rename some columns to english

This commit is contained in:
2021-08-09 15:31:20 +02:00
parent b02ab91c31
commit 4649658fa7
4 changed files with 30 additions and 32 deletions
+19 -19
View File
@@ -39,7 +39,7 @@ read_all <- function(path="inst/records/") {
select(-type) -> select(-type) ->
comments comments
filter(commentsandapplause, type == "applause") %>% filter(commentsandapplause, type == "applause") %>%
select(-type, -kommentator, -content) %>% select(-type, -commenter, -content) %>%
mutate("CDU_CSU" = str_detect(fraction, "CDU/CSU"), mutate("CDU_CSU" = str_detect(fraction, "CDU/CSU"),
"SPD" = str_detect(fraction, "SPD"), "SPD" = str_detect(fraction, "SPD"),
"FDP" = str_detect(fraction, "FDP"), "FDP" = str_detect(fraction, "FDP"),
@@ -86,17 +86,17 @@ xml_get <- function(node, name) {
parse_speaker <- function(speaker_xml) { parse_speaker <- function(speaker_xml) {
speaker_id <- xml_attr(speaker_xml, "id") speaker_id <- xml_attr(speaker_xml, "id")
nm <- xml_child(speaker_xml) nm <- xml_child(speaker_xml)
vorname <- xml_get(nm, "vorname") prename <- xml_get(nm, "vorname")
nachname <- xml_get(nm, "nachname") lastname <- xml_get(nm, "nachname")
fraction <- xml_get(nm, "fraktion") fraction <- xml_get(nm, "fraktion")
titel <- xml_get(nm, "titel") title <- xml_get(nm, "titel")
rolle <- xml_find_all(nm, "rolle") role <- xml_find_all(nm, "rolle")
if (length(rolle) > 0) { if (length(role) > 0) {
rolle_lang <- xml_get(rolle, "rolle_lang") role_long <- xml_get(role, "rolle_lang")
rolle_kurz <- xml_get(rolle, "rolle_kurz") role_short <- xml_get(role, "rolle_kurz")
} else rolle_kurz <- rolle_lang <- NA_character_ } else role_short <- role_long <- NA_character_
c(id = speaker_id, vorname = vorname, nachname = nachname, fraction = fraction, titel = titel, c(id = speaker_id, prename = prename, lastname = lastname, fraction = fraction, title = title,
rolle_kurz = rolle_kurz, rolle_lang = rolle_lang) role_short = role_short, role_long = role_long)
} }
# parse one speech # parse one speech
@@ -165,10 +165,10 @@ parse_comment <- function(comment, speech_id, on_speaker) {
sapply(partial(flip(head), 1) %.% agrep, x=fractionnames, max=0.2, value=T) %>% sapply(partial(flip(head), 1) %.% agrep, x=fractionnames, max=0.2, value=T) %>%
str_c(collapse=",") -> str_c(collapse=",") ->
by by
c(base, type = "applause", fraction = by, kommentator = NA_character_, content = comment) c(base, type = "applause", fraction = by, commenter = NA_character_, content = comment)
} else { } else {
ps <- str_match(comment, "(.*) \\[(.*?)\\]: (.*)")[1,] ps <- str_match(comment, "(.*) \\[(.*?)\\]: (.*)")[1,]
c(base, type = "comment", fraction = ps[3], kommentator = ps[2], content = ps[4]) c(base, type = "comment", fraction = ps[3], commenter = ps[2], content = ps[4])
} }
} }
@@ -187,7 +187,7 @@ parse_speechlist <- function(speechlist_xml, date) {
on_speaker = comments["on_speaker",], on_speaker = comments["on_speaker",],
type = comments["type",], type = comments["type",],
fraction = comments["fraction",], fraction = comments["fraction",],
kommentator = comments["kommentator",], commenter = comments["commenter",],
content = comments["content", ])) content = comments["content", ]))
} }
@@ -195,12 +195,12 @@ parse_speechlist <- function(speechlist_xml, date) {
parse_speakerlist <- function(speakerliste_xml) { parse_speakerlist <- function(speakerliste_xml) {
d <- sapply(speakerliste_xml, parse_speaker) d <- sapply(speakerliste_xml, parse_speaker)
tibble(id = d["id",], tibble(id = d["id",],
vorname = d["vorname",], prename = d["prename",],
nachname = d["nachname",], lastname = d["lastname",],
fraction = d["fraction",], fraction = d["fraction",],
titel = d["titel",], title = d["title",],
rolle_kurz = d["rolle_kurz",], role_short = d["role_short",],
rolle_lang = d["rolle_lang",]) role_long = d["role_long",])
} }
#' Write the parsed and repaired results into separate csv files #' Write the parsed and repaired results into separate csv files
+10 -12
View File
@@ -29,15 +29,13 @@ repair_speaker <- function(speaker) {
filter(id != "10000") %>% # invalid id's filter(id != "10000") %>% # invalid id's
mutate(fraction = Vectorize(repair_fraction)(fraction)) %>% # fix fraction mutate(fraction = Vectorize(repair_fraction)(fraction)) %>% # fix fraction
group_by(id) %>% group_by(id) %>%
summarize(vorname = head(vorname, 1), summarize(prename = head(prename, 1),
nachname = head(nachname, 1), lastname = head(lastname, 1),
fraction = collect_unique(fraction), fraction = collect_unique(fraction),
titel = longest_titel(titel), title = longest_titel(title),
rolle_kurz = collect_unique(str_squish(rolle_kurz)), role_short = collect_unique(str_squish(role_short)),
rolle_lang = collect_unique(str_squish(rolle_lang))) %>% role_long = collect_unique(str_squish(role_long))) %>%
ungroup() #%>% ungroup() #%>%
# arrange(id) %>%
# distinct(vorname, nachname, fraction, titel)
} }
repair_speeches <- function(speeches) { repair_speeches <- function(speeches) {
@@ -68,7 +66,7 @@ repair_talks <- function(talks) {
lookup_speaker <- function(tb, speaker, name_variable) { lookup_speaker <- function(tb, speaker, name_variable) {
tobereplaced <- "[-–—‑­­-­­­ ]" tobereplaced <- "[-–—‑­­-­­­ ]"
speaker %>% speaker %>%
unite(name, vorname, nachname, sep=".*") %>% unite(name, prename, lastname, sep=".*") %>%
mutate(name = str_replace_all(name, tobereplaced, ".*")) -> mutate(name = str_replace_all(name, tobereplaced, ".*")) ->
rs rs
find_match <- function(komm) { find_match <- function(komm) {
@@ -88,10 +86,10 @@ repair_comments <- function(comments, speaker) {
"Use repair(, repair_commments = FALSE) to skip this.\n")) "Use repair(, repair_commments = FALSE) to skip this.\n"))
# try to find a speaker id for each actual comment # try to find a speaker id for each actual comment
comments %>% comments %>%
filter(!is.na(kommentator)) %>% filter(!is.na(commenter)) %>%
lookup_speaker(speaker, kommentator) %>% lookup_speaker(speaker, commenter) %>%
left_join(comments, ., by="kommentator") %>% left_join(comments, ., by="commenter") %>%
select(-kommentator) select(-commenter)
} }
#' Repair parsed tables #' Repair parsed tables
Binary file not shown.
+1 -1
View File
@@ -99,7 +99,7 @@ Funktion: \lstinline{fetch_all(download_dir)}
\begin{lstlisting}[language=R,basicstyle=\tiny\ttfamily] \begin{lstlisting}[language=R,basicstyle=\tiny\ttfamily]
> res$comments > res$comments
# A tibble: 83,649 x 5 # A tibble: 83,649 x 5
speech_id on_speaker fraction commentator content speech_id on_speaker fraction commenter content
<chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 ID19100300 11003218 BUENDNIS 90/D Katrin Goering Was? 1 ID19100300 11003218 BUENDNIS 90/D Katrin Goering Was?
2 ID19100300 11003218 CDU/CSU Volker Kauder Warum habt ihr das bei Ge 2 ID19100300 11003218 CDU/CSU Volker Kauder Warum habt ihr das bei Ge