update readme for package usage

DESCRIPTION

@@ -0,0 +1,26 @@
+Package: hateimparlament
+Title: Protocolanalysis of German Bundestag
+Version: 0.0.0.9000
+Authors@R: 
+    person(given = "First",
+           family = "Last",
+           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).
+License: `use_mit_license()`, `use_gpl3_license()` or friends to pick a
+    license
+Encoding: UTF-8
+LazyData: true
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.1.1
+Imports: 
+    dplyr,
+    pbapply,
+    rvest,
+    stringr,
+    xml2
+Suggests: 
+    rmarkdown,
+    knitr
+VignetteBuilder: knitr

NAMESPACE

@@ -0,0 +1,7 @@
+# Generated by roxygen2: do not edit by hand
+
+import(dplyr)
+import(pbapply)
+import(stringr)
+import(tibble)
+import(xml2)

R/fetch.R

@@ -0,0 +1,46 @@
+mk_absolute_url <- function(path) paste0("https://www.bundestag.de", path)
+
+mk_url <- function(offset) {
+    mk_absolute_url %$% sprintf("/ajax/filterlist/de/services/opendata/543410-543410?offset=%d",
+                                offset)
+}
+
+download_protocol <- function(path, name, download_dir) {
+    fp <- paste0(download_dir, name)
+    try %$% download.file(mk_absolute_url(path), fp, quiet=T)
+    progress <<- progress + 1
+    setTimerProgressBar(pb, progress)
+}
+
+fetch_batch <- function(offset, download_dir) {
+    stopifnot("Offset must be numeric" = is.numeric(offset))
+    mk_url(offset) %>%
+        rvest::read_html() %>%
+        as.character() %>%
+        str_match_all("/resource/blob/.*?/([0-9]*-data\\.xml)") %>%
+        `[[`(1) ->
+        paths
+    mapply(download_protocol,
+           paths[,1],
+           paths[,2],
+           MoreArgs=list(download_dir = download_dir))
+    return(length(paths) > 0)
+}
+
+# TODO: error handling
+# - what if: page not reachable
+# - wrong format, etc.
+fetch_all <- function(download_dir="records/") {
+    cat("Fetching all available records from bundestag.de. This may take a while ...\n")
+    
+    # create progress bar
+    pb <<- timerProgressBar(min=0, max=250, width=40, char="+")
+    progress <<- 0
+    # close progress bar on exit (also on error)
+    on.exit({close(pb); cat("Done.\n")})
+    # fetch batch by batch
+    offset <- 0
+    while(fetch_batch(offset, download_dir)) offset <- offset + 10
+    # if successful, set progressbar to 100%
+    setTimerProgressBar(pb, 250)
+}

R/hateimparlament-package.R

@@ -0,0 +1,15 @@
+#' @details
+#' hateimparlament ist ein großartiges Paket!
+#' @import tibble
+#' @import dplyr
+#' @import pbapply
+#' @import stringr
+#' @import xml2
+#' @keywords internal
+"_PACKAGE"
+
+# The following block is used by usethis to automatically manage
+# roxygen namespace tags. Modify with care!
+## usethis namespace: start
+## usethis namespace: end
+NULL

R/helpers.R

@@ -1,2 +1,4 @@
 `%$%` <- function(f, x) f(x)
 `%.%` <- function(f, g) function(...) f(g(...))
+
+clear_na <- function(xs) xs[!is.na(xs)]

R/parse.R

