#' Merge the run data into individual data frames for easy processing
#'
#' @param sim_data simulated data from the OM
#' @param short_term_yrs Years included in short term plots
#' @param long_term_yrs Years greater than this will be in long term plots
#' @param quants Quantiles to calculate for plotting output [data.frame]s
#' @param catch_multiplier Value to multiply all catch calculations by
#' @param ... Absorbs extra parameters
#'
#' @return List of many outputs from the MSE
#'
#' @export
merge_run_data <- function(sim_data = NULL,
short_term_yrs = NULL,
long_term_yrs = NULL,
quants = c(0.025, 0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95, 0.975),
catch_multiplier = 1e-6,
...){
if(is.null(short_term_yrs)){
stop("You must supply the short_term_yrs vector", call. = FALSE)
}
if(is.null(long_term_yrs)){
stop("You must supply the long_term_yrs start year value", call. = FALSE)
}
if(max(sim_data[[1]]$future_yrs) < max(short_term_yrs)){
stop("The maximum year in the simulation (", max(sim_data[[1]]$future_yrs), ") is less than the last term year (", max(short_term_yrs), ")",
call. = FALSE)
}
if(max(sim_data[[1]]$future_yrs) < long_term_yrs){
stop("The maximum year in the simulation (", max(sim_data[[1]]$future_yrs), ") is less than the long term year (", long_term_yrs, ")",
call. = FALSE)
}
yrs <- sim_data[[1]]$yrs
min_yr <- min(yrs)
nyrs <- length(yrs)
simyears <- nyrs - (length(min_yr:short_term_yrs[1])) + 1
nruns <- length(sim_data)
out <- list()
# ssb_plot ------------------------------------------------------------------
out$ssb_plot <- map2(sim_data, seq_along(sim_data), ~{
data.frame(year = yrs,
ssb = rowSums(.x$ssb_all[, , 1]) / sum(.x$ssb_0),
run = .y)
}) %>%
map_df(~{.x}) %>%
as_tibble()
# ssb_mid_plot --------------------------------------------------------------
out$ssb_mid_plot <- map2(sim_data, seq_along(sim_data), ~{
data.frame(year = yrs,
ssb = rowSums(.x$ssb_all[ , , 3]) / sum(.x$ssb_0),
run = .y)
}) %>%
map_df(~{.x}) %>%
as_tibble()
# ssb_ssb0_quant ------------------------------------------------------------
out$ssb_ssb0_quant <- calc_quantiles_by_group(out$ssb_plot,
"year",
"ssb",
probs = quants)
out$ssb_ssb0_mid_quant <- calc_quantiles_by_group(out$ssb_mid_plot,
"year",
"ssb",
probs = quants)
# ssb_mid_space--------------------------------------------------------------
out$ssb_mid_space <- map2(sim_data, seq_along(sim_data), ~{
yrs <- as.numeric(rownames(.x$ssb_all[ , , 3]))
.x$ssb_all[ , , 3] %>%
as_tibble() %>%
mutate(run = .y, year = yrs) %>%
select(year, everything())
}) %>%
map_df(~{.x})
# ssb_mid_ca ----------------------------------------------------------------
out$ssb_mid_ca <- out$ssb_mid_space %>%
select(year, `1`, run) %>%
rename(ssb = `1`)
# ssb_mid_ca_quant ----------------------------------------------------------
out$ssb_mid_ca_quant <- out$ssb_mid_ca %>%
calc_quantiles_by_group("year", "ssb", probs = quants)
# ssb_mid_us ----------------------------------------------------------------
out$ssb_mid_us <- out$ssb_mid_space %>%
select(year, `2`, run) %>%
rename(ssb = `2`)
# ssb_mid_us_quant ----------------------------------------------------------
out$ssb_mid_us_quant <- out$ssb_mid_us %>%
calc_quantiles_by_group("year", "ssb", probs = quants)
# ssb_space -----------------------------------------------------------------
out$ssb_space <- map2(sim_data, seq_along(sim_data), ~{
yrs <- as.numeric(rownames(.x$ssb_all[ , , 1]))
.x$ssb_all[ , , 1] %>%
as_tibble() %>%
mutate(run = .y, year = yrs) %>%
select(year, everything())
}) %>%
map_df(~{.x})
# ssb_all -------------------------------------------------------------------
out$ssb_all <- out$ssb_space %>%
mutate(ssb = `1` + `2`) %>%
select(year, ssb, run)
# ssb_all_mid ---------------------------------------------------------------
out$ssb_mid_all <- out$ssb_mid_space %>%
mutate(ssb = `1` + `2`) %>%
select(year, ssb, run)
# ssb_all_quant -------------------------------------------------------------
out$ssb_all_quant <- out$ssb_all %>%
calc_quantiles_by_group("year", "ssb", probs = quants)
# ssb_mid_quant -------------------------------------------------------------
out$ssb_mid_quant <- out$ssb_mid_all %>%
calc_quantiles_by_group("year", "ssb", probs = quants)
# ssb_ca --------------------------------------------------------------------
out$ssb_ca <- out$ssb_space %>%
select(year, `1`, run) %>%
rename(ssb = `1`)
# ssb_ca_quant --------------------------------------------------------------
out$ssb_ca_quant <- out$ssb_ca %>%
calc_quantiles_by_group("year", "ssb", probs = quants)
# ssb_us --------------------------------------------------------------------
out$ssb_us <- out$ssb_space %>%
select(year, `2`, run) %>%
rename(ssb = `2`)
# ssb_us_quant --------------------------------------------------------------
out$ssb_us_quant <- out$ssb_us %>%
calc_quantiles_by_group("year", "ssb", probs = quants)
# v_ca_plot -----------------------------------------------------------------
# Vulnerable biomass at mid-year start of season 3 for each country
out$v_ca_plot <- map2(sim_data, seq_along(sim_data), ~{
data.frame(year = yrs,
v = .x$v_save[,1,3],
run = .y)
}) %>%
map_df(~{.x}) %>%
as_tibble()
# v_us_plot -----------------------------------------------------------------
out$v_us_plot <- map2(sim_data, seq_along(sim_data), ~{
data.frame(year = yrs,
v = .x$v_save[,2,3],
run = .y)
}) %>%
map_df(~{.x}) %>%
as_tibble()
# f0_plot -------------------------------------------------------------------
out$f0_plot <- map2(sim_data, seq_along(sim_data), ~{
yrs <- rownames(.x$f_out_save)
apply(.x$f_out_save, c(1, 3), sum) %>%
as_tibble() %>%
mutate(run = .y) %>%
mutate(year = yrs) %>%
select(year, everything())
}) %>%
map_df(~{.x})
# f0_ca_plot-----------------------------------------------------------------
out$f0_ca_plot <- out$f0_plot %>%
select(-`2`) %>%
rename(f = `1`)
# f0_us_plot ----------------------------------------------------------------
out$f0_us_plot <- out$f0_plot %>%
select(-`1`) %>%
rename(f = `2`)
# f0_ca_quant ---------------------------------------------------------------
out$f0_ca_quant <- calc_quantiles_by_group(out$f0_ca_plot,
"year",
"f",
probs = quants)
# f0_us_quant ---------------------------------------------------------------
out$f0_us_quant <- calc_quantiles_by_group(out$f0_us_plot,
"year",
"f",
probs = quants)
# catch_for_aav -------------------------------------------------------------
out$catch_for_aav <- map2(sim_data, seq_along(sim_data), ~{
apply(.x$catch_save_age, MARGIN = 2, FUN = sum) %>%
as_tibble() %>%
mutate(year = .x$yrs, run = .y) %>%
rename(catch = value) %>%
select(year, everything())
#mutate(run = .y) %>%
}) %>%
bind_rows()
# catch_plot ----------------------------------------------------------------
out$catch_obs_plot <- map2(sim_data, seq_along(sim_data), ~{
.x$catch_obs <- cbind(.x$catch_obs, rep(.y, nrow(.x$catch_obs)))
colnames(.x$catch_obs) <- c("year", "catch", "run")
.x$catch_obs
})
out$catch_obs_plot <- do.call(rbind, out$catch_obs_plot) %>%
as_tibble()
out$catch_plot <- map2(sim_data, seq_along(sim_data), ~{
.x$catch %>%
as_tibble() %>%
rename(catch = 1) %>%
mutate(year = .x$yrs) %>%
mutate(run = .y) %>%
select(year, catch, run)
}) %>%
map_df(~{.x}) %>%
as_tibble()
# catch_quants --------------------------------------------------------------
out$catch_quant <- calc_quantiles_by_group(out$catch_plot,
"year",
"catch",
probs = quants)
out$catch_obs_quant <- calc_quantiles_by_group(out$catch_obs_plot,
"year",
"catch",
probs = quants)
# catch_country ----------------------------------------------------------------
out$catch_country <- map2(sim_data, seq_along(sim_data), ~{
.x$catch_country %>%
as_tibble() %>%
rename(catch_ca = space1, catch_us = space2) %>%
mutate(run = .y) %>%
select(year, catch_ca, catch_us, run)
}) %>%
map_df(~{.x}) %>%
as_tibble()
# catch_ca ------------------------------------------------------------------
out$catch_ca <- out$catch_country %>%
as_tibble() %>%
select(year, catch_ca, run) %>%
rename(catch = catch_ca)
# catch_ca_quant ------------------------------------------------------------
out$catch_ca_quant <- out$catch_ca %>%
calc_quantiles_by_group("year", "catch", probs = quants)
# catch_us ------------------------------------------------------------------
out$catch_us <- out$catch_country %>%
as_tibble() %>%
select(year, catch_us, run) %>%
rename(catch = catch_us)
# catch_us_quant ------------------------------------------------------------
out$catch_us_quant <- out$catch_us %>%
calc_quantiles_by_group("year", "catch", probs = quants)
# conv_am function ----------------------------------------------------------
# TODO: Need to check generation of age_comps_catch_space because there are no age 15's they are NA!!
# sim_data[[1]]$age_comps_catch_space[,,1]
conv_am <- function(space, sim_age_comp_type = "catch"){
if(!sim_age_comp_type %in% c("catch", "surv", "om")){
stop("sim_age_comp_type must be catch, surv, or om", call. = FALSE)
}
if(space != 0 && space != 1 && space != 2){
stop("space must be 0, 1, or 2", call. = FALSE)
}
# TODO: This code is all correct, but the space age_comps_catch_space[,,1], age_comps_catch_space[,,2],
# age_comps_surv_space[,,1], age_comps_surv_space[,,2] are fully populated when I think they should
# have NAs for non-data years. Populated correctly is age_comps_catch and age_comps_surv
if(sim_age_comp_type == "catch"){
if(space == 1){
x <- map_df(seq_len(nruns), ~{
calc_mean_age(sim_data[[.x]]$age_comps_catch_space[, , 1], sim_data[[.x]]$age_max_age)
})
}else if(space == 2){
x <- map_df(seq_len(nruns), ~{
calc_mean_age(sim_data[[.x]]$age_comps_catch_space[, , 2], sim_data[[.x]]$age_max_age)
})
}else{
x <- map_df(seq_len(nruns), ~{
calc_mean_age(sim_data[[.x]]$age_comps_catch, sim_data[[.x]]$age_max_age)
})
}
}else if(sim_age_comp_type == "surv"){
if(space == 1){
x <- map_df(seq_len(nruns), ~{
calc_mean_age(sim_data[[.x]]$age_comps_surv_space[, , 1], sim_data[[.x]]$age_max_age)
})
}else if(space == 2){
x <- map_df(seq_len(nruns), ~{
calc_mean_age(sim_data[[.x]]$age_comps_surv_space[, , 2], sim_data[[.x]]$age_max_age)
})
}else{
x <- map_df(seq_len(nruns), ~{
calc_mean_age(sim_data[[.x]]$age_comps_surv, sim_data[[.x]]$age_max_age)
})
}
}else{
if(space == 1){
x <- map_df(seq_len(nruns), ~{
calc_mean_age(sim_data[[.x]]$age_comps_om[, , 1, 3], sim_data[[.x]]$age_max_age)
})
}else if(space == 2){
x <- map_df(seq_len(nruns), ~{
calc_mean_age(sim_data[[.x]]$age_comps_om[, , 2, 3], sim_data[[.x]]$age_max_age)
})
}else{
x <- map_df(seq_len(nruns), ~{
calc_mean_age(apply(sim_data[[.x]]$age_comps_om[, , , 3], c(1, 2), sum), sim_data[[.x]]$age_max_age)
})
}
}
x <- x %>%
t() %>%
as_tibble(.name_repair = ~ as.character(1:nruns)) %>%
mutate(yr = yrs)
names(x) <- c(1:nruns, "yr")
x %>%
select(yr, everything())
}
# Average age in population -------------------------------------------------
out$aap_tot <- conv_am(0, "om")
out$aap_tot_quant <- melt(out$aap_tot, id.vars = "yr") %>%
as_tibble() %>%
set_names(c("year", "run", "val"))
out$aap_tot_quant <- calc_quantiles_by_group(out$aap_tot_quant,
"year",
"val",
probs = quants)
# Average age in population for Canada --------------------------------------
out$aap_ca <- conv_am(1, "om")
out$aap_ca_quant <- melt(out$aap_ca, id.vars = "yr") %>%
as_tibble() %>%
set_names(c("year", "run", "val"))
out$aap_ca_quant <- calc_quantiles_by_group(out$aap_ca_quant,
"year",
"val",
probs = quants)
# Average age in population for the US --------------------------------------
out$aap_us <- conv_am(2, "om")
out$aap_us_quant <- melt(out$aap_us, id.vars = "yr") %>%
as_tibble() %>%
set_names(c("year", "run", "val"))
out$aap_us_quant <- calc_quantiles_by_group(out$aap_us_quant,
"year",
"val",
probs = quants)
# amc_tot_quant -------------------------------------------------------------
out$amc_tot <- conv_am(0)
out$amc_tot_quant <- melt(out$amc_tot, id.vars = "yr") %>%
as_tibble() %>%
set_names(c("year", "run", "val"))
out$amc_tot_quant <- calc_quantiles_by_group(out$amc_tot_quant,
"year",
"val",
probs = quants)
# amc_ca_quant --------------------------------------------------------------
out$amc_ca <- conv_am(1)
out$amc_ca_quant <- melt(out$amc_ca, id.vars = "yr") %>%
as_tibble() %>%
set_names(c("year", "run", "val"))
out$amc_ca_quant <- calc_quantiles_by_group(out$amc_ca_quant,
"year",
"val",
probs = quants)
# amc_us_quant --------------------------------------------------------------
out$amc_us <- conv_am(2)
out$amc_us_quant <- melt(out$amc_us, id.vars = "yr") %>%
as_tibble() %>%
set_names(c("year", "run", "val"))
out$amc_us_quant <- calc_quantiles_by_group(out$amc_us_quant,
"year",
"val",
probs = quants)
# ams_tot_quant -------------------------------------------------------------
out$ams_tot <- conv_am(0, "surv")
out$ams_tot_quant <- melt(out$ams_tot, id.vars = "yr") %>%
as_tibble() %>%
set_names(c("year", "run", "val"))
out$ams_tot_quant <- calc_quantiles_by_group(out$ams_tot_quant,
"year",
"val",
probs = quants)
# ams_ca_quant --------------------------------------------------------------
out$ams_ca <- conv_am(1, "surv")
out$ams_ca_quant <- melt(out$ams_ca, id.vars = "yr") %>%
as_tibble() %>%
set_names(c("year", "run", "val"))
out$ams_ca_quant <- calc_quantiles_by_group(out$ams_ca_quant,
"year",
"val",
probs = quants)
# ams_us_quant --------------------------------------------------------------
out$ams_us <- conv_am(2, "surv")
out$ams_us_quant <- melt(out$ams_us, id.vars = "yr") %>%
as_tibble() %>%
set_names(c("year", "run", "val"))
out$ams_us_quant <- calc_quantiles_by_group(out$ams_us_quant,
"year",
"val",
probs = quants)
# quota_space ---------------------------------------------------------------
out$quota_space <- map2(sim_data, seq_along(sim_data), ~{
yrs <- as.numeric(rownames(.x$catch_quota[,,1]))
apply(.x$catch_quota, c(1,2), sum) %>%
as_tibble() %>%
mutate(run = .y) %>%
mutate(year = yrs) %>%
select(year, everything())
}) %>%
map_df(~{.x}) %>%
as_tibble()
# quota_tot -----------------------------------------------------------------
out$quota_tot <- out$quota_space %>%
mutate(quota = `1` + `2`) %>%
select(year, quota, run)
# quota ---------------------------------------------------------------------
out$quota <- map2(sim_data, seq_along(sim_data), ~{
yrs <- as.numeric(rownames(.x$catch_quota[,,1]))
rowSums(.x$catch_quota) %>%
as_tibble() %>%
mutate(run = .y) %>%
mutate(year = yrs) %>%
rename(quota = value) %>%
select(year, everything())
}) %>%
map_df(~{.x}) %>%
as_tibble()
# catch_quota_tot -----------------------------------------------------------
out$catch_quota_tot <- out$catch_plot %>%
left_join(out$quota, by = c("run", "year")) %>%
mutate(catch_quota = catch / quota) %>%
select(year, catch, quota, catch_quota, run)
#out$catch_quota_tot[is.na(out$catch_quota_tot)] <- 0
# catch_quota_quant ---------------------------------------------------------
out$catch_quota_quant <- out$catch_quota_tot %>%
calc_quantiles_by_group("year", "catch_quota", probs = quants)
# quota_ca ------------------------------------------------------------------
out$quota_ca <- out$quota_space %>%
select(year, `1`, run) %>%
rename(quota = `1`)
# quota_ca_quant ------------------------------------------------------------
out$quota_ca_quant <- out$quota_ca %>%
calc_quantiles_by_group("year", "quota", probs = quants)
# quota_us ------------------------------------------------------------------
out$quota_us <- out$quota_space %>%
select(year, `2`, run) %>%
rename(quota = `2`)
# quota_us_quant ------------------------------------------------------------
out$quota_us_quant <- out$quota_us %>%
calc_quantiles_by_group("year", "quota", probs = quants)
# quota_quant ---------------------------------------------------------------
out$quota_quant <- calc_quantiles_by_group(out$quota_tot,
"year",
"quota",
probs = quants)
# quota_frac ----------------------------------------------------------------
out$quota_frac <- map2(list(out$quota_tot), list(out$catch_plot), ~{
class(.x$year) <- class(.y$year)
class(.x$run) <- class(.y$run)
.x %>%
left_join(.y, by = c("year", "run")) %>%
mutate(quota_frac = quota / catch) %>%
select(year, quota_frac, run)
}) %>% map_df(~{.x})
# r_country (recruitment) ---------------------------------------------------
out$r_country <- map2(sim_data, seq_along(sim_data), ~{
.x$r_save %>% as_tibble %>% mutate(year = .x$yrs, run = .y)
}) %>%
map_df(~{.x}) %>%
rename(canada = V1, us = V2) %>%
select(year, canada, us, run)
# r_ca ----------------------------------------------------------------------
out$r_ca <- out$r_country %>%
select(year, canada, run) %>%
rename(value = canada)
# r_ca_quant ----------------------------------------------------------------
out$r_ca_quant <- out$r_ca %>%
calc_quantiles_by_group("year", "value", probs = quants)
# r_us ----------------------------------------------------------------------
out$r_us <- out$r_country %>%
select(year, us, run) %>%
rename(value = us)
# r_us_quant ----------------------------------------------------------------
out$r_us_quant <- out$r_us %>%
calc_quantiles_by_group("year", "value", probs = quants)
# r_all ---------------------------------------------------------------------
out$r_all <- out$r_country %>% transmute(year, value = canada + us, run)
# r_quant ---------------------------------------------------------------------
out$r_quant <- calc_quantiles_by_group(out$r_all, "year", "value", probs = quants)
# yrs_quota_met -------------------------------------------------------------
out$yrs_quota_met <- out$ssb_plot %>%
group_by(run) %>%
summarize(value = length(which(ssb > 0.1 & ssb <= 0.4)) / simyears)
# catch_area ----------------------------------------------------------------
out$catch_area <- map2(sim_data, seq_along(sim_data), ~{
data.frame(year = yrs,
area = apply(.x$catch_save_age, MARGIN = c(2, 3), FUN = sum),
run = .y)
}) %>%
map_df(~{.x}) %>%
transmute(year,
ca = area.1,
us = area.2,
run) %>%
as_tibble()
# catch_us_tot --------------------------------------------------------------
out$catch_us_tot <- out$catch_area %>%
transmute(year, catch = us, run)
# catch_ca_tot --------------------------------------------------------------
out$catch_ca_tot <- out$catch_area %>%
transmute(year, catch = ca, run)
# vtac_us -------------------------------------------------------------------
out$vtac_us <- map2(list(out$v_us_plot), list(out$catch_us_tot), ~{
class(.x$year) <- class(.y$year)
class(.x$run) <- class(.y$run)
.x %>%
left_join(.y, by = c("year", "run")) %>%
mutate(v_tac = v / catch) %>%
select(year, v_tac, run)
}) %>%
map_df(~{.x})
# vtac_ca -------------------------------------------------------------------
out$vtac_ca <- map2(list(out$v_us_plot), list(out$catch_ca_tot), ~{
class(.x$year) <- class(.y$year)
class(.x$run) <- class(.y$run)
.x %>%
left_join(.y, by = c("year", "run")) %>%
mutate(v_tac = v / catch) %>%
select(year, v_tac, run)
}) %>%
map_df(~{.x})
# vtac_us_seas --------------------------------------------------------------
out$vtac_us_seas <- map2(sim_data, seq_along(sim_data), ~{
ctmp <- colSums(.x$catch_save_age)
data.frame(year = yrs,
v_tac_sp = ctmp[, 2, 2] / .x$v_save[, 2, 2],
v_tac_su = ctmp[, 2, 3] / .x$v_save[, 2, 3],
v_tac_fa = ctmp[, 2, 4] / .x$v_save[, 2, 4],
run = .y)
}) %>%
map_df(~{.x}) %>%
mutate(country = "US") %>%
as_tibble()
# vtac_ca_seas --------------------------------------------------------------
out$vtac_ca_seas <- map2(sim_data, seq_along(sim_data), ~{
ctmp <- colSums(.x$catch_save_age)
data.frame(year = yrs,
v_tac_sp = ctmp[, 1, 2] / .x$v_save[, 1, 2],
v_tac_su = ctmp[, 1, 3] / .x$v_save[, 1, 3],
v_tac_fa = ctmp[, 1, 4] / .x$v_save[, 1, 4],
run = .y)
}) %>%
map_df(~{.x}) %>%
mutate(country = "Canada") %>%
as_tibble()
# vtac_seas -----------------------------------------------------------------
out$vtac_seas <- bind_rows(out$vtac_ca_seas, out$vtac_us_seas)
# aav_plot ------------------------------------------------------------------
out$aav_plot <- map2(list(out$catch_for_aav), seq_along(list(out$catch_for_aav)), ~{
.x %>%
group_by(run) %>%
mutate(catch_lag = lag(catch, 1)) %>%
mutate(aav = abs(catch_lag - catch) / catch_lag) %>%
ungroup() %>%
filter(!is.na(aav)) %>%
select(year, aav, run)
}) %>%
map_df(~{.x}) %>%
filter(year > sim_data[[1]]$m_yr) %>%
group_by(run) %>%
summarize(aav = median(aav))
# v_space ------------------------------------------------------------------
out$v_space <- map2(sim_data, seq_along(sim_data), ~{
yrs <- as.numeric(rownames(.x$v_save[ , , 1]))
.x$v_save[ , , 1] %>%
as_tibble() %>%
mutate(run = .y, year = yrs) %>%
select(year, everything())
}) %>%
map_df(~{.x})
# v_all ---------------------------------------------------------------------
out$v_all <- out$v_space %>%
mutate(v = `1` + `2`) %>%
select(year, v, run)
# v_all_quant ---------------------------------------------------------------
out$v_all_quant <- out$v_all %>%
calc_quantiles_by_group("year", "v", probs = quants)
# v_ca_quant ----------------------------------------------------------------
out$v_ca_quant <- calc_quantiles_by_group(out$v_ca_plot, grp_col = "year", col = "v", probs = quants)
# v_us_quant ----------------------------------------------------------------
out$v_us_quant <- calc_quantiles_by_group(out$v_us_plot, grp_col = "year", col = "v", probs = quants)
# catch_quant ----------------------------------------------------------------
out$catch_quant <- calc_quantiles_by_group(out$catch_plot, grp_col = "year", col = "catch", probs = quants)
# quota_frac_quant ----------------------------------------------------------------
out$quota_frac_quant <- calc_quantiles_by_group(out$quota_frac, grp_col = "year", col = "quota_frac", probs = quants)
# ssb_10 --------------------------------------------------------------------
# Probability of SSB < SSB_10%
ssb_future <- out$ssb_plot %>%
filter(year > min(short_term_yrs))
out$ssb_10 <- ssb_future %>%
group_by(run) %>%
summarize(pcnt = length(which(ssb < 0.1)) /
length(unique(year))) %>%
group_map(~ calc_quantiles(.x, col = "pcnt", probs = quants)) %>%
map_df(~{.x}) %>%
ungroup()
# ssb_4010 ------------------------------------------------------------------
# Probability of SSB >= SSB_10% and <= SSB_40%
out$ssb_4010 <- ssb_future %>%
group_by(run) %>%
summarize(pcnt = length(which(ssb >= 0.1 & ssb <= 0.4)) /
length(unique(year))) %>%
group_map(~ calc_quantiles(.x, col = "pcnt", probs = quants)) %>%
map_df(~{.x}) %>%
ungroup()
# catch_short_term ----------------------------------------------------------
out$catch_short_term <- calc_term_quantiles(out$catch_plot,
grp_col = "run",
col = "catch",
min_yr = min(short_term_yrs),
max_yr = long_term_yrs,
probs = quants,
mean_multiplier = catch_multiplier)
# catch_long_term -----------------------------------------------------------
out$catch_long_term <- calc_term_quantiles(out$catch_plot,
grp_col = "run",
col = "catch",
min_yr = long_term_yrs + 1,
probs = quants,
mean_multiplier = catch_multiplier)
# aav_short_term ------------------------------------------------------------
# out$aav_short_term <- calc_term_quantiles(out$aav_plot,
# grp_col = "run",
# col = "aav",
# min_yr = min(short_term_yrs),
# max_yr = max(short_term_yrs),
# probs = quants)
# v_ca_stat -----------------------------------------------------------------
out$v_ca_stat <- calc_term_quantiles(out$v_ca_plot,
grp_col = "run",
col = "v",
probs = quants)
# v_us_stat -----------------------------------------------------------------
out$v_us_stat <- calc_term_quantiles(out$v_us_plot,
grp_col = "run",
col = "v",
probs = quants)
# vtac_ca_stat --------------------------------------------------------------
out$vtac_ca_stat <- out$vtac_ca %>%
group_by(run) %>%
summarise(prop = length(which(v_tac > (1 / 0.3))) / length(v_tac)) %>%
group_map(~ calc_quantiles(.x, col = "prop", probs = quants)) %>%
map_df(~{.x}) %>%
ungroup()
# vtac_us_stat --------------------------------------------------------------
out$vtac_us_stat <- out$vtac_us %>%
group_by(run) %>%
summarise(prop = length(which(v_tac > 1)) / length(v_tac)) %>%
group_map(~ calc_quantiles(.x, col = "prop", probs = quants)) %>%
map_df(~{.x}) %>%
ungroup()
# vtac_ca_seas_stat ---------------------------------------------------------
out$vtac_ca_seas_stat <- out$vtac_ca_seas %>%
filter(year > long_term_yrs) %>%
group_by(run) %>%
summarise(avg_sp = mean(1 / v_tac_sp),
avg_su = mean(1 / v_tac_su),
avg_fa = mean(1 / v_tac_fa)) %>%
summarise(med_sp = median(avg_sp),
med_su = median(avg_su),
med_fa = median(avg_fa))
# vtac_us_seas_stat ---------------------------------------------------------
out$vtac_us_seas_stat <- out$vtac_us_seas %>%
filter(year > long_term_yrs) %>%
group_by(run) %>%
summarise(avg_sp = mean(1 / v_tac_sp),
avg_su = mean(1 / v_tac_su),
avg_fa = mean(1 / v_tac_fa)) %>%
summarise(med_sp = median(avg_sp),
med_su = median(avg_su),
med_fa = median(avg_fa))
# nclosed -------------------------------------------------------------------
# Calculate the median number of closed years
out$nclosed <- map_int(unique(ssb_future$run), ~{
tmp <- ssb_future %>% filter(run == .x)
length(which(tmp$ssb < 0.1))
})
# indicators ----------------------------------------------------------------
# Create a table with all the indicator data
indicator <- c("SSB < 0.10 SSB0",
"0.10 < SSB < 0.4 SSB0",
"SSB > 0.4 SSB0",
"AAV",
"Mean SSB / SSB0",
"Short term catch",
"Long term catch",
"Canada TAC/V spr",
"Canada TAC/V sum",
"Canada TAC/V fall",
"US TAC/V spr",
"US TAC/V sum",
"US TAC/V fall")
indicator_key <- seq_along(indicator)
# ssb_quant_by_run ----------------------------------------------------------
tmp_ssb_by_run <- out$ssb_plot %>% filter(year > min(short_term_yrs))
out$ssb_quant_by_run <- calc_quantiles_by_group(tmp_ssb_by_run, grp_col = "run",
col = "ssb", probs = quants)
# catch_quant_by_run (short term catch) -------------------------------------
tmp_catch_by_run <- out$catch_plot %>% filter(year > min(short_term_yrs), year <= long_term_yrs)
out$catch_quant_by_run <- calc_quantiles_by_group(tmp_catch_by_run, grp_col = "run",
col = "catch", probs = quants)
# catch_quant_by_run (long term catch) --------------------------------------
tmp_catch_by_run <- out$catch_plot %>% filter(year > long_term_yrs - 2)
tmp_catch_by_run <- calc_quantiles_by_group(tmp_catch_by_run, grp_col = "run",
col = "catch", probs = quants)
# info (indicator table) ----------------------------------------------------
out$info <- map(1:nruns, ~{
data.frame(
indicator_key = indicator_key,
indicator = indicator,
value = c(
round(length(which(ssb_future[ssb_future$run == .x,]$ssb <= 0.1)) /
length(ssb_future[ssb_future$run == .x,]$ssb), digits = 2),
round(length(which(ssb_future[ssb_future$run == .x,]$ssb > 0.1 & ssb_future[ssb_future$run == .x,]$ssb < 0.4)) /
length(ssb_future[ssb_future$run == .x,]$ssb), digits = 2),
round(length(which(ssb_future[ssb_future$run == .x,]$ssb > 0.4)) /
length(ssb_future[ssb_future$run == .x,]$ssb), digits = 2),
round(out$aav_plot[out$aav_plot$run == .x,]$aav, digits = 2),
round(out$ssb_quant_by_run[out$ssb_quant_by_run$run == .x,]$`0.5`, digits = 2),
round(out$catch_quant_by_run[out$catch_quant_by_run$run == .x,]$`0.5`, digits = 2),
round(tmp_catch_by_run[tmp_catch_by_run$run == .x,]$`0.5`, digits = 2),
out$vtac_ca_seas_stat$med_sp,
out$vtac_ca_seas_stat$med_su,
out$vtac_ca_seas_stat$med_fa,
out$vtac_us_seas_stat$med_sp,
out$vtac_us_seas_stat$med_su,
out$vtac_us_seas_stat$med_fa)) %>%
as_tibble() %>%
mutate(run = .x)
}) %>%
map_df(~{.x})
# info_quant (indicator table) ----------------------------------------------
out$info_quant <- out$info %>%
calc_quantiles_by_group(grp_col = "indicator_key",
col = "value",
grp_names = "indicator",
probs = quants)
out$info <- out$info %>%
select(-indicator_key) %>%
mutate(indicator = as.factor(indicator))
out
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.