christian/hateimparlament
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

solve most of predefined challenges

Browse Source
This commit is contained in:
christian
2021-08-02 16:12:18 +02:00
parent d01cea9d52
commit 4fe45feec9
7 changed files with 138 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files
DESCRIPTION
+1
View File
@@ -21,6 +21,7 @@ Imports:
rvest,
stringr,
tibble,
tidyr,
xml2
Suggests:
rmarkdown,
NAMESPACE
+3
View File
@@ -1,16 +1,19 @@
# Generated by roxygen2: do not edit by hand
export(bar_plot_fraktionen)
export(fetch_all)
export(find_word)
export(join_redner)
export(read_all)
export(read_from_csv)
export(repair)
export(word_usage_by_date)
export(write_to_csv)
import(dplyr)
import(pbapply)
import(purrr)
import(stringr)
import(tibble)
import(tidyr)
import(utils)
import(xml2)
R/analyze.R
+19
View File
@@ -29,3 +29,22 @@ bar_plot_fraktionen <- function(tb) {
scale_fill_manual(values = party_colors) +
geom_bar(stat = "identity")
}
# Counts how many talks do match a given pattern and summarises by date
#
#' @export
word_usage_by_date <- function(res, patterns, name, tidy=F) {
tb <- res$talks
nms <- names(patterns)
for (i in seq_along(patterns)) {
if (!is.null(nms)) name <- nms[[i]]
else name <- patterns[[i]]
tb <- mutate(tb, {{name}} := str_count(content, patterns[[i]]))
}
left_join(tb, res$reden, by=c("rede_id" = "id")) %>%
group_by(date) %>%
summarize(across(where(is.numeric), sum)) %>%
arrange(date) -> tb
if (!tidy) pivot_longer(tb, where(is.numeric) , names_to = "pattern", values_to="count")
else tb
}
R/hateimparlament-package.R
+1
View File
@@ -6,6 +6,7 @@
#' @import stringr
#' @import xml2
#' @import utils
#' @import tidyr
#' @import purrr
#' @keywords internal
"_PACKAGE"
R/parse.R
+36 -18
View File
@@ -20,7 +20,8 @@ read_all <- function(path="records/") {
lapply(res, `[[`, "reden") %>%
bind_rows() %>%
distinct() ->
distinct() %>%
mutate(date = as.Date(date, format="%d.%m.%Y")) ->
reden
lapply(res, `[[`, "talks") %>%
@@ -31,11 +32,26 @@ read_all <- function(path="records/") {
lapply(res, `[[`, "comments") %>%
bind_rows() %>%
distinct() ->
comments
commentsandapplause
if (length(available_protocols) == 0)
warning("The given directory is empty or does not exist.")
list(redner = redner, reden = reden, talks = talks, comments = comments)
filter(commentsandapplause, type == "comment") %>%
select(-type) ->
comments
filter(commentsandapplause, type == "applause") %>%
select(-type, -kommentator, -content) %>%
mutate("CDU_CSU" = str_detect(fraktion, "CDU/CSU"),
"SPD" = str_detect(fraktion, "SPD"),
"FDP" = str_detect(fraktion, "FDP"),
"DIE_LINKE" = str_detect(fraktion, "DIE LINKE"),
"BÜNDNIS_90_DIE_GRÜNEN" = str_detect(fraktion, "BÜNDNIS 90/DIE GRÜNEN"),
"AfD" = str_detect(fraktion, "AfD")) %>%
select(-fraktion) ->
applause
list(redner = redner, reden = reden, talks = talks, comments = comments, applause = applause)
}
# this reads all currently parseable data from one xml
@@ -43,6 +59,8 @@ read_one <- function(name, path) {
x <- tryCatch(read_xml(paste0(path, name)),
error = function(c) NULL)
if (is.null(x)) return(NULL)
# extract date of session
date <- xml_attr(x, "sitzung-datum")
cs <- xml_children(x)
verlauf <- xml_find_first(x, "sitzungsverlauf")
@@ -54,7 +72,7 @@ read_one <- function(name, path) {
xml_children(verlauf) %>%
xml_find_all("rede") %>%
parse_redenliste() ->
parse_redenliste(date) ->
res
list(redner = redner, reden = res$reden, talks = res$talks, comments = res$comments)
@@ -86,7 +104,7 @@ parse_redner <- function(redner_xml) {
# parse one rede
# returns: - a rede (with rede id and redner id)
# - all talks appearing in the rede (with corresponding content)
parse_rede <- function(rede_xml) {
parse_rede <- function(rede_xml, date) {
rede_id <- xml_attr(rede_xml, "id")
cs <- xml_children(rede_xml)
cur_redner <- NA_character_
@@ -132,7 +150,7 @@ parse_rede <- function(rede_xml) {
redner = cur_redner,
content = cur_content)
reden <- c(reden, list(rede))
list(rede = c(id = rede_id, redner = principal_redner),
list(rede = c(id = rede_id, redner = principal_redner, date = date),
parts = reden,
comments = comments)
}
@@ -142,16 +160,13 @@ fraktionsnames <- c("BÜNDNIS 90/DIE GRÜNEN", "CDU/CSU", "AfD", "SPD", "DIE LIN
parse_comment <- function(comment, rede_id, on_redner) {
base <- c(rede_id = rede_id, on_redner = on_redner)
str_extract_all(comment, fraktionspattern) %>%
`[[`(1) %>%
sapply(partial(flip(head), 1) %.% agrep, x=fraktionsnames, max=0.2, value=T) %>%
str_c(collapse=",") ->
by
# classify comment
# TODO:
# - actually separate content properly
# - differentiate between [AfD] and AfD in by
if(str_detect(comment, "Beifall")) {
str_extract_all(comment, fraktionspattern) %>%
`[[`(1) %>%
sapply(partial(flip(head), 1) %.% agrep, x=fraktionsnames, max=0.2, value=T) %>%
str_c(collapse=",") ->
by
c(base, type = "applause", fraktion = by, kommentator = NA_character_, content = comment)
} else {
ps <- str_match(comment, "(.*) \\[(.*?)\\]: (.*)")[1,]
@@ -160,12 +175,13 @@ parse_comment <- function(comment, rede_id, on_redner) {
}
# creates a tibble of reden and a tibble of talks from a list of xml nodes representing reden
parse_redenliste <- function(redenliste_xml) {
d <- sapply(redenliste_xml, parse_rede)
parse_redenliste <- function(redenliste_xml, date) {
d <- sapply(redenliste_xml, parse_rede, date = date)
reden <- simplify2array(d["rede", ])
parts <- simplify2array %$% unlist(d["parts", ], recursive=FALSE)
comments <- simplify2array %$% unlist(d["comments", ], recursive=FALSE)
list(reden = tibble(id = reden["id",], redner = reden["redner",]),
list(reden = tibble(id = reden["id",], redner = reden["redner",],
date = reden["date",]),
talks = tibble(rede_id = parts["rede_id", ],
redner = parts["redner", ],
content = parts["content", ]),
@@ -196,6 +212,7 @@ write_to_csv <- function(tables, path="csv/", create=F) {
write.table(tables$reden, str_c(path, "reden.csv"))
write.table(tables$talks, str_c(path, "talks.csv"))
write.table(tables$comments, str_c(path, "comments.csv"))
write.table(tables$applause, str_c(path, "applause.csv"))
}
#' @export
@@ -207,7 +224,8 @@ read_from_csv <- function(path="csv/") {
tibble() %>%
mutate(redner = as.character(redner)),
talks = tibble %$% read.table(str_c(path, "talks.csv")),
comments = tibble %$% read.table(str_c(path, "comments.csv")))
comments = tibble %$% read.table(str_c(path, "comments.csv")),
applause = tibble %$% read.table(str_c(path, "applause.csv")))
}
# -------------------------------
R/repair.R
+4 -3
View File
@@ -47,8 +47,8 @@ repair_reden <- function(reden) {
repair_talks <- function(talks) {
if (nrow(talks) == 0) return(talks)
# TODO: fill with content
talks
# ignore all talks which have empty content
filter(talks, str_length(content) > 0)
}
# tries to find the correct redner id given a name
@@ -90,6 +90,7 @@ repair <- function(parse_output) {
reden = repair_reden(parse_output$reden),
talks = repair_talks(parse_output$talks),
#comments = repair_comments(parse_output$comments)
comments = parse_output$comments
comments = parse_output$comments,
applause = parse_output$applause
)
}
vignettes/funwithdata.Rmd
+74 -3
View File
@@ -48,8 +48,8 @@ talks <- res$talks
## Analysis
Now we can start analysing our parsed dataset, e.g. find out which party gives the most talks:
```{r, fig.width=10}
join_redner(reden, res) %>%
```{r, fig.width=8}
join_redner(res$reden, res) %>%
group_by(fraktion) %>%
summarize(n = n()) %>%
arrange(n) %>%
@@ -58,7 +58,7 @@ join_redner(reden, res) %>%
### Count a word occurence
```{r, fig.width=10}
```{r, fig.width=8}
find_word(res, "hitler") %>%
filter(occurences > 0) %>%
join_redner(res) %>%
@@ -68,3 +68,74 @@ find_word(res, "hitler") %>%
arrange(desc(n)) %>%
bar_plot_fraktionen()
```
### Who gives the most speeches?
```{r}
res$reden %>%
group_by(redner) %>%
summarize(n = n()) %>%
arrange(-n) %>%
left_join(res$redner, by=c("redner" = "id")) %>%
head(10)
```
### Who talks the longest?
```{r}
res$talks %>%
mutate(content_len = str_length(content)) %>%
group_by(redner) %>%
summarize(avg_content_len = mean(content_len)) %>%
arrange(-avg_content_len) %>%
left_join(res$redner, by=c("redner" = "id")) %>%
head(10)
```
### Which party gives the most applause to which parties?
```{r}
res$applause %>%
left_join(res$redner, by=c("on_redner" = "id")) %>%
select(on_fraktion = fraktion, where(is.logical)) %>%
group_by(on_fraktion) %>%
arrange(on_fraktion) %>%
summarize("AfD" = sum(`AfD`),
"BÜNDNIS 90 / DIE GRÜNEN" = sum(`BÜNDNIS_90_DIE_GRÜNEN`),
"CDU/CSU" = sum(`CDU_CSU`),
"DIE LINKE" = sum(`DIE_LINKE`),
"FDP" = sum(`FDP`),
"SPD" = sum(`SPD`))
```
### Which party comments the most on which parties?
```{r}
res$comments %>%
left_join(res$redner, by=c("on_redner" = "id")) %>%
select(by_fraktion = fraktion.x, on_fraktion = fraktion.y) %>%
group_by(on_fraktion) %>%
summarize(`AfD` = sum(str_detect(by_fraktion, "AfD"), na.rm=T),
`BÜNDNIS 90 / DIE GRÜNEN` = sum(str_detect(by_fraktion, "BÜNDNIS 90/DIE GRÜNEN"), na.rm=T),
`CDU/CSU` = sum(str_detect(by_fraktion, "CDU/CSU"), na.rm = T),
`DIE LINKE` = sum(str_detect(by_fraktion, "DIE LINKE"), na.rm=T),
`FDP` = sum(str_detect(by_fraktion, "FDP"), na.rm=T),
`SPD` = sum(str_detect(by_fraktion, "SPD"), na.rm=T))
```
### When are which topics discussed the most?
```{r, fig.width=8}
pandemic_pattern <- "(?i)virus|corona|covid|lockdown"
climate_pattern <- "(?i)klimawandel|erderwärmung|co2|treibhaus|methan|kyoto-protokoll|klimaabkommen"
pension_pattern <- "(?i)rente|pension|altersarmut"
word_usage_by_date(res, c(pandemic = pandemic_pattern,
climate = climate_pattern,
pension = pension_pattern)) %>%
ggplot(aes(x = date, y = count, color = pattern)) +
xlab("date of session") +
ylab("occurence of word per session") +
labs(color = "Topic") +
geom_point()
```