reduce duplicate processing code, cowplot major cat legends

findex/_targets.R

@@ -66,11 +66,17 @@ p2 <- list(
     )
   ),
   tar_target(
-    p2_total_weighted_threats_csv,
-    compute_total_weighted_threats(
+    p2_weighted_threats,
+    compute_weighted_threats(
       threat_data = p2_threats,
       threat_weights = p2_weights,
-      hybas_habitat_types = p2_hybas_habitat_types_sf,
+      hybas_habitat_types = p2_hybas_habitat_types_sf
+    )
+  ),
+  tar_target(
+    p2_total_weighted_threats_csv,
+    compute_total_weighted_threats(
+      in_dat = p2_weighted_threats,
       outfile = "../public/findex_total_weighted_threats.csv"
     ),
     format = "file"
@@ -79,18 +85,13 @@ p2 <- list(
   tar_target(
     p2_mean_weighted_threats, 
     compute_mean_weighted_threats(
-      threat_data = p2_threats, 
-      threat_weights = p2_weights, 
-      hybas_habitat_types = p2_hybas_habitat_types_sf
+      in_dat = p2_weighted_threats
     )
   ),
   tar_target( 
     p2_mean_weighted_subThreats, 
     compute_mean_weighted_subThreats(
-      threat_data = p2_threats, 
-      threat_weights = p2_weights, 
-      hybas_habitat_types = p2_hybas_habitat_types_sf
-      #sub_threat = subThreat_cat
+      in_dat = p2_weighted_threats
     )
   ),
   
@@ -146,6 +147,7 @@ p3 <- list(
         final_plot <- threat_map(in_dat = p2_mean_weighted_threats, 
                                  threat_category = p2_threat_categories, 
                                  threat_pal = p3_color_pal,
+                                 hybas_habitat_types = p2_hybas_habitat_types_sf,
                                  proj = p1_proj) + 
           theme(legend.position = "none")
         
@@ -163,15 +165,20 @@ p3 <- list(
         final_plot <- threat_map(in_dat = p2_mean_weighted_threats, 
                                  threat_category = p2_threat_categories, 
                                  threat_pal = p3_color_pal,
-                                 proj = p1_proj)
+                                 proj = p1_proj,
+                                 hybas_habitat_types = p2_hybas_habitat_types_sf)
         
         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")
+        out_file <- paste0("out/", str_replace_all(p2_threat_categories, " ", "_"), "_legend_raw.png")
         
         ggsave(out_file, 
                plot_legend, dpi = 300, bg = "transparent")
         knitr::plot_crop(out_file)
+        
+        out_file_final <- paste0("../src/assets/images/", str_replace_all(p2_threat_categories, " ", "_"), "_legend.png")
+        
+        cowplot_legend(in_dat = p2_mean_weighted_threats, legend_png = out_file, threat_category = p2_threat_categories, out_file = out_file_final)
       },
       pattern = p2_threat_categories
     ),
@@ -184,7 +191,8 @@ p3 <- list(
                       subcat_pollution = p2_pollution_subthreats,
                       subcat_climate = p2_climate_subthreats,
                       threat_pal = p3_color_pal,
-                      proj = p1_proj) + 
+                      proj = p1_proj,
+                      hybas_habitat_types = p2_hybas_habitat_types_sf) + 
           theme(legend.position = "none")
         
         if(p2_threat_subcategories %in% p2_habitat_subthreats){
@@ -214,7 +222,8 @@ p3 <- list(
                                     subcat_pollution = p2_pollution_subthreats,
                                     subcat_climate = p2_climate_subthreats,
                                     threat_pal = p3_color_pal,
-                                    proj = p1_proj)
+                                    proj = p1_proj,
+                                    hybas_habitat_types = p2_hybas_habitat_types_sf)
         
         plot_legend <- get_plot_component(final_plot, "guide-box-right", return_all = T)
         

findex/src/data_utils.R

@@ -5,9 +5,10 @@ get_hybas_habitat_types <- function (hybas_04_sf, hybas_legend) {
     select(HYBAS_ID, Habitat = MHT_Name)
 }
 
-compute_total_weighted_threats <- function(threat_data, threat_weights,
-                                           hybas_habitat_types, outfile) {
-  threat_data |>
+# compute weighted threats
+compute_weighted_threats <- function(threat_data, threat_weights,
+                                     hybas_habitat_types){
+  processed_df <- threat_data |>
     select(HYBAS_ID, ends_with("_LS")) |>
     pivot_longer(cols = ends_with("LS"), names_to = c("ThreatCode", NA), 
                  names_sep = "_", values_to = "ThreatMetric") |>
@@ -18,8 +19,13 @@ compute_total_weighted_threats <- function(threat_data, threat_weights,
     #                        "No Data")) |>
     left_join(select(threat_weights, ThreatCode = Threat_Code, Threat, 
                      ThreatCategory = Threat_Category, everything())) |>
-    mutate(weightedThreatMetric = ThreatMetric * Final_Weight) |>
-    group_by(Threat, ThreatCategory) |>
+    mutate(weightedThreatMetric = ThreatMetric * Final_Weight)
+}
+
+# total threats
+compute_total_weighted_threats <- function(in_dat, outfile) {
+  in_dat |>
+    group_by(Threat, ThreatCategory) |> #
     summarize(TotalWeightedThreatMetric = sum(weightedThreatMetric, na.rm = TRUE)) |>
     select(ThreatCategory, Threat, TotalWeightedThreatMetric) |>
     arrange(desc(TotalWeightedThreatMetric)) |>
@@ -28,25 +34,14 @@ compute_total_weighted_threats <- function(threat_data, threat_weights,
   return(outfile)
 }
 
-compute_mean_weighted_threats <- function(threat_data, threat_weights, 
-                                     hybas_habitat_types){ #outfile
+# mean threats
+compute_mean_weighted_threats <- function(in_dat){ 
   
-  processed_df <- threat_data |> 
-    select(HYBAS_ID, ends_with("_LS")) |>
-    pivot_longer(cols = ends_with("LS"), names_to = c("ThreatCode", NA), 
-                 names_sep = "_", values_to = "ThreatMetric") |>
-    left_join(hybas_habitat_types) |>
-    # # Gretchen said there's not much data for Xeric - we could filter these out
-    # filter(!Habitat %in% c("Xeric freshwaters and endorheic basins",
-    #                        "Greenland",
-    #                        "No Data")) |>
-    left_join(select(threat_weights, ThreatCode = Threat_Code, Threat, 
-                     ThreatCategory = Threat_Category, everything())) |>
-    mutate(weightedThreatMetric = ThreatMetric * Final_Weight) |>
+  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) |> #, Shape
     unique() |> 
     arrange(desc(MeanWeightedThreatMetric)) #|>
     #readr::write_csv(outfile)
@@ -54,26 +49,14 @@ compute_mean_weighted_threats <- function(threat_data, threat_weights,
   #return(outfile)
 }
 
-# same as comput_mean_weighted_threats except it includes subcategories
-compute_mean_weighted_subThreats <- function(threat_data, threat_weights, 
-                                             hybas_habitat_types){
+# mean sub threats
+compute_mean_weighted_subThreats <- function(in_dat){
   
-  processed_df <- threat_data |> 
-    select(HYBAS_ID, ends_with("_LS")) |>
-    pivot_longer(cols = ends_with("LS"), names_to = c("ThreatCode", NA), 
-                 names_sep = "_", values_to = "ThreatMetric") |>
-    left_join(hybas_habitat_types) |>
-    # # Gretchen said there's not much data for Xeric - we could filter these out
-    # filter(!Habitat %in% c("Xeric freshwaters and endorheic basins",
-    #                        "Greenland",
-    #                        "No Data")) |>
-    left_join(select(threat_weights, ThreatCode = Threat_Code, Threat, 
-                     ThreatCategory = Threat_Category, everything())) |>
-    mutate(weightedThreatMetric = ThreatMetric * Final_Weight) |>
+  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) |> #, Shape
     rename(MajorCat = ThreatCategory, ThreatCategory = Threat) |> 
     unique() |> 
     arrange(desc(MeanWeightedThreatMetric))

findex/src/plot_utils.R

-threat_map <- function(in_dat, threat_category, threat_pal, proj){
-
-filtered_df <- st_as_sf(in_dat) |> 
+threat_map <- function(in_dat, threat_category, threat_pal, hybas_habitat_types, proj){
+# hybas_habitat_types = p2_hybas_habitat_types_sf
+filtered_df <- in_dat |> 
+  left_join(hybas_habitat_types) |> 
+  st_as_sf() |> 
   dplyr::filter(ThreatCategory == threat_category) |> 
   # remove visual bug with robinson projection
   st_wrap_dateline()
@@ -52,9 +54,11 @@ return(threat_map)
 
 }
 
-subThreat_map <- function(in_dat, threat_category, threat_pal, subcat_habitat, subcat_pollution, subcat_climate, proj){
+subThreat_map <- function(in_dat, threat_category, threat_pal, subcat_habitat, subcat_pollution, subcat_climate, proj, hybas_habitat_types){
   
-  filtered_df <- st_as_sf(in_dat) |> 
+  filtered_df <- in_dat |> 
+    left_join(hybas_habitat_types) |> 
+    st_as_sf() |> 
     dplyr::filter(ThreatCategory == threat_category) |> 
     # remove visual bug with robinson projection
     st_wrap_dateline()
@@ -114,8 +118,8 @@ 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)
+  min_val <- round(min(threat_df$MeanWeightedThreatMetric, na.rm = T), digits = 2)
+  max_val <- round(max(threat_df$MeanWeightedThreatMetric, na.rm = T), digits = 2)
   
   # Define colors
   background_color = NA