#' @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_speaker <- function(tb, res, fraktion_only = F) { joined <- left_join(tb, res$speaker, by=c("speaker" = "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"="#AAAAFF", Fraktionslos="#AAAAAA" ) party_order <- factor(c("Fraktionslos", "AfD&Fraktionslos", "DIE LINKE", "BÜNDNIS 90 / DIE GRÜNEN", "SPD", "CDU/CSU", "FDP", "AfD", NA_character_)) #' @export bar_plot_fractions <- function(tb, x_variable = NULL, # default is fraktion y_variable = NULL, # default is n fill = NULL, # default is fraktion title = NULL, xlab = "Fraction", ylab = "n", filllab = "Fraction", flipped = TRUE, position = "dodge", reorder = FALSE) { # capture expressions in arguments fill <- enexpr(fill) y_variable <- enexpr(y_variable) x_variable <- enexpr(x_variable) # set default values if (is.null(fill)) fill <- expr(fraktion) if (is.null(y_variable)) y_variable <- expr(n) if (is.null(x_variable)) x_variable <- expr(fraktion) # either reorder fraction factor by variable value if (reorder) maps <- aes(x = reorder(!!x_variable, -!!y_variable), y = !!y_variable, fill = reorder(!!fill, -!!y_variable)) # or reorder fraction factor by party seat order in parliament (default) else maps <- aes(x = factor(!!x_variable, levels = party_order), y = !!y_variable, fill = factor(!!fill, levels = party_order)) # make a bar plot ggplot(tb, maps) + scale_fill_manual(values = party_colors, na.value = "#555555") + xlab(xlab) + ylab(ylab) + labs(fill = filllab) + ggtitle(title) + geom_bar(stat = "identity", position = position) -> plt # if flipped == TRUE, draw bars horizontally (default TRUE) if (flipped) plt + coord_flip() else plt } # 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$speeches, by=c("speech_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 }