hateimparlament/R/analyze.R

#' @export
find_word <- function(res, word) {
    talks <- res$talks
    mutate(talks, occurences = sapply(str_match_all(talks$content, regex(word, ignore_case = TRUE)),
           nrow))
}

#' @export
join_redner <- function(tb, res, fraktion_only = F) {
    joined <- left_join(tb, res$redner, by=c("redner" = "id"))
    if (fraktion_only) select(joined, "fraktion")
    else joined
}

#' @export
party_colors <- c(
  AfD="#1A9FDD",
  FDP="#FEEB34",
  "CDU/CSU"="#000000", 
  SPD="#DF0B25",
  "BÜNDNIS 90 / DIE GRÜNEN"="#4A932B",
  "DIE LINKE"="#BC3475",
  "AfD&Fraktionslos"="#1A9FDD",
  Fraktionslos="#FEEB34"
)

#' @export
bar_plot_fraktionen <- function(tb, variable, fill, title=NULL, xlab = "Fraction",
                                ylab="n", filllab="Fraction") {
    ggplot(tb, aes(x = reorder(fraktion, -{{variable}}), y = {{variable}}, fill = {{fill}})) +
        scale_fill_manual(values = party_colors) +
        xlab(xlab) +
        ylab(ylab) +
        labs(fill = filllab) +
        ggtitle(title) +
        geom_bar(stat = "identity") + coord_flip()
}

# Counts how many talks do match a given pattern and summarises by date
#
#' @export
word_usage_by_date <- function(res, patterns, name, tidy=F) {
    tb <- res$talks
    nms <- names(patterns)
    for (i in seq_along(patterns)) {
        if (!is.null(nms)) name <- nms[[i]]
        else name <- patterns[[i]]
        tb <- mutate(tb, {{name}} := str_count(content, patterns[[i]]))
    }
    left_join(tb, res$reden, by=c("rede_id" = "id")) %>%
        group_by(date) %>%
        summarize(across(where(is.numeric), sum)) %>%
        arrange(date) -> tb
    if (!tidy) pivot_longer(tb, where(is.numeric) , names_to = "pattern", values_to="count")
    else tb
}