@@ -0,0 +1,141 @@
+# for usage see the example at the end
+
+read_all <- function(path="records/") {
+    cat("Reading all records from", path, "\n")
+    available_protocols <- list.files(path)
+    res <- pblapply(available_protocols, read_one, path=path)
+
+    lapply(res, `[[`, "redner") %>%
+        bind_rows() %>%
+        distinct() ->
+        redner
+    
+    lapply(res, `[[`, "reden") %>%
+        bind_rows() %>%
+        distinct() ->
+        reden
+
+    lapply(res, `[[`, "talks") %>%
+        bind_rows() %>%
+        distinct() ->
+        talks
+
+    list(redner = redner, reden = reden, talks = talks)
+}
+
+# this reads all currently parseable data from one xml
+read_one <- function(name, path) {
+    x <- tryCatch(read_xml(paste0(path, name)),
+                  error = function(c) NULL)
+    if (is.null(x)) return(NULL)
+    cs <- xml_children(x)
+
+    verlauf <- xml_find_first(x, "sitzungsverlauf")
+    rednerl <- xml_find_first(x, "rednerliste")
+
+    xml_children(rednerl) %>%
+        parse_rednerliste() ->
+        redner
+
+    xml_children(verlauf) %>%
+        xml_find_all("rede") %>%
+        parse_redenliste() ->
+        res
+
+    list(redner = redner, reden = res$reden, talks = res$talks)
+}
+
+xml_get <- function(node, name) {
+    res <- xml_text %$% xml_find_all(node, name)
+    if (length(res) == 0) NA_character_
+    else res
+}
+
+# parse one redner
+parse_redner <- function(redner_xml) {
+    redner_id <- xml_attr(redner_xml, "id")
+    nm <- xml_child(redner_xml)
+    vorname <- xml_get(nm, "vorname")
+    nachname <- xml_get(nm, "nachname")
+    fraktion <- 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 = redner_id, vorname = vorname, nachname = nachname, fraktion = fraktion, titel = titel,
+      rolle_kurz = rolle_kurz, rolle_lang = rolle_lang)
+}
+
+# parse one rede
+# returns: - a rede (with rede id and redner id)
+#          - all talks appearing in the rede (with corresponding content)
+parse_rede <- function(rede_xml) {
+    rede_id <- xml_attr(rede_xml, "id")
+    cs <- xml_children(rede_xml)
+    cur_redner <- NA_character_
+    principal_redner <- NA_character_
+    cur_content <- ""
+    reden <- list()
+    for (node in cs) {
+        if (xml_name(node) == "p") {
+            klasse <- xml_attr(node, "klasse")
+            if (!is.na(klasse) && klasse == "redner") {
+                if (!is.na(cur_redner)) {
+                    rede <- c(rede_id = rede_id,
+                              redner = cur_redner,
+                              content = cur_content)
+                    reden <- c(reden, list(rede))
+                    cur_content <- ""
+                } else {
+                    principal_redner <- xml_child(node) %>% xml_attr("id")
+                }
+                cur_redner <- xml_child(node) %>% xml_attr("id")
+            } else {
+                cur_content <- paste0(cur_content, xml_text(node), sep="\n")
+            }
+        }
+    }
+    rede <- c(rede_id = rede_id,
+              redner = cur_redner,
+              content = cur_content)
+    reden <- c(reden, list(rede))
+    list(rede = c(id = rede_id, redner = principal_redner),
+         parts = reden)
+}
+
+# creates a tibble of reden and a tibble of talks from a list of xml nodes representing reden
+parse_redenliste <- function(redenliste_xml) {
+    d <- sapply(redenliste_xml, parse_rede)
+    reden <- simplify2array(d["rede", ])
+    parts <- simplify2array %$% unlist(d["parts", ], recursive=FALSE)
+    list(reden = tibble(id = reden["id",], redner = reden["redner",]),
+         talks = tibble(rede_id = parts["rede_id", ],
+                        redner = parts["redner", ],
+                        content = parts["content", ]))
+}
+
+# create a tibble of redner from a list of xml nodes representing redner
+parse_rednerliste <- function(rednerliste_xml) {
+    d <- sapply(rednerliste_xml, parse_redner)
+    tibble(id = d["id",],
+           vorname = d["vorname",],
+           nachname = d["nachname",],
+           fraktion = d["fraktion",],
+           titel = d["titel",],
+           rolle_kurz = d["rolle_kurz",],
+           rolle_lang = d["rolle_lang",])
+}
+
+# -------------------------------
+# EXAMPLE USE
+
+# make sure data ist downloaded via fetch.R
+# res <- read_one("19126-data.xml")
+# 
+# res$redner
+# res$reden
+# res$talks
+
+# -------------------------------

R/repair.R

