christian/hateimparlament
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

refactor rede -> speech, redner -> speaker

Browse Source
This commit is contained in:
JosuaKugler
2021-08-03 17:05:07 +02:00
parent 09f5e5da0d
commit 7315dd8793
6 changed files with 106 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files
R/parse.R
+62 -62
View File
@@ -13,16 +13,16 @@ read_all <- function(path="records/") {
available_protocols <- list.files(path)
res <- pblapply(available_protocols, read_one, path=path)
lapply(res, `[[`, "redner") %>%
lapply(res, `[[`, "speaker") %>%
bind_rows() %>%
distinct() ->
redner
speaker
lapply(res, `[[`, "reden") %>%
lapply(res, `[[`, "speeches") %>%
bind_rows() %>%
distinct() %>%
mutate(date = as.Date(date, format="%d.%m.%Y")) ->
reden
speeches
lapply(res, `[[`, "talks") %>%
bind_rows() %>%
@@ -51,7 +51,7 @@ read_all <- function(path="records/") {
select(-fraktion) ->
applause
list(redner = redner, reden = reden, talks = talks, comments = comments, applause = applause)
list(speaker = speaker, speeches = speeches, talks = talks, comments = comments, applause = applause)
}
# this reads all currently parseable data from one xml
@@ -64,18 +64,18 @@ read_one <- function(name, path) {
cs <- xml_children(x)
verlauf <- xml_find_first(x, "sitzungsverlauf")
rednerl <- xml_find_first(x, "rednerliste")
speakerl <- xml_find_first(x, "rednerliste")
xml_children(rednerl) %>%
parse_rednerliste() ->
redner
xml_children(speakerl) %>%
parse_speakerlist() ->
speaker
xml_children(verlauf) %>%
xml_find_all("rede") %>%
parse_redenliste(date) ->
parse_speechlist(date) ->
res
list(redner = redner, reden = res$reden, talks = res$talks, comments = res$comments)
list(speaker = speaker, speeches = res$speeches, talks = res$talks, comments = res$comments)
}
xml_get <- function(node, name) {
@@ -84,10 +84,10 @@ xml_get <- function(node, name) {
else res
}
# parse one redner
parse_redner <- function(redner_xml) {
redner_id <- xml_attr(redner_xml, "id")
nm <- xml_child(redner_xml)
# parse one speaker
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")
fraktion <- xml_get(nm, "fraktion")
@@ -97,39 +97,39 @@ parse_redner <- function(redner_xml) {
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,
c(id = speaker_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, date) {
rede_id <- xml_attr(rede_xml, "id")
cs <- xml_children(rede_xml)
cur_redner <- NA_character_
principal_redner <- NA_character_
# parse one speech
# returns: - a speech (with speech id and speaker id)
# - all talks appearing in the speech (with corresponding content)
parse_speech <- function(speech_xml, date) {
speech_id <- xml_attr(speech_xml, "id")
cs <- xml_children(speech_xml)
cur_speaker <- NA_character_
principal_speaker <- NA_character_
cur_content <- ""
reden <- list()
speeches <- list()
comments <- list()
for (node in cs) {
if (xml_name(node) == "p" || xml_name(node) == "name") {
klasse <- xml_attr(node, "klasse")
if ((!is.na(klasse) && klasse == "redner") || xml_name(node) == "name") {
if (!is.na(cur_redner)) {
rede <- c(rede_id = rede_id,
redner = cur_redner,
if ((!is.na(klasse) && klasse == "speaker") || xml_name(node) == "name") {
if (!is.na(cur_speaker)) {
speech <- c(speech_id = speech_id,
speaker = cur_speaker,
content = cur_content)
reden <- c(reden, list(rede))
speeches <- c(speeches, list(speech))
cur_content <- ""
}
if (is.na(principal_redner) && xml_name(node) != "name") {
principal_redner <- xml_child(node) %>% xml_attr("id")
if (is.na(principal_speaker) && xml_name(node) != "name") {
principal_speaker <- xml_child(node) %>% xml_attr("id")
}
if (xml_name(node) == "name") {
cur_redner <- "BTP"
cur_speaker <- "BTP"
} else {
cur_redner <- xml_child(node) %>% xml_attr("id")
cur_speaker <- xml_child(node) %>% xml_attr("id")
}
} else {
cur_content <- paste0(cur_content, xml_text(node), sep="\n")
@@ -141,25 +141,25 @@ parse_rede <- function(rede_xml, date) {
str_sub(2, -2) %>%
str_split("–") %>%
`[[`(1) %>%
lapply(parse_comment, rede_id = rede_id, on_redner = cur_redner) ->
lapply(parse_comment, speech_id = speech_id, on_speaker = cur_speaker) ->
cs
comments <- c(comments, cs)
}
}
rede <- c(rede_id = rede_id,
redner = cur_redner,
speech <- c(speech_id = speech_id,
speaker = cur_speaker,
content = cur_content)
reden <- c(reden, list(rede))
list(rede = c(id = rede_id, redner = principal_redner, date = date),
parts = reden,
speeches <- c(speeches, list(speech))
list(speech = c(id = speech_id, speaker = principal_speaker, date = date),
parts = speeches,
comments = comments)
}
fraktionspattern <- "BÜNDNIS(SES)?\\W*90/DIE\\W*GRÜNEN|CDU/CSU|AfD|SPD|DIE LINKE|FDP|LINKEN"
fraktionsnames <- c("BÜNDNIS 90/DIE GRÜNEN", "CDU/CSU", "AfD", "SPD", "DIE LINKE", "FDP")
parse_comment <- function(comment, rede_id, on_redner) {
base <- c(rede_id = rede_id, on_redner = on_redner)
parse_comment <- function(comment, speech_id, on_speaker) {
base <- c(speech_id = speech_id, on_speaker = on_speaker)
# classify comment
if(str_detect(comment, "Beifall")) {
str_extract_all(comment, fraktionspattern) %>%
@@ -174,28 +174,28 @@ parse_comment <- function(comment, rede_id, on_redner) {
}
}
# creates a tibble of reden and a tibble of talks from a list of xml nodes representing reden
parse_redenliste <- function(redenliste_xml, date) {
d <- sapply(redenliste_xml, parse_rede, date = date)
reden <- simplify2array(d["rede", ])
# creates a tibble of speeches and a tibble of talks from a list of xml nodes representing speeches
parse_speechlist <- function(speechlist_xml, date) {
d <- sapply(speechlist_xml, parse_speech, date = date)
speeches <- simplify2array(d["speech", ])
parts <- simplify2array %$% unlist(d["parts", ], recursive=FALSE)
comments <- simplify2array %$% unlist(d["comments", ], recursive=FALSE)
list(reden = tibble(id = reden["id",], redner = reden["redner",],
date = reden["date",]),
talks = tibble(rede_id = parts["rede_id", ],
redner = parts["redner", ],
list(speeches = tibble(id = speeches["id",], speaker = speeches["speaker",],
date = speeches["date",]),
talks = tibble(speech_id = parts["speech_id", ],
speaker = parts["speaker", ],
content = parts["content", ]),
comments = tibble(rede_id = comments["rede_id",],
on_redner = comments["on_redner",],
comments = tibble(speech_id = comments["speech_id",],
on_speaker = comments["on_speaker",],
type = comments["type",],
fraktion = comments["fraktion",],
kommentator = comments["kommentator",],
content = comments["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)
# create a tibble of speaker from a list of xml nodes representing speaker
parse_speakerliste <- function(speakerliste_xml) {
d <- sapply(speakerliste_xml, parse_speaker)
tibble(id = d["id",],
vorname = d["vorname",],
nachname = d["nachname",],
@@ -208,8 +208,8 @@ parse_rednerliste <- function(rednerliste_xml) {
#' @export
write_to_csv <- function(tables, path="csv/", create=F) {
check_directory(path, create)
write.table(tables$redner, str_c(path, "redner.csv"))
write.table(tables$reden, str_c(path, "reden.csv"))
write.table(tables$speaker, str_c(path, "speaker.csv"))
write.table(tables$speeches, str_c(path, "speeches.csv"))
write.table(tables$talks, str_c(path, "talks.csv"))
write.table(tables$comments, str_c(path, "comments.csv"))
write.table(tables$applause, str_c(path, "applause.csv"))
@@ -217,12 +217,12 @@ write_to_csv <- function(tables, path="csv/", create=F) {
#' @export
read_from_csv <- function(path="csv/") {
list(redner = read.table(str_c(path, "redner.csv")) %>%
list(speaker = read.table(str_c(path, "speaker.csv")) %>%
tibble() %>%
mutate(id = as.character(id)),
reden = read.table(str_c(path, "reden.csv")) %>%
speeches = read.table(str_c(path, "speeches.csv")) %>%
tibble() %>%
mutate(redner = as.character(redner)),
mutate(speaker = as.character(speaker)),
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")))
@@ -234,8 +234,8 @@ read_from_csv <- function(path="csv/") {
# make sure data ist downloaded via fetch.R
# res <- read_one("records/19126-data.xml")
#
# res$redner
# res$reden
# res$speaker
# res$speeches
# res$talks
# -------------------------------