├── .gitignore ├── 30DayMapChallenge-2021.Rproj ├── LICENSE.md ├── R ├── day01-points.R ├── day02-lines.R ├── day03-polygons-football-clubs.R ├── day04_hexagons.R ├── day05-data_osm-bike-lanes.R ├── day06-red.R ├── day07-green.R ├── day08-blue-housing.R ├── day09-monochrome-buildings.R ├── day09-monochrome-streets.R ├── day11-3d.R ├── day12-population.R ├── day13-naturalearth.R ├── day14-datawrapper-chart.Rmd ├── day14-datawrapper-chart.html ├── day14-datawrapper-chart.md ├── day14-datawrapper-prep.R ├── day16-urban-rural-de-us.R ├── day16-urban-rural-trees.R ├── day17-land_use.R ├── day20-movement.R ├── day24-historical-roman-empire.R ├── day26-choropleth-unemployment.R ├── day27-heatmap.R └── day28-earth-not-flat.R ├── Readme.Rmd ├── Readme.md └── plots ├── day01_points_01.png ├── day02_lines.png ├── day03_polygons_football_grounds.png ├── day04_hexagons.png ├── day05_osmdata_bike-lanes.png ├── day06_red_vote-share-spd_de.png ├── day06_red_vote-share-spd_en.png ├── day07_green_vote-share-greens_de.png ├── day07_green_vote-share-greens_en.png ├── day08-blue-area_living_inset.png ├── day09_monochrome-streets.png ├── day09_monochrome_buildings.png ├── day09_monochrome_buildings_lres.png ├── day11-3d-turnout.gif ├── day11-3d-turnout.mp4 ├── day11-3d-turnout_optimized.gif ├── day11-3d-turnout_snapshot.png ├── day12-population-animated.gif ├── day13_naturalearth.png ├── day16-two-cities-of-cologne.png ├── day16_urban-rural_trees.png ├── day17-landuse-en.png ├── day17-landuse-en_facets.png ├── day17-landuse.png ├── day24-historical.png ├── day26-choropleth_alo_facets.png ├── day27-heatmap-3d.png ├── day27-heatmap.png ├── day28_earth-not-flat.png └── day28_earth-not-flat_with_cologne.png /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .DS_Store 6 | .RDataTmp 7 | -------------------------------------------------------------------------------- /30DayMapChallenge-2021.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 30DayMapChallenge-2021 authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /R/day01-points.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", 2 | "sf", "osmdata", "geojsonsf", "jsonlite") 3 | 4 | 5 | ## GEOMETRIES ================================================================== 6 | ## Area of Cologne 7 | coords_cgn <- getbb("Cologne, Germany", format_out = "sf_polygon") 8 | coords_cgn 9 | coords_cathedral <- getbb("Kölner Dom, Cologne, Germany", 10 | featuretype = "church") 11 | 12 | 13 | ## GET DATA ================================= 14 | #' Child care centers in Cologne 15 | #' Source: Offene Daten Köln, 16 | #' https://www.offenedaten-koeln.de/dataset/kindertagesstaetten-koeln 17 | 18 | url_kitas_private <- "https://geoportal.stadt-koeln.de/arcgis/rest/services/familie_partnerschaft_kinder/kitas/MapServer/0/query?where=objectid+is+not+null&text=&objectIds=&time=&geometry=&geometryType=esriGeometryEnvelope&inSR=&spatialRel=esriSpatialRelIntersects&distance=&units=esriSRUnit_Foot&relationParam=&outFields=*&returnGeometry=true&returnTrueCurves=false&maxAllowableOffset=&geometryPrecision=&outSR=4326&havingClause=&returnIdsOnly=false&returnCountOnly=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&returnZ=false&returnM=false&gdbVersion=&historicMoment=&returnDistinctValues=false&resultOffset=&resultRecordCount=&returnExtentOnly=false&datumTransformation=¶meterValues=&rangeValues=&quantizationParameters=&featureEncoding=esriDefault&f=pjson" 19 | url_kitas_public <- "https://geoportal.stadt-koeln.de/arcgis/rest/services/familie_partnerschaft_kinder/kitas/MapServer/1/query?where=objectid+is+not+null&text=&objectIds=&time=&geometry=&geometryType=esriGeometryEnvelope&inSR=&spatialRel=esriSpatialRelIntersects&distance=&units=esriSRUnit_Foot&relationParam=&outFields=*&returnGeometry=true&returnTrueCurves=false&maxAllowableOffset=&geometryPrecision=&outSR=4326&havingClause=&returnIdsOnly=false&returnCountOnly=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&returnZ=false&returnM=false&gdbVersion=&historicMoment=&returnDistinctValues=false&resultOffset=&resultRecordCount=&returnExtentOnly=false&datumTransformation=¶meterValues=&rangeValues=&quantizationParameters=&featureEncoding=esriDefault&f=pjson" 20 | kitas_private_sf <- st_read(url_kitas_private) 21 | kitas_public_sf <- st_read(url_kitas_public) 22 | 23 | kitas_sf <- bind_rows(kitas_private_sf, kitas_public_sf, .id = "type") %>% 24 | mutate(type = ifelse(type == "1", "private", "public")) 25 | 26 | 27 | ## PLOT ======================================================================== 28 | 29 | # Download from https://toppng.com/show_download/154246/kolner-dom/large (creator: John3) 30 | cathedral_filepath <- here("toppng.com-kölner-dom-2000x3401.png") 31 | cathedral_img <- png::readPNG(cathedral_filepath) 32 | 33 | point_colors <- c("private" = "#482d52", "public" = "grey68") 34 | 35 | # Annotations 36 | plot_titles <- list( 37 | title = str_to_upper("Kindergardens in Cologne, Germany"), 38 | subtitle = glue( 39 | "Locations of private and 40 | public kindergardens and 41 | day care centers"), 42 | caption = "Data: **Open Data Cologne** (last update: 2021-10-29), 43 | **OpenStreetMap** | 44 | Visualization: **Ansgar Wolsing** | 45 | Image credit Cologne Cathedral: **John3** (toppng.com)" 46 | ) 47 | 48 | ggplot(coords_cgn) + 49 | geom_sf(fill = "#d1a1e3", color = "grey91", size = 0.25) + 50 | # mer losse d'r Dom in Kölle 51 | ggimage::geom_image(data = as.data.frame(t(coords_cathedral[, "min"])), 52 | aes(x, y), 53 | image = cathedral_filepath, 54 | alpha = 0.3, size = 0.5, col = "#854e99") + 55 | geom_sf(data = kitas_sf, 56 | aes(geometry = geometry, 57 | fill = type), 58 | shape = 21, col = "white", size = 2, alpha = 0.6, 59 | show.legend = FALSE) + 60 | scale_fill_manual(values = point_colors) + 61 | coord_sf() + 62 | labs( 63 | title = plot_titles$title, 64 | subtitle = plot_titles$subtitle, 65 | caption = plot_titles$caption 66 | ) + 67 | cowplot::theme_map(font_family = "Montserrat") + 68 | theme( 69 | plot.background = element_rect(color = NA, fill = "#854e99"), 70 | legend.position = "top", 71 | legend.justification = "left", 72 | text = element_text(color = "grey93", lineheight = 1.3), 73 | plot.title = element_textbox_simple(color = "white", size = 24, 74 | family = "Source Sans Pro", 75 | # face = "bold", 76 | margin = margin(t = 4, b = 12)), 77 | plot.subtitle = element_textbox_simple(size = 16, 78 | margin = margin(t = 4, b = 0)), 79 | plot.caption = element_textbox_simple(size = 8, 80 | margin = margin(t = 8, b = 8))) 81 | ggsave(here("plots", "day01_points_01.png"), dpi = 600, width = 8, height = 8) 82 | 83 | 84 | 85 | -------------------------------------------------------------------------------- /R/day02-lines.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", 2 | "sf", "osmdata", "paletteer", "rvest", "rnaturalearth", 3 | "stars") 4 | 5 | #' https://github.com/ropensci/rnaturalearth 6 | #' https://www.naturalearthdata.com/features/ 7 | # Download shaded relief raster (SR) in high/low resolution (HR/LR) 8 | dir_raster <- here("data", "raster_data", "SR_LR") 9 | if (!file.exists(dir_raster)) { 10 | ne_download(scale = 50, type = "SR_LR", category = "raster", 11 | destdir = dir_raster, load = FALSE) 12 | } 13 | 14 | # Read raster data for relief 15 | relief <- raster::raster(here(dir_raster, "SR_LR.tif")) %>% 16 | as("SpatialPixelsDataFrame") %>% 17 | as.data.frame() %>% 18 | rename(value = SR_LR) 19 | 20 | relief_filtered <- relief %>% 21 | filter(x >= 4, x <= 10, y >= 46, y <= 52.5) %>% 22 | mutate(geometry = map2(x, y, ~st_point(c(.x, .y)))) %>% 23 | st_as_sf() 24 | st_crs(relief_filtered) <- "EPSG:4326" 25 | 26 | rm(list = c("relief")) 27 | 28 | coords_rhine <- opq(bbox = 'Cologne, Germany') %>% 29 | add_osm_feature(key = 'name:de', value = 'Rhein', value_exact = TRUE) %>% 30 | osmdata_sf() 31 | 32 | coords_cathedral <- getbb("Kölner Dom, Cologne, Germany", 33 | featuretype = "church") 34 | 35 | ggplot() + 36 | # Relief 37 | geom_raster(data = relief_filtered, 38 | aes(x, y, alpha = value), fill = "white", 39 | show.legend = FALSE) + 40 | # The Rhine river course 41 | geom_sf(data = coords_rhine$osm_lines, 42 | col = "#1d7cdb", size = 1.1) + 43 | # Marker and label for Cologne 44 | geom_point(aes(coords_cathedral["x", "min"], 45 | coords_cathedral["y", "min"]), 46 | shape = 25, fill = "grey8", col = "white", size = 7) + 47 | annotate("label", label = "Cologne", 48 | x = coords_cathedral["x", "min"] + 0.2, 49 | y = coords_cathedral["y", "min"], 50 | size = 4, label.size = 0, label.r = unit(0.05, "lines"), 51 | fill = "grey12", col = "white", alpha = 0.6, 52 | hjust = 0, 53 | family = "Roboto", fontface = "bold") + 54 | # TITLE + key facts 55 | annotate("richtext", 56 | label = "The Rhine", 57 | x = 4.1, y = 49.5, 58 | family = "Noto Serif Display", 59 | size = 18, col = "grey2", 60 | label.color = NA, fill = NA, 61 | hjust = 0, 62 | ) + 63 | annotate("richtext", 64 | label = "Source: Rein Anteriur, CH
65 | Mouth: North Sea, NL
66 | Length: 1,233 km", 67 | x = 4.2, y = 49.15, 68 | family = "Noto Serif Display", 69 | size = 5, col = "grey11", 70 | label.color = NA, fill = NA, 71 | hjust = 0, vjust = 1, lineheight = 1.3 72 | ) + 73 | scale_alpha(c(0.7, 0)) + 74 | labs(caption = "Data: **Natural Earth**, **OpenStreetMap** | 75 | Visualization: **Ansgar Wolsing**", 76 | x = NULL, y = NULL) + 77 | coord_sf(xlim = c(4.01, 10), expand = FALSE) + 78 | theme_minimal(base_family = "Roboto") + 79 | theme(plot.background = element_rect(color = NA, fill = "grey98"), 80 | panel.background = element_rect(color = NA, fill = "#b8a149"), 81 | panel.grid = element_blank(), 82 | plot.margin = margin(t = 0, l = 16, r = 16, b = 2), 83 | plot.caption = element_markdown(family = "Roboto", size = 11, 84 | hjust = 0.5, color = "grey35", 85 | margin = margin(t = 20, b = 6))) 86 | ggsave(here("plots", "day02_lines.png"), dpi = 600, 87 | width = 6, height = 10) 88 | 89 | -------------------------------------------------------------------------------- /R/day03-polygons-football-clubs.R: -------------------------------------------------------------------------------- 1 | #' INSPIRATION: https://github.com/VictimOfMaths/30DayMapChallenge/blob/main/Day3_Polygons.R 2 | #' Colin Angus 3 | 4 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", 5 | "sf", "osmdata", "paletteer", "rvest", "jsonlite") 6 | 7 | ## GEOMETRIES ================================================================== 8 | ## Area of Cologne 9 | cgn_polygon <- getbb("Cologne, Germany", format_out = "sf_polygon") 10 | st_crs(cgn_polygon) <- "EPSG:4326" 11 | 12 | #' Football clubs in Cologne 13 | #' https://de.wikipedia.org/wiki/Kategorie:Fu%C3%9Fballverein_aus_K%C3%B6ln 14 | page <- read_html("https://de.wikipedia.org/wiki/Kategorie:Fu%C3%9Fballverein_aus_K%C3%B6ln") 15 | clubs <- html_nodes(page, "div.mw-category ul a") %>% 16 | html_text() 17 | clubs 18 | 19 | # Limit to clubs down to Oberliga (5th division) 20 | clubs_1to5div <- c("1. FC Köln", 21 | "SV Deutz 05", 22 | "FC Junkersdorf", 23 | "FC Pesch", 24 | "SC Fortuna Köln", 25 | "FC Viktoria Köln") 26 | 27 | #' Football grounds 28 | #' Search on Google Maps 29 | grounds <- tibble( 30 | club = clubs_1to5div, 31 | ground = c("RheinEnergie Stadion", 32 | "BB Bank Sportpark", 33 | "Ostkampfbahn", 34 | "Helmut-Kusserow-Sportanlage", 35 | "Südstadion", 36 | "Sportpark Höhenberg"), 37 | coordinates = st_sfc( 38 | st_point(c(6.875, 50.933611)), 39 | st_point(c(6.9791233, 50.9259744)), 40 | st_point(c(6.8755043, 50.933527)), 41 | st_point(c(6.8688709, 51.001883)), 42 | st_point(c(6.94361, 50.9175)), 43 | st_point(c(7.03039, 50.9452)) 44 | ), 45 | club_icon = c( 46 | here("data", "Emblem_1.FC_Köln.svg"), 47 | here("data", "Logo_Deutz_05.svg"), 48 | here("data", "LOGO_FC_Junkersdorf.svg"), 49 | here("data", "FC_Pesch_Logo.svg"), 50 | here("data", "SC_Fortuna_Koeln_Logo_since_2019.svg"), 51 | here("data", "FC_Viktoria_Köln_1904_Logo.svg") 52 | ) 53 | ) %>% 54 | st_as_sf(crs = 4326) 55 | 56 | grounds2 <- grounds %>% 57 | # exclude FC Junkersdorf which uses a ground at Sportpark Müngersdorf (1. FC Köln) 58 | filter(club != "FC Junkersdorf") 59 | 60 | 61 | #' Club icons 62 | #' Attributions: 63 | #' Viktoria Köln: Von FC Viktoria Köln 1904 e.V. - Extracted from PDF [1] and converted to SVG, Gemeinfrei, https://commons.wikimedia.org/w/index.php?curid=85249908 64 | #' 1. FC Köln: Von Autor unbekannt - https://fc.de/typo3conf/ext/bra_projectfiles/Resources/Public/vorschaltseite/img/svg/01-logo.svg, Gemeinfrei, https://commons.wikimedia.org/w/index.php?curid=99279386 65 | #' SV Deutz 05: Von Sportvereinigung Deutz 05 e. V. - vectorized from Sportvereinigung Deutz 05 e. V.-Website [1], Gemeinfrei, https://commons.wikimedia.org/w/index.php?curid=85273833 66 | #' Fortuna Köln: Von S.C. Fortuna Köln e.V. - S.C. Fortuna Köln e.V. - SVG extracted from [1], Gemeinfrei, https://commons.wikimedia.org/w/index.php?curid=86903779 67 | #' FC Pesch: Von FC Pesch 1956 e.V. - FC Pesch 1956 e.V., Gemeinfrei, https://commons.wikimedia.org/w/index.php?curid=86282215 68 | #' FC Junkersdorf: Von FC Junkersdorf 1946 e.V. - FC Junkersdorf 1946 e.V., Gemeinfrei, https://commons.wikimedia.org/w/index.php?curid=85519922 69 | 70 | 71 | ## VORONOI TESSELATION ========================================================= 72 | 73 | # Create Voronoi cells based on club grounds 74 | voronoi <- grounds2 %>% 75 | st_union() %>% 76 | st_voronoi() %>% 77 | st_collection_extract() 78 | 79 | # intersect with Cologne shape 80 | voronoi <- voronoi[unlist(st_intersects(grounds2, voronoi))] %>% 81 | st_intersection(cgn_polygon) 82 | 83 | 84 | ## PLOT ======================================================================== 85 | 86 | seed <- 4711 87 | set.seed(seed) 88 | p <- voronoi %>% 89 | ggplot() + 90 | geom_sf(aes(fill = sample(grounds2$club, size = nrow(grounds2), replace = FALSE)), 91 | col = "white", size = 0.5, show.legend = FALSE) + 92 | geom_sf(data = grounds2, 93 | aes(geometry = coordinates), size = 3, 94 | shape = 21, col = "white", fill = "grey12") + 95 | ggimage::geom_image(data = grounds2, 96 | aes(x = st_coordinates(coordinates)[, "X"], 97 | y = st_coordinates(coordinates)[, "Y"], 98 | image = club_icon), 99 | inherit.aes = FALSE) + 100 | geom_sf_label(data = grounds2, 101 | aes(geometry = coordinates, label = club), 102 | size = 3, label.size = 0, label.r = unit(0.05, "lines"), 103 | fill = "grey12", col = "white", alpha = 0.6, 104 | hjust = 0, nudge_x = 0.012, nudge_y = -0.005, 105 | family = "Chivo") + 106 | scale_fill_paletteer_d("cartography::green.pal", dynamic = TRUE) + 107 | labs( 108 | # title = "Support your local club", 109 | title = "Mer stonn zo dir, FC Kölle*", 110 | subtitle = "Nearest (semi)-professional football teams' grounds to every point in Cologne", 111 | caption = "\\*Translation: We stand by you, FC Kölle.

