3 Commits
7 changed files with 182 additions and 181 deletions
+3 -2
View File
@@ -1,9 +1,10 @@
# Generated by roxygen2: do not edit by hand
export(bar_plot_fraktionen)
export(bar_plot_fractions)
export(fetch_all)
export(find_word)
export(join_redner)
export(join_speaker)
export(party_colors)
export(read_all)
export(read_from_csv)
export(repair)
+9 -9
View File
@@ -6,9 +6,9 @@ find_word <- function(res, word) {
}
#' @export
join_redner <- function(tb, res, fraktion_only = F) {
joined <- left_join(tb, res$redner, by=c("redner" = "id"))
if (fraktion_only) select(joined, "fraktion")
join_speaker <- function(tb, res, fraction_only = F) {
joined <- left_join(tb, res$speaker, by=c("speaker" = "id"))
if (fraction_only) select(joined, "fraction")
else joined
}
@@ -29,10 +29,10 @@ party_order <- factor(c("Fraktionslos", "AfD&Fraktionslos",
"FDP", "AfD", NA_character_))
#' @export
bar_plot_fraktionen <- function(tb,
x_variable = NULL, # default is fraktion
bar_plot_fractions <- function(tb,
x_variable = NULL, # default is fraction
y_variable = NULL, # default is n
fill = NULL, # default is fraktion
fill = NULL, # default is fraction
title = NULL,
xlab = "Fraction",
ylab = "n",
@@ -46,9 +46,9 @@ bar_plot_fraktionen <- function(tb,
x_variable <- enexpr(x_variable)
# set default values
if (is.null(fill)) fill <- expr(fraktion)
if (is.null(fill)) fill <- expr(fraction)
if (is.null(y_variable)) y_variable <- expr(n)
if (is.null(x_variable)) x_variable <- expr(fraktion)
if (is.null(x_variable)) x_variable <- expr(fraction)
# either reorder fraction factor by variable value
if (reorder) maps <- aes(x = reorder(!!x_variable, -!!y_variable),
@@ -82,7 +82,7 @@ word_usage_by_date <- function(res, patterns, name, tidy=F) {
else name <- patterns[[i]]
tb <- mutate(tb, {{name}} := str_count(content, patterns[[i]]))
}
left_join(tb, res$reden, by=c("rede_id" = "id")) %>%
left_join(tb, res$speeches, by=c("speech_id" = "id")) %>%
group_by(date) %>%
summarize(across(where(is.numeric), sum)) %>%
arrange(date) -> tb
+76 -76
View File
@@ -16,16 +16,16 @@ read_all <- function(path="records/") {
if (length(available_protocols) == 0)
stop("The given directory is empty or does not exist.")
lapply(res, `[[`, "redner") %>%
lapply(res, `[[`, "speaker") %>%
bind_rows() %>%
distinct() ->
redner
speaker
lapply(res, `[[`, "reden") %>%
lapply(res, `[[`, "speeches") %>%
bind_rows() %>%
distinct() %>%
mutate(date = as.Date(date, format="%d.%m.%Y")) ->
reden
speeches
lapply(res, `[[`, "talks") %>%
bind_rows() %>%
@@ -42,16 +42,16 @@ read_all <- function(path="records/") {
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"),
"BUENDNIS_90_DIE_GRUENEN" = str_detect(fraktion, "BÜNDNIS 90/DIE GRÜNEN"),
"AfD" = str_detect(fraktion, "AfD")) %>%
select(-fraktion) ->
mutate("CDU_CSU" = str_detect(fraction, "CDU/CSU"),
"SPD" = str_detect(fraction, "SPD"),
"FDP" = str_detect(fraction, "FDP"),
"DIE_LINKE" = str_detect(fraction, "DIE LINKE"),
"BUENDNIS_90_DIE_GRUENEN" = str_detect(fraction, "BÜNDNIS 90/DIE GRÜNEN"),
"AfD" = str_detect(fraction, "AfD")) %>%
select(-fraction) ->
applause
list(redner = redner, reden = reden, talks = talks, comments = comments, applause = applause)
list(speaker = speaker, speeches = speeches, talks = talks, comments = comments, applause = applause)
}
# this reads all currently parseable data from one xml
@@ -64,18 +64,18 @@ read_one <- function(name, path) {
cs <- xml_children(x)
verlauf <- xml_find_first(x, "sitzungsverlauf")
rednerl <- xml_find_first(x, "rednerliste")
speakerl <- xml_find_first(x, "rednerliste")
xml_children(rednerl) %>%
parse_rednerliste() ->
redner
xml_children(speakerl) %>%
parse_speakerlist() ->
speaker
xml_children(verlauf) %>%
xml_find_all("rede") %>%
parse_redenliste(date) ->
parse_speechlist(date) ->
res
list(redner = redner, reden = res$reden, talks = res$talks, comments = res$comments)
list(speaker = speaker, speeches = res$speeches, talks = res$talks, comments = res$comments)
}
xml_get <- function(node, name) {
@@ -84,52 +84,52 @@ xml_get <- function(node, name) {
else res
}
# parse one redner
parse_redner <- function(redner_xml) {
redner_id <- xml_attr(redner_xml, "id")
nm <- xml_child(redner_xml)
# parse one speaker
parse_speaker <- function(speaker_xml) {
speaker_id <- xml_attr(speaker_xml, "id")
nm <- xml_child(speaker_xml)
vorname <- xml_get(nm, "vorname")
nachname <- xml_get(nm, "nachname")
fraktion <- xml_get(nm, "fraktion")
fraction <- xml_get(nm, "fraction")
titel <- xml_get(nm, "titel")
rolle <- xml_find_all(nm, "rolle")
if (length(rolle) > 0) {
rolle_lang <- xml_get(rolle, "rolle_lang")
rolle_kurz <- xml_get(rolle, "rolle_kurz")
} else rolle_kurz <- rolle_lang <- NA_character_
c(id = redner_id, vorname = vorname, nachname = nachname, fraktion = fraktion, titel = titel,
c(id = speaker_id, vorname = vorname, nachname = nachname, fraction = fraction, titel = titel,
rolle_kurz = rolle_kurz, rolle_lang = rolle_lang)
}
# 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, date) {
rede_id <- xml_attr(rede_xml, "id")
cs <- xml_children(rede_xml)
cur_redner <- NA_character_
principal_redner <- NA_character_
# parse one speech
# returns: - a speech (with speech id and speaker id)
# - all talks appearing in the speech (with corresponding content)
parse_speech <- function(speech_xml, date) {
speech_id <- xml_attr(speech_xml, "id")
cs <- xml_children(speech_xml)
cur_speaker <- NA_character_
principal_speaker <- NA_character_
cur_content <- ""
reden <- list()
speeches <- list()
comments <- list()
for (node in cs) {
if (xml_name(node) == "p" || xml_name(node) == "name") {
klasse <- xml_attr(node, "klasse")
if ((!is.na(klasse) && klasse == "redner") || xml_name(node) == "name") {
if (!is.na(cur_redner)) {
rede <- c(rede_id = rede_id,
redner = cur_redner,
if ((!is.na(klasse) && klasse == "speaker") || xml_name(node) == "name") {
if (!is.na(cur_speaker)) {
speech <- c(speech_id = speech_id,
speaker = cur_speaker,
content = cur_content)
reden <- c(reden, list(rede))
speeches <- c(speeches, list(speech))
cur_content <- ""
}
if (is.na(principal_redner) && xml_name(node) != "name") {
principal_redner <- xml_child(node) %>% xml_attr("id")
if (is.na(principal_speaker) && xml_name(node) != "name") {
principal_speaker <- xml_child(node) %>% xml_attr("id")
}
if (xml_name(node) == "name") {
cur_redner <- "BTP"
cur_speaker <- "BTP"
} else {
cur_redner <- xml_child(node) %>% xml_attr("id")
cur_speaker <- xml_child(node) %>% xml_attr("id")
}
} else {
cur_content <- paste0(cur_content, xml_text(node), sep="\n")
@@ -141,65 +141,65 @@ parse_rede <- function(rede_xml, date) {
str_sub(2, -2) %>%
str_split("") %>%
`[[`(1) %>%
lapply(parse_comment, rede_id = rede_id, on_redner = cur_redner) ->
lapply(parse_comment, speech_id = speech_id, on_speaker = cur_speaker) ->
cs
comments <- c(comments, cs)
}
}
rede <- c(rede_id = rede_id,
redner = cur_redner,
speech <- c(speech_id = speech_id,
speaker = cur_speaker,
content = cur_content)
reden <- c(reden, list(rede))
list(rede = c(id = rede_id, redner = principal_redner, date = date),
parts = reden,
speeches <- c(speeches, list(speech))
list(speech = c(id = speech_id, speaker = principal_speaker, date = date),
parts = speeches,
comments = comments)
}
fraktionspattern <- "BÜNDNIS(SES)?\\W*90/DIE\\W*GRÜNEN|CDU/CSU|AfD|SPD|DIE LINKE|FDP|LINKEN"
fraktionsnames <- c("BÜNDNIS 90/DIE GRÜNEN", "CDU/CSU", "AfD", "SPD", "DIE LINKE", "FDP")
fractionpattern <- "BÜNDNIS(SES)?\\W*90/DIE\\W*GRÜNEN|CDU/CSU|AfD|SPD|DIE LINKE|FDP|LINKEN"
fractionnames <- c("BÜNDNIS 90/DIE GRÜNEN", "CDU/CSU", "AfD", "SPD", "DIE LINKE", "FDP")
parse_comment <- function(comment, rede_id, on_redner) {
base <- c(rede_id = rede_id, on_redner = on_redner)
parse_comment <- function(comment, speech_id, on_speaker) {
base <- c(speech_id = speech_id, on_speaker = on_speaker)
# classify comment
if(str_detect(comment, "Beifall")) {
str_extract_all(comment, fraktionspattern) %>%
str_extract_all(comment, fractionpattern) %>%
`[[`(1) %>%
sapply(partial(flip(head), 1) %.% agrep, x=fraktionsnames, max=0.2, value=T) %>%
sapply(partial(flip(head), 1) %.% agrep, x=fractionnames, max=0.2, value=T) %>%
str_c(collapse=",") ->
by
c(base, type = "applause", fraktion = by, kommentator = NA_character_, content = comment)
c(base, type = "applause", fraction = by, kommentator = NA_character_, content = comment)
} else {
ps <- str_match(comment, "(.*) \\[(.*?)\\]: (.*)")[1,]
c(base, type = "comment", fraktion = ps[3], kommentator = ps[2], content = ps[4])
c(base, type = "comment", fraction = ps[3], kommentator = ps[2], content = ps[4])
}
}
# creates a tibble of reden and a tibble of talks from a list of xml nodes representing reden
parse_redenliste <- function(redenliste_xml, date) {
d <- sapply(redenliste_xml, parse_rede, date = date)
reden <- simplify2array(d["rede", ])
# creates a tibble of speeches and a tibble of talks from a list of xml nodes representing speeches
parse_speechlist <- function(speechlist_xml, date) {
d <- sapply(speechlist_xml, parse_speech, date = date)
speeches <- simplify2array(d["speech", ])
parts <- simplify2array %$% unlist(d["parts", ], recursive=FALSE)
comments <- simplify2array %$% unlist(d["comments", ], recursive=FALSE)
list(reden = tibble(id = reden["id",], redner = reden["redner",],
date = reden["date",]),
talks = tibble(rede_id = parts["rede_id", ],
redner = parts["redner", ],
list(speeches = tibble(id = speeches["id",], speaker = speeches["speaker",],
date = speeches["date",]),
talks = tibble(speech_id = parts["speech_id", ],
speaker = parts["speaker", ],
content = parts["content", ]),
comments = tibble(rede_id = comments["rede_id",],
on_redner = comments["on_redner",],
comments = tibble(speech_id = comments["speech_id",],
on_speaker = comments["on_speaker",],
type = comments["type",],
fraktion = comments["fraktion",],
fraction = comments["fraction",],
kommentator = comments["kommentator",],
content = comments["content", ]))
}
# create a tibble of redner from a list of xml nodes representing redner
parse_rednerliste <- function(rednerliste_xml) {
d <- sapply(rednerliste_xml, parse_redner)
# create a tibble of speaker from a list of xml nodes representing speaker
parse_speakerliste <- function(speakerliste_xml) {
d <- sapply(speakerliste_xml, parse_speaker)
tibble(id = d["id",],
vorname = d["vorname",],
nachname = d["nachname",],
fraktion = d["fraktion",],
fraction = d["fraction",],
titel = d["titel",],
rolle_kurz = d["rolle_kurz",],
rolle_lang = d["rolle_lang",])
@@ -208,8 +208,8 @@ parse_rednerliste <- function(rednerliste_xml) {
#' @export
write_to_csv <- function(tables, path="csv/", create=F) {
check_directory(path, create)
write.table(tables$redner, str_c(path, "redner.csv"))
write.table(tables$reden, str_c(path, "reden.csv"))
write.table(tables$speaker, str_c(path, "speaker.csv"))
write.table(tables$speeches, str_c(path, "speeches.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"))
@@ -217,12 +217,12 @@ write_to_csv <- function(tables, path="csv/", create=F) {
#' @export
read_from_csv <- function(path="csv/") {
list(redner = read.table(str_c(path, "redner.csv")) %>%
list(speaker = read.table(str_c(path, "speaker.csv")) %>%
tibble() %>%
mutate(id = as.character(id)),
reden = read.table(str_c(path, "reden.csv")) %>%
speeches = read.table(str_c(path, "speeches.csv")) %>%
tibble() %>%
mutate(redner = as.character(redner)),
mutate(speaker = as.character(speaker)),
talks = tibble %$% read.table(str_c(path, "talks.csv")),
comments = tibble %$% read.table(str_c(path, "comments.csv")),
applause = tibble %$% read.table(str_c(path, "applause.csv")))
+20 -20
View File
@@ -1,4 +1,4 @@
fraktionen <- c("AFD" = "AfD",
fractions <- c("AFD" = "AfD",
"AFD&FRAKTIONSLOS" = "AfD&Fraktionslos",
"BÜNDNIS90/" = "BÜNDNIS 90 / DIE GRÜNEN",
"BÜNDNIS90/DIEGRÜNEN" = "BÜNDNIS 90 / DIE GRÜNEN",
@@ -8,9 +8,9 @@ fraktionen <- c("AFD" = "AfD",
"CDU/CSU" = "CDU/CSU",
"FDP" = "FDP")
repair_fraktion <- function(fraktion) {
cleaned <- str_to_upper %$% str_replace_all(fraktion, "\\s", "")
fraktionen[cleaned]
repair_fraction <- function(fraction) {
cleaned <- str_to_upper %$% str_replace_all(fraction, "\\s", "")
fractions[cleaned]
}
# takes vector of titel and keeps longest
@@ -22,28 +22,28 @@ longest_titel <- function(titel) {
# takes character vector, removes duplicates and collapses
collect_unique <- function(xs) xs %>% clear_na() %>% unique() %>% str_c(collapse="&") %>% na_if("")
# expects a tibble of redner and repairs
repair_redner <- function(redner) {
if (nrow(redner) == 0) return(redner)
redner %>%
# expects a tibble of speaker and repairs
repair_speaker <- function(speaker) {
if (nrow(speaker) == 0) return(speaker)
speaker %>%
filter(id != "10000") %>% # invalid id's
mutate(fraktion = Vectorize(repair_fraktion)(fraktion)) %>% # fix fraktion
mutate(fraction = Vectorize(repair_fraction)(fraction)) %>% # fix fraction
group_by(id) %>%
summarize(vorname = head(vorname, 1),
nachname = head(nachname, 1),
fraktion = collect_unique(fraktion),
fraction = collect_unique(fraction),
titel = longest_titel(titel),
rolle_kurz = collect_unique(str_squish(rolle_kurz)),
rolle_lang = collect_unique(str_squish(rolle_lang))) %>%
ungroup() #%>%
# arrange(id) %>%
# distinct(vorname, nachname, fraktion, titel)
# distinct(vorname, nachname, fraction, titel)
}
repair_reden <- function(reden) {
if (nrow(reden) == 0) return(reden)
repair_speeches <- function(speeches) {
if (nrow(speeches) == 0) return(speeches)
# TODO: fill with content
reden
speeches
}
repair_talks <- function(talks) {
@@ -65,9 +65,9 @@ repair_talks <- function(talks) {
#' Tries to match the name_variable column with speaker names
#'
#' returns a lookup table
lookup_redner <- function(tb, redner, name_variable) {
lookup_speaker <- function(tb, speaker, name_variable) {
tobereplaced <- "[-–—‑­­-­­­ ]"
redner %>%
speaker %>%
unite(name, vorname, nachname, sep=".*") %>%
mutate(name = str_replace_all(name, tobereplaced, ".*")) ->
rs
@@ -80,7 +80,7 @@ lookup_redner <- function(tb, redner, name_variable) {
}
tb %>%
distinct({{name_variable}}) %>%
mutate(redner = Vectorize(find_match)(str_replace_all({{name_variable}}, tobereplaced, "")))
mutate(speaker = Vectorize(find_match)(str_replace_all({{name_variable}}, tobereplaced, "")))
}
repair_comments <- function(comments, redner) {
@@ -104,11 +104,11 @@ repair_comments <- function(comments, redner) {
#' @export
repair <- function(parse_output, repair_comments = FALSE) {
list(redner = repair_redner(parse_output$redner),
reden = repair_reden(parse_output$reden),
list(redner = repair_speaker(parse_output$speaker),
reden = repair_speeches(parse_output$speeches),
talks = repair_talks(parse_output$talks),
comments = if(repair_comments) repair_comments(parse_output$comments,
parse_output$redner)
parse_output$speaker)
else parse_output$comments,
applause = parse_output$applause
)
+1 -1
View File
@@ -44,7 +44,7 @@ parse.R parsed einzelne Protokolle und erstellt 3 Tibbles
### Redner
Struktur: `id` , `vorname` , `nachname` , `fraktion` , `titel` , `rolle_kurz`, `rolle_lang`
Struktur: `id` , `vorname` , `nachname` , `fraction` , `titel` , `rolle_kurz`, `rolle_lang`
Die Rollen sind beispielsweise "Bundeskanzlerin". Leider gegendert und deshalb wahrscheinlich
nervig zu analysieren.
+36 -36
View File
@@ -42,8 +42,8 @@ res <- read_from_csv('../csv/')
and unpack our tibbles
```{r}
comments <- res$comments
reden <- res$reden
redner <- res$redner
speeches <- res$speeches
speaker <- res$speaker
talks <- res$talks
```
@@ -51,11 +51,11 @@ talks <- res$talks
Now we can start analysing our parsed dataset, e.g. find out which party gives the most talks:
```{r, fig.width=7}
join_redner(res$reden, res) %>%
group_by(fraktion) %>%
join_speaker(res$speeches, res) %>%
group_by(fraction) %>%
summarize(n = n()) %>%
arrange(n) %>%
bar_plot_fraktionen(title="Number of speeches given by fraction",
bar_plot_fractions(title="Number of speeches given by fraction",
ylab="Number of speeches")
```
@@ -64,13 +64,13 @@ or counting the occurences of a given word:
```{r, fig.width=7}
find_word(res, "Kohleausstieg") %>%
filter(occurences > 0) %>%
join_redner(res) %>%
select(content, fraktion) %>%
filter(!is.na(fraktion)) %>%
group_by(fraktion) %>%
join_speaker(res) %>%
select(content, fraction) %>%
filter(!is.na(fraction)) %>%
group_by(fraction) %>%
summarize(n = n()) %>%
arrange(desc(n)) %>%
bar_plot_fraktionen(title = "Parties using the word 'Kohleausstieg' the most (absolutely)",
bar_plot_fractions(title = "Parties using the word 'Kohleausstieg' the most (absolutely)",
ylab = "Number of uses of 'Kohleausstieg'",
flipped = F)
```
@@ -78,11 +78,11 @@ find_word(res, "Kohleausstieg") %>%
### Who gives the most speeches?
```{r}
res$reden %>%
group_by(redner) %>%
res$speeches %>%
group_by(speaker) %>%
summarize(n = n()) %>%
arrange(-n) %>%
left_join(res$redner, by=c("redner" = "id")) %>%
left_join(res$speaker, by=c("speaker" = "id")) %>%
head(10)
```
@@ -91,10 +91,10 @@ res$reden %>%
```{r}
res$talks %>%
mutate(content_len = str_length(content)) %>%
group_by(redner) %>%
group_by(speaker) %>%
summarize(avg_content_len = mean(content_len)) %>%
arrange(-avg_content_len) %>%
left_join(res$redner, by=c("redner" = "id")) %>%
left_join(res$speaker, by=c("speaker" = "id")) %>%
head(10)
```
@@ -102,10 +102,10 @@ res$talks %>%
```{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) %>%
left_join(res$speaker, by=c("on_speaker" = "id")) %>%
select(on_fraction = fraction, where(is.logical)) %>%
group_by(on_fraction) %>%
arrange(on_fraction) %>%
summarize("AfD" = sum(`AfD`),
"BÜNDNIS 90 / DIE GRÜNEN" = sum(`BUENDNIS_90_DIE_GRUENEN`),
"CDU/CSU" = sum(`CDU_CSU`),
@@ -117,11 +117,11 @@ res$applause %>%
For plotting our results we reorganize them a bit and produce a bar plot:
```{r, fig.width=7}
pivot_longer(tb, where(is.numeric), "by_fraktion", "count") %>%
filter(!is.na(on_fraktion)) %>%
bar_plot_fraktionen(x_variable = on_fraktion,
pivot_longer(tb, where(is.numeric), "by_fraction", "count") %>%
filter(!is.na(on_fraction)) %>%
bar_plot_fractions(x_variable = on_fraction,
y_variable = value,
fill = by_fraktion,
fill = by_fraction,
title = "Number of rounds of applauses from fractions to fractions",
xlab = "Applauded fraction",
ylab = "Rounds of applauses",
@@ -134,24 +134,24 @@ pivot_longer(tb, where(is.numeric), "by_fraktion", "count") %>%
```{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)) -> tb
left_join(res$speaker, by=c("on_speaker" = "id")) %>%
select(by_fraction = fraction.x, on_fraction = fraction.y) %>%
group_by(on_fraction) %>%
summarize(`AfD` = sum(str_detect(by_fraction, "AfD"), na.rm=T),
`BÜNDNIS 90 / DIE GRÜNEN` = sum(str_detect(by_fraction, "BÜNDNIS 90/DIE GRÜNEN"), na.rm=T),
`CDU/CSU` = sum(str_detect(by_fraction, "CDU/CSU"), na.rm = T),
`DIE LINKE` = sum(str_detect(by_fraction, "DIE LINKE"), na.rm=T),
`FDP` = sum(str_detect(by_fraction, "FDP"), na.rm=T),
`SPD` = sum(str_detect(by_fraction, "SPD"), na.rm=T)) -> tb
```
Analogously we plot the results:
```{r, fig.width=7}
pivot_longer(tb, where(is.numeric), "by_fraktion", "count") %>%
filter(!is.na(on_fraktion)) %>%
bar_plot_fraktionen(x_variable = on_fraktion,
pivot_longer(tb, where(is.numeric), "by_fraction", "count") %>%
filter(!is.na(on_fraction)) %>%
bar_plot_fractions(x_variable = on_fraction,
y_variable = value,
fill = by_fraktion,
fill = by_fraction,
title = "Number of comments from fractions to fractions",
xlab = "Commented fraction",
ylab = "Number of comments",
+37 -37
View File
@@ -31,8 +31,8 @@ Second, those `.xml` files, need to be parsed into `R` `tibbles`. This is accomp
```r
read_all("../records/") %>% repair() -> res
reden <- res$reden
redner <- res$redner
speeches <- res$speeches
speaker <- res$speaker
talks <- res$talks
```
We also used `repair` to fix a bunch of formatting issues in the records and unpacked
@@ -43,8 +43,8 @@ For development purposes, we load the tables from csv files.
tables <- read_from_csv('../csv/')
comments <- tables$comments
reden <- tables$reden
redner <- tables$redner
speeches <- tables$speeches
speaker <- tables$speaker
talks <- tables$talks
```
@@ -60,54 +60,54 @@ hitlerwords <- tibble(Worte)
Now we extract the words that were used with higher frequency by one party and compare them with `hitlerwords`.
```{r}
talks %>%
left_join(redner, by=c(redner='id')) %>%
group_by(fraktion) %>%
summarize(full_text=str_c(content, collapse="\n")) -> talks_by_fraktion
left_join(speaker, by=c(speaker='id')) %>%
group_by(fraction) %>%
summarize(full_text=str_c(content, collapse="\n")) -> talks_by_fraction
```
For each party, we want to get a tibble of words with frequency.
```{r}
#AfD
Worte <- str_extract_all(talks_by_fraktion$full_text[[1]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
Worte <- str_extract_all(talks_by_fraction$full_text[[1]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
afdtotal = length(Worte)
tibble(Worte) %>% group_by(Worte) %>% count() %>% mutate(freq =n/afdtotal) -> afd_words
#AfD&Fraktionslos
Worte <- str_extract_all(talks_by_fraktion$full_text[[2]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
Worte <- str_extract_all(talks_by_fraction$full_text[[2]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
afdundfraktionslostotal = length(Worte)
tibble(Worte) %>% group_by(Worte) %>% count() %>% mutate(freq =n/afdundfraktionslostotal) -> afdundfraktionslos_words
#BÜNDNIS 90 / DIE GRÜNEN
Worte <- str_extract_all(talks_by_fraktion$full_text[[3]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
Worte <- str_extract_all(talks_by_fraction$full_text[[3]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
grünetotal = length(Worte)
tibble(Worte) %>% group_by(Worte) %>% count() %>% mutate(freq =n/grünetotal) -> grüne_words
#CDU/CSU
Worte <- str_extract_all(talks_by_fraktion$full_text[[4]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
Worte <- str_extract_all(talks_by_fraction$full_text[[4]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
cdutotal = length(Worte)
tibble(Worte) %>% group_by(Worte) %>% count() %>% mutate(freq =n/cdutotal) -> cdu_words
#DIE LINKE
Worte <- str_extract_all(talks_by_fraktion$full_text[[5]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
Worte <- str_extract_all(talks_by_fraction$full_text[[5]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
linketotal = length(Worte)
tibble(Worte) %>% group_by(Worte) %>% count() %>% mutate(freq =n/linketotal) -> linke_words
#FDP
Worte <- str_extract_all(talks_by_fraktion$full_text[[6]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
Worte <- str_extract_all(talks_by_fraction$full_text[[6]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
fdptotal = length(Worte)
tibble(Worte) %>% group_by(Worte) %>% count() %>% mutate(freq =n/fdptotal) -> fdp_words
#Fraktionslos
Worte <- str_extract_all(talks_by_fraktion$full_text[[7]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
Worte <- str_extract_all(talks_by_fraction$full_text[[7]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
fraktionslostotal = length(Worte)
tibble(Worte) %>% group_by(Worte) %>% count() %>% mutate(freq =n/fraktionslostotal) -> fraktionslos_words
#SPD
Worte <- str_extract_all(talks_by_fraktion$full_text[[8]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
Worte <- str_extract_all(talks_by_fraction$full_text[[8]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
spdtotal = length(Worte)
tibble(Worte) %>% group_by(Worte) %>% count() %>% mutate(freq =n/spdtotal) -> spd_words
#NA
Worte <- str_extract_all(talks_by_fraktion$full_text[[9]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
Worte <- str_extract_all(talks_by_fraction$full_text[[9]], "\\b[a-zA-ZäöüÄÖÜß]+\\b")[[1]]
natotal = length(Worte)
tibble(Worte) %>% group_by(Worte) %>% count() %>% mutate(freq =n/natotal) -> na_words
@@ -117,34 +117,34 @@ total <- sum(all_words$n)
all_words %>% group_by(Worte) %>% summarize(n = sum(n), part= sum(n)/total) -> all_words
```
Now we want to extract the words that are more frequently used by a specific `fraktion`.
Now we want to extract the words that are more frequently used by a specific fraction.
```{r}
afd_words %>% transmute(freq, fraktion_n = n) %>% left_join(all_words) %>% transmute(fraktion_freq = freq, total_freq = part, fraktion_n, total_n = n, rel_quotient = fraktion_freq/total_freq, abs_quotient = fraktion_n/total_n) %>% arrange(-abs_quotient, -fraktion_n) %>% filter(rel_quotient > 1) -> afd_high_frequent
select(afd_high_frequent, fraktion_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
afd_words %>% transmute(freq, fraction_n = n) %>% left_join(all_words) %>% transmute(fraction_freq = freq, total_freq = part, fraction_n, total_n = n, rel_quotient = fraction_freq/total_freq, abs_quotient = fraction_n/total_n) %>% arrange(-abs_quotient, -fraction_n) %>% filter(rel_quotient > 1) -> afd_high_frequent
select(afd_high_frequent, fraction_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
afdundfraktionslos_words %>% transmute(freq, fraktion_n = n) %>% left_join(all_words) %>% transmute(fraktion_freq = freq, total_freq = part, fraktion_n, total_n = n, rel_quotient = fraktion_freq/total_freq, abs_quotient = fraktion_n/total_n) %>% arrange(-abs_quotient, -fraktion_n) %>% filter(rel_quotient > 1) -> afdundfraktionslos_high_frequent
select(afdundfraktionslos_high_frequent, fraktion_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
afdundfraktionslos_words %>% transmute(freq, fraction_n = n) %>% left_join(all_words) %>% transmute(fraction_freq = freq, total_freq = part, fraction_n, total_n = n, rel_quotient = fraction_freq/total_freq, abs_quotient = fraction_n/total_n) %>% arrange(-abs_quotient, -fraction_n) %>% filter(rel_quotient > 1) -> afdundfraktionslos_high_frequent
select(afdundfraktionslos_high_frequent, fraction_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
grüne_words %>% transmute(freq, fraktion_n = n) %>% left_join(all_words) %>% transmute(fraktion_freq = freq, total_freq = part, fraktion_n, total_n = n, rel_quotient = fraktion_freq/total_freq, abs_quotient = fraktion_n/total_n) %>% arrange(-abs_quotient, -fraktion_n) %>% filter(rel_quotient > 1) -> grüne_high_frequent
select(grüne_high_frequent, fraktion_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
grüne_words %>% transmute(freq, fraction_n = n) %>% left_join(all_words) %>% transmute(fraction_freq = freq, total_freq = part, fraction_n, total_n = n, rel_quotient = fraction_freq/total_freq, abs_quotient = fraction_n/total_n) %>% arrange(-abs_quotient, -fraction_n) %>% filter(rel_quotient > 1) -> grüne_high_frequent
select(grüne_high_frequent, fraction_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
cdu_words %>% transmute(freq, fraktion_n = n) %>% left_join(all_words) %>% transmute(fraktion_freq = freq, total_freq = part, fraktion_n, total_n = n, rel_quotient = fraktion_freq/total_freq, abs_quotient = fraktion_n/total_n) %>% arrange(-abs_quotient, -fraktion_n) %>% filter(rel_quotient > 1) -> cdu_high_frequent
select(cdu_high_frequent, fraktion_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
cdu_words %>% transmute(freq, fraction_n = n) %>% left_join(all_words) %>% transmute(fraction_freq = freq, total_freq = part, fraction_n, total_n = n, rel_quotient = fraction_freq/total_freq, abs_quotient = fraction_n/total_n) %>% arrange(-abs_quotient, -fraction_n) %>% filter(rel_quotient > 1) -> cdu_high_frequent
select(cdu_high_frequent, fraction_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
linke_words %>% transmute(freq, fraktion_n = n) %>% left_join(all_words) %>% transmute(fraktion_freq = freq, total_freq = part, fraktion_n, total_n = n, rel_quotient = fraktion_freq/total_freq, abs_quotient = fraktion_n/total_n) %>% arrange(-abs_quotient, -fraktion_n) %>% filter(rel_quotient > 1) -> linke_high_frequent
select(linke_high_frequent, fraktion_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
linke_words %>% transmute(freq, fraction_n = n) %>% left_join(all_words) %>% transmute(fraction_freq = freq, total_freq = part, fraction_n, total_n = n, rel_quotient = fraction_freq/total_freq, abs_quotient = fraction_n/total_n) %>% arrange(-abs_quotient, -fraction_n) %>% filter(rel_quotient > 1) -> linke_high_frequent
select(linke_high_frequent, fraction_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
fdp_words %>% transmute(freq, fraktion_n = n) %>% left_join(all_words) %>% transmute(fraktion_freq = freq, total_freq = part, fraktion_n, total_n = n, rel_quotient = fraktion_freq/total_freq, abs_quotient = fraktion_n/total_n) %>% arrange(-abs_quotient, -fraktion_n) %>% filter(rel_quotient > 1) -> fdp_high_frequent
select(fdp_high_frequent, fraktion_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
fdp_words %>% transmute(freq, fraction_n = n) %>% left_join(all_words) %>% transmute(fraction_freq = freq, total_freq = part, fraction_n, total_n = n, rel_quotient = fraction_freq/total_freq, abs_quotient = fraction_n/total_n) %>% arrange(-abs_quotient, -fraction_n) %>% filter(rel_quotient > 1) -> fdp_high_frequent
select(fdp_high_frequent, fraction_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
fraktionslos_words %>% transmute(freq, fraktion_n = n) %>% left_join(all_words) %>% transmute(fraktion_freq = freq, total_freq = part, fraktion_n, total_n = n, rel_quotient = fraktion_freq/total_freq, abs_quotient = fraktion_n/total_n) %>% arrange(-abs_quotient, -fraktion_n) %>% filter(rel_quotient > 1) -> fraktionslos_high_frequent
select(fraktionslos_high_frequent, fraktion_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
fraktionslos_words %>% transmute(freq, fraction_n = n) %>% left_join(all_words) %>% transmute(fraction_freq = freq, total_freq = part, fraction_n, total_n = n, rel_quotient = fraction_freq/total_freq, abs_quotient = fraction_n/total_n) %>% arrange(-abs_quotient, -fraction_n) %>% filter(rel_quotient > 1) -> fraktionslos_high_frequent
select(fraktionslos_high_frequent, fraction_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
spd_words %>% transmute(freq, fraktion_n = n) %>% left_join(all_words) %>% transmute(fraktion_freq = freq, total_freq = part, fraktion_n, total_n = n, rel_quotient = fraktion_freq/total_freq, abs_quotient = fraktion_n/total_n) %>% arrange(-abs_quotient, -fraktion_n) %>% filter(rel_quotient > 1) -> spd_high_frequent
select(spd_high_frequent, fraktion_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
spd_words %>% transmute(freq, fraction_n = n) %>% left_join(all_words) %>% transmute(fraction_freq = freq, total_freq = part, fraction_n, total_n = n, rel_quotient = fraction_freq/total_freq, abs_quotient = fraction_n/total_n) %>% arrange(-abs_quotient, -fraction_n) %>% filter(rel_quotient > 1) -> spd_high_frequent
select(spd_high_frequent, fraction_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
na_words %>% transmute(freq, fraktion_n = n) %>% left_join(all_words) %>% transmute(fraktion_freq = freq, total_freq = part, fraktion_n, total_n = n, rel_quotient = fraktion_freq/total_freq, abs_quotient = fraktion_n/total_n) %>% arrange(-abs_quotient, -fraktion_n) %>% filter(rel_quotient > 1) -> na_high_frequent
select(na_high_frequent, fraktion_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
na_words %>% transmute(freq, fraction_n = n) %>% left_join(all_words) %>% transmute(fraction_freq = freq, total_freq = part, fraction_n, total_n = n, rel_quotient = fraction_freq/total_freq, abs_quotient = fraction_n/total_n) %>% arrange(-abs_quotient, -fraction_n) %>% filter(rel_quotient > 1) -> na_high_frequent
select(na_high_frequent, fraction_n, total_n, abs_quotient, rel_quotient) %>% filter(total_n > 80)
```
We compare these words with `hitlerwords`.
@@ -161,7 +161,7 @@ spd_high_frequent %>% mutate(Worte = str_to_lower(Worte)) %>% inner_join(hitlerw
na_high_frequent %>% mutate(Worte = str_to_lower(Worte)) %>% inner_join(hitlerwords) -> na_hitler_comparison
#not unique
tibble(fraktion = c("AfD", "AfD&Fraktionslos", "BÜNDNIS 90 / DIE GRÜNEN", "CDU/CSU", "DIE LINKE", "FDP", "Fraktionslos", "SPD"),
tibble(fraction = c("AfD", "AfD&Fraktionslos", "BÜNDNIS 90 / DIE GRÜNEN", "CDU/CSU", "DIE LINKE", "FDP", "Fraktionslos", "SPD"),
absolute = c(nrow(afd_hitler_comparison), nrow(afdundfraktionslos_hitler_comparison), nrow(grüne_hitler_comparison), nrow(cdu_hitler_comparison), nrow(linke_hitler_comparison), nrow(fdp_hitler_comparison), nrow(fraktionslos_hitler_comparison), nrow(spd_hitler_comparison)),
total = c(nrow(afd_words), nrow(afdundfraktionslos_words), nrow(grüne_words), nrow(cdu_words), nrow(linke_words), nrow(fdp_words), nrow(fraktionslos_words), nrow(spd_words))
) %>% mutate(percent = 100*absolute/total) -> hitler_comparison
@@ -169,5 +169,5 @@ hitler_comparison
```
Finally, we want to plot our results:
```{r, fig.width=7}
bar_plot_fraktionen(hitler_comparison, y_variable = percent, title="Coincidence of party vocabulary with nazi vocabulary", ylab="unique 'nazi' words per total (unique) fraction words [%]")
bar_plot_fractions(hitler_comparison, y_variable = percent, title="Coincidence of party vocabulary with nazi vocabulary", ylab="unique 'nazi' words per total (unique) fraction words [%]")
```