Merge pull request 'add masterdata from bundestag.de and use this for genderequality' (#16) from genderequality-alternative into master

DESCRIPTION

@@ -1,13 +1,21 @@
 Package: hateimparlament
-Title: Protocolanalysis of German Bundestag
+Title: Recordanalysis Of Bundestag
 Version: 0.0.0.9000
-Authors@R: 
-    person(given = "First",
-           family = "Last",
+Authors@R: c(
+    person(given = "Leon",
+           family = "Burgard",
+           role = c("aut")),
+    person(given = "Josua",
+           family = "Kugler",
+           role = c("aut")),
+    person(given = "Christian",
+           family = "Merten",
            role = c("aut", "cre"),
-           email = "first.last@example.com",
-           comment = c(ORCID = "YOUR-ORCID-ID"))
-Description: Downloads, parses and analyses protocols of the current German parliament (Bundestag).
+           email = "christian@merten.dev"))
+Description: Downloads, parses and analyses parliamentary records of the 19th legislative
+    period of the German parliament (Bundestag).
+URL: https://git.flavigny.de/christian/hateimparlament
+BugReports: https://git.flavigny.de/christian/hateimparlament/issues
 License: GPL (>= 3)
 Encoding: UTF-8
 LazyData: true

R/fetch.R

@@ -61,10 +61,3 @@ fetch_all <- function(download_dir="inst/records/", create=FALSE) {
     # if successful, set progressbar to 100%
     setTimerProgressBar(pb, 250)
 }
-
-stop_dir_not_creatable <- function(cond) {
-    # currently this has call: dir.create(download_dir)
-    # do we want to change this to fetch_all(...) ?
-    cond$message <- "Directory does not exist and can't be created. Probably because the path is not writeable."
-    stop(cond)
-}

R/helpers.R

@@ -19,6 +19,13 @@ check_directory <- function(path, create=F) {
     }
 }
 