@@ -0,0 +1,49 @@
+fraktionen <- c("AFD" = "AfD",
+                "BÜNDNIS90/" = "BÜNDNIS 90 / DIE GRÜNEN",
+                "BÜNDNIS90/DIEGRÜNEN" = "BÜNDNIS 90 / DIE GRÜNEN",
+                "FRAKTIONSLOS" = "Fraktionslos",
+                "DIELINKE" = "DIE LINKE",
+                "SPD" = "SPD",
+                "CDU/CSU" = "CDU/CSU",
+                "FDP" = "FDP")
+
+repair_fraktion <- function(fraktion) {
+    cleaned <- str_to_upper %$% str_replace_all(fraktion, "\\s", "")
+    fraktionen[cleaned]
+}
+
+# takes vector of titel and keeps longest
+longest_titel <- function(titel) {
+    if (all(is.na(titel))) NA_character_
+    else titel[which.max %$% str_length(titel)]
+}
+
+# takes character vector, removes duplicates and collapses
+collect_unique <- function(xs) xs %>% clear_na() %>% unique() %>% str_c(collapse="&") %>% na_if("")
+
+# expects a tibble of redner and repairs
+repair_redner <- function(redner) {
+    redner %>% mutate(fraktion = Vectorize(repair_fraktion)(fraktion)) %>% # fix fraktion
+        group_by(id, vorname, nachname) %>%
+        summarize(fraktion = collect_unique(fraktion),
+                  titel = longest_titel(titel),
+                  rolle_kurz = collect_unique(str_squish(rolle_kurz)),
+                  rolle_lang = collect_unique(str_squish(rolle_lang)))
+}
+
+repair_reden <- function(reden) {
+    # TODO: fill with content
+    reden
+}
+
+repair_talks <- function(talks) {
+    # TODO: fill with content
+    talks
+}
+
+# repairs all tables
+repair <- function(parse_output) {
+    list(redner = repair_redner(parse_output$redner),
+         reden = repair_reden(parse_output$reden),
+         talks = repair_talks(parse_output$talks))
+}

README.md

