From 7bd719f492eae206b9eb5f834fc9bf0c5d016384 Mon Sep 17 00:00:00 2001
From: Kaysa Vaarre-Lamoureux <kvaarre-lamoureux@usgs.gov>
Date: Wed, 12 Feb 2025 17:20:00 -0500
Subject: [PATCH] add function documentation and clean up code
---
findex/_targets.R | 269 ++++++++++++++++++----------------------
findex/src/data_utils.R | 32 +++--
findex/src/plot_utils.R | 69 ++++++++---
3 files changed, 199 insertions(+), 171 deletions(-)
diff --git a/findex/_targets.R b/findex/_targets.R
index 952b5aa..efed7ea 100644
--- a/findex/_targets.R
+++ b/findex/_targets.R
@@ -65,6 +65,9 @@ p2 <- list(
hybas_legend = p2_hybas_legend
)
),
+
+ #### processing for threat maps ####
+
tar_target(
p2_weighted_threats,
compute_weighted_threats(
@@ -81,7 +84,6 @@ p2 <- list(
),
format = "file"
),
- #### processing for threat maps ####
tar_target(
p2_mean_weighted_threats,
compute_mean_weighted_threats(
@@ -95,7 +97,7 @@ p2 <- list(
)
),
- ## set up threat and sub-category threat lists for visualization dynamic branching
+ #### threat lists for branching ####
tar_target(
p2_threat_categories,
@@ -109,155 +111,132 @@ p2 <- list(
pull(ThreatCategory) |>
unique()
),
+
+ #### color ramps and file name templates ####
+
tar_target(
- p2_habitat_subthreats,
- p2_mean_weighted_subThreats |>
- filter(MajorCat == "Habitat") |>
- pull(ThreatCategory) |>
- unique()
- ),
- tar_target(
- p2_pollution_subthreats,
- p2_mean_weighted_subThreats |>
- filter(MajorCat == "Pollution") |>
- pull(ThreatCategory) |>
- unique()
- ),
- tar_target(
- p2_climate_subthreats,
- p2_mean_weighted_subThreats |>
- filter(MajorCat == "Climate and weather") |>
- pull(ThreatCategory) |>
- unique()
- ),
- tar_target(p2_viz_config,
- {
- p2_mean_weighted_subThreats |>
- select(MajorCat, ThreatCategory) |>
- mutate(
- # map color ramp
- pal = case_when(
- MajorCat == "Habitat" ~ list(c("#7A562B", "#C7985F", "#E1C8AA")),
- MajorCat == "Exploitation" ~ list(c("#B74F49", "#E2B8B6")),
- MajorCat == "Invasive species" ~ list(c("#4E6D6E", "#C9D8D9")),
- MajorCat == "Pollution" ~ list(c("#002D5E", "#B2C0CE")),
- MajorCat == "Climate and weather" ~ list(c("#835192", "#DDCCE2"))
- ),
- # legend and map file name template strings
- threat_legend_raw = "out/%s_legend_raw.png",
- threat_legend = "../src/assets/images/%s_legend.png",
- threat_map = "../src/assets/images/%s_map.png",
- subThreat_legend_raw = case_when(
- MajorCat %in% "Habitat" ~ "out/H_%s_legend_raw.png",
- MajorCat %in% "Exploitation" ~ "out/E_%s_legend_raw.png",
- MajorCat %in% "Invasive species" ~ "out/IS_%s_legend_raw.png",
- MajorCat %in% "Pollution" ~ "out/P_%s_legend_raw.png",
- MajorCat %in% "Climate and weather" ~ "out/CW_%s_legend_raw.png"
- ),
- subThreat_legend = case_when(
- MajorCat %in% "Habitat" ~ "../src/assets/images/H_%s_legend.png",
- MajorCat %in% "Exploitation" ~ "../src/assets/images/E_%s_legend.png",
- MajorCat %in% "Invasive species" ~ "../src/assets/images/IS_%s_legend.png",
- MajorCat %in% "Pollution" ~ "../src/assets/images/P_%s_legend.png",
- MajorCat %in% "Climate and weather" ~ "../src/assets/images/CW_%s_legend.png"
- ),
- subThreat_map = case_when(
- MajorCat %in% "Habitat" ~ "../src/assets/images/H_%s_map.png",
- MajorCat %in% "Exploitation" ~ "../src/assets/images/E_%s_map.png",
- MajorCat %in% "Invasive species" ~ "../src/assets/images/IS_%s_map.png",
- MajorCat %in% "Pollution" ~ "../src/assets/images/P_%s_map.png",
- MajorCat %in% "Climate and weather" ~ "../src/assets/images/CW_%s_map.png"
- )
- )
- }
+ p2_viz_config,
+ {
+ p2_mean_weighted_subThreats |>
+ select(MajorCat, ThreatCategory) |>
+ mutate(
+ # color ramps
+ pal = case_when(
+ MajorCat == "Habitat" ~ list(c("#7A562B", "#C7985F", "#E1C8AA")),
+ MajorCat == "Exploitation" ~ list(c("#B74F49", "#E2B8B6")),
+ MajorCat == "Invasive species" ~ list(c("#4E6D6E", "#C9D8D9")),
+ MajorCat == "Pollution" ~ list(c("#002D5E", "#B2C0CE")),
+ MajorCat == "Climate and weather" ~ list(c("#835192", "#DDCCE2"))
+ ),
+ # file name templates
+ threat_legend_raw = "out/%s_legend_raw.png",
+ threat_legend = "../src/assets/images/%s_legend.png",
+ threat_map = "../src/assets/images/%s_map.png",
+ subThreat_legend_raw = case_when(
+ MajorCat %in% "Habitat" ~ "out/H_%s_legend_raw.png",
+ MajorCat %in% "Exploitation" ~ "out/E_%s_legend_raw.png",
+ MajorCat %in% "Invasive species" ~ "out/IS_%s_legend_raw.png",
+ MajorCat %in% "Pollution" ~ "out/P_%s_legend_raw.png",
+ MajorCat %in% "Climate and weather" ~ "out/CW_%s_legend_raw.png"
+ ),
+ subThreat_legend = case_when(
+ MajorCat %in% "Habitat" ~ "../src/assets/images/H_%s_legend.png",
+ MajorCat %in% "Exploitation" ~ "../src/assets/images/E_%s_legend.png",
+ MajorCat %in% "Invasive species" ~ "../src/assets/images/IS_%s_legend.png",
+ MajorCat %in% "Pollution" ~ "../src/assets/images/P_%s_legend.png",
+ MajorCat %in% "Climate and weather" ~ "../src/assets/images/CW_%s_legend.png"
+ ),
+ subThreat_map = case_when(
+ MajorCat %in% "Habitat" ~ "../src/assets/images/H_%s_map.png",
+ MajorCat %in% "Exploitation" ~ "../src/assets/images/E_%s_map.png",
+ MajorCat %in% "Invasive species" ~ "../src/assets/images/IS_%s_map.png",
+ MajorCat %in% "Pollution" ~ "../src/assets/images/P_%s_map.png",
+ MajorCat %in% "Climate and weather" ~ "../src/assets/images/CW_%s_map.png"
+ )
+ )
+ }
)
)
p3 <- list(
- tar_target(
- p3_threat_map_png,
- {
- final_plot <- threat_map(in_dat = p2_mean_weighted_threats,
- threat_category = p2_threat_categories,
- threat_pal = p2_viz_config,
- hybas_habitat_types = p2_hybas_habitat_types_sf,
- proj = p1_proj) +
- theme(legend.position = "none")
-
- save_map(type = "threat", plot = final_plot,
- threat_category = p2_threat_categories,
- subcat_habitat = NA,
- subcat_pollution = NA,
- subcat_climate = NA,
- config_df = p2_viz_config,
- height = 6, width = 10, dpi = 300)
- },
- format = "file",
- pattern = p2_threat_categories
- ),
- tar_target(
- p3_legend_png,
- {
- final_plot <- threat_map(in_dat = p2_mean_weighted_threats,
- threat_category = p2_threat_categories,
- threat_pal = p2_viz_config,
- proj = p1_proj,
- hybas_habitat_types = p2_hybas_habitat_types_sf)
-
- save_legend(type = "threat", plot = final_plot,
- threat_category = p2_threat_categories,
- subcat_habitat = NA,
- subcat_pollution = NA,
- subcat_climate = NA,
- in_dat = p2_mean_weighted_threats,
- config_df = p2_viz_config,
- height = 176, width = 429, unit = "px", dpi = 300)
- },
- pattern = p2_threat_categories
- ),
- tar_target(
- p3_sub_threat_map_png,
- {
- final_plot <- subThreat_map(in_dat = p2_mean_weighted_subThreats,
- threat_category = p2_threat_subcategories,
- threat_pal = p2_viz_config,
- proj = p1_proj,
- hybas_habitat_types = p2_hybas_habitat_types_sf) +
- theme(legend.position = "none")
-
- save_map(type = "subThreat", plot = final_plot,
- threat_category = p2_threat_subcategories,
- subcat_habitat = p2_habitat_subthreats,
- subcat_pollution = p2_pollution_subthreats,
- subcat_climate = p2_climate_subthreats,
- config_df = p2_viz_config,
- height = 6, width = 10, dpi = 300)
- },
- format = "file",
- pattern = p2_threat_subcategories
- ),
- tar_target(
- p3_sub_threat_legend_png,
- {
- final_plot <- subThreat_map(in_dat = p2_mean_weighted_subThreats,
- threat_category = p2_threat_subcategories,
- threat_pal = p2_viz_config,
- proj = p1_proj,
- hybas_habitat_types = p2_hybas_habitat_types_sf)
-
- save_legend(type = "subThreat", plot = final_plot,
- threat_category = p2_threat_subcategories,
- subcat_habitat = p2_habitat_subthreats,
- subcat_pollution = p2_pollution_subthreats,
- subcat_climate = p2_climate_subthreats,
- in_dat = p2_mean_weighted_subThreats,
- config_df = p2_viz_config,
- height = 176, width = 429, unit = "px", dpi = 300)
- },
- format = "file",
- pattern = p2_threat_subcategories
- )
+
+ #### major threat maps and legends ####
+
+ tar_target(
+ p3_threat_map_png,
+ {
+ final_plot <- threat_map(in_dat = p2_mean_weighted_threats,
+ threat_category = p2_threat_categories,
+ threat_pal = p2_viz_config,
+ hybas_habitat_types = p2_hybas_habitat_types_sf,
+ proj = p1_proj) +
+ theme(legend.position = "none")
+
+ save_map(type = "threat", plot = final_plot,
+ threat_category = p2_threat_categories,
+ threat_pal = p2_viz_config,
+ height = 6, width = 10, dpi = 300)
+ },
+ format = "file",
+ pattern = p2_threat_categories
+ ),
+ tar_target(
+ p3_legend_png,
+ {
+ final_plot <- threat_map(in_dat = p2_mean_weighted_threats,
+ threat_category = p2_threat_categories,
+ threat_pal = p2_viz_config,
+ proj = p1_proj,
+ hybas_habitat_types = p2_hybas_habitat_types_sf)
+
+ save_legend(type = "threat", plot = final_plot,
+ threat_category = p2_threat_categories,
+ in_dat = p2_mean_weighted_threats,
+ threat_pal = p2_viz_config,
+ height = 176, width = 429, unit = "px", dpi = 300)
+ },
+ pattern = p2_threat_categories
+ ),
+
+ #### sub-category treat maps and legends ####
+
+ tar_target(
+ p3_sub_threat_map_png,
+ {
+ final_plot <- subThreat_map(in_dat = p2_mean_weighted_subThreats,
+ threat_category = p2_threat_subcategories,
+ threat_pal = p2_viz_config,
+ proj = p1_proj,
+ hybas_habitat_types = p2_hybas_habitat_types_sf) +
+ theme(legend.position = "none")
+
+ save_map(type = "subThreat", plot = final_plot,
+ threat_category = p2_threat_subcategories,
+ threat_pal = p2_viz_config,
+ height = 6, width = 10, dpi = 300)
+ },
+ format = "file",
+ pattern = p2_threat_subcategories
+ ),
+ tar_target(
+ p3_sub_threat_legend_png,
+ {
+ final_plot <- subThreat_map(in_dat = p2_mean_weighted_subThreats,
+ threat_category = p2_threat_subcategories,
+ threat_pal = p2_viz_config,
+ proj = p1_proj,
+ hybas_habitat_types = p2_hybas_habitat_types_sf)
+
+ save_legend(type = "subThreat", plot = final_plot,
+ threat_category = p2_threat_subcategories,
+ in_dat = p2_mean_weighted_subThreats,
+ threat_pal = p2_viz_config,
+ height = 176, width = 429, unit = "px", dpi = 300)
+ },
+ format = "file",
+ pattern = p2_threat_subcategories
)
+)
c(p1, p2, p3)
diff --git a/findex/src/data_utils.R b/findex/src/data_utils.R
index 170d7b0..2f7e33c 100644
--- a/findex/src/data_utils.R
+++ b/findex/src/data_utils.R
@@ -1,3 +1,7 @@
+
+#' @description create shape file with HYBAS IDs and their habitat types
+#' @param hybas_04_sf shape file of HYBAS IDs
+#' @param hybas_legend dataframe with deifning habitat types
get_hybas_habitat_types <- function (hybas_04_sf, hybas_legend) {
hybas_04_sf |>
select(HYBAS_ID,fmh_cl_smj) |>
@@ -5,7 +9,10 @@ get_hybas_habitat_types <- function (hybas_04_sf, hybas_legend) {
select(HYBAS_ID, Habitat = MHT_Name)
}
-# compute weighted threats
+#' @description calculate weighted threat scores
+#' @param threat_data dataframe with threat scores
+#' @param threat_weights dataframe with weights for each threat type
+#' @param hybas_habitat_types shape file with HYBAS IDs and their habitat types
compute_weighted_threats <- function(threat_data, threat_weights,
hybas_habitat_types){
processed_df <- threat_data |>
@@ -22,10 +29,12 @@ compute_weighted_threats <- function(threat_data, threat_weights,
mutate(weightedThreatMetric = ThreatMetric * Final_Weight)
}
-# total threats
+#' @description sum weighted threat scores by threat type
+#' @param in_dat dataframe with weighted threat scores
+#' @param outfile file name and directory for output
compute_total_weighted_threats <- function(in_dat, outfile) {
in_dat |>
- group_by(Threat, ThreatCategory) |> #
+ group_by(Threat, ThreatCategory) |>
summarize(TotalWeightedThreatMetric = sum(weightedThreatMetric, na.rm = TRUE)) |>
select(ThreatCategory, Threat, TotalWeightedThreatMetric) |>
arrange(desc(TotalWeightedThreatMetric)) |>
@@ -34,29 +43,28 @@ compute_total_weighted_threats <- function(in_dat, outfile) {
return(outfile)
}
-# mean threats
+#' @description mean weighted threat scores by major threat type and HYBAS_ID
+#' @param in_dat dataframe with weighted threat scores
compute_mean_weighted_threats <- function(in_dat){
- processed_df <- in_dat |> #
+ processed_df <- in_dat |>
group_by(HYBAS_ID, ThreatCategory) |>
mutate(MeanWeightedThreatMetric = mean(weightedThreatMetric, na.rm = TRUE)) |>
ungroup() |>
- select(HYBAS_ID, ThreatCategory, MeanWeightedThreatMetric) |> #, Shape
+ select(HYBAS_ID, ThreatCategory, MeanWeightedThreatMetric) |>
unique() |>
- arrange(desc(MeanWeightedThreatMetric)) #|>
- #readr::write_csv(outfile)
-
- #return(outfile)
+ arrange(desc(MeanWeightedThreatMetric))
}
-# mean sub threats
+#' @description mean weighted threat scores by sub threat type and HYBAS_ID
+#' @param in_dat dataframe with weighted threat scores
compute_mean_weighted_subThreats <- function(in_dat){
processed_df <- in_dat |>
group_by(HYBAS_ID, ThreatCategory, Threat) |>
mutate(MeanWeightedThreatMetric = mean(weightedThreatMetric, na.rm = TRUE)) |>
ungroup() |>
- select(HYBAS_ID, ThreatCategory, Threat, MeanWeightedThreatMetric) |> #, Shape
+ select(HYBAS_ID, ThreatCategory, Threat, MeanWeightedThreatMetric) |>
rename(MajorCat = ThreatCategory, ThreatCategory = Threat) |>
unique() |>
arrange(desc(MeanWeightedThreatMetric))
diff --git a/findex/src/plot_utils.R b/findex/src/plot_utils.R
index d4af10c..1918f8d 100644
--- a/findex/src/plot_utils.R
+++ b/findex/src/plot_utils.R
@@ -1,3 +1,10 @@
+
+#' @description establish ggplot code to create threat maps
+#' @param in_dat dataframe with mean weighted threat scores by threat type and HYBAS_ID
+#' @param threat_category list of target threat categories
+#' @param threat_pal dataframe with color palettes and file name templates by threat type
+#' @param hybas_habitat_types shape file with HYBAS IDs and their habitat types
+#' @param proj character string with map projection definition
general_threat_map <- function(in_dat, threat_category, threat_pal, hybas_habitat_types, proj){
filtered_df <- in_dat |>
left_join(hybas_habitat_types) |>
@@ -15,7 +22,6 @@ general_threat_map <- function(in_dat, threat_category, threat_pal, hybas_habita
limits = c(0, max(proj_df$MeanWeightedThreatMetric, na.rm = T)),
na.value = "gray80",
breaks = c(0 + max(proj_df$MeanWeightedThreatMetric, na.rm = T)/10,
- #max(habitat_data$MeanWeightedThreatMetric)/2,
max(proj_df$MeanWeightedThreatMetric, na.rm = T) - max(proj_df$MeanWeightedThreatMetric, na.rm = T)/10),
labels = c("Lower", "Higher")
)+
@@ -40,6 +46,12 @@ general_threat_map <- function(in_dat, threat_category, threat_pal, hybas_habita
return(threat_map)
}
+#' @description filter data to target major threat and apply to established ggplot function
+#' @param in_dat dataframe with mean weighted threat scores by threat type and HYBAS_ID
+#' @param threat_category list of target threat categories
+#' @param threat_pal dataframe with color palettes and file name templates by threat type
+#' @param hybas_habitat_types shape file with HYBAS IDs and their habitat types
+#' @param proj character string with map projection definition
threat_map <- function(in_dat, threat_category, threat_pal, hybas_habitat_types, proj){
pal <- threat_pal |>
@@ -55,6 +67,12 @@ threat_map <- function(in_dat, threat_category, threat_pal, hybas_habitat_types,
}
+#' @description filter data to target sub threat and apply to established ggplot function
+#' @param in_dat dataframe with mean weighted threat scores by threat type and HYBAS_ID
+#' @param threat_category list of target threat categories
+#' @param threat_pal dataframe with color palettes and file name templates by threat type
+#' @param hybas_habitat_types shape file with HYBAS IDs and their habitat types
+#' @param proj character string with map projection definition
subThreat_map <- function(in_dat, threat_category, threat_pal, proj, hybas_habitat_types){
pal <- threat_pal |>
@@ -70,6 +88,15 @@ subThreat_map <- function(in_dat, threat_category, threat_pal, proj, hybas_habit
}
+#' @description cowplot code to style the legend
+#' @param in_dat dataframe with mean weighted threat scores by threat type and HYBAS_ID
+#' @param legend_png character string of raw extracted legend file location
+#' @param threat_category list of target threat categories
+#' @param out_file character string of file name and location to save final legend
+#' @param height png height
+#' @param width png width
+#' @param unit png height and width units
+#' @param dpi png dpi
cowplot_legend <- function(in_dat, legend_png, threat_category, out_file, height, width, unit, dpi){
threat_df <- in_dat |>
@@ -80,7 +107,6 @@ cowplot_legend <- function(in_dat, legend_png, threat_category, out_file, height
# Define colors
background_color = NA
- font_color = "#ffffff"
# The background canvas for your viz (DO NOT EDIT)
canvas <- grid::rectGrob(
@@ -89,10 +115,7 @@ cowplot_legend <- function(in_dat, legend_png, threat_category, out_file, height
gp = grid::gpar(fill = background_color, alpha = 1, col = background_color)
)
- # margin for plotting (DO NOT EDIT)
- margin = 0.04
-
- # Load in USGS logo (also a black logo available)
+ # Load raw legend png
legend <- magick::image_read(legend_png)
final_legend <- ggdraw(ylim = c(0,1), # 0-1 scale makes it easy to place viz items on canvas
@@ -125,15 +148,24 @@ cowplot_legend <- function(in_dat, legend_png, threat_category, out_file, height
lineheight = 0.75,
color = "gray50",
size = 9)
- #429x176
+
ggsave(out_file, final_legend, height = height, width = width, units = unit, dpi = dpi, bg = "transparent")
}
-# height = 176, width = 429, unit = "px", dpi = 300
-save_legend <- function(type, plot, threat_category, subcat_habitat, subcat_pollution, subcat_climate, in_dat, config_df, height, width, unit, dpi){
+#' @description cowplot code to style the legend
+#' @param type "threat" or "subThreat"
+#' @param plot ggplot map with legend to be saved
+#' @param threat_category list of target threat categories
+#' @param in_dat dataframe with mean weighted threat scores by threat type and HYBAS_ID
+#' @param threat_pal dataframe with color palettes and file name templates by threat type
+#' @param height png height
+#' @param width png width
+#' @param unit png height and width units
+#' @param dpi png dpi
+save_legend <- function(type, plot, threat_category, in_dat, threat_pal, height, width, unit, dpi){
if(type == "threat"){
- name_conv <- config_df |>
+ name_conv <- threat_pal |>
filter(MajorCat == threat_category)
plot_legend <- get_plot_component(plot, "guide-box-right", return_all = T)
@@ -152,7 +184,7 @@ save_legend <- function(type, plot, threat_category, subcat_habitat, subcat_poll
return(out_file_final)
} else if(type == "subThreat"){
- name_conv <- config_df |>
+ name_conv <- threat_pal |>
filter(ThreatCategory == threat_category)
plot_legend <- get_plot_component(plot, "guide-box-right", return_all = T)
@@ -173,10 +205,19 @@ save_legend <- function(type, plot, threat_category, subcat_habitat, subcat_poll
}
}
-save_map <- function(type, plot, threat_category, subcat_habitat, subcat_pollution, subcat_climate, config_df, height, width, dpi){
+#' @description cowplot code to style the legend
+#' @param type "threat" or "subThreat"
+#' @param plot ggplot map to be saved
+#' @param threat_category list of target threat categories
+#' @param threat_pal dataframe with color palettes and file name templates by threat type
+#' @param height png height
+#' @param width png width
+#' @param unit png height and width units
+#' @param dpi png dpi
+save_map <- function(type, plot, threat_category, threat_pal, height, width, dpi){
if(type == "threat"){
- name_conv <- config_df |>
+ name_conv <- threat_pal |>
filter(MajorCat == threat_category)
out_file <- sprintf(unique(name_conv$threat_map), str_replace_all(threat_category, " ", "_"))
@@ -185,7 +226,7 @@ save_map <- function(type, plot, threat_category, subcat_habitat, subcat_polluti
plot, height = height, width = width, dpi = dpi)
} else if(type == "subThreat"){
- name_conv <- config_df |>
+ name_conv <- threat_pal |>
filter(ThreatCategory == threat_category)
out_file <- sprintf(unique(name_conv$subThreat_map), str_replace_all(threat_category, " ", "_"))
--
GitLab