diff --git a/R/08-hdx.R b/R/08-hdx.R index 9f6d49f..431e4d8 100644 --- a/R/08-hdx.R +++ b/R/08-hdx.R @@ -11,61 +11,73 @@ data_path <- file.path("data", "HDX") raster_paths <- file.path( data_path, c("population_deu_2019-07-01.tif", "DEU_elderly_60_plus.tif", - "DEU_children_under_five.tif")) + "DEU_children_under_five.tif", "DEU_youth_15_24.tif")) rasters <- map(raster_paths, rast) +raster_crs <- crs(rasters[[1]]) -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) +downsample_raster <- function(raster, factor = 25) { + terra::aggregate(raster, fact = factor, fun = sum, na.rm = TRUE) +} +raster_downsampled_pop_full <- downsample_raster(rasters[[1]]) +raster_downsampled_pop_group <- downsample_raster(rasters[[4]]) # Combine by division -raster_downsampled_combined <- raster_downsampled_pop_60_plus / raster_downsampled_pop_full +raster_downsampled_combined <- raster_downsampled_pop_group / 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 + raster_downsampled_combined, xy = TRUE ) |> rename(population = `Population Count`) |> mutate(population = replace_na(population, 0)) - +contour_breaks <- seq( + floor(min(raster_downsampled_combined_df$population) * 100) / 100, + ceiling(max(raster_downsampled_combined_df$population) * 100) / 100, 0.02) +contour_labels <- sprintf( + "%s-%s %%", + contour_breaks * 100, + c(contour_breaks[2:length(contour_breaks)] * 100, "")) +contour_labels[2:length(contour_breaks)] <- paste0( + ">", contour_labels[2:length(contour_breaks)]) + p <- raster_downsampled_combined_df |> ggplot() + geom_contour_filled( - aes(x, y, z = population)) + + aes(x, y, z = population), + breaks = contour_breaks) + + # scale_fill_viridis_d(labels = contour_labels) + + scale_fill_brewer(labels = contour_labels, direction = -1) + coord_sf(crs = raster_crs) + - theme_void() + + guides(fill = guide_legend( + title.position = "top", + override.aes = list(color = "white", linewidth = 0.2))) + + labs( + title = "Where's the Youth?", + subtitle = "Share of people aged 15 to 24 among the population
on a + high-resolution grid", + caption = "Source: Data for Good at Meta via The Humanitarian Data Exchange. + Visualization: Ansgar Wolsing", + fill = "Share of population aged 15-24 (%)
+ Lighter shades indicate areas with a higher share + of young people" + ) + + theme_void(base_family = "Fira Sans") + theme( - plot.background = element_rect(color = "#121212", fill = "#121212"), - text = element_text(color = "#FCFCFC") + plot.background = element_rect(color = "transparent", fill = "#121212"), + text = element_text(color = "#FCFCFC"), + legend.position = "bottom", + # legend.position.inside = c(1.15, 0.25), + legend.key.width = unit(3.5, "mm"), + legend.key.height = unit(3.5, "mm"), + legend.title = element_markdown(size = 7, lineheight = 1.1), + legend.text = element_text(size = 6), + plot.margin = margin(rep(4, 4)), + plot.title = element_text(hjust = 0.5, family = "Fira Sans SemiBold", size = 18), + plot.subtitle = element_markdown(hjust = 0.5, size = 9, lineheight = 1.1), + plot.caption = element_markdown( + hjust = 0.5, size = 6, margin = margin(t = 10, b = 2)) ) -ggsave(file.path("plots", "08-hdx.png"), width = 6, height = 5) +ggsave(file.path("plots", "08-hdx.png"), width = 5, height = 5) diff --git a/plots/08-hdx.png b/plots/08-hdx.png new file mode 100644 index 0000000..e6d655f Binary files /dev/null and b/plots/08-hdx.png differ