Skip to content

Commit c7dc933

Browse files
Ovec8hkinOvec8hkin
committed
feat: Highlight specific HCRs in timeseries and performance plots
1 parent 1175af3 commit c7dc933

2 files changed

Lines changed: 520 additions & 82 deletions

File tree

‎R/plotting.R‎

Lines changed: 159 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
plot_ssb <- function(data, v1="hcr", v2=NA, v3=NA, show_est=FALSE, common_trajectory=64, base_hcr="F40"){
1+
plot_ssb <- function(data, v1="hcr", v2=NA, v3=NA, show_est=FALSE, common_trajectory=64, base_hcr="F40", highlight=NULL){
22
group_columns <- colnames(data)
33
group_columns <- group_columns[! group_columns %in% c("sim", "spbio", "biomass")]
44
# Plot spawning biomass from OM and EM
@@ -8,7 +8,16 @@ plot_ssb <- function(data, v1="hcr", v2=NA, v3=NA, show_est=FALSE, common_trajec
88
group_by(across(all_of(group_columns))) %>%
99
median_qi(spbio, .width=c(0.50, 0.80), .simple_names=FALSE) %>%
1010
# Reformat ggdist tibble into long format
11-
reformat_ggdist_long(n=length(group_columns))
11+
reformat_ggdist_long(n=length(group_columns)) %>%
12+
mutate(
13+
color_group = as.character(hcr)
14+
)
15+
16+
if(!is.null(highlight)){
17+
d <- d %>% mutate(
18+
color_group = ifelse(hcr %in% highlight, color_group, "Other")
19+
)
20+
}
1221

1322
hcr1 <- as.character((d %>% pull(hcr) %>% unique)[1])
1423

@@ -19,25 +28,41 @@ plot_ssb <- function(data, v1="hcr", v2=NA, v3=NA, show_est=FALSE, common_trajec
1928

2029
base_hcr_d <- d %>% filter(L1 == "naa", hcr == base_hcr)
2130

31+
colors <- hcr_colors
32+
sizes <- rep(0.85, length(colors))
33+
names(sizes) <- names(colors)
34+
if(!is.null(highlight)){
35+
colors <- hcr_colors[highlight]
36+
colors <- c(colors, "Other" = "grey70")
37+
38+
sizes <- c(rep(1.2, length(highlight)), 0.85)
39+
names(sizes) <- c(highlight, "Other")
40+
}
41+
2242
plot <- ggplot(d %>% filter(L1 == "naa")) +
23-
geom_lineribbon(data = base_hcr_d, aes(x=time, y=median, ymin=lower, ymax=upper, group=.data[[v1]], color=.data[[v1]]), size=0.85)+
24-
geom_line(aes(x=time, y=median, ymin=lower, ymax=upper, group=.data[[v1]], color=.data[[v1]]), size=0.85)+
43+
geom_lineribbon(data = base_hcr_d, aes(x=time, y=median, ymin=lower, ymax=upper, group=.data[[v1]], color=color_group), size=0.85)+
44+
geom_line(aes(x=time, y=median, ymin=lower, ymax=upper, group=.data[[v1]], color=color_group, size=color_group))+
45+
geom_line(
46+
data = d %>% filter(color_group != "Other", time > common_trajectory-1),
47+
aes(x=time, y=median, ymin=lower, ymax=upper, group=.data[[v1]], color=color_group, size=color_group)
48+
)+
2549
geom_line(data = common, aes(x=time, y=median), size=0.85)+
2650
geom_vline(data=common, aes(xintercept=common), linetype="dashed")+
2751
# geom_hline(yintercept=121.4611, linetype="dashed")+
2852
scale_fill_brewer(palette="Blues")+
29-
scale_color_manual(values=hcr_colors)+
53+
scale_color_manual(values=colors)+
54+
scale_size_manual(values=sizes)+
3055
scale_y_continuous(limits=c(0, 500))+
3156
labs(x="Year", y="SSB")+
3257
coord_cartesian(expand=0)+
33-
guides(color=guide_legend(title="Management \n Strategy", nrow=2), fill="none")
58+
guides(color=guide_legend(title="Management \n Strategy", nrow=2), fill="none", size="none")
3459

3560
if(show_est){
3661
plot <- plot + geom_pointrange(data = d %>% filter(L1 == "naa_est"), aes(x=time, y=median, ymin=lower, ymax=upper, color=hcr), alpha=0.35)
3762
}
3863

3964
if(!is.na(v2) && is.na(v3)){
40-
plot <- plot + facet_wrap(~.data[[v2]])+guides(fill="none")
65+
plot <- plot + facet_wrap(vars(.data[[v2]]))+guides(fill="none")
4166
}else if(!is.na(v2) && !is.na(v3)){
4267
plot <- plot + facet_grid(rows=vars(.data[[v2]]), cols=vars(.data[[v3]]))+guides(fill="none")
4368
}
@@ -47,9 +72,9 @@ plot_ssb <- function(data, v1="hcr", v2=NA, v3=NA, show_est=FALSE, common_trajec
4772

4873
plot_relative_ssb <- function(data, v1="hcr", v2=NA, common_trajectory=64, base_hcr="No Fishing"){
4974
group_columns <- colnames(data)
50-
group_columns <- group_columns[! group_columns %in% c("sim", "spbio")]
75+
group_columns <- group_columns[! group_columns %in% c("sim", "spbio", "biomass")]
5176

52-
base_ssb_data <- data %>% filter(hcr == base_hcr)
77+
base_ssb_data <- data %>% filter(hcr == base_hcr, L1 == "spbio")
5378
rel_ssb <- data %>% left_join(base_ssb_data, by=c("time", "sim", "L1", "om"), suffix=c("", ".nofish")) %>%
5479
filter(time > common_trajectory) %>%
5580
mutate(
@@ -147,14 +172,23 @@ plot_recruitment <- function(data, v1="hcr", v2=NA, show_est=FALSE, common_traje
147172
return(plot)
148173
}
149174

150-
plot_landed_catch <- function(data, v1="hcr", v2=NA, v3=NA, by_fleet=FALSE, common_trajectory=64, base_hcr="F40"){
175+
plot_landed_catch <- function(data, v1="hcr", v2=NA, v3=NA, by_fleet=FALSE, common_trajectory=64, base_hcr="F40", highlight=NULL){
151176
group_columns <- colnames(data)
152177
group_columns <- group_columns[! group_columns %in% c("sim", "catch", "total_catch")]
153178

154179
c <- data %>%
155180
group_by(across(all_of(group_columns))) %>%
156181
median_qi(catch, total_catch, .width=c(0.50, 0.80), .simple_names=TRUE) %>%
157-
reformat_ggdist_long(n=length(group_columns))
182+
reformat_ggdist_long(n=length(group_columns)) %>%
183+
mutate(
184+
color_group = as.character(hcr)
185+
)
186+
187+
if(!is.null(highlight)){
188+
c <- c %>% mutate(
189+
color_group = ifelse(hcr %in% highlight, color_group, "Other")
190+
)
191+
}
158192

159193
hcr1 <- as.character((c %>% pull(hcr) %>% unique)[1])
160194
traj_column <- ifelse(is.na(v3), v2, v3)
@@ -170,17 +204,33 @@ plot_landed_catch <- function(data, v1="hcr", v2=NA, v3=NA, by_fleet=FALSE, comm
170204

171205
base_hcr_c <- c %>% filter(hcr == base_hcr)
172206

173-
plot <- ggplot(c %>% left_join(traj, by=traj_column) %>% filter(time > common-1))+
207+
colors <- hcr_colors
208+
sizes <- rep(0.85, length(colors))
209+
names(sizes) <- names(colors)
210+
if(!is.null(highlight)){
211+
colors <- hcr_colors[highlight]
212+
colors <- c(colors, "Other" = "grey70")
213+
214+
sizes <- c(rep(1.2, length(highlight)), 0.85)
215+
names(sizes) <- c(highlight, "Other")
216+
}
217+
218+
plot <- ggplot(c %>% filter(time > common_trajectory-1))+
174219
geom_lineribbon(data = base_hcr_c, aes(x=time, y=median, ymin=lower, ymax=upper, group=.data[[v1]], color=.data[[v1]]), size=0.85)+
175-
geom_line(aes(x=time, y=median, ymin=lower, ymax=upper, group=.data[[v1]], color=.data[[v1]]), size=0.85)+
220+
geom_line(aes(x=time, y=median, ymin=lower, ymax=upper, group=.data[[v1]], color=color_group, size=color_group))+
221+
geom_line(
222+
data = c %>% filter(color_group != "Other", time > common_trajectory-1),
223+
aes(x=time, y=median, ymin=lower, ymax=upper, group=.data[[v1]], color=color_group, size=color_group)
224+
)+
176225
geom_line(data = common, aes(x=time, y=median), size=0.85)+
177226
geom_vline(data=common, aes(xintercept=common), linetype="dashed")+
178227
scale_fill_brewer(palette="Blues")+
179-
scale_color_manual(values=hcr_colors)+
228+
scale_color_manual(values=colors)+
229+
scale_size_manual(values=sizes)+
180230
# scale_y_continuous(limits=c(0, 60))+
181231
labs(x="Year", y="Catch (mt)", color="Management \n Strategy")+
182232
coord_cartesian(expand=0, ylim=c(0, 60))+
183-
guides(color=guide_legend(title="Management \n Strategy", nrow=2), fill="none")
233+
guides(color=guide_legend(title="Management \n Strategy", nrow=2), fill="none", size="none")
184234

185235
if(!is.na(v2) && is.na(v3)){
186236
plot <- plot + facet_wrap(~.data[[v2]])+guides(fill="none")
@@ -196,7 +246,7 @@ plot_landed_catch <- function(data, v1="hcr", v2=NA, v3=NA, by_fleet=FALSE, comm
196246

197247
}
198248

199-
plot_ssb_catch <- function(ssb_data, catch_data, v1="hcr", v2=NA, v3=NA, common_trajectory=64, base_hcr="F40"){
249+
plot_ssb_catch <- function(ssb_data, catch_data, v1="hcr", v2=NA, v3=NA, common_trajectory=64, base_hcr="F40", flip_facet=FALSE, highlight=NULL){
200250

201251
group_columns <- colnames(ssb_data)
202252
group_columns <- group_columns[! group_columns %in% c("sim", "spbio", "biomass")]
@@ -207,7 +257,16 @@ plot_ssb_catch <- function(ssb_data, catch_data, v1="hcr", v2=NA, v3=NA, common_
207257
group_by(across(all_of(group_columns))) %>%
208258
median_qi(spbio, .width=c(0.50, 0.80), .simple_names=FALSE) %>%
209259
# Reformat ggdist tibble into long format
210-
reformat_ggdist_long(n=length(group_columns))
260+
reformat_ggdist_long(n=length(group_columns)) %>%
261+
mutate(
262+
color_group = as.character(hcr)
263+
)
264+
265+
if(!is.null(highlight)){
266+
ssb_d <- ssb_d %>% mutate(
267+
color_group = ifelse(hcr %in% highlight, color_group, "Other")
268+
)
269+
}
211270

212271
hcr1 <- as.character((ssb_d %>% pull(hcr) %>% unique)[1])
213272

@@ -223,7 +282,16 @@ plot_ssb_catch <- function(ssb_data, catch_data, v1="hcr", v2=NA, v3=NA, common_
223282
catch_d <- catch_data %>%
224283
group_by(across(all_of(group_columns))) %>%
225284
median_qi(total_catch, .width=c(0.50, 0.80), .simple_names=TRUE) %>%
226-
reformat_ggdist_long(n=length(group_columns))
285+
reformat_ggdist_long(n=length(group_columns)) %>%
286+
mutate(
287+
color_group = as.character(hcr)
288+
)
289+
290+
if(!is.null(highlight)){
291+
catch_d <- catch_d %>% mutate(
292+
color_group = ifelse(hcr %in% highlight, color_group, "Other")
293+
)
294+
}
227295

228296
hcr1 <- as.character((catch_d %>% pull(hcr) %>% unique)[1])
229297
traj_column <- ifelse(is.na(v3), v2, v3)
@@ -238,25 +306,46 @@ plot_ssb_catch <- function(ssb_data, catch_data, v1="hcr", v2=NA, v3=NA, common_
238306

239307
base_hcr <- d %>% filter(hcr == base_hcr)
240308

309+
colors <- hcr_colors
310+
sizes <- rep(0.85, length(colors))
311+
names(sizes) <- names(colors)
312+
if(!is.null(highlight)){
313+
colors <- hcr_colors[highlight]
314+
colors <- c(colors, "Other" = "grey70")
315+
316+
sizes <- c(rep(1.2, length(highlight)), 0.85)
317+
names(sizes) <- c(highlight, "Other")
318+
}
319+
241320
plot <- ggplot(d) +
242321
geom_line(data = base_hcr, aes(x=time, y=median, group=.data[[v1]], color=.data[[v1]]), size=0.85)+
243-
geom_line(aes(x=time, y=median, group=.data[[v1]], color=.data[[v1]]), size=0.85)+
322+
geom_line(aes(x=time, y=median, group=.data[[v1]], color=color_group, size=color_group))+
323+
geom_line(
324+
data = d %>% filter(color_group != "Other", time > common_trajectory-1),
325+
aes(x=time, y=median, ymin=lower, ymax=upper, group=.data[[v1]], color=color_group, size=color_group)
326+
)+
244327
geom_line(data = common, aes(x=time, y=median), size=0.85)+
245328
geom_vline(data=common, aes(xintercept=common), linetype="dashed")+
246329
# geom_hline(yintercept=121.4611, linetype="dashed")+
247330
scale_fill_brewer(palette="Blues")+
248-
scale_color_manual(values=hcr_colors)+
331+
scale_color_manual(values=colors)+
332+
scale_size_manual(values=sizes)+
249333
# scale_y_continuous(limits=c(0, 320))+
250334
labs(x="Year", y="1000s Metric Tons")+
251335
coord_cartesian(expand=0)+
252-
guides(color=guide_legend("Management \n Strategy", nrow=2), fill="none")+
336+
guides(color=guide_legend("Management \n Strategy", nrow=2), fill="none", size="none")+
253337
facet_grid(rows=vars(L1), cols=vars(.data[[v2]]), scales="free_y")+
254338
ggh4x::facetted_pos_scales(
255339
y = list(
256340
scale_y_continuous(limits=c(0, 60)),
257341
scale_y_continuous(limits=c(0, 500))
258342
)
259343
)
344+
345+
if(flip_facet){
346+
plot <- plot + facet_grid(rows=vars(.data[[v2]]), cols=vars(L1), scales="free_y")
347+
}
348+
260349
return(plot+custom_theme)
261350
}
262351

@@ -572,22 +661,44 @@ plot_mse_summary <- function(model_runs, extra_columns, dem_params, hcr_filter,
572661
return(plot+custom_theme)
573662
}
574663

575-
plot_performance_metric_summary <- function(perf_data, v1="hcr", v2="om", is_relative=FALSE, summary_hcr="F40"){
664+
plot_performance_metric_summary <- function(perf_data, v1="hcr", v2="om", is_relative=FALSE, summary_hcr="F40", highlight=NULL){
576665

577666
metric_minmax = perf_data %>% group_by(name) %>% summarise(min=min(lower), max=max(upper))
578667
axis_scalar <- c(0.9, 1.1)
579668

580669
summary <- perf_data %>% filter(!is.infinite(median), hcr != "No Fishing") %>% summarise(median=mean(median))
581670

671+
perf_data <- perf_data %>% mutate(color_group = as.character(hcr))
672+
if(!is.null(highlight)){
673+
perf_data <- perf_data %>% mutate(
674+
color_group = ifelse(hcr %in% highlight, color_group, "Other")
675+
)
676+
}
677+
# perf_data <- perf_data %>% mutate(color_group = factor(color_group))
678+
679+
# colors <- rank_colors
680+
# if(!is.null(highlight)){
681+
# colors <- rank_colors[highlight]
682+
# colors <- c(colors, "Other" = "grey70")
683+
# }
684+
685+
colors <- rank_colors
686+
if(!is.null(highlight)){
687+
colors <- c(hcr_colors, "Other" = "grey70")
688+
colors <- colors[perf_data$color_group %>% unique]
689+
}
690+
691+
color_var <- ifelse(is.null(highlight), "rank", "color_group")
692+
582693
plot <- ggplot(perf_data)+
583694
geom_vline(data=summary, aes(xintercept = median), color="black")+
584695
scale_shape_discrete()+
585-
scale_color_manual(values=rank_colors)+
696+
scale_color_manual(values=colors)+
586697
# scale_color_manual(values=hcr_colors)+
587698
# facet_wrap(vars(name), scales="free_x")+
588699
labs(y="", x="", shape="OM", color="Performance Order")+
589700
coord_cartesian(expand=0)+
590-
guides(shape="none", color=guide_legend(nrow=1))
701+
guides(shape="none", color=guide_legend(nrow=1))+
591702
theme(
592703
plot.margin = margin(0.25, 1, 0.25, 0.25, "cm"),
593704
panel.spacing.x = unit(5, "cm"),
@@ -597,11 +708,11 @@ plot_performance_metric_summary <- function(perf_data, v1="hcr", v2="om", is_rel
597708

598709
if(is.character(v2)){
599710
plot <- plot +
600-
geom_pointinterval(aes(x=median, xmin=lower, xmax=upper, y=.data[[v1]], color=rank, shape=.data[[v2]]), point_size=3, position="dodge")+
711+
geom_pointinterval(aes(x=median, xmin=lower, xmax=upper, y=.data[[v1]], color=.data[[color_var]], shape=.data[[v2]]), point_size=3, position="dodge")+
601712
facet_grid(rows=vars(.data[[v2]]), cols=vars(name), scales="free_x")
602713
}else{
603714
plot <- plot +
604-
geom_pointinterval(aes(x=median, xmin=lower, xmax=upper, y=.data[[v1]], color=rank), point_size=3, position="dodge")+
715+
geom_pointinterval(aes(x=median, xmin=lower, xmax=upper, y=.data[[v1]], color=.data[[color_var]]), point_size=3, position="dodge")+
605716
facet_wrap(~name, scales="free_x")
606717
}
607718

@@ -624,7 +735,7 @@ plot_performance_metric_summary <- function(perf_data, v1="hcr", v2="om", is_rel
624735
scale_x_continuous(limits=c(0, 1.25)),
625736
scale_x_continuous(limits=c(0, 3.5)),
626737
scale_x_continuous(limits=c(0, 2)),
627-
scale_x_continuous(limits=c(0.75, 2.5)),
738+
scale_x_continuous(limits=c(0, 1.25)),
628739
scale_x_continuous(limits=c(0.5, 1.25))
629740
)
630741
)
@@ -747,10 +858,10 @@ set_hcr_colors <- function(hcrs){
747858

748859
set_hcr_colors2 <- function(hcrs){
749860
hcr_colors <- c(
750-
"F40" = "#E31C39",
861+
"F40" = "black",
751862
"F50" = "#EA8115",
752863
"B40/F50" = "#1C39E3",
753-
"No Fishing" = "#000000",
864+
"No Fishing" = "#E31C39",
754865
"F40 +/- 5%" = "#30AF6C",
755866
"F40 +/- 10%" = "#8115EA",
756867
"15k Harvest Cap" = "#29C1D6",
@@ -763,7 +874,7 @@ set_hcr_colors2 <- function(hcrs){
763874
}
764875

765876

766-
rank_colors <- c(
877+
rank_colors_small <- c(
767878
"#D55E00",
768879
"#FF740A",
769880
"#FF8B33",
@@ -777,6 +888,24 @@ rank_colors <- c(
777888
"#0072B2"
778889
)
779890

891+
rank_colors_large <- c(
892+
"#8F3E00",
893+
"#B85000",
894+
"#D55E00",
895+
"#FF740A",
896+
"#FF8B33",
897+
"#FFA35C",
898+
"#FFBA85",
899+
"#AAAAAA",
900+
"#5CC3FF",
901+
"#33B4FF",
902+
"#0AA5FF",
903+
"#008EE0",
904+
"#0072B2",
905+
"#005A8F",
906+
"#004166"
907+
)
908+
780909
custom_theme <- ggplot2::theme_bw()+ggplot2::theme(
781910
panel.spacing.y = ggplot2::unit(0.5, "cm"),
782911
panel.grid.minor = ggplot2::element_blank(),

0 commit comments

Comments
 (0)