R/plot_map.R

In statistikat/coronar: corona austria

globalVariables(c(
  ".", "id", "bezirke", "freq_rel"
))

#' Leaflet-Karte mit relativen Fallzahlen pro Bundesland
#' 
#' [plot_map()] .
#' @param region 1:9 Burgenland, Kärnten, Niederösterreich, Oberösterreich,
#'   Salzburg, Steiermark, Tirol, Vorarlberg, Wien
#' @param color_cutoff Bis zu welchem perzentil soll die Farbskala gehen.
#'   Der default Wert (`0.9`) sagt aus, dass die Farbskala mit dem 90%
#'   perzentil der relativen Fallzahlen endet.
#' @param timestamp wird an [data_corona()] weitergegeben.
#' @importFrom magrittr %$%
#' @import leaflet
#' @export
plot_map <- function(region = 1:9, color_cutoff = 0.9, timestamp = NULL) {
  data_bezirke <- data_corona(timestamp = timestamp) %$% 
    bezirke %>% 
    merge(coronaAT::geo_bez, all = TRUE) %>% 
    dplyr::mutate(freq_rel = freq/population*100000) %>% 
    dplyr::mutate(freq_rel = ifelse(is.na(freq_rel), 0, freq_rel)) %>% 
    dplyr::mutate(freq_top = pmin(freq_rel, stats::quantile(freq_rel, color_cutoff, na.rm = TRUE)))
  
  pal = leaflet::colorNumeric(
    grDevices::colorRamp(c("green", "red")),
    domain = data_bezirke$freq_top
  )
  
  polygons_bezirke <- data_bezirke %>%
    sp::merge(coronaAT::map_AT, .) %>%
    subset(substr(id, 1, 1) %in% region)
  
  polygons_nuts2 <- maptools::unionSpatialPolygons(
    polygons_bezirke, 
    substr(polygons_bezirke$id, 1, 1)
  )

  leaflet(polygons_bezirke) %>% 
    addProviderTiles(leaflet::providers$CartoDB.Positron) %>% 
    addPolygons(data = polygons_nuts2, fillOpacity = 1, weight = 2, 
                color = "black", fillColor = "white") %>%
    addPolygons(
      fillColor = ~pal(freq_top),
      weight = .5, color = "black", fillOpacity = .4,
      label = ~paste(
        "<b>", name, "</b><br>F&auml;lle: ", freq, "<br>",
        "Einwohner:", format(population, big.mark = " "), "<br>",
        "Fl&auml;che (km<sup>2</sup>):", format(area, big.mark = " "), "<br>",
        "Infizierte pro 100 000 EW: ", round(freq_rel, 2)
      ) %>% lapply(htmltools::HTML)
    ) %>% 
    addLegend(
      title = "F&auml;lle pro 100 000 EW<br/>(top coded)<br/><a href='https://info.gesundheitsministerium.at' target='_blank'>Quelle</a>",
      pal = pal,
      values = ~freq_top, position = "topleft"
    )
}