R/plot_bl_cleveland.R

In statistikat/coronar: corona austria

globalVariables(c("gm", "change"))

#' Zeige Veränderungen in relativen Fallzahlen (21.03, - Heute)
#' 
#' Visualisiere die Anzahl der Fälle pro 100000 Einwohner für jedes Bundesland
#' für den ersten und letzten verfügbaren Zeitpunkt aus coronaDAT
#' 
#' @param label_offset Wie weit sollen die Fallzahlen von den Datenpunkten
#'   entfernt dargestellt werden.
#' @examples
#' plot_bl_cleveland()
#' @export
plot_bl_cleveland <- function(label_offset = .15) {
  ts_bl <- data_corona_ts()$ts_bundesland
  
  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")
  )
  
  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
  
  plot_data <- ts_bl %>% 
    dplyr::filter(date %in% range(date)) %>%
    dplyr::mutate(population = rep(population, 2)) %>% 
    merge(bl_labels) %>% 
    dplyr::mutate(freq = round(freq/population * 100000, 2)) 
  
  plot_data <- plot_data %>% 
    dplyr::group_by(bundesland) %>% 
    dplyr::arrange(date) %>% 
    dplyr::mutate(gm = sqrt(prod(freq))) %>% 
    dplyr::mutate(change = paste0("+", round((freq[2]/freq[1] - 1) * 100), "%")) %>% 
    dplyr::ungroup()
  
  plot_data <- plot_data %>% 
    dplyr::arrange(freq) %>%
    dplyr::mutate(label = factor(label, levels = unique(label)))
  
  ggplot(plot_data, aes(freq, label, color = as.factor(date))) +
    geom_line(aes(group = bundesland), color = "black", alpha = .2, size = 3.5) +
    geom_point(size = 5) +
    scale_x_continuous(trans = "log", breaks = c(15, 20, 30, 40, 50, 70, 100,
                                                 130, 170)) +
    geom_text(aes(label = freq, freq *
                    exp(label_offset*ifelse(date == max(date), 1, -1)))) +
    theme_minimal() +
    ylab("") +
    ggtitle("Ver\u00e4nderungen der relativen Fallzahlen") +
    xlab("Best\u00e4tigte F\u00e4lle pro 100 0000 Einwohner") +
    theme(legend.position = "top", legend.title = element_blank()) +
    geom_text(aes(gm, label = change), color = "black", alpha = .5, size = 3)
}