+stop_dir_not_creatable <- function(cond) {
+    # currently this has call: dir.create(download_dir)
+    # do we want to change this to fetch_all(...) ?
+    cond$message <- "Directory does not exist and can't be created. Probably because the path is not writeable."
+    stop(cond)
+}
+
 # appends a file seperator at end of path if needed
 make_directory_path <- function(path) {
     if (!str_ends(path, .Platform$file.sep)) str_c(path, .Platform$file.sep)

R/parse.R

@@ -153,10 +153,10 @@ parse_speech <- function(speech_xml, date) {
             }
         } else if (xml_name(node) == "kommentar") {
             # comments are of the form
-            # <kommentar>(blabla [Fraktion] – blabla liasdf – bla)</kommentar>
+            # <kommentar>(blabla [Fraktion] \u2013 blabla liasdf \u2013 bla)</kommentar>
             xml_text(node) %>%
                 str_sub(2, -2) %>%
-                str_split("–") %>%
+                str_split("\u2013") %>%
                 `[[`(1) %>%
                 lapply(parse_comment, speech_id = speech_id, on_speaker = cur_speaker) ->
                 cs
@@ -233,6 +233,11 @@ parse_speakerlist <- function(speakerliste_xml) {
 #' 
 #' @export
 write_to_csv <- function(tables, path="inst/csv/", create=F) {
+    is_valid_res(tables)
+    stopifnot("path must be of type character" = is.character(path))
+    stopifnot("create must be of type logical" = is.logical(create))
+
+    path <- make_directory_path(path)
     check_directory(path, create)
     write.table(tables$speaker, str_c(path, "speaker.csv"))
     write.table(tables$speeches, str_c(path, "speeches.csv"))
@@ -250,6 +255,9 @@ write_to_csv <- function(tables, path="inst/csv/", create=F) {
 #' 
 #' @export
 read_from_csv <- function(path="inst/csv/") {
+    stopifnot("path must be of type character" = is.character(path))
+
+    path <- make_directory_path(path)
     list(speaker = read.table(str_c(path, "speaker.csv")) %>%
              tibble() %>%
              mutate(id = as.character(id)),
@@ -259,5 +267,7 @@ read_from_csv <- function(path="inst/csv/") {
                     date = as.Date(date)),
          talks = tibble %$% read.table(str_c(path, "talks.csv")),
          comments = tibble %$% read.table(str_c(path, "comments.csv")),
-         applause = tibble %$% read.table(str_c(path, "applause.csv")))
+         applause = tibble %$% read.table(str_c(path, "applause.csv"))) -> res
+    is_valid_res(res)
+    res
 }

R/repair.R

@@ -64,7 +64,7 @@ repair_talks <- function(talks) {
 #' 
 #' returns a lookup table
 lookup_speaker <- function(tb, speaker, name_variable) {
-    tobereplaced <- "[-–—‑­­-­­­ ]"
+    tobereplaced <- "[\u002D\u2013\u2014\u2011\u00AD ]"
     speaker %>%
         unite(name, prename, lastname, sep=".*") %>%
         mutate(name = str_replace_all(name, tobereplaced, ".*")) ->

README.md

@@ -1,19 +1,166 @@
-# How to develop
+# Description
 
+R package to analyze parliamentary records of the 19th legislative period of the Bundestag,
+the German parliament.
+
+# Installation
+
+Using the `remotes` package, this is easily installed via:
+```r
+remotes::install_url("https://git.flavigny.de/christian/hateimparlament/archive/master.zip")
+```
+Since the fetching and reading is very slow and depends on an internet connection, all vignettes
+use `read_from_csv` to read already parsed tibbles from `.csv` files.
+
+That's why, if you want to build the vignettes yourself, you need to
+download the source code, e.g. on Linux
+```
+git clone https://git.flavigny.de/christian/hateimparlament
+cd hateimparlament
+```
+then start `R` and do
+```r
+devtools::load_all()
+fetch_all(create = TRUE)
+read_all() %>% repair() -> res
+write_to_csv(res, create = TRUE)
+```
+Then finally, do:
+```r
+devtools::install(build_vignettes = TRUE)
+```
+
+# Features
+
+The package mainly supplies 4 functionalities:
+
+## Download records
+
+To analyze records, they need to be downloaded. This is done with `fetch_all`:
+```r
+fetch_all("records/", create = TRUE) # path to directory where records should be stored
+```
+This downloads all parliamentary records and stores them as `.xml` files in the given directory.
+
+## Parse records
+
+To use the records in R, they are converted to `tibble`s with
+```r
+res_raw <- read_all("records/") # path to directory where records are stored
+```
+
+`res_raw` is a named list with 5 `tibble`s:
+
+### Speaker
+
+Table of all speakers of this legislative period.
+
+Fields:
+- `id`: Unique speaker id
+- `prename`: Prename
+- `lastname`: Surname
+- `fraction`: Name of fraction if the speaker is member of parliament.
+- `title`: Title, e.g. ,,Prof''
+- `role_short`: Short name of role, e.g. ,,Bundeskanzlerin''
+- `role_long`: Long name of role
+
+### Speeches
+
+Table of all speeches given during this legislative period.
+
+Fields:
+- `id`: Unique speech id
+- `speaker`: Principal speaker (the person standing behind the lectern during the speech).
+- `date`: Date of session
+
+### Talks
+
+Within a speech, there can be multiple talks by different people. Mostly this is the main speech
+by the principal speaker, but usually there are questions by other members of parliament or
+order calls by the president of the Bundestag.
+
+Fields:
+- `speech_id`: Speech in which this talk has been given
+- `speaker`: Person that actually talks
+- `content`: Spoken content
+
+### Comments
+
+These are the interjections that appear during the speeches.
+
+Fields:
+- `speech_id`: The speech that was interrupted
+- `on_speaker`: The speaker who was interrupted
+- `fraction`: The fraction of the commenter
+- `commenter`: The person who interrupted the speech
+- `comment`: The content of the comment
+
+### Applause
+
+Table containing all the rounds of applause that happened during this legislative period.
+
+Fields:
+- `speech_id`: Speech during which was applauded
+- `on_speaker`: Speaker who was applauded
+
+And then logical fields `CDU_CSU`, `SPD`, `FDP`, `DIE_LINKE`, `BUENDNIS_90_DIE_GRUENEN`, `AfD`
+for every fraction in the Bundestag, signifying whether this fraction applauded.
+
+## Repair records
+
+The parliamentary records usually contain some major and minor formatting issues. These are
+mostly resolved by using
+```
+res <- repair(res_raw)
+```
+By passing `lookup_speaker = TRUE`, even commenters in
+`res_raw$comments` are matched with their respective speaker id.
+
+## Analysis
+
+Also some functions are provided to analyze the parliamentary records and draw some plots:
+
+- `bar_plot_fractions`
+- `find_word`
+- `join_speaker`
+- `word_usage_by_date`
+
+See their usage with the `?` operator.
+
+In the vignettes you can find different analyses of the protocols, for example:
+
+- "Who talks the most?"
+- "Which party gives the most speeches?"
+- "Which party comments the most on which parties?"
+- "When are which topics discussed the most?"
+- ...
+
+# Contributing
+
+Developing works the easiest with `devtools`:
 ```r
-# everything works with devtools (loads some other packages too)
 library(devtools)
-
-# reload all package functions
+```
+When you changed something or added some functionality, you can reload all package functions with
+```r
 load_all()
+```
+If you want to avoid reading all records every time you start a new R session, you can
+write your parsed tibbles to CSV files:
 
-#write to CSV files to speed up loading
+```
 tables <- read_all()
 tables <- repair(tables)
-write_to_csv(tables)
+write_to_csv(tables, "path/to/csv/")
 ```
-We NEVER use source(...), etc.! Also NEVER use library(...). 
-But to add new packages (as dependency), use:
+Then later you can use
+```r
+res <- read_from_csv("path/to/csv/")
+```
+to load your stored tibbles very fast.
+
+NEVER use source(...), etc.! Also NEVER use library(...). 
+To add new packages (as dependency), use:
 ```r
 use_package("my-good-old-package")
 ```
@@ -27,87 +174,5 @@ document()
 
 Build vignettes
 ```r
-rmarkdown::render("vignettes/bla.Rmd")
+rmarkdown::render("vignettes/test.Rmd")
 ```
-
-# Download
-
-Before parsing, fetch.R must be run to download all protocols.
-```r
-fetch_all("../inst/records/") # path to directory where records should be stored
-```
-
-# Parsing
-
-## tables
-
-parse.R parses all downloaded logs and creates 5 tibbles.
-repair.R then cleans up the errors in these tibbles.
-```r
-read_all("../inst/records/") %>% repair()
-```
-
-
-
-### Speaker
-
-structure: `id` , `first_name` , `last_name` , `fraction` , `title` , `role_short`, `role_long`.
-
-
-
-Obtained from the `<speaker list>` entry at the end of the transcripts.
-
-### Speeches
-
-Structure: `id` , `speaker`
-
-The speeches `id` is specified in the protocol and is unique.A speech is a `<speech>` entry in the session history. A speech always has a main speaker (the one standing at the front of the lectern).
-
-Within a speech, there can be different speech entries:
-
-- Comments: Applause, interjections, etc.
-- Speeches: Typically mainly the main speaker, but also interjections. 
-These are stored in the talks, comments and applause tables when parsing.
-
-
-### Talks
-
-Structure: `speech_id` , `speaker` , `content`.
-
-These are the actual talk entries that appear within _speeches_.
-
-- `speech_id`: the speech in which the contribution appears.
-- `speaker`: The speaker of the speech entry.
-- `content`: The content of the speech.
-
-###comments
-
-These are the interjections that appear during the speeches.
-
-They have the following structure:
-- `speech_id`: The speech that was interrupted.
-- `on_speaker`: The speaker who was interrupted.
-- `fraction`
-- `commenter`: The person who interrupted the speech.
-- `comment`: The content of the comment.
-
-###applause
-
-The logical table shows which party applauded for which speaker with explicit speech and which did not.
-
-structure: `speech_id`, `on_speaker`, `CDU_CSU`, `SPD`, `FDP`, `DIE_LINKE`, `BUENDNIS_90_DIE_GRUENEN`, `AfD`
-
-
-# Analysis
-
-analysis.R provides some functions to analyze the "Plenarprotokolle" and to create plots.
-
-In the vignettes you can find different analyses of the protocols, for example:
-
-- "Who talks the most?"
-- "Which party gives the most speeches?"
-- "Which party comments the most on which parties?"
-- "When are which topics discussed the most?"
-- ...
-
-

man/hateimparlament-package.Rd

@@ -4,15 +4,30 @@
 \name{hateimparlament-package}
 \alias{hateimparlament}
 \alias{hateimparlament-package}
-\title{hateimparlament: Protocolanalysis of German Bundestag}
+\title{hateimparlament: Recordanalysis Of Bundestag}
 \description{
-Downloads, parses and analyses protocols of the current German parliament (Bundestag).
+Downloads, parses and analyses parliamentary records of the 19th legislative
+    period of the German parliament (Bundestag).
 }
 \details{
 hateimparlament ist ein großartiges Paket!
+}
+\seealso{
+Useful links:
+\itemize{
+  \item \url{https://git.flavigny.de/christian/hateimparlament}
+  \item Report bugs at \url{https://git.flavigny.de/christian/hateimparlament/issues}
+}
+
 }
 \author{
-\strong{Maintainer}: First Last \email{first.last@example.com} (\href{https://orcid.org/YOUR-ORCID-ID}{ORCID})
+\strong{Maintainer}: Christian Merten \email{christian@merten.dev}
+
+Authors:
+\itemize{
+  \item Leon Burgard
+  \item Josua Kugler
+}
 
 }
 \keyword{internal}

vignettes/explicittopic.Rmd

@@ -1,8 +1,8 @@
 ---
-title: "explicittopic"
+title: "Analysis of covered topics"
 output: rmarkdown::html_vignette
 vignette: >
-  %\VignetteIndexEntry{explicittopic}
+  %\VignetteIndexEntry{Analysis of covered topics}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
 ---

vignettes/genderequality.Rmd

@@ -1,8 +1,8 @@
 ---
-title: "genderequality"
+title: "Differences in gender"
 output: rmarkdown::html_vignette
 vignette: >
-  %\VignetteIndexEntry{genderequality}
+  %\VignetteIndexEntry{Differences in gender}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
 ---
@@ -20,7 +20,7 @@ library(dplyr)
 library(ggplot2)
 library(stringr)
 library(tidyr)
-library(rvest)
+library(xml2)
 ```
 
 ## Preparation of data
@@ -33,8 +33,7 @@ Second, those `.xml` files, need to be parsed into `R` `tibbles`. This is accomp
 ```r
 read_all("../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.
+We also used `repair` to fix a bunch of formatting issues in the records.
 
 For development purposes, we load the tables from csv files.
 ```{r}
@@ -48,53 +47,33 @@ speaker <- res$speaker
 talks <- res$talks
 ```
 
-Bevor we can do our analysis, we have to assign a gender to our politicans.
+Bevor we can do our analysis, we have to assign a gender to our politicans. We do this
+by reading the gender from the master data of all members of parliament, which is
+fetched from bundestag.de.
 
 ```{r}
-extract_href <- function(sel, html) {
-  html %>%
-    html_node(sel) %>%
-    html_attr("href")
+xml_get <- function(node, name) {
+    res <- xml_text(xml_find_all(node, name))
+    if (length(res) == 0) NA_character_
+    else res
 }
 
-first_content_p_text <- function(url) {
-  res <- NA
-  i <- 1
-  while(is.na(res)) {
-    read_html(url) %>% 
-      html_node(str_glue("#mw-content-text > div.mw-parser-output > p:nth-child({i})"))  %>% 
-      html_text() -> res
-    i <- i + 1
-  }
-  res
+x <- read_xml("../inst/masterdata.xml")
+mdbs <- xml_find_all(x, "MDB")
+
+ids <- c()
+genders <- c()
+for (mdb in mdbs) {
+    xml_get(mdb, "ID") -> mdb_id
+    xml_find_first(mdb, "BIOGRAFISCHE_ANGABEN") %>%
+        xml_get("GESCHLECHT") ->
+        mdb_gender
+    ids <- c(ids, mdb_id)
+    genders <- c(genders, if (mdb_gender == "männlich") "male" else "female")
 }
 
-abgeordneten_list_html <- read_html(
-  "https://de.wikipedia.org/wiki/Liste_der_Mitglieder_des_Deutschen_Bundestages_(19._Wahlperiode)")
-
-selectors <- str_glue("#mw-content-text > div.mw-parser-output > table:nth-child(20) > tbody > tr:nth-child({2:709}) > td:nth-child(2) > a")
-link_part2 <- sapply(selectors, extract_href, abgeordneten_list_html)
-link <- str_c("https://de.wikipedia.org", link_part2)
-
-text <- sapply(link, first_content_p_text)
-text %>% 
-  str_extract(" ist ein.") %>% 
-  str_replace(" ist eine", "female") %>% 
-  str_replace(" ist ein ", "male") ->
-  gender
-
-text %>% 
-  str_extract("^([:upper:]?[:lower:]+[\\s\\-]?)*") %>% 
-  str_trim() -> 
-  names
-
-gender <- tibble(speaker = names,
-                 gender = gender)
-
-speaker %>% 
-  unite("speaker", vorname, nachname, sep = " ") %>% 
-  right_join(gender, by = "speaker") -> 
-  speaker_with_gender
+gender <- tibble(id = ids, gender = genders)
+speaker_with_gender <- left_join(res$speaker, gender)
 ```
 
 ## Analyse
@@ -179,9 +158,8 @@ speeches %>%
   summarize(n = n()) %>%
   ungroup() %>% 
   arrange(-n) %>%
-  left_join(speaker, by=c("speaker" = "id")) %>% 
-  unite(name, vorname, nachname, sep = " ") %>% 
-  inner_join(gender, by=c("name"= "speaker")) %>% 
+  join_speaker(res) %>%
+  left_join(gender, by=c("speaker"="id")) %>% 
   group_by(gender) %>% 
   summarise(absolute=sum(n)) %>%
   filter(gender %in% c("female", "male")) %>%

vignettes/generalquestions.Rmd

@@ -1,8 +1,8 @@
 ---
-title: "generalquestions"
+title: "General questions"
 output: rmarkdown::html_vignette
 vignette: >
-  %\VignetteIndexEntry{generalquestions}
+  %\VignetteIndexEntry{General questions}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
 ---

vignettes/interaction.Rmd

@@ -1,8 +1,8 @@
 ---
-title: "interaction"
+title: "Interaction between fractions"
 output: rmarkdown::html_vignette
 vignette: >
-  %\VignetteIndexEntry{interaction}
+  %\VignetteIndexEntry{Interaction between fractions}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
 ---