From fc43fd98c33ea4a0c83bd07d8d778822fecc4970 Mon Sep 17 00:00:00 2001
From: Kaysa Vaarre-Lamoureux <kvaarre-lamoureux@usgs.gov>
Date: Thu, 3 Oct 2024 12:55:38 -0400
Subject: [PATCH] add impervious surfaces map
---
1_fetch.R | 17 +++++++-
2_process.R | 15 +++++--
2_process/src/data_utils.R | 20 ++++++++-
3_visualize.R | 10 +++++
3_visualize/src/plot_utils.R | 85 +++++++++++++++++++++++++++++++++++-
5 files changed, 140 insertions(+), 7 deletions(-)
diff --git a/1_fetch.R b/1_fetch.R
index d880fe8..b3d99a9 100644
--- a/1_fetch.R
+++ b/1_fetch.R
@@ -40,8 +40,23 @@ p1_targets <- list(
filter(group %in% c('CONUS')) |>
rmapshaper::ms_simplify(keep = 0.2) |>
filter(NAME %in% p1_census_states)),
+ tar_target(p1_out_data,
+ "1_fetch/out"),
# raster data for population density
tar_target(p1_pop_density_raster,
- '1_fetch/in/gpw-v4-population-count-rev11_2020_30_sec_tif/gpw_v4_population_count_rev11_2020_30_sec.tif')
+ '1_fetch/in/gpw-v4-population-count-rev11_2020_30_sec_tif/gpw_v4_population_count_rev11_2020_30_sec.tif'),
+ # raster data for impervious surfaces
+ tar_target(p1_imp_surf_rast,
+ download_from_sb(sb_id = "664e0da6d34e702fe8744579",
+ filename = 'Annual_NLCD_FctImp_2022_CU_C1V0.zip',
+ dest_dir = p1_out_data),
+ format = 'file'),
+ tar_target(p1_imp_surf_zip,
+ '1_fetch/out/Annual_NLCD_FctImp_2022_CU_C1V0.zip'),
+ tar_target(p1_imp_surf_tif,
+ unzip(p1_imp_surf_zip, 'Annual_NLCD_FctImp_2022_CU_C1V0.tif',
+ exdir = p1_out_data)),
+ tar_target(p1_imp_surf_tif,
+ "1_fetch/out/Annual_NLCD_FctImp_2022_CU_C1V0/Annual_NLCD_FctImp_2022_CU_C1V0.tif")
)
\ No newline at end of file
diff --git a/2_process.R b/2_process.R
index 0f438ad..c9588d4 100644
--- a/2_process.R
+++ b/2_process.R
@@ -252,9 +252,16 @@ tar_target(p2_conus_sf_proj,
tar_target(p2_conus_inner,
rmapshaper::ms_innerlines(p2_conus_sf_proj)),
tar_target(p2_pop_density_processed,
- process_raster(in_raster = p1_pop_density_raster, proj = p1_proj,
- conus = p2_conus_sf, conus_proj = p2_conus_sf_proj,
- outfile_path = "2_process/out/pop_density.tif")),
+ process_pop_dens_raster(in_raster = p1_pop_density_raster, #proj = p1_proj,
+ conus = p2_conus_sf, conus_proj = p2_conus_sf_proj,
+ outfile_path = "2_process/out/pop_density.tif")),
tar_target(p2_pop_density_filepath,
- "2_process/out/pop_density.tif")
+ "2_process/out/pop_density.tif"),
+# process impervious surfaces raster data
+tar_target(p2_imp_surf_processed,
+ process_imp_surf(in_raster = p1_imp_surf_tif, conus_proj = p2_conus_sf_proj,
+ outfile_path = "2_process/out/imp_surfaces.tif")),
+tar_target(p2_imp_surfaces_filepath,
+ "2_process/out/imp_surfaces.tif")
+
)
\ No newline at end of file
diff --git a/2_process/src/data_utils.R b/2_process/src/data_utils.R
index 18bfc86..c7ab01e 100644
--- a/2_process/src/data_utils.R
+++ b/2_process/src/data_utils.R
@@ -65,7 +65,7 @@ fetch_conus_sf <- function(){
#' @title Process raster data for ploting
#' @param
-process_raster <- function(in_raster, proj, conus, conus_proj, outfile_path){
+process_pop_dens_raster <- function(in_raster, conus, conus_proj, outfile_path){
# in_raster = p1_pop_density_raster, proj = p1_proj, conus = p2_conus_sf, conus_proj = p2_conus_sf_proj
raw_data <- rast(in_raster)
@@ -91,3 +91,21 @@ process_raster <- function(in_raster, proj, conus, conus_proj, outfile_path){
writeRaster(usa_dat_rast, filename=outfile_path, overwrite=TRUE)
}
+
+process_imp_surf <- function(in_raster, conus_proj, outfile_path){
+ # in_raster = p1_imp_surf_tip, conus_proj = p2_conus_sf_proj
+
+ imp_surf_raw <- rast(in_raster)
+
+ # crop population data to area of interest
+ terra::window(imp_surf_raw) <- terra::ext(conus_proj)
+
+ # project population data
+ conus_sf_rast <- rast(conus_proj, resolution = c(1000, 1000))
+ imp_surf_proj <- project(imp_surf_raw, conus_sf_rast)
+
+ # match boundaries of population data to conus data
+ imp_surf_mask <- terra::mask(imp_surf_proj, terra::vect(conus_proj))
+
+ writeRaster(imp_surf_mask, filename=outfile_path, overwrite=TRUE)
+}
\ No newline at end of file
diff --git a/3_visualize.R b/3_visualize.R
index 1bf1be2..15bc6da 100644
--- a/3_visualize.R
+++ b/3_visualize.R
@@ -124,6 +124,16 @@ tar_target(
font_size = p0_viz_config_df$font_size_desktop, barwidth = 20, barheight = 1,
outfile_path = "3_visualize/out/pop_density_rast_2020_en.png", low_ramp_col = "#E8F4F4"),
format = "file"),
+# impervious surfaces raster plot
+tar_target(
+ p3_imp_surf_plot,
+ plot_imp_surf_raster(in_raster = p2_imp_surfaces_filepath, conus_sf = p2_conus_sf_proj, viz_config_df = p0_viz_config_df,
+ conus_col = "gray90", conus_inner = p2_conus_inner, viz_config_pal = p0_viz_config_pal$living_conditions,
+ width = p0_viz_config_df$width_desktop, height = p0_viz_config_df$height_desktop,
+ font_size = p0_viz_config_df$font_size_desktop, barwidth = 20, barheight = 1,
+ outfile_path = "3_visualize/out/imp_surface_rast_2022_en.png",
+ low_ramp_col = "white" )
+),
# Spanish version's of maps -----------------------------------------------
tar_target(
p3_med_income_png_es,
diff --git a/3_visualize/src/plot_utils.R b/3_visualize/src/plot_utils.R
index 5b6634c..66d21c1 100644
--- a/3_visualize/src/plot_utils.R
+++ b/3_visualize/src/plot_utils.R
@@ -212,4 +212,87 @@ plot_raster <- function(in_raster, conus_sf, conus_inner, outfile_path,
ggsave(outfile_path, final_map, width = width, height = height, dpi = viz_config_df$dpi, bg = viz_config_df$bg_col, units = "in")
}
-
\ No newline at end of file
+
+
+plot_imp_surf_raster <- function(in_raster, conus_sf, conus_inner, conus_col, outfile_path,
+ viz_config_df, viz_config_pal, width, height,
+ font_size, barwidth, barheight,
+ low_ramp_col){
+ # in_raster = p2_imp_surf_processed, conus_sf = p2_conus_sf_proj, conus_col = "gray90", viz_config_pal = p0_viz_config_pal$living_conditions
+ # width = p0_viz_config_df$width_desktop, height = p0_viz_config_df$height_desktop, font_size = p0_viz_config_df$font_size_desktop, barwidth = 20, barheight = 1,
+ #outfile_path = "3_visualize/out/imp_surface_rast_2020_en.png", low_ramp_col = "white"
+ raster_data <- rast(in_raster)
+
+ # plot
+ font_legend <- viz_config_df$load_font
+ font_add_google(font_legend)
+ showtext_opts(dpi = 300, regular.wt = 200, bold.wt = 700)
+ showtext_auto(enable = TRUE)
+
+ (pop_map <- ggplot() +
+ geom_sf(data = conus_sf, fill = NA, color = conus_col, linewidth = 0.9) +
+ geom_spatraster(data = raster_data)+ #x = x, y = y,
+ geom_sf(data = conus_inner, fill = NA, color = conus_col, linewidth = 0.5) +
+ scale_fill_gradientn(
+ colors = colorRampPalette(c(low_ramp_col, viz_config_pal))(100),
+ name = "% Impervious Surface, 2022",
+ limits = c(0, 100),
+ breaks = c(0, 25, 50, 75, 100),
+ labels = c("0%", "25%", "50%", "75%", "100%"),
+ na.value=NA
+ )+
+ labs(fill = "% Impervious Surface, 2022") +
+ theme(plot.background = element_rect(fill = "white", color = "white"),
+ panel.background = element_rect(fill = "white", color = "white"),
+ axis.title = element_blank(),
+ axis.text = element_blank(),
+ axis.ticks = element_blank(),
+ panel.grid = element_blank(),
+ legend.background = element_blank(),
+ legend.direction = "horizontal",
+ legend.position = "bottom",
+ legend.title.align = 0.5) +
+ guides(fill = guide_colorbar(
+ title.position = "top",
+ title.theme = element_text(face = 'bold', family = font_legend, size = font_size),
+ direction = "horizontal",
+ position = "bottom",
+ barwidth = barwidth,
+ barheight = barheight
+ ))
+ )
+
+ background_color = "white"
+ plot_margin = 0.025
+
+ # cowplot to get map sizes larger
+ canvas <- grid::rectGrob(
+ x = 0, y = 0,
+ width = 6, height = 6,
+ gp = grid::gpar(fill = background_color, alpha = 1, col = background_color
+ )
+ )
+ pop_map_legend <- get_plot_component(pop_map, 'guide-box', return_all = TRUE)
+ # compose final plot
+ final_map <- ggdraw(ylim = c(0,1),
+ xlim = c(0,1)) +
+ # White background
+ draw_grob(canvas,
+ x = 0, y = 1,
+ height = 6, width = 6,
+ hjust = 0, vjust = 1) +
+ # Add main plot
+ draw_plot(pop_map + theme(legend.position="none"),
+ x = -0.01,
+ y = 0.08,
+ height = 0.98,
+ width = (1-plot_margin)*1.03) +
+ # Add legend
+ draw_plot(pop_map_legend[[3]],
+ x = 0.48,
+ y = 0.02,
+ height = 0.09 ,
+ width = 0.1 - plot_margin)
+
+ ggsave(outfile_path, final_map, width = width, height = height, dpi = viz_config_df$dpi, bg = viz_config_df$bg_col, units = "in")
+}
\ No newline at end of file
--
GitLab