From eb19ff721f5996050379f89ecc0ab132e0e19fee Mon Sep 17 00:00:00 2001
From: Kaysa Vaarre-Lamoureux <kvaarre-lamoureux@usgs.gov>
Date: Mon, 3 Mar 2025 16:30:39 -0500
Subject: [PATCH] top threats by basin first draft
---
findex/_targets.R | 34 +++++++++++++++++++++++++++
findex/src/plot_utils.R | 51 +++++++++++++++++++++++++++++++++++++++++
2 files changed, 85 insertions(+)
diff --git a/findex/_targets.R b/findex/_targets.R
index 0d800a4..1381a19 100644
--- a/findex/_targets.R
+++ b/findex/_targets.R
@@ -237,6 +237,40 @@ p3 <- list(
},
format = "file",
pattern = p2_threat_subcategories
+ ),
+ # top threat in each basin globally
+ tar_target(
+ p3_top_threat_map_png,
+ {
+ final_plot <- top_threat_plot(in_dat = p2_mean_weighted_threats,
+ threat_pal = p2_viz_config,
+ hybas_habitat_types = p2_hybas_habitat_types_sf,
+ proj = p1_proj) +
+ theme(legend.position = "none")
+
+ # change to actual directory once design is finalized --------------------
+ ggsave("test_out/threat_by_basin.png",
+ final_plot, height = 6, width = 10, dpi = 300)
+
+ # change to actual directory once design is finalized --------------------
+ knitr::plot_crop("test_out/threat_by_basin.png")
+ },
+ format = "file"
+ ),
+ tar_target(
+ p3_top_threat_legend_png,
+ {
+ final_plot <- top_threat_plot(in_dat = p2_mean_weighted_threats,
+ threat_pal = p2_viz_config,
+ hybas_habitat_types = p2_hybas_habitat_types_sf,
+ proj = p1_proj)
+
+ save_top_threat_legend(plot = final_plot,
+ dpi = 300,
+ # change to actual directory once design is finalized
+ out_file = "test_out/threat_by_basin_legend.png")
+ },
+ format = "file"
)
)
diff --git a/findex/src/plot_utils.R b/findex/src/plot_utils.R
index 68b9230..731821e 100644
--- a/findex/src/plot_utils.R
+++ b/findex/src/plot_utils.R
@@ -256,3 +256,54 @@ save_map <- function(type, plot, threat_category, threat_pal, height, width, dpi
}
}
+
+#in_dat = p2_mean_weighted_threats, threat_pal = p2_viz_config hybas_habitat_types = p2_hybas_habitat_types_sf, proj = p1_proj
+top_threat_plot <- function(in_dat, threat_pal, hybas_habitat_types, proj){
+
+ processed_df <- in_dat |>
+ group_by(HYBAS_ID) |>
+ filter(MeanWeightedThreatMetric == max(MeanWeightedThreatMetric, na.rm = T))
+
+ processed_sf <- processed_df |>
+ left_join(hybas_habitat_types) |>
+ st_as_sf() |>
+ # remove visual bug with robinson projection
+ st_wrap_dateline()
+
+ proj_sf <- st_transform(processed_sf, crs = st_crs(proj))
+
+ pal <- threat_pal |>
+ select(MajorCat, pal) |>
+ rowwise() |>
+ mutate(pal = first(pal)) |>
+ unique() |>
+ mutate(pal = case_when(pal == "#4E6D6E" ~ "#598586",
+ pal == "#7A562B" ~ "#A97639",
+ pal == "#835192" ~ "#995EAB",
+ pal == "#B74F49" ~ "#963C36",
+ pal == "#002D5E" ~ "#002D5E"))
+
+ threat_map <- ggplot()+
+ geom_sf(data = proj_sf, aes(geometry = Shape, fill = ThreatCategory), color = NA)+
+ scale_fill_manual(values = pal$pal, breaks = pal$MajorCat)+
+ guides(fill = guide_legend(nrow = 2,)) +
+ theme_void()+
+ theme(
+ legend.ticks = element_blank(),
+ legend.title = element_text(face = "bold"),
+ legend.title.position = "top",
+ legend.text = element_text(size = 11),
+ legend.direction = "horizontal"
+ )
+}
+
+#plot = final_plot, dpi = 300, out_file = "test_out/threat_by_basin_legend.png"
+save_top_threat_legend <- function(plot, dpi, out_file){
+
+ plot_legend <- get_plot_component(plot, "guide-box-right", return_all = T)
+
+ ggsave(out_file,
+ plot_legend, dpi = dpi, bg = "transparent")
+
+ knitr::plot_crop(out_file)
+}
--
GitLab