Compare commits
3
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 christian
|
4649658fa7 | ||
|
christian
|
b02ab91c31 | ||
|
christian
|
03f8ca0813 |
@@ -39,7 +39,7 @@ read_all <- function(path="inst/records/") {
|
||||
select(-type) ->
|
||||
comments
|
||||
filter(commentsandapplause, type == "applause") %>%
|
||||
select(-type, -kommentator, -content) %>%
|
||||
select(-type, -commenter, -content) %>%
|
||||
mutate("CDU_CSU" = str_detect(fraction, "CDU/CSU"),
|
||||
"SPD" = str_detect(fraction, "SPD"),
|
||||
"FDP" = str_detect(fraction, "FDP"),
|
||||
@@ -86,17 +86,17 @@ xml_get <- function(node, name) {
|
||||
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")
|
||||
prename <- xml_get(nm, "vorname")
|
||||
lastname <- xml_get(nm, "nachname")
|
||||
fraction <- xml_get(nm, "fraktion")
|
||||
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 = speaker_id, vorname = vorname, nachname = nachname, fraction = fraction, titel = titel,
|
||||
rolle_kurz = rolle_kurz, rolle_lang = rolle_lang)
|
||||
title <- xml_get(nm, "titel")
|
||||
role <- xml_find_all(nm, "rolle")
|
||||
if (length(role) > 0) {
|
||||
role_long <- xml_get(role, "rolle_lang")
|
||||
role_short <- xml_get(role, "rolle_kurz")
|
||||
} else role_short <- role_long <- NA_character_
|
||||
c(id = speaker_id, prename = prename, lastname = lastname, fraction = fraction, title = title,
|
||||
role_short = role_short, role_long = role_long)
|
||||
}
|
||||
|
||||
# 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) %>%
|
||||
str_c(collapse=",") ->
|
||||
by
|
||||
c(base, type = "applause", fraction = by, kommentator = NA_character_, content = comment)
|
||||
c(base, type = "applause", fraction = by, commenter = NA_character_, content = comment)
|
||||
} else {
|
||||
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",],
|
||||
type = comments["type",],
|
||||
fraction = comments["fraction",],
|
||||
kommentator = comments["kommentator",],
|
||||
commenter = comments["commenter",],
|
||||
content = comments["content", ]))
|
||||
}
|
||||
|
||||
@@ -195,12 +195,12 @@ parse_speechlist <- function(speechlist_xml, date) {
|
||||
parse_speakerlist <- function(speakerliste_xml) {
|
||||
d <- sapply(speakerliste_xml, parse_speaker)
|
||||
tibble(id = d["id",],
|
||||
vorname = d["vorname",],
|
||||
nachname = d["nachname",],
|
||||
prename = d["prename",],
|
||||
lastname = d["lastname",],
|
||||
fraction = d["fraction",],
|
||||
titel = d["titel",],
|
||||
rolle_kurz = d["rolle_kurz",],
|
||||
rolle_lang = d["rolle_lang",])
|
||||
title = d["title",],
|
||||
role_short = d["role_short",],
|
||||
role_long = d["role_long",])
|
||||
}
|
||||
|
||||
#' Write the parsed and repaired results into separate csv files
|
||||
|
||||
+10
-12
@@ -29,15 +29,13 @@ repair_speaker <- function(speaker) {
|
||||
filter(id != "10000") %>% # invalid id's
|
||||
mutate(fraction = Vectorize(repair_fraction)(fraction)) %>% # fix fraction
|
||||
group_by(id) %>%
|
||||
summarize(vorname = head(vorname, 1),
|
||||
nachname = head(nachname, 1),
|
||||
summarize(prename = head(prename, 1),
|
||||
lastname = head(lastname, 1),
|
||||
fraction = collect_unique(fraction),
|
||||
titel = longest_titel(titel),
|
||||
rolle_kurz = collect_unique(str_squish(rolle_kurz)),
|
||||
rolle_lang = collect_unique(str_squish(rolle_lang))) %>%
|
||||
title = longest_titel(title),
|
||||
role_short = collect_unique(str_squish(role_short)),
|
||||
role_long = collect_unique(str_squish(role_long))) %>%
|
||||
ungroup() #%>%
|
||||
# arrange(id) %>%
|
||||
# distinct(vorname, nachname, fraction, titel)
|
||||
}
|
||||
|
||||
repair_speeches <- function(speeches) {
|
||||
@@ -68,7 +66,7 @@ repair_talks <- function(talks) {
|
||||
lookup_speaker <- function(tb, speaker, name_variable) {
|
||||
tobereplaced <- "[-–—‑- ]"
|
||||
speaker %>%
|
||||
unite(name, vorname, nachname, sep=".*") %>%
|
||||
unite(name, prename, lastname, sep=".*") %>%
|
||||
mutate(name = str_replace_all(name, tobereplaced, ".*")) ->
|
||||
rs
|
||||
find_match <- function(komm) {
|
||||
@@ -88,10 +86,10 @@ repair_comments <- function(comments, speaker) {
|
||||
"Use repair(, repair_commments = FALSE) to skip this.\n"))
|
||||
# try to find a speaker id for each actual comment
|
||||
comments %>%
|
||||
filter(!is.na(kommentator)) %>%
|
||||
lookup_speaker(speaker, kommentator) %>%
|
||||
left_join(comments, ., by="kommentator") %>%
|
||||
select(-kommentator)
|
||||
filter(!is.na(commenter)) %>%
|
||||
lookup_speaker(speaker, commenter) %>%
|
||||
left_join(comments, ., by="commenter") %>%
|
||||
select(-commenter)
|
||||
}
|
||||
|
||||
#' Repair parsed tables
|
||||
|
||||
Binary file not shown.
@@ -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}
|
||||
Reference in New Issue
Block a user