Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
E
earth-in-flux
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Water Mission Area
VizLab
earth-in-flux
Commits
18dc9562
Commit
18dc9562
authored
1 month ago
by
Vaarre-Lamoureux, Kaysa S
Browse files
Options
Downloads
Patches
Plain Diff
create legend and map save functions
parent
3d4364bf
No related branches found
No related tags found
1 merge request
!86
Findex global maps
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
findex/_targets.R
+29
-66
29 additions, 66 deletions
findex/_targets.R
findex/src/plot_utils.R
+136
-77
136 additions, 77 deletions
findex/src/plot_utils.R
with
165 additions
and
143 deletions
findex/_targets.R
+
29
−
66
View file @
18dc9562
...
...
@@ -145,21 +145,23 @@ p3 <- list(
p3_threat_map_png
,
{
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
)
+
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"
)
out_file
<-
paste0
(
"../src/assets/images/"
,
str_replace_all
(
p2_threat_categories
,
" "
,
"_"
),
"_map.png"
)
ggsave
(
out_file
,
final_plot
,
height
=
6
,
width
=
10
,
dpi
=
300
)
save_map
(
type
=
"threat"
,
plot
=
final_plot
,
threat_category
=
p2_threat_categories
,
subcat_habitat
=
NA
,
subcat_pollution
=
NA
,
subcat_climate
=
NA
)
},
format
=
"file"
,
pattern
=
p2_threat_categories
),
tar_target
(
tar_target
(
# will turn this into a function
p3_legend_png
,
{
final_plot
<-
threat_map
(
in_dat
=
p2_mean_weighted_threats
,
...
...
@@ -168,21 +170,16 @@ p3 <- list(
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
(
"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
)
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
)
},
pattern
=
p2_threat_categories
),
tar_target
(
# will turn this into a function
tar_target
(
p3_sub_threat_map_png
,
{
final_plot
<-
subThreat_map
(
in_dat
=
p2_mean_weighted_subThreats
,
...
...
@@ -195,20 +192,11 @@ p3 <- list(
hybas_habitat_types
=
p2_hybas_habitat_types_sf
)
+
theme
(
legend.position
=
"none"
)
if
(
p2_threat_subcategories
%in%
p2_habitat_subthreats
){
out_file
<-
paste0
(
"../src/assets/images/H_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_map.png"
)
}
else
if
(
p2_threat_subcategories
%in%
p2_pollution_subthreats
){
out_file
<-
paste0
(
"../src/assets/images/P_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_map.png"
)
}
else
if
(
p2_threat_subcategories
==
"Overfishing"
){
out_file
<-
paste0
(
"../src/assets/images/E_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_map.png"
)
}
else
if
(
p2_threat_subcategories
==
"Invasive non-native species"
){
out_file
<-
paste0
(
"../src/assets/images/IS_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_map.png"
)
}
else
if
(
p2_threat_subcategories
%in%
p2_climate_subthreats
){
out_file
<-
paste0
(
"../src/assets/images/CW_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_map.png"
)
}
ggsave
(
out_file
,
final_plot
,
height
=
6
,
width
=
10
,
dpi
=
300
)
save_map
(
type
=
"threat"
,
plot
=
final_plot
,
threat_category
=
p2_threat_subcategories
,
subcat_habitat
=
p2_habitat_subthreats
,
subcat_pollution
=
p2_pollution_subthreats
,
subcat_climate
=
p2_climate_subthreats
)
},
format
=
"file"
,
pattern
=
p2_threat_subcategories
...
...
@@ -225,37 +213,12 @@ p3 <- list(
proj
=
p1_proj
,
hybas_habitat_types
=
p2_hybas_habitat_types_sf
)
plot_legend
<-
get_plot_component
(
final_plot
,
"guide-box-right"
,
return_all
=
T
)
if
(
p2_threat_subcategories
%in%
p2_habitat_subthreats
){
out_file
<-
paste0
(
"out/H_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_legend_raw.png"
)
}
else
if
(
p2_threat_subcategories
%in%
p2_pollution_subthreats
){
out_file
<-
paste0
(
"out/P_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_legend_raw.png"
)
}
else
if
(
p2_threat_subcategories
==
"Overfishing"
){
out_file
<-
paste0
(
"out/E_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_legend_raw.png"
)
}
else
if
(
p2_threat_subcategories
==
"Invasive non-native species"
){
out_file
<-
paste0
(
"out/IS_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_legend_raw.png"
)
}
else
if
(
p2_threat_subcategories
%in%
p2_climate_subthreats
){
out_file
<-
paste0
(
"out/CW_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_legend_raw.png"
)
}
ggsave
(
out_file
,
plot_legend
,
dpi
=
300
,
bg
=
"transparent"
)
knitr
::
plot_crop
(
out_file
)
if
(
p2_threat_subcategories
%in%
p2_habitat_subthreats
){
out_file_final
<-
paste0
(
"../src/assets/images/H_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_legend.png"
)
}
else
if
(
p2_threat_subcategories
%in%
p2_pollution_subthreats
){
out_file_final
<-
paste0
(
"../src/assets/images/P_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_legend.png"
)
}
else
if
(
p2_threat_subcategories
==
"Overfishing"
){
out_file_final
<-
paste0
(
"../src/assets/images/E_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_legend.png"
)
}
else
if
(
p2_threat_subcategories
==
"Invasive non-native species"
){
out_file_final
<-
paste0
(
"../src/assets/images/IS_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_legend.png"
)
}
else
if
(
p2_threat_subcategories
%in%
p2_climate_subthreats
){
out_file_final
<-
paste0
(
"../src/assets/images/CW_"
,
str_replace_all
(
p2_threat_subcategories
,
" "
,
"_"
),
"_legend.png"
)
}
cowplot_legend
(
in_dat
=
p2_mean_weighted_subThreats
,
legend_png
=
out_file
,
threat_category
=
p2_threat_subcategories
,
out_file
=
out_file_final
)
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
)
},
format
=
"file"
,
pattern
=
p2_threat_subcategories
...
...
This diff is collapsed.
Click to expand it.
findex/src/plot_utils.R
+
136
−
77
View file @
18dc9562
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
()
proj_df
<-
st_transform
(
filtered_df
,
crs
=
st_crs
(
proj
))
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
=
proj_df
,
aes
(
geometry
=
Shape
,
fill
=
MeanWeightedThreatMetric
,
color
=
MeanWeightedThreatMetric
))
+
scale_fill_gradientn
(
colors
=
colorRampPalette
(
c
(
rev
(
unlist
(
pal
))))(
100
),
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"
)
)
+
scale_color_gradientn
(
colors
=
colorRampPalette
(
c
(
rev
(
unlist
(
pal
))))(
100
),
na.value
=
"gray80"
)
+
guides
(
color
=
"none"
)
+
guides
(
fill
=
guide_colorbar
(
title
=
"Mean Threat"
,
title.position
=
"top"
,
direction
=
"horizontal"
,
barwidth
=
7
,
barheight
=
1
))
+
theme_void
()
+
theme
(
#legend.position = c(0.1, 0.21),
legend.ticks
=
element_blank
(),
legend.title
=
element_text
(
face
=
"bold"
),
legend.text
=
element_text
(
size
=
11
)
)
return
(
threat_map
)
}
subThreat_map
<-
function
(
in_dat
,
threat_category
,
threat_pal
,
subcat_habitat
,
subcat_pollution
,
subcat_climate
,
proj
,
hybas_habitat_types
){
general_threat_map
<-
function
(
in_dat
,
threat_category
,
threat_pal
,
hybas_habitat_types
,
proj
){
filtered_df
<-
in_dat
|>
left_join
(
hybas_habitat_types
)
|>
st_as_sf
()
|>
...
...
@@ -65,22 +8,10 @@ subThreat_map <- function(in_dat, threat_category, threat_pal, subcat_habitat, s
proj_df
<-
st_transform
(
filtered_df
,
crs
=
st_crs
(
proj
))
if
(
threat_category
%in%
subcat_habitat
){
pal
<-
threat_pal
$
Habitat_pal
}
else
if
(
threat_category
%in%
subcat_pollution
){
pal
<-
threat_pal
$
Pollution_pal
}
else
if
(
threat_category
==
"Overfishing"
){
pal
<-
threat_pal
$
Exploitation_pal
}
else
if
(
threat_category
==
"Invasive non-native species"
){
pal
<-
threat_pal
$
Invasive_pal
}
else
if
(
threat_category
%in%
subcat_climate
){
pal
<-
threat_pal
$
Climate_pal
}
threat_map
<-
ggplot
()
+
geom_sf
(
data
=
proj_df
,
aes
(
geometry
=
Shape
,
fill
=
MeanWeightedThreatMetric
,
color
=
MeanWeightedThreatMetric
))
+
scale_fill_gradientn
(
colors
=
colorRampPalette
(
c
(
rev
(
unlist
(
pal
))))(
100
),
colors
=
colorRampPalette
(
c
(
rev
(
unlist
(
threat_
pal
))))(
100
),
limits
=
c
(
0
,
max
(
proj_df
$
MeanWeightedThreatMetric
,
na.rm
=
T
)),
na.value
=
"gray80"
,
breaks
=
c
(
0
+
max
(
proj_df
$
MeanWeightedThreatMetric
,
na.rm
=
T
)
/
10
,
...
...
@@ -89,7 +20,7 @@ subThreat_map <- function(in_dat, threat_category, threat_pal, subcat_habitat, s
labels
=
c
(
"Lower"
,
"Higher"
)
)
+
scale_color_gradientn
(
colors
=
colorRampPalette
(
c
(
rev
(
unlist
(
pal
))))(
100
),
colors
=
colorRampPalette
(
c
(
rev
(
unlist
(
threat_
pal
))))(
100
),
na.value
=
"gray80"
)
+
guides
(
color
=
"none"
)
+
...
...
@@ -107,12 +38,53 @@ subThreat_map <- function(in_dat, threat_category, threat_pal, subcat_habitat, s
)
return
(
threat_map
)
}
threat_map
<-
function
(
in_dat
,
threat_category
,
threat_pal
,
hybas_habitat_types
,
proj
){
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
}
final_plot
<-
general_threat_map
(
in_dat
=
in_dat
,
threat_category
=
threat_category
,
threat_pal
=
pal
,
hybas_habitat_types
=
hybas_habitat_types
,
proj
=
proj
)
}
# in_dat = p2_mean_weighted_threats, legend_png = p3_legend_png, threat_category = threat_cat
## note about out_file - need to find a way to save the cowplot version of the legend without crowding the images folder
## maybe by saving the initial legend png in the findex out folder and then saving
## the cowplot version to the earth-in-flux parent directory "src/assets/images/" folder
subThreat_map
<-
function
(
in_dat
,
threat_category
,
threat_pal
,
subcat_habitat
,
subcat_pollution
,
subcat_climate
,
proj
,
hybas_habitat_types
){
# establish palette
if
(
threat_category
%in%
subcat_habitat
){
pal
<-
threat_pal
$
Habitat_pal
}
else
if
(
threat_category
%in%
subcat_pollution
){
pal
<-
threat_pal
$
Pollution_pal
}
else
if
(
threat_category
==
"Overfishing"
){
pal
<-
threat_pal
$
Exploitation_pal
}
else
if
(
threat_category
==
"Invasive non-native species"
){
pal
<-
threat_pal
$
Invasive_pal
}
else
if
(
threat_category
%in%
subcat_climate
){
pal
<-
threat_pal
$
Climate_pal
}
final_plot
<-
general_threat_map
(
in_dat
=
in_dat
,
threat_category
=
threat_category
,
threat_pal
=
pal
,
hybas_habitat_types
=
hybas_habitat_types
,
proj
=
proj
)
}
cowplot_legend
<-
function
(
in_dat
,
legend_png
,
threat_category
,
out_file
){
threat_df
<-
in_dat
|>
...
...
@@ -170,4 +142,91 @@ cowplot_legend <- function(in_dat, legend_png, threat_category, out_file){
size
=
9
)
#429x176
ggsave
(
out_file
,
final_legend
,
height
=
176
,
width
=
429
,
units
=
"px"
,
dpi
=
300
,
bg
=
"transparent"
)
}
\ No newline at end of file
}
# plot = final_plot, in_dat = p2_mean_weighted_threats
save_legend
<-
function
(
type
,
plot
,
threat_category
,
subcat_habitat
,
subcat_pollution
,
subcat_climate
,
in_dat
){
if
(
type
==
"threat"
){
plot_legend
<-
get_plot_component
(
plot
,
"guide-box-right"
,
return_all
=
T
)
out_file
<-
paste0
(
"out/"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_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
(
threat_category
,
" "
,
"_"
),
"_legend.png"
)
cowplot_legend
(
in_dat
=
in_dat
,
legend_png
=
out_file
,
threat_category
=
threat_category
,
out_file
=
out_file_final
)
return
(
out_file_final
)
}
else
if
(
type
==
"subThreat"
){
plot_legend
<-
get_plot_component
(
plot
,
"guide-box-right"
,
return_all
=
T
)
if
(
threat_category
%in%
subcat_habitat
){
out_file
<-
paste0
(
"out/H_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_legend_raw.png"
)
}
else
if
(
threat_category
%in%
subcat_pollution
){
out_file
<-
paste0
(
"out/P_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_legend_raw.png"
)
}
else
if
(
threat_category
==
"Overfishing"
){
out_file
<-
paste0
(
"out/E_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_legend_raw.png"
)
}
else
if
(
threat_category
==
"Invasive non-native species"
){
out_file
<-
paste0
(
"out/IS_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_legend_raw.png"
)
}
else
if
(
threat_category
%in%
subcat_climate
){
out_file
<-
paste0
(
"out/CW_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_legend_raw.png"
)
}
ggsave
(
out_file
,
plot_legend
,
dpi
=
300
,
bg
=
"transparent"
)
knitr
::
plot_crop
(
out_file
)
if
(
threat_category
%in%
subcat_habitat
){
out_file_final
<-
paste0
(
"../src/assets/images/H_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_legend.png"
)
}
else
if
(
threat_category
%in%
subcat_pollution
){
out_file_final
<-
paste0
(
"../src/assets/images/P_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_legend.png"
)
}
else
if
(
threat_category
==
"Overfishing"
){
out_file_final
<-
paste0
(
"../src/assets/images/E_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_legend.png"
)
}
else
if
(
threat_category
==
"Invasive non-native species"
){
out_file_final
<-
paste0
(
"../src/assets/images/IS_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_legend.png"
)
}
else
if
(
threat_category
%in%
subcat_climate
){
out_file_final
<-
paste0
(
"../src/assets/images/CW_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_legend.png"
)
}
cowplot_legend
(
in_dat
=
in_dat
,
legend_png
=
out_file
,
threat_category
=
threat_category
,
out_file
=
out_file_final
)
return
(
out_file_final
)
}
}
save_map
<-
function
(
type
,
plot
,
threat_category
,
subcat_habitat
,
subcat_pollution
,
subcat_climate
){
if
(
type
==
"threat"
){
out_file
<-
paste0
(
"../src/assets/images/"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_map.png"
)
ggsave
(
out_file
,
plot
,
height
=
6
,
width
=
10
,
dpi
=
300
)
}
else
if
(
type
==
"subThreat"
){
if
(
threat_category
%in%
subcat_habitat
){
out_file
<-
paste0
(
"../src/assets/images/H_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_map.png"
)
}
else
if
(
threat_category
%in%
subcat_pollution
){
out_file
<-
paste0
(
"../src/assets/images/P_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_map.png"
)
}
else
if
(
threat_category
==
"Overfishing"
){
out_file
<-
paste0
(
"../src/assets/images/E_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_map.png"
)
}
else
if
(
threat_category
==
"Invasive non-native species"
){
out_file
<-
paste0
(
"../src/assets/images/IS_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_map.png"
)
}
else
if
(
threat_category
%in%
subcat_climate
){
out_file
<-
paste0
(
"../src/assets/images/CW_"
,
str_replace_all
(
threat_category
,
" "
,
"_"
),
"_map.png"
)
}
ggsave
(
out_file
,
plot
,
height
=
6
,
width
=
10
,
dpi
=
300
)
}
}
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment