Skip to content
Snippets Groups Projects
Commit 7bd719f4 authored by Vaarre-Lamoureux, Kaysa S's avatar Vaarre-Lamoureux, Kaysa S
Browse files

add function documentation and clean up code

parent 4076acd3
No related branches found
No related tags found
1 merge request!86Findex global maps
Hide whitespace changes
Inline Side-by-side
findex/_targets.R
+ 124
− 145
View file @ 7bd719f4
......@@ -65,6 +65,9 @@ p2 <- list(
hybas_legend = p2_hybas_legend
)
),
#### processing for threat maps ####
tar_target(
p2_weighted_threats,
compute_weighted_threats(
......@@ -81,7 +84,6 @@ p2 <- list(
),
format = "file"
),
#### processing for threat maps ####
tar_target(
p2_mean_weighted_threats,
compute_mean_weighted_threats(
......@@ -95,7 +97,7 @@ p2 <- list(
)
),
## set up threat and sub-category threat lists for visualization dynamic branching
#### threat lists for branching ####
tar_target(
p2_threat_categories,
......@@ -109,155 +111,132 @@ p2 <- list(
pull(ThreatCategory) |>
unique()
),
#### color ramps and file name templates ####
tar_target(
p2_habitat_subthreats,
p2_mean_weighted_subThreats |>
filter(MajorCat == "Habitat") |>
pull(ThreatCategory) |>
unique()
),
tar_target(
p2_pollution_subthreats,
p2_mean_weighted_subThreats |>
filter(MajorCat == "Pollution") |>
pull(ThreatCategory) |>
unique()
),
tar_target(
p2_climate_subthreats,
p2_mean_weighted_subThreats |>
filter(MajorCat == "Climate and weather") |>
pull(ThreatCategory) |>
unique()
),
tar_target(p2_viz_config,
{
p2_mean_weighted_subThreats |>
select(MajorCat, ThreatCategory) |>
mutate(
# map color ramp
pal = case_when(
MajorCat == "Habitat" ~ list(c("#7A562B", "#C7985F", "#E1C8AA")),
MajorCat == "Exploitation" ~ list(c("#B74F49", "#E2B8B6")),
MajorCat == "Invasive species" ~ list(c("#4E6D6E", "#C9D8D9")),
MajorCat == "Pollution" ~ list(c("#002D5E", "#B2C0CE")),
MajorCat == "Climate and weather" ~ list(c("#835192", "#DDCCE2"))
),
# legend and map file name template strings
threat_legend_raw = "out/%s_legend_raw.png",
threat_legend = "../src/assets/images/%s_legend.png",
threat_map = "../src/assets/images/%s_map.png",
subThreat_legend_raw = case_when(
MajorCat %in% "Habitat" ~ "out/H_%s_legend_raw.png",
MajorCat %in% "Exploitation" ~ "out/E_%s_legend_raw.png",
MajorCat %in% "Invasive species" ~ "out/IS_%s_legend_raw.png",
MajorCat %in% "Pollution" ~ "out/P_%s_legend_raw.png",
MajorCat %in% "Climate and weather" ~ "out/CW_%s_legend_raw.png"
),
subThreat_legend = case_when(
MajorCat %in% "Habitat" ~ "../src/assets/images/H_%s_legend.png",
MajorCat %in% "Exploitation" ~ "../src/assets/images/E_%s_legend.png",
MajorCat %in% "Invasive species" ~ "../src/assets/images/IS_%s_legend.png",
MajorCat %in% "Pollution" ~ "../src/assets/images/P_%s_legend.png",
MajorCat %in% "Climate and weather" ~ "../src/assets/images/CW_%s_legend.png"
),
subThreat_map = case_when(
MajorCat %in% "Habitat" ~ "../src/assets/images/H_%s_map.png",
MajorCat %in% "Exploitation" ~ "../src/assets/images/E_%s_map.png",
MajorCat %in% "Invasive species" ~ "../src/assets/images/IS_%s_map.png",
MajorCat %in% "Pollution" ~ "../src/assets/images/P_%s_map.png",
MajorCat %in% "Climate and weather" ~ "../src/assets/images/CW_%s_map.png"
)
)
}
p2_viz_config,
{
p2_mean_weighted_subThreats |>
select(MajorCat, ThreatCategory) |>
mutate(
# color ramps
pal = case_when(
MajorCat == "Habitat" ~ list(c("#7A562B", "#C7985F", "#E1C8AA")),
MajorCat == "Exploitation" ~ list(c("#B74F49", "#E2B8B6")),
MajorCat == "Invasive species" ~ list(c("#4E6D6E", "#C9D8D9")),
MajorCat == "Pollution" ~ list(c("#002D5E", "#B2C0CE")),
MajorCat == "Climate and weather" ~ list(c("#835192", "#DDCCE2"))
),
# file name templates
threat_legend_raw = "out/%s_legend_raw.png",
threat_legend = "../src/assets/images/%s_legend.png",
threat_map = "../src/assets/images/%s_map.png",
subThreat_legend_raw = case_when(
MajorCat %in% "Habitat" ~ "out/H_%s_legend_raw.png",
MajorCat %in% "Exploitation" ~ "out/E_%s_legend_raw.png",
MajorCat %in% "Invasive species" ~ "out/IS_%s_legend_raw.png",
MajorCat %in% "Pollution" ~ "out/P_%s_legend_raw.png",
MajorCat %in% "Climate and weather" ~ "out/CW_%s_legend_raw.png"
),
subThreat_legend = case_when(
MajorCat %in% "Habitat" ~ "../src/assets/images/H_%s_legend.png",
MajorCat %in% "Exploitation" ~ "../src/assets/images/E_%s_legend.png",
MajorCat %in% "Invasive species" ~ "../src/assets/images/IS_%s_legend.png",
MajorCat %in% "Pollution" ~ "../src/assets/images/P_%s_legend.png",
MajorCat %in% "Climate and weather" ~ "../src/assets/images/CW_%s_legend.png"
),
subThreat_map = case_when(
MajorCat %in% "Habitat" ~ "../src/assets/images/H_%s_map.png",
MajorCat %in% "Exploitation" ~ "../src/assets/images/E_%s_map.png",
MajorCat %in% "Invasive species" ~ "../src/assets/images/IS_%s_map.png",
MajorCat %in% "Pollution" ~ "../src/assets/images/P_%s_map.png",
MajorCat %in% "Climate and weather" ~ "../src/assets/images/CW_%s_map.png"
)
)
}
)
)
p3 <- list(
tar_target(
p3_threat_map_png,
{
final_plot <- threat_map(in_dat = p2_mean_weighted_threats,
threat_category = p2_threat_categories,
threat_pal = p2_viz_config,
hybas_habitat_types = p2_hybas_habitat_types_sf,
proj = p1_proj) +
theme(legend.position = "none")
save_map(type = "threat", plot = final_plot,
threat_category = p2_threat_categories,
subcat_habitat = NA,
subcat_pollution = NA,
subcat_climate = NA,
config_df = p2_viz_config,
height = 6, width = 10, dpi = 300)
},
format = "file",
pattern = p2_threat_categories
),
tar_target(
p3_legend_png,
{
final_plot <- threat_map(in_dat = p2_mean_weighted_threats,
threat_category = p2_threat_categories,
threat_pal = p2_viz_config,
proj = p1_proj,
hybas_habitat_types = p2_hybas_habitat_types_sf)
save_legend(type = "threat", plot = final_plot,
threat_category = p2_threat_categories,
subcat_habitat = NA,
subcat_pollution = NA,
subcat_climate = NA,
in_dat = p2_mean_weighted_threats,
config_df = p2_viz_config,
height = 176, width = 429, unit = "px", dpi = 300)
},
pattern = p2_threat_categories
),
tar_target(
p3_sub_threat_map_png,
{
final_plot <- subThreat_map(in_dat = p2_mean_weighted_subThreats,
threat_category = p2_threat_subcategories,
threat_pal = p2_viz_config,
proj = p1_proj,
hybas_habitat_types = p2_hybas_habitat_types_sf) +
theme(legend.position = "none")
save_map(type = "subThreat", plot = final_plot,
threat_category = p2_threat_subcategories,
subcat_habitat = p2_habitat_subthreats,
subcat_pollution = p2_pollution_subthreats,
subcat_climate = p2_climate_subthreats,
config_df = p2_viz_config,
height = 6, width = 10, dpi = 300)
},
format = "file",
pattern = p2_threat_subcategories
),
tar_target(
p3_sub_threat_legend_png,
{
final_plot <- subThreat_map(in_dat = p2_mean_weighted_subThreats,
threat_category = p2_threat_subcategories,
threat_pal = p2_viz_config,
proj = p1_proj,
hybas_habitat_types = p2_hybas_habitat_types_sf)
save_legend(type = "subThreat", plot = final_plot,
threat_category = p2_threat_subcategories,
subcat_habitat = p2_habitat_subthreats,
subcat_pollution = p2_pollution_subthreats,
subcat_climate = p2_climate_subthreats,
in_dat = p2_mean_weighted_subThreats,
config_df = p2_viz_config,
height = 176, width = 429, unit = "px", dpi = 300)
},
format = "file",
pattern = p2_threat_subcategories
)
#### major threat maps and legends ####
tar_target(
p3_threat_map_png,
{
final_plot <- threat_map(in_dat = p2_mean_weighted_threats,
threat_category = p2_threat_categories,
threat_pal = p2_viz_config,
hybas_habitat_types = p2_hybas_habitat_types_sf,
proj = p1_proj) +
theme(legend.position = "none")
save_map(type = "threat", plot = final_plot,
threat_category = p2_threat_categories,
threat_pal = p2_viz_config,
height = 6, width = 10, dpi = 300)
},
format = "file",
pattern = p2_threat_categories
),
tar_target(
p3_legend_png,
{
final_plot <- threat_map(in_dat = p2_mean_weighted_threats,
threat_category = p2_threat_categories,
threat_pal = p2_viz_config,
proj = p1_proj,
hybas_habitat_types = p2_hybas_habitat_types_sf)
save_legend(type = "threat", plot = final_plot,
threat_category = p2_threat_categories,
in_dat = p2_mean_weighted_threats,
threat_pal = p2_viz_config,
height = 176, width = 429, unit = "px", dpi = 300)
},
pattern = p2_threat_categories
),
#### sub-category treat maps and legends ####
tar_target(
p3_sub_threat_map_png,
{
final_plot <- subThreat_map(in_dat = p2_mean_weighted_subThreats,
threat_category = p2_threat_subcategories,
threat_pal = p2_viz_config,
proj = p1_proj,
hybas_habitat_types = p2_hybas_habitat_types_sf) +
theme(legend.position = "none")
save_map(type = "subThreat", plot = final_plot,
threat_category = p2_threat_subcategories,
threat_pal = p2_viz_config,
height = 6, width = 10, dpi = 300)
},
format = "file",
pattern = p2_threat_subcategories
),
tar_target(
p3_sub_threat_legend_png,
{
final_plot <- subThreat_map(in_dat = p2_mean_weighted_subThreats,
threat_category = p2_threat_subcategories,
threat_pal = p2_viz_config,
proj = p1_proj,
hybas_habitat_types = p2_hybas_habitat_types_sf)
save_legend(type = "subThreat", plot = final_plot,
threat_category = p2_threat_subcategories,
in_dat = p2_mean_weighted_subThreats,
threat_pal = p2_viz_config,
height = 176, width = 429, unit = "px", dpi = 300)
},
format = "file",
pattern = p2_threat_subcategories
)
)
c(p1, p2, p3)
findex/src/data_utils.R
+ 20
− 12
View file @ 7bd719f4
#' @description create shape file with HYBAS IDs and their habitat types
#' @param hybas_04_sf shape file of HYBAS IDs
#' @param hybas_legend dataframe with deifning habitat types
get_hybas_habitat_types <- function (hybas_04_sf, hybas_legend) {
hybas_04_sf |>
select(HYBAS_ID,fmh_cl_smj) |>
......@@ -5,7 +9,10 @@ get_hybas_habitat_types <- function (hybas_04_sf, hybas_legend) {
select(HYBAS_ID, Habitat = MHT_Name)
}
# compute weighted threats
#' @description calculate weighted threat scores
#' @param threat_data dataframe with threat scores
#' @param threat_weights dataframe with weights for each threat type
#' @param hybas_habitat_types shape file with HYBAS IDs and their habitat types
compute_weighted_threats <- function(threat_data, threat_weights,
hybas_habitat_types){
processed_df <- threat_data |>
......@@ -22,10 +29,12 @@ compute_weighted_threats <- function(threat_data, threat_weights,
mutate(weightedThreatMetric = ThreatMetric * Final_Weight)
}
# total threats
#' @description sum weighted threat scores by threat type
#' @param in_dat dataframe with weighted threat scores
#' @param outfile file name and directory for output
compute_total_weighted_threats <- function(in_dat, outfile) {
in_dat |>
group_by(Threat, ThreatCategory) |> #
group_by(Threat, ThreatCategory) |>
summarize(TotalWeightedThreatMetric = sum(weightedThreatMetric, na.rm = TRUE)) |>
select(ThreatCategory, Threat, TotalWeightedThreatMetric) |>
arrange(desc(TotalWeightedThreatMetric)) |>
......@@ -34,29 +43,28 @@ compute_total_weighted_threats <- function(in_dat, outfile) {
return(outfile)
}
# mean threats
#' @description mean weighted threat scores by major threat type and HYBAS_ID
#' @param in_dat dataframe with weighted threat scores
compute_mean_weighted_threats <- function(in_dat){
processed_df <- in_dat |> #
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) |>
unique() |>
arrange(desc(MeanWeightedThreatMetric)) #|>
#readr::write_csv(outfile)
#return(outfile)
arrange(desc(MeanWeightedThreatMetric))
}
# mean sub threats
#' @description mean weighted threat scores by sub threat type and HYBAS_ID
#' @param in_dat dataframe with weighted threat scores
compute_mean_weighted_subThreats <- function(in_dat){
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) |>
rename(MajorCat = ThreatCategory, ThreatCategory = Threat) |>
unique() |>
arrange(desc(MeanWeightedThreatMetric))
......
findex/src/plot_utils.R
+ 55
− 14
View file @ 7bd719f4
#' @description establish ggplot code to create threat maps
#' @param in_dat dataframe with mean weighted threat scores by threat type and HYBAS_ID
#' @param threat_category list of target threat categories
#' @param threat_pal dataframe with color palettes and file name templates by threat type
#' @param hybas_habitat_types shape file with HYBAS IDs and their habitat types
#' @param proj character string with map projection definition
general_threat_map <- function(in_dat, threat_category, threat_pal, hybas_habitat_types, proj){
filtered_df <- in_dat |>
left_join(hybas_habitat_types) |>
......@@ -15,7 +22,6 @@ general_threat_map <- function(in_dat, threat_category, threat_pal, hybas_habita
limits = c(0, max(proj_df$MeanWeightedThreatMetric, na.rm = T)),
na.value = "gray80",
breaks = c(0 + max(proj_df$MeanWeightedThreatMetric, na.rm = T)/10,
#max(habitat_data$MeanWeightedThreatMetric)/2,
max(proj_df$MeanWeightedThreatMetric, na.rm = T) - max(proj_df$MeanWeightedThreatMetric, na.rm = T)/10),
labels = c("Lower", "Higher")
)+
......@@ -40,6 +46,12 @@ general_threat_map <- function(in_dat, threat_category, threat_pal, hybas_habita
return(threat_map)
}
#' @description filter data to target major threat and apply to established ggplot function
#' @param in_dat dataframe with mean weighted threat scores by threat type and HYBAS_ID
#' @param threat_category list of target threat categories
#' @param threat_pal dataframe with color palettes and file name templates by threat type
#' @param hybas_habitat_types shape file with HYBAS IDs and their habitat types
#' @param proj character string with map projection definition
threat_map <- function(in_dat, threat_category, threat_pal, hybas_habitat_types, proj){
pal <- threat_pal |>
......@@ -55,6 +67,12 @@ threat_map <- function(in_dat, threat_category, threat_pal, hybas_habitat_types,
}
#' @description filter data to target sub threat and apply to established ggplot function
#' @param in_dat dataframe with mean weighted threat scores by threat type and HYBAS_ID
#' @param threat_category list of target threat categories
#' @param threat_pal dataframe with color palettes and file name templates by threat type
#' @param hybas_habitat_types shape file with HYBAS IDs and their habitat types
#' @param proj character string with map projection definition
subThreat_map <- function(in_dat, threat_category, threat_pal, proj, hybas_habitat_types){
pal <- threat_pal |>
......@@ -70,6 +88,15 @@ subThreat_map <- function(in_dat, threat_category, threat_pal, proj, hybas_habit
}
#' @description cowplot code to style the legend
#' @param in_dat dataframe with mean weighted threat scores by threat type and HYBAS_ID
#' @param legend_png character string of raw extracted legend file location
#' @param threat_category list of target threat categories
#' @param out_file character string of file name and location to save final legend
#' @param height png height
#' @param width png width
#' @param unit png height and width units
#' @param dpi png dpi
cowplot_legend <- function(in_dat, legend_png, threat_category, out_file, height, width, unit, dpi){
threat_df <- in_dat |>
......@@ -80,7 +107,6 @@ cowplot_legend <- function(in_dat, legend_png, threat_category, out_file, height
# Define colors
background_color = NA
font_color = "#ffffff"
# The background canvas for your viz (DO NOT EDIT)
canvas <- grid::rectGrob(
......@@ -89,10 +115,7 @@ cowplot_legend <- function(in_dat, legend_png, threat_category, out_file, height
gp = grid::gpar(fill = background_color, alpha = 1, col = background_color)
)
# margin for plotting (DO NOT EDIT)
margin = 0.04
# Load in USGS logo (also a black logo available)
# Load raw legend png
legend <- magick::image_read(legend_png)
final_legend <- ggdraw(ylim = c(0,1), # 0-1 scale makes it easy to place viz items on canvas
......@@ -125,15 +148,24 @@ cowplot_legend <- function(in_dat, legend_png, threat_category, out_file, height
lineheight = 0.75,
color = "gray50",
size = 9)
#429x176
ggsave(out_file, final_legend, height = height, width = width, units = unit, dpi = dpi, bg = "transparent")
}
# height = 176, width = 429, unit = "px", dpi = 300
save_legend <- function(type, plot, threat_category, subcat_habitat, subcat_pollution, subcat_climate, in_dat, config_df, height, width, unit, dpi){
#' @description cowplot code to style the legend
#' @param type "threat" or "subThreat"
#' @param plot ggplot map with legend to be saved
#' @param threat_category list of target threat categories
#' @param in_dat dataframe with mean weighted threat scores by threat type and HYBAS_ID
#' @param threat_pal dataframe with color palettes and file name templates by threat type
#' @param height png height
#' @param width png width
#' @param unit png height and width units
#' @param dpi png dpi
save_legend <- function(type, plot, threat_category, in_dat, threat_pal, height, width, unit, dpi){
if(type == "threat"){
name_conv <- config_df |>
name_conv <- threat_pal |>
filter(MajorCat == threat_category)
plot_legend <- get_plot_component(plot, "guide-box-right", return_all = T)
......@@ -152,7 +184,7 @@ save_legend <- function(type, plot, threat_category, subcat_habitat, subcat_poll
return(out_file_final)
} else if(type == "subThreat"){
name_conv <- config_df |>
name_conv <- threat_pal |>
filter(ThreatCategory == threat_category)
plot_legend <- get_plot_component(plot, "guide-box-right", return_all = T)
......@@ -173,10 +205,19 @@ save_legend <- function(type, plot, threat_category, subcat_habitat, subcat_poll
}
}
save_map <- function(type, plot, threat_category, subcat_habitat, subcat_pollution, subcat_climate, config_df, height, width, dpi){
#' @description cowplot code to style the legend
#' @param type "threat" or "subThreat"
#' @param plot ggplot map to be saved
#' @param threat_category list of target threat categories
#' @param threat_pal dataframe with color palettes and file name templates by threat type
#' @param height png height
#' @param width png width
#' @param unit png height and width units
#' @param dpi png dpi
save_map <- function(type, plot, threat_category, threat_pal, height, width, dpi){
if(type == "threat"){
name_conv <- config_df |>
name_conv <- threat_pal |>
filter(MajorCat == threat_category)
out_file <- sprintf(unique(name_conv$threat_map), str_replace_all(threat_category, " ", "_"))
......@@ -185,7 +226,7 @@ save_map <- function(type, plot, threat_category, subcat_habitat, subcat_polluti
plot, height = height, width = width, dpi = dpi)
} else if(type == "subThreat"){
name_conv <- config_df |>
name_conv <- threat_pal |>
filter(ThreatCategory == threat_category)
out_file <- sprintf(unique(name_conv$subThreat_map), str_replace_all(threat_category, " ", "_"))
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment