4 Commits
32 changed files with 160 additions and 95 deletions
+4 -4
View File
@@ -1,10 +1,10 @@
*.xml
/doc/
/Meta/
/reports/
!/reports/*.pdf
!/reports/*.tex
/csv/*
/inst/reports/
!/inst/reports/*.pdf
!/inst/reports/*.tex
/data/csv/*
/parlament_49_53_texts/
.Rproj.user
*.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
find_word <- function(res, word) {
talks <- res$talks
mutate(talks, occurences = sapply(str_match_all(talks$content, regex(word, ignore_case = TRUE)),
nrow))
mutate(
talks,
occurences = sapply(
str_match_all(talks$content, regex(word, ignore_case = TRUE)),
nrow
)
)
}
#'Assign speaker-name to speaker-ID
#'
#' Assign speaker-name to speaker-ID.
#' add information from speaker table to a tibble containing speaker id
#'
#' @param tb tibble
#' @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
join_speaker <- function(tb, res, fraction_only = F) {
@@ -20,7 +33,7 @@ join_speaker <- function(tb, res, fraction_only = F) {
else joined
}
#'Assignment of the official colors to the parties
#' lookup table for official party colors
#'
#' @export
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",
"FDP", "AfD", NA_character_))
#'Bar chart of the fractions
#' Bar chart visualizing fraction based data
#'
#' @param tb The tibble to be analyzed.
#' @param x_variable Default is fraction.
#' @param y_variable Default is n.
#' @param fill Default is fraction.
#' @param title Title of the chart.
#' @param xlab Description of x-Lab. Default is Fraction.
#' @param ylab Description of y-Lab. Default is n.
#' @param filllab Default is Fraction.
#' @param flipped Default is TRUE. If TRUE draw bars horizontally, else vertically.
#' @param position Default is dodge.
#' Can be configured to also visualize data not related to fractions.
#'
#' @param tb tibble
#' @param x_variable column in tb, default is fraction
#' @param y_variable column in tb, default is n
#' @param fill column in tb, default is fraction
#' @param title plot title
#' @param xlab label for x axis, default is fraction
#' @param ylab label for y axis, default is n
#' @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).
#'
#' 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
bar_plot_fractions <- function(tb,
x_variable = NULL, # default is fraction
@@ -95,14 +116,14 @@ bar_plot_fractions <- function(tb,
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.
#'
#' @param res List of Tibbles to be analysed.
#' @param patterns Words to look up.
#' @param name ?
#' @param tidy Default is FALSE.
#' @param tidy default is FALSE.
#'
#' @export
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.
#'
#' @param download_dir character
#' @param create bool
#'
#' if create is TRUE, the directory given in download_dir is created
#'
#' @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
if (str_sub(download_dir, -1) != .Platform$file.sep)
download_dir <- str_c(download_dir, .Platform$file.sep)
+14 -13
View File
@@ -8,7 +8,7 @@
#' @param path character
#'
#' @export
read_all <- function(path="records/") {
read_all <- function(path="data/records/") {
cat("Reading all records from", path, "\n")
available_protocols <- list.files(path)
res <- pblapply(available_protocols, read_one, path=path)
@@ -90,7 +90,7 @@ parse_speaker <- function(speaker_xml) {
nm <- xml_child(speaker_xml)
vorname <- xml_get(nm, "vorname")
nachname <- xml_get(nm, "nachname")
fraction <- xml_get(nm, "fraction")
fraction <- xml_get(nm, "fraktion")
titel <- xml_get(nm, "titel")
rolle <- xml_find_all(nm, "rolle")
if (length(rolle) > 0) {
@@ -115,7 +115,7 @@ parse_speech <- function(speech_xml, date) {
for (node in cs) {
if (xml_name(node) == "p" || xml_name(node) == "name") {
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)) {
speech <- c(speech_id = speech_id,
speaker = cur_speaker,
@@ -205,16 +205,14 @@ parse_speakerlist <- function(speakerliste_xml) {
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 The List of Tables you want to convert into a CSV-Document.
#' @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.
#' @param tables list of tables to convert into a csv files.
#' @param path where to put the csv files.
#' @param create set TRUE if the path does not exist yet and you want to create it
#'
#' @export
write_to_csv <- function(tables, path="csv/", create=F) {
write_to_csv <- function(tables, path="data/csv/", create=F) {
check_directory(path, create)
write.table(tables$speaker, str_c(path, "speaker.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"))
}
#'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
read_from_csv <- function(path="csv/") {
read_from_csv <- function(path="data/csv/") {
list(speaker = read.table(str_c(path, "speaker.csv")) %>%
tibble() %>%
mutate(id = as.character(id)),
+10 -8
View File
@@ -59,7 +59,7 @@ repair_talks <- function(talks) {
#' unique (luckily :D)
#'
#' @param tb tibble
#' @param redner tibble
#' @param speaker tibble
#' @param name_variable name
#'
#' 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, "")))
}
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",
"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 %>%
filter(!is.na(kommentator)) %>%
lookup_redner(redner, kommentator) %>%
lookup_speaker(speaker, kommentator) %>%
left_join(comments, ., by="kommentator") %>%
select(-kommentator)
}
#' Repair parsed tables
#'
#' TODO: Explain repair_comments argument
#' (if TRUE, we try to lookup redner names in redner table)
#' @param parse_output tibble
#' @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
#' Since repaired tables should be a fixpoint of repair.
#' @export
repair <- function(parse_output, repair_comments = FALSE) {
list(redner = repair_speaker(parse_output$speaker),
reden = repair_speeches(parse_output$speeches),
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)
+19 -13
View File
@@ -2,7 +2,7 @@
% Please edit documentation in R/analyze.R
\name{bar_plot_fractions}
\alias{bar_plot_fractions}
\title{Bar chart of the fractions}
\title{Bar chart visualizing fraction based data}
\usage{
bar_plot_fractions(
tb,
@@ -19,28 +19,34 @@ bar_plot_fractions(
)
}
\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{
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}
\title{Download available records}
\usage{
fetch_all(download_dir = "records/", create = FALSE)
fetch_all(download_dir = "data/records/", create = FALSE)
}
\arguments{
\item{download_dir}{character}
\item{create}{bool
if create is TRUE, the directory given in download_dir is created}
}
\description{
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
\name{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{
join_speaker(tb, res, fraction_only = F)
}
@@ -11,8 +11,11 @@ join_speaker(tb, res, fraction_only = F)
\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{
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{
\item{tb}{tibble}
\item{speaker}{tibble}
\item{name_variable}{name
Tries to match the name_variable column with speaker names
returns a lookup table}
\item{redner}{tibble}
}
\description{
Tries to find the correct speaker id given a name.
+2 -2
View File
@@ -3,7 +3,7 @@
\docType{data}
\name{party_colors}
\alias{party_colors}
\title{Assignment of the official colors to the parties}
\title{lookup table for official party colors}
\format{
An object of class \code{character} of length 8.
}
@@ -11,6 +11,6 @@ An object of class \code{character} of length 8.
party_colors
}
\description{
Assignment of the official colors to the parties
lookup table for official party colors
}
\keyword{datasets}
+1 -1
View File
@@ -4,7 +4,7 @@
\alias{read_all}
\title{Parse xml records}
\usage{
read_all(path = "records/")
read_all(path = "data/records/")
}
\arguments{
\item{path}{character}
+6 -4
View File
@@ -2,13 +2,15 @@
% Please edit documentation in R/parse.R
\name{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{
read_from_csv(path = "csv/")
read_from_csv(path = "data/csv/")
}
\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{
Create a Tibble out of the CSV-Document
create a tibble from the csv file
}
+11 -6
View File
@@ -6,11 +6,16 @@
\usage{
repair(parse_output, repair_comments = FALSE)
}
\description{
TODO: Explain repair_comments argument
(if TRUE, we try to lookup redner names in redner table)
}
\details{
\arguments{
\item{parse_output}{tibble}
\item{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
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{tidy}{Default is FALSE.}
\item{tidy}{default is FALSE.}
}
\description{
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
\name{write_to_csv}
\alias{write_to_csv}
\title{Write to CSV-Document}
\title{Write the parsed and repaired results into separate csv files}
\usage{
write_to_csv(tables, path = "csv/", create = F)
write_to_csv(tables, path = "data/csv/", create = F)
}
\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{
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.
```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:
```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
the result into more descriptive variables.
For development purposes, we load the tables from csv files.
```{r}
res <- read_from_csv('../csv/')
res <- read_from_csv('../data/csv/')
```
and unpack our tibbles
```{r}
+4 -4
View File
@@ -25,11 +25,11 @@ library(ggplot2)
First, you need to download all records of the current legislative period.
```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:
```r
read_all("../records/") %>% repair() -> res
read_all("../data/records/") %>% repair() -> res
speeches <- res$speeches
speaker <- res$speaker
@@ -40,7 +40,7 @@ the result into more descriptive variables.
For development purposes, we load the tables from csv files.
```{r}
tables <- read_from_csv('../csv/')
tables <- read_from_csv('../data/csv/')
comments <- tables$comments
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.
```{r}
fil <- file('../hitler_texts/hitler_words')
fil <- file('../data/hitler_texts/hitler_words')
Worte <- readLines(fil)
hitlerwords <- tibble(Worte)
```