add processing and plotting for threat maps

findex/_targets.R

 library(targets)
+library(tarchetypes)
 
 options(tidyverse.quiet = TRUE)
 tar_option_set(packages = c("tidyverse", 
@@ -6,6 +7,7 @@ tar_option_set(packages = c("tidyverse",
                             "readxl"))
 
 source("src/data_utils.R")
+source("src/plot_utils.R")
 
 p1 <- list(
   # Download from SB using SB link with token (see project notes)
@@ -67,7 +69,41 @@ p2 <- list(
       outfile = "../public/findex_total_weighted_threats.csv"
     ),
     format = "file"
+  ),
+  #### processing for threat maps ####
+  tar_target(
+    p2_mean_weighted_threats, # take _csv ending off if not saving to a csv
+    compute_mean_weighted_threats(
+      threat_data = p2_threats, 
+      threat_weights = p2_weights, 
+      hybas_habitat_types = p2_hybas_habitat_types_sf#,
+      #outfile = "out/findex_mean_weighted_threats.csv"
+    )#,
+    #format = "file"
   )
 )
 
-c(p1, p2)
+p3 <- list(
+  tar_target(p3_color_pal,
+             tibble(
+               Habitat_pal = list(c("#A07138", "#C08B4B", "#CDA371", "#E1C8AA")),
+               Pollution_pal = list(c("#002D5E", "#B2C0CE")),
+               Exploitation_pal = list(c("#B74F49", "#cd8480", "#E2B8B6")),
+               Invasive_pal = list(c("#4E6D6E", "#6f9899", "#9CB8B9", "#C9D8D9")),
+               Climate_pal = list(c("#9D6AAC", "#bd9bc7", "#DDCCE2"))
+             )),
+  tar_map(
+    values = tibble::tibble(threat_cat = c("Habitat", "Exploitation", 
+                                           "Invasive species", "Pollution", 
+                                           "Climate and weather")),
+  tar_target(
+    p3_threat_map,
+    threat_map(in_dat = p2_mean_weighted_threats, 
+                   threat_category = threat_cat, 
+                   threat_pal = p3_color_pal, 
+                   out_file = paste0("out/", str_replace_all(threat_cat, " ", "_"), "_map.png")),
+    format = "file"
+  ))
+)
+
+c(p1, p2, p3)

findex/src/data_utils.R

@@ -27,3 +27,29 @@ compute_total_weighted_threats <- function(threat_data, threat_weights,
   
   return(outfile)
 }
+
+compute_mean_weighted_threats <- function(threat_data, threat_weights, 
+                                     hybas_habitat_types){ #outfile
+  
+  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) |>
+    group_by(HYBAS_ID, ThreatCategory) |>
+    mutate(MeanWeightedThreatMetric = mean(weightedThreatMetric, na.rm = TRUE)) |>
+    ungroup() |> 
+    select(HYBAS_ID, ThreatCategory, MeanWeightedThreatMetric, Shape) |>
+    unique() |> 
+    arrange(desc(MeanWeightedThreatMetric)) #|>
+    #readr::write_csv(outfile)
+  
+  #return(outfile)
+}
\ No newline at end of file

findex/src/plot_utils.R

+threat_map <- function(in_dat, threat_category, threat_pal, out_file){
+
+filtered_df <- st_as_sf(in_dat) |> 
+  dplyr::filter(ThreatCategory == threat_category)
+
+if(threat_category == "Habitat"){
+  pal <- threat_pal$Habitat_pal
+} else if(threat_category == "Pollution"){
+  pal <- threat_pal$Pollution_pal
+} else if(threat_category == "Exploitation"){
+  pal <- threat_pal$Exploitation_pal
+} else if(threat_category == "Invasive species"){
+  pal <- threat_pal$Invasive_pal
+} else if(threat_category == "Climate and weather"){
+  pal <- threat_pal$Climate_pal
+}
+
+threat_map <- ggplot()+
+  geom_sf(data = filtered_df, aes(geometry = Shape, fill = MeanWeightedThreatMetric, color = MeanWeightedThreatMetric))+
+  scale_fill_gradientn(
+    colors = colorRampPalette(c(rev(unlist(pal))))(100),
+    limits = c(0, max(filtered_df$MeanWeightedThreatMetric)),
+    na.value=NA
+  )+
+  scale_color_gradientn(
+    colors = colorRampPalette(c(rev(unlist(pal))))(100), 
+    na.value=NA
+  )+
+  guides(color = "none")+
+  guides(fill = guide_colorbar(title.position = "top",
+                               direction = "vertical",
+                               barwidth = 1,
+                               barheight = 5))+
+  theme_void()+
+  theme(
+    legend.position = c(0.1, 0.21),
+    legend.title = element_blank()
+  )
+
+ggsave(out_file, height = 6, width = 10, dpi = 300) 
+
+}
\ No newline at end of file