improve comment parsing and add comment commentator redner matching

R/repair.R

@@ -24,12 +24,19 @@ collect_unique <- function(xs) xs %>% clear_na() %>% unique() %>% str_c(collapse
 # expects a tibble of redner and repairs
 repair_redner <- function(redner) {
     if (nrow(redner) == 0) return(redner)
-    redner %>% mutate(fraktion = Vectorize(repair_fraktion)(fraktion)) %>% # fix fraktion
-        group_by(id, vorname, nachname) %>%
-        summarize(fraktion = collect_unique(fraktion),
+    redner %>%
+        filter(id != "10000") %>% # invalid id's
+        mutate(fraktion = Vectorize(repair_fraktion)(fraktion)) %>% # fix fraktion
+        group_by(id) %>%
+        summarize(vorname = head(vorname, 1),
+                  nachname = head(nachname, 1),
+                  fraktion = collect_unique(fraktion),
                   titel = longest_titel(titel),
                   rolle_kurz = collect_unique(str_squish(rolle_kurz)),
-                  rolle_lang = collect_unique(str_squish(rolle_lang)))
+                  rolle_lang = collect_unique(str_squish(rolle_lang))) %>%
+        ungroup() #%>%
+        # arrange(id) %>%
+        # distinct(vorname, nachname, fraktion, titel)
 }
 
 repair_reden <- function(reden) {
@@ -44,6 +51,37 @@ repair_talks <- function(talks) {
     talks
 }
 
+# tries to find the correct redner id given a name
+# this is sufficient since every prename lastname combination in the bundestag is
+# unique (luckily :D)
+# returns a lookup table
+lookup_redner <- function(comments, redner) {
+    tobereplaced <- "[-–—‑­­-­­­ ]"
+    redner %>%
+        unite(name, vorname, nachname, sep=".*") %>%
+        mutate(name = str_replace_all(name, tobereplaced, ".*")) ->
+        rs
+    find_match <- function(komm) {
+        if (komm == "") return (NA_character_)
+        # I tried with agrep (levensthein distance) but results are better that way
+        matches <- str_which(komm, rs$name)
+        if (length(matches) == 0) return(NA_character_)
+        rs[head(matches, 1), ]$id
+    }
+    comments %>%
+        distinct(kommentator) %>%
+        mutate(redner = Vectorize(find_match)(str_replace_all(kommentator, tobereplaced, "")))
+}
+
+repair_comments <- function(comments, redner) {
+    # try to find a redner id for each actual comment
+    comments %>%
+        filter(!is.na(kommentator)) %>%
+        lookup_redner(redner) %>%
+        left_join(comments, ., by="kommentator") %>%
+        select(-kommentator)
+}
+
 #' Repair parsed tables
 #'
 #' @export