dynamic branching, adding cowplot function, programatic threat names

findex/_targets.R

@@ -34,6 +34,10 @@ p1 <- list(
     p1_hybas_legend_xlsx,
     "in/BasinATLAS_Data_v10.gdb/HydroATLAS_v10_Legends.xlsx",
     format = "file"
+  ),
+  tar_target(
+    p1_proj,
+    "ESRI:54030"
   )
 )
 
@@ -89,23 +93,41 @@ p2 <- list(
       #sub_threat = subThreat_cat
     )
   ),
+  
+  ## set up threat and sub-category threat lists for visualization dynamic branching
+  
+  tar_target(
+    p2_threat_categories,
+    p2_weights |>
+      pull(Threat_Category) |> 
+      unique()
+  ),
+  tar_target(
+    p2_threat_subcategories,
+    p2_mean_weighted_subThreats |>
+      pull(ThreatCategory) |> 
+      unique()
+  ),
   tar_target(
     p2_habitat_subthreats,
-    c("Dams", "Wetland drainage", "Deforestation and associated runoff",
-      "Riparian degradation", "Agricultural extraction", "Urban extraction", 
-      "Industrial extraction")
+    p2_mean_weighted_subThreats |> 
+      filter(MajorCat == "Habitat") |> 
+      pull(ThreatCategory) |>
+      unique()
   ),
   tar_target(
     p2_pollution_subthreats,
-    c("Agricultural effluents", "Urban wastewater", 
-      "Industrial effluents", "Aquaculture effluents",
-      "Pharmaceuticals", "Oil or gas exploration",
-      "Plastics", "Mining")
+    p2_mean_weighted_subThreats |> 
+      filter(MajorCat == "Pollution") |> 
+      pull(ThreatCategory) |>
+      unique()
   ),
   tar_target(
     p2_climate_subthreats,
-    c("Change in water temperature", "Drought", "Change in flooding", 
-      "Change in wind patterns", "Change in ice cover")
+    p2_mean_weighted_subThreats |> 
+      filter(MajorCat == "Climate and weather") |> 
+      pull(ThreatCategory) |>
+      unique()
   )
 )
 
@@ -118,105 +140,117 @@ p3 <- list(
                Invasive_pal = list(c("#4E6D6E", "#C9D8D9")),
                Climate_pal = list(c("#835192", "#DDCCE2")) #9D6AAC
              )),
-  #### major threat category maps ####
-  tar_map(
-    values = tibble::tibble(threat_cat = c("Habitat", "Exploitation", 
-                                           "Invasive species", "Pollution", 
-                                           "Climate and weather")),
-    tar_target( 
-      # change all out file paths to the earth in flux directroy: src/assets/images
-      p3_threat_map,
-      threat_map(in_dat = p2_mean_weighted_threats, 
-                 threat_category = threat_cat, 
-                 threat_pal = p3_color_pal 
-      )
-    ),
     tar_target( 
       p3_threat_map_png,
       {
-        final_plot <- p3_threat_map + 
+        final_plot <- threat_map(in_dat = p2_mean_weighted_threats, 
+                                 threat_category = p2_threat_categories, 
+                                 threat_pal = p3_color_pal,
+                                 proj = p1_proj) + 
           theme(legend.position = "none")
         
-        out_file <- paste0("../src/assets/images/", str_replace_all(threat_cat, " ", "_"), "_map.png")
+        out_file <- paste0("../src/assets/images/", str_replace_all(p2_threat_categories, " ", "_"), "_map.png")
         
         ggsave(out_file, 
                final_plot, height = 6, width = 10, dpi = 300)
       },
-      format = "file"
+      format = "file",
+      pattern = p2_threat_categories
     ),
     tar_target(
       p3_legend_png,
       {
-        plot_legend <- get_plot_component(p3_threat_map, "guide-box-right", return_all = T)
+        final_plot <- threat_map(in_dat = p2_mean_weighted_threats, 
+                                 threat_category = p2_threat_categories, 
+                                 threat_pal = p3_color_pal,
+                                 proj = p1_proj)
         
-        out_file <- paste0("../src/assets/images/", str_replace_all(threat_cat, " ", "_"), "_legend.png")
+        plot_legend <- get_plot_component(final_plot, "guide-box-right", return_all = T)
+        
+        out_file <- paste0("../src/assets/images/", str_replace_all(p2_threat_categories, " ", "_"), "_legend.png")
         
         ggsave(out_file, 
                plot_legend, dpi = 300, bg = "transparent")
         knitr::plot_crop(out_file)
-      }
-    )),
-  #### subcategory threat maps ####
-  tar_map(
-    values = tibble::tibble(sub_threat_cat = c("Dams", "Wetland drainage", "Deforestation and associated runoff",
-                                               "Riparian degradation", "Agricultural effluents", "Agricultural extraction",
-                                               "Aquaculture effluents", "Industrial effluents", "Industrial extraction",
-                                               "Urban extraction", "Urban wastewater", "Overfishing",
-                                               "Invasive non-native species", "Change in water temperature", "Drought",
-                                               "Change in flooding", "Pharmaceuticals", "Plastics",
-                                               "Oil or gas exploration", "Mining", "Change in wind patterns",
-                                               "Change in ice cover")),
-    tar_target(
-      p3_sub_threat_map,
-      subThreat_map(in_dat = p2_mean_weighted_subThreats, 
-                    threat_category = sub_threat_cat, 
-                    threat_pal = p3_color_pal)
+      },
+      pattern = p2_threat_categories
     ),
