From 2ea5013b92195dbed44175751bf335bab9de2600 Mon Sep 17 00:00:00 2001
From: Kaysa Vaarre-Lamoureux <kvaarre-lamoureux@usgs.gov>
Date: Fri, 10 Jan 2025 17:01:05 -0500
Subject: [PATCH] add processing and plotting for threat maps
---
findex/_targets.R | 38 ++++++++++++++++++++++++++++++++++++-
findex/src/data_utils.R | 26 +++++++++++++++++++++++++
findex/src/plot_utils.R | 42 +++++++++++++++++++++++++++++++++++++++++
3 files changed, 105 insertions(+), 1 deletion(-)
create mode 100644 findex/src/plot_utils.R
diff --git a/findex/_targets.R b/findex/_targets.R
index ab85b48..da62c19 100644
--- a/findex/_targets.R
+++ b/findex/_targets.R
@@ -1,4 +1,5 @@
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)
diff --git a/findex/src/data_utils.R b/findex/src/data_utils.R
index bd92889..0dced0a 100644
--- a/findex/src/data_utils.R
+++ b/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
diff --git a/findex/src/plot_utils.R b/findex/src/plot_utils.R
new file mode 100644
index 0000000..f5f7aa3
--- /dev/null
+++ b/findex/src/plot_utils.R
@@ -0,0 +1,42 @@
+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
--
GitLab