change spelling of greens fraction, fix parsing issue in comments table

R/parse.R

@@ -173,7 +173,8 @@ parse_speech <- function(speech_xml, date) {
 }
 
 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")
+fractionnames <- c("BÜNDNIS 90/DIE GRÜNEN", "CDU/CSU", "AfD", "SPD", "DIE LINKE", "FDP",
+                   "Fraktionslos")
 
 parse_comment <- function(comment, speech_id, on_speaker) {
     base <- c(speech_id = speech_id, on_speaker = on_speaker)
@@ -187,7 +188,9 @@ parse_comment <- function(comment, speech_id, on_speaker) {
         c(base, type = "applause", fraction = by, commenter = NA_character_, content = comment)
     } else {
         ps <- str_match(comment, "(.*) \\[(.*?)\\]: (.*)")[1,]
-        c(base, type = "comment", fraction = ps[3], commenter = ps[2], content = ps[4])
+        fraction <- agrep(ps[3], fractionnames, max=0.2, value=T)
+        if (all(is.na(fraction)) || length(fraction) == 0) fraction <- NA_character_
+        c(base, type = "comment", fraction = fraction, commenter = ps[2], content = ps[4])
     }
 }
 

R/repair.R

@@ -81,35 +81,39 @@ lookup_speaker <- function(tb, speaker, name_variable) {
         mutate(speaker = Vectorize(find_match)(str_replace_all({{name_variable}}, tobereplaced, "")))
 }
 
-repair_comments <- function(comments, speaker) {
-    cat(paste0("Looking up speaker id's for names in comments. This may take a while ...\n",
-               "Use repair(, repair_commments = FALSE) to skip this.\n"))
-    # try to find a speaker id for each actual comment
+repair_comments <- function(comments, speaker, lookup_speaker=F) {
     comments %>%
+        filter(!is.na(commenter) | !is.na(content) | !is.na(fraction)) ->
+        tb
+    if (lookup_speaker) {
+        cat(paste0("Looking up speaker id's for names in comments. This may take a while ...\n",
+                   "Use repair(, lookup_speaker = FALSE) to skip this.\n"))
+        # try to find a speaker id for each actual comment
+        tb %>%
             filter(!is.na(commenter)) %>%
             lookup_speaker(speaker, commenter) %>%
-        left_join(comments, ., by="commenter") %>%
-        select(-commenter)
+            left_join(tb, ., by="commenter")
+    } else tb
 }
 
 #' Repair parsed tables
 #'
 #' @param parse_output tibble
-#' @param repair_comments bool
+#' @param lookup_speaker bool
 #' 
-#' If repair_comments is TRUE, members of the parliament mentioned in comments are looked up in speaker table.
+#' If lookup_speaker is TRUE, members of the parliament mentioned in comments are looked up in speaker table.
 #'
 #' Possible test: check identical(repair(res), repair(repair(res))) == TRUE
 #' Since repaired tables should be a fixpoint of repair.
 #' @export
-repair <- function(parse_output, repair_comments = FALSE) {
-
+repair <- function(parse_output, lookup_speaker = FALSE) {
+    is_valid_res(parse_output)
+    stopifnot("lookup_speaker must be of type logical" = is.logical(lookup_speaker))
     list(speaker = repair_speaker(parse_output$speaker),
          speeches = repair_speeches(parse_output$speeches),
          talks = repair_talks(parse_output$talks),
-         comments = if(repair_comments) repair_comments(parse_output$comments,
-                                                        parse_output$speaker)
-                    else parse_output$comments,
-         applause = parse_output$applause
-         )
+         comments = repair_comments(parse_output$comments,
+                                    parse_output$speaker,
+                                    lookup_speaker),
+         applause = parse_output$applause)
 }