4 Commits
32 changed files with 160 additions and 95 deletions
+4 -4
View File
@@ -1,10 +1,10 @@
*.xml *.xml
/doc/ /doc/
/Meta/ /Meta/
/reports/ /inst/reports/
!/reports/*.pdf !/inst/reports/*.pdf
!/reports/*.tex !/inst/reports/*.tex
/csv/* /data/csv/*
/parlament_49_53_texts/ /parlament_49_53_texts/
.Rproj.user .Rproj.user
*.Rproj *.Rproj
+41 -20
View File
@@ -1,17 +1,30 @@
#' Count number of occurences of a given word
#'
#' @param res tibble
#' @param word character
#'
#' Add number of occurences of word to talks
#'
#' @export #' @export
find_word <- function(res, word) { find_word <- function(res, word) {
talks <- res$talks talks <- res$talks
mutate(talks, occurences = sapply(str_match_all(talks$content, regex(word, ignore_case = TRUE)), mutate(
nrow)) talks,
occurences = sapply(
str_match_all(talks$content, regex(word, ignore_case = TRUE)),
nrow
)
)
} }
#'Assign speaker-name to speaker-ID #' add information from speaker table to a tibble containing speaker id
#'
#' Assign speaker-name to speaker-ID.
#' #'
#' @param tb tibble #' @param tb tibble
#' @param res list of tibbles #' @param res list of tibbles
#' @param fraction_only If TRUE select only from "fraction" #' @param fraction_only if TRUE, only select fraction from the resulting joined tibble
#'
#' left join speaker information from res$speaker into tb.
#' if fraction_only
#' #'
#' @export #' @export
join_speaker <- function(tb, res, fraction_only = F) { join_speaker <- function(tb, res, fraction_only = F) {
@@ -20,7 +33,7 @@ join_speaker <- function(tb, res, fraction_only = F) {
else joined else joined
} }
#'Assignment of the official colors to the parties #' lookup table for official party colors
#' #'
#' @export #' @export
party_colors <- c( party_colors <- c(
@@ -38,20 +51,28 @@ party_order <- factor(c("Fraktionslos", "AfD&Fraktionslos",
"DIE LINKE", "BÜNDNIS 90 / DIE GRÜNEN", "SPD", "CDU/CSU", "DIE LINKE", "BÜNDNIS 90 / DIE GRÜNEN", "SPD", "CDU/CSU",
"FDP", "AfD", NA_character_)) "FDP", "AfD", NA_character_))
#'Bar chart of the fractions #' Bar chart visualizing fraction based data
#' #'
#' @param tb The tibble to be analyzed. #' Can be configured to also visualize data not related to fractions.
#' @param x_variable Default is fraction. #'
#' @param y_variable Default is n. #' @param tb tibble
#' @param fill Default is fraction. #' @param x_variable column in tb, default is fraction
#' @param title Title of the chart. #' @param y_variable column in tb, default is n
#' @param xlab Description of x-Lab. Default is Fraction. #' @param fill column in tb, default is fraction
#' @param ylab Description of y-Lab. Default is n. #' @param title plot title
#' @param filllab Default is Fraction. #' @param xlab label for x axis, default is fraction
#' @param flipped Default is TRUE. If TRUE draw bars horizontally, else vertically. #' @param ylab label for y axis, default is n
#' @param position Default is dodge. #' @param filllab default is 'Fraction'
#' @param flipped if TRUE draw bars horizontally, else vertically. Default is TRUE
#' @param position default is 'dodge'
#' @param reorder Either reorder fraction factor by variable value or reorder fraction factor by party seat order in parliament (default). #' @param reorder Either reorder fraction factor by variable value or reorder fraction factor by party seat order in parliament (default).
#' #'
#' plot data from tb in the following way: for each item in x_variable show the corresponding value in y_variable.
#' Then color the plot depending on the fill value.
#' Give the plot a title and a label for x-axis and y-axis,
#' color the legend according to filllab and finally
#' improve positioning details according to position
#'
#' @export #' @export
bar_plot_fractions <- function(tb, bar_plot_fractions <- function(tb,
x_variable = NULL, # default is fraction x_variable = NULL, # default is fraction
@@ -95,14 +116,14 @@ bar_plot_fractions <- function(tb,
if (flipped) plt + coord_flip() else plt if (flipped) plt + coord_flip() else plt
} }
#'Word usage summarised by date #' Word usage summarised by date
#' #'
#' Counts how many talks do match a given pattern and summarises by date. #' Counts how many talks do match a given pattern and summarises by date.
#' #'
#' @param res List of Tibbles to be analysed. #' @param res List of Tibbles to be analysed.
#' @param patterns Words to look up. #' @param patterns Words to look up.
#' @param name ? #' @param name ?
#' @param tidy Default is FALSE. #' @param tidy default is FALSE.
#' #'
#' @export #' @export
word_usage_by_date <- function(res, patterns, name, tidy=F) { word_usage_by_date <- function(res, patterns, name, tidy=F) {
+4 -1
View File
@@ -36,9 +36,12 @@ fetch_batch <- function(offset, download_dir) {
#' This fetches all available records of the 19th legislative period of the german Bundestag. #' This fetches all available records of the 19th legislative period of the german Bundestag.
#' #'
#' @param download_dir character #' @param download_dir character
#' @param create bool
#'
#' if create is TRUE, the directory given in download_dir is created
#' #'
#' @export #' @export
fetch_all <- function(download_dir="records/", create=FALSE) { fetch_all <- function(download_dir="data/records/", create=FALSE) {
# check if download_dir path is a directory path # check if download_dir path is a directory path
if (str_sub(download_dir, -1) != .Platform$file.sep) if (str_sub(download_dir, -1) != .Platform$file.sep)
download_dir <- str_c(download_dir, .Platform$file.sep) download_dir <- str_c(download_dir, .Platform$file.sep)
+14 -13
View File
@@ -8,7 +8,7 @@
#' @param path character #' @param path character
#' #'
#' @export #' @export
read_all <- function(path="records/") { read_all <- function(path="data/records/") {
cat("Reading all records from", path, "\n") cat("Reading all records from", path, "\n")
available_protocols <- list.files(path) available_protocols <- list.files(path)
res <- pblapply(available_protocols, read_one, path=path) res <- pblapply(available_protocols, read_one, path=path)
@@ -90,7 +90,7 @@ parse_speaker <- function(speaker_xml) {
nm <- xml_child(speaker_xml) nm <- xml_child(speaker_xml)
vorname <- xml_get(nm, "vorname") vorname <- xml_get(nm, "vorname")
nachname <- xml_get(nm, "nachname") nachname <- xml_get(nm, "nachname")
fraction <- xml_get(nm, "fraction") fraction <- xml_get(nm, "fraktion")
titel <- xml_get(nm, "titel") titel <- xml_get(nm, "titel")
rolle <- xml_find_all(nm, "rolle") rolle <- xml_find_all(nm, "rolle")
if (length(rolle) > 0) { if (length(rolle) > 0) {
@@ -115,7 +115,7 @@ parse_speech <- function(speech_xml, date) {
for (node in cs) { for (node in cs) {
if (xml_name(node) == "p" || xml_name(node) == "name") { if (xml_name(node) == "p" || xml_name(node) == "name") {
klasse <- xml_attr(node, "klasse") klasse <- xml_attr(node, "klasse")
if ((!is.na(klasse) && klasse == "speaker") || xml_name(node) == "name") { if ((!is.na(klasse) && klasse == "redner") || xml_name(node) == "name") {
if (!is.na(cur_speaker)) { if (!is.na(cur_speaker)) {
speech <- c(speech_id = speech_id, speech <- c(speech_id = speech_id,
speaker = cur_speaker, speaker = cur_speaker,
@@ -205,16 +205,14 @@ parse_speakerlist <- function(speakerliste_xml) {
rolle_lang = d["rolle_lang",]) rolle_lang = d["rolle_lang",])
} }
#' Write to CSV-Document #' Write the parsed and repaired results into separate csv files
#' #'
#' Put all tables from the entered list in separate CSV documents. #' @param tables list of tables to convert into a csv files.
#' #' @param path where to put the csv files.
#' @param tables The List of Tables you want to convert into a CSV-Document. #' @param create set TRUE if the path does not exist yet and you want to create it
#' @param path The path where to put the CSV-Document.
#' @param create Set TRUE if the path does not exist yet and you want to create it.
#' #'
#' @export #' @export
write_to_csv <- function(tables, path="csv/", create=F) { write_to_csv <- function(tables, path="data/csv/", create=F) {
check_directory(path, create) check_directory(path, create)
write.table(tables$speaker, str_c(path, "speaker.csv")) write.table(tables$speaker, str_c(path, "speaker.csv"))
write.table(tables$speeches, str_c(path, "speeches.csv")) write.table(tables$speeches, str_c(path, "speeches.csv"))
@@ -223,12 +221,15 @@ write_to_csv <- function(tables, path="csv/", create=F) {
write.table(tables$applause, str_c(path, "applause.csv")) write.table(tables$applause, str_c(path, "applause.csv"))
} }
#'Create a Tibble out of the CSV-Document
#' create a tibble from the csv file
#' #'
#'@param path The path that shows which Documents you want to use. #' @param path directory to read files from
#'
#' reading the tables from a csv is way faster than reading and repairing the data every single time
#' #'
#' @export #' @export
read_from_csv <- function(path="csv/") { read_from_csv <- function(path="data/csv/") {
list(speaker = read.table(str_c(path, "speaker.csv")) %>% list(speaker = read.table(str_c(path, "speaker.csv")) %>%
tibble() %>% tibble() %>%
mutate(id = as.character(id)), mutate(id = as.character(id)),
+10 -8
View File
@@ -59,7 +59,7 @@ repair_talks <- function(talks) {
#' unique (luckily :D) #' unique (luckily :D)
#' #'
#' @param tb tibble #' @param tb tibble
#' @param redner tibble #' @param speaker tibble
#' @param name_variable name #' @param name_variable name
#' #'
#' Tries to match the name_variable column with speaker names #' Tries to match the name_variable column with speaker names
@@ -83,29 +83,31 @@ lookup_speaker <- function(tb, speaker, name_variable) {
mutate(speaker = Vectorize(find_match)(str_replace_all({{name_variable}}, tobereplaced, ""))) mutate(speaker = Vectorize(find_match)(str_replace_all({{name_variable}}, tobereplaced, "")))
} }
repair_comments <- function(comments, redner) { repair_comments <- function(comments, speaker) {
cat(paste0("Looking up speaker id's for names in comments. This may take a while ...\n", 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")) "Use repair(, repair_commments = FALSE) to skip this.\n"))
# try to find a redner id for each actual comment # try to find a speaker id for each actual comment
comments %>% comments %>%
filter(!is.na(kommentator)) %>% filter(!is.na(kommentator)) %>%
lookup_redner(redner, kommentator) %>% lookup_speaker(speaker, kommentator) %>%
left_join(comments, ., by="kommentator") %>% left_join(comments, ., by="kommentator") %>%
select(-kommentator) select(-kommentator)
} }
#' Repair parsed tables #' Repair parsed tables
#' #'
#' TODO: Explain repair_comments argument #' @param parse_output tibble
#' (if TRUE, we try to lookup redner names in redner table) #' @param repair_comments bool
#'
#' If repair_comments 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 #' Possible test: check identical(repair(res), repair(repair(res))) == TRUE
#' Since repaired tables should be a fixpoint of repair. #' Since repaired tables should be a fixpoint of repair.
#' @export #' @export
repair <- function(parse_output, repair_comments = FALSE) { repair <- function(parse_output, repair_comments = FALSE) {
list(redner = repair_speaker(parse_output$speaker), list(speaker = repair_speaker(parse_output$speaker),
reden = repair_speeches(parse_output$speeches), speeches = repair_speeches(parse_output$speeches),
talks = repair_talks(parse_output$talks), talks = repair_talks(parse_output$talks),
comments = if(repair_comments) repair_comments(parse_output$comments, comments = if(repair_comments) repair_comments(parse_output$comments,
parse_output$speaker) parse_output$speaker)
+19 -13
View File
@@ -2,7 +2,7 @@
% Please edit documentation in R/analyze.R % Please edit documentation in R/analyze.R
\name{bar_plot_fractions} \name{bar_plot_fractions}
\alias{bar_plot_fractions} \alias{bar_plot_fractions}
\title{Bar chart of the fractions} \title{Bar chart visualizing fraction based data}
\usage{ \usage{
bar_plot_fractions( bar_plot_fractions(
tb, tb,
@@ -19,28 +19,34 @@ bar_plot_fractions(
) )
} }
\arguments{ \arguments{
\item{tb}{The tibble to be analyzed.} \item{tb}{tibble}
\item{x_variable}{Default is fraction.} \item{x_variable}{column in tb, default is fraction}
\item{y_variable}{Default is n.} \item{y_variable}{column in tb, default is n}
\item{fill}{Default is fraction.} \item{fill}{column in tb, default is fraction}
\item{title}{Title of the chart.} \item{title}{plot title}
\item{xlab}{Description of x-Lab. Default is Fraction.} \item{xlab}{label for x axis, default is fraction}
\item{ylab}{Description of y-Lab. Default is n.} \item{ylab}{label for y axis, default is n}
\item{filllab}{Default is Fraction.} \item{filllab}{default is 'Fraction'}
\item{flipped}{Default is TRUE. If TRUE draw bars horizontally, else vertically.} \item{flipped}{if TRUE draw bars horizontally, else vertically. Default is TRUE}
\item{position}{Default is dodge.} \item{position}{default is 'dodge'}
\item{reorder}{Either reorder fraction factor by variable value or reorder fraction factor by party seat order in parliament (default).} \item{reorder}{Either reorder fraction factor by variable value or reorder fraction factor by party seat order in parliament (default).
plot data from tb in the following way: for each item in x_variable show the corresponding value in y_variable.
Then color the plot depending on the fill value.
Give the plot a title and a label for x-axis and y-axis,
color the legend according to filllab and finally
improve positioning details according to position}
} }
\description{ \description{
Bar chart of the fractions Can be configured to also visualize data not related to fractions.
} }
+5 -1
View File
@@ -4,10 +4,14 @@
\alias{fetch_all} \alias{fetch_all}
\title{Download available records} \title{Download available records}
\usage{ \usage{
fetch_all(download_dir = "records/", create = FALSE) fetch_all(download_dir = "data/records/", create = FALSE)
} }
\arguments{ \arguments{
\item{download_dir}{character} \item{download_dir}{character}
\item{create}{bool
if create is TRUE, the directory given in download_dir is created}
} }
\description{ \description{
This fetches all available records of the 19th legislative period of the german Bundestag. This fetches all available records of the 19th legislative period of the german Bundestag.
+18
View File
@@ -0,0 +1,18 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/analyze.R
\name{find_word}
\alias{find_word}
\title{Count number of occurences of a given word}
\usage{
find_word(res, word)
}
\arguments{
\item{res}{tibble}
\item{word}{character
Add number of occurences of word to talks}
}
\description{
Count number of occurences of a given word
}
+6 -3
View File
@@ -2,7 +2,7 @@
% Please edit documentation in R/analyze.R % Please edit documentation in R/analyze.R
\name{join_speaker} \name{join_speaker}
\alias{join_speaker} \alias{join_speaker}
\title{Assign speaker-name to speaker-ID} \title{add information from speaker table to a tibble containing speaker id}
\usage{ \usage{
join_speaker(tb, res, fraction_only = F) join_speaker(tb, res, fraction_only = F)
} }
@@ -11,8 +11,11 @@ join_speaker(tb, res, fraction_only = F)
\item{res}{list of tibbles} \item{res}{list of tibbles}
\item{fraction_only}{If TRUE select only from "fraction"} \item{fraction_only}{if TRUE, only select fraction from the resulting joined tibble
left join speaker information from res$speaker into tb.
if fraction_only}
} }
\description{ \description{
Assign speaker-name to speaker-ID. add information from speaker table to a tibble containing speaker id
} }
+2 -2
View File
@@ -9,13 +9,13 @@ lookup_speaker(tb, speaker, name_variable)
\arguments{ \arguments{
\item{tb}{tibble} \item{tb}{tibble}
\item{speaker}{tibble}
\item{name_variable}{name \item{name_variable}{name
Tries to match the name_variable column with speaker names Tries to match the name_variable column with speaker names
returns a lookup table} returns a lookup table}
\item{redner}{tibble}
} }
\description{ \description{
Tries to find the correct speaker id given a name. Tries to find the correct speaker id given a name.
+2 -2
View File
@@ -3,7 +3,7 @@
\docType{data} \docType{data}
\name{party_colors} \name{party_colors}
\alias{party_colors} \alias{party_colors}
\title{Assignment of the official colors to the parties} \title{lookup table for official party colors}
\format{ \format{
An object of class \code{character} of length 8. An object of class \code{character} of length 8.
} }
@@ -11,6 +11,6 @@ An object of class \code{character} of length 8.
party_colors party_colors
} }
\description{ \description{
Assignment of the official colors to the parties lookup table for official party colors
} }
\keyword{datasets} \keyword{datasets}
+1 -1
View File
@@ -4,7 +4,7 @@
\alias{read_all} \alias{read_all}
\title{Parse xml records} \title{Parse xml records}
\usage{ \usage{
read_all(path = "records/") read_all(path = "data/records/")
} }
\arguments{ \arguments{
\item{path}{character} \item{path}{character}
+6 -4
View File
@@ -2,13 +2,15 @@
% Please edit documentation in R/parse.R % Please edit documentation in R/parse.R
\name{read_from_csv} \name{read_from_csv}
\alias{read_from_csv} \alias{read_from_csv}
\title{Create a Tibble out of the CSV-Document} \title{create a tibble from the csv file}
\usage{ \usage{
read_from_csv(path = "csv/") read_from_csv(path = "data/csv/")
} }
\arguments{ \arguments{
\item{path}{The path that shows which Documents you want to use.} \item{path}{directory to read files from
reading the tables from a csv is way faster than reading and repairing the data every single time}
} }
\description{ \description{
Create a Tibble out of the CSV-Document create a tibble from the csv file
} }
+11 -6
View File
@@ -6,11 +6,16 @@
\usage{ \usage{
repair(parse_output, repair_comments = FALSE) repair(parse_output, repair_comments = FALSE)
} }
\description{ \arguments{
TODO: Explain repair_comments argument \item{parse_output}{tibble}
(if TRUE, we try to lookup redner names in redner table)
} \item{repair_comments}{bool
\details{
If repair_comments 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 Possible test: check identical(repair(res), repair(repair(res))) == TRUE
Since repaired tables should be a fixpoint of repair. Since repaired tables should be a fixpoint of repair.}
}
\description{
Repair parsed tables
} }
+1 -1
View File
@@ -13,7 +13,7 @@ word_usage_by_date(res, patterns, name, tidy = F)
\item{name}{?} \item{name}{?}
\item{tidy}{Default is FALSE.} \item{tidy}{default is FALSE.}
} }
\description{ \description{
Counts how many talks do match a given pattern and summarises by date. Counts how many talks do match a given pattern and summarises by date.
+6 -6
View File
@@ -2,17 +2,17 @@
% Please edit documentation in R/parse.R % Please edit documentation in R/parse.R
\name{write_to_csv} \name{write_to_csv}
\alias{write_to_csv} \alias{write_to_csv}
\title{Write to CSV-Document} \title{Write the parsed and repaired results into separate csv files}
\usage{ \usage{
write_to_csv(tables, path = "csv/", create = F) write_to_csv(tables, path = "data/csv/", create = F)
} }
\arguments{ \arguments{
\item{tables}{The List of Tables you want to convert into a CSV-Document.} \item{tables}{list of tables to convert into a csv files.}
\item{path}{The path where to put the CSV-Document.} \item{path}{where to put the csv files.}
\item{create}{Set TRUE if the path does not exist yet and you want to create it.} \item{create}{set TRUE if the path does not exist yet and you want to create it}
} }
\description{ \description{
Put all tables from the entered list in separate CSV documents. Write the parsed and repaired results into separate csv files
} }
+3 -3
View File
@@ -26,18 +26,18 @@ library(tidyr)
First, you need to download all records of the current legislative period. First, you need to download all records of the current legislative period.
```r ```r
fetch_all("../records/") # path to directory where records should be stored fetch_all("../data/records/") # path to directory where records should be stored
``` ```
Second, those `.xml` files, need to be parsed into `R` `tibbles`. This is accomplished by: Second, those `.xml` files, need to be parsed into `R` `tibbles`. This is accomplished by:
```r ```r
read_all("../records/") %>% repair() -> res read_all("../data/records/") %>% repair() -> res
``` ```
We also used `repair` to fix a bunch of formatting issues in the records and unpacked We also used `repair` to fix a bunch of formatting issues in the records and unpacked
the result into more descriptive variables. the result into more descriptive variables.
For development purposes, we load the tables from csv files. For development purposes, we load the tables from csv files.
```{r} ```{r}
res <- read_from_csv('../csv/') res <- read_from_csv('../data/csv/')
``` ```
and unpack our tibbles and unpack our tibbles
```{r} ```{r}
+4 -4
View File
@@ -25,11 +25,11 @@ library(ggplot2)
First, you need to download all records of the current legislative period. First, you need to download all records of the current legislative period.
```r ```r
fetch_all("../records/") # path to directory where records should be stored fetch_all("../data/records/") # path to directory where records should be stored
``` ```
Second, those `.xml` files, need to be parsed into `R` `tibbles`. This is accomplished by: Second, those `.xml` files, need to be parsed into `R` `tibbles`. This is accomplished by:
```r ```r
read_all("../records/") %>% repair() -> res read_all("../data/records/") %>% repair() -> res
speeches <- res$speeches speeches <- res$speeches
speaker <- res$speaker speaker <- res$speaker
@@ -40,7 +40,7 @@ the result into more descriptive variables.
For development purposes, we load the tables from csv files. For development purposes, we load the tables from csv files.
```{r} ```{r}
tables <- read_from_csv('../csv/') tables <- read_from_csv('../data/csv/')
comments <- tables$comments comments <- tables$comments
speeches <- tables$speeches speeches <- tables$speeches
@@ -50,7 +50,7 @@ talks <- tables$talks
Further, we need to load a list of words that were used by Hitler but not by standard German texts. Further, we need to load a list of words that were used by Hitler but not by standard German texts.
```{r} ```{r}
fil <- file('../hitler_texts/hitler_words') fil <- file('../data/hitler_texts/hitler_words')
Worte <- readLines(fil) Worte <- readLines(fil)
hitlerwords <- tibble(Worte) hitlerwords <- tibble(Worte)
``` ```