4  Model comparisons

Code

# retrieve data/results from ADMB & RT<B models
data <- source(here::here('data', 'nork_data_2022.r'))
rtmb <- readRDS(here::here('data', 'rtmb.RData'))
rtmb_proj <- readRDS(here::here('data', 'rtmb_proj.RData'))
catch <- read.csv(here::here('data', 'catch.csv'))
srv <- read.csv(here::here('data', 'survey.csv'))
fac <- read.csv(here::here('data', 'fac.csv'))
sac <- read.csv(here::here('data', 'sac.csv'))
fsc <- read.csv(here::here('data', 'fsc.csv'))
slx <- read.csv(here::here('data', 'selex.csv'))
bio <- read.csv(here::here('data', 'bio_rec_f.csv'))
n_proj <- read.csv(here::here('data', 'n_proj.csv'))
b40 <- read.csv(here::here('data', 'b35_b40_yld.csv'))

Code

library(ggplot2)
library(dplyr)
library(tidyr)
theme_set(afscassess::theme_report())

4.1 Selectivity

• No discernible differences in selectivity observed.

Code

as.data.frame(rtmb$slx) %>% 
  rename(fishery = V1, survey = V2) %>% 
  bind_cols(slx) %>% 
  mutate(fish_diff = (fishery - fish) / fish,
         srv_diff = (survey - srv1) / srv1) -> df
  
df %>% 
  pivot_longer(-c(age, maturity, fish_diff, srv_diff)) %>% 
  ggplot(aes(age, value, color = name)) + 
  geom_line()

Code

df %>% 
  pivot_longer(c(fish_diff, srv_diff)) %>% 
  ggplot(aes(age, value, color = name)) + 
  geom_line() +
  scale_y_continuous(labels = scales::percent) +
  ylab('percent difference') +
    geom_hline(yintercept=0, lty=3)

4.2 Biomass

• No discernible differences in biomass observed.

Code

data.frame(ssb = rtmb$spawn_bio,
           tot = rtmb$tot_bio) %>% 
  bind_cols(bio) %>% 
  mutate(tot_diff = (tot - tot_biom) / tot_biom,
         sb_diff = (ssb - sp_biom) / sp_biom) -> df1

  df1 %>% 
  pivot_longer(c(ssb, tot, tot_biom, sp_biom)) %>% 
  ggplot(aes(year, value, color = name)) + 
  geom_line()

Code

  df1 %>% 
  pivot_longer(c(tot_diff, sb_diff)) %>% 
  ggplot(aes(year, value, color = name)) + 
  geom_line() +
  scale_y_continuous(labels = scales::percent) +
  ylab('percent difference') +
    geom_hline(yintercept=0, lty=3)

4.3 Comps

4.3.1 Fishery age compositions

Code

## fish age comp
data.frame(age = rtmb$ages, 
           rtmb$fish_age_pred) %>% 
  pivot_longer(-age) %>% 
  mutate(year = rep(fish_age_yrs, length(ages)),
         groups = 'pred2') %>% 
  bind_rows(fac) -> df2

df2 %>% 
  ggplot(aes(age, value, color = groups)) + 
  geom_line() +
  facet_wrap(~year)

Code

df2 %>% 
  select(age, value, year, groups) %>% 
  filter(groups!='obs') %>% 
  pivot_wider(names_from=groups, values_from = value) %>% 
  mutate(diff = (pred2 - pred) / pred,
         Age = factor(age)) %>% 
    pivot_longer(diff) %>% 
  ggplot(aes(year, value, color = Age)) + 
  geom_line() +
  # facet_wrap(~year) +
  scale_y_continuous(labels = scales::percent) +
  ylab('percent difference') +
    geom_hline(yintercept=0, lty=3)

4.3.2 Survey age compositions

Code

## fish age comp
data.frame(age = rtmb$ages, 
           rtmb$srv_age_pred) %>% 
  pivot_longer(-age) %>% 
  mutate(year = rep(srv_age_yrs, length(ages)),
         groups = 'pred2') %>% 
  bind_rows(sac) -> df3

df3 %>% 
  ggplot(aes(age, value, color = groups)) + 
  geom_line() +
  facet_wrap(~year)

Code

df2 %>% 
  select(age, value, year, groups) %>% 
  filter(groups!='obs') %>% 
  pivot_wider(names_from=groups, values_from = value) %>% 
  mutate(diff = (pred2 - pred) / pred,
         Age = factor(age)) %>% 
    pivot_longer(diff) %>% 
  ggplot(aes(year, value, color = Age)) + 
  geom_line() +
  # facet_wrap(~year) +
  scale_y_continuous(labels = scales::percent) +
  ylab('percent difference') +
    geom_hline(yintercept=0, lty=3)

4.3.3 Fishery size compositions

Code

## fish age comp
data.frame(length = length_bins, 
           rtmb$fish_size_pred) %>% 
  pivot_longer(-length) %>% 
  mutate(year = rep(fish_size_yrs, length(length_bins)),
         groups = 'pred2') %>% 
  bind_rows(fsc) -> df4

df4 %>% 
  ggplot(aes(length, value, color = groups)) + 
  geom_line() +
  facet_wrap(~year)

Code

df4 %>% 
  select(length, value, year, groups) %>% 
  filter(groups!='obs') %>% 
  pivot_wider(names_from=groups, values_from = value) %>% 
  mutate(diff = (pred2 - pred) / pred,
         Length = factor(length)) %>% 
    pivot_longer(diff) %>% 
  ggplot(aes(year, value, color = Length)) + 
  geom_line() +
  # facet_wrap(~year) +
  scale_y_continuous(labels = scales::percent) +
  ylab('percent difference') +
    geom_hline(yintercept=0, lty=3)

4.3.4 F’s

Code

## F values


data.frame(year = bio$year,
           admb = bio$F,
           rtmb = rtmb$Ft * max(rtmb$slx[,1])) %>% 
  mutate(diff = admb - rtmb) -> df5

df5 %>% 
  pivot_longer(-c(year, diff)) %>% 
  ggplot(aes(year, value, color = name)) + 
  geom_line() 

Code

df5 %>% 
    pivot_longer(diff) %>% 
  ggplot(aes(year, value)) + 
  geom_line() +
  # facet_wrap(~year) +
  scale_y_continuous(labels = scales::percent) +
  ylab('percent difference') +
    geom_hline(yintercept=0, lty=3)

4.4 B’s

ADMB output:

Code

# admb
data.frame(b0 = 82349.7, b40 = 32939.9, b35 = 28822.4,
           f40 = 0.0612999, f35 = 0.0736157)

       b0     b40     b35       f40       f35
1 82349.7 32939.9 28822.4 0.0612999 0.0736157

Code

data.frame(year = 2023:2024,
           spawn_bio = c(39462.6, 37360.3),
           tot_bio = c(95559.2, 92840.4),
           abc = c(4971.65, 4734.3),
           ofl = c(5935.16, 5651.9))

  year spawn_bio tot_bio     abc     ofl
1 2023   39462.6 95559.2 4971.65 5935.16
2 2024   37360.3 92840.4 4734.30 5651.90

RTMB output:

Code

# rtmb
data.frame(b0 = rtmb$B0, b40 = rtmb$B40, b35 = rtmb$B35) 

        b0      b40      b35
1 82349.84 32939.95 28822.46

Code

rtmb_proj

  year spawn_bio  tot_bio catch_abc catch_ofl       F40        F35
1 2023  39462.66 95559.35  4971.655  5935.173 0.0612999 0.07361567
2 2024  37360.40 92840.50  4734.307  5651.909 0.0612999 0.07361567