Operating model summary"

In MSEtool: Management Strategy Evaluation Toolkit

  knitr::opts_chunk$set(collapse = TRUE, echo = FALSE, message = FALSE,
  fig.width = 6, fig.height = 4.5, out.width = "650px", comment = "#>")

{.tabset}

Total numbers

year_lab <- "Year"
mainyrs <- replist$startyr:replist$endyr
if(Hist@OM@nyears == length(mainyrs)) {
  OM_years <- replist$startyr:replist$endyr
} else {
  nseas <- 1/replist$seasdurations
  year_frac <- data.frame(mainyrs = mainyrs, seas = rep(1:nseas, length(mainyrs)/nseas), 
                          true_year = rep(1:(length(mainyrs)/nseas), each = nseas))
  age_frac <- data.frame(age = 0:OM@maxage) %>% mutate(true_age = floor(age/nseas))
  OM_years <- dplyr::filter(year_frac, seas == 1) %>% getElement("mainyrs")
}


N_SS <- replist$natage %>% filter(Yr %in% OM_years, `Beg/Mid`=="B")
cols <- which(colnames(N_SS)=='0'):ncol(replist$natage)
N_SS <- N_SS %>% 
    tidyr::pivot_longer(cols=all_of(cols)) %>%
    group_by(Yr) %>%
    summarize(N=sum(value), .groups = 'keep')
N_OM <- apply(Hist@AtAge$Number, c(1, 3), sum)
ylim_N <- c(0, 1.1 * max(c(N_SS$N, N_OM)))
matplot(OM_years, t(N_OM), xlab = year_lab, ylab = "Numbers", ylim = ylim_N, pch = 1, col = "black", typ = "o")
lines(OM_years, N_SS$N, col = "red", lwd = 3)
abline(h = 0, col = "grey")

Spawning biomass

SSB_SS <- replist$timeseries %>% filter(Yr %in% OM_years) %>% group_by(Yr, Area) %>% 
  summarise(SpawnBio = mean(SpawnBio, na.rm = TRUE)) %>% group_by(Yr) %>% 
  summarise(SpawnBio = sum(SpawnBio, na.rm = TRUE)) %>% getElement("SpawnBio")
SSB_OM <- apply(Hist@AtAge$SBiomass, c(1, 3), sum)
ylim_SSB <- c(0, 1.1 * max(c(SSB_SS, SSB_OM)))
matplot(OM_years, t(SSB_OM), xlab = year_lab, ylab = "Spawning Biomass", ylim = ylim_SSB, pch = 1, col = "black", typ = "o")
lines(OM_years, SSB_SS, col = "red", lwd = 3)
abline(h = 0, col = "grey")

SS_B0 <- replist$timeseries$SpawnBio[grepl("VIRG", replist$timeseries$Era)] %>% sum(na.rm = TRUE)
dep_SS <- SSB_SS/SS_B0
dep_OM <- SSB_OM/Hist@Ref$ReferencePoints$SSB0
ylim_dep <- c(0, 1.1 * max(c(dep_SS, dep_OM)))
matplot(OM_years, t(dep_OM), xlab = year_lab, ylab = "Spawning Depletion", ylim = ylim_dep, pch = 1, col = "black", typ = "o")
lines(OM_years, dep_SS, col = "red", lwd = 3)
abline(h = 0, col = "grey")

Catch

C_SS <- cbind(replist$timeseries[, 1:4], rowSums(replist$timeseries[, startsWith(names(replist$timeseries), "dead(B):"), drop = FALSE], na.rm = TRUE))
C_SS <- aggregate(C_SS[, 5], list(Year = C_SS$Yr), sum)
C_SS <- C_SS[C_SS$Year %in% OM_years, 2]

C_OM <- apply(Hist@AtAge$Removals, c(1, 3), sum)
ylim_cat <- c(0, 1.1 * max(C_SS, C_OM))
matplot(OM_years, t(C_OM), xlab = year_lab, ylab = "Removals", ylim = ylim_cat, pch = 1, col = "black", typ = "o")
lines(OM_years, C_SS, col = "red", lwd = 3)
abline(h = 0, col = "grey")

Cr_SS <- C_SS/C_SS[length(C_SS)]
Cr_OM <- C_OM/C_OM[, ncol(C_OM)]
ylim_cr <- c(0, 1.1 * max(Cr_SS, Cr_OM))
matplot(OM_years, t(Cr_OM), xlab = year_lab, ylab = "Catch Relative to today", ylim = ylim_cr, pch = 1, col = "black", typ = "o")
lines(OM_years, Cr_SS, col = "red", lwd = 3)
abline(h = 0, col = "grey")
abline(h = 1, lty = 3)

Abundance-at-age {.tabset}

Recruitment

# Age-0 is summed across seasons, but age-1+ is in the first season only
if(replist$SS_versionNumeric == 3.30) {
  N_at_age <- reshape2::melt(replist$natage[replist$natage$`Beg/Mid` == "B" & replist$natage$Seas == 1, -c(9:12)], 
                             list("Area", "Bio_Pattern", "Sex", "BirthSeas", "Settlement", "Platoon", "Morph", "Yr"),
                             variable.name = "Age", value.name = "N") %>% 
    dplyr::filter(Yr %in% mainyrs, Sex %in% gender)
  N_at_age <- summarise(group_by(N_at_age, Yr, Age), N = sum(N)) # Sum over area, morphs, platoons, sex, etc.
  N_at_age <- reshape2::acast(N_at_age, list("Yr", "Age"), value.var = "N")
} else {

  R_main <- replist$timeseries$Yr %in% mainyrs
  Recruits <- aggregate(replist$timeseries$Recruit[R_main], list(Yr = replist$timeseries$Yr[R_main]), 
                        sum, na.rm = TRUE)

  N_at_age <- reshape2::melt(replist$natage[replist$natage$`Beg/Mid` == "B" & replist$natage$Seas == 1, -c(8:11)], 
                             list("Area", "Bio_Pattern", "Sex", "BirthSeas", "Platoon", "Morph", "Yr"),
                             variable.name = "Age", value.name = "N") %>% 
    dplyr::filter(Yr %in% mainyrs, Sex %in% gender) %>% group_by(Yr, Age) %>% summarise(N = sum(N)) %>%
    reshape2::acast(list("Yr", "Age"), value.var = "N")
  N_at_age[, 1] <- Recruits$x

}

if(Hist@OM@nyears != length(mainyrs)) {
  season_N_at_age <- function(x, year_frac, age_frac) {
    newR <- aggregate(N_at_age[, 1], by = list(Yr = year_frac$true_year), sum)$x

    other <- N_at_age[year_frac$seas == 1, -c(1:nseas)] %>% 
      apply(1, function(xx) aggregate(xx, by = list(Age = age_frac$true_age[-c(1:nseas)]), sum)$x)

    rbind(newR, other) %>% t()
  }
  N_at_age <- season_N_at_age(N_at_age, year_frac, age_frac)
}

#N_at_age <- summarise(group_by(N_at_age, Yr, Age), N = sum(N)) # Sum over area, morphs, platoons, sex, etc.
#N_at_age <- reshape2::acast(N_at_age, list("Yr", "Age"), value.var = "N")

R_OM <- apply(Hist@AtAge$Number[, 1, , ], c(1, 2), sum)
R_SS <- N_at_age[, 1]
ylim_R <- c(0, 1.1 * max(R_OM, R_SS))
matplot(OM_years, t(R_OM), xlab = year_lab, ylab = "Recruitment (age 0)", ylim = ylim_R, pch = 1, col = "black", typ = "o")
lines(OM_years, N_at_age[, 1], col = "red", lwd = 3)
abline(h = 0, col = "grey")

Absolute abundance

if(requireNamespace("SAMtool", quietly = TRUE)) {
  N_OM <- apply(Hist@AtAge$Number, 1:3, sum)
  SAMtool::plot_composition(OM_years, t(N_OM[1, , ]), N_at_age, N = NULL, 
                            ages = 1:ncol(N_OM) - 1, annual_ylab = "Numbers at age", annual_yscale = "raw")
}

Relative abundance

if(requireNamespace("SAMtool", quietly = TRUE)) {
  N_OM <- apply(Hist@AtAge$Number, 1:3, sum)
  SAMtool::plot_composition(OM_years, t(N_OM[1, , ]), N_at_age, N = NULL, 
                            ages = 1:ncol(N_OM) - 1, annual_ylab = "Proportions at age")
}

Selectivity and F {.tabset}

Apical F

F_OM <- apply(Hist@AtAge$F.Mortality, c(1, 3), max)
if(inherits(x, "OM")) {
  F_SS <- OM@cpars$Find[1, ]
} else {
  F_SS <- Hist@SampPars$Fleet$Find[1, ]
}
ylim_F <- c(0, 1.1 * max(F_SS, F_OM))
matplot(OM_years, t(F_OM), typ = "o", xlab = "Year", ylab = "Apical F", ylim = ylim_F, pch = 1, col = "black")
lines(OM_years, F_SS, col = "red", lwd = 3)
abline(h = 0, col = "grey")

Selectivity

if(requireNamespace("SAMtool", quietly = TRUE)) {
  V <- Hist@AtAge$Select[1, , 1:length(OM_years)]
  SAMtool::plot_composition(OM_years, t(V), ages = 1:nrow(V) - 1,
                            N = NULL, annual_ylab = "Selectivity", annual_yscale = "raw")
}

About

This report was generated on: r Sys.time()
MSEtool version r packageVersion("MSEtool")
r R.version.string

MSEtool documentation built on July 26, 2023, 5:21 p.m.