From 87b2a3d4e2c7c9d9c5b6adb64d99ffa3c987c3ea Mon Sep 17 00:00:00 2001 From: bydata Date: Fri, 8 Nov 2024 00:19:58 +0100 Subject: [PATCH] Day 08 - HDX (Draft) --- R/08-hdx.R | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 71 insertions(+) create mode 100644 R/08-hdx.R diff --git a/R/08-hdx.R b/R/08-hdx.R new file mode 100644 index 0000000..9f6d49f --- /dev/null +++ b/R/08-hdx.R @@ -0,0 +1,71 @@ +library(tidyverse) +library(terra) +library(sf) +library(ggspatial) +library(ggtext) + +data_path <- file.path("data", "HDX") + +#' Manually download the raster data from +#' https://data.humdata.org/dataset/germany-high-resolution-population-density-maps-demographic-estimates + +raster_paths <- file.path( + data_path, c("population_deu_2019-07-01.tif", "DEU_elderly_60_plus.tif", + "DEU_children_under_five.tif")) +rasters <- map(raster_paths, rast) + + +raster_combined <- rasters[[2]] / rasters[[1]] +plot(raster_combined) + +# Remove NAs +na_mask <- !is.na(raster_combined) +raster_no_na <- mask(raster_combined, na_mask) +plot(raster_no_na) +nlyr(raster_no_na) +ncell(raster_no_na) +res(rasters[[1]]) + +raster_crs <- crs(raster_downsampled_pop_full) + +# Downsample the rasters +downsample_factor <- 20 +raster_downsampled_pop_full <- + terra::aggregate(rasters[[1]], fact = downsample_factor, fun = sum, na.rm = TRUE) +raster_downsampled_pop_60_plus <- + terra::aggregate(rasters[[2]], fact = downsample_factor, fun = sum, na.rm = TRUE) +ncell(raster_downsampled_pop_full) / ncell(raster_no_na) + +# ## +# downsample_factor <- 50 +# current_res <- res(rasters[[1]]) +# new_res <- current_res * downsample_factor +# names(new_res) <- c("x", "y") +# new_raster <- rast(ext(rasters[[1]]), +# resolution = new_res, +# crs = raster_crs) +# raster_resampled <- resample(rasters[[1]], new_raster, method = "sum") +# ncell(raster_resampled) + +# Combine by division +raster_downsampled_combined <- raster_downsampled_pop_60_plus / raster_downsampled_pop_full + +# Transform to a data.frame for ggplot +raster_downsampled_combined_df <- as.data.frame( + raster_downsampled_combined, xy = TRUE #, na.rm = FALSE + ) |> + rename(population = `Population Count`) |> + mutate(population = replace_na(population, 0)) + + +p <- raster_downsampled_combined_df |> + ggplot() + + geom_contour_filled( + aes(x, y, z = population)) + + coord_sf(crs = raster_crs) + + theme_void() + + theme( + plot.background = element_rect(color = "#121212", fill = "#121212"), + text = element_text(color = "#FCFCFC") + ) +ggsave(file.path("plots", "08-hdx.png"), width = 6, height = 5)