diff --git a/findex/_targets.R b/findex/_targets.R
index 1bcbd29a720d5906cfd7962bcd952141dbda0a0c..59f1a6d785a4a898d351f0ad275d86449cbd0515 100644
--- a/findex/_targets.R
+++ b/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)
diff --git a/findex/src/data_utils.R b/findex/src/data_utils.R
index 2c47c826b34c64238024c7a0e74ad73a07514798..170d7b085c4a8d3c57f674638b67364dc9d7b3d7 100644
--- a/findex/src/data_utils.R
+++ b/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))
diff --git a/findex/src/plot_utils.R b/findex/src/plot_utils.R
index b5ed06e0ae17f148a05afab6fa43d7071340b805..f103b46c84b6f3b5a7bbd6139b1bc11ad1461d2e 100644
--- a/findex/src/plot_utils.R
+++ b/findex/src/plot_utils.R
@@ -1,6 +1,8 @@
-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
diff --git a/src/assets/images/Climate_and_weather_legend.png b/src/assets/images/Climate_and_weather_legend.png
index 2c0bb4f8272f3c40ea55366cf21ed363c3f2a937..2bb9a9bbd9c0738ddc181df12e3f3ff370ac6d45 100644
Binary files a/src/assets/images/Climate_and_weather_legend.png and b/src/assets/images/Climate_and_weather_legend.png differ
diff --git a/src/assets/images/Exploitation_legend.png b/src/assets/images/Exploitation_legend.png
index c1dda7a87164ee070d6e5b0ea6763a28e88295d8..243b5dabe0f3c939681f20165e4b000838abc1dd 100644
Binary files a/src/assets/images/Exploitation_legend.png and b/src/assets/images/Exploitation_legend.png differ
diff --git a/src/assets/images/Habitat_legend.png b/src/assets/images/Habitat_legend.png
index 53fc1103c2e3077a3f07e68200b02cdd488fcfc2..52c0174c572b6d8b39e14683eb7b6762adb72592 100644
Binary files a/src/assets/images/Habitat_legend.png and b/src/assets/images/Habitat_legend.png differ
diff --git a/src/assets/images/Invasive_species_legend.png b/src/assets/images/Invasive_species_legend.png
index b4f9c41a13a2226c6431bccb278694c86cfca260..a0b625be30df58e1d95e18e06ea111d0d1e71a7c 100644
Binary files a/src/assets/images/Invasive_species_legend.png and b/src/assets/images/Invasive_species_legend.png differ
diff --git a/src/assets/images/Pollution_legend.png b/src/assets/images/Pollution_legend.png
index 3dc97270cdd7756b4c47f3b63a2320026a76a770..0f9da582d30541dacf61025d4b5f1f2b61546414 100644
Binary files a/src/assets/images/Pollution_legend.png and b/src/assets/images/Pollution_legend.png differ