@@ -0,0 +1,85 @@
+# How to develop
+
+Wie kann man entwickeln?
+
+```r
+# alles geht mit devtools (laedt auch noch ein paar andere pakete)
+library(devtools)
+
+# neu laden aller paket funktionen
+load_all()
+```
+Wir verwenden NIEMALS source, etc.! Außerdem NIEMALD library(...) verwenden, sondern
+um neue pakete hinzuzufuegen (als dependency), verwende:
+```r
+use_package("my-good-old-package")
+```
+Um paket imports verfuegbar zu machen, muss man diese in `R/hateimparlament-package.R`
+als `@import <package>` hinzufuegen.
+
+Um dokumentationen neu zu laden / zu erstellen (ruft roxgen auf)
+```r
+document()
+```
+
+# Herunterladen
+
+Bevor analysiert werden kann, muss fetch.R ausgeführt werden, um alle Protokolle herunterzuladen.
+
+# Parsing
+
+## Tabellen
+
+parse.R parsed einzelne Protokolle und erstellt 3 Tibbles
+
+### Redner
+
+Struktur: `id` , `vorname` , `nachname` , `fraktion` , `titel` , `rolle_kurz`, `rolle_lang`
+
+Die Rollen sind beispielsweise "Bundeskanzlerin". Leider gegendert und deshalb wahrscheinlich
+nervig zu analysieren.
+
+Wird gewonnnen aus dem `<rednerliste>` Eintrag am Ende der Protokolle.
+
+### Reden
+
+Struktur: `id` , `redner`
+
+Die Reden `id` wird im Protokoll festgelegt und ist eindeutig. Eine Rede ist ein
+`<rede>` Eintrag im Sitzungsverlauf. Eine Rede hat immer einen Hauptredner
+(der der vorne am Pult steht).
+
+Innerhalb einer Rede kann es verschieden Redebeiträge geben:
+
+- Kommentare: Beifall, Zwischenrufe, etc.
+- Redebeiträge: Typischerweise hauptsächlich der Hauptredner, aber auch Zwischenfragen. Diese werden
+beim parsen in der Tabelle Talks gespeichert.
+
+### Talks
+
+Struktur: `rede_id` , `redner` , `content`
+
+Das sind die eigentlichen Redebeiträge, die innerhalb von _rede_ Einträgen auftauchen. Dabei gilt:
+
+- `rede_id`: Die Rede in dem der Beitrag auftaucht
+- `redner`: Der Sprecher des Redebeitrags
+- `content`: Der Inhalt der Rede (__wichtig__: Aktuell werden die Ordnungskommentare des
+Bundestagspräsidenten nicht herausgefiltert, tauchen also im Inhalt auf, obwohl sie nicht vom
+`redner` gesprochen werden. To be fixed -> Issues!)
+
+## Noch zu parsen: Alles kann, nichts muss.
+
+- Kommentare (aktuell werden nur `<p>`'s in Reden gesammelt). Hier ist zu überlegen, wie diese
+gesammelt werden sollten.
+- Meta Daten? Diese sind teilweise in den `rede_id`'s encoded.
+
+## Kombinieren der Tabellen der Protokolle 
+
+- Alle Tabellen sollten schlussendlich kombiniert werden zu großen Tabellen über
+alle Protokolle.
+
+# Analyse
+
+- Schnittmenge AfD Vokabular und Hitler's Reden?
+- Redeanteile nach Geschlecht (dazu gibt es leider keine Daten in der Rednerliste), Fraktion, etc.
+- Ideen, Ideen, Ideen ...

man/hateimparlament-package.Rd

@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/hateimparlament-package.R
+\docType{package}
+\name{hateimparlament-package}
+\alias{hateimparlament}
+\alias{hateimparlament-package}
+\title{hateimparlament: Protocolanalysis of German Bundestag}
+\description{
+Downloads, parses and analyses protocols of the current German parliament (Bundestag).
+}
+\details{
+hateimparlament ist ein großartiges Paket!
+}
+\author{
+\strong{Maintainer}: First Last \email{first.last@example.com} (\href{https://orcid.org/YOUR-ORCID-ID}{ORCID})
+
+}
+\keyword{internal}

scraping/fetch.R

@@ -1,33 +0,0 @@
-source("../utils/helpers.R")
-library(RCurl)
-library(stringr)
-
-DOWNLOAD_DIR = "../data/" # warning: this is not created (should maybe)
-
-mk_absolute_url <- function(path) paste0("https://www.bundestag.de", path)
-
-mk_url <- function(offset) {
-    mk_absolute_url %$% sprintf("/ajax/filterlist/de/services/opendata/543410-543410?offset=%d",
-                                offset)
-}
-
-download_protocol <- function(path, name) {
-    fp <- paste0(DOWNLOAD_DIR, name)
-    try %$% download.file(mk_absolute_url(path), fp, quiet=T)
-}
-
-fetch_batch <- function(offset) {
-    url <- mk_url(offset)
-    res <- getURL(url)
-    paths <- str_match_all(res, "/resource/blob/.*?/([0-9]*-data\\.xml)")[[1]]
-    mapply(download_protocol, paths[,1], paths[,2])
-    return(length(paths) > 0)
-}
-
-# TODO: error handling
-# - what if: page not reachable
-# - wrong format, etc.
-fetch_all <- function() {
-    offset <- 0
-    while(fetch_batch(offset)) offset <- offset + 10
-}

vignettes/.gitignore

@@ -0,0 +1,2 @@
+*.html
+*.R

vignettes/funwithdata.Rmd

@@ -0,0 +1,36 @@
+---
+title: "funwithdata"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{funwithdata}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+```
+
+```r
+read_all() %>% repair() -> res
+
+reden <- res$reden
+redner <- res$redner
+talks <- res$talks
+
+# first tries
+
+left_join(reden, redner, by=c("redner" = "id")) %>%
+    group_by(fraktion) %>%
+    summarize(n = n()) %>%
+    ggplot(aes(x = fraktion, y = n)) +
+    geom_bar(stat = "identity")
+```
+
+
+```{r setup}
+library(hateimparlament)
+```