R/plot_confirmed_bl.R

Defines functions .add_population plot_confirmed_bl

Documented in plot_confirmed_bl

globalVariables(c(
  "bundesland", "freq", "nuts2_id", "population", "label"
))

.add_population <- function(dat, relative = FALSE) {
  if (!relative)
    return(dat)
  dat %>% 
    dplyr::mutate(
      population = coronaAT::geo_bez %>% 
        dplyr::mutate(nuts2_id = substring(id, 1, 1)) %>% 
        dplyr::group_by(nuts2_id) %>% 
        dplyr::summarise(population = sum(population, na.rm = TRUE)) %$% 
        population
    ) %>% 
    dplyr::mutate(freq = round(freq/population * 100000, 2))
}

#' Balkendiagramm mit absoluten oder relativen Fallzahlen pro Bundesland
#'
#' @param relative Sollen absolute oder relative Häufigkeiten angezeigt werden?
#' @param offset_text Verchiebung des Textlayer, welcher die Häufigkeiten
#'   in der Grafik anzeigt.
#' @param timestamp wird an [data_corona()] weitergegeben.
#' @export
#' @examples 
#' plot_confirmed_bl()
#' plot_confirmed_bl(relative = FALSE)
#' @import ggplot2
plot_confirmed_bl <- function(relative = TRUE, offset_text = NULL,
                              timestamp = NULL) {
  if (is.null(offset_text))
    offset_text <- ifelse(relative, 7, 45)
  md <- data_corona(timestamp = timestamp)
  bl_labels <- data.frame(
    label = c("Tirol", "Ober\u00f6sterreich", "Nieder\u00f6sterreich", "Wien",
              "Steiermark", "Salzburg", "Vorarlberg", "K\u00e4rnten", "Burgenland"),
    bundesland = c("T", "O\u00d6", "N\u00d6", "W", "Stmk", "Sbg", "Vbg", "Ktn", "Bgld")
  )
  md$bundesland %>% 
    .add_population(relative) %>% 
    merge(bl_labels) %>% 
    dplyr::arrange(freq) %>% 
    dplyr::mutate(label = factor(label, levels = unique(label))) %>% 
    ggplot(aes(label, freq)) + geom_col(fill = "steelblue") +
    xlab("Bundesland") + 
    ggtitle("Coronaf\u00e4lle nach Bundesland", 
            paste("Stand:", md$timestamp)) +
    coord_flip() + theme_minimal() + xlab("") +
    ylab(ifelse(relative, "F\u00e4lle pro 100 000 Einwohner", "F\u00e4lle")) +
    geom_text(aes(label = freq, y = freq + offset_text), color = "steelblue")
}
statistikat/coronar documentation built on April 6, 2020, 6:25 p.m.