3 Commits
4 changed files with 200 additions and 31 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.
+171
View File
@@ -0,0 +1,171 @@
\documentclass{beamer}
\usepackage[utf8]{inputenc}
\usepackage{listings}
\lstdefinestyle{mystyle}{
commentstyle=\color{gray},
keywordstyle=\color{black},
numberstyle=\tiny\color{gray},
stringstyle=\color{black},
basicstyle=\ttfamily\footnotesize,
breakatwhitespace=false,
breaklines=true,
captionpos=b,
keepspaces=true,
numbers=left,
numbersep=5pt,
showspaces=false,
showstringspaces=false,
showtabs=false,
tabsize=2
}
\lstset{style=mystyle}
\begin{document}
\begin{frame}
\frametitle{Implementierung}
\tableofcontents
\end{frame}
\section{Herunterladen der Protokolle}
\begin{frame}
\frametitle{Herunterladen der Protokolle}
Funktion: \lstinline{fetch_all(download_dir)}
\begin{itemize}[<+->]
\item Protokolle als XML-Dateien von \url{bundestag.de} herunterladen und
in \lstinline{download_dir} speichern.
\item Problem: Maschinenunfreundliche Webseite
\item Lösung: Source Code von \url{bundestag.de} nach Schnittstelle durchsuchen
\end{itemize}
\end{frame}
\section{Konvertierung der XML-Dateien in tibbles}
\begin{frame}
\frametitle{Konvertierung der XML-Dateien in tibbles}
Funktion: \lstinline{read_all(filepath)}
\begin{itemize}[<+->]
\item Liest jede XML-Datei in angegebenem Dateipfad einzeln
\item Extrahiert Sitzungsdatum, Rednerliste und Sitzungsverlauf
\item Konvertiert Rednerliste in eine R Liste.
\item Iteriert durch den Sitzungsverlauf, extrahiert Reden,
Redebeiträge, Kommentare und Beifall
\item Kombiniert alle Redner, Reden, Redebeiträge, Kommentare und Beifall
zu 5 tibbles und gibt benannte Liste zurück.
\end{itemize}
\end{frame}
\begin{frame}[fragile]
\frametitle{Tabellen}
Ergebnis der Konvertierung ist eine benannte Liste \lstinline{res} mit tibbles:
\pause
\begin{lstlisting}[language=R,basicstyle=\tiny\ttfamily]
> res$speaker
# A tibble: 1,025 x 7
id prename lastname fraction title role_short role_long
<chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 110021 Alterspraesident D Otto Solms NA NA Alterspraesi Alterspraesi
2 110032 Carsten Schneider SPD NA NA NA
# with 1,023 more rows
\end{lstlisting}
\pause
\begin{lstlisting}[language=R,basicstyle=\tiny\ttfamily]
> res$speeches
# A tibble: 25,068 x 3
id speaker date
<chr> <chr> <date>
1 ID19100100 11002190 2017-10-24
2 ID19100200 11002190 2017-10-24
# with 25,066 more rows
\end{lstlisting}
\pause
\begin{lstlisting}[language=R,basicstyle=\tiny\ttfamily]
> res$talks
# A tibble: 63,663 x 3
speech_id speaker content
<chr> <chr> <chr>
1 ID19100100 11002190 "Guten Morgen, liebe Kolleginnen und Kollegen! Nehmen Sie
2 ID19100300 11003218 "Sehr geehrter Herr Praesident! Sehr geehrte Kolleginnen u
# with 63,661 more rows
\end{lstlisting}
\end{frame}
\begin{frame}[fragile]
\begin{lstlisting}[language=R,basicstyle=\tiny\ttfamily]
> res$comments
# A tibble: 83,649 x 5
speech_id on_speaker fraction commenter content
<chr> <chr> <chr> <chr> <chr>
1 ID19100300 11003218 BUENDNIS 90/D Katrin Goering Was?
2 ID19100300 11003218 CDU/CSU Volker Kauder Warum habt ihr das bei Ge
# with 83,647 more rows
\end{lstlisting}
\pause
\begin{lstlisting}[language=R,basicstyle=\tiny\ttfamily]
> res$applause
# A tibble: 89,586 x 8
speech_id on_speaker CDU_CSU SPD FDP DIE_LINKE BUENDNIS_90_DIE_GRU AfD
<chr> <chr> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl>
1 ID19100300 11003218 FALSE TRUE FALSE TRUE TRUE FALSE
2 ID19100300 11003218 FALSE TRUE TRUE TRUE FALSE FALSE
# with 89,584 more rows\end{lstlisting}
\end{frame}
\section{Reparieren von Fehlern}
\begin{frame}
\frametitle{Reparieren von Fehlern}
Problem: Uneinheitliche Schreibweisen / Fehler in den Rednerlisten.
\pause
Lösung: Funktion: \lstinline{repair_speaker(speakers)}
\pause
\begin{itemize}[<+->]
\item Erhält \lstinline{tibble} von Rednern
\item Entfernt Redner mit ungültigen, doppelt vergebenen IDs
\item Vereinheitlicht Schreibweisen der Fraktionen, Namen und Titel der Redner
\end{itemize}
\end{frame}
\begin{frame}
\frametitle{Reparieren von Fehlern}
Problem: Namen in Kommentaren Rednern aus Rednertabelle zuordnen
\pause
Lösung: Funktion \lstinline{repair_comments(comments, speakers)}
\begin{itemize}
\item Erstellt für jeden Redner einen Regulären Ausdruck aus dem Namen
\item Sucht für jeden Kommentar nach dem entsprechenden Eintrag in der
Rednertabelle
\end{itemize}
\end{frame}
\begin{frame}
\frametitle{Reparieren von Fehlern}
Beide Reparaturschritte werden in der Funktion \lstinline{repair} zusammengefasst.
\end{frame}
\section{Analyse}
\begin{frame}
\frametitle{Analyse}
Stelle Hilfsfunktionen zur Analyse der Daten zur Verfügung:
\begin{itemize}[<+->]
\item \lstinline{bar_plot_fractions}: Erstellt ein Balkendiagramm aus einer Tabelle
mit Fraktionsdaten
\item \lstinline{find_word}: Fügt in der Redebeiträgetabelle zu jedem Redebeitrag
die Häufigkeit eines Regulären Ausdrucks hinzu.
\item \lstinline{word_usage_by_date}: Zählt an welchen Daten (Tagen) ein regulärer Ausdruck
wie oft verwendet wird.
\item \lstinline{join_speaker}: Fügt einer Tabelle mit Spalte \lstinline{speaker} die
enstprechenden Informationen aus der Rednertabelle hinzu.
\end{itemize}
\end{frame}
\end{document}