-    tar_target(
+    tar_target( # will turn this into a function
       p3_sub_threat_map_png,
       {
-        final_plot <- p3_sub_threat_map + 
+        final_plot <- subThreat_map(in_dat = p2_mean_weighted_subThreats, 
+                      threat_category = p2_threat_subcategories, 
+                      subcat_habitat = p2_habitat_subthreats,
+                      subcat_pollution = p2_pollution_subthreats,
+                      subcat_climate = p2_climate_subthreats,
+                      threat_pal = p3_color_pal,
+                      proj = p1_proj) + 
           theme(legend.position = "none")
         
-        if(sub_threat_cat %in% p2_habitat_subthreats){
-          out_file <- paste0("../src/assets/images/H_", str_replace_all(sub_threat_cat, " ", "_"), "_map.png")
-        } else if(sub_threat_cat %in% p2_pollution_subthreats){
-          out_file <- paste0("../src/assets/images/P_", str_replace_all(sub_threat_cat, " ", "_"), "_map.png")
-        } else if(sub_threat_cat == "Overfishing"){
-          out_file <- paste0("../src/assets/images/E_", str_replace_all(sub_threat_cat, " ", "_"), "_map.png")
-        } else if(sub_threat_cat == "Invasive non-native species"){
-          out_file <- paste0("../src/assets/images/IS_", str_replace_all(sub_threat_cat, " ", "_"), "_map.png")
-        } else if(sub_threat_cat %in% p2_climate_subthreats){
-          out_file <- paste0("../src/assets/images/CW_", str_replace_all(sub_threat_cat, " ", "_"), "_map.png")
+        if(p2_threat_subcategories %in% p2_habitat_subthreats){
+          out_file <- paste0("../src/assets/images/H_", str_replace_all(p2_threat_subcategories, " ", "_"), "_map.png")
+        } else if(p2_threat_subcategories %in% p2_pollution_subthreats){
+          out_file <- paste0("../src/assets/images/P_", str_replace_all(p2_threat_subcategories, " ", "_"), "_map.png")
+        } else if(p2_threat_subcategories == "Overfishing"){
+          out_file <- paste0("../src/assets/images/E_", str_replace_all(p2_threat_subcategories, " ", "_"), "_map.png")
+        } else if(p2_threat_subcategories == "Invasive non-native species"){
+          out_file <- paste0("../src/assets/images/IS_", str_replace_all(p2_threat_subcategories, " ", "_"), "_map.png")
+        } else if(p2_threat_subcategories %in% p2_climate_subthreats){
+          out_file <- paste0("../src/assets/images/CW_", str_replace_all(p2_threat_subcategories, " ", "_"), "_map.png")
         }
         
         ggsave(out_file, 
                final_plot, height = 6, width = 10, dpi = 300)
       },
-      format = "file"
+      format = "file",
+      pattern = p2_threat_subcategories
     ),
-    tar_target(
+    tar_target( # will turn this into a function
       p3_sub_threat_legend_png,
       {
-        plot_legend <- get_plot_component(p3_sub_threat_map, "guide-box-right", return_all = T)
+        final_plot <- subThreat_map(in_dat = p2_mean_weighted_subThreats, 
+                                    threat_category = p2_threat_subcategories, 
+                                    subcat_habitat = p2_habitat_subthreats,
+                                    subcat_pollution = p2_pollution_subthreats,
+                                    subcat_climate = p2_climate_subthreats,
+                                    threat_pal = p3_color_pal,
+                                    proj = p1_proj)
         
-        if(sub_threat_cat %in% p2_habitat_subthreats){
-          out_file <- paste0("../src/assets/images/H_", str_replace_all(sub_threat_cat, " ", "_"), "_legend.png")
-        } else if(sub_threat_cat %in% p2_pollution_subthreats){
-          out_file <- paste0("../src/assets/images/P_", str_replace_all(sub_threat_cat, " ", "_"), "_legend.png")
-        } else if(sub_threat_cat == "Overfishing"){
-          out_file <- paste0("../src/assets/images/E_", str_replace_all(sub_threat_cat, " ", "_"), "_legend.png")
-        } else if(sub_threat_cat == "Invasive non-native species"){
-          out_file <- paste0("../src/assets/images/IS_", str_replace_all(sub_threat_cat, " ", "_"), "_legend.png")
-        } else if(sub_threat_cat %in% p2_climate_subthreats){
-          out_file <- paste0("../src/assets/images/CW_", str_replace_all(sub_threat_cat, " ", "_"), "_legend.png")
+        plot_legend <- get_plot_component(final_plot, "guide-box-right", return_all = T)
+        
+        if(p2_threat_subcategories %in% p2_habitat_subthreats){
+          out_file <- paste0("out/H_", str_replace_all(p2_threat_subcategories, " ", "_"), "_legend_raw.png")
+        } else if(p2_threat_subcategories %in% p2_pollution_subthreats){
+          out_file <- paste0("out/P_", str_replace_all(p2_threat_subcategories, " ", "_"), "_legend_raw.png")
+        } else if(p2_threat_subcategories == "Overfishing"){
+          out_file <- paste0("out/E_", str_replace_all(p2_threat_subcategories, " ", "_"), "_legend_raw.png")
+        } else if(p2_threat_subcategories == "Invasive non-native species"){
+          out_file <- paste0("out/IS_", str_replace_all(p2_threat_subcategories, " ", "_"), "_legend_raw.png")
+        } else if(p2_threat_subcategories %in% p2_climate_subthreats){
+          out_file <- paste0("out/CW_", str_replace_all(p2_threat_subcategories, " ", "_"), "_legend_raw.png")
         }
         
         ggsave(out_file, 
                plot_legend, dpi = 300, bg = "transparent")
         knitr::plot_crop(out_file)
-      }
-    ))
+        
+        if(p2_threat_subcategories %in% p2_habitat_subthreats){
+          out_file_final <- paste0("../src/assets/images/H_", str_replace_all(p2_threat_subcategories, " ", "_"), "_legend.png")
+        } else if(p2_threat_subcategories %in% p2_pollution_subthreats){
+          out_file_final <- paste0("../src/assets/images/P_", str_replace_all(p2_threat_subcategories, " ", "_"), "_legend.png")
+        } else if(p2_threat_subcategories == "Overfishing"){
+          out_file_final <- paste0("../src/assets/images/E_", str_replace_all(p2_threat_subcategories, " ", "_"), "_legend.png")
+        } else if(p2_threat_subcategories == "Invasive non-native species"){
+          out_file_final <- paste0("../src/assets/images/IS_", str_replace_all(p2_threat_subcategories, " ", "_"), "_legend.png")
+        } else if(p2_threat_subcategories %in% p2_climate_subthreats){
+          out_file_final <- paste0("../src/assets/images/CW_", str_replace_all(p2_threat_subcategories, " ", "_"), "_legend.png")
+        }
+        
+        cowplot_legend(in_dat = p2_mean_weighted_subThreats, legend_png = out_file, threat_category = p2_threat_subcategories, out_file = out_file_final)
+      },
+      format = "file",
+      pattern = p2_threat_subcategories
+    )
   )
 
 