112 | Data: **OpenStreetMap** | Visualization: **Ansgar Wolsing** | 113 | Images credits: Wikipedia, the respective clubs") + 114 | cowplot::theme_map() + 115 | theme(plot.background = element_rect(color = NA, fill = "#1D1D59"), 116 | text = element_text(family = "Roboto Light", color = "white"), 117 | plot.title = element_markdown(family = "Roboto", size = 28, 118 | margin = margin(b = 18)), 119 | plot.subtitle = element_textbox_simple(size = 14), 120 | plot.caption = element_textbox_simple(size = 9) 121 | ) 122 | set.seed(seed) 123 | ggsave(here("plots/day03_polygons_football_grounds.png"), 124 | plot = p, dpi = 600, width = 8, height = 8) 125 | 126 | 127 | # Adding an annotation for the missing FC Junkersdorf 128 | coords_junkersdorf <- grounds$coordinates[grounds$club == "FC Junkersdorf"] 129 | lat_junkersdorf <- st_coordinates(coords_junkersdorf)[, "X"] 130 | lon_junkersdorf <- st_coordinates(coords_junkersdorf)[, "YY"] 131 | 132 | p + 133 | ggimage::geom_image(aes(x = lat_junkersdorf - 0.095, 134 | y = lon_junkersdorf - 0.05, 135 | image = grounds$club_icon[grounds$club == "FC Junkersdorf"]), 136 | inherit.aes = FALSE) + 137 | geom_textbox(x = lat_junkersdorf - 0.095, y = lon_junkersdorf -0.05, 138 | label = "FC Junkersdorf (5th division)", 139 | width = unit(50, "mm"), fill = NA, box.color = NA, hjust = 0, 140 | family = "Roboto", color = "white", size = 3.5) 141 | ggsave(here("plots/day03_polygons_football_grounds_w_junkersdorf.png"), 142 | dpi = 600, width = 8, height = 8) 143 | 144 | -------------------------------------------------------------------------------- /R/day04_hexagons.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", "scico", 2 | "sf", "osmdata", "geojsonsf", "jsonlite", "lubridate") 3 | 4 | 5 | ## LOAD GEOMETRY =============================================================== 6 | 7 | #' https://www.offenedaten-koeln.de/dataset/stadtteile 8 | #' https://www.offenedaten-koeln.de/sites/default/files/Stadtteil.zip 9 | shp_districts <- st_read(here("data", "cologne_stadtteile", "Stadtteil", "Stadtteil.shp")) 10 | 11 | #' https://offenedaten-koeln.de/dataset/stadtbezirke-koeln 12 | url_boroughs <- "https://geoportal.stadt-koeln.de/arcgis/rest/services/Basiskarten/kgg/MapServer/4/query?where=objectid+is+not+null&text=&objectIds=&time=&geometry=&geometryType=esriGeometryEnvelope&inSR=&spatialRel=esriSpatialRelIntersects&distance=&units=esriSRUnit_Foot&relationParam=&outFields=*&returnGeometry=true&returnTrueCurves=false&maxAllowableOffset=&geometryPrecision=&outSR=4326&havingClause=&returnIdsOnly=false&returnCountOnly=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&returnZ=false&returnM=false&gdbVersion=&historicMoment=&returnDistinctValues=false&resultOffset=&resultRecordCount=&returnExtentOnly=false&datumTransformation=¶meterValues=&rangeValues=&quantizationParameters=&featureEncoding=esriDefault&f=pjson" 13 | boroughs_sf <- st_read(here("data", "cologne_stadtbezirke", "stadtbezirke_koeln.json")) 14 | 15 | 16 | ## CREATE A HONEYCOMB GRID ===================================================== 17 | #' Intro to creating hexmaps with sf 18 | #' https://rpubs.com/dieghernan/beautifulmaps_I 19 | 20 | shape <- st_transform(shp_districts, 3857) %>% select(STT_NAME) 21 | initial <- shape 22 | initial$index_target <- 1:nrow(initial) 23 | target <- st_geometry(initial) 24 | 25 | # Create the grid of hexagons 26 | grid <- st_make_grid(target, 27 | cellsize = 2.5 * 1000, 28 | crs = st_crs(initial), 29 | what = "polygons", 30 | square = FALSE # for hex, TRUE for squares 31 | ) 32 | # Add index, transform list to dataframe 33 | grid <- st_sf(index = 1:length(lengths(grid)), grid) 34 | 35 | # We identify the grids that belongs to a entity by assessing the centroid 36 | cent_grid <- st_centroid(grid) 37 | cent_merge <- st_join(cent_grid, initial["index_target"], left = FALSE) 38 | grid_new <- inner_join(grid, st_drop_geometry(cent_merge)) 39 | 40 | 41 | ## LOAD DATA =================================================================== 42 | #' Child care centers in Cologne 43 | #' Source: Offene Daten Köln, 44 | #' https://www.offenedaten-koeln.de/dataset/kindertagesstaetten-koeln 45 | 46 | url_kitas_private <- "https://geoportal.stadt-koeln.de/arcgis/rest/services/familie_partnerschaft_kinder/kitas/MapServer/0/query?where=objectid+is+not+null&text=&objectIds=&time=&geometry=&geometryType=esriGeometryEnvelope&inSR=&spatialRel=esriSpatialRelIntersects&distance=&units=esriSRUnit_Foot&relationParam=&outFields=*&returnGeometry=true&returnTrueCurves=false&maxAllowableOffset=&geometryPrecision=&outSR=4326&havingClause=&returnIdsOnly=false&returnCountOnly=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&returnZ=false&returnM=false&gdbVersion=&historicMoment=&returnDistinctValues=false&resultOffset=&resultRecordCount=&returnExtentOnly=false&datumTransformation=¶meterValues=&rangeValues=&quantizationParameters=&featureEncoding=esriDefault&f=pjson" 47 | url_kitas_public <- "https://geoportal.stadt-koeln.de/arcgis/rest/services/familie_partnerschaft_kinder/kitas/MapServer/1/query?where=objectid+is+not+null&text=&objectIds=&time=&geometry=&geometryType=esriGeometryEnvelope&inSR=&spatialRel=esriSpatialRelIntersects&distance=&units=esriSRUnit_Foot&relationParam=&outFields=*&returnGeometry=true&returnTrueCurves=false&maxAllowableOffset=&geometryPrecision=&outSR=4326&havingClause=&returnIdsOnly=false&returnCountOnly=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&returnZ=false&returnM=false&gdbVersion=&historicMoment=&returnDistinctValues=false&resultOffset=&resultRecordCount=&returnExtentOnly=false&datumTransformation=¶meterValues=&rangeValues=&quantizationParameters=&featureEncoding=esriDefault&f=pjson" 48 | kitas_private_sf <- st_read(url_kitas_private) 49 | kitas_public_sf <- st_read(url_kitas_public) 50 | 51 | # Calculates the total daily hours from opening hours 52 | calculate_opening_duration <- function(from1, to1, from2, to2) { 53 | to1 - from1 + ifelse(!is.na(from2) & !is.na(to2), to2 - from2, seconds(0)) 54 | } 55 | 56 | kitas_sf <- bind_rows(kitas_private_sf, kitas_public_sf, .id = "type") %>% 57 | mutate(type = ifelse(type == "1", "private", "public")) %>% 58 | mutate(across(starts_with("einrichtungoeff_"), hms), 59 | # set to missing if opening time is "00:00:00" 60 | across(starts_with("einrichtungoeff_"), ~na_if(.x, seconds(0))), 61 | opening_duration = 62 | calculate_opening_duration(einrichtungoeff_mo1_von, 63 | einrichtungoeff_mo1_bis, 64 | einrichtungoeff_mo2_von, 65 | einrichtungoeff_mo2_bis) + 66 | calculate_opening_duration(einrichtungoeff_di1_von, 67 | einrichtungoeff_di1_bis, 68 | einrichtungoeff_di2_von, 69 | einrichtungoeff_di2_bis) + 70 | calculate_opening_duration(einrichtungoeff_mi1_von, 71 | einrichtungoeff_mi1_bis, 72 | einrichtungoeff_mi2_von, 73 | einrichtungoeff_mi2_bis) + 74 | calculate_opening_duration(einrichtungoeff_do1_von, 75 | einrichtungoeff_do1_bis, 76 | einrichtungoeff_do2_von, 77 | einrichtungoeff_do2_bis) + 78 | calculate_opening_duration(einrichtungoeff_fr1_von, 79 | einrichtungoeff_fr1_bis, 80 | einrichtungoeff_fr2_von, 81 | einrichtungoeff_fr2_bis), 82 | opening_duration_hours = as.numeric(opening_duration) / 3600 83 | ) 84 | 85 | rm(list = c("kitas_private_sf", "kitas_public_sf")) 86 | 87 | 88 | # Join the spacial objects to locate kindergardens in hexagons 89 | st_crs(grid_new) 90 | st_crs(kitas_sf) 91 | kitas_sf <- st_transform(kitas_sf, st_crs(grid_new)) 92 | grid_new_kitas <- st_join(grid_new, kitas_sf, join = st_intersects) 93 | 94 | # Lets add the df 95 | grid_kitas <- left_join( 96 | grid_new_kitas, 97 | st_drop_geometry(initial), 98 | by = "index_target") %>% 99 | select(-index_target) 100 | 101 | 102 | grid_kitas_agg <- aggregate( 103 | select(grid_kitas, STT_NAME, opening_duration_hours, geometry = grid), 104 | by = list(grid_kitas$STT_NAME), 105 | FUN = mean, 106 | na.rm = TRUE, 107 | do_union = FALSE 108 | ) 109 | 110 | 111 | ## PLOT ======================================================================== 112 | 113 | # Annotations 114 | plot_titles <- list( 115 | title = "Opening times of kindergardens in Cologne", 116 | subtitle = "The color of the honeycombs indicates the average weekly 117 | opening durations of kindergardens and day care centers within that area. 118 | Grey honeycombs means no data.", 119 | caption = "Data: **Open Data Cologne** (last update: 2021-10-29) | 120 | Visualization: **Ansgar Wolsing**" 121 | ) 122 | 123 | ggplot() + 124 | geom_sf(data = grid_kitas_agg, 125 | aes(fill = opening_duration_hours), 126 | col = "white", size = 0.25) + 127 | geom_sf(data = boroughs_sf, 128 | fill = "grey90", lty = "solid", 129 | col = "grey32", size = 0.5, alpha = 0.2) + 130 | ggrepel::geom_label_repel(data = boroughs_sf, 131 | aes(geometry = geometry, 132 | label = name), 133 | stat = "sf_coordinates", 134 | size = 3, fill = "grey8", family = "Chivo", 135 | label.size = 0, alpha = 0.8, col = "white" 136 | ) + 137 | scale_fill_scico(palette = "bamako", alpha = 0.7) + 138 | scale_alpha_continuous(range = c(0.1, 1)) + 139 | guides(fill = guide_legend(title.position = "top")) + 140 | labs(title = plot_titles$title, 141 | subtitle = plot_titles$subtitle, 142 | caption = plot_titles$caption, 143 | fill = "Average weekly openings hours") + 144 | cowplot::theme_map() + 145 | theme(# legend.position = "top", 146 | plot.background = element_rect(color = NA, fill = "grey20"), 147 | text = element_text(color = "grey97", family = "Roboto"), 148 | plot.title = element_text(color = "white", 149 | margin = margin(t = 6, b = 12)), 150 | plot.subtitle = element_textbox_simple(size = 10), 151 | plot.caption = element_textbox_simple(size = 8), 152 | legend.position = c(0.6, 0.87), 153 | legend.title = element_text(size = 10), 154 | legend.text = element_text(size = 8), 155 | legend.key.width = unit(3, "mm"), 156 | legend.direction = "horizontal" 157 | ) 158 | ggsave(here("plots", "day04_hexagons.png"), dpi = 600, width = 8, height = 8) 159 | 160 | 161 | -------------------------------------------------------------------------------- /R/day05-data_osm-bike-lanes.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", "scico", 2 | "sf", "osmdata", "gganimate") 3 | 4 | ## GEOMETRIES ================================================================== 5 | 6 | crs <- "EPSG:4326" 7 | 8 | ## Shape Cologne 9 | shape_cgn <- getbb("Cologne, Germany", format_out = "sf_polygon") 10 | st_crs(shape_cgn) <- crs 11 | 12 | #' Which keys to retrieve? 13 | #' https://help.openstreetmap.org/questions/64879/get-all-bicycle-infrastructure-for-a-city 14 | #' all roads that have additional tags indicating cycle infrastructure 15 | #' (cycleway=lane and cycleway=track) 16 | #' all highway=cycleway 17 | #' all highway=footway and highway=path that allow bicycle use or are 18 | #' intended for such (bicycle=yes, bicycle=designated, bicycle=official) 19 | 20 | bike_lanes <- opq(bbox = shape_cgn) %>% 21 | add_osm_feature(key = "cycleway", value = "lane") %>% 22 | add_osm_feature(key = "cycleway", value = "track") %>% 23 | add_osm_feature(key = "highway", value = "cycleway") %>% 24 | add_osm_feature(key = "highway", value = "footway") %>% 25 | add_osm_feature(key = "highway", value = "path") %>% 26 | osmdata_sf() 27 | 28 | highway_features <- opq(bbox = shape_cgn) %>% 29 | add_osm_feature(key = "highway") %>% 30 | osmdata_sf() 31 | 32 | data_dir <- here("data", "cologne_bikelanes") 33 | # if (!dir.exists(data_dir)) { 34 | # dir.create(data_dir) 35 | # message(glue("Created folder {data_dir}")) 36 | # write_rds(bike_lanes, 37 | # here(data_dir, "bike_lanes_osm_raw.rds"), 38 | # compress = "gz") 39 | # } else { 40 | # bike_lanes <- read_rds(here(data_dir, "bike_lanes_osm_raw.rds")) 41 | # } 42 | 43 | bike_lanes_lines <- bike_lanes$osm_lines %>% 44 | select(osm_id, name, bicycle, bridge, bridge.name, 45 | cycleway, starts_with("cycleway\\."), 46 | highway, 47 | surface, zone.maxspeed, geometry) 48 | 49 | #' Filtering for highways 50 | #' (only keep key = "highway", value = "footway|path" if 51 | #' bicycle=yes|designated|official) 52 | 53 | bike_lanes_lines %>% st_drop_geometry() %>% count(cycleway, sort = TRUE) 54 | bike_lanes_lines %>% st_drop_geometry() %>% count(highway, sort = TRUE) 55 | 56 | bike_lanes_lines_filtered <- bike_lanes_lines %>% 57 | filter( 58 | !is.na(cycleway) | 59 | highway == "cycleway" | 60 | highway == "path" & bicycle %in% c("yes", "designated", "official") | 61 | highway == "footway" & bicycle %in% c("yes", "designated", "official") 62 | 63 | ) 64 | st_crs(bike_lanes_lines_filtered) <- crs 65 | 66 | # library(tictoc) 67 | # tic("st_intersection only") 68 | # bike_lanes_cgn <- st_intersection(shape_cgn, bike_lanes_lines_filtered) 69 | # toc() 70 | 71 | tic("st_intersects + st_intersection") 72 | bike_lanes_cgn <- bike_lanes_lines_filtered %>% 73 | filter(., st_intersects(., shape_cgn, sparse = FALSE)[, 1]) %>% 74 | st_intersection(shape_cgn) 75 | toc() 76 | write_rds(bike_lanes_cgn, here(data_dir, "bike_lanes_cgn.rds")) 77 | 78 | tic("highways: st_intersects + st_intersection") 79 | highway_features_cgn <- highway_features$osm_lines %>% 80 | filter(., st_intersects(., shape_cgn, sparse = FALSE)[, 1]) %>% 81 | st_intersection(shape_cgn) 82 | toc() 83 | write_rds(highway_features_cgn, here(data_dir, "highway_features_cgn.rds")) 84 | 85 | 86 | #' Check which cycleway OSM values are present 87 | #' Exhaustive list of values: https://wiki.openstreetmap.org/wiki/Key:cycleway 88 | 89 | bike_lanes_cgn %>% 90 | st_drop_geometry() %>% 91 | count(surface, sort = TRUE) 92 | 93 | 94 | plot_titles <- list( 95 | title = "Bike Lanes in Cologne", 96 | subtitle = "Bike Lanes are colored by their surface type", 97 | caption = "Data: **OpenStreetMap** | Visualization: **Ansgar Wolsing**" 98 | ) 99 | 100 | p <- bike_lanes_cgn %>% 101 | mutate( 102 | surface = ifelse(is.na(surface), "Other/Unknown", surface), 103 | surface_grp = fct_lump(surface, prop = 0.05, 104 | other_level = "Other/Unknown")) %>% 105 | ggplot() + 106 | geom_sf(data = shape_cgn, 107 | fill = "grey21") + 108 | geom_sf(data = filter(highway_features_cgn, highway != "motorway"), 109 | size = 0.2, col = "grey62") + 110 | geom_sf(data = filter(highway_features_cgn, highway == "motorway"), 111 | size = 0.4, col = "grey70") + 112 | geom_sf(aes(col = surface_grp, fill = surface_grp), 113 | size = 0.2 114 | ) + 115 | paletteer::scale_color_paletteer_d("jcolors::pal3", 116 | labels = as_labeller(function(x) 117 | str_to_title(str_replace_all(x, "_", " ")))) + 118 | paletteer::scale_fill_paletteer_d("jcolors::pal3") + 119 | guides(color = guide_legend(override.aes = list("size" = 1.5)), 120 | fill = "none") + 121 | labs(title = plot_titles$title, 122 | subtitle = plot_titles$subtitle, 123 | caption = plot_titles$caption, 124 | color = "Surface type") + 125 | cowplot::theme_map() + 126 | theme(plot.background = element_rect(color = NA, fill = "grey50"), 127 | text = element_text(color = "grey92", family = "Roboto"), 128 | plot.title = element_markdown(color = "white", family = "Chivo", 129 | size = 24, 130 | margin = margin(t = 6, b = 12)), 131 | plot.subtitle = element_textbox_simple(), 132 | plot.caption = element_textbox_simple(size = 8), 133 | legend.position = c(0.7, 0.9), 134 | legend.title = element_text(size = 12, family = "Chivo"), 135 | legend.text = element_text(size = 10, family = "Roboto Light"), 136 | legend.key.width = unit(2, "mm")) 137 | ggsave(here("plots", "day05_osmdata_bike-lanes.png"), 138 | plot = p, dpi = 600, width = 10, height = 8) 139 | -------------------------------------------------------------------------------- /R/day06-red.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", "ggforce") 2 | 3 | ## Grid of Cologne's districts =============================== 4 | grid <- read_csv(here::here("data", "grid_koeln_stadtteile.csv")) 5 | grid 6 | 7 | ## Election results in Cologne's districts =================== 8 | 9 | url_btw_results_districts <- "https://wahlen.stadt-koeln.de/prod/BTW2021/05315000/praesentation/Open-Data-Bundestagswahl4711.csv?ts=1632676666514" 10 | btw_results_districts <- read_csv2(url_btw_results_districts) 11 | 12 | # D1 / F1 : Christlich Demokratische Union Deutschlands 13 | # D2 / F2 : Sozialdemokratische Partei Deutschlands 14 | # D3 / F3 : Freie Demokratische Partei 15 | # D4 / F4 : Alternative für Deutschland 16 | # D5 / F5 : BÜNDNIS 90/DIE GRÜNEN 17 | # D6 / F6 : DIE LINKE 18 | # D7 / F7 : Partei für Arbeit, Rechtsstaat, Tierschutz, Elitenförderung und basisdemokratische Initiative 19 | 20 | colnames(btw_results_districts) <- janitor::make_clean_names(colnames(btw_results_districts)) 21 | # Rename variables for biggest parties and remove the others 22 | btw_results_districts_long <- btw_results_districts %>% 23 | rename(wahlberechtigte = a, 24 | waehler = b, 25 | erst_ungueltig = c, 26 | erst_gueltig = d, 27 | zweit_ungueltig = e, 28 | zweit_gueltig = f, 29 | erst_cdu = d1, 30 | zweit_cdu = f1, 31 | erst_spd = d2, 32 | zweit_spd = f2, 33 | erst_fdp = d3, 34 | zweit_fdp = f3, 35 | erst_afd = d4, 36 | zweit_afd = f4, 37 | erst_gruene = d5, 38 | zweit_gruene = f5, 39 | erst_linke = d6, 40 | zweit_linke = f6, 41 | erst_diepartei = d7, 42 | zweit_diepartei = f7) %>% 43 | select(datum:zweit_diepartei, -c(a1:a3, b1)) %>% 44 | # calculate vote shares 45 | mutate(across(erst_cdu:erst_diepartei, .fns = ~.x/erst_gueltig, .names = "{.col}_perc"), 46 | across(zweit_cdu:zweit_diepartei, .fns = ~.x/zweit_gueltig, .names = "{.col}_perc")) %>% 47 | select(-c(erst_cdu:zweit_diepartei)) %>% 48 | pivot_longer(cols = c(erst_cdu_perc:zweit_diepartei_perc), 49 | names_to = "variable", 50 | values_to = "stimmenanteil") %>% 51 | separate(variable, into = c("stimme", "partei"), sep = "_") 52 | 53 | 54 | btw_winner_district <- 55 | btw_results_districts_long %>% 56 | select(gebiet_name, stimme, partei, stimmenanteil) %>% 57 | group_by(gebiet_name, stimme) %>% 58 | arrange(-stimmenanteil, .by_group = TRUE) %>% 59 | mutate(rang = rank(-stimmenanteil, ties.method = "first"), 60 | difference = stimmenanteil - lead(stimmenanteil)) %>% 61 | slice_max(order_by = stimmenanteil, n = 1, with_ties = FALSE) %>% 62 | ungroup() 63 | 64 | 65 | # Party colors 66 | party_colors <- c("CDU/CSU" = "grey9", 67 | "SPD" = "#ca0002", ## "#E3000F", 68 | "Grüne" = rgb(100, 161, 45, maxColorValue = 255), 69 | "FDP" = darken("#ffed00", 0.1), 70 | "Linke" = "purple", 71 | "AfD" = rgb(0, 158, 224, maxColorValue = 255)) 72 | 73 | 74 | ## PLOT ======================================================================== 75 | 76 | ## Prepared data frame for plotting 77 | df_plot <- btw_results_districts_long %>% 78 | select(gebiet_name, stimme, partei, stimmenanteil) %>% 79 | mutate(partei = str_to_upper(partei)) %>% 80 | filter(partei == "SPD") %>% 81 | inner_join(grid, by = c("gebiet_name" = "gebiet-name")) 82 | 83 | 84 | # Draw the grid map with customized titles 85 | draw_grid_map <- function(df, plot_titles) { 86 | df %>% 87 | mutate(stimme = ifelse(stimme == "erst", plot_titles$first_vote, 88 | plot_titles$second_vote)) %>% 89 | ggplot(aes(col, row)) + 90 | geom_point( 91 | aes(fill = partei, alpha = stimmenanteil), 92 | size = 11.5, shape = 22, stroke = 1.5, color = "transparent" 93 | ) + 94 | geom_point( 95 | aes(color = partei), 96 | size = 11.5, shape = 22, stroke = 1.5, fill = "transparent" 97 | ) + 98 | # geom_text(aes(label = paste(col, row, sep = "x"))) + 99 | coord_fixed() + 100 | scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) + 101 | scale_y_reverse(expand = c(.05, .05)) + 102 | scale_alpha_continuous(range = c(0.1, 1), 103 | breaks = seq(0.1, 0.4, 0.1), 104 | # show labels in percent format 105 | labels = paste(100 * seq(0.1, 0.4, 0.1), "%") 106 | ) + 107 | scale_color_manual(values = party_colors, name = NULL) + 108 | scale_fill_manual(values = party_colors, name = NULL) + 109 | facet_wrap(vars(stimme), ncol = 2) + 110 | guides(fill = "none", col = "none", 111 | alpha = guide_legend(override.aes = list( 112 | fill = party_colors["SPD"], color = party_colors["SPD"], 113 | size = 6), 114 | # title.position = "top" 115 | )) + 116 | labs(title = plot_titles$title, 117 | subtitle = plot_titles$subtitle, 118 | caption = plot_titles$caption, 119 | alpha = plot_titles$alpha) + 120 | theme_minimal(base_family = "Roboto", base_size = 16) + 121 | theme(plot.background = element_rect(color = NA, fill = "white"), 122 | legend.position = "bottom", 123 | legend.key.width = unit(4, "mm"), 124 | legend.title = element_text(size = 14), 125 | legend.text = element_text(size = 12), 126 | panel.grid = element_blank(), 127 | text = element_text(color = "grey40", lineheight = 1.2), 128 | plot.title = element_markdown(family = "Source Sans Pro SemiBold", 129 | color = "black", size = 24, 130 | margin = margin(t = 4, b = 12)), 131 | plot.subtitle = element_textbox_simple(size = 14, 132 | margin = margin(t = 2, b = 16)), 133 | plot.caption = element_textbox_simple(margin = margin(t = 20, b = 4)), 134 | strip.text = element_text(face = "bold", color = "grey45", size = 16, 135 | margin = margin(t = 12, b = 20)), 136 | panel.spacing.x = unit(16, "mm"), 137 | panel.background = element_rect(color = NA), 138 | axis.title = element_blank(), 139 | axis.text = element_blank()) 140 | } 141 | 142 | 143 | ## English version ------------------------------------------------------------- 144 | 145 | plot_titles_en <- list( 146 | title = glue("Vote shares of 147 | Social Democrats (SPD)
148 | in the German Federal Election 2021 in Cologne"), 149 | subtitle = "Each tile represents a district of Cologne. 150 | The more *intense* the color of a tile, the *higher* the vote share of the SPD 151 | within that district.", 152 | caption = "Data: **Stadt Köln** | 153 | Grid: **Ansgar Wolsing & Cedric Scherer** | 154 | Visualization: **Ansgar Wolsing**", 155 | alpha = "Vote share SPD", 156 | first_vote = "First vote (candidate)", 157 | second_vote = "Second vote (party)") 158 | 159 | draw_grid_map(df_plot, plot_titles_en) 160 | 161 | ggsave(here::here("plots", "day06_red_vote-share-spd_en.png"), 162 | device = ragg::agg_png, 163 | dpi = 600, width = 12, height = 8.5) 164 | 165 | 166 | ## German version ------------------------------------------------------------- 167 | 168 | plot_titles_de <- list( 169 | title = glue("Stimmenanteile der 170 | SPD in den Kölner Stadtteilen bei der Bundestagswahl 2021"), 171 | subtitle = "Jede Kachel repräsentiert einen Kölner Stadtteil. 172 | Je stärker die Färbung einer Kachel, desto höher der Stimmenanteil der SPD in 173 | diesem Stadtteil.", 174 | caption = "Quelle: **Stadt Köln** | 175 | Grid: **Ansgar Wolsing & Cedric Scherer** | 176 | Visualisierung: **Ansgar Wolsing**", 177 | alpha = "Stimmenanteil SPD", 178 | first_vote = "Erststimmen", 179 | second_vote = "Zweitstimmen") 180 | 181 | # Districts of Mülheim borough 182 | districts_lauterbach <- c("Buchforst", "Buchheim", "Dellbrück", "Dünnwald", 183 | "Flittard", "Höhenhaus", "Holweide", "Mülheim", 184 | "Stammheim") 185 | 186 | df_plot %>% 187 | # filter(stimme == "erst") %>% 188 | # Tweaking dataframe for Lauterbach annotation 189 | mutate(wk_lauterbach = gebiet_name %in% districts_lauterbach) %>% 190 | draw_grid_map(plot_titles_de) + 191 | ## Lauterbach annotation 192 | geom_mark_rect(aes(fill = wk_lauterbach, 193 | filter = wk_lauterbach & stimme == "Erststimmen", 194 | label = str_wrap("Hier gewann Karl Lauterbach 195 | das Direktmandat", 16) 196 | ), 197 | label.buffer = unit(1, "mm"), 198 | # do not fill the rectangle, this would imply a higher vote share 199 | fill = NA, 200 | label.colour = "grey38", 201 | size = 0.9, color = "grey20", label.fontsize = 9.5) 202 | ggsave(here::here("plots", "day06_red_vote-share-spd_de.png"), 203 | device = ragg::agg_png, 204 | dpi = 600, width = 12, height = 8.5) 205 | 206 | -------------------------------------------------------------------------------- /R/day07-green.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", "ggforce") 2 | 3 | ## Grid of Cologne's districts =============================== 4 | grid <- read_csv(here::here("data", "grid_koeln_stadtteile.csv")) 5 | grid 6 | 7 | ## Election results in Cologne's districts =================== 8 | 9 | url_btw_results_districts <- "https://wahlen.stadt-koeln.de/prod/BTW2021/05315000/praesentation/Open-Data-Bundestagswahl4711.csv?ts=1632676666514" 10 | btw_results_districts <- read_csv2(url_btw_results_districts) 11 | 12 | # D1 / F1 : Christlich Demokratische Union Deutschlands 13 | # D2 / F2 : Sozialdemokratische Partei Deutschlands 14 | # D3 / F3 : Freie Demokratische Partei 15 | # D4 / F4 : Alternative für Deutschland 16 | # D5 / F5 : BÜNDNIS 90/DIE GRÜNEN 17 | # D6 / F6 : DIE LINKE 18 | # D7 / F7 : Partei für Arbeit, Rechtsstaat, Tierschutz, Elitenförderung und basisdemokratische Initiative 19 | 20 | colnames(btw_results_districts) <- janitor::make_clean_names(colnames(btw_results_districts)) 21 | # Rename variables for biggest parties and remove the others 22 | btw_results_districts_long <- btw_results_districts %>% 23 | rename(wahlberechtigte = a, 24 | waehler = b, 25 | erst_ungueltig = c, 26 | erst_gueltig = d, 27 | zweit_ungueltig = e, 28 | zweit_gueltig = f, 29 | erst_cdu = d1, 30 | zweit_cdu = f1, 31 | erst_spd = d2, 32 | zweit_spd = f2, 33 | erst_fdp = d3, 34 | zweit_fdp = f3, 35 | erst_afd = d4, 36 | zweit_afd = f4, 37 | erst_gruene = d5, 38 | zweit_gruene = f5, 39 | erst_linke = d6, 40 | zweit_linke = f6, 41 | erst_diepartei = d7, 42 | zweit_diepartei = f7) %>% 43 | select(datum:zweit_diepartei, -c(a1:a3, b1)) %>% 44 | # calculate vote shares 45 | mutate(across(erst_cdu:erst_diepartei, .fns = ~.x/erst_gueltig, .names = "{.col}_perc"), 46 | across(zweit_cdu:zweit_diepartei, .fns = ~.x/zweit_gueltig, .names = "{.col}_perc")) %>% 47 | select(-c(erst_cdu:zweit_diepartei)) %>% 48 | pivot_longer(cols = c(erst_cdu_perc:zweit_diepartei_perc), 49 | names_to = "variable", 50 | values_to = "stimmenanteil") %>% 51 | separate(variable, into = c("stimme", "partei"), sep = "_") 52 | 53 | # Party colors 54 | party_colors <- c("CDU/CSU" = "grey9", 55 | "SPD" = "#ca0002", ## "#E3000F", 56 | "Grüne" = rgb(100, 161, 45, maxColorValue = 255), 57 | "FDP" = darken("#ffed00", 0.1), 58 | "Linke" = "purple", 59 | "AfD" = rgb(0, 158, 224, maxColorValue = 255)) 60 | 61 | 62 | ## PLOT ======================================================================== 63 | 64 | ## Prepared data frame for plotting 65 | df_plot <- btw_results_districts_long %>% 66 | select(gebiet_name, stimme, partei, stimmenanteil) %>% 67 | filter(partei == "gruene") %>% 68 | mutate(partei = "Grüne") %>% 69 | inner_join(grid, by = c("gebiet_name" = "gebiet-name")) 70 | 71 | 72 | # Draw the grid map with customized titles 73 | draw_grid_map <- function(df, plot_titles) { 74 | df %>% 75 | mutate(stimme = ifelse(stimme == "erst", plot_titles$first_vote, 76 | plot_titles$second_vote)) %>% 77 | ggplot(aes(col, row)) + 78 | geom_point( 79 | aes(fill = partei, alpha = stimmenanteil), 80 | size = 11.5, shape = 22, stroke = 1.5, color = "transparent" 81 | ) + 82 | geom_point( 83 | aes(color = partei), 84 | size = 11.5, shape = 22, stroke = 1.5, fill = "transparent" 85 | ) + 86 | # geom_text(aes(label = paste(col, row, sep = "x"))) + 87 | coord_fixed() + 88 | scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) + 89 | scale_y_reverse(expand = c(.05, .05)) + 90 | scale_alpha_continuous(range = c(0.1, 1), 91 | breaks = seq(0.1, 0.4, 0.1), 92 | # show labels in percent format 93 | labels = paste(100 * seq(0.1, 0.4, 0.1), "%") 94 | ) + 95 | scale_color_manual(values = party_colors, name = NULL) + 96 | scale_fill_manual(values = party_colors, name = NULL) + 97 | facet_wrap(vars(stimme), ncol = 2) + 98 | guides(fill = "none", col = "none", 99 | alpha = guide_legend(override.aes = list( 100 | fill = party_colors["Grüne"], color = party_colors["Grüne"], 101 | size = 6), 102 | )) + 103 | labs(title = plot_titles$title, 104 | subtitle = plot_titles$subtitle, 105 | caption = plot_titles$caption, 106 | alpha = plot_titles$alpha) + 107 | theme_minimal(base_family = "Roboto", base_size = 16) + 108 | theme(plot.background = element_rect(color = NA, fill = "white"), 109 | legend.position = "bottom", 110 | legend.key.width = unit(4, "mm"), 111 | legend.title = element_text(size = 14), 112 | legend.text = element_text(size = 12), 113 | panel.grid = element_blank(), 114 | text = element_text(color = "grey40", lineheight = 1.2), 115 | plot.title = element_markdown(family = "Source Sans Pro SemiBold", 116 | color = "black", size = 24, 117 | margin = margin(t = 4, b = 12)), 118 | plot.subtitle = element_textbox_simple(size = 14, 119 | margin = margin(t = 2, b = 16)), 120 | plot.caption = element_textbox_simple(margin = margin(t = 20, b = 4)), 121 | strip.text = element_text(face = "bold", color = "grey45", size = 16, 122 | margin = margin(t = 12, b = 20)), 123 | panel.spacing.x = unit(16, "mm"), 124 | panel.background = element_rect(color = NA), 125 | axis.title = element_blank(), 126 | axis.text = element_blank()) 127 | } 128 | 129 | 130 | ## English version ------------------------------------------------------------- 131 | 132 | plot_titles_en <- list( 133 | title = glue("Vote shares of 134 | the Greens (Bündnis 90 / Die Grünen)
135 | in the German Federal Election 2021 in Cologne"), 136 | subtitle = "Each tile represents a district of Cologne. 137 | The more *intense* the color of a tile, the *higher* the vote share of the 138 | Greens within that district.", 139 | caption = "Data: **Stadt Köln** | 140 | Grid: **Ansgar Wolsing & Cedric Scherer** | 141 | Visualization: **Ansgar Wolsing**", 142 | alpha = "Vote share Greens", 143 | first_vote = "First vote (candidate)", 144 | second_vote = "Second vote (party)") 145 | 146 | draw_grid_map(df_plot, plot_titles_en) 147 | 148 | ggsave(here::here("plots", "day07_green_vote-share-greens_en.png"), 149 | device = ragg::agg_png, 150 | dpi = 600, width = 12, height = 8.5) 151 | 152 | 153 | ## German version ------------------------------------------------------------- 154 | 155 | plot_titles_de <- list( 156 | title = glue("Stimmenanteile von 157 | the Greens (Bündnis 90 / Die Grünen) in den Kölner Stadtteilen bei der Bundestagswahl 2021"), 158 | subtitle = "Jede Kachel repräsentiert einen Kölner Stadtteil. 159 | Je stärker die Färbung einer Kachel, desto höher der Stimmenanteil der SPD in 160 | diesem Stadtteil.", 161 | caption = "Quelle: **Stadt Köln** | 162 | Grid: **Ansgar Wolsing & Cedric Scherer** | 163 | Visualisierung: **Ansgar Wolsing**", 164 | alpha = "Stimmenanteil Bündnis 90 / Die Grünen", 165 | first_vote = "Erststimmen", 166 | second_vote = "Zweitstimmen") 167 | 168 | 169 | draw_grid_map(df_plot, plot_titles_de) 170 | ggsave(here::here("plots", "day07_green_vote-share-greens_de.png"), 171 | device = ragg::agg_png, 172 | dpi = 600, width = 12, height = 8.5) 173 | 174 | -------------------------------------------------------------------------------- /R/day08-blue-housing.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "sf", "paletteer", 2 | "pdftools", "lubridate", "patchwork", "ggbeeswarm") 3 | 4 | ## GEOMETRY ==================================================================== 5 | #' https://www.offenedaten-koeln.de/dataset/stadtteile 6 | #' https://www.offenedaten-koeln.de/sites/default/files/Stadtteil.zip 7 | shp_districts <- st_read(here("data", "cologne_stadtteile", "Stadtteil", "Stadtteil.shp")) 8 | shp_districts <- st_transform(shp_districts, crs = 4326) 9 | 10 | #' https://offenedaten-koeln.de/dataset/stadtbezirke-koeln 11 | url_boroughs <- "https://geoportal.stadt-koeln.de/arcgis/rest/services/Basiskarten/kgg/MapServer/4/query?where=objectid+is+not+null&text=&objectIds=&time=&geometry=&geometryType=esriGeometryEnvelope&inSR=&spatialRel=esriSpatialRelIntersects&distance=&units=esriSRUnit_Foot&relationParam=&outFields=*&returnGeometry=true&returnTrueCurves=false&maxAllowableOffset=&geometryPrecision=&outSR=4326&havingClause=&returnIdsOnly=false&returnCountOnly=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&returnZ=false&returnM=false&gdbVersion=&historicMoment=&returnDistinctValues=false&resultOffset=&resultRecordCount=&returnExtentOnly=false&datumTransformation=¶meterValues=&rangeValues=&quantizationParameters=&featureEncoding=esriDefault&f=pjson" 12 | boroughs_sf <- st_read(here("data", "cologne_stadtbezirke", "stadtbezirke_koeln.json")) 13 | boroughs_sf <- st_transform(boroughs_sf, crs = 4326) 14 | 15 | ## DATA ======================================================================= 16 | # Get file 17 | url_district_info <- "https://www.stadt-koeln.de/mediaasset/content/pdf15/statistik-standardinformationen/k%C3%B6lner_stadtteilinformationen_2020_fertig.pdf" 18 | filepath_district_info <- here("data", "stadtteilinfo.pdf") 19 | download.file(url_district_info, destfile = filepath_district_info) 20 | 21 | # TODO: Extract table via https://www.pdftron.com/pdf-tools/pdf-table-extraction/ 22 | wohnflaeche <- read_delim(here("data", "cologne_wohnfläche.tsv"), 23 | delim = "\t", locale = locale(decimal_mark = ","), 24 | skip = 1) %>% 25 | mutate(nr = as.character(nr)) 26 | years <- c(2010, 2015, 2019, 2020) 27 | colnames(wohnflaeche) <- c("id", "district", 28 | paste("area_per_accomodation", years, sep = "_"), 29 | paste("area_per_inhabitant", years, sep = "_")) 30 | 31 | 32 | ## PLOT ======================================================================== 33 | text_color <- "#0e304a" 34 | 35 | # geom_curve with customized defaults 36 | geom_curve2 <- function(..., curvature = 0.125) { 37 | geom_curve( 38 | color = text_color, 39 | arrow = arrow(angle = 17, length = unit(2.5, "mm")), 40 | curvature = curvature, 41 | size = 0.35, 42 | ... 43 | ) 44 | } 45 | 46 | # get the centroid of a given district 47 | district_centroid <- function(district, shp) { 48 | st_coordinates( 49 | st_centroid( 50 | shp[shp$STT_NAME == district,] 51 | ) 52 | ) 53 | } 54 | 55 | 56 | # average housing space for Cologne overall 57 | avg_housing_space_cgn <- wohnflaeche$area_per_inhabitant_2020[wohnflaeche$district == "Köln insgesamt"] 58 | 59 | plot_titles <- list( 60 | title = "Housing space in Cologne", 61 | subtitle = glue( 62 | "The floor area per person is a key indicators of dwelling comfort. 63 | The average housing space in Cologne is {avg_housing_space_cgn} 64 | m2 per person, 65 | but varies a lot between districts. 66 |

67 | Boroughs are labelled for better orientation."), 68 | caption = "Data: **Stadt Köln** (Shapes; Stadtteilinformation 2020, pp. 52-53) | 69 | Visualization: **Ansgar Wolsing**" 70 | ) 71 | 72 | p <- wohnflaeche %>% 73 | # exclude borough information (1-digit ids) 74 | filter(id > 100) %>% 75 | select(id, district, area_per_inhabitant_2020) %>% 76 | inner_join(shp_districts, by = c("id" = "STT_NR")) %>% 77 | ggplot() + 78 | geom_sf(aes(geometry = geometry, 79 | fill = area_per_inhabitant_2020), 80 | col = "white", size = 0.1) + 81 | geom_sf(data = boroughs_sf, 82 | fill = NA, col = "grey97", size = 0.5) + 83 | geom_label(data = boroughs_sf, 84 | aes(geometry = geometry, 85 | label = name), 86 | stat = "sf_coordinates", 87 | size = 3, fill = "#1d3242", family = "Chivo", 88 | label.size = 0, alpha = 0.8, col = "white" 89 | ) + 90 | 91 | ## Annotations -------------------------- 92 | 93 | # Custom subtitle via geom_textbox 94 | geom_textbox(aes(x = 6.56, y = 51.038, 95 | label = plot_titles$subtitle), 96 | hjust = 0, vjust = 1, box.colour = NA, fill = NA, 97 | col = "#0e304a", family = "Roboto", size = 5, 98 | box.padding = unit(c(5.5, 5.5, 5.5, 2), "pt"), 99 | width = unit(3, "inch")) + 100 | 101 | # Annotation for Gremberghoven 102 | geom_textbox(aes(x = 7.005, y = 51.045, 103 | label = "With 25.4 square meters per person, **Gremberghoven** is the district 104 | with the least average housing space."), 105 | hjust = 0, box.colour = NA, fill = NA, size = 3.5, 106 | col = text_color, family = "Roboto Light") + 107 | geom_curve2(aes( 108 | x = 7.005 + 0.01, 109 | y = 51.045 - 0.018, 110 | xend = district_centroid("Gremberghoven", shp_districts)[, "X"], 111 | yend = district_centroid("Gremberghoven", shp_districts)[, "Y"])) + 112 | 113 | # Annotation for Hahnwald 114 | geom_textbox(aes(x = 6.78, y = 50.86, 115 | label = "With 88.8 square meters, **Hahnwald** is the district 116 | with the highest average housing space per person."), 117 | hjust = 0, box.colour = NA, fill = NA, size = 3.5, 118 | col = text_color, family = "Roboto Light") + 119 | geom_curve2(aes( 120 | x = 6.798 + 0.11, 121 | y = 50.86 + 0.005, 122 | xend = district_centroid("Hahnwald", shp_districts)[, "X"], 123 | yend = district_centroid("Hahnwald", shp_districts)[, "Y"])) + 124 | 125 | paletteer::scale_fill_paletteer_c( 126 | palette = "pals::kovesi.linear_blue_95_50_c20") + 127 | guides(fill = guide_colorbar(title.position = "top", 128 | title = "Average floor area per person (m2)")) + 129 | labs(title = plot_titles$title, 130 | caption = plot_titles$caption) + 131 | coord_sf(expand = FALSE) + 132 | cowplot::theme_map() + 133 | theme( 134 | plot.background = element_rect(color = NA, fill = "white"), 135 | text = element_text(family = "Roboto", color = text_color), 136 | plot.title = element_text(size = 28, color = "#297bba", 137 | margin = margin(t = 0, b = 12)), 138 | plot.subtitle = element_blank(), # replaced by custom annotation 139 | plot.caption = element_textbox_simple(size = 8, 140 | margin = margin(t = 12, b = 4)), 141 | panel.background = element_rect(color = NA), 142 | legend.title = element_markdown(size = 10), 143 | legend.text = element_text(size = 8, color = text_color), 144 | legend.position = c(0.01, 0.92), # c(0.05, 0.2), 145 | legend.direction = "horizontal", 146 | legend.key.width = unit(10, "mm"), 147 | legend.key.height = unit(3, "mm") 148 | ) 149 | ggsave(here("plots", "day08-blue-area_living.png"), 150 | plot = p, dpi = 600, width = 9, height = 8) 151 | 152 | 153 | # Beeswarm plot of average housing ------- 154 | 155 | p_bee <- wohnflaeche %>% 156 | # exclude borough information (1-digit ids) 157 | filter(id > 100) %>% 158 | ggplot(aes(x = factor(1), y = area_per_inhabitant_2020)) + 159 | geom_beeswarm(aes(fill = area_per_inhabitant_2020), 160 | shape = 21, col = "grey97", size = 4, 161 | cex = 4, 162 | show.legend = FALSE) + 163 | paletteer::scale_fill_paletteer_c( 164 | palette = "pals::kovesi.linear_blue_95_50_c20") + 165 | coord_flip(ylim = c(20, 100)) + 166 | labs(title = "Distribution", 167 | x = NULL, y = NULL) + 168 | theme_minimal(base_family = "Roboto") + 169 | theme( 170 | plot.title = element_text(color = text_color, family = "Roboto", 171 | face = "bold", size = 10), 172 | plot.title.position = "plot", 173 | panel.grid = element_blank(), 174 | panel.grid.major.x = element_line(size = 0.1, color = "grey90"), 175 | axis.text.y = element_blank() 176 | ) 177 | 178 | # Inset --------------------------- 179 | p_inset <- p + 180 | # Arrow pointing to the beeswarm plot 181 | geom_curve2(aes( 182 | x = 6.78, 183 | y = 50.86 + 0.004, 184 | xend = 6.717, 185 | yend = 50.872), 186 | curvature = -0.1) + 187 | inset_element(p_bee, 0.0, 0.05, 0.3, 0.3) 188 | ggsave(here("plots", "day08-blue-area_living_inset.png"), 189 | plot = p_inset, dpi = 600, width = 9, height = 8) 190 | 191 | -------------------------------------------------------------------------------- /R/day09-monochrome-buildings.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", 2 | "sf", "osmdata", "geojsonsf", "jsonlite") 3 | 4 | ## GEOMETRIES ================================================================== 5 | ## Area of Cologne 6 | coords_cgn <- getbb("Cologne, Germany", format_out = "sf_polygon") 7 | coords_cathedral <- getbb("Kölner Dom, Cologne, Germany", 8 | featuretype = "church") 9 | 10 | ## GET DATA ==================================================================== 11 | #' Source: https://www.offenedaten-koeln.de/dataset/adresse 12 | #' Source: https://www.offenedaten-koeln.de/dataset/geb%C3%A4udemodell-stadt-k%C3%B6ln-2010 13 | #' Projection: 31466 - DHDN / Gauss-Kruger zone 2. VG 14 | 15 | # url_addresses <- "https://www.offenedaten-koeln.de/sites/default/files/Adresse_0.zip" 16 | # filepath_addresses_zip <- here("data", "Adresse_0.zip") 17 | # if (!file.exists(filepath_addresses_zip)) { 18 | # download.file(url_addresses, destfile = filepath_addresses_zip, mode = "wb") 19 | # unzip(filepath_addresses_zip, exdir = here("data", "addresses")) 20 | # } 21 | # filepath_addresses_shp <- here("data", "addresses", "Adresse.shp") 22 | # shp <- st_read(filepath_addresses_shp) 23 | 24 | urls_buildings <- paste0("https://www.offenedaten-koeln.de/sites/default/files/dachansicht_lod2_part", 25 | 1:3, ".zip") 26 | filepaths_buildings_zip <- here("data", "cologne_buildings", 27 | paste0("dachansicht_lod2_part", 1:3, ".zip")) 28 | folder_buildings <- here("data", "cologne_buildings") 29 | filepath_buildings_dataframe <- here(folder_buildings, "cologne_buildings.rds") 30 | 31 | if (!file.exists(filepath_buildings_dataframe)) { 32 | if (!file.exists(filepaths_buildings_zip[1])) { 33 | dir.create(folder_buildings) 34 | walk2(urls_buildings, filepaths_buildings_zip, 35 | ~download.file(url = .x, destfile = .y, mode = "wb")) 36 | walk(filepaths_buildings_zip, unzip, exdir = folder_buildings) 37 | } 38 | 39 | filepaths_shp <- here(folder_buildings, 40 | list.files(folder_buildings, pattern = ".*\\.shp$")) 41 | buildings <- map_dfr(filepaths_shp, st_read) 42 | 43 | # Save buildings dataframe with geometry 44 | write_rds(buildings, filepath_buildings_dataframe, 45 | compress = "gz") 46 | } else { 47 | buildings <- read_rds(filepath_buildings_dataframe) 48 | } 49 | 50 | #' Set the coordinate reference system 51 | #' According to comments/documentation: 31466 - DHDN / Gauss-Kruger zone 2. VG 52 | st_crs(buildings$geometry) <- "EPSG:31466" 53 | st_crs(buildings$geometry) 54 | 55 | buildings2 <- st_zm(buildings, drop = TRUE, what = "ZM") 56 | 57 | 58 | ## PLOT ======================================================================== 59 | 60 | # Annotations 61 | plot_titles <- list( 62 | title = "BUILDINGS OF COLOGNE", 63 | subtitle = glue("{sp::dd2dms(round(coords_cathedral['y', 'min'], 2), NS = TRUE)}, 64 | {sp::dd2dms(round(coords_cathedral['x', 'min'], 2))}"), 65 | caption = "Data: **Open Data Cologne** (last update: 2021-10-29), 66 | **OpenStreetMap contributors** | Visualization: **Ansgar Wolsing**" 67 | ) 68 | 69 | p <- ggplot(coords_cgn) + 70 | geom_sf(fill = "#1c1c1c") + 71 | geom_sf(data = buildings2, 72 | aes(geometry = geometry), 73 | fill = "#e9e9e9", 74 | color = NA 75 | ) + 76 | coord_sf() + 77 | labs( 78 | title = plot_titles$title, 79 | subtitle = plot_titles$subtitle, 80 | caption = plot_titles$caption 81 | ) + 82 | cowplot::theme_map(font_family = "Roboto") + 83 | theme(plot.background = element_rect(color = NA, fill = "grey1"), 84 | text = element_text(color = "grey92"), 85 | plot.title = element_text(color = "white", 86 | family = "Oswald", 87 | face = "plain", 88 | size = 42, 89 | hjust = 0.5, 90 | margin = margin(t = 6, b = 12)), 91 | plot.subtitle = element_markdown(size = 16, 92 | hjust = 0.5, 93 | margin = margin(t = 4, b = 0)), 94 | plot.caption = element_markdown(size = 10, 95 | hjust = 0.5, 96 | margin = margin(t = 8, b = 8))) 97 | ggsave(here("plots", "day09_monochrome_buildings.png"), 98 | plot = p, dpi = 600, width = 10, height = 10) 99 | ggsave(here("plots", "day09_monochrome_buildings_lres.png"), 100 | plot = p, dpi = 200, width = 10, height = 10) 101 | 102 | -------------------------------------------------------------------------------- /R/day09-monochrome-streets.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "sf", "osmdata") 2 | 3 | ## GEOMETRIES ================================================================== 4 | 5 | crs <- "EPSG:4326" 6 | 7 | ## Shape Cologne 8 | shape_cgn <- getbb("Cologne, Germany", format_out = "sf_polygon") 9 | st_crs(shape_cgn) <- crs 10 | 11 | # Get streets 12 | highway_features <- opq(bbox = shape_cgn) %>% 13 | add_osm_feature(key = "highway") %>% 14 | osmdata_sf() 15 | 16 | highway_features_cgn <- highway_features$osm_lines %>% 17 | filter(., st_intersects(., shape_cgn, sparse = FALSE)[, 1]) %>% 18 | st_intersection(shape_cgn) 19 | 20 | street_types <- list( 21 | large = c("motorway", "primary", "motorway_link", "primary_link"), 22 | medium = c("secondary", "tertiary", "secondary_link", "tertiary_link"), 23 | small = c("residential", "living_street", "unclassified", "service", "footway") 24 | ) 25 | 26 | 27 | ## PLOT ======================================================================== 28 | 29 | plot_titles <- list( 30 | title = "STREETS OF COLOGNE", 31 | subtitle = glue("{sp::dd2dms(round(coords_cathedral['y', 'min'], 2), NS = TRUE)}, 32 | {sp::dd2dms(round(coords_cathedral['x', 'min'], 2))}"), 33 | caption = "Data: **OpenStreetMap contributors** | Visualization: **Ansgar Wolsing**" 34 | ) 35 | 36 | p <- ggplot() + 37 | geom_sf(data = shape_cgn, 38 | fill = "#1c1c1c") + 39 | geom_sf(data = filter(highway_features_cgn, !highway %in% unlist(street_types)), 40 | size = 0.1, alpha = 0.4, col = "#e9e9e9") + 41 | geom_sf(data = filter(highway_features_cgn, highway %in% street_types$small), 42 | size = 0.1, alpha = 0.8, col = "#e9e9e9") + 43 | geom_sf(data = filter(highway_features_cgn, highway %in% street_types$medium), 44 | size = 0.15, col = "#e9e9e9") + 45 | geom_sf(data = filter(highway_features_cgn, highway %in% street_types$large), 46 | size = 0.4, col = "#f5f5f5") + 47 | labs(title = plot_titles$title, 48 | subtitle = plot_titles$subtitle, 49 | caption = plot_titles$caption) + 50 | cowplot::theme_map(font_family = "Roboto") + 51 | theme(plot.background = element_rect(color = NA, fill = "grey1"), 52 | text = element_text(color = "grey92"), 53 | plot.title = element_text(color = "white", 54 | family = "Oswald", 55 | face = "plain", 56 | size = 42, 57 | hjust = 0.5, 58 | margin = margin(t = 6, b = 12)), 59 | plot.subtitle = element_textbox_simple(size = 16, 60 | hjust = 0.5, 61 | margin = margin(t = 4, b = 0)), 62 | plot.caption = element_textbox_simple(size = 10, 63 | hjust = 0.5, 64 | margin = margin(t = 8, b = 8))) 65 | ggsave(here("plots", "day09_monochrome-streets.png"), 66 | plot = p, dpi = 600, width = 10, height = 10) 67 | 68 | -------------------------------------------------------------------------------- /R/day11-3d.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", "ggforce", 2 | "rayshader", "sf") 3 | 4 | ## Election results in Cologne's districts =================== 5 | 6 | url_btw_results_districts <- "https://wahlen.stadt-koeln.de/prod/BTW2021/05315000/praesentation/Open-Data-Bundestagswahl4711.csv?ts=1632676666514" 7 | btw_results_districts <- read_csv2(url_btw_results_districts) 8 | 9 | # D1 / F1 : Christlich Demokratische Union Deutschlands 10 | # D2 / F2 : Sozialdemokratische Partei Deutschlands 11 | # D3 / F3 : Freie Demokratische Partei 12 | # D4 / F4 : Alternative für Deutschland 13 | # D5 / F5 : BÜNDNIS 90/DIE GRÜNEN 14 | # D6 / F6 : DIE LINKE 15 | # D7 / F7 : Partei für Arbeit, Rechtsstaat, Tierschutz, Elitenförderung und basisdemokratische Initiative 16 | 17 | colnames(btw_results_districts) <- janitor::make_clean_names(colnames(btw_results_districts)) 18 | # Rename variables for biggest parties and remove the others 19 | btw_results_districts_long <- btw_results_districts %>% 20 | rename(wahlberechtigte = a, 21 | waehler = b, 22 | erst_ungueltig = c, 23 | erst_gueltig = d, 24 | zweit_ungueltig = e, 25 | zweit_gueltig = f, 26 | erst_cdu = d1, 27 | zweit_cdu = f1, 28 | erst_spd = d2, 29 | zweit_spd = f2, 30 | erst_fdp = d3, 31 | zweit_fdp = f3, 32 | erst_afd = d4, 33 | zweit_afd = f4, 34 | erst_gruene = d5, 35 | zweit_gruene = f5, 36 | erst_linke = d6, 37 | zweit_linke = f6, 38 | erst_diepartei = d7, 39 | zweit_diepartei = f7) %>% 40 | select(datum:zweit_diepartei, -c(a1:a3, b1)) %>% 41 | # calculate vote shares 42 | mutate(across(erst_cdu:erst_diepartei, .fns = ~.x/erst_gueltig, .names = "{.col}_perc"), 43 | across(zweit_cdu:zweit_diepartei, .fns = ~.x/zweit_gueltig, .names = "{.col}_perc")) %>% 44 | select(-c(erst_cdu:zweit_diepartei)) %>% 45 | pivot_longer(cols = c(erst_cdu_perc:zweit_diepartei_perc), 46 | names_to = "variable", 47 | values_to = "stimmenanteil") %>% 48 | separate(variable, into = c("stimme", "partei"), sep = "_") 49 | 50 | 51 | wbt_districts <- btw_results_districts_long %>% 52 | distinct(gebiet_name, wahlberechtigte, waehler) %>% 53 | mutate(wbt = waehler / wahlberechtigte) 54 | 55 | # Overall turnout in Cologne (calculated on sums) 56 | wbt_cgn <- wbt_districts %>% 57 | summarize(wbt = sum(waehler) / sum(wahlberechtigte)) %>% 58 | pull(wbt) 59 | 60 | 61 | 62 | ## GEOMETRY ==================================================================== 63 | #' https://www.offenedaten-koeln.de/dataset/stadtteile 64 | #' https://www.offenedaten-koeln.de/sites/default/files/Stadtteil.zip 65 | 66 | shp_districts <- st_read(here("data", "cologne_stadtteile", "Stadtteil", "Stadtteil.shp")) 67 | shp_districts <- st_transform(shp_districts, crs = 4326) 68 | 69 | 70 | ## PLOT ======================================================================== 71 | 72 | 73 | p <- wbt_districts %>% 74 | inner_join(shp_districts, by = c("gebiet_name" = "STT_NAME")) %>% 75 | ggplot() + 76 | geom_sf(aes(geometry = geometry, fill = wbt), 77 | size = 0, color = NA) + 78 | scale_fill_continuous_diverging(palette = "Vik", 79 | mid = wbt_cgn, 80 | aesthetics = c("fill"), 81 | labels = scales::label_percent(accuracy = 1) 82 | ) + 83 | guides( 84 | fill = guide_colorbar(title = "Turnout"), 85 | # fill = "none", 86 | color = "none") + 87 | cowplot::theme_map(font_family = "Roboto") + 88 | theme(plot.background = element_rect(color = NA, fill = "white"), 89 | legend.text = element_text(color = "grey50"), 90 | legend.position = "bottom", 91 | legend.key.width = unit(10, "mm"), 92 | legend.key.height = unit(2.5, "mm") 93 | ) 94 | 95 | plot_gg(p, width = 7, height = 8, 96 | height_aes = "fill", 97 | multicore = TRUE, 98 | preview = FALSE, 99 | raytrace = TRUE, 100 | phi = 35, theta = 0, 101 | scale = 300, zoom = 0.45, 102 | # params passed to plot_3d() 103 | solid = TRUE, 104 | solidcolor = "white", 105 | soliddepth = 0, 106 | background = "white", 107 | baseshape = "circle", 108 | obj_material = rayrender::diffuse(), 109 | ground_material = rayrender::diffuse(), 110 | # reduce_size = 0, 111 | linewidth = 0, # default: 2 112 | windowsize = c(1600, 1600) # see https://github.com/tylermorganwall/rayshader/issues/70 113 | ) 114 | 115 | # render_label with plot_gg: https://github.com/tylermorganwall/rayshader/issues/82 116 | 117 | title <- "Turnout in Cologne's districts (Federal Election 2021)" 118 | title_font <- "Oswald" 119 | title_size <- 48 120 | 121 | render_snapshot(here("plots", "day11-3d-turnout_snapshot.png"), 122 | ground_size = 100000, 123 | title_text = title, 124 | title_font = title_font, 125 | title_size = title_size, 126 | smooth_line = TRUE, 127 | # software_render = TRUE, 128 | # webshot = TRUE, 129 | cache_filename = here("plots", "day11-3d-snapshot-cache.png"), 130 | windowsize = c(1600, 1600) 131 | ) 132 | 133 | render_highquality(here("plots", "day11-3d-turnout-hi.png"), 134 | title_text = title, 135 | title_font = title_font, 136 | title_size = title_size, 137 | # smooth_line = TRUE, 138 | # software_render = TRUE, 139 | cache_filename = here("plots", "day11-3d-snapshot-hi-cache.png") 140 | ) 141 | 142 | 143 | #' from: https://arthurwelle.github.io/RayshaderWalkthrough/index.html 144 | #parameters for 360 positions 145 | phivechalf <- 30 + 60 * 1/(1 + exp(seq(-7, 20, length.out = 180)/2)) 146 | phivecfull <- c(rep("88.2", 30), phivechalf, rev(phivechalf)) 147 | thetavec <- c(rep("0", 30), 0 + 60 * sin(seq(0,359,length.out = 360) * pi/180)) 148 | zoomvec <- 0.25 + 0.4 * 1/(1 + exp(seq(-5, 20, length.out = 180))) 149 | zoomvecfull <- c(rep("0.65", 30),zoomvec, rev(zoomvec)) 150 | 151 | render_movie(here("plots", "day11-3d-turnout.gif"), 152 | type = "custom", 153 | width = 8, height = 6, 154 | frames = 390, fps = 24, 155 | hi = phivecfull, 156 | zoom = zoomvecfull, 157 | theta = thetavec, 158 | title_text = title, 159 | title_font = title_font, 160 | title_size = title_size) 161 | 162 | render_movie(here("plots", "day11-3d-turnout.mp4"), 163 | type = "custom", 164 | width = 8, height = 6, 165 | frames = 390, fps = 24, 166 | hi = phivecfull, 167 | zoom = zoomvecfull, 168 | theta = thetavec, 169 | title_text = title, 170 | title_font = title_font, 171 | title_size = title_size) 172 | 173 | 174 | rgl::rgl.clear() 175 | rgl::rgl.close() 176 | 177 | #' If needed, compress and optimize GIF at: 178 | #' 1. https://www.iloveimg.com/compress-image/compress-gif 179 | #' 2. https://ezgif.com/optimize 180 | -------------------------------------------------------------------------------- /R/day12-population.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "sf", "glue", "here", "scico", "rnaturalearth", 2 | "countrycode", "cartogram", "ggtext", "gganimate") 3 | 4 | world <- ne_countries(returnclass = "sf") %>% 5 | st_transform(crs = "+proj=moll") 6 | 7 | 8 | ## GET DATA ==================================================================== 9 | url <- "https://www.offenedaten-koeln.de/sites/default/files/Geburts_Zuzugsorte_Koeln_V1.csv" 10 | immi <- read_csv2(url, 11 | col_names = c("bundesland_staat_nr", "bundesland_staat", 12 | "ags_staat_schluessel", "gemeinde_staat", 13 | "n_geburtsort", "n_zuzug"), skip = 1) 14 | immi_countries <- immi %>% 15 | # exclude German federal states (id 001-016) 16 | filter(bundesland_staat_nr > "016") %>% 17 | rename(country = bundesland_staat) %>% 18 | mutate(country = ifelse(country == "Weißrussland", "Belarus", country)) %>% 19 | arrange(-n_geburtsort) %>% 20 | mutate(country_en = countrycode(country, 21 | origin = "country.name.de", 22 | destination = "country.name"), 23 | country_code = countrycode(country, 24 | origin = "country.name.de", 25 | destination = "iso3c")) 26 | 27 | immi_countries %>% 28 | anti_join(st_drop_geometry(world), by = c("country_code" = "gu_a3")) 29 | 30 | immi_countries_world <- immi_countries %>% 31 | right_join(world, by = c("country_code" = "gu_a3")) %>% 32 | st_as_sf() 33 | class(immi_countries_world) 34 | 35 | immi_countries_world %>% 36 | ggplot() + 37 | # geom_sf(data = world, size = 0.1, col = "grey89", fill = "grey80") + 38 | geom_sf(aes(geometry = geometry, fill = n_geburtsort), 39 | size = 0.1, col = "grey89") + 40 | # scale_fill_binned(trans = "pseudo_log") + 41 | scale_fill_viridis_c(trans = "pseudo_log") + 42 | # scico::scale_fill_scico(palette = "bamako") + 43 | coord_sf() + 44 | theme_minimal() + 45 | theme(axis.text = element_blank(), 46 | legend.position = "bottom", 47 | legend.key.width = unit(10, "mm"), 48 | legend.key.height = unit(3, "mm"), 49 | plot.background = element_rect(color = NA, fill = "grey12"), 50 | panel.grid = element_line(size = 0.1, color = "grey89")) 51 | ggsave(here("plots", "day12-population.png"), 52 | dpi = 600, width = 10, height = 9) 53 | 54 | #' https://r-charts.com/spatial/cartogram-ggplot2/ 55 | carto_data_immi <- immi_countries_world %>% 56 | # mutate(n_geburtsort = replace_na(n_geburtsort, 0)) %>% 57 | mutate(representation = "contiguous cartogram") %>% 58 | cartogram_cont(weight = "n_geburtsort") 59 | 60 | ggplot(carto_data_immi) + 61 | geom_sf(aes(fill = n_geburtsort), 62 | col = NA) + 63 | geom_sf_label(data = filter(carto_data_immi, n_geburtsort > 2500), 64 | aes(label = country_code), 65 | stat = "sf_coordinates", 66 | size = 3, fill = "#1d3242", family = "Chivo", 67 | label.size = 0, alpha = 0.8, col = "white") + 68 | scale_fill_scico(palette = "bamako", na.value = "grey90") + 69 | coord_sf() + 70 | theme_minimal() + 71 | theme(axis.text = element_blank(), 72 | axis.title = element_blank(), 73 | legend.position = "bottom", 74 | legend.key.width = unit(10, "mm"), 75 | legend.key.height = unit(3, "mm"), 76 | plot.background = element_rect(color = NA, fill = "white"), 77 | # panel.grid = element_line(size = 0.1, color = "grey89"), 78 | panel.grid= element_blank() 79 | ) 80 | ggsave(here("plots", "day12-population-cartogram.png"), 81 | dpi = 600, width = 10, height = 9) 82 | 83 | 84 | #' https://r-charts.com/spatial/cartogram-ggplot2/ 85 | carto_data_immi_dorling <- immi_countries_world %>% 86 | mutate(representation = "dorling cartogram") %>% 87 | filter(!is.na(n_geburtsort)) %>% 88 | # mutate(n_geburtsort = replace_na(n_geburtsort, 0)) %>% 89 | cartogram_dorling(weight = "n_geburtsort") 90 | 91 | ggplot(carto_data_immi_dorling) + 92 | geom_sf(aes(fill = n_geburtsort), 93 | col = NA) 94 | 95 | 96 | representations_df <- immi_countries_world %>% 97 | mutate(representation = "map (mollweide projection)") %>% 98 | bind_rows(carto_data_immi, carto_data_immi_dorling) %>% 99 | mutate(representation = factor(representation, 100 | levels = c("map (mollweide projection)", "contiguous cartogram", "dorling cartogram"))) %>% 101 | filter(!(representation %in% c("contiguous cartogram", "dorling cartogram") & is.na(n_geburtsort))) 102 | 103 | 104 | p <- representations_df %>% 105 | # repair a few invalid geoms 106 | # https://r-spatial.org/r/2017/03/19/invalid.html#corrup-or-invalid-geometries 107 | st_make_valid() %>% 108 | # TODO: experimentation with missing countries 109 | filter(!is.na(n_geburtsort)) %>% 110 | # remove Antarktika which only appears in the map representation 111 | filter(geounit != "Antarctica") %>% 112 | ggplot() + 113 | geom_sf(aes(fill = n_geburtsort), 114 | col = NA) + 115 | geom_sf_label(data = . %>% filter(n_geburtsort > 4000), 116 | aes(label = country_code), 117 | stat = "sf_coordinates", 118 | size = 2, fill = "#1d3242", family = "Chivo", 119 | label.size = 0, alpha = 0.3, col = "white") + 120 | viridis::scale_fill_viridis(option = "E", trans = "log2", 121 | labels = scales::label_number(), 122 | breaks = c(300, 1000, 5000, 30000), 123 | name = "# of residents") + 124 | # facet_wrap(vars(representation)) + 125 | coord_sf() + 126 | labs(title = "Country of birth of Cologne residents", 127 | subtitle = "Cologne residents by country of birth outside Germany as of 2014. 128 | Listed are places of birth with more than 100 persons. 129 | In the cartograms, the countries of origin are enlarged or reduced according 130 | to the number of inhabitants of Cologne. 131 |


132 | 133 | {str_to_title(closest_state)} 134 | ", 135 | caption = "Data: Open Data Cologne, 136 | NaturalEarthData | 137 | Visualization: Ansgar Wolsing") + 138 | theme_minimal(base_family = "Helvetica Neue Light", base_size = 9) + 139 | theme(axis.text = element_blank(), 140 | axis.title = element_blank(), 141 | # legend.position = "bottom", 142 | legend.position = c(0.075, 0.25), 143 | legend.key.width = unit(3, "mm"), 144 | legend.key.height = unit(6, "mm"), 145 | legend.text = element_text(size = 6), 146 | plot.background = element_rect(color = NA, fill = "white"), 147 | # panel.grid = element_line(size = 0.1, color = "grey89"), 148 | panel.grid = element_blank(), 149 | text = element_text(color = "grey35", lineheight = 1.25), 150 | plot.title = element_text(family = "Oswald", 151 | color = "black", face = "plain", 152 | margin = margin(t = 6, b = 8)), 153 | plot.title.position = "plot", 154 | plot.subtitle = element_textbox_simple(size = 8, margin = margin(b = 0)), 155 | plot.caption = element_markdown(size = 6, color = "grey45", hjust = 0) 156 | ) 157 | p 158 | 159 | p_anim <- p + transition_states(representation, transition_length = 3, state_length = 2) 160 | animate(p_anim, width = 1200, height = 900, res = 200, units = "px") 161 | anim_save(here("plots", "day12-population-animated.gif"), 162 | nframes = 180, fps = 24, rewind = TRUE, device = "ragg_png", units = "in") 163 | 164 | -------------------------------------------------------------------------------- /R/day13-naturalearth.R: -------------------------------------------------------------------------------- 1 | # Download development version of devtools which fixes ne_download issue 2 | # devtools::install_github("ropensci/rnaturalearth") 3 | pacman::p_load("tidyverse", "sf", "glue", "here", "scico", "rnaturalearth", 4 | "ggtext", "raster", "ggfx") 5 | 6 | 7 | #' https://github.com/ropensci/rnaturalearth 8 | ## RIVERS 9 | dir_raster <- here("data", "raster_data") 10 | ne_type <- "rivers_lake_centerlines" 11 | if (!file.exists(here(dir_raster, ne_type))) { 12 | ne_download(scale = 10, type = ne_type, category = "physical", 13 | destdir = here(dir_raster, ne_type), load = FALSE) 14 | } 15 | rivers <- ne_load(scale = 10, category = "physical", type = ne_type, 16 | destdir = here(dir_raster, ne_type), returnclass = "sf") 17 | rhine <- rivers[rivers$name_en == "Rhine", ] 18 | 19 | ggplot(rhine) + 20 | geom_sf() 21 | 22 | 23 | #' https://www.naturalearthdata.com/features/ 24 | # Download shaded relief raster (SR) in high/low resolution (HR/LR) 25 | ne_type <- "SR_LR" 26 | if (!file.exists(dir_raster)) { 27 | ne_download(scale = 50, type = ne_type, category = "raster", 28 | destdir = dir_raster, load = FALSE) 29 | } 30 | 31 | raster <- ne_load(scale = 10, category = "raster", type = "", 32 | destdir = dir_raster, file_name = ne_type, returnclass = "sf") 33 | 34 | extent <- extent(3.5, 10.5, 46.5, 52) 35 | relief <- raster %>% 36 | crop(extent) %>% 37 | as("SpatialPixelsDataFrame") %>% 38 | as.data.frame() %>% 39 | rename(value = SR_LR) %>% 40 | mutate(geometry = map2(x, y, ~st_point(c(.x, .y)))) %>% 41 | st_as_sf() 42 | st_crs(relief) <- "EPSG:4326" 43 | 44 | 45 | ggplot(relief) + 46 | # Relief 47 | geom_raster(aes(x, y), fill = "black") + 48 | geom_raster(aes(x, y, alpha = value), fill = "grey90", 49 | show.legend = FALSE) + 50 | # The Rhine river course 51 | geom_sf(data = rhine, 52 | col = "white", size = 0.9) + 53 | # TITLE + key facts 54 | annotate("richtext", 55 | label = "The Rhine", 56 | x = 4.0, y = 49.5, 57 | family = "Noto Serif Display", 58 | size = 14, col = "grey96", 59 | label.color = NA, fill = NA, 60 | hjust = 0, 61 | ) + 62 | annotate("richtext", 63 | label = "Source: Rein Anteriur, CH
64 | Mouth: North Sea, NL
65 | Length: 1,233 km", 66 | x = 4.1, y = 49.15, 67 | family = "Noto Serif Display", 68 | size = 4, col = "grey90", 69 | label.color = NA, fill = NA, 70 | hjust = 0, vjust = 1, lineheight = 1.3 71 | ) + 72 | scale_alpha(range = c(0.005, 0.15)) + 73 | labs(caption = "Data: **Natural Earth** | Visualization: **Ansgar Wolsing**", 74 | x = NULL, y = NULL) + 75 | coord_sf(xlim = c(4, 10.5)) + 76 | theme_minimal(base_family = "Roboto") + 77 | theme(plot.background = element_rect(color = NA, fill = "grey10"), 78 | panel.background = element_rect(color = NA, fill = NA), 79 | panel.grid = element_blank(), 80 | axis.text = element_blank(), 81 | panel.spacing = unit(10, "mm"), 82 | plot.margin = margin(t = 0, l = 0, r = 0, b = 0), 83 | plot.caption = element_markdown(family = "Roboto", size = 8, 84 | hjust = 0, color = "grey75", 85 | margin = margin(t = 2, l = 20, b = 2))) 86 | ggsave(here("plots", "day13_naturalearth.png"), dpi = 1000, 87 | width = 5, height = 6.8) 88 | 89 | -------------------------------------------------------------------------------- /R/day14-datawrapper-chart.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "" 3 | output: github_document 4 | self_contained: false 5 | --- 6 | 7 | ```{r setup, include=FALSE} 8 | knitr::opts_chunk$set(echo = TRUE) 9 | ``` 10 | 11 | ## #30DayMapChallenge | Day 14 | Using a new tool 12 | 13 | Map created with [Datawrapper](https://www.datawrapper.com). The tile grid, created by @z3tt and me, can be downloaded from https://github.com/z3tt/grid-btw-wahlkreise-constituencies. 14 | 15 | ![](plots/voter-turnout-in-the-german-federal-election-2021.png) 16 | 17 | Interactive map: https://datawrapper.dwcdn.net/oaJLl/6/ 18 | 19 | 20 | 21 | -------------------------------------------------------------------------------- /R/day14-datawrapper-chart.md: -------------------------------------------------------------------------------- 1 | 2 | ## \#30DayMapChallenge \| Day 14 \| Using a new tool 3 | 4 | Map created with [Datawrapper](https://www.datawrapper.com). The tile 5 | grid, created by @z3tt and me, can be downloaded from 6 | [](https://github.com/z3tt/grid-btw-wahlkreise-constituencies) 7 | 8 | 10 | -------------------------------------------------------------------------------- /R/day14-datawrapper-prep.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | 3 | #' Data prep for Datawrapper map 4 | #' Map editor: https://app.datawrapper.de/map/b69Bt/data 5 | 6 | url_btw <- "https://www.bundeswahlleiter.de/bundestagswahlen/2021/ergebnisse/opendata/csv/kerg2.csv" 7 | btw <- read_csv2(url_btw, skip = 9) 8 | colnames(btw) <- str_to_lower(colnames(btw)) 9 | 10 | btw_wbt <- btw %>% 11 | filter(wahlart == "BT", wahltag == "26092021", gebietsart == "Wahlkreis", 12 | gruppenart == "System-Gruppe", 13 | gruppenname == "Wählende") %>% 14 | mutate(wkr_nr = as.numeric(gebietsnummer)) %>% 15 | select(wkr_nr, wkr_name = "gebietsname", wbt = prozent) 16 | # select(wkr_name = "gebietsname", VALUE = prozent) 17 | 18 | write_csv(btw_wbt, here::here("data", "bundestagswahl2021-wbt.csv")) 19 | -------------------------------------------------------------------------------- /R/day16-urban-rural-de-us.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "sf", "osmdata", "patchwork") 2 | 3 | ## COLOGNE, GERMANY vs. COLOGNE, MINNESOTA, USA ## 4 | 5 | 6 | ## GEOMETRIES ================================================================== 7 | 8 | crs <- "EPSG:4326" 9 | 10 | get_geo_features <- function(place, crs = "EPSG:4326") { 11 | 12 | ## Shape 13 | message(glue("Get shape of {place}.")) 14 | shape <- getbb(place, format_out = "sf_polygon") 15 | bbox <- getbb(place, format_out = "matrix") 16 | 17 | # If multipolygon is available use it, otherwise use polygon 18 | if (!is.null(shape[["multipolygon"]])) { 19 | shape <- shape[["multipolygon"]] 20 | } else if (!is.null(shape[["polygon"]])) { 21 | shape <- shape[["polygon"]] 22 | } else { 23 | # ... 24 | } 25 | st_crs(shape) <- crs 26 | 27 | # Get streets 28 | message(glue("Get street features for {place}.")) 29 | highway_features <- opq(place) %>% 30 | add_osm_feature(key = "highway") %>% 31 | osmdata_sf() 32 | 33 | st_crs(highway_features$osm_lines) <- crs 34 | 35 | message(glue("Intersect street features and shape for {place}")) 36 | highway_features_filtered <- highway_features$osm_lines %>% 37 | filter(., st_intersects(., shape, sparse = FALSE)[, 1]) %>% 38 | st_intersection(shape) 39 | 40 | # return results in a list 41 | list("shape" = shape, 42 | "bbox" = bbox, 43 | "highway_features" = highway_features, 44 | "highway_features_filtered" = highway_features_filtered) 45 | 46 | } 47 | 48 | features_us <- get_geo_features("Cologne, Minnesota, USA") 49 | features_de <- get_geo_features("Cologne, Germany") 50 | write_rds(features_de, here("data", "day16_features_de.rds")) 51 | 52 | ggplot() + 53 | geom_sf(data = features_us$shape) + 54 | geom_sf(data = features_us$highway_features_filtered, 55 | col = "red") 56 | 57 | street_types <- list( 58 | large = c("motorway", "primary", "motorway_link", "primary_link"), 59 | medium = c("secondary", "tertiary", "secondary_link", "tertiary_link"), 60 | small = c("residential", "living_street", "unclassified", "service", "footway") 61 | ) 62 | 63 | #' In order to get the same extent for both facets despite different shapes, 64 | #' we have to define a buffer box. Since Cologne, DE has the larger area, we take 65 | #' its bounding box as a reference 66 | box = list( 67 | "width" = features_de$bbox["x", "max"] - features_de$bbox["x", "min"], 68 | "height" = features_de$bbox["y", "max"] - features_de$bbox["y", "min"] 69 | ) 70 | 71 | # Create the plot for given location with given features 72 | street_plot <- function(feature_set, place_name, info_str, fill_color, 73 | box = NULL, use_box_aspect_ratio = TRUE) { 74 | feature_set$shape$place_name <- place_name 75 | feature_set$shape$facet_label <- glue(" 76 | {place_name}

{info_str}") 77 | 78 | # Add a buffer to the city's bounding box 79 | width <- feature_set$bbox["x", "max"] - feature_set$bbox["x", "min"] 80 | height <- feature_set$bbox["y", "max"] - feature_set$bbox["y", "min"] 81 | if (!missing(box)) { 82 | aspect_ratio <- ifelse(use_box_aspect_ratio, 83 | (box$width / box$height) / (width/height), 84 | 1) 85 | print(aspect_ratio) 86 | coord_limits <- list( 87 | x = c("min" = feature_set$bbox["x", "min"] - aspect_ratio * (box$width - width) / 2, 88 | "max" = feature_set$bbox["x", "max"] + aspect_ratio * (box$width - width) / 2), 89 | y = c("min" = feature_set$bbox["y", "min"] - (box$height - height) / 2, 90 | "max" = feature_set$bbox["y", "max"] + (box$height - height) / 2) 91 | ) 92 | } else { 93 | coord_limits <- list( 94 | x = c("min" = feature_set$bbox["x", "min"], "max" = feature_set$bbox["x", "max"]), 95 | y = c("min" = feature_set$bbox["y", "min"], "max" = feature_set$bbox["y", "max"]) 96 | ) 97 | } 98 | 99 | print(coord_limits) 100 | print(feature_set$bbox) 101 | 102 | ggplot() + 103 | geom_sf(data = feature_set$shape, fill = fill_color, col = "grey89", size = 0.3) + 104 | geom_sf(data = filter(feature_set$highway_features_filtered, highway %in% street_types$small), 105 | size = 0.1, alpha = 0.8, col = "#e9e9e9") + 106 | geom_sf(data = filter(feature_set$highway_features_filtered, highway %in% street_types$medium), 107 | size = 0.15, col = "#e9e9e9") + 108 | geom_sf(data = filter(feature_set$highway_features_filtered, highway %in% street_types$large), 109 | size = 0.4, col = "#f5f5f5") + 110 | facet_wrap(vars(facet_label)) + 111 | coord_sf(xlim = coord_limits$x, ylim = coord_limits$y) + 112 | cowplot::theme_map(font_family = "Roboto") + 113 | theme(text = element_text(color = "grey92"), 114 | strip.background = element_rect(color = NA, fill = fill_color), 115 | strip.text = element_markdown(color = "white", hjust = 0, 116 | lineheight = 1.4, 117 | margin = margin(t = 12, l = 12, b = 12)), 118 | panel.background = element_rect(color = NA, 119 | fill = alpha(fill_color, 0.4)), 120 | plot.background = element_rect(color = NA, fill = "white")) 121 | } 122 | 123 | # Plot for Cologne, Minnesota 124 | pop_density <- (1981 / 4.95) %>% 125 | scales::number(accuracy = 1, big.mark = ",") 126 | info_str_us <- glue( 127 | "**Population:** 1,981
128 | **Area:** 4.95 km2
129 | **Population density:** {pop_density} inhabitants/km2 130 | ") 131 | p_us <- street_plot(features_us, "Cologne, Minnesota", info_str = info_str_us, 132 | fill_color = "#0a5e0a", box = box) 133 | 134 | 135 | # Plot for Cologne, Germany 136 | pop_density <- (1083498 / 405.15) %>% 137 | scales::number(accuracy = 1, big.mark = ",") 138 | info_str_de <- glue( 139 | "**Population:** 1,083,498
140 | **Area:** 405.15 km2
141 | **Population density:** {pop_density} inhabitants/km2 142 | ") 143 | p_de <- street_plot(features_de, "Cologne, Germany", info_str = info_str_de, 144 | fill_color = "grey12", box = box) 145 | 146 | # Combine the plots in one chart 147 | p_us_de <- p_us + p_de + 148 | plot_annotation(title = "Two Cities of Cologne", 149 | subtitle = NULL, 150 | caption = "Data: **OpenStreetMap contributors**, 151 | Population as of 2020 (Source: **Wikipedia**) | 152 | Visualization: **Ansgar Wolsing**", 153 | theme = theme( 154 | text = element_text(color = "grey35", family = "Roboto"), 155 | plot.title = element_markdown(color = "grey4", 156 | family = "Oswald", 157 | face = "plain", 158 | size = 42, 159 | hjust = 0.5, 160 | margin = margin(t = 6, b = 12)), 161 | plot.subtitle = element_textbox_simple(size = 14, 162 | hjust = 0.5, 163 | halign = 0.5, 164 | margin = margin(t = 4, b = 12)), 165 | plot.caption = element_markdown(size = 10, 166 | hjust = 0.5, 167 | margin = margin(t = 8, b = 8)) 168 | ) 169 | ) + 170 | plot_layout() 171 | ggsave(here("plots", "day16-two-cities-of-cologne.png"), plot = p_us_de, device = ragg::agg_png, width = 10, height = 8) 172 | 173 | -------------------------------------------------------------------------------- /R/day16-urban-rural-trees.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "sf") 2 | 3 | ## GET DATA ==================================================================== 4 | #' Tree population in Cologne, 2020 5 | #' Source: Offene Daten Köln, 6 | #' https://www.offenedaten-koeln.de/dataset/baumkataster-koeln 7 | 8 | url_trees_2020 <- "https://www.offenedaten-koeln.de/sites/default/files/20200610_Baumbestan_Koeln.zip" 9 | data_dir <- here("data", "cologne_trees") 10 | if (!dir.exists(data_dir)) { 11 | dir.create(data_dir) 12 | download.file(url_trees_2020, destfile = here(data_dir, "Shapes_Bestand_Einzelbaeume_Koeln_2020.zip")) 13 | unzip(here(data_dir, "Shapes_Bestand_Einzelbaeume_Koeln_2020.zip"), 14 | exdir = here(data_dir, "Shapes_Bestand_Einzelbaeume_Koeln_2020")) 15 | } 16 | 17 | crs <- "EPSG:4326" 18 | trees_2020_sf <- st_read(here(data_dir, 19 | "Shapes_Bestand_Einzelbaeume_Koeln_2020", 20 | "Baumbestand.shp")) 21 | trees_2020_sf <- st_transform(trees_2020_sf, crs) 22 | st_crs(trees_2020_sf) 23 | 24 | 25 | ## Basic EDA =================================================================== 26 | 27 | trees_2020_sf %>% 28 | st_drop_geometry() %>% 29 | ggplot(aes(ANZAHL)) + 30 | geom_boxplot() 31 | 32 | trees_2020_sf %>% 33 | st_drop_geometry() %>% 34 | filter(ANZAHL <= 100) %>% 35 | ggplot(aes(ANZAHL)) + 36 | geom_histogram(binwidth = 1) 37 | 38 | trees_2020_sf %>% 39 | st_drop_geometry() %>% 40 | filter(ANZAHL == 0) %>% 41 | count(beschreibu) 42 | 43 | # Replace NA with 1 for ANZAHL (number of trees) 44 | trees_2020_sf_prep <- trees_2020_sf %>% 45 | mutate(ANZAHL2 = replace_na(ANZAHL, 1), 46 | ANZAHL2 = ifelse(ANZAHL2 == 0, 1, ANZAHL2)) 47 | 48 | 49 | ## Reduce to a smaller circle around the city center 50 | cgn_centroid <- # st_centroid(shape_cgn) %>% 51 | st_point(c(6.93, 50.94558)) %>% 52 | st_sfc() %>% 53 | st_sf(crs = "EPSG:4326") %>% 54 | st_transform(crs = "EPSG:3857") 55 | 56 | cgn_circle <- st_buffer(cgn_centroid, dist = 7500) 57 | 58 | 59 | trees_2020_sf_prep_intersect <- st_intersection( 60 | cgn_circle, 61 | st_transform(trees_2020_sf_prep, "EPSG:3857")) 62 | 63 | 64 | # Number of trees (sum, not number of rows) 65 | n_trees_cgn <- sum(trees_2020_sf_prep$ANZAHL2) 66 | n_trees_cgn_circle <- sum(trees_2020_sf_prep_intersect$ANZAHL2) 67 | n_trees_cgn_fmt <- scales::number(n_trees_cgn, big.mark = ",") 68 | n_trees_cgn_circle_fmt <- scales::number(n_trees_cgn_circle, big.mark = ",") 69 | 70 | base_font <- "Lato" 71 | span_tag <- glue("") 72 | plot_titles <- list( 73 | title = "TREES OF COLOGNE", 74 | subtitle = glue("{span_tag}{n_trees_cgn_fmt} trees are registered in the 75 | (yet to be completed) tree cadastre of the Municipality of Cologne. 76 | {span_tag}{n_trees_cgn_circle_fmt} trees are displayed in this visualization."), 77 | caption = glue("Data: {span_tag}Municipality of Cologne, Tree Cadastre | 78 | Visualization: {span_tag}Ansgar Wolsing")) 79 | 80 | p <- ggplot() + 81 | geom_sf(data = cgn_circle, 82 | fill = "grey12", col = "grey70", size = 1.25) + 83 | geom_sf(data = trees_2020_sf_prep_intersect, 84 | aes(size = ANZAHL2), 85 | col = "deeppink", alpha = 0.6, 86 | show.legend = FALSE) + 87 | geom_sf(data = cgn_circle, 88 | fill = NA, col = "grey97", size = 1) + 89 | scale_size_continuous(range = c(0.0005, 0.25)) + 90 | coord_sf() + 91 | labs(title = plot_titles$title, 92 | subtitle = plot_titles$subtitle, 93 | caption = plot_titles$caption) + 94 | cowplot::theme_map() + 95 | theme( 96 | plot.background = element_rect(color = NA, fill = "black"), 97 | text = element_text(family = paste(base_font, "Light"), color = "grey90", 98 | lineheight = 1.33), 99 | plot.title = element_markdown(color = "white", family = "Bangers", 100 | face = "plain", hjust = 0.5, size = 40, 101 | margin = margin(t = 6, b = 18)), 102 | plot.subtitle = element_textbox_simple(hjust = 0.5, halign = 0.5, 103 | margin = margin(t = 0, b = 12)), 104 | plot.caption = element_markdown(hjust = 0.5, size = 9, 105 | margin = margin(t = 12, b = 4)) 106 | 107 | ) 108 | ggsave(here("plots", "day16_urban-rural_trees.png"), plot = p, 109 | dpi = 600, width = 8, height = 8) 110 | 111 | 112 | -------------------------------------------------------------------------------- /R/day17-land_use.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "sf", "paletteer") 2 | 3 | ## GET DATA ==================================================================== 4 | #' Land use plan ("Flächennutzungsplan") of Cologne 5 | 6 | # lup_url <- "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?where=objectid+is+not+null&text=&objectIds=&time=&geometry=&geometryType=esriGeometryEnvelope&inSR=&spatialRel=esriSpatialRelIntersects&distance=&units=esriSRUnit_Foot&relationParam=&outFields=*&returnGeometry=true&returnTrueCurves=false&maxAllowableOffset=&geometryPrecision=&outSR=4326&havingClause=&returnIdsOnly=false&returnCountOnly=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&returnZ=false&returnM=false&gdbVersion=&historicMoment=&returnDistinctValues=false&resultOffset=&resultRecordCount=&returnExtentOnly=false&datumTransformation=¶meterValues=&rangeValues=&quantizationParameters=&featureEncoding=esriDefault&f=pjson" 7 | # lup <- st_read(lup_url) 8 | 9 | lup_urls <- c( 10 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/3/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 11 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%201%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 12 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2012%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 13 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%207%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 14 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2013%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 15 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%206%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 16 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2014%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 17 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2033%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 18 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%209%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 19 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2020%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 20 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2011%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 21 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%202%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 22 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%205%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 23 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2022%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 24 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%203%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 25 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%204%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 26 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2015%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 27 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2016%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 28 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/6/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 29 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/5/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 30 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2021%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 31 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/4/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 32 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2017%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 33 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2010%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 34 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/1/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 35 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2023%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 36 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%208%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 37 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%200%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 38 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/7/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20AND%20subtype%20%3D%2019%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100", 39 | "https://geoportal.stadt-koeln.de/arcgis/rest/services/planen_und_bauen/flaechennutzungsplan/MapServer/2/query?f=json&where=%20objectid%20IS%20NOT%20NULL%20&returnGeometry=true&spatialRel=esriSpatialRelIntersects&outFields=*&outSR=102100" 40 | ) 41 | 42 | length(unique(lup_urls)) 43 | lup_urls <- unique(lup_urls) 44 | lup <- map_dfr(lup_urls, st_read) 45 | 46 | 47 | #' https://offenedaten-koeln.de/dataset/stadtbezirke-koeln 48 | url_boroughs <- "https://geoportal.stadt-koeln.de/arcgis/rest/services/Basiskarten/kgg/MapServer/4/query?where=objectid+is+not+null&text=&objectIds=&time=&geometry=&geometryType=esriGeometryEnvelope&inSR=&spatialRel=esriSpatialRelIntersects&distance=&units=esriSRUnit_Foot&relationParam=&outFields=*&returnGeometry=true&returnTrueCurves=false&maxAllowableOffset=&geometryPrecision=&outSR=4326&havingClause=&returnIdsOnly=false&returnCountOnly=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&returnZ=false&returnM=false&gdbVersion=&historicMoment=&returnDistinctValues=false&resultOffset=&resultRecordCount=&returnExtentOnly=false&datumTransformation=¶meterValues=&rangeValues=&quantizationParameters=&featureEncoding=esriDefault&f=pjson" 49 | boroughs_sf <- st_read(here("data", "cologne_stadtbezirke", "stadtbezirke_koeln.json")) 50 | 51 | lup %>% 52 | st_drop_geometry() %>% 53 | count(nutzung, sort = TRUE) 54 | lup %>% 55 | st_drop_geometry() %>% 56 | count(nutzung) 57 | lup %>% 58 | filter(is.na(nutzung)) %>% 59 | select(erlaeuterung) 60 | 61 | 62 | #' Urban land use categories 63 | #' https://www.semanticscholar.org/paper/Urban-land-use-classes-with-fuzzy-membership-and-on-Zhan-Molenaar/37f786405ce6e88fcd5e4cd6f2e72efce11fdc96/figure/2 64 | #' https://www.bbc.co.uk/bitesize/guides/z3n9gdm/revision/1 65 | #' https://www.gesetze-im-internet.de/planzv_90/BJNR000580991.html 66 | #' https://www.land.com/buying/guide-to-land-use-definitions 67 | 68 | # Translation of use categories 69 | de_en_translation <- c( 70 | "Bahnanlagen" = "Railroad facilities", 71 | "Besonderes Wohngebiet" = "Special residential area", 72 | "Forstwirtschaft, Erholungswald" = "Forestry, recreational forest", 73 | "Gemeinbedarf" = "Institutional", 74 | "Gemischte Baufläche" = "Mixed construction area", 75 | "Gewerbegebiet" = "Business park", 76 | "Grünfläche" = "Green urban area", 77 | "Hauptverkehrszüge" = "Railroad", 78 | "Industriegebiet" = "Industrial use", 79 | "Kerngebiet" = "Business area", 80 | "Landwirtschaft" = "Agriculture", 81 | "Luftverkehr" = "Airport", 82 | "Mischgebiet" = "Mixed use area", 83 | "Sanierungsgebiet" = "Redevelopment area", 84 | "Sonderbaufläche" = "Special-purpose area", 85 | "Unbekannt" = "Unknown", 86 | "Ver- und Entsorgung" = "Power plants & dump sites", 87 | "Waldfläche mit besonderer Nutzung" = "Forestry with special use", 88 | "Wasserflächen" = "Waterbody", 89 | "Windenergieanlagen" = "Wind energy plants", 90 | "Wohnbaufläche" = "Residential area" 91 | ) 92 | 93 | 94 | 95 | lup_prep <- lup %>% 96 | mutate(nutzung2 = replace_na(nutzung, "Unbekannt"), 97 | nutzung2 = str_remove(nutzung2, "Fläche für(\\s(den|die|das))?"), 98 | nutzung2 = case_when( 99 | str_detect(nutzung2, "Grünfläche") ~ "Grünfläche", 100 | str_detect(nutzung2, "Sonderbaufläche") ~ "Sonderbaufläche", 101 | TRUE ~ nutzung2), 102 | nutzung2 = str_trim(nutzung2) 103 | ) %>% 104 | select(nutzung2) %>% 105 | mutate( 106 | landuse = de_en_translation[nutzung2], 107 | landuse_grp = fct_collapse( 108 | landuse, 109 | "Residential" = c("Residential area", "Special residential area"), 110 | "Transport" = c("Railroad facilities", "Airport", "Railroad"), 111 | "Forestry" = c("Forestry, recreational forest", "Forestry with special use"), 112 | "Industry" = c("Industrial use", "Business park"), 113 | "Commercial" = c("Business area") 114 | )) 115 | 116 | lup_prep %>% 117 | st_drop_geometry() %>% 118 | count(nutzung2) 119 | 120 | lup_prep %>% 121 | st_drop_geometry() %>% 122 | count(landuse) 123 | 124 | ## PLOTS ======================================================================= 125 | 126 | # Choose colors for land use categories 127 | paletteer_d("trekcolors::lcars_cardassian") 128 | landuse_colors <- c( 129 | "Residential area" = "#BFCAFEFF" , "Special residential area" = "#8B799CFF", 130 | "Railroad facilities" = "#8BEAFFFF", "Airport" = "#80A0E0FF", 131 | "Railroad" = "#B0C8F8FF", 132 | "Green urban area" = "#3C999CFF", 133 | "Agriculture" = "#A1B3E2FF", 134 | "Forestry, recreational forest" = "#9B5928FF", 135 | "Forestry with special use" = "#CA480DFF", 136 | "Industrial use" = "#FFE705FF", "Business park" = "#2F7270FF" 137 | ) 138 | 139 | 140 | 141 | ## FACETS ---------------------------------------------------------------------- 142 | 143 | plot_titles <- list( 144 | title = "Zoning Plan Cologne", 145 | subtitle = "A zoning plan is issued by the municipal authorities 146 | and provides guidelines on how a particular area can be used. 147 | It determines where housing, businesses, agricultural and commercial uses 148 | may be established. 149 | This plot shows selected land use categories.", 150 | caption = "Source: **Municipality of Cologne**, released 2016, last update 2021 | 151 | Visualization: **Ansgar Wolsing**" 152 | ) 153 | 154 | p <- lup_prep %>% 155 | filter(landuse_grp %in% c("Residential", "Green urban area", "Forestry", 156 | "Industry", "Transport", "Agriculture")) %>% 157 | mutate(landuse2 = factor(landuse, levels = c("Agriculture", 158 | "Railroad facilities", "Airport", "Railroad", 159 | "Industrial use", "Business park", 160 | "Forestry, recreational forest", "Forestry with special use", 161 | "Green urban area", 162 | "Residential area", "Special residential area" 163 | ))) %>% 164 | ggplot() + 165 | geom_sf(data = boroughs_sf, fill = "grey20", 166 | col = NA, size = 0.25) + 167 | geom_sf(aes(fill = landuse2), 168 | col = NA, size = 0.15, show.legend = TRUE) + 169 | scale_fill_manual(values = landuse_colors) + 170 | guides(fill = guide_legend(ncol = 4, title = NULL, 171 | override.aes = list(color = "grey4", size = 0.5))) + 172 | facet_wrap(vars(landuse_grp), 173 | labeller = as_labeller(str_to_upper)) + 174 | labs(title = plot_titles$title, 175 | subtitle = plot_titles$subtitle, 176 | caption = plot_titles$caption) + 177 | cowplot::theme_map(font_family = "Helvetica Neue") + 178 | theme(plot.background = element_rect(color = NA, fill = "grey4"), 179 | legend.position = "bottom", 180 | legend.justification = "center", 181 | legend.key.height = unit(4, "mm"), 182 | legend.spacing.x = unit(0.25, "cm"), 183 | legend.text = element_text(size = 10), 184 | text = element_text(color = "grey91"), 185 | plot.title = element_text(size = 36, family = "Oswald", face = "plain", 186 | hjust = 0.5, margin = margin(t = 6, b = 16)), 187 | plot.subtitle = element_textbox_simple(margin = margin(b = 24)), 188 | plot.caption = element_markdown(hjust = 0, margin = margin(t = 36)), 189 | strip.text = element_text(family = "Helvetica Neue", face = "bold", 190 | margin = margin(t = 8, b = 8)), 191 | strip.background = element_rect(color = "white", linetype = "dotted", 192 | fill = "grey8"), 193 | panel.spacing.y = unit(1.25, "cm"), 194 | panel.spacing.x = unit(1, "cm")) 195 | ggsave(here("plots", "day17-landuse-en_facets.png"), plot = p, 196 | dpi = 600, width = 9.5, height = 9) 197 | 198 | 199 | ## ALL IN ONE ------------------------------------------------------------------ 200 | 201 | 202 | plot_titles$subtitle <- "A zoning plan is issued by the municipal authorities 203 | and provides guidelines on how a particular area can be used. 204 | It determines where housing, businesses, agricultural and commercial uses 205 | may be established." 206 | p2 <- lup_prep %>% 207 | mutate(landuse = na_if(landuse, "Unknown")) %>% 208 | ggplot() + 209 | geom_sf(data = boroughs_sf, 210 | col = "grey90", size = 1.5) + 211 | geom_sf(aes(fill = landuse), 212 | col = "grey97", size = 0.15, show.legend = TRUE) + 213 | paletteer::scale_fill_paletteer_d("khroma::discrete_rainbow", 214 | na.value = "grey60", 215 | na.translate = FALSE) + 216 | guides(fill = guide_legend(nrow = 7, title = NULL, 217 | override.aes = list(color = "grey4", size = 0.5))) + 218 | labs(title = plot_titles$title, 219 | subtitle = plot_titles$subtitle, 220 | caption = plot_titles$caption) + 221 | cowplot::theme_map(font_family = "Helvetica Neue") + 222 | theme(plot.background = element_rect(color = NA, fill = "grey4"), 223 | legend.position = "bottom", 224 | legend.justification = "center", 225 | legend.key.height = unit(4, "mm"), 226 | legend.spacing.x = unit(0.25, "cm"), 227 | legend.text = element_text(size = 10), 228 | text = element_text(color = "grey91"), 229 | plot.title = element_text(size = 36, family = "Oswald", face = "plain", 230 | hjust = 0, margin = margin(t = 6, b = 16)), 231 | plot.subtitle = element_textbox_simple(margin = margin(b = 24)), 232 | plot.caption = element_markdown(hjust = 0, margin = margin(t = 36)), 233 | strip.text = element_text(family = "Helvetica Neue", face = "bold", 234 | margin = margin(t = 8, b = 8)), 235 | strip.background = element_rect(color = "white", linetype = "dotted", 236 | fill = "grey8"), 237 | panel.spacing.y = unit(1.25, "cm"), 238 | panel.spacing.x = unit(1, "cm")) 239 | ggsave(here("plots", "day17-landuse.png"), plot = p2, dpi = 600, 240 | width = 8, height = 10) 241 | 242 | 243 | -------------------------------------------------------------------------------- /R/day20-movement.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "sf", "paletteer", 2 | "osmdata", "lubridate", "gganimate", "colorspace") 3 | 4 | ## GET DATA ==================================================================== 5 | 6 | get_geo_features <- function(place, crs = "EPSG:4326") { 7 | 8 | ## Shape 9 | message(glue("Get shape of {place}.")) 10 | shape <- getbb(place, format_out = "sf_polygon") 11 | bbox <- getbb(place, format_out = "matrix") 12 | 13 | # If multipolygon is available use it, otherwise use polygon 14 | if (!is.null(shape[["multipolygon"]])) { 15 | shape <- shape[["multipolygon"]] 16 | } else if (!is.null(shape[["polygon"]])) { 17 | shape <- shape[["polygon"]] 18 | } else { 19 | # ... 20 | } 21 | st_crs(shape) <- crs 22 | 23 | # Get streets 24 | message(glue("Get street features for {place}.")) 25 | highway_features <- opq(place) %>% 26 | add_osm_feature(key = "highway") %>% 27 | osmdata_sf() 28 | 29 | st_crs(highway_features$osm_lines) <- crs 30 | 31 | message(glue("Intersect street features and shape for {place}")) 32 | highway_features_filtered <- highway_features$osm_lines %>% 33 | filter(., st_intersects(., shape, sparse = FALSE)[, 1]) %>% 34 | st_intersection(shape) 35 | 36 | # return results in a list 37 | list("shape" = shape, 38 | "bbox" = bbox, 39 | "highway_features" = highway_features, 40 | "highway_features_filtered" = highway_features_filtered) 41 | 42 | } 43 | 44 | features_cgn <- get_geo_features("Cologne, Germany") 45 | write_rds(features_cgn, here("data", "day19_features_cgn_de.rds")) 46 | 47 | 48 | features_cgn <- read_rds(here("data", "day19_features_cgn_de.rds")) 49 | bike_counters <- read_rds(here("data", "counters_677_daily.rds")) 50 | 51 | # Rhine 52 | 53 | # Get water 54 | water_features <- opq(bbox = features_cgn$shape) %>% 55 | add_osm_feature(key = "water") %>% 56 | osmdata_sf() 57 | rhine <- opq(bbox = features_cgn$shape) %>% 58 | add_osm_feature(key = "name:de", value = "Rhein") %>% 59 | osmdata_sf() 60 | rhine_cgn <- rhine$osm_multilines %>% 61 | st_intersection(features_cgn$shape) 62 | water_features_polygons_cgn <- st_intersection(water_features$osm_polygons, features_cgn$shape) %>% 63 | st_filter(rhine_cgn, 64 | .predicate = function(x, y) st_is_within_distance(x, y, dist = 0.1)) 65 | 66 | 67 | # Correct typo in street name 68 | bike_counters$info <- bike_counters$info %>% 69 | mutate(name = case_when( 70 | name == "09 Alphons-Sibermann-Weg" ~ "09 Alphons-Silbermann-Weg", 71 | name == "Zülpicher Neu kpl" ~ "Zülpicher Straße", 72 | name == "07 Alfred Schütte kpl" ~ "Alfred-Schütte-Allee", 73 | name == "Universitätsstr. kpl" ~ "Universitätsstraße", 74 | TRUE ~ name)) 75 | 76 | # Bike counter location (full streets) 77 | bike_counter_locations <- 78 | str_remove_all(bike_counters$info$name, 79 | "(\\d{2}|kpl\\.?|Rad|Neu\\b)") %>% 80 | str_trim() 81 | 82 | (matched_locations <- features_cgn$highway_features_filtered %>% 83 | st_drop_geometry() %>% 84 | filter(name %in% bike_counter_locations) %>% 85 | pull(name) %>% 86 | unique()) 87 | length(matched_locations) 88 | # Which locations have not been matched in the highway features set? 89 | setdiff(bike_counter_locations, matched_locations) 90 | 91 | # join bike counter info and data 92 | bike_counters_prep <- inner_join(bike_counters$info, bike_counters$data, 93 | by = c("idPdc" = "id")) %>% 94 | arrange(idPdc, date) %>% 95 | mutate(date = as_date(date)) %>% 96 | group_by(idPdc) %>% 97 | # rolling average in 7-day window 98 | mutate(count_roll7 = zoo::rollmean(comptage, k = 7, align = "right", fill = NA), 99 | count_roll28 = zoo::rollmean(comptage, k = 28, align = "right", fill = NA)) %>% 100 | ungroup() %>% 101 | filter(date >= as_date("2020-01-01"), date <= as_date("2020-12-31")) 102 | 103 | ## calculate bounding box from bike counter locations 104 | bike_counters_centroid <- bike_counters_prep %>% 105 | st_as_sf(coords = c("lon", "lat")) %>% 106 | st_centroid() %>% 107 | select(geometry) %>% 108 | slice(1) 109 | 110 | bike_counters_circle <- st_buffer(bike_counters_centroid, dist = 0.1) 111 | st_crs(bike_counters_circle) <- "EPSG:4326" 112 | 113 | features_cgn$highway_features_filtered_circle <- 114 | st_intersection(features_cgn$highway_features_filtered, bike_counters_circle) 115 | 116 | street_types <- list( 117 | large = c("motorway", "primary", "motorway_link", "primary_link"), 118 | medium = c("secondary", "tertiary", "secondary_link", "tertiary_link"), 119 | small = c("residential", "living_street", "unclassified", "service", "footway") 120 | ) 121 | 122 | p <- ggplot() + 123 | geom_sf(data = features_cgn$shape, fill = "grey84", col = NA) + 124 | geom_sf(data = water_features_polygons_cgn, 125 | fill = "steelblue", alpha = 0.8, col = NA) + 126 | # geom_sf(data = filter(features_cgn$highway_features_filtered, highway %in% street_types$small), 127 | # size = 0.15, col = "#e9e9e9") + 128 | # geom_sf(data = filter(features_cgn$highway_features_filtered, highway %in% street_types$medium), 129 | # size = 0.25, col = "#e9e9e9") + 130 | geom_sf(data = filter(features_cgn$highway_features_filtered, highway %in% street_types$large), 131 | size = 0.5, col = "#f5f5f5") + 132 | geom_point(data = bike_counters_prep, 133 | aes(x = lon, y = lat, size = count_roll28, fill = count_roll7), 134 | shape = 21, col = "white", stroke = 0.1) + 135 | # scale_fill_viridis_c(option = "magma") + 136 | scico::scale_fill_scico(palette = "berlin") + 137 | scale_size_continuous(range = c(0.5, 10)) + 138 | # coord_sf(xlim = c(6.83, 7.01), ylim = c(50.88, 50.97)) + 139 | coord_sf(xlim = c(6.85, 7.00), ylim = c(50.90, 50.97)) + 140 | guides(size = guide_legend(override.aes = list(color = "grey50"))) + 141 | labs(title = "One year of bike traffic in Cologne", 142 | subtitle = "Daily bike traffic as measured by bicycle counters at 15 locations 143 | in Cologne, Germany, in 2020

144 | {frame_time}", 145 | caption = "Data: **OpenStreetMap** contributors, **Stadt Köln/eco-visio.net** | 146 | Visualization: **Ansgar Wolsing**", 147 | fill = "7-day rolling daily avg.", size = "28-day rolling daily avg.") + 148 | # cowplot::theme_map(font_family = "Roboto", font_size = 16) + 149 | theme_minimal(base_family = "Roboto", base_size = 14) + 150 | theme(plot.background = element_rect(color = NA, fill = "grey97"), 151 | panel.background = element_rect(color = NA, fill = "grey93"), 152 | legend.position = "bottom", 153 | legend.title = element_text(color = "grey45", size = 8, face = "bold"), 154 | legend.text = element_text(color = "grey45", size = 7), 155 | legend.title.align = 0.5, 156 | legend.box.just = 0.5, 157 | legend.key.height = unit(2, "mm"), 158 | text = element_text(color = "grey35"), 159 | plot.title = element_markdown(color = "black", face = "bold"), 160 | plot.subtitle = element_textbox_simple(margin = margin(t = 6, b = 12)), 161 | plot.caption = element_textbox_simple(margin = margin(t = 12, b = 12)), 162 | axis.text = element_blank(), 163 | axis.title = element_blank(), 164 | panel.grid = element_blank()) 165 | ggsave("foo2.png", plot = p, dpi = 150, width = 1200, height = 1200, units = "px") 166 | 167 | p_anim <- p + 168 | transition_time(date) + 169 | enter_fade() + 170 | exit_fade() 171 | 172 | anim <- animate(p_anim, fps = 24, nframes = 365 / 2, 173 | width = 1200, height = 1200, res = 150, device = "ragg_png") 174 | 175 | anim_save(here("plots", "day20-movement-bike_counters.gif"), anim) 176 | 177 | 178 | 179 | 180 | 181 | ## With streets highlighted directly --------- 182 | 183 | bike_counter_features <- bike_counters_prep %>% 184 | mutate(name = str_remove_all(name, "(\\d{2}|kpl\\.?|Rad|Neu\\b)") %>% 185 | str_trim()) %>% 186 | inner_join(features_cgn$highway_features_filtered, by = "name") 187 | 188 | 189 | 190 | p <- ggplot() + 191 | geom_sf(data = features_cgn$shape, fill = "grey70", col = NA) + 192 | geom_sf(data = filter(features_cgn$highway_features_filtered, highway %in% street_types$medium), 193 | size = 0.15, col = "#e9e9e9") + 194 | geom_sf(data = filter(features_cgn$highway_features_filtered, highway %in% street_types$large), 195 | size = 0.4, col = "#f5f5f5") + 196 | # Bike counters 197 | geom_sf(data = bike_counter_features, 198 | aes(geometry = geometry, 199 | col = comptage, size = comptage), 200 | # col = "deeppink", size = 1 201 | ) + 202 | scale_color_viridis_d(option = "magma") + 203 | scale_size_continuous(range = c(0.5, 2)) + 204 | coord_sf(xlim = c(6.83, 7.01), ylim = c(50.88, 51.01)) + 205 | labs(title = "Bike traffic in Cologne", 206 | subtitle = "Daily bike traffic as measured by bike counters at 15 locations 207 | in Cologne, Germany

208 | {frame_time}") + 209 | cowplot::theme_map(font_family = "Roboto", font_size = 16) + 210 | theme(plot.background = element_rect(color = NA, fill = "white"), 211 | panel.background = element_rect(color = NA, fill = "white"), 212 | legend.position = "bottom", 213 | legend.text = element_text(color = "grey85"), 214 | text = element_text(color = "grey90"), 215 | plot.title = element_markdown(color = "white"), 216 | plot.subtitle = element_markdown()) 217 | p 218 | 219 | p_anim <- p + 220 | transition_time(date) + 221 | enter_fade() + 222 | exit_fade() 223 | 224 | anim <- animate(p_anim, fps = 24, 225 | width = 900, height = 900, res = 100) 226 | 227 | anim_save(here("plots", "day20-movement-bike_counters-lines.gif"), anim) 228 | 229 | 230 | 231 | -------------------------------------------------------------------------------- /R/day24-historical-roman-empire.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", "sf", 2 | "rvest", "raster", "rnaturalearth") 3 | 4 | #' http://awmc.unc.edu/awmc/map_data/shapefiles/political_shading/ 5 | #' 6 | #' For Shapefiles, The suggested citation is the following: 7 | #' Ancient World Mapping Center. “Shapefile name”. 8 | #' [Accessed: April 23, 2013 11:00am] 9 | 10 | 11 | ## Scrape & download shapefiles ================================================ 12 | 13 | # Scrape relevant links 14 | scrape_download_links <- function(url, download_link_regex) { 15 | page <- read_html(url) 16 | links <- html_nodes(page, css = "a") %>% html_attr("href") 17 | grep(download_link_regex, links, value = TRUE) 18 | } 19 | 20 | download_repo_files <- function(base_url, rel_links, data_dir, force = FALSE) { 21 | if (!dir.exists(data_dir) | force) { 22 | dir.create(data_dir) 23 | walk(rel_links, ~download.file(paste0(base_url, .x), 24 | destfile = here(data_dir, .x))) 25 | } else { 26 | message(glue("Folder {data_dir} already exists. Skipping download.")) 27 | } 28 | } 29 | 30 | 31 | url <- "http://awmc.unc.edu/awmc/map_data/shapefiles/political_shading/" 32 | links_roman_empire <- scrape_download_links(url, "roman_empire_(60_bc|bc_60|ad_14|ad_117|ad_75|ad_69)") 33 | # Download shapefiles for extent and provinces 34 | data_dir <- here("data", "roman_empire") 35 | download_repo_files(url, links_roman_empire, data_dir, force = TRUE) 36 | 37 | # # ... shapefile for water 38 | # water_repo_url <- "http://awmc.unc.edu/awmc/map_data/shapefiles/physical_data/openwater/roman_open_water/" 39 | # links_water <- scrape_download_links(water_repo_url, "roman_open_water") 40 | # download_repo_files(water_repo_url, links_water, here(data_dir, "water_shp")) 41 | 42 | empire_extent <- st_read(here(data_dir, "roman_empire_ad_69_extent.shp")) %>% 43 | st_make_valid() 44 | 45 | ggplot(empire_extent) + 46 | geom_sf() + 47 | geom_point(data = NULL, 48 | aes(x = 6.83, y = 50.93), col = "red", size = 5) 49 | 50 | 51 | ## Hillshade ------------------------------------------------------------------- 52 | dir_raster <- here("data", "raster_data") 53 | ne_type <- "SR_50M" 54 | if (!file.exists(here(dir_raster, ne_type))) { 55 | ne_download(scale = 50, type = ne_type, category = "raster", 56 | destdir = here(dir_raster, ne_type), load = FALSE) 57 | } 58 | hillshade_raster <- ne_load(scale = 50, category = "raster", type = "", 59 | destdir = dir_raster, file_name = ne_type, returnclass = "sf") 60 | 61 | hillshade_raster_agg <- raster::aggregate(hillshade_raster, fact = 3) 62 | 63 | hillshade <- hillshade_raster_agg %>% 64 | crop(extent(-11, 40, 22, 55)) %>% 65 | as("SpatialPixelsDataFrame") %>% 66 | as.data.frame() %>% 67 | rename(value = ne_type) %>% 68 | mutate(geometry = map2(x, y, ~st_point(c(.x, .y)))) %>% 69 | st_as_sf() 70 | st_crs(hillshade) <- "EPSG:4326" 71 | hillshade_sf <- st_as_sf(hillshade) 72 | 73 | hillshade_empire_sf <- hillshade_sf %>% 74 | st_make_valid() %>% 75 | st_join(empire_extent, left = FALSE) 76 | 77 | 78 | ## Shapefiles for continents in the background --------------------------------- 79 | 80 | europe <- ne_countries(continent = "Europe", returnclass = "sf") 81 | asia_africa <- ne_countries(continent = c("Africa", "Asia"), returnclass = "sf") 82 | 83 | # Labels for provinces with coordinates and font size 84 | provinces <- tibble(province = c("Italia", "Hispania", "Gallia", "Asia", 85 | "Macedonia", "Dalmatia", "Aegyptus"), 86 | coordinates = c( 87 | st_geometry(st_point(c(12.2, 42.1))), 88 | st_geometry(st_point(c(-3.9, 40.0))), 89 | st_geometry(st_point(c(2.3, 46.3))), 90 | st_geometry(st_point(c(29.1, 38))), 91 | st_geometry(st_point(c(21.8, 42.0))), 92 | st_geometry(st_point(c(17.3, 44.4))), 93 | st_geometry(st_point(c(29.4, 29.7))) 94 | ), 95 | angle = c(320, 5, -5, 2, 67, -29, 0), 96 | font_size = c(4, 4, 6, 4, 3, 3, 3)) 97 | 98 | other_countries_color <- lighten(desaturate("#EFE3D5", 0.2), 0.2) 99 | 100 | plot_titles <- list( 101 | title = "IMPERIUM ROMANUM", 102 | subtitle = "The first urban settlement on the grounds of modern-day Cologne was 103 | *Oppidum Ubiorum*, founded in 38 BC by the Ubii, a Cisrhenian Germanic tribe. 104 | In AD 50, the Romans founded *Colonia Claudia Ara Agrippinensium* (Cologne) on 105 | the river Rhine and the city became the provincial capital of Germania Inferior in AD 85. 106 | The map shows the extent of the Roman Empire in AD 69.", 107 | caption = "Source: *Ancient World Mapping Center.* (roman_empire_ad_69_extent.shp), 108 | Subtitle: Wikipedia | Visualization: *Ansgar Wolsing*" 109 | ) 110 | 111 | p <- ggplot(empire_extent) + 112 | geom_sf(data = europe, 113 | col = NA, fill = other_countries_color) + 114 | geom_sf(data = asia_africa, 115 | col = NA, fill = other_countries_color) + 116 | geom_sf(data = hillshade_empire_sf, 117 | aes(col = value, fill = value), size = 0.5, alpha = 0.5, 118 | show.legend = FALSE) + 119 | geom_sf(fill = "#faf3dc", 120 | # linetype = "dashed", 121 | size = 0.05, 122 | alpha = 0.8) + 123 | # geom_sf(col = alpha("darkblue", 0.1), 124 | # fill = NA, size = 1.2, 125 | # show.legend = FALSE) + 126 | geom_sf(col = "grey98", alpha = 0.5, 127 | fill = NA, size = 0.6, 128 | show.legend = FALSE) + 129 | geom_point(data = NULL, 130 | aes(x = 6.83, y = 50.93), col = "black", size = 4) + 131 | geom_text(data = NULL, 132 | aes(x = 7.7, y = 51.2), 133 | label = "CCAA", fontface = "bold", 134 | col = "black", hjust = 0, size = 5, 135 | family = "Cardo") + 136 | geom_sf_text(data = provinces, 137 | aes(geometry = coordinates, 138 | label = str_to_upper(province), 139 | angle = angle, size = font_size), 140 | hjust = 0.5, vjust = -0.5, family = "Libre Baskerville", 141 | col = "grey37" 142 | ) + 143 | scale_size_identity() + # size the province labels according to the font_size column 144 | scale_color_continuous_sequential(palette = "Grays") + 145 | coord_sf(xlim = c(-10, 38), ylim = c(26, 58)) + 146 | labs(title = plot_titles$title, 147 | subtitle = plot_titles$subtitle, 148 | caption = plot_titles$caption) + 149 | cowplot::theme_map(font_family = "Cardo") + 150 | theme(plot.background = element_rect(color = NA, fill = "grey97"), 151 | panel.background = element_rect(color = "grey60", 152 | # fill = lighten("#faf3dc", 0.9) 153 | fill = alpha("steelblue", 0.8) 154 | ), 155 | plot.title = element_text(family = "Forum", face = "plain", size = 28, 156 | hjust = 0.5, margin = margin(t = 4, b = 12)), 157 | plot.subtitle = element_textbox_simple(family = "Cardo", face = "plain", 158 | size = 12, hjust = 0.5, 159 | margin = margin(b = 16)), 160 | plot.caption = element_textbox_simple(size = 9, 161 | margin = margin(t = 8))) 162 | ggsave(here("plots", "day24-historical.png"), dpi = 600, width = 8, height = 8) 163 | 164 | -------------------------------------------------------------------------------- /R/day26-choropleth-unemployment.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "sf") 2 | 3 | 4 | ## GEOMETRY & DATA ============================================================= 5 | #' Source: https://www.offenedaten-koeln.de/dataset/arbeitsmarkt-statistik-koeln 6 | url <- "https://geoportal.stadt-koeln.de/arcgis/rest/services/Statistische_Daten/QMFS_Arbeitsmarkt/MapServer/1/query?where=objectid+is+not+null&text=&objectIds=&time=&geometry=&geometryType=esriGeometryEnvelope&inSR=&spatialRel=esriSpatialRelIntersects&relationParam=&outFields=*&returnGeometry=true&returnTrueCurves=false&maxAllowableOffset=&geometryPrecision=&outSR=4326&returnIdsOnly=false&returnCountOnly=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&returnZ=false&returnM=false&gdbVersion=&returnDistinctValues=false&resultOffset=&resultRecordCount=&f=geojson" 7 | shp_alo <- st_read(url) 8 | shp_alo <- st_transform(shp_alo, "EPSG:25832") 9 | 10 | glimpse(shp_alo) 11 | 12 | 13 | ## PLOT ======================================================================== 14 | p <- 15 | shp_alo %>% 16 | st_drop_geometry() %>% 17 | select(name, am_alo_insg_ap, am_alo_unter25_ap) %>% 18 | pivot_longer(cols = -name, names_to = "group", values_to = "alo_perc") %>% 19 | mutate(group = case_when( 20 | group == "am_alo_insg_ap" ~ "Overall", 21 | group == "am_alo_unter25_ap" ~ "Under 25 years" 22 | )) %>% 23 | inner_join(select(shp_alo, name, geometry), by = "name") %>% 24 | ggplot() + 25 | geom_sf(aes(geometry = geometry, fill = alo_perc), 26 | col = "white", size = 0.2) + 27 | paletteer::scale_fill_paletteer_c("ggthemes::Orange-Blue-White Diverging", 28 | direction = -1) + 29 | # paletteer::scale_fill_paletteer_c("grDevices::PuOr") + 30 | coord_sf() + 31 | guides(fill = guide_colorsteps(title = "Unemployment Rate (%)", 32 | title.position = "top")) + 33 | facet_wrap(vars(group)) + 34 | labs(title = "Unemployment in Cologne", 35 | subtitle = "Unemployment rates in the districts as of December 2020 36 | (grey = no data)", 37 | caption = "Source: **Stadt Köln** | Visualization: **Ansgar Wolsing**") + 38 | cowplot::theme_map(font_family = "Roboto") + 39 | theme( 40 | plot.background = element_rect(color = NA, fill = "grey81"), 41 | panel.background = element_rect(color = NA, fill = "grey88"), 42 | legend.position = "bottom", 43 | legend.justification = "center", 44 | text = element_text(color = "grey10"), 45 | plot.title = element_markdown(family = "Roboto", face = "bold", 46 | size = 24, 47 | margin = margin(t = 4, b = 8)), 48 | plot.subtitle = element_textbox_simple(margin = margin(t = 0, b = 18)), 49 | plot.caption = element_textbox_simple(color = "grey30", 50 | margin = margin(t = 16, b = 2)), 51 | strip.background = element_rect(color = NA, fill = "grey40"), 52 | strip.text = element_text(color = "grey94", face = "bold"), 53 | legend.key.width = unit(12, "mm"), 54 | legend.key.height = unit(4, "mm"), 55 | legend.title = element_text(size = 10), 56 | legend.text = element_text(size = 8) 57 | ) 58 | ggsave(here("plots", "day26-choropleth_alo_facets.png"), plot = p, dpi = 300, 59 | width = 8, height = 7) 60 | -------------------------------------------------------------------------------- /R/day27-heatmap.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "colorspace", "scico", 2 | "sf", "osmdata") 3 | 4 | #' https://unfallatlas.statistikportal.de/ 5 | #' https://unfallatlas.statistikportal.de/_opendata2021.html 6 | #' Licence: https://www.govdata.de/dl-de/by-2-0 7 | #' Download shapefiles manually 8 | 9 | data_dir <- here("data", "unfallatlas") 10 | years <- 2016:2020 11 | filepaths <- here(data_dir, years, glue("Unfallorte{years}_LinRef.shp")) 12 | # 2016 files are named slightly different 13 | filepaths <- gsub("Unfallorte2016_", "Unfaelle_2016_", filepaths) 14 | 15 | accidents <- map(filepaths, st_read) 16 | accidents <- set_names(accidents, years) 17 | accidents <- map(accidents, st_zm) 18 | # transform numeric variables from character to numeric 19 | accidents <- map(accidents, ~mutate(.x, across(starts_with("Ist"), as.numeric), 20 | IstPKWxRad = IstPKW * IstRad 21 | )) 22 | 23 | 24 | ## Shape Cologne 25 | shape_cgn <- getbb("Cologne, Germany", format_out = "sf_polygon") 26 | st_crs(shape_cgn) <- "EPSG:4326" 27 | shape_cgn <- st_transform(shape_cgn, st_crs(accidents[["2020"]])) 28 | 29 | regional_key_cgn <- list("ULAND" = "05", "UREGBEZ" = "3", "UKREIS" = "15") 30 | 31 | 32 | # accidents_2020 <- accidents[["2020"]] 33 | # merge all years to one dataframe 34 | accidents_all_years <- bind_rows(accidents, .id = "year") 35 | 36 | accidents_2020_cgn <- st_intersection(accidents_all_years, shape_cgn) 37 | 38 | accidents_2020_cgn %>% 39 | filter(ULAND == regional_key_cgn$ULAND, 40 | UREGBEZ == regional_key_cgn$UREGBEZ, 41 | UKREIS == regional_key_cgn$UKREIS) %>% 42 | ggplot() + 43 | geom_sf(data = shape_cgn) + 44 | geom_sf(size = 0.1, alpha = 0.3) 45 | 46 | 47 | 48 | ## Create tile grid ------------------------------------------------------------ 49 | 50 | shape <- st_transform(shape_cgn, 3857) 51 | initial <- shape 52 | # initial$index_target <- 1:nrow(initial) 53 | target <- st_geometry(initial) 54 | 55 | # Create a tile grid 56 | grid <- st_make_grid(target, 57 | cellsize = 1 * 1000, 58 | crs = st_crs(initial), 59 | what = "polygons", 60 | square = FALSE 61 | ) 62 | # Add index, transform list to dataframe 63 | grid <- st_sf(index = 1:length(lengths(grid)), grid) 64 | cent_merge <- st_join(st_centroid(grid), initial, left = FALSE) 65 | grid_new <- inner_join(grid, st_drop_geometry(cent_merge)) 66 | 67 | # ensure both geometries share the same CRS 68 | st_crs(grid_new) 69 | st_crs(accidents_2020_cgn) 70 | grid_new <- st_transform(grid_new, st_crs(accidents_2020_cgn)) 71 | # add a constant (will be summed up in the aggregate step) 72 | accidents_2020_cgn$n_accidents = 1 73 | grid_new_accidents <- st_join(grid_new, accidents_2020_cgn, join = st_intersects) 74 | 75 | grid_new_accidents_agg <- aggregate( 76 | select(grid_new_accidents, index, n_accidents, starts_with("Ist")), 77 | by = list(grid_new_accidents$index), 78 | FUN = sum, 79 | na.rm = TRUE, 80 | do_union = FALSE 81 | ) 82 | 83 | 84 | p_overall <- grid_new_accidents_agg %>% 85 | ggplot() + 86 | geom_sf(aes(geometry = geometry, fill = n_accidents), 87 | col = "grey10", size = 0.1) + 88 | paletteer::scale_fill_paletteer_c("ggthemes::Red-Black-White Diverging", 89 | direction = -1, 90 | aesthetics = list("fill", "color")) + 91 | guides(fill = guide_colorsteps(title = "# accidents", title.position = "top")) + 92 | cowplot::theme_map() + 93 | theme( 94 | plot.background = element_rect(color = NA, fill = "white"), 95 | legend.position = "bottom", 96 | legend.direction = "horizontal", 97 | legend.key.width = unit(15, "mm") 98 | 99 | ) 100 | ggsave(here("plots", "day27-heatmap_overall.png"), plot = p_overall, dpi = 300, width = 8, height = 8) 101 | 102 | plot_titles <- list( 103 | title = "Road accidents in Cologne", 104 | subtitle = "Cumulative number of accidents with passenger cars, bicycles, 105 | or both invoved per cell from 2016 to 2020. No indication of liability", 106 | caption = "Data: **Unfallatlas, Statistisches Bundesamt** (dl-de/by-2-0), 107 | shape: **OpenStreetMap** contributors | 108 | Visualization: **Ansgar Wolsing**" 109 | ) 110 | 111 | p <- grid_new_accidents_agg %>% 112 | pivot_longer(cols = starts_with("Ist"), names_to = "involved_type", values_to = "count") %>% 113 | mutate(involved_type = str_remove(involved_type, "Ist")) %>% 114 | filter(involved_type %in% c("Rad", "PKW", "PKWxRad")) %>% 115 | mutate(involved_type_en = case_when( 116 | involved_type == "Rad" ~ "Bicycle", 117 | involved_type == "PKW" ~ "Passenger car", 118 | involved_type == "PKWxRad" ~ "Passenger car & Bicycle" 119 | ), 120 | involved_type_en = factor( 121 | involved_type_en, 122 | levels = c("Passenger car", "Passenger car & Bicycle", "Bicycle"))) %>% 123 | ggplot() + 124 | geom_sf(aes(geometry = geometry, fill = count), 125 | col = NA, size = 0) + 126 | paletteer::scale_fill_paletteer_c( 127 | "ggthemes::Red-Black-White Diverging", 128 | direction =- 1, 129 | aesthetics = list("fill", "color")) + 130 | facet_wrap(vars(involved_type_en)) + 131 | guides(fill = guide_colorsteps(title = "No. of accidents", title.position = "top")) + 132 | labs(title = plot_titles$title, 133 | subtitle = plot_titles$subtitle, 134 | caption = plot_titles$caption) + 135 | cowplot::theme_map(font_family = "Roboto", font_size = 10) + 136 | theme( 137 | plot.background = element_rect(color = NA, fill = "grey90"), 138 | legend.position = "bottom", 139 | legend.justification = "center", 140 | legend.direction = "horizontal", 141 | legend.key.width = unit(15, "mm"), 142 | legend.key.height = unit(3, "mm"), 143 | legend.title = element_text(size = 7), 144 | legend.text = element_text(size = 6), 145 | text = element_text(color = "grey25"), 146 | strip.text = element_text(face = "bold", hjust = 0.5), 147 | strip.background = element_rect(color = NA, fill = "grey70"), 148 | panel.background = element_rect(color = NA, fill = "grey94"), 149 | plot.title = element_markdown(color = "grey2", 150 | margin = margin(t = 4, b = 8)), 151 | plot.subtitle = element_textbox_simple(margin = margin(t = 0, b = 12)), 152 | plot.caption = element_textbox_simple(color = "grey35", size = 6, 153 | margin = margin(t = 12, b = 2)) 154 | ) 155 | ggsave(here("plots", "day27-heatmap.png"), plot = p, 156 | dpi = 300, width = 8, height = 4.5) 157 | 158 | 159 | 160 | ## 3D MAP ====================================================================== 161 | 162 | library(rayshader) 163 | 164 | p_3d <- grid_new_accidents_agg %>% 165 | ggplot() + 166 | geom_sf(aes(geometry = geometry, fill = n_accidents), 167 | col = "grey20", size = 0.25 168 | ) + 169 | paletteer::scale_fill_paletteer_c("ggthemes::Red-Black-White Diverging", 170 | direction = -1, 171 | aesthetics = list("fill", "color")) + 172 | guides(fill = guide_colorsteps(title = "No. of accidents", title.position = "top"), 173 | color = "none") + 174 | cowplot::theme_map(font_family = "Lato", font_size = 8) + 175 | theme( 176 | plot.background = element_rect(color = NA, fill = "white"), 177 | legend.position = "bottom", 178 | legend.justification = "center", 179 | legend.direction = "horizontal", 180 | # legend.key.width = unit(15, "mm") 181 | legend.key.height = unit(2, "mm"), 182 | text = element_text(color = "grey40"), 183 | legend.title = element_text(size = 4), 184 | legend.text = element_text(size = 4) 185 | ) 186 | 187 | # rgl::rgl.close() 188 | rgl::rgl.clear() 189 | plot_gg( 190 | p_3d, preview = FALSE, 191 | scale = 120, zoom = 0.5, 192 | multicore = TRUE, 193 | raytrace = TRUE, 194 | phi = 39, theta = 0, 195 | # params passed to plot_3d() 196 | zcale = 1.05, 197 | solid = FALSE, 198 | soliddepth = 10, 199 | solidcolor = "transparent", 200 | baseshape = "circle", 201 | windowsize = c(1200, 1024) # see https://github.com/tylermorganwall/rayshader/issues/70 202 | ) 203 | 204 | render_snapshot( 205 | here("plots", "day27-heatmap-3d.png"), 206 | title_text = toupper("Road accidents in Cologne (2016-2020)"), 207 | title_font = "Oswald", 208 | title_color = "grey8", 209 | title_position = "northwest", 210 | title_offset = c(40, 40), 211 | title_size = 36 212 | ) 213 | 214 | 215 | 216 | -------------------------------------------------------------------------------- /R/day28-earth-not-flat.R: -------------------------------------------------------------------------------- 1 | pacman::p_load("tidyverse", "here", "glue", "ggtext", "sf", "rnaturalearth") 2 | shape_cgn <- getbb("Cologne, Germany", format_out = "sf_polygon") 3 | st_crs(shape_cgn) <- "EPSG:4326" 4 | st_centroid(shape_cgn) 5 | 6 | world <- ne_countries(returnclass = "sf") 7 | 8 | 9 | p <- ggplot(world) + 10 | geom_sf(fill = "deeppink", col = NA, alpha = 0.75, size = 0.05) + 11 | coord_sf(crs = "+proj=laea +y_0=0 +lon_0=6.974 +lat_0=50.95 +ellps=WGS84 +no_defs") + 12 | labs(title = "THE EARTH IS NOT FLAT", 13 | caption = "Data: **OpenStreetMap** contributors | Visualization: **Ansgar Wolsing**") + 14 | cowplot::theme_map() + 15 | theme(plot.background = element_rect(color = NA, fill = "grey9"), 16 | text = element_text(family = "Montserrat", color = "grey80"), 17 | plot.title = element_markdown(family = "Bangers", face = "plain", 18 | color = "white", size = 36, hjust = 0.5), 19 | plot.caption = element_markdown(size = 7, hjust = 0.5) 20 | ) 21 | ggsave(here("plots", "day28_earth-not-flat.png"), plot = p, dpi = 300, 22 | width = 6, height = 6) 23 | 24 | 25 | 26 | p + geom_point(data = shape_cgn, 27 | aes(x = st_coordinates(st_centroid(geometry))[, "X"], 28 | y = st_coordinates(st_centroid(geometry))[, "Y"]), 29 | size = 1, col = "white") + 30 | ggforce::geom_mark_circle( 31 | data = shape_cgn, 32 | aes(label = "Cologne", 33 | fill = "Cologne", 34 | x = st_coordinates(st_centroid(geometry))[, "X"], 35 | y = st_coordinates(st_centroid(geometry))[, "Y"]), 36 | fill = "white", col = "white", size = 0.2, 37 | expand = unit(3, "mm"), 38 | con.colour = "white", con.cap = unit(1, "mm"), 39 | label.family = "Montserrat", label.fontsize = 8, 40 | label.colour = "grey16", 41 | label.margin = margin(1.5, 1.5, 1.5, 1.5, "mm"), 42 | label.fontface = "bold", label.buffer = unit(1, "mm")) 43 | ggsave(here("plots", "day28_earth-not-flat_with_cologne.png"), dpi = 300, 44 | width = 6, height = 6) 45 | 46 | -------------------------------------------------------------------------------- /Readme.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "#30DayMapChallenge 2021" 3 | output: github_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | knitr::opts_chunk$set(echo = FALSE, 8 | fig.retina = TRUE) 9 | ``` 10 | 11 | ## The Challenge 12 | 13 | Github repo: https://github.com/tjukanovt/30DayMapChallenge 14 | 15 | ![List of the daily challenges in #30DayMapChallenge](https://raw.githubusercontent.com/tjukanovt/30DayMapChallenge/master/images/30dmpc_2021.png) 16 | 17 | ## The Maps 18 | 19 | ### Day 1: Points 20 | 21 | A map of the locations of all kindergardens and day care centers in Cologne, Germany. 22 | 23 | ![A map of the locations of all kindergardens and day care centers in Cologne, Germany](plots/day01_points_01.png) 24 | 25 | ### Day 2: Lines 26 | 27 | The Rhine 28 | 29 | ![A map of the river flow of the Rhine](plots/day02_lines.png) 30 | 31 | ### Day 3: Polygons 32 | 33 | Voronoi tesselation to find the nearest (semi-)professional football team for each point in Cologne 34 | 35 | ![Voronoi shapes](plots/day03_polygons_football_grounds.png) 36 | 37 | 38 | ### Day 4: Hexagons 39 | 40 | Opening times / availabilities of kindergardens in Cologne 41 | 42 | ![A honeycomb tile map showing opening times / availabilities of kindergardens in Cologne](plots/day04_hexagons.png) 43 | 44 | ### Day 5: Data Challenge 1: OpenStreetMap 45 | 46 | Bike lanes in Cologne, Germany, colored by surface type 47 | 48 | ![A map of bike lanes in Cologne, Germany, colored by surface type](plots/day05_osmdata_bike-lanes.png) 49 | 50 | ### Day 6: Red 51 | 52 | A tile grid map of vote shares of the Social Democrats (SPD) in the German Federal Election 2021 in each district in Cologne. 53 | 54 | #### English 55 | 56 | ![A tile grid map of vote shares of the Social Democrats (SPD) in the German Federal Election 2021 in each district in Cologne.](plots/day06_red_vote-share-spd_en.png) 57 | 58 | #### German 59 | 60 | ![A tile grid map of vote shares of the Social Democrats (SPD) in the German Federal Election 2021 in each district in Cologne.](plots/day06_red_vote-share-spd_de.png) 61 | 62 | 63 | ### Day 7: Green 64 | 65 | A tile grid map of vote shares of the Green Party (Bündnis 90 / Die Grünen) in the German Federal Election 2021 in each district in Cologne. 66 | 67 | ![A tile grid map of vote shares of the Green Party in the German Federal Election 2021 in each district in Cologne.](plots/day07_green_vote-share-greens_en.png) 68 | 69 | ### Day 8: Blue 70 | 71 | Average housing space the districts of Cologne 72 | 73 | ![Average housing space the districts of Cologne](plots/day08-blue-area_living_inset.png) 74 | 75 | ### Day 9: Monochrome 76 | 77 | Streets of Cologne 78 | 79 | ![A map showing the streets of Cologne](plots/day09_monochrome-streets.png) 80 | 81 | ### Day 10: Raster 82 | 83 | ![](plots/day10_raster.png) 84 | 85 | 86 | ### Day 11: 3D 87 | 88 | ![](plots/day11-3d-turnout.mp4) 89 | 90 | ![](plots/day11-3d-turnout_optimized.gif) 91 | 92 | ![](plots/day11-3d-turnout_snapshot.png) 93 | 94 | 95 | ### Day 12: Population 96 | 97 | ![](plots/day12-population-animated.gif) 98 | 99 | ### Day 13: Data challenge 2: Natural Earth 100 | 101 | Day 2 (Lines) revisited, but using only Natural Earth data. 102 | 103 | ![](plots/day13_naturalearth.png) 104 | 105 | 106 | ### Day 14: Map using a new tool 107 | 108 | Map created with [Datawrapper](https://www.datawrapper.com). The tile grid, created by @z3tt and me, can be downloaded from https://github.com/z3tt/grid-btw-wahlkreise-constituencies. 109 | 110 | ![](plots/voter-turnout-in-the-german-federal-election-2021.png) 111 | 112 | Interactive map: https://datawrapper.dwcdn.net/oaJLl/6/ 113 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | \#30DayMapChallenge 2021 2 | ================ 3 | 4 | ## The Challenge 5 | 6 | Github repo: 7 | 8 | ![List of the daily challenges in 9 | \#30DayMapChallenge](https://raw.githubusercontent.com/tjukanovt/30DayMapChallenge/master/images/30dmpc_2021.png) 10 | 11 | ## The Maps 12 | 13 | ### Day 1: Points 14 | 15 | A map of the locations of all kindergardens and day care centers in 16 | Cologne, Germany. 17 | 18 | ![A map of the locations of all kindergardens and day care centers in 19 | Cologne, Germany](plots/day01_points_01.png) 20 | 21 | ### Day 2: Lines 22 | 23 | The Rhine 24 | 25 | ![A map of the river flow of the Rhine](plots/day02_lines.png) 26 | 27 | ### Day 3: Polygons 28 | 29 | Voronoi tesselation to find the nearest (semi-)professional football 30 | team for each point in Cologne 31 | 32 | ![Voronoi shapes](plots/day03_polygons_football_grounds.png) 33 | 34 | ### Day 4: Hexagons 35 | 36 | Opening times / availabilities of kindergardens in Cologne 37 | 38 | ![A honeycomb tile map showing opening times / availabilities of 39 | kindergardens in Cologne](plots/day04_hexagons.png) 40 | 41 | ### Day 5: Data Challenge 1: OpenStreetMap 42 | 43 | Bike lanes in Cologne, Germany, colored by surface type 44 | 45 | ![A map of bike lanes in Cologne, Germany, colored by surface 46 | type](plots/day05_osmdata_bike-lanes.png) 47 | 48 | ### Day 6: Red 49 | 50 | A tile grid map of vote shares of the Social Democrats (SPD) in the 51 | German Federal Election 2021 in each district in Cologne. 52 | 53 | #### English 54 | 55 | ![A tile grid map of vote shares of the Social Democrats (SPD) in the 56 | German Federal Election 2021 in each district in 57 | Cologne.](plots/day06_red_vote-share-spd_en.png) 58 | 59 | #### German 60 | 61 | ![A tile grid map of vote shares of the Social Democrats (SPD) in the 62 | German Federal Election 2021 in each district in 63 | Cologne.](plots/day06_red_vote-share-spd_de.png) 64 | 65 | ### Day 7: Green 66 | 67 | A tile grid map of vote shares of the Green Party (Bündnis 90 / Die 68 | Grünen) in the German Federal Election 2021 in each district in Cologne. 69 | 70 | ![A tile grid map of vote shares of the Green Party in the German 71 | Federal Election 2021 in each district in 72 | Cologne.](plots/day07_green_vote-share-greens_en.png) 73 | 74 | ### Day 8: Blue 75 | 76 | Average housing space the districts of Cologne 77 | 78 | ![Average housing space the districts of 79 | Cologne](plots/day08-blue-area_living_inset.png) 80 | 81 | ### Day 9: Monochrome 82 | 83 | Streets of Cologne 84 | 85 | ![A map showing the streets of 86 | Cologne](plots/day09_monochrome-streets.png) 87 | 88 | ### Day 10: Raster 89 | 90 | ![](plots/day10_raster.png) 91 | 92 | ### Day 11: 3D 93 | 94 | ![](plots/day11-3d-turnout.mp4) 95 | 96 | ![](plots/day11-3d-turnout_optimized.gif) 97 | 98 | ![](plots/day11-3d-turnout_snapshot.png) 99 | 100 | ### Day 12: Population 101 | 102 | ![](plots/day12-population-animated.gif) 103 | 104 | ### Day 13: Data challenge 2: Natural Earth 105 | 106 | Day 2 (Lines) revisited, but using only Natural Earth data. 107 | 108 | ![](plots/day13_naturalearth.png) 109 | 110 | ### Day 14: Map using a new tool 111 | 112 | Map created with [Datawrapper](https://www.datawrapper.com). The tile 113 | grid, created by @z3tt and me, can be downloaded from 114 | . 115 | 116 | ![](plots/voter-turnout-in-the-german-federal-election-2021.png) 117 | 118 | Interactive map: 119 | -------------------------------------------------------------------------------- /plots/day01_points_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day01_points_01.png -------------------------------------------------------------------------------- /plots/day02_lines.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day02_lines.png -------------------------------------------------------------------------------- /plots/day03_polygons_football_grounds.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day03_polygons_football_grounds.png -------------------------------------------------------------------------------- /plots/day04_hexagons.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day04_hexagons.png -------------------------------------------------------------------------------- /plots/day05_osmdata_bike-lanes.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day05_osmdata_bike-lanes.png -------------------------------------------------------------------------------- /plots/day06_red_vote-share-spd_de.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day06_red_vote-share-spd_de.png -------------------------------------------------------------------------------- /plots/day06_red_vote-share-spd_en.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day06_red_vote-share-spd_en.png -------------------------------------------------------------------------------- /plots/day07_green_vote-share-greens_de.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day07_green_vote-share-greens_de.png -------------------------------------------------------------------------------- /plots/day07_green_vote-share-greens_en.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day07_green_vote-share-greens_en.png -------------------------------------------------------------------------------- /plots/day08-blue-area_living_inset.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day08-blue-area_living_inset.png -------------------------------------------------------------------------------- /plots/day09_monochrome-streets.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day09_monochrome-streets.png -------------------------------------------------------------------------------- /plots/day09_monochrome_buildings.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day09_monochrome_buildings.png -------------------------------------------------------------------------------- /plots/day09_monochrome_buildings_lres.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day09_monochrome_buildings_lres.png -------------------------------------------------------------------------------- /plots/day11-3d-turnout.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day11-3d-turnout.gif -------------------------------------------------------------------------------- /plots/day11-3d-turnout.mp4: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day11-3d-turnout.mp4 -------------------------------------------------------------------------------- /plots/day11-3d-turnout_optimized.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day11-3d-turnout_optimized.gif -------------------------------------------------------------------------------- /plots/day11-3d-turnout_snapshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day11-3d-turnout_snapshot.png -------------------------------------------------------------------------------- /plots/day12-population-animated.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day12-population-animated.gif -------------------------------------------------------------------------------- /plots/day13_naturalearth.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day13_naturalearth.png -------------------------------------------------------------------------------- /plots/day16-two-cities-of-cologne.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day16-two-cities-of-cologne.png -------------------------------------------------------------------------------- /plots/day16_urban-rural_trees.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day16_urban-rural_trees.png -------------------------------------------------------------------------------- /plots/day17-landuse-en.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day17-landuse-en.png -------------------------------------------------------------------------------- /plots/day17-landuse-en_facets.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day17-landuse-en_facets.png -------------------------------------------------------------------------------- /plots/day17-landuse.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day17-landuse.png -------------------------------------------------------------------------------- /plots/day24-historical.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day24-historical.png -------------------------------------------------------------------------------- /plots/day26-choropleth_alo_facets.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day26-choropleth_alo_facets.png -------------------------------------------------------------------------------- /plots/day27-heatmap-3d.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day27-heatmap-3d.png -------------------------------------------------------------------------------- /plots/day27-heatmap.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day27-heatmap.png -------------------------------------------------------------------------------- /plots/day28_earth-not-flat.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day28_earth-not-flat.png -------------------------------------------------------------------------------- /plots/day28_earth-not-flat_with_cologne.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bydata/30DayMapChallenge-2021/914ed468dabb0ba4d47782d8a334f4f7fe9619fe/plots/day28_earth-not-flat_with_cologne.png --------------------------------------------------------------------------------