3d Hexagon Map for Covid in Austria [experimental] (https://twitter.com/matschnetzer/status/1459092614318333957?s=20)

hexagon.R

library(tidyverse)
library(sf)
library(msthemes)
library(rayshader)
library(wesanderson)

# Download the map here: https://github.com/ginseng666/GeoJSON-TopoJSON-Austria/tree/master/2021
map <- st_read("bezirke_999_geo.json") %>%
  mutate(iso = as.numeric(iso),
         iso = ifelse(iso %in% 901:923, 900, iso)) %>%
  group_by(iso) %>% 
  summarise(across(geometry, ~ sf::st_union(.)), .groups = "keep") %>%
  summarise(across(geometry, ~ sf::st_combine(.)))

# Download the data here: https://www.data.gv.at/katalog/dataset/4b71eb3d-7d55-4967-b80d-91a3f220b60c
impf <- read.csv2("CovidFaelle_Timeline_GKZ.csv") %>%
  mutate(Time = as.Date(Time, "%d.%m.%Y")) %>%
  group_by(GKZ) %>% arrange(desc(Time)) %>% slice(1) %>%
  select(iso = GKZ, inzidenz = SiebenTageInzidenzFaelle)

# Source for code for hexagon map here: https://rpubs.com/dieghernan/beautifulmaps_I
shape <- map %>% left_join(impf) %>% st_transform(3857) %>%
  mutate(index_target = 1:n())

target <- st_geometry(shape)

grid <- st_make_grid(target,
                     cellsize = 15 * 1000,
                     crs = st_crs(shape),
                     what = "polygons",
                     square = FALSE)

grid <- st_sf(index = 1:length(lengths(grid)), grid)

cent_grid <- st_centroid(grid)
cent_merge <- st_join(cent_grid, shape, left = FALSE)
grid_new <- inner_join(grid, st_drop_geometry(cent_merge))
bezirke <- grid_new %>% group_by(iso) %>%
  summarise(across(grid, ~ sf::st_union(.)), .groups = "keep") %>%
  summarise(across(grid, ~ sf::st_combine(.)))

pal <- wes_palette("Zissou1", 100, type = "continuous")

bezplot <- ggplot() +
  geom_sf(data = grid_new, size = 0.1, aes(fill = inzidenz)) +
  geom_sf(data = bezirke, size = 0.3, color = "black", fill = NA) +
  scale_fill_gradientn(colours = pal, name = "", 
                       guide = guide_colorbar(barheight = 10, barwidth = 0.3)) +
  coord_sf(expand = FALSE) +

  theme_ms(grid = F, alttf = T) +
  theme(legend.position = "none",
        axis.text = element_blank())

bezplotflat <- bezplot + 
  labs(title = "Corona-Inzidenz nach Bezirken",
       caption = "Daten: AGES. Grafik: @matschnetzer") +
  theme(legend.position = "right")

png(filename = "hexagon.png", units = "in", width = 5, height = 5, res = 320)
par(mfrow = c(2, 1))
plot_gg(bezplotflat, width = 7.5, height = 4, raytrace = FALSE, preview = TRUE)
plot_gg(bezplot, width = 7, height = 4, scale = 300, multicore = TRUE,
        windowsize = c(1200, 700), fov = 70, zoom = 0.45, theta = 5, phi = 50)
Sys.sleep(0.2)
render_snapshot(clear = TRUE)
dev.off()