findex/src/data_utils.R

@@ -74,6 +74,7 @@ compute_mean_weighted_subThreats <- function(threat_data, threat_weights,
     mutate(MeanWeightedThreatMetric = mean(weightedThreatMetric, na.rm = TRUE)) |>
     ungroup() |> 
     select(HYBAS_ID, ThreatCategory, Threat, MeanWeightedThreatMetric, Shape) |>
+    rename(MajorCat = ThreatCategory, ThreatCategory = Threat) |> 
     unique() |> 
     arrange(desc(MeanWeightedThreatMetric))
 }

findex/src/plot_utils.R

-threat_map <- function(in_dat, threat_category, threat_pal){
+threat_map <- function(in_dat, threat_category, threat_pal, proj){
 
 filtered_df <- st_as_sf(in_dat) |> 
   dplyr::filter(ThreatCategory == threat_category) |> 
   # remove visual bug with robinson projection
   st_wrap_dateline()
 
-proj_df <- st_transform(filtered_df, crs = st_crs("ESRI:54030"))
+proj_df <- st_transform(filtered_df, crs = st_crs(proj))
 
 if(threat_category == "Habitat"){
   pal <- threat_pal$Habitat_pal
@@ -43,37 +43,33 @@ threat_map <- ggplot()+
   theme_void()+
   theme(
     #legend.position = c(0.1, 0.21),
-    legend.ticks = element_blank()
+    legend.ticks = element_blank(),
+    legend.title = element_text(face = "bold"),
+    legend.text = element_text(size = 11)
   )
 
 return(threat_map)
 
 }
 
-subThreat_map <- function(in_dat, threat_category, threat_pal){
+subThreat_map <- function(in_dat, threat_category, threat_pal, subcat_habitat, subcat_pollution, subcat_climate, proj){
   
   filtered_df <- st_as_sf(in_dat) |> 
-    dplyr::filter(Threat == threat_category) |> 
+    dplyr::filter(ThreatCategory == threat_category) |> 
     # remove visual bug with robinson projection
     st_wrap_dateline()
   
-  proj_df <- st_transform(filtered_df, crs = st_crs("ESRI:54030"))
+  proj_df <- st_transform(filtered_df, crs = st_crs(proj))
   
-  if(threat_category %in% c("Dams", "Wetland drainage", "Deforestation and associated runoff",
-                            "Riparian degradation", "Agricultural extraction", "Urban extraction", 
-                            "Industrial extraction")){
+  if(threat_category %in% subcat_habitat){
     pal <- threat_pal$Habitat_pal
-  } else if(threat_category %in% c("Agricultural effluents", "Urban wastewater", 
-                                   "Industrial effluents", "Aquaculture effluents",
-                                   "Pharmaceuticals", "Oil or gas exploration",
-                                   "Plastics", "Mining")){
+  } else if(threat_category %in% subcat_pollution){
     pal <- threat_pal$Pollution_pal
   } else if(threat_category == "Overfishing"){
     pal <- threat_pal$Exploitation_pal
   } else if(threat_category == "Invasive non-native species"){
     pal <- threat_pal$Invasive_pal
-  } else if(threat_category %in% c("Change in water temperature", "Drought", "Change in flooding", 
-                                 "Change in wind patterns", "Change in ice cover")){
+  } else if(threat_category %in% subcat_climate){
     pal <- threat_pal$Climate_pal
   }
   
@@ -101,9 +97,73 @@ subThreat_map <- function(in_dat, threat_category, threat_pal){
     theme_void()+
     theme(
       #legend.position = c(0.1, 0.21),
-      legend.ticks = element_blank()
+      legend.ticks = element_blank(),
+      legend.title = element_text(face = "bold"),
+      legend.text = element_text(size = 11)
     )
   
   return(threat_map)
   
+}
+# in_dat = p2_mean_weighted_threats, legend_png = p3_legend_png, threat_category = threat_cat
+## note about out_file - need to find a way to save the cowplot version of the legend without crowding the images folder
+## maybe by saving the initial legend png in the findex out folder and then saving 
+## the cowplot version to the earth-in-flux parent directory "src/assets/images/" folder
+cowplot_legend <- function(in_dat, legend_png, threat_category, out_file){
+  
+  threat_df <- in_dat |> 
+    filter(ThreatCategory == threat_category)
+  
+  min_val <- min(threat_df$MeanWeightedThreatMetric, na.rm = T)
+  max_val <- max(threat_df$MeanWeightedThreatMetric, na.rm = T)
+  
+  # Define colors
+  background_color = NA
+  font_color = "#ffffff"
+  
+  # The background canvas for your viz (DO NOT EDIT)
+  canvas <- grid::rectGrob(
+    x = 0, y = 0, 
+    width = 9, height = 9,
+    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)
+  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
+                         xlim = c(0,1)) +
+    # a background  (DO NOT EDIT)
+    draw_grob(canvas,
+              x = 0, y = 1,
+              height = 9, width = 16,
+              hjust = 0, vjust = 1) +
+    draw_image(legend, 
+               x = 0.08,
+               y = 0.08,
+               width = 0.77, 
+               hjust = 0, vjust = 0, 
+               halign = 0, valign = 0)+
+    # min max values
+    draw_label(as.character(min_val),
+               x = 0.02,
+               y = 0.54,
+               hjust = 0,
+               vjust = 1,
+               lineheight = 0.75,
+               color = "gray50",
+               size = 9) +
+    draw_label(as.character(max_val),
+               x = 1,
+               y = 0.54,
+               hjust = 1,
+               vjust = 1,
+               lineheight = 0.75,
+               color = "gray50",
+               size = 9) 
+  #429x176
+  ggsave(out_file, final_legend, height = 176, width = 429, units = "px", dpi = 300, bg = "transparent")
 }
\ No newline at end of file