Fit von Bertalanffy models

von Bertalanffy growth models

Fit VBGE models that vary with respect to common or area-specific parameters by adding a dummy-variable (0, 1) and use WAIC to compare them. Because we use back-calculated data (few repetitions within the same individual), we fit models with catch-age-only. The models have sigma varying with age and cohort-varying K and L_inf.

Load libraries

library(tidyverse); theme_set(theme_classic(base_size = 12))
#> Warning: package 'tidyr' was built under R version 4.0.5
library(brms)
#> Warning: package 'Rcpp' was built under R version 4.0.5
library(nlstools)
library(viridis)
library(bayesplot)
library(tidylog)
library(tidybayes)
library(RColorBrewer)
#> Warning: package 'RColorBrewer' was built under R version 4.0.5
library(patchwork)
library(modelr)
library(janitor)

# Print package versions for versions
sessionInfo() 
#> R version 4.0.2 (2020-06-22)
#> Platform: x86_64-apple-darwin17.0 (64-bit)
#> Running under: macOS  10.16
#> 
#> Matrix products: default
#> BLAS:   /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
#> LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
#> 
#> locale:
#> [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#>  [1] janitor_2.0.1      modelr_0.1.8       patchwork_1.1.1    RColorBrewer_1.1-3
#>  [5] tidybayes_3.0.1    tidylog_1.0.2      bayesplot_1.7.2    viridis_0.5.1     
#>  [9] viridisLite_0.4.1  nlstools_1.0-2     brms_2.17.0        Rcpp_1.0.8        
#> [13] forcats_0.5.1      stringr_1.4.1      dplyr_1.0.10       purrr_0.3.4       
#> [17] readr_2.1.1        tidyr_1.2.0        tibble_3.1.8       ggplot2_3.3.6     
#> [21] tidyverse_1.3.2   
#> 
#> loaded via a namespace (and not attached):
#>   [1] readxl_1.3.1         backports_1.3.0      plyr_1.8.6          
#>   [4] igraph_1.2.5         svUnit_1.0.6         splines_4.0.2       
#>   [7] crosstalk_1.1.0.1    TH.data_1.1-1        rstantools_2.1.1    
#>  [10] inline_0.3.15        digest_0.6.30        htmltools_0.5.3     
#>  [13] rsconnect_0.8.16     fansi_1.0.3          magrittr_2.0.3      
#>  [16] checkmate_2.0.0      googlesheets4_1.0.0  tzdb_0.2.0          
#>  [19] RcppParallel_5.1.4   matrixStats_0.61.0   xts_0.12-0          
#>  [22] sandwich_3.0-2       prettyunits_1.1.1    colorspace_2.0-3    
#>  [25] rvest_1.0.3          ggdist_3.0.0         haven_2.5.1         
#>  [28] xfun_0.33            callr_3.7.2          crayon_1.4.2        
#>  [31] jsonlite_1.8.0       lme4_1.1-26          survival_3.1-12     
#>  [34] zoo_1.8-8            glue_1.6.2           gtable_0.3.1        
#>  [37] gargle_1.2.0         emmeans_1.5.0        V8_3.2.0            
#>  [40] distributional_0.2.2 pkgbuild_1.3.1       rstan_2.21.2        
#>  [43] abind_1.4-5          scales_1.2.1         mvtnorm_1.1-3       
#>  [46] DBI_1.1.1            miniUI_0.1.1.1       xtable_1.8-4        
#>  [49] clisymbols_1.2.0     stats4_4.0.2         StanHeaders_2.21.0-7
#>  [52] DT_0.15              htmlwidgets_1.5.4    httr_1.4.4          
#>  [55] threejs_0.3.3        arrayhelpers_1.1-0   posterior_1.1.0     
#>  [58] ellipsis_0.3.2       pkgconfig_2.0.3      loo_2.3.1           
#>  [61] farver_2.1.1         sass_0.4.2           dbplyr_2.1.1        
#>  [64] utf8_1.2.2           tidyselect_1.1.2     rlang_1.0.6         
#>  [67] reshape2_1.4.4       later_1.3.0          munsell_0.5.0       
#>  [70] cellranger_1.1.0     tools_4.0.2          cachem_1.0.6        
#>  [73] cli_3.4.1            generics_0.1.2       broom_1.0.1         
#>  [76] ggridges_0.5.2       evaluate_0.16        fastmap_1.1.0       
#>  [79] yaml_2.3.5           processx_3.7.0       knitr_1.40          
#>  [82] fs_1.5.2             nlme_3.1-148         projpred_2.0.2      
#>  [85] mime_0.12            xml2_1.3.3           compiler_4.0.2      
#>  [88] shinythemes_1.1.2    rstudioapi_0.14      gamm4_0.2-6         
#>  [91] curl_4.3.2           reprex_2.0.1         statmod_1.4.36      
#>  [94] bslib_0.4.0          stringi_1.7.8        ps_1.7.1            
#>  [97] Brobdingnag_1.2-6    lattice_0.20-41      Matrix_1.3-4        
#> [100] nloptr_1.2.2.2       markdown_1.1         shinyjs_1.1         
#> [103] tensorA_0.36.2       vctrs_0.5.0          pillar_1.8.1        
#> [106] lifecycle_1.0.3      jquerylib_0.1.4      bridgesampling_1.0-0
#> [109] estimability_1.3     httpuv_1.5.5         R6_2.5.1            
#> [112] promises_1.1.1       gridExtra_2.3        codetools_0.2-16    
#> [115] boot_1.3-25          colourpicker_1.0     MASS_7.3-51.6       
#> [118] gtools_3.8.2         assertthat_0.2.1     withr_2.5.0         
#> [121] shinystan_2.5.0      multcomp_1.4-20      mgcv_1.8-31         
#> [124] parallel_4.0.2       hms_1.1.1            grid_4.0.2          
#> [127] minqa_1.2.4          coda_0.19-4          snakecase_0.11.0    
#> [130] rmarkdown_2.16       googledrive_2.0.0    shiny_1.6.0         
#> [133] lubridate_1.8.0      base64enc_0.1-3      dygraphs_1.1.1.6

# For parallel processing
options(mc.cores = parallel::detectCores()) 

# Load cache
# qwraps2::lazyload_cache_dir(path = "R/analysis/01_vbge_fit_cache/html")

Read data

d <- read.csv("data/for_fitting/vbge_dat.csv")

Fit models

Here are some guides I followed https://rstudio-pubs-static.s3.amazonaws.com/57692_215e844f73e949ada4854dc688677dc1.html vignette(“brms_nonlinear”, package = “brms”); https://cran.r-project.org/web/packages/brms/vignettes/brms_nonlinear.html; https://cran.r-project.org/web/packages/brms/vignettes/brms_distreg.html

All models have year as a ID within year as random factors for K & L_inf & a model on sigma: https://cran.r-project.org/web/packages/brms/vignettes/brms_distreg.html

Preliminary analysis result in bimodal posterior distributions, so therefore I will put informative priors on the models.

Below BT is the warm area, FM is the cold. After this code I use heated/reference instead

# First selected informative priors through a prior predictive check on all data combined
# hist(rnorm(10000, mean = 45, sd = 10))    # L_inf
# hist(rnorm(10000, mean = -0.3, sd = 0.2)) # t0 
# hist(rnorm(10000, mean = 0.2, sd = 0.1))  # K

# However, this did not work with the full model. I achieved convergence by setting 
# much tighter priors.
# prior(normal(-0.5, 0.1), nlpar = "t0FM") +
# prior(normal(-0.5, 0.1), nlpar = "t0BT") +
# prior(normal(0.17, 0.02), nlpar = "KFM") +
# prior(normal(0.17, 0.02), nlpar = "KBT") +
# prior(normal(40, 1), nlpar = "LinfFM") +
# prior(normal(40, 1), nlpar = "LinfBT")

# I then relaxed them step-wise. That resulted in the following priors: 
# prior(normal(-0.5, 0.4), nlpar = "t0FM") +
# prior(normal(-0.5, 0.4), nlpar = "t0BT") +
# prior(normal(0.17, 0.05), nlpar = "KFM") +
# prior(normal(0.17, 0.05), nlpar = "KBT") +
# prior(normal(40, 5), nlpar = "LinfFM") +
# prior(normal(40, 5), nlpar = "LinfBT")

# However, they seemed to narrow.
# Therefore I tried to constrain parameters by using uniform distributions. I landed 
# on using it only for K, which was sufficient in order to be able to put broad normal
# priors on L_inf and t_0
# https://rdrr.io/cran/brms/man/set_prior.html

M0: Prior predictive check: Warm+Cold merged

hist(rnorm(100000, mean = 45, sd = 20))

hist(rnorm(100000, mean = 0.2, sd = 0.1)) 

M0fmbt <- brm(
  bf(log(length_cm) ~ log(Linf*(1-exp(-K*(age-t0)))),
     Linf ~ 1, t0 ~ 1, K ~ 1, nl = TRUE),
  data = d, family = gaussian(),
  prior = c(prior(normal(45, 20), nlpar = "Linf"),
            prior(normal(-0.5, 1), nlpar = "t0"),
            prior(normal(0.2, 0.1), nlpar = "K")),
            sample_prior = "only", 
  iter = 4000, thin = 1, cores = 3, chains = 3, seed = 9)
#> Compiling Stan program...
#> Start sampling


# From add_fitted_draws {tidybayes} which I use for the general predictions
# add_predicted_draws adds draws from posterior predictions to the data. It corresponds to ... or brms::predict.brmsfit() in brms.
pp <- conditional_effects(M0fmbt, method = "posterior_predict")
#> Warning in log(Linf * (1 - exp(-K * (age - t0)))): NaNs produced

plot(pp, plot = FALSE)[[1]] +
  labs(x = "Age [yrs]", y = "log(length [cm])") 

#ggsave("figures/supp/vbge_prior_pred_check.png", width = 6.5, height = 6.5, dpi = 600)
ggsave("figures/supp/vbge_prior_pred_check.pdf", height = 20, width = 20, units = "cm")

M1: All parameters specific by area

# These inits where found after initial exploration
load("output/vbge_3_chain_inits.RData")
inits_3_chain
#> [[1]]
#> [[1]]$b_t0C
#> [1] 0.5371245
#> 
#> [[1]]$b_t0W
#> [1] 0.05326085
#> 
#> [[1]]$b_KC
#> [1] 1.842615
#> 
#> [[1]]$b_KW
#> [1] 1.938825
#> 
#> [[1]]$b_LinfC
#> [1] 1.75094
#> 
#> [[1]]$b_LinfW
#> [1] 1.378209
#> 
#> [[1]]$sigma
#> [1] 1.041299
#> 
#> [[1]]$nu
#> [1] 1.175157
#> 
#> [[1]]$sd_1
#> [1] 0.3621573
#> 
#> 
#> [[2]]
#> [[2]]$b_t0C
#> [1] 0.5354698
#> 
#> [[2]]$b_t0W
#> [1] 0.05309676
#> 
#> [[2]]$b_KC
#> [1] 1.836939
#> 
#> [[2]]$b_KW
#> [1] 1.932852
#> 
#> [[2]]$b_LinfC
#> [1] 1.745546
#> 
#> [[2]]$b_LinfW
#> [1] 1.373963
#> 
#> [[2]]$sigma
#> [1] 1.038091
#> 
#> [[2]]$nu
#> [1] 1.171537
#> 
#> [[2]]$sd_1
#> [1] 0.3610416
#> 
#> 
#> [[3]]
#> [[3]]$b_t0C
#> [1] 0.5320083
#> 
#> [[3]]$b_t0W
#> [1] 0.05275353
#> 
#> [[3]]$b_KC
#> [1] 1.825064
#> 
#> [[3]]$b_KW
#> [1] 1.920358
#> 
#> [[3]]$b_LinfC
#> [1] 1.734262
#> 
#> [[3]]$b_LinfW
#> [1] 1.365081
#> 
#> [[3]]$sigma
#> [1] 1.031381
#> 
#> [[3]]$nu
#> [1] 1.163963
#> 
#> [[3]]$sd_1
#> [1] 0.3587077

prior <-
  prior(normal(-0.5, 1), nlpar = "t0C") +
  prior(normal(-0.5, 1), nlpar = "t0W") +
  prior(normal(0.2, 0.1), nlpar = "KC") +
  prior(normal(0.2, 0.1), nlpar = "KW") +
  prior(normal(45, 20), nlpar = "LinfC") +
  prior(normal(45, 20), nlpar = "LinfW")
  
start_time <- Sys.time()
m1 <- 
  brm(
    bf(log(length_cm) ~ areaW*log(LinfW*(1-exp(-KW*(age-t0W)))) + areaC*log(LinfC*(1-exp(-KC*(age-t0C)))),
       t0C ~ 1,
       t0W ~ 1,
       KC ~ 1 + (1|birth_year),    # parameter varying by birth_year
       KW ~ 1 + (1|birth_year),    # parameter varying by birth_year
       LinfC ~ 1 + (1|birth_year), # parameter varying by birth_year
       LinfW ~ 1 + (1|birth_year), # parameter varying by birth_year
       nl = TRUE),
    data = d,
    family = student(), prior = prior, seed = 9, 
    iter = 4000, thin = 1, cores = 3, chains = 3, inits = inits_3_chain,
    control = list(max_treedepth = 13, adapt_delta = 0.99))
#> Warning: Argument 'inits' is deprecated. Please use argument 'init' instead.
#> Compiling Stan program...
#> Start sampling
end_time <- Sys.time()
end_time - start_time
#> Time difference of 8.270999 hours
# Time difference of 4.624257 hours

summary(m1)
#>  Family: student 
#>   Links: mu = identity; sigma = identity; nu = identity 
#> Formula: log(length_cm) ~ areaW * log(LinfW * (1 - exp(-KW * (age - t0W)))) + areaC * log(LinfC * (1 - exp(-KC * (age - t0C)))) 
#>          t0C ~ 1
#>          t0W ~ 1
#>          KC ~ 1 + (1 | birth_year)
#>          KW ~ 1 + (1 | birth_year)
#>          LinfC ~ 1 + (1 | birth_year)
#>          LinfW ~ 1 + (1 | birth_year)
#>    Data: d (Number of observations: 7434) 
#>   Draws: 3 chains, each with iter = 4000; warmup = 2000; thin = 1;
#>          total post-warmup draws = 6000
#> 
#> Group-Level Effects: 
#> ~birth_year (Number of levels: 17) 
#>                     Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(KC_Intercept)        0.04      0.01     0.03     0.07 1.00     2059     3465
#> sd(KW_Intercept)        0.08      0.02     0.05     0.12 1.00     2022     3364
#> sd(LinfC_Intercept)     6.82      1.47     4.48    10.20 1.00     2093     3257
#> sd(LinfW_Intercept)    19.03      5.22    11.15    31.93 1.00     1618     3198
#> 
#> Population-Level Effects: 
#>                 Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> t0C_Intercept      -0.44      0.06    -0.56    -0.33 1.00     6143     4528
#> t0W_Intercept      -0.16      0.03    -0.21    -0.11 1.00     7499     4305
#> KC_Intercept        0.15      0.01     0.12     0.17 1.00     1832     3269
#> KW_Intercept        0.19      0.02     0.15     0.23 1.00     1444     2365
#> LinfC_Intercept    39.38      2.09    35.55    43.76 1.00     2043     2797
#> LinfW_Intercept    45.86      5.10    36.57    56.95 1.00     1093     2245
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma     0.11      0.00     0.11     0.11 1.00     6356     4352
#> nu       11.75      1.68     9.02    15.59 1.00     6632     4659
#> 
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
plot(m1)

# Save model object to not have to rerun it...
# saveRDS(m1, "output/vbge/m1.rds")
# m1 <- readRDS("output/vbge/m1.rds")

# > prior_summary(m1)

M2: L_inf common parameter, t_0 & K specific

prior2 <-
  prior(normal(-0.5, 1), nlpar = "t0C") +
  prior(normal(-0.5, 1), nlpar = "t0W") +
  prior(normal(0.2, 0.1), nlpar = "KC") +
  prior(normal(0.2, 0.1), nlpar = "KW") +
  prior(normal(45, 20), nlpar = "Linf")

start_time <- Sys.time()
m2 <- 
  brm(
    bf(log(length_cm) ~ areaW*log(Linf*(1-exp(-KW*(age-t0W)))) + areaC*log(Linf*(1-exp(-KC*(age-t0C)))),
       t0C ~ 1,
       t0W ~ 1,
       KC ~ 1 + (1|birth_year),   # parameter varying by birth_year
       KW ~ 1 + (1|birth_year),   # parameter varying by birth_year
       Linf ~ 1 + (1|birth_year), # parameter varying by birth_year
       nl = TRUE),
    data = d,
    family = student(), prior = prior2, seed = 9, 
    iter = 4000, thin = 1, cores = 3, chains = 3, inits = inits_3_chain,
    control = list(max_treedepth = 13, adapt_delta = 0.99))
#> Warning: Argument 'inits' is deprecated. Please use argument 'init' instead.
#> Compiling Stan program...
#> Start sampling
end_time <- Sys.time()
end_time - start_time
#> Time difference of 4.460673 hours
# Time difference of 3.828257 hours

summary(m2)
#>  Family: student 
#>   Links: mu = identity; sigma = identity; nu = identity 
#> Formula: log(length_cm) ~ areaW * log(Linf * (1 - exp(-KW * (age - t0W)))) + areaC * log(Linf * (1 - exp(-KC * (age - t0C)))) 
#>          t0C ~ 1
#>          t0W ~ 1
#>          KC ~ 1 + (1 | birth_year)
#>          KW ~ 1 + (1 | birth_year)
#>          Linf ~ 1 + (1 | birth_year)
#>    Data: d (Number of observations: 7434) 
#>   Draws: 3 chains, each with iter = 4000; warmup = 2000; thin = 1;
#>          total post-warmup draws = 6000
#> 
#> Group-Level Effects: 
#> ~birth_year (Number of levels: 17) 
#>                    Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(KC_Intercept)       0.03      0.01     0.02     0.05 1.00     2284     3075
#> sd(KW_Intercept)       0.04      0.01     0.03     0.06 1.00     2351     3688
#> sd(Linf_Intercept)    10.27      2.59     6.29    16.44 1.00     1695     3514
#> 
#> Population-Level Effects: 
#>                Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> t0C_Intercept     -0.59      0.05    -0.69    -0.50 1.00     5431     4923
#> t0W_Intercept     -0.18      0.02    -0.23    -0.14 1.00     6000     5019
#> KC_Intercept       0.13      0.01     0.11     0.15 1.00     2172     3132
#> KW_Intercept       0.19      0.01     0.17     0.21 1.00     2479     3283
#> Linf_Intercept    41.97      2.76    36.81    47.85 1.00     1503     2243
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma     0.11      0.00     0.11     0.12 1.00     6496     4938
#> nu       12.85      1.99     9.68    17.44 1.00     6216     4610
#> 
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
plot(m2)

# Save model object to not have to rerun it...
# saveRDS(m2, "output/vbge/m2.rds")
# m2 <- readRDS("output/vbge/m2.rds")

M3: K common parameter, t_0 & L_inf specific

prior3 <-
  prior(normal(-0.5, 1), nlpar = "t0C") +
  prior(normal(-0.5, 1), nlpar = "t0W") +
  prior(normal(0.2, 0.1), nlpar = "K") +
  prior(normal(45, 20), nlpar = "LinfC") +
  prior(normal(45, 20), nlpar = "LinfW")

start_time <- Sys.time()
m3 <- 
  brm(
    bf(log(length_cm) ~ areaW*log(LinfW*(1-exp(-K*(age-t0W)))) + areaC*log(LinfC*(1-exp(-K*(age-t0C)))),
       t0C ~ 1,
       t0W ~ 1,
       K ~ 1 + (1|birth_year),      # parameter varying by birth_year
       LinfC ~ 1 + (1|birth_year),  # parameter varying by birth_year
       LinfW ~ 1 + (1|birth_year),  # parameter varying by birth_year
       nl = TRUE),
    data = d,
    family = student(), prior = prior3, seed = 9, 
    iter = 4000, thin = 1, cores = 3, chains = 3, inits = inits_3_chain,
    control = list(max_treedepth = 13, adapt_delta = 0.99))
#> Warning: Argument 'inits' is deprecated. Please use argument 'init' instead.
#> Compiling Stan program...
#> Start sampling
end_time <- Sys.time()
end_time - start_time 
#> Time difference of 5.259894 hours
# Time difference of 3.402677 hours

summary(m3)
#>  Family: student 
#>   Links: mu = identity; sigma = identity; nu = identity 
#> Formula: log(length_cm) ~ areaW * log(LinfW * (1 - exp(-K * (age - t0W)))) + areaC * log(LinfC * (1 - exp(-K * (age - t0C)))) 
#>          t0C ~ 1
#>          t0W ~ 1
#>          K ~ 1 + (1 | birth_year)
#>          LinfC ~ 1 + (1 | birth_year)
#>          LinfW ~ 1 + (1 | birth_year)
#>    Data: d (Number of observations: 7434) 
#>   Draws: 3 chains, each with iter = 4000; warmup = 2000; thin = 1;
#>          total post-warmup draws = 6000
#> 
#> Group-Level Effects: 
#> ~birth_year (Number of levels: 17) 
#>                     Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(K_Intercept)         0.03      0.01     0.02     0.05 1.00     2622     3757
#> sd(LinfC_Intercept)     6.01      1.34     3.90     9.15 1.00     2168     3360
#> sd(LinfW_Intercept)    10.51      2.22     7.06    15.58 1.00     2130     3798
#> 
#> Population-Level Effects: 
#>                 Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> t0C_Intercept      -0.40      0.04    -0.48    -0.31 1.00     6070     4204
#> t0W_Intercept      -0.29      0.02    -0.34    -0.25 1.00     6407     4906
#> K_Intercept         0.16      0.01     0.14     0.17 1.00     2667     3467
#> LinfC_Intercept    37.16      1.68    33.92    40.59 1.00     1999     2780
#> LinfW_Intercept    46.83      2.85    41.44    52.55 1.00     1774     3146
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma     0.11      0.00     0.11     0.12 1.00     7118     4349
#> nu       12.30      1.75     9.44    16.36 1.00     7827     4409
#> 
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
plot(m3)

# Save model object to not have to rerun it...
# saveRDS(m3, "output/vbge/m3.rds")
# m3 <- readRDS("output/vbge/m3.rds")

M4: t_0 common parameter, K & L_inf specific

prior4 <-
  prior(normal(-0.5, 1), nlpar = "t0") +
  prior(normal(0.2, 0.1), nlpar = "KC") +
  prior(normal(0.2, 0.1), nlpar = "KW") +
  prior(normal(45, 20), nlpar = "LinfC") +
  prior(normal(45, 20), nlpar = "LinfW")

start_time <- Sys.time()
m4 <- 
  brm(
    bf(log(length_cm) ~ areaW*log(LinfW*(1-exp(-KW*(age-t0)))) + areaC*log(LinfC*(1-exp(-KC*(age-t0)))),
       t0 ~ 1,
       KC ~ 1 + (1|birth_year),    # parameter varying by birth_year
       KW ~ 1 + (1|birth_year),    # parameter varying by birth_year
       LinfC ~ 1 + (1|birth_year), # parameter varying by birth_year
       LinfW ~ 1 + (1|birth_year), # parameter varying by birth_year
       nl = TRUE),
    data = d,
    family = student(), prior = prior4, seed = 9, 
    iter = 4000, thin = 1, cores = 3, chains = 3, inits = inits_3_chain,
    control = list(max_treedepth = 13, adapt_delta = 0.99))
#> Warning: Argument 'inits' is deprecated. Please use argument 'init' instead.
#> Compiling Stan program...
#> Start sampling
end_time <- Sys.time()
end_time - start_time
#> Time difference of 6.806711 hours
# Time difference of 2.186266 hours

summary(m4)
#>  Family: student 
#>   Links: mu = identity; sigma = identity; nu = identity 
#> Formula: log(length_cm) ~ areaW * log(LinfW * (1 - exp(-KW * (age - t0)))) + areaC * log(LinfC * (1 - exp(-KC * (age - t0)))) 
#>          t0 ~ 1
#>          KC ~ 1 + (1 | birth_year)
#>          KW ~ 1 + (1 | birth_year)
#>          LinfC ~ 1 + (1 | birth_year)
#>          LinfW ~ 1 + (1 | birth_year)
#>    Data: d (Number of observations: 7434) 
#>   Draws: 3 chains, each with iter = 4000; warmup = 2000; thin = 1;
#>          total post-warmup draws = 6000
#> 
#> Group-Level Effects: 
#> ~birth_year (Number of levels: 17) 
#>                     Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(KC_Intercept)        0.05      0.01     0.03     0.07 1.00     1888     3175
#> sd(KW_Intercept)        0.07      0.02     0.05     0.11 1.00     1918     2910
#> sd(LinfC_Intercept)     5.43      1.11     3.69     7.92 1.00     2106     3383
#> sd(LinfW_Intercept)    22.41      6.28    13.04    37.23 1.00     1591     2628
#> 
#> Population-Level Effects: 
#>                 Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> t0_Intercept       -0.21      0.02    -0.26    -0.17 1.00     6039     4806
#> KC_Intercept        0.17      0.01     0.15     0.20 1.00     1609     2324
#> KW_Intercept        0.18      0.02     0.14     0.22 1.00     1720     2619
#> LinfC_Intercept    35.88      1.46    33.16    38.90 1.00     1746     2835
#> LinfW_Intercept    48.30      5.68    37.87    60.67 1.00     1444     2132
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma     0.11      0.00     0.11     0.11 1.00     5467     3816
#> nu       11.75      1.62     9.13    15.45 1.00     5171     4027
#> 
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
plot(m4)

# Save model object to not have to rerun it...
# saveRDS(m4, "output/vbge/m4.rds")
# m4 <- readRDS("output/vbge/m4.rds")

M5: L_inf & K common parameter, t_0 specific

prior5 <-
  prior(normal(-0.5, 1), nlpar = "t0C") +
  prior(normal(-0.5, 1), nlpar = "t0W") +
  prior(normal(0.2, 0.1), nlpar = "K") +
  prior(normal(45, 20), nlpar = "Linf")

start_time <- Sys.time()
m5 <- 
  brm(
    bf(log(length_cm) ~ areaW*log(Linf*(1-exp(-K*(age-t0W)))) + areaC*log(Linf*(1-exp(-K*(age-t0C)))),
       t0C ~ 1,
       t0W ~ 1,
       K ~ 1 + (1|birth_year),    # parameter varying by birth_year
       Linf ~ 1 + (1|birth_year), # parameter varying by birth_year
       nl = TRUE),
    data = d,
    family = student(), prior = prior5, seed = 9, 
    iter = 4000, thin = 1, cores = 3, chains = 3, inits = inits_3_chain,
    control = list(max_treedepth = 13, adapt_delta = 0.99))
#> Warning: Argument 'inits' is deprecated. Please use argument 'init' instead.
#> Compiling Stan program...
#> Start sampling
#> Warning: The largest R-hat is 1.67, indicating chains have not mixed.
#> Running the chains for more iterations may help. See
#> http://mc-stan.org/misc/warnings.html#r-hat
#> Warning: Bulk Effective Samples Size (ESS) is too low, indicating posterior means and medians may be unreliable.
#> Running the chains for more iterations may help. See
#> http://mc-stan.org/misc/warnings.html#bulk-ess
#> Warning: Tail Effective Samples Size (ESS) is too low, indicating posterior variances and tail quantiles may be unreliable.
#> Running the chains for more iterations may help. See
#> http://mc-stan.org/misc/warnings.html#tail-ess
end_time <- Sys.time()
end_time - start_time
#> Time difference of 4.071098 hours
# Time difference of 4.4384 hours

summary(m5)
#> Warning: Parts of the model have not converged (some Rhats are > 1.05). Be
#> careful when analysing the results! We recommend running more iterations and/or
#> setting stronger priors.
#>  Family: student 
#>   Links: mu = identity; sigma = identity; nu = identity 
#> Formula: log(length_cm) ~ areaW * log(Linf * (1 - exp(-K * (age - t0W)))) + areaC * log(Linf * (1 - exp(-K * (age - t0C)))) 
#>          t0C ~ 1
#>          t0W ~ 1
#>          K ~ 1 + (1 | birth_year)
#>          Linf ~ 1 + (1 | birth_year)
#>    Data: d (Number of observations: 7434) 
#>   Draws: 3 chains, each with iter = 4000; warmup = 2000; thin = 1;
#>          total post-warmup draws = 6000
#> 
#> Group-Level Effects: 
#> ~birth_year (Number of levels: 17) 
#>                    Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(K_Intercept)        0.02      0.02     0.00     0.05 1.67        5       37
#> sd(Linf_Intercept)     3.07      1.34     0.23     5.50 1.20       12       35
#> 
#> Population-Level Effects: 
#>                Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> t0C_Intercept     -0.58      1.02    -2.10     0.19 1.66        5       35
#> t0W_Intercept     -1.26      1.08    -2.86    -0.45 1.66        5       36
#> K_Intercept        0.14      0.11    -0.02     0.23 1.66        5       38
#> Linf_Intercept   -30.22     90.70  -174.40    35.66 1.66        5       34
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma     0.13      0.01     0.12     0.14 1.66        5       31
#> nu       16.97      3.51    11.92    25.27 1.05       38      143
#> 
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
plot(m5)

# Save model object to not have to rerun it...
# saveRDS(m5, "output/vbge/m5.rds")
# m5 <- readRDS("output/vbge/m5.rds")

M6: L_inf & t_0 common parameter, K specific

prior6 <-
  prior(normal(-0.5, 1), nlpar = "t0") +
  prior(normal(0.2, 0.1), nlpar = "KC") +
  prior(normal(0.2, 0.1), nlpar = "KW") +
  prior(normal(45, 20), nlpar = "Linf")

start_time <- Sys.time()
m6 <- 
  brm(
    bf(log(length_cm) ~ areaW*log(Linf*(1-exp(-KW*(age-t0)))) + areaC*log(Linf*(1-exp(-KC*(age-t0)))),
       t0 ~ 1,
       KC ~ 1 + (1|birth_year),    # parameter varying by birth_year
       KW ~ 1 + (1|birth_year),    # parameter varying by birth_year
       Linf ~ 1 + (1|birth_year),  # parameter varying by birth_year
       nl = TRUE),
    data = d,
    family = student(), prior = prior6, seed = 9, 
    iter = 4000, thin = 1, cores = 3, chains = 3, inits = inits_3_chain,
    control = list(max_treedepth = 13, adapt_delta = 0.99))
#> Warning: Argument 'inits' is deprecated. Please use argument 'init' instead.
#> Compiling Stan program...
#> Start sampling
end_time <- Sys.time()
end_time - start_time
#> Time difference of 3.651207 hours
# Time difference of 1.077574 hours

summary(m6)
#>  Family: student 
#>   Links: mu = identity; sigma = identity; nu = identity 
#> Formula: log(length_cm) ~ areaW * log(Linf * (1 - exp(-KW * (age - t0)))) + areaC * log(Linf * (1 - exp(-KC * (age - t0)))) 
#>          t0 ~ 1
#>          KC ~ 1 + (1 | birth_year)
#>          KW ~ 1 + (1 | birth_year)
#>          Linf ~ 1 + (1 | birth_year)
#>    Data: d (Number of observations: 7434) 
#>   Draws: 3 chains, each with iter = 4000; warmup = 2000; thin = 1;
#>          total post-warmup draws = 6000
#> 
#> Group-Level Effects: 
#> ~birth_year (Number of levels: 17) 
#>                    Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(KC_Intercept)       0.04      0.01     0.03     0.05 1.00     2143     3214
#> sd(KW_Intercept)       0.04      0.01     0.03     0.06 1.00     2103     2717
#> sd(Linf_Intercept)     7.07      1.64     4.57    10.99 1.00     1855     2802
#> 
#> Population-Level Effects: 
#>                Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> t0_Intercept      -0.20      0.02    -0.25    -0.16 1.00     7050     4585
#> KC_Intercept       0.16      0.01     0.14     0.18 1.00     1472     2495
#> KW_Intercept       0.21      0.01     0.19     0.24 1.00     2409     3106
#> Linf_Intercept    37.63      1.89    34.09    41.55 1.00     1247     2359
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma     0.11      0.00     0.11     0.12 1.00     6825     4723
#> nu       12.69      1.92     9.67    17.09 1.00     7169     4598
#> 
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
plot(m6)

# Save model object to not have to rerun it...
# saveRDS(m6, "output/vbge/m6.rds")
# m6 <- readRDS("output/vbge/m6.rds")

M7: K & t_0 common parameter, L_inf specific

prior7 <-
  prior(normal(-0.5, 1), nlpar = "t0") +
  prior(normal(0.2, 0.1), nlpar = "K") +
  prior(normal(45, 20), nlpar = "LinfC") +
  prior(normal(45, 20), nlpar = "LinfW")

start_time <- Sys.time()
m7 <- 
  brm(
    bf(log(length_cm) ~ areaW*log(LinfW*(1-exp(-K*(age-t0)))) + areaC*log(LinfC*(1-exp(-K*(age-t0)))),
       t0 ~ 1,
       K ~ 1 + (1|birth_year),     # parameter varying by birth_year
       LinfC ~ 1 + (1|birth_year), # parameter varying by birth_year
       LinfW ~ 1 + (1|birth_year), # parameter varying by birth_year
       nl = TRUE),
    data = d,
    family = student(), prior = prior7, seed = 9, 
    iter = 4000, thin = 1, cores = 3, chains = 3, inits = inits_3_chain,
    control = list(max_treedepth = 13, adapt_delta = 0.99))
#> Warning: Argument 'inits' is deprecated. Please use argument 'init' instead.
#> Compiling Stan program...
#> Start sampling
end_time <- Sys.time()
end_time - start_time
#> Time difference of 2.845204 hours
# Time difference of 58.70017 mins

summary(m7)
#>  Family: student 
#>   Links: mu = identity; sigma = identity; nu = identity 
#> Formula: log(length_cm) ~ areaW * log(LinfW * (1 - exp(-K * (age - t0)))) + areaC * log(LinfC * (1 - exp(-K * (age - t0)))) 
#>          t0 ~ 1
#>          K ~ 1 + (1 | birth_year)
#>          LinfC ~ 1 + (1 | birth_year)
#>          LinfW ~ 1 + (1 | birth_year)
#>    Data: d (Number of observations: 7434) 
#>   Draws: 3 chains, each with iter = 4000; warmup = 2000; thin = 1;
#>          total post-warmup draws = 6000
#> 
#> Group-Level Effects: 
#> ~birth_year (Number of levels: 17) 
#>                     Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(K_Intercept)         0.03      0.01     0.02     0.05 1.00     2322     3597
#> sd(LinfC_Intercept)     5.38      1.16     3.51     8.15 1.00     2268     3602
#> sd(LinfW_Intercept)     9.34      1.94     6.28    13.89 1.00     2118     3672
#> 
#> Population-Level Effects: 
#>                 Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> t0_Intercept       -0.28      0.02    -0.33    -0.24 1.00    10453     4498
#> K_Intercept         0.17      0.01     0.15     0.19 1.00     2043     3124
#> LinfC_Intercept    36.16      1.44    33.42    39.12 1.00     1465     2856
#> LinfW_Intercept    44.51      2.47    39.74    49.48 1.00     1514     2340
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma     0.11      0.00     0.11     0.12 1.00     7747     4274
#> nu       12.32      1.81     9.44    16.54 1.00     8531     4370
#> 
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
plot(m7)

# Save model object to not have to rerun it...
# saveRDS(m7, "output/vbge/m7.rds")
# m7 <- readRDS("output/vbge/m7.rds")

M8: All parameters common

prior8 <-
  prior(normal(-0.5, 1), nlpar = "t0") +
  prior(normal(0.2, 0.1), nlpar = "K") +
  prior(normal(45, 20), nlpar = "Linf")

start_time <- Sys.time()
m8 <- 
  brm(
    bf(log(length_cm) ~ areaW*log(Linf*(1-exp(-K*(age-t0)))) + areaC*log(Linf*(1-exp(-K*(age-t0)))),
       t0 ~ 1,
       K ~ 1 + (1|birth_year),     # parameter varying by birth_year
       Linf ~ 1 + (1|birth_year),  # parameter varying by birth_year
       nl = TRUE),
    data = d,
    family = student(), prior = prior8, seed = 9, 
    iter = 4000, thin = 1, cores = 3, chains = 3, inits = inits_3_chain,
    control = list(max_treedepth = 13, adapt_delta = 0.99))
#> Warning: Argument 'inits' is deprecated. Please use argument 'init' instead.
#> Compiling Stan program...
#> Start sampling
#> Warning: The largest R-hat is 1.66, indicating chains have not mixed.
#> Running the chains for more iterations may help. See
#> http://mc-stan.org/misc/warnings.html#r-hat
#> Warning: Bulk Effective Samples Size (ESS) is too low, indicating posterior means and medians may be unreliable.
#> Running the chains for more iterations may help. See
#> http://mc-stan.org/misc/warnings.html#bulk-ess
#> Warning: Tail Effective Samples Size (ESS) is too low, indicating posterior variances and tail quantiles may be unreliable.
#> Running the chains for more iterations may help. See
#> http://mc-stan.org/misc/warnings.html#tail-ess
end_time <- Sys.time()
end_time - start_time
#> Time difference of 4.555278 hours
# Warning messages:
#   1: The largest R-hat is 1.68, indicating chains have not mixed.
# Running the chains for more iterations may help. See
# http://mc-stan.org/misc/warnings.html#r-hat 
# 2: Bulk Effective Samples Size (ESS) is too low, indicating posterior means and medians may be unreliable.
# Running the chains for more iterations may help. See
# http://mc-stan.org/misc/warnings.html#bulk-ess 
# 3: Tail Effective Samples Size (ESS) is too low, indicating posterior variances and tail quantiles may be unreliable.
# Running the chains for more iterations may help. See
# http://mc-stan.org/misc/warnings.html#tail-ess 
summary(m8)
#> Warning: Parts of the model have not converged (some Rhats are > 1.05). Be
#> careful when analysing the results! We recommend running more iterations and/or
#> setting stronger priors.
#>  Family: student 
#>   Links: mu = identity; sigma = identity; nu = identity 
#> Formula: log(length_cm) ~ areaW * log(Linf * (1 - exp(-K * (age - t0)))) + areaC * log(Linf * (1 - exp(-K * (age - t0)))) 
#>          t0 ~ 1
#>          K ~ 1 + (1 | birth_year)
#>          Linf ~ 1 + (1 | birth_year)
#>    Data: d (Number of observations: 7434) 
#>   Draws: 3 chains, each with iter = 4000; warmup = 2000; thin = 1;
#>          total post-warmup draws = 6000
#> 
#> Group-Level Effects: 
#> ~birth_year (Number of levels: 17) 
#>                    Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(K_Intercept)        0.01      0.01     0.00     0.04 1.66        5       38
#> sd(Linf_Intercept)     2.95      1.68     0.13     6.61 1.18     1140     1112
#> 
#> Population-Level Effects: 
#>                Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> t0_Intercept      -2.08      1.08    -2.94    -0.50 1.66        5       31
#> K_Intercept        0.05      0.09    -0.02     0.20 1.66        5       34
#> Linf_Intercept   -86.26     85.74  -166.17    35.78 1.66        5       39
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma     0.15      0.01     0.14     0.16 1.66        5       35
#> nu       27.38      8.91    15.77    50.06 1.17       12       62
#> 
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
plot(m8)

# Save model object to not have to rerun it...
# saveRDS(m8, "output/vbge/m8.rds")
# m8 <- readRDS("output/vbge/m8.rds")

Compare models

loo_m1 <- loo(m1)
loo_m2 <- loo(m2)
loo_m3 <- loo(m3)
loo_m4 <- loo(m4)
loo_m5 <- loo(m5)
loo_m6 <- loo(m6)
loo_m7 <- loo(m7)
loo_m8 <- loo(m8)

# Compare models
loo_compare(loo_m1, loo_m2, loo_m3, loo_m4, loo_m5, loo_m6, loo_m7, loo_m8)
#>    elpd_diff se_diff
#> m1     0.0       0.0
#> m4    -9.8       4.6
#> m2  -112.0      16.5
#> m3  -152.0      19.5
#> m7  -158.9      19.6
#> m6  -174.9      20.8
#> m5 -1338.0      49.2
#> m8 -2155.3      63.9

Figures

Main figures

# https://mjskay.github.io/tidybayes/articles/tidy-brms.html
# m1 <- readRDS("output/vbge/m1.rds")

pal <- rev(brewer.pal(n = 6, name = "Paired")[c(2, 6)])

# Plot main predictions
pvbge <- d %>% 
  data_grid(age = seq_range(age, by = 1),
            area = c("FM", "BT")) %>%
  mutate(areaC = ifelse(area == "FM", 1, 0),
         areaW = ifelse(area == "BT", 1, 0)) %>% 
  add_predicted_draws(m1, re_formula = NA) %>%
  ggplot(aes(x = factor(age), y = length_cm, color = area, fill = area)) +
  stat_lineribbon(aes(y = exp(.prediction)), .width = c(.5, 0.9), alpha = 0.2, size = 0.8) +
  geom_jitter(data = d, alpha = 0.1, width = 0.3, height = 0, size = 0.8) +
  stat_lineribbon(aes(y = exp(.prediction)), .width = 0, alpha = 0.8, size = 0.8) +
  guides(fill = "none",
         color = guide_legend(override.aes = list(linetype = 0, fill = NA,
                                                  size = 3, shape = 16, alpha = 0.5))) +
  scale_fill_manual(values = pal, labels = c("Heated", "Reference")) +
  scale_color_manual(values = pal, labels = c("Heated", "Reference")) +
  labs(y = "Length [cm]", x = "Age [yrs]", fill = "Area", colour = "Area") +
  annotate("text", 8, 10, label = paste("n=", nrow(d), sep = ""), size = 3) +
  theme(text = element_text(size = 12), # 12 for word doc
        legend.position = c(0.1, 0.9), 
        legend.spacing.y = unit(0, 'cm'),
        legend.key.size = unit(0, "cm"),
        legend.title = element_text(size = 10),
        legend.text = element_text(size = 10))
#> mutate: new variable 'areaC' (double) with 2 unique values and 0% NA
#>         new variable 'areaW' (double) with 2 unique values and 0% NA

# Plotting mcmc_dens and use patchwork to plot them together. Note I add the vertical
# lines manually simply by extracting the fixed effects
m1_fe <- fixef(m1, probs = c(0.1, 0.9)) %>% as.data.frame()
posterior <- as.array(m1)

# http://mjskay.github.io/tidybayes/articles/tidy-brms.html
post_K <- 
  m1 %>%
  gather_draws(b_KC_Intercept, b_KW_Intercept) %>%
  ggplot(aes(x = .value, fill = .variable, color = .variable)) +
  stat_halfeye(alpha = 0.5, size = 5, .width = c(0.7)) +
  guides(fill = guide_legend(override.aes = list(size = 1, shape = NA, linetype = 0)),
         color = "none") +
  #guides(fill = "none", color = "none") + 
  scale_fill_manual(values = rev(pal), labels = c("Ref", "Heat")) +
  scale_color_manual(values = rev(pal)) +
  labs(x = expression(paste(italic(K), " [", yr^-1,"]", sep = "")), fill = "") +
  theme(legend.position = c(0.9, 0.9),
        legend.key.size = unit(0.2, "cm"),
        legend.background = element_blank())

post_L_inf <- 
  m1 %>%
  gather_draws(b_LinfC_Intercept, b_LinfW_Intercept) %>%
  ggplot(aes(x = .value, fill = .variable, color = .variable)) +
  stat_halfeye(alpha = 0.5, size = 5, .width = c(0.7)) +
  # guides(fill = guide_legend(override.aes = list(size = 1, shape = NA, linetype = 0)),
  #        color = "none") +
  guides(fill = "none", color = "none") + 
  scale_fill_manual(values = rev(pal), labels = c("Cold", "Warm")) +
  scale_color_manual(values = rev(pal)) +
  labs(x = expression(paste(italic(L[infinity]), " [cm]")), fill = "") +
  theme(legend.position = c(0.9, 0.9),
        legend.key.size = unit(0.2, "cm"),
        legend.background = element_blank())

# Plot distribution of differences
# http://mjskay.github.io/tidybayes/articles/tidy-brms.html
diff <- m1 %>%
  spread_draws(b_LinfC_Intercept, b_LinfW_Intercept, b_KC_Intercept, b_KW_Intercept) %>%
  mutate(diff_K = b_KW_Intercept - b_KC_Intercept,
         diff_L_inf = b_LinfW_Intercept - b_LinfC_Intercept) 
#> mutate: new variable 'diff_K' (double) with 6,000 unique values and 0% NA
#>         new variable 'diff_L_inf' (double) with 6,000 unique values and 0% NA

prop_diff_K <- summarise(diff, Proportion_of_the_difference_below_0 = sum(diff_K < 0) / length(diff_K))
#> summarise: now one row and one column, ungrouped
prop_diff_L_inf <- summarise(diff, Proportion_of_the_difference_below_0 = sum(diff_L_inf < 0) / length(diff_L_inf))
#> summarise: now one row and one column, ungrouped

round(prop_diff_K, 2)

round(prop_diff_L_inf, 2)

# https://bookdown.org/content/3890/interactions.html
post_diff_K <- ggplot(diff, aes(x = diff_K, fill = stat(x > 0))) +
  stat_halfeye(alpha = 0.5, size = 5, .width = 0) +
  guides(fill = guide_legend(override.aes = list(size = 1, shape = NA, linetype = 0)), color = "none") + 
  scale_fill_manual(values = c("grey10", "grey70")) +
  #annotate("text", 0.01, 0.95, size = 3, label = paste("Proportion of difference < 0=", round(prop_diff_K, 2), sep = "")) +
  labs(x = expression(~italic(K)[heat]~-~italic(K)[ref])) +
  theme(legend.position = c(0.2, 0.7),
        legend.key.size = unit(0.2, "cm"),
        legend.text = element_text(size = 8),
        legend.title = element_text(size = 10),
        legend.background = element_blank())

post_diff_L_inf <- ggplot(diff, aes(x = diff_L_inf, fill = stat(x > 0))) +
  stat_halfeye(alpha = 0.5, size = 5, .width = 0) +
  guides(fill = guide_legend(override.aes = list(size = 1, shape = NA, linetype = 0)), color = "none") + 
  scale_fill_manual(values = c("grey10", "grey70")) +
  #annotate("text", 0, 0.95, size = 3, label = paste("Proportion of difference < 0 =", round(prop_diff_L_inf, 2), sep = "")) +
  labs(x = expression(paste(~italic(L[infinity])[heat]~-~italic(L[infinity])[ref]))) +
  theme(legend.position = c(0.2, 0.7),
        legend.key.size = unit(0.2, "cm"),
        legend.text = element_text(size = 8),
        legend.title = element_text(size = 10),
        legend.background = element_blank())

pvbge

ggsave("figures/vbge_pred.pdf", width = 20, height = 20, unit = "cm")

#ggsave("figures/vbge_pred_K_Linf_post.png", width = 6.5, height = 6.5, dpi = 600)

((post_K/post_diff_K) | (post_L_inf/post_diff_L_inf)) +
  plot_layout(heights = c(1.2, 1)) +
  plot_annotation(tag_levels = 'A')

ggsave("figures/supp/vbge_K_Linf_post.pdf", width = 20, height = 20, unit = "cm")

Supporting figures

Random year effects

# http://mjskay.github.io/tidybayes/articles/tidy-brms.html

pal2 <- alpha(pal, alpha = 0.8)

# Plot predictions by cohort:
p2 <- d %>%
  data_grid(age = seq_range(age, by = 1),
            birth_year = seq_range(birth_year, by = 1),
            area = c("FM", "BT")) %>%
  mutate(areaC = ifelse(area == "FM", 1, 0),
         areaW = ifelse(area == "BT", 1, 0)) %>%
  add_predicted_draws(m1) %>%
  ggplot(aes(x = factor(age), y = length_cm, color = area, fill = area)) +
  stat_lineribbon(aes(y = exp(.prediction)), .width = .95, alpha = 0.4, size = 0.5) +
  stat_lineribbon(aes(y = exp(.prediction)), .width = 0, alpha = 0.8, size = 0.5) +
  geom_jitter(data = d, alpha = 0.2, width = 0.3,
              height = 0, size = 0.6) +
  facet_wrap(~birth_year) +
  scale_fill_manual(values = pal2, labels = c("Warm", "Cold")) +
  scale_color_manual(values = pal2, labels = c("Warm", "Cold")) +
  labs(y = "Length [cm]", x = "Age [yrs]", fill = "Area", colour = "Area") +
  NULL
#> mutate: new variable 'areaC' (double) with 2 unique values and 0% NA
#>         new variable 'areaW' (double) with 2 unique values and 0% NA

pWord2 <- p2 + theme(text = element_text(size = 12),
                     legend.position = c(0.7, 0.1),
                     legend.title = element_text(size = 12),
                     legend.text = element_text(size = 12))

#ggsave("figures/supp/vbge_pred_cohort.png", width = 6.5, height = 6.5, dpi = 600)
ggsave("figures/supp/vbge_pred_cohort.pdf", width = 20, height = 20, unit = "cm")


# Cohort-specific VBGE parameters
get_variables(m1)
#>  [1] "b_t0C_Intercept"                     "b_t0W_Intercept"                    
#>  [3] "b_KC_Intercept"                      "b_KW_Intercept"                     
#>  [5] "b_LinfC_Intercept"                   "b_LinfW_Intercept"                  
#>  [7] "sd_birth_year__KC_Intercept"         "sd_birth_year__KW_Intercept"        
#>  [9] "sd_birth_year__LinfC_Intercept"      "sd_birth_year__LinfW_Intercept"     
#> [11] "sigma"                               "nu"                                 
#> [13] "r_birth_year__KC[1981,Intercept]"    "r_birth_year__KC[1982,Intercept]"   
#> [15] "r_birth_year__KC[1983,Intercept]"    "r_birth_year__KC[1984,Intercept]"   
#> [17] "r_birth_year__KC[1985,Intercept]"    "r_birth_year__KC[1986,Intercept]"   
#> [19] "r_birth_year__KC[1987,Intercept]"    "r_birth_year__KC[1988,Intercept]"   
#> [21] "r_birth_year__KC[1989,Intercept]"    "r_birth_year__KC[1990,Intercept]"   
#> [23] "r_birth_year__KC[1991,Intercept]"    "r_birth_year__KC[1992,Intercept]"   
#> [25] "r_birth_year__KC[1993,Intercept]"    "r_birth_year__KC[1994,Intercept]"   
#> [27] "r_birth_year__KC[1995,Intercept]"    "r_birth_year__KC[1996,Intercept]"   
#> [29] "r_birth_year__KC[1997,Intercept]"    "r_birth_year__KW[1981,Intercept]"   
#> [31] "r_birth_year__KW[1982,Intercept]"    "r_birth_year__KW[1983,Intercept]"   
#> [33] "r_birth_year__KW[1984,Intercept]"    "r_birth_year__KW[1985,Intercept]"   
#> [35] "r_birth_year__KW[1986,Intercept]"    "r_birth_year__KW[1987,Intercept]"   
#> [37] "r_birth_year__KW[1988,Intercept]"    "r_birth_year__KW[1989,Intercept]"   
#> [39] "r_birth_year__KW[1990,Intercept]"    "r_birth_year__KW[1991,Intercept]"   
#> [41] "r_birth_year__KW[1992,Intercept]"    "r_birth_year__KW[1993,Intercept]"   
#> [43] "r_birth_year__KW[1994,Intercept]"    "r_birth_year__KW[1995,Intercept]"   
#> [45] "r_birth_year__KW[1996,Intercept]"    "r_birth_year__KW[1997,Intercept]"   
#> [47] "r_birth_year__LinfC[1981,Intercept]" "r_birth_year__LinfC[1982,Intercept]"
#> [49] "r_birth_year__LinfC[1983,Intercept]" "r_birth_year__LinfC[1984,Intercept]"
#> [51] "r_birth_year__LinfC[1985,Intercept]" "r_birth_year__LinfC[1986,Intercept]"
#> [53] "r_birth_year__LinfC[1987,Intercept]" "r_birth_year__LinfC[1988,Intercept]"
#> [55] "r_birth_year__LinfC[1989,Intercept]" "r_birth_year__LinfC[1990,Intercept]"
#> [57] "r_birth_year__LinfC[1991,Intercept]" "r_birth_year__LinfC[1992,Intercept]"
#> [59] "r_birth_year__LinfC[1993,Intercept]" "r_birth_year__LinfC[1994,Intercept]"
#> [61] "r_birth_year__LinfC[1995,Intercept]" "r_birth_year__LinfC[1996,Intercept]"
#> [63] "r_birth_year__LinfC[1997,Intercept]" "r_birth_year__LinfW[1981,Intercept]"
#> [65] "r_birth_year__LinfW[1982,Intercept]" "r_birth_year__LinfW[1983,Intercept]"
#> [67] "r_birth_year__LinfW[1984,Intercept]" "r_birth_year__LinfW[1985,Intercept]"
#> [69] "r_birth_year__LinfW[1986,Intercept]" "r_birth_year__LinfW[1987,Intercept]"
#> [71] "r_birth_year__LinfW[1988,Intercept]" "r_birth_year__LinfW[1989,Intercept]"
#> [73] "r_birth_year__LinfW[1990,Intercept]" "r_birth_year__LinfW[1991,Intercept]"
#> [75] "r_birth_year__LinfW[1992,Intercept]" "r_birth_year__LinfW[1993,Intercept]"
#> [77] "r_birth_year__LinfW[1994,Intercept]" "r_birth_year__LinfW[1995,Intercept]"
#> [79] "r_birth_year__LinfW[1996,Intercept]" "r_birth_year__LinfW[1997,Intercept]"
#> [81] "lprior"                              "lp__"                               
#> [83] "accept_stat__"                       "stepsize__"                         
#> [85] "treedepth__"                         "n_leapfrog__"                       
#> [87] "divergent__"                         "energy__"

# Warm K
pKW <- m1 %>%
  spread_draws(b_KW_Intercept,
               r_birth_year__KW[birth_year, Intercept]) %>%
  mutate(year_mean_KW = b_KW_Intercept + r_birth_year__KW) %>% # The random effects are offsets
  ggplot(aes(y = factor(birth_year), x = year_mean_KW)) +
  stat_halfeye(fill = pal2[1], alpha = 0.8, point_interval = median_qi, .width = 0.95) + 
  labs(y = "Cohort", x = expression(paste(italic(K), " [", yr^-1,"]", sep = ""))) + 
  ggtitle("Warm")
#> Warning: `gather_()` was deprecated in tidyr 1.2.0.
#> ℹ Please use `gather()` instead.
#> ℹ The deprecated feature was likely used in the tidybayes package.
#>   Please report the issue at <]8;;https://github.com/mjskay/tidybayes/issues/newhttps://github.com/mjskay/tidybayes/issues/new]8;;>.
#> mutate (grouped): new variable 'year_mean_KW' (double) with 102,000 unique values and 0% NA

# Cold K
pKC <- m1 %>%
  spread_draws(b_KC_Intercept,
               r_birth_year__KC[birth_year, Intercept]) %>%
  mutate(year_mean_KC = b_KC_Intercept + r_birth_year__KC) %>% # The random effects are offsets
  ggplot(aes(y = factor(birth_year), x = year_mean_KC)) +
  stat_halfeye(fill = pal2[2], alpha = 0.8, point_interval = median_qi, .width = 0.95) + 
  labs(y = "Cohort", x = expression(paste(italic(K), " [", yr^-1,"]", sep = ""))) + 
  ggtitle("Cold")
#> mutate (grouped): new variable 'year_mean_KC' (double) with 102,000 unique values and 0% NA

pKW + pKC

#ggsave("figures/supp/vbge_random_K.png", width = 6.5, height = 6.5, dpi = 600)
ggsave("figures/supp/vbge_random_K.pdf", width = 20, height = 20, unit = "cm")

# Warm L_inf
pLinfW <- m1 %>%
  spread_draws(b_LinfW_Intercept,
               r_birth_year__LinfW[birth_year, Intercept]) %>%
  mutate(year_mean_LinfW = b_LinfW_Intercept + r_birth_year__LinfW) %>% # The random effects are offsets
  ggplot(aes(y = factor(birth_year), x = year_mean_LinfW)) +
  stat_halfeye(fill = pal2[1], alpha = 0.8, point_interval = median_qi, .width = 0.95) + 
  labs(y = "Cohort", x = expression(paste(italic(L[infinity]), " [cm]"))) + 
  coord_cartesian(xlim = c(26, 100)) +
  ggtitle("Warm")
#> mutate (grouped): new variable 'year_mean_LinfW' (double) with 102,000 unique values and 0% NA

# Cold L_inf
pLinfC <- m1 %>%
  spread_draws(b_LinfC_Intercept,
               r_birth_year__LinfC[birth_year, Intercept]) %>%
  mutate(year_mean_LinfC = b_LinfC_Intercept + r_birth_year__LinfC) %>% # The random effects are offsets
  ggplot(aes(y = factor(birth_year), x = year_mean_LinfC)) +
  stat_halfeye(fill = pal2[2], alpha = 0.8, point_interval = median_qi, .width = 0.95) + 
  labs(y = "Cohort", x = expression(paste(italic(L[infinity]), " [cm]"))) + 
  coord_cartesian(xlim = c(26, 100)) +
  ggtitle("Cold")
#> mutate (grouped): new variable 'year_mean_LinfC' (double) with 102,000 unique values and 0% NA

pLinfW + pLinfC

#ggsave("figures/supp/vbge_random_Linf.png", width = 6.5, height = 6.5, dpi = 600)
ggsave("figures/supp/vbge_random_Linf.pdf", width = 20, height = 20, unit = "cm")

Prior vs posterior

# https://discourse.mc-stan.org/t/presenting-influence-of-different-priors/23393
# Refit model and sample prior or load below (m1_w_prior)
prior <-
  prior(normal(-0.5, 1), nlpar = "t0C") +
  prior(normal(-0.5, 1), nlpar = "t0W") +
  prior(normal(0.2, 0.1), nlpar = "KC") +
  prior(normal(0.2, 0.1), nlpar = "KW") +
  prior(normal(45, 20), nlpar = "LinfC") +
  prior(normal(45, 20), nlpar = "LinfW")

m1_w_prior <-
  brm(
    bf(log(length_cm) ~ areaW*log(LinfW*(1-exp(-KW*(age-t0W)))) + areaC*log(LinfC*(1-exp(-KC*(age-t0C)))),
       t0C ~ 1,
       t0W ~ 1,
       KC ~ 1 + (1|birth_year),    # parameter varying by birth_year
       KW ~ 1 + (1|birth_year),    # parameter varying by birth_year
       LinfC ~ 1 + (1|birth_year), # parameter varying by birth_year
       LinfW ~ 1 + (1|birth_year), # parameter varying by birth_year
       nl = TRUE),
    data = d,
    family = student(), prior = prior, sample_prior = "yes", seed = 9,
    iter = 4000, thin = 1, cores = 3, chains = 3, inits = inits_3_chain,
    control = list(max_treedepth = 13, adapt_delta = 0.99))
#> Warning: Argument 'inits' is deprecated. Please use argument 'init' instead.
#> Compiling Stan program...
#> Start sampling

# saveRDS(m1_w_prior, "output/vbge/m1_w_prior.rds")
# m1_w_prior <- readRDS("output/vbge/m1_w_prior.rds")

post <- m1_w_prior %>%
  posterior_samples() %>%
  clean_names() %>% 
  dplyr::select(b_linf_w_intercept, b_linf_c_intercept, b_kw_intercept, b_kc_intercept, b_t0w_intercept, b_t0c_intercept, 
                prior_b_linf_w, prior_b_linf_c, prior_b_kw, prior_b_kc, prior_b_t0w, prior_b_t0c)
#> Warning: Method 'posterior_samples' is deprecated. Please see ?as_draws for
#> recommended alternatives.

post_long <- post %>% pivot_longer(cols = c(1:12), names_to = "Parameter", values_to = "value")
#> pivot_longer: reorganized (b_linf_w_intercept, b_linf_c_intercept, b_kw_intercept, b_kc_intercept, b_t0w_intercept, …) into (Parameter, value) [was 6000x12, now 72000x2]

# parameter Linf
prior_post_linf <- post_long %>%
  filter(Parameter %in% c("b_linf_w_intercept", "b_linf_c_intercept", "prior_b_linf_w", "prior_b_linf_c")) %>% 
  ggplot(., aes(value, fill = Parameter, color = Parameter, alpha = Parameter))+
  geom_density() +
  labs(x = expression(italic(L[infinity]))) +
  coord_cartesian(expand = 0) +
  scale_alpha_manual(values = c(0.4, 0.4, 0.1, 0.1)) +
  scale_color_manual(values = c(NA, NA, "gray50", "gray50")) +
  scale_fill_manual(values = c(pal[2], pal[1], NA, NA),
                    labels = c(expression(paste(~italic(L[infinity])[ref])), 
                               expression(paste(~italic(L[infinity])[heat])),
                               expression(paste(Prior~italic(L[infinity])[heat])),
                               expression(paste(Prior~italic(L[infinity])[ref])))) + 
  guides(color = "none", alpha = "none",
         fill = guide_legend(override.aes = list(color = c(NA, NA, "gray50", "gray50"),
                                                 alpha = c(0.4, 0.4, 0.1, 0.1)))) +
  theme(legend.position = c(0.2, 0.8),
        legend.text.align = 0)
#> filter: removed 48,000 rows (67%), 24,000 rows remaining

# parameter K
prior_post_K <- post_long %>%
  filter(Parameter %in% c("b_kw_intercept", "b_kc_intercept", "prior_b_kw", "prior_b_kc")) %>% 
  ggplot(., aes(value, fill = Parameter, color = Parameter, alpha = Parameter))+
  geom_density() +
  labs(x = expression(italic(K))) +
  coord_cartesian(expand = 0) +
  scale_alpha_manual(values = c(0.4, 0.4, 0.1, 0.1)) +
  scale_color_manual(values = c(NA, NA, "gray50", "gray50")) +
  scale_fill_manual(values = c(pal[2], pal[1], NA, NA),
                    labels = c(expression(italic(K)[ref]),
                               expression(italic(K)[heat]), 
                               expression(paste(Prior~italic(K)[heat])),
                               expression(paste(Prior~italic(K)[ref])))) + 
  guides(color = "none", alpha = "none",
         fill = guide_legend(override.aes = list(color = c(NA, NA, "gray50", "gray50"),
                                                 alpha = c(0.4, 0.4, 0.1, 0.1)))) +
  theme(legend.position = c(0.2, 0.8),
        legend.text.align = 0)
#> filter: removed 48,000 rows (67%), 24,000 rows remaining

# parameter t0
prior_post_t0 <- post_long %>%
  filter(Parameter %in% c("b_t0w_intercept", "b_t0c_intercept", "prior_b_t0w", "prior_b_t0c")) %>% 
  ggplot(., aes(value, fill = Parameter, color = Parameter, alpha = Parameter))+
  geom_density() +
  labs(x = expression(italic(t[0]))) +
  coord_cartesian(expand = 0) +
  scale_alpha_manual(values = c(0.4, 0.4, 0.1, 0.1)) +
  scale_color_manual(values = c(NA, NA, "gray50", "gray50")) +
  scale_fill_manual(values = c(pal[2], pal[1], NA, NA),
                    labels = c(expression(italic(t[0])[ref]),
                               expression(italic(t[0])[heat]), 
                               expression(paste(Prior~italic(t[0])[ref])),
                               expression(paste(Prior~italic(t[0])[heat])))) + 
  guides(color = "none", alpha = "none",
         fill = guide_legend(override.aes = list(color = c(NA, NA, "gray50", "gray50"),
                                                 alpha = c(0.4, 0.4, 0.1, 0.1)))) +
  theme(legend.position = c(0.2, 0.8),
        legend.text.align = 0)
#> filter: removed 48,000 rows (67%), 24,000 rows remaining

prior_post_linf / prior_post_K / prior_post_t0 +
  plot_annotation(tag_levels = "A")

ggsave("figures/supp/vbge_prior_post.pdf", width = 20, height = 20, unit = "cm")

Size difference by age class

# Plot % difference by age class
fm_preds <- d %>%
  data_grid(age = seq_range(age, by = 1),
            area = c("FM")) %>%
  mutate(areaC = ifelse(area == "FM", 1, 0),
         areaW = ifelse(area == "BT", 1, 0)) %>%
  add_epred_draws(m1, re_formula = NA, seed = 5) %>%
  ungroup() %>%
  rename(FM_pred = .epred) %>%
  dplyr::select(-area, -areaC, -areaW)
#> mutate: new variable 'areaC' (double) with one unique value and 0% NA
#>         new variable 'areaW' (double) with one unique value and 0% NA
#> ungroup: no grouping variables
#> rename: renamed one variable (FM_pred)

bt_preds <- d %>%
  data_grid(age = seq_range(age, by = 1),
            area = c("BT")) %>%
  mutate(areaC = ifelse(area == "FM", 1, 0),
         areaW = ifelse(area == "BT", 1, 0)) %>%
  add_epred_draws(m1, re_formula = NA, seed = 5) %>%
  ungroup() %>%
  rename(BT_pred = .epred) %>%
  dplyr::select(-area, -areaC, -areaW)
#> mutate: new variable 'areaC' (double) with one unique value and 0% NA
#>         new variable 'areaW' (double) with one unique value and 0% NA
#> ungroup: no grouping variables
#> rename: renamed one variable (BT_pred)

ratio_df <- left_join(fm_preds, bt_preds) %>% 
  mutate(heated_ref_ratio = (BT_pred/FM_pred))
#> Joining, by = c("age", ".row", ".chain", ".iteration", ".draw")
#> left_join: added one column (BT_pred)
#>            > rows only in x        0
#>            > rows only in y  (     0)
#>            > matched rows     54,000
#>            >                 ========
#>            > rows total       54,000
#> mutate: new variable 'heated_ref_ratio' (double) with 54,000 unique values and 0% NA

size_ratio <- ggplot(ratio_df, aes(factor(age), heated_ref_ratio)) +
  geom_violin(fill = "grey50", color = NA) + 
  geom_pointrange(stat = "summary",
                  fun.min = function(z) { quantile(z,0.25) },
                  fun.max = function(z) { quantile(z,0.75) },
                  fun = median, color = "white") +
  geom_hline(yintercept = 1, linetype = 2, color = "gray50") + 
  coord_cartesian(ylim = c(0.85, 1.35)) +
  labs(y = "Heated / Reference size-at-age", x = "Age [yrs]") +
  theme(text = element_text(size = 12), # 12 for word doc
        legend.position = c(0.1, 0.9), 
        legend.spacing.y = unit(0, 'cm'),
        legend.key.size = unit(0, "cm"),
        legend.title = element_text(size = 10),
        legend.text = element_text(size = 10)) +
  NULL

size_ratio

ggsave("figures/supp/vbge_size_age_ratios.pdf", width = 20, height = 20, unit = "cm")

Model diagnostics & fit

pal_diag <- rev(brewer.pal(n = 3, name = "Dark2"))

# Chain convergence
posterior <- as.array(m1)
dimnames(posterior)
#> $iteration
#>    [1] "1"    "2"    "3"    "4"    "5"    "6"    "7"    "8"    "9"    "10"  
#>   [11] "11"   "12"   "13"   "14"   "15"   "16"   "17"   "18"   "19"   "20"  
#>   [21] "21"   "22"   "23"   "24"   "25"   "26"   "27"   "28"   "29"   "30"  
#>   [31] "31"   "32"   "33"   "34"   "35"   "36"   "37"   "38"   "39"   "40"  
#>   [41] "41"   "42"   "43"   "44"   "45"   "46"   "47"   "48"   "49"   "50"  
#>   [51] "51"   "52"   "53"   "54"   "55"   "56"   "57"   "58"   "59"   "60"  
#>   [61] "61"   "62"   "63"   "64"   "65"   "66"   "67"   "68"   "69"   "70"  
#>   [71] "71"   "72"   "73"   "74"   "75"   "76"   "77"   "78"   "79"   "80"  
#>   [81] "81"   "82"   "83"   "84"   "85"   "86"   "87"   "88"   "89"   "90"  
#>   [91] "91"   "92"   "93"   "94"   "95"   "96"   "97"   "98"   "99"   "100" 
#>  [101] "101"  "102"  "103"  "104"  "105"  "106"  "107"  "108"  "109"  "110" 
#>  [111] "111"  "112"  "113"  "114"  "115"  "116"  "117"  "118"  "119"  "120" 
#>  [121] "121"  "122"  "123"  "124"  "125"  "126"  "127"  "128"  "129"  "130" 
#>  [131] "131"  "132"  "133"  "134"  "135"  "136"  "137"  "138"  "139"  "140" 
#>  [141] "141"  "142"  "143"  "144"  "145"  "146"  "147"  "148"  "149"  "150" 
#>  [151] "151"  "152"  "153"  "154"  "155"  "156"  "157"  "158"  "159"  "160" 
#>  [161] "161"  "162"  "163"  "164"  "165"  "166"  "167"  "168"  "169"  "170" 
#>  [171] "171"  "172"  "173"  "174"  "175"  "176"  "177"  "178"  "179"  "180" 
#>  [181] "181"  "182"  "183"  "184"  "185"  "186"  "187"  "188"  "189"  "190" 
#>  [191] "191"  "192"  "193"  "194"  "195"  "196"  "197"  "198"  "199"  "200" 
#>  [201] "201"  "202"  "203"  "204"  "205"  "206"  "207"  "208"  "209"  "210" 
#>  [211] "211"  "212"  "213"  "214"  "215"  "216"  "217"  "218"  "219"  "220" 
#>  [221] "221"  "222"  "223"  "224"  "225"  "226"  "227"  "228"  "229"  "230" 
#>  [231] "231"  "232"  "233"  "234"  "235"  "236"  "237"  "238"  "239"  "240" 
#>  [241] "241"  "242"  "243"  "244"  "245"  "246"  "247"  "248"  "249"  "250" 
#>  [251] "251"  "252"  "253"  "254"  "255"  "256"  "257"  "258"  "259"  "260" 
#>  [261] "261"  "262"  "263"  "264"  "265"  "266"  "267"  "268"  "269"  "270" 
#>  [271] "271"  "272"  "273"  "274"  "275"  "276"  "277"  "278"  "279"  "280" 
#>  [281] "281"  "282"  "283"  "284"  "285"  "286"  "287"  "288"  "289"  "290" 
#>  [291] "291"  "292"  "293"  "294"  "295"  "296"  "297"  "298"  "299"  "300" 
#>  [301] "301"  "302"  "303"  "304"  "305"  "306"  "307"  "308"  "309"  "310" 
#>  [311] "311"  "312"  "313"  "314"  "315"  "316"  "317"  "318"  "319"  "320" 
#>  [321] "321"  "322"  "323"  "324"  "325"  "326"  "327"  "328"  "329"  "330" 
#>  [331] "331"  "332"  "333"  "334"  "335"  "336"  "337"  "338"  "339"  "340" 
#>  [341] "341"  "342"  "343"  "344"  "345"  "346"  "347"  "348"  "349"  "350" 
#>  [351] "351"  "352"  "353"  "354"  "355"  "356"  "357"  "358"  "359"  "360" 
#>  [361] "361"  "362"  "363"  "364"  "365"  "366"  "367"  "368"  "369"  "370" 
#>  [371] "371"  "372"  "373"  "374"  "375"  "376"  "377"  "378"  "379"  "380" 
#>  [381] "381"  "382"  "383"  "384"  "385"  "386"  "387"  "388"  "389"  "390" 
#>  [391] "391"  "392"  "393"  "394"  "395"  "396"  "397"  "398"  "399"  "400" 
#>  [401] "401"  "402"  "403"  "404"  "405"  "406"  "407"  "408"  "409"  "410" 
#>  [411] "411"  "412"  "413"  "414"  "415"  "416"  "417"  "418"  "419"  "420" 
#>  [421] "421"  "422"  "423"  "424"  "425"  "426"  "427"  "428"  "429"  "430" 
#>  [431] "431"  "432"  "433"  "434"  "435"  "436"  "437"  "438"  "439"  "440" 
#>  [441] "441"  "442"  "443"  "444"  "445"  "446"  "447"  "448"  "449"  "450" 
#>  [451] "451"  "452"  "453"  "454"  "455"  "456"  "457"  "458"  "459"  "460" 
#>  [461] "461"  "462"  "463"  "464"  "465"  "466"  "467"  "468"  "469"  "470" 
#>  [471] "471"  "472"  "473"  "474"  "475"  "476"  "477"  "478"  "479"  "480" 
#>  [481] "481"  "482"  "483"  "484"  "485"  "486"  "487"  "488"  "489"  "490" 
#>  [491] "491"  "492"  "493"  "494"  "495"  "496"  "497"  "498"  "499"  "500" 
#>  [501] "501"  "502"  "503"  "504"  "505"  "506"  "507"  "508"  "509"  "510" 
#>  [511] "511"  "512"  "513"  "514"  "515"  "516"  "517"  "518"  "519"  "520" 
#>  [521] "521"  "522"  "523"  "524"  "525"  "526"  "527"  "528"  "529"  "530" 
#>  [531] "531"  "532"  "533"  "534"  "535"  "536"  "537"  "538"  "539"  "540" 
#>  [541] "541"  "542"  "543"  "544"  "545"  "546"  "547"  "548"  "549"  "550" 
#>  [551] "551"  "552"  "553"  "554"  "555"  "556"  "557"  "558"  "559"  "560" 
#>  [561] "561"  "562"  "563"  "564"  "565"  "566"  "567"  "568"  "569"  "570" 
#>  [571] "571"  "572"  "573"  "574"  "575"  "576"  "577"  "578"  "579"  "580" 
#>  [581] "581"  "582"  "583"  "584"  "585"  "586"  "587"  "588"  "589"  "590" 
#>  [591] "591"  "592"  "593"  "594"  "595"  "596"  "597"  "598"  "599"  "600" 
#>  [601] "601"  "602"  "603"  "604"  "605"  "606"  "607"  "608"  "609"  "610" 
#>  [611] "611"  "612"  "613"  "614"  "615"  "616"  "617"  "618"  "619"  "620" 
#>  [621] "621"  "622"  "623"  "624"  "625"  "626"  "627"  "628"  "629"  "630" 
#>  [631] "631"  "632"  "633"  "634"  "635"  "636"  "637"  "638"  "639"  "640" 
#>  [641] "641"  "642"  "643"  "644"  "645"  "646"  "647"  "648"  "649"  "650" 
#>  [651] "651"  "652"  "653"  "654"  "655"  "656"  "657"  "658"  "659"  "660" 
#>  [661] "661"  "662"  "663"  "664"  "665"  "666"  "667"  "668"  "669"  "670" 
#>  [671] "671"  "672"  "673"  "674"  "675"  "676"  "677"  "678"  "679"  "680" 
#>  [681] "681"  "682"  "683"  "684"  "685"  "686"  "687"  "688"  "689"  "690" 
#>  [691] "691"  "692"  "693"  "694"  "695"  "696"  "697"  "698"  "699"  "700" 
#>  [701] "701"  "702"  "703"  "704"  "705"  "706"  "707"  "708"  "709"  "710" 
#>  [711] "711"  "712"  "713"  "714"  "715"  "716"  "717"  "718"  "719"  "720" 
#>  [721] "721"  "722"  "723"  "724"  "725"  "726"  "727"  "728"  "729"  "730" 
#>  [731] "731"  "732"  "733"  "734"  "735"  "736"  "737"  "738"  "739"  "740" 
#>  [741] "741"  "742"  "743"  "744"  "745"  "746"  "747"  "748"  "749"  "750" 
#>  [751] "751"  "752"  "753"  "754"  "755"  "756"  "757"  "758"  "759"  "760" 
#>  [761] "761"  "762"  "763"  "764"  "765"  "766"  "767"  "768"  "769"  "770" 
#>  [771] "771"  "772"  "773"  "774"  "775"  "776"  "777"  "778"  "779"  "780" 
#>  [781] "781"  "782"  "783"  "784"  "785"  "786"  "787"  "788"  "789"  "790" 
#>  [791] "791"  "792"  "793"  "794"  "795"  "796"  "797"  "798"  "799"  "800" 
#>  [801] "801"  "802"  "803"  "804"  "805"  "806"  "807"  "808"  "809"  "810" 
#>  [811] "811"  "812"  "813"  "814"  "815"  "816"  "817"  "818"  "819"  "820" 
#>  [821] "821"  "822"  "823"  "824"  "825"  "826"  "827"  "828"  "829"  "830" 
#>  [831] "831"  "832"  "833"  "834"  "835"  "836"  "837"  "838"  "839"  "840" 
#>  [841] "841"  "842"  "843"  "844"  "845"  "846"  "847"  "848"  "849"  "850" 
#>  [851] "851"  "852"  "853"  "854"  "855"  "856"  "857"  "858"  "859"  "860" 
#>  [861] "861"  "862"  "863"  "864"  "865"  "866"  "867"  "868"  "869"  "870" 
#>  [871] "871"  "872"  "873"  "874"  "875"  "876"  "877"  "878"  "879"  "880" 
#>  [881] "881"  "882"  "883"  "884"  "885"  "886"  "887"  "888"  "889"  "890" 
#>  [891] "891"  "892"  "893"  "894"  "895"  "896"  "897"  "898"  "899"  "900" 
#>  [901] "901"  "902"  "903"  "904"  "905"  "906"  "907"  "908"  "909"  "910" 
#>  [911] "911"  "912"  "913"  "914"  "915"  "916"  "917"  "918"  "919"  "920" 
#>  [921] "921"  "922"  "923"  "924"  "925"  "926"  "927"  "928"  "929"  "930" 
#>  [931] "931"  "932"  "933"  "934"  "935"  "936"  "937"  "938"  "939"  "940" 
#>  [941] "941"  "942"  "943"  "944"  "945"  "946"  "947"  "948"  "949"  "950" 
#>  [951] "951"  "952"  "953"  "954"  "955"  "956"  "957"  "958"  "959"  "960" 
#>  [961] "961"  "962"  "963"  "964"  "965"  "966"  "967"  "968"  "969"  "970" 
#>  [971] "971"  "972"  "973"  "974"  "975"  "976"  "977"  "978"  "979"  "980" 
#>  [981] "981"  "982"  "983"  "984"  "985"  "986"  "987"  "988"  "989"  "990" 
#>  [991] "991"  "992"  "993"  "994"  "995"  "996"  "997"  "998"  "999"  "1000"
#> [1001] "1001" "1002" "1003" "1004" "1005" "1006" "1007" "1008" "1009" "1010"
#> [1011] "1011" "1012" "1013" "1014" "1015" "1016" "1017" "1018" "1019" "1020"
#> [1021] "1021" "1022" "1023" "1024" "1025" "1026" "1027" "1028" "1029" "1030"
#> [1031] "1031" "1032" "1033" "1034" "1035" "1036" "1037" "1038" "1039" "1040"
#> [1041] "1041" "1042" "1043" "1044" "1045" "1046" "1047" "1048" "1049" "1050"
#> [1051] "1051" "1052" "1053" "1054" "1055" "1056" "1057" "1058" "1059" "1060"
#> [1061] "1061" "1062" "1063" "1064" "1065" "1066" "1067" "1068" "1069" "1070"
#> [1071] "1071" "1072" "1073" "1074" "1075" "1076" "1077" "1078" "1079" "1080"
#> [1081] "1081" "1082" "1083" "1084" "1085" "1086" "1087" "1088" "1089" "1090"
#> [1091] "1091" "1092" "1093" "1094" "1095" "1096" "1097" "1098" "1099" "1100"
#> [1101] "1101" "1102" "1103" "1104" "1105" "1106" "1107" "1108" "1109" "1110"
#> [1111] "1111" "1112" "1113" "1114" "1115" "1116" "1117" "1118" "1119" "1120"
#> [1121] "1121" "1122" "1123" "1124" "1125" "1126" "1127" "1128" "1129" "1130"
#> [1131] "1131" "1132" "1133" "1134" "1135" "1136" "1137" "1138" "1139" "1140"
#> [1141] "1141" "1142" "1143" "1144" "1145" "1146" "1147" "1148" "1149" "1150"
#> [1151] "1151" "1152" "1153" "1154" "1155" "1156" "1157" "1158" "1159" "1160"
#> [1161] "1161" "1162" "1163" "1164" "1165" "1166" "1167" "1168" "1169" "1170"
#> [1171] "1171" "1172" "1173" "1174" "1175" "1176" "1177" "1178" "1179" "1180"
#> [1181] "1181" "1182" "1183" "1184" "1185" "1186" "1187" "1188" "1189" "1190"
#> [1191] "1191" "1192" "1193" "1194" "1195" "1196" "1197" "1198" "1199" "1200"
#> [1201] "1201" "1202" "1203" "1204" "1205" "1206" "1207" "1208" "1209" "1210"
#> [1211] "1211" "1212" "1213" "1214" "1215" "1216" "1217" "1218" "1219" "1220"
#> [1221] "1221" "1222" "1223" "1224" "1225" "1226" "1227" "1228" "1229" "1230"
#> [1231] "1231" "1232" "1233" "1234" "1235" "1236" "1237" "1238" "1239" "1240"
#> [1241] "1241" "1242" "1243" "1244" "1245" "1246" "1247" "1248" "1249" "1250"
#> [1251] "1251" "1252" "1253" "1254" "1255" "1256" "1257" "1258" "1259" "1260"
#> [1261] "1261" "1262" "1263" "1264" "1265" "1266" "1267" "1268" "1269" "1270"
#> [1271] "1271" "1272" "1273" "1274" "1275" "1276" "1277" "1278" "1279" "1280"
#> [1281] "1281" "1282" "1283" "1284" "1285" "1286" "1287" "1288" "1289" "1290"
#> [1291] "1291" "1292" "1293" "1294" "1295" "1296" "1297" "1298" "1299" "1300"
#> [1301] "1301" "1302" "1303" "1304" "1305" "1306" "1307" "1308" "1309" "1310"
#> [1311] "1311" "1312" "1313" "1314" "1315" "1316" "1317" "1318" "1319" "1320"
#> [1321] "1321" "1322" "1323" "1324" "1325" "1326" "1327" "1328" "1329" "1330"
#> [1331] "1331" "1332" "1333" "1334" "1335" "1336" "1337" "1338" "1339" "1340"
#> [1341] "1341" "1342" "1343" "1344" "1345" "1346" "1347" "1348" "1349" "1350"
#> [1351] "1351" "1352" "1353" "1354" "1355" "1356" "1357" "1358" "1359" "1360"
#> [1361] "1361" "1362" "1363" "1364" "1365" "1366" "1367" "1368" "1369" "1370"
#> [1371] "1371" "1372" "1373" "1374" "1375" "1376" "1377" "1378" "1379" "1380"
#> [1381] "1381" "1382" "1383" "1384" "1385" "1386" "1387" "1388" "1389" "1390"
#> [1391] "1391" "1392" "1393" "1394" "1395" "1396" "1397" "1398" "1399" "1400"
#> [1401] "1401" "1402" "1403" "1404" "1405" "1406" "1407" "1408" "1409" "1410"
#> [1411] "1411" "1412" "1413" "1414" "1415" "1416" "1417" "1418" "1419" "1420"
#> [1421] "1421" "1422" "1423" "1424" "1425" "1426" "1427" "1428" "1429" "1430"
#> [1431] "1431" "1432" "1433" "1434" "1435" "1436" "1437" "1438" "1439" "1440"
#> [1441] "1441" "1442" "1443" "1444" "1445" "1446" "1447" "1448" "1449" "1450"
#> [1451] "1451" "1452" "1453" "1454" "1455" "1456" "1457" "1458" "1459" "1460"
#> [1461] "1461" "1462" "1463" "1464" "1465" "1466" "1467" "1468" "1469" "1470"
#> [1471] "1471" "1472" "1473" "1474" "1475" "1476" "1477" "1478" "1479" "1480"
#> [1481] "1481" "1482" "1483" "1484" "1485" "1486" "1487" "1488" "1489" "1490"
#> [1491] "1491" "1492" "1493" "1494" "1495" "1496" "1497" "1498" "1499" "1500"
#> [1501] "1501" "1502" "1503" "1504" "1505" "1506" "1507" "1508" "1509" "1510"
#> [1511] "1511" "1512" "1513" "1514" "1515" "1516" "1517" "1518" "1519" "1520"
#> [1521] "1521" "1522" "1523" "1524" "1525" "1526" "1527" "1528" "1529" "1530"
#> [1531] "1531" "1532" "1533" "1534" "1535" "1536" "1537" "1538" "1539" "1540"
#> [1541] "1541" "1542" "1543" "1544" "1545" "1546" "1547" "1548" "1549" "1550"
#> [1551] "1551" "1552" "1553" "1554" "1555" "1556" "1557" "1558" "1559" "1560"
#> [1561] "1561" "1562" "1563" "1564" "1565" "1566" "1567" "1568" "1569" "1570"
#> [1571] "1571" "1572" "1573" "1574" "1575" "1576" "1577" "1578" "1579" "1580"
#> [1581] "1581" "1582" "1583" "1584" "1585" "1586" "1587" "1588" "1589" "1590"
#> [1591] "1591" "1592" "1593" "1594" "1595" "1596" "1597" "1598" "1599" "1600"
#> [1601] "1601" "1602" "1603" "1604" "1605" "1606" "1607" "1608" "1609" "1610"
#> [1611] "1611" "1612" "1613" "1614" "1615" "1616" "1617" "1618" "1619" "1620"
#> [1621] "1621" "1622" "1623" "1624" "1625" "1626" "1627" "1628" "1629" "1630"
#> [1631] "1631" "1632" "1633" "1634" "1635" "1636" "1637" "1638" "1639" "1640"
#> [1641] "1641" "1642" "1643" "1644" "1645" "1646" "1647" "1648" "1649" "1650"
#> [1651] "1651" "1652" "1653" "1654" "1655" "1656" "1657" "1658" "1659" "1660"
#> [1661] "1661" "1662" "1663" "1664" "1665" "1666" "1667" "1668" "1669" "1670"
#> [1671] "1671" "1672" "1673" "1674" "1675" "1676" "1677" "1678" "1679" "1680"
#> [1681] "1681" "1682" "1683" "1684" "1685" "1686" "1687" "1688" "1689" "1690"
#> [1691] "1691" "1692" "1693" "1694" "1695" "1696" "1697" "1698" "1699" "1700"
#> [1701] "1701" "1702" "1703" "1704" "1705" "1706" "1707" "1708" "1709" "1710"
#> [1711] "1711" "1712" "1713" "1714" "1715" "1716" "1717" "1718" "1719" "1720"
#> [1721] "1721" "1722" "1723" "1724" "1725" "1726" "1727" "1728" "1729" "1730"
#> [1731] "1731" "1732" "1733" "1734" "1735" "1736" "1737" "1738" "1739" "1740"
#> [1741] "1741" "1742" "1743" "1744" "1745" "1746" "1747" "1748" "1749" "1750"
#> [1751] "1751" "1752" "1753" "1754" "1755" "1756" "1757" "1758" "1759" "1760"
#> [1761] "1761" "1762" "1763" "1764" "1765" "1766" "1767" "1768" "1769" "1770"
#> [1771] "1771" "1772" "1773" "1774" "1775" "1776" "1777" "1778" "1779" "1780"
#> [1781] "1781" "1782" "1783" "1784" "1785" "1786" "1787" "1788" "1789" "1790"
#> [1791] "1791" "1792" "1793" "1794" "1795" "1796" "1797" "1798" "1799" "1800"
#> [1801] "1801" "1802" "1803" "1804" "1805" "1806" "1807" "1808" "1809" "1810"
#> [1811] "1811" "1812" "1813" "1814" "1815" "1816" "1817" "1818" "1819" "1820"
#> [1821] "1821" "1822" "1823" "1824" "1825" "1826" "1827" "1828" "1829" "1830"
#> [1831] "1831" "1832" "1833" "1834" "1835" "1836" "1837" "1838" "1839" "1840"
#> [1841] "1841" "1842" "1843" "1844" "1845" "1846" "1847" "1848" "1849" "1850"
#> [1851] "1851" "1852" "1853" "1854" "1855" "1856" "1857" "1858" "1859" "1860"
#> [1861] "1861" "1862" "1863" "1864" "1865" "1866" "1867" "1868" "1869" "1870"
#> [1871] "1871" "1872" "1873" "1874" "1875" "1876" "1877" "1878" "1879" "1880"
#> [1881] "1881" "1882" "1883" "1884" "1885" "1886" "1887" "1888" "1889" "1890"
#> [1891] "1891" "1892" "1893" "1894" "1895" "1896" "1897" "1898" "1899" "1900"
#> [1901] "1901" "1902" "1903" "1904" "1905" "1906" "1907" "1908" "1909" "1910"
#> [1911] "1911" "1912" "1913" "1914" "1915" "1916" "1917" "1918" "1919" "1920"
#> [1921] "1921" "1922" "1923" "1924" "1925" "1926" "1927" "1928" "1929" "1930"
#> [1931] "1931" "1932" "1933" "1934" "1935" "1936" "1937" "1938" "1939" "1940"
#> [1941] "1941" "1942" "1943" "1944" "1945" "1946" "1947" "1948" "1949" "1950"
#> [1951] "1951" "1952" "1953" "1954" "1955" "1956" "1957" "1958" "1959" "1960"
#> [1961] "1961" "1962" "1963" "1964" "1965" "1966" "1967" "1968" "1969" "1970"
#> [1971] "1971" "1972" "1973" "1974" "1975" "1976" "1977" "1978" "1979" "1980"
#> [1981] "1981" "1982" "1983" "1984" "1985" "1986" "1987" "1988" "1989" "1990"
#> [1991] "1991" "1992" "1993" "1994" "1995" "1996" "1997" "1998" "1999" "2000"
#> 
#> $chain
#> [1] "1" "2" "3"
#> 
#> $variable
#>  [1] "b_t0C_Intercept"                     "b_t0W_Intercept"                    
#>  [3] "b_KC_Intercept"                      "b_KW_Intercept"                     
#>  [5] "b_LinfC_Intercept"                   "b_LinfW_Intercept"                  
#>  [7] "sd_birth_year__KC_Intercept"         "sd_birth_year__KW_Intercept"        
#>  [9] "sd_birth_year__LinfC_Intercept"      "sd_birth_year__LinfW_Intercept"     
#> [11] "sigma"                               "nu"                                 
#> [13] "r_birth_year__KC[1981,Intercept]"    "r_birth_year__KC[1982,Intercept]"   
#> [15] "r_birth_year__KC[1983,Intercept]"    "r_birth_year__KC[1984,Intercept]"   
#> [17] "r_birth_year__KC[1985,Intercept]"    "r_birth_year__KC[1986,Intercept]"   
#> [19] "r_birth_year__KC[1987,Intercept]"    "r_birth_year__KC[1988,Intercept]"   
#> [21] "r_birth_year__KC[1989,Intercept]"    "r_birth_year__KC[1990,Intercept]"   
#> [23] "r_birth_year__KC[1991,Intercept]"    "r_birth_year__KC[1992,Intercept]"   
#> [25] "r_birth_year__KC[1993,Intercept]"    "r_birth_year__KC[1994,Intercept]"   
#> [27] "r_birth_year__KC[1995,Intercept]"    "r_birth_year__KC[1996,Intercept]"   
#> [29] "r_birth_year__KC[1997,Intercept]"    "r_birth_year__KW[1981,Intercept]"   
#> [31] "r_birth_year__KW[1982,Intercept]"    "r_birth_year__KW[1983,Intercept]"   
#> [33] "r_birth_year__KW[1984,Intercept]"    "r_birth_year__KW[1985,Intercept]"   
#> [35] "r_birth_year__KW[1986,Intercept]"    "r_birth_year__KW[1987,Intercept]"   
#> [37] "r_birth_year__KW[1988,Intercept]"    "r_birth_year__KW[1989,Intercept]"   
#> [39] "r_birth_year__KW[1990,Intercept]"    "r_birth_year__KW[1991,Intercept]"   
#> [41] "r_birth_year__KW[1992,Intercept]"    "r_birth_year__KW[1993,Intercept]"   
#> [43] "r_birth_year__KW[1994,Intercept]"    "r_birth_year__KW[1995,Intercept]"   
#> [45] "r_birth_year__KW[1996,Intercept]"    "r_birth_year__KW[1997,Intercept]"   
#> [47] "r_birth_year__LinfC[1981,Intercept]" "r_birth_year__LinfC[1982,Intercept]"
#> [49] "r_birth_year__LinfC[1983,Intercept]" "r_birth_year__LinfC[1984,Intercept]"
#> [51] "r_birth_year__LinfC[1985,Intercept]" "r_birth_year__LinfC[1986,Intercept]"
#> [53] "r_birth_year__LinfC[1987,Intercept]" "r_birth_year__LinfC[1988,Intercept]"
#> [55] "r_birth_year__LinfC[1989,Intercept]" "r_birth_year__LinfC[1990,Intercept]"
#> [57] "r_birth_year__LinfC[1991,Intercept]" "r_birth_year__LinfC[1992,Intercept]"
#> [59] "r_birth_year__LinfC[1993,Intercept]" "r_birth_year__LinfC[1994,Intercept]"
#> [61] "r_birth_year__LinfC[1995,Intercept]" "r_birth_year__LinfC[1996,Intercept]"
#> [63] "r_birth_year__LinfC[1997,Intercept]" "r_birth_year__LinfW[1981,Intercept]"
#> [65] "r_birth_year__LinfW[1982,Intercept]" "r_birth_year__LinfW[1983,Intercept]"
#> [67] "r_birth_year__LinfW[1984,Intercept]" "r_birth_year__LinfW[1985,Intercept]"
#> [69] "r_birth_year__LinfW[1986,Intercept]" "r_birth_year__LinfW[1987,Intercept]"
#> [71] "r_birth_year__LinfW[1988,Intercept]" "r_birth_year__LinfW[1989,Intercept]"
#> [73] "r_birth_year__LinfW[1990,Intercept]" "r_birth_year__LinfW[1991,Intercept]"
#> [75] "r_birth_year__LinfW[1992,Intercept]" "r_birth_year__LinfW[1993,Intercept]"
#> [77] "r_birth_year__LinfW[1994,Intercept]" "r_birth_year__LinfW[1995,Intercept]"
#> [79] "r_birth_year__LinfW[1996,Intercept]" "r_birth_year__LinfW[1997,Intercept]"
#> [81] "lprior"                              "lp__"

d1 <- mcmc_trace(posterior,
                 pars = c("b_t0C_Intercept", "b_t0W_Intercept", "b_KC_Intercept", 
                          "b_KW_Intercept", "b_LinfC_Intercept", "b_LinfW_Intercept",
                          "sd_birth_year__KC_Intercept", "sd_birth_year__KW_Intercept",
                          "sd_birth_year__LinfC_Intercept", "sd_birth_year__LinfW_Intercept",
                          "sigma", "nu"),
                 facet_args = list(ncol = 3, strip.position = "left")) + 
  theme(text = element_text(size = 12),
        strip.text = element_text(size = 4),
        legend.position = "top") + 
  scale_color_manual(values = alpha(pal_diag, alpha = 0.8))
#> Scale for 'colour' is already present. Adding another scale for 'colour',
#> which will replace the existing scale.

# Resid vs fitted
d2 <- d %>%
  add_residual_draws(m1) %>%
  ggplot(aes(x = .row, y = .residual)) +
  stat_pointinterval(alpha = 0.5, size = 0.7) + 
  theme(text = element_text(size = 12))

# qq-plot
# d3 <- d %>%
#   add_residual_draws(m1) %>%
#   median_qi() %>%
#   ggplot(aes(sample = .residual)) +
#   geom_qq_line() +
#   geom_qq(alpha = 0.8) +
#   theme(text = element_text(size = 12))

# Student QQ plot
# https://stackoverflow.com/questions/42493048/computation-failed-for-stat-summary-what-must-be-a-character-string-or-a-func
# https://www.seascapemodels.org/rstats/2017/10/06/qqplot-non-normal-glm.html

summary(m1)$spec_pars # Extract "fixed" effects from m1 for plotting the equation 

nu <- summary(m1)$spec_pars[2, 1]
nu
#> [1] 11.75294

# "Base" version
# t <- d_dummy %>%
#  add_residual_draws(m3s) %>%
#  median_qi()
# resids <- t$.residual
# n <- nrow(d_dummy)
# qqplot(qt(ppoints(n), df = nu), resids,
# xlab = "Theoretical quantile", ylab = "residuals")
# qqline(resids, lty = 2)

# Below ggplot version (check they are the same!)
#?geom_qq_line. Does not take a df argument but dparams, a bit strange
# https://ggplot2.tidyverse.org/reference/geom_qq.html
d3 <- d %>%
  add_residual_draws(m1) %>%
  median_qi() %>%
  ggplot(aes(sample = .residual)) +
  geom_qq_line(distribution = qt, dparams = nu) +
  geom_qq(alpha = 0.8, distribution = qt, dparams = nu) +
  theme(text = element_text(size = 12))

# Posterior predictive
d4 <- pp_check(m1) + 
  theme(text = element_text(size = 12),
        legend.position = c(0.15, 0.95),
        legend.background = element_rect(fill = NA)) + 
  scale_color_manual(values = rev(pal_diag)) +
  labs(color = "", x = "log(length [cm])")
#> Using 10 posterior draws for ppc type 'dens_overlay' by default.
#> Scale for 'colour' is already present. Adding another scale for 'colour',
#> which will replace the existing scale.

d1 / (d2 / (d3 + d4)) + 
  plot_annotation(tag_levels = 'A')

ggsave("figures/supp/vbge_diag_fit.pdf", width = 20, height = 20, unit = "cm")

Supporting analysis

Here I remove cohorts 95-97, since they are a bit extreme and we are unsure this reflects a true “jump” in L_inf.

M1: All parameters specific by area

# These inits where found after initial exploration

d_supp <- d %>% filter(birth_year < 1995)
#> filter: removed 1,286 rows (17%), 6,148 rows remaining

start_time <- Sys.time()
m1_supp <- 
  brm(
    bf(log(length_cm) ~ areaW*log(LinfW*(1-exp(-KW*(age-t0W)))) + areaC*log(LinfC*(1-exp(-KC*(age-t0C)))),
       t0C ~ 1,
       t0W ~ 1,
       KC ~ 1 + (1|birth_year),    # parameter varying by birth_year
       KW ~ 1 + (1|birth_year),    # parameter varying by birth_year
       LinfC ~ 1 + (1|birth_year), # parameter varying by birth_year
       LinfW ~ 1 + (1|birth_year), # parameter varying by birth_year
       nl = TRUE),
    data = d_supp,
    family = student(), prior = prior, seed = 9, 
    iter = 4000, thin = 1, cores = 3, chains = 3, inits = inits_3_chain,
    control = list(max_treedepth = 13, adapt_delta = 0.99))
#> Warning: Argument 'inits' is deprecated. Please use argument 'init' instead.
#> Compiling Stan program...
#> Start sampling
end_time <- Sys.time()
end_time - start_time
#> Time difference of 7.796208 hours
# Time difference of 4.624257 hours

summary(m1)
#>  Family: student 
#>   Links: mu = identity; sigma = identity; nu = identity 
#> Formula: log(length_cm) ~ areaW * log(LinfW * (1 - exp(-KW * (age - t0W)))) + areaC * log(LinfC * (1 - exp(-KC * (age - t0C)))) 
#>          t0C ~ 1
#>          t0W ~ 1
#>          KC ~ 1 + (1 | birth_year)
#>          KW ~ 1 + (1 | birth_year)
#>          LinfC ~ 1 + (1 | birth_year)
#>          LinfW ~ 1 + (1 | birth_year)
#>    Data: d (Number of observations: 7434) 
#>   Draws: 3 chains, each with iter = 4000; warmup = 2000; thin = 1;
#>          total post-warmup draws = 6000
#> 
#> Group-Level Effects: 
#> ~birth_year (Number of levels: 17) 
#>                     Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(KC_Intercept)        0.04      0.01     0.03     0.07 1.00     2059     3465
#> sd(KW_Intercept)        0.08      0.02     0.05     0.12 1.00     2022     3364
#> sd(LinfC_Intercept)     6.82      1.47     4.48    10.20 1.00     2093     3257
#> sd(LinfW_Intercept)    19.03      5.22    11.15    31.93 1.00     1618     3198
#> 
#> Population-Level Effects: 
#>                 Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> t0C_Intercept      -0.44      0.06    -0.56    -0.33 1.00     6143     4528
#> t0W_Intercept      -0.16      0.03    -0.21    -0.11 1.00     7499     4305
#> KC_Intercept        0.15      0.01     0.12     0.17 1.00     1832     3269
#> KW_Intercept        0.19      0.02     0.15     0.23 1.00     1444     2365
#> LinfC_Intercept    39.38      2.09    35.55    43.76 1.00     2043     2797
#> LinfW_Intercept    45.86      5.10    36.57    56.95 1.00     1093     2245
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma     0.11      0.00     0.11     0.11 1.00     6356     4352
#> nu       11.75      1.68     9.02    15.59 1.00     6632     4659
#> 
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
summary(m1_supp)
#>  Family: student 
#>   Links: mu = identity; sigma = identity; nu = identity 
#> Formula: log(length_cm) ~ areaW * log(LinfW * (1 - exp(-KW * (age - t0W)))) + areaC * log(LinfC * (1 - exp(-KC * (age - t0C)))) 
#>          t0C ~ 1
#>          t0W ~ 1
#>          KC ~ 1 + (1 | birth_year)
#>          KW ~ 1 + (1 | birth_year)
#>          LinfC ~ 1 + (1 | birth_year)
#>          LinfW ~ 1 + (1 | birth_year)
#>    Data: d_supp (Number of observations: 6148) 
#>   Draws: 3 chains, each with iter = 4000; warmup = 2000; thin = 1;
#>          total post-warmup draws = 6000
#> 
#> Group-Level Effects: 
#> ~birth_year (Number of levels: 14) 
#>                     Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sd(KC_Intercept)        0.05      0.01     0.03     0.07 1.00     2297     3818
#> sd(KW_Intercept)        0.05      0.01     0.03     0.07 1.00     2173     3144
#> sd(LinfC_Intercept)     5.90      1.30     3.90     8.95 1.00     3142     4104
#> sd(LinfW_Intercept)     4.82      1.32     2.75     8.00 1.00     2787     3823
#> 
#> Population-Level Effects: 
#>                 Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> t0C_Intercept      -0.43      0.06    -0.55    -0.31 1.00     7408     4546
#> t0W_Intercept      -0.29      0.03    -0.36    -0.22 1.00     7190     4909
#> KC_Intercept        0.15      0.01     0.13     0.18 1.00     2159     3427
#> KW_Intercept        0.19      0.02     0.16     0.22 1.00     2812     3376
#> LinfC_Intercept    37.42      1.86    33.91    41.27 1.00     2410     3495
#> LinfW_Intercept    39.81      1.77    36.55    43.55 1.00     3541     3934
#> 
#> Family Specific Parameters: 
#>       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma     0.11      0.00     0.10     0.11 1.00     6780     4273
#> nu       11.75      1.83     8.89    15.97 1.00     6615     4136
#> 
#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
plot(m1_supp)

# Save model object to not have to rerun it...
#saveRDS(m1_supp, "output/vbge/m1_supp.rds")
# m1_supp <- readRDS("output/vbge/m1_supp.rds")

# > prior_summary(m1_supp)

# http://mjskay.github.io/tidybayes/articles/tidy-brms.html
# Plot % difference by age class
fm_preds_full <- d %>%
  data_grid(age = seq_range(age, by = 1),
            area = c("FM")) %>%
  mutate(areaC = ifelse(area == "FM", 1, 0),
         areaW = ifelse(area == "BT", 1, 0)) %>%
  add_epred_draws(m1, re_formula = NA, seed = 5) %>%
  ungroup() %>%
  rename(FM_pred = .epred) %>%
  dplyr::select(-area, -areaC, -areaW)
#> mutate: new variable 'areaC' (double) with one unique value and 0% NA
#>         new variable 'areaW' (double) with one unique value and 0% NA
#> ungroup: no grouping variables
#> rename: renamed one variable (FM_pred)

fm_preds_supp <- d %>%
  data_grid(age = seq_range(age, by = 1),
            area = c("FM")) %>%
  mutate(areaC = ifelse(area == "FM", 1, 0),
         areaW = ifelse(area == "BT", 1, 0)) %>%
  add_epred_draws(m1_supp, re_formula = NA, seed = 5) %>%
  ungroup() %>%
  rename(FM_pred = .epred) %>%
  dplyr::select(-area, -areaC, -areaW)
#> mutate: new variable 'areaC' (double) with one unique value and 0% NA
#>         new variable 'areaW' (double) with one unique value and 0% NA
#> ungroup: no grouping variables
#> rename: renamed one variable (FM_pred)

bt_preds_full <- d %>%
  data_grid(age = seq_range(age, by = 1),
            area = c("BT")) %>%
  mutate(areaC = ifelse(area == "FM", 1, 0),
         areaW = ifelse(area == "BT", 1, 0)) %>%
  add_epred_draws(m1, re_formula = NA, seed = 5) %>%
  ungroup() %>%
  rename(BT_pred = .epred) %>%
  dplyr::select(-area, -areaC, -areaW)
#> mutate: new variable 'areaC' (double) with one unique value and 0% NA
#>         new variable 'areaW' (double) with one unique value and 0% NA
#> ungroup: no grouping variables
#> rename: renamed one variable (BT_pred)

bt_preds_supp <- d %>%
  data_grid(age = seq_range(age, by = 1),
            area = c("BT")) %>%
  mutate(areaC = ifelse(area == "FM", 1, 0),
         areaW = ifelse(area == "BT", 1, 0)) %>%
  add_epred_draws(m1_supp, re_formula = NA, seed = 5) %>%
  ungroup() %>%
  rename(BT_pred = .epred) %>%
  dplyr::select(-area, -areaC, -areaW)
#> mutate: new variable 'areaC' (double) with one unique value and 0% NA
#>         new variable 'areaW' (double) with one unique value and 0% NA
#> ungroup: no grouping variables
#> rename: renamed one variable (BT_pred)


ratio_full <- left_join(fm_preds_full, bt_preds_full) %>% 
  mutate(heated_ref_ratio = (BT_pred/FM_pred),
         model = "Full")
#> Joining, by = c("age", ".row", ".chain", ".iteration", ".draw")
#> left_join: added one column (BT_pred)
#>            > rows only in x        0
#>            > rows only in y  (     0)
#>            > matched rows     54,000
#>            >                 ========
#>            > rows total       54,000
#> mutate: new variable 'heated_ref_ratio' (double) with 54,000 unique values and 0% NA
#>         new variable 'model' (character) with one unique value and 0% NA

ratio_supp <- left_join(fm_preds_supp, bt_preds_supp) %>% 
  mutate(heated_ref_ratio = (BT_pred/FM_pred),
         model = "Subset")
#> Joining, by = c("age", ".row", ".chain", ".iteration", ".draw")
#> left_join: added one column (BT_pred)
#>            > rows only in x        0
#>            > rows only in y  (     0)
#>            > matched rows     54,000
#>            >                 ========
#>            > rows total       54,000
#> mutate: new variable 'heated_ref_ratio' (double) with 54,000 unique values and 0% NA
#>         new variable 'model' (character) with one unique value and 0% NA

ratio_df <- bind_rows(ratio_full, ratio_supp)

ratio_df %>% 
  group_by(age, model) %>% 
  summarise(mean_ratio = mean(heated_ref_ratio)) %>% 
  pivot_wider(values_from = mean_ratio, names_from = model)
#> group_by: 2 grouping variables (age, model)
#> summarise: now 18 rows and 3 columns, one group variable remaining (age)
#> pivot_wider: reorganized (model, mean_ratio) into (Full, Subset) [was 18x3, now 9x3]

size_ratio <- ggplot(ratio_df, aes(factor(age), heated_ref_ratio, fill = model, color = model)) +
  geom_violin(position = position_dodge(width = 0.6), alpha = 0.8, color = NA) + 
  scale_fill_brewer(palette = "Dark2") +
  scale_color_brewer(palette = "Dark2") +
  #geom_pointinterval() + 
  geom_pointrange(stat = "summary",
                  fun.min = function(z) { quantile(z,0.25) },
                  fun.max = function(z) { quantile(z,0.75) },
                  fun = median, color = "white",
                  position = position_dodge(width = 0.6),
                  size = 0.5) +
  geom_hline(yintercept = 1, linetype = 2, color = "gray50") + 
  #coord_cartesian(ylim = c(0.85, 1.35)) +
  labs(y = "Heated / Reference size-at-age", x = "Age [yrs]") +
  guides(fill = "none", color = "none") +
  theme(text = element_text(size = 12), # 12 for word doc
        legend.position = c(0.9, 0.9), 
        legend.spacing.y = unit(0, 'cm'),
        legend.key.size = unit(0, "cm"),
        legend.title = element_text(size = 10),
        legend.text = element_text(size = 10)) +
  NULL

size_ratio

# Area diff full model
post_L_inf2 <- m1 %>%
  gather_draws(b_LinfC_Intercept, b_LinfW_Intercept) %>% 
  mutate(param = "L_inf",
         model = "Full") %>% 
  pivot_wider(names_from = .variable, values_from = .value) %>%
  mutate(diff = b_LinfW_Intercept - b_LinfC_Intercept) %>% 
  dplyr::select(diff, model, param)
#> mutate (grouped): new variable 'param' (character) with one unique value and 0% NA
#>                   new variable 'model' (character) with one unique value and 0% NA
#> pivot_wider: reorganized (.variable, .value) into (b_LinfC_Intercept, b_LinfW_Intercept) [was 12000x7, now 6000x7]
#> mutate: new variable 'diff' (double) with 6,000 unique values and 0% NA

post_L_inf_sens2 <- m1_supp %>%
  gather_draws(b_LinfC_Intercept, b_LinfW_Intercept) %>% 
  mutate(param = "L_inf",
         model = "Subset") %>% 
  pivot_wider(names_from = .variable, values_from = .value) %>% 
  mutate(diff = b_LinfW_Intercept - b_LinfC_Intercept) %>% 
  dplyr::select(diff, model, param)
#> mutate (grouped): new variable 'param' (character) with one unique value and 0% NA
#>                   new variable 'model' (character) with one unique value and 0% NA
#> pivot_wider: reorganized (.variable, .value) into (b_LinfC_Intercept, b_LinfW_Intercept) [was 12000x7, now 6000x7]
#> mutate: new variable 'diff' (double) with 6,000 unique values and 0% NA

post_K2 <- m1 %>%
  gather_draws(b_KC_Intercept, b_KW_Intercept) %>% 
  mutate(param = "K",
         model = "Full") %>% 
  pivot_wider(names_from = .variable, values_from = .value) %>%
  mutate(diff = b_KW_Intercept - b_KC_Intercept) %>% 
  dplyr::select(diff, model, param)
#> mutate (grouped): new variable 'param' (character) with one unique value and 0% NA
#>                   new variable 'model' (character) with one unique value and 0% NA
#> pivot_wider: reorganized (.variable, .value) into (b_KC_Intercept, b_KW_Intercept) [was 12000x7, now 6000x7]
#> mutate: new variable 'diff' (double) with 6,000 unique values and 0% NA

post_K_sens2 <- 
  m1_supp %>%
  gather_draws(b_KC_Intercept, b_KW_Intercept) %>% 
  mutate(param = "K",
         model = "Subset") %>% 
  pivot_wider(names_from = .variable, values_from = .value) %>% 
  mutate(diff = b_KW_Intercept - b_KC_Intercept) %>% 
  dplyr::select(diff, model, param)
#> mutate (grouped): new variable 'param' (character) with one unique value and 0% NA
#>                   new variable 'model' (character) with one unique value and 0% NA
#> pivot_wider: reorganized (.variable, .value) into (b_KC_Intercept, b_KW_Intercept) [was 12000x7, now 6000x7]
#> mutate: new variable 'diff' (double) with 6,000 unique values and 0% NA

t <- bind_rows(post_L_inf2, post_L_inf_sens2, post_K2, post_K_sens2)

k <- ggplot(filter(t, param == "K"), aes(diff, fill = model, color = model)) +
  stat_halfeye(alpha = 0.5, size = 5, .width = c(0.7)) +
  facet_wrap(~param, scales = "free") +
  guides(color = "none", alpha = "none",
         fill = guide_legend(override.aes = list(linetype = rep(0, 2), shape = rep(NA, 2)))) +
  scale_fill_brewer(palette = "Dark2") +
  scale_color_brewer(palette = "Dark2") +
  labs(x = "Heated-Reference", y = "density", fill = "Model") +
  theme(legend.key.size = unit(0.2, "cm"),
        legend.background = element_blank(), 
        aspect.ratio = 1)
#> filter: removed 12,000 rows (50%), 12,000 rows remaining

t_sub <- filter(t, !param == "K") %>% mutate(param = as.factor(param))
#> filter: removed 12,000 rows (50%), 12,000 rows remaining
#> mutate: converted 'param' from character to factor (0 new NA)

levels(t_sub$param) <- c(expression(L[infinity]))

linf <- ggplot(t_sub, aes(diff, fill = model, color = model)) +
  stat_halfeye(alpha = 0.5, size = 5, .width = c(0.7)) +
  facet_wrap(~param, scales = "free", labeller = label_parsed) +
  guides(color = "none", alpha = "none",
         fill = guide_legend(override.aes = list(linetype = rep(0, 2), shape = rep(NA, 2)))) +
  scale_fill_brewer(palette = "Dark2") +
  scale_color_brewer(palette = "Dark2") +
  labs(x = "Heated-Reference", y = "density", fill = "Model") +
  theme(legend.key.size = unit(0.2, "cm"),
        legend.background = element_blank(), 
        aspect.ratio = 1)

linf

(size_ratio / (k + linf)) + plot_annotation(tag_levels = "A") + plot_layout(guides = "collect") & theme(legend.position = "top")

ggsave("figures/supp/vbge_sensi.pdf", width = 20, height = 20, unit = "cm")


# Now compare differences in estiamtes, not differences in differences
post_L_inf3 <- m1 %>%
  gather_draws(b_LinfC_Intercept, b_LinfW_Intercept) %>% 
  mutate(param = "L_inf") %>% 
  pivot_wider(names_from = .variable, values_from = .value) %>%
  dplyr::select(b_LinfC_Intercept, b_LinfW_Intercept) %>% 
  rename(full_b_LinfC_Intercept = b_LinfC_Intercept,
         full_b_LinfW_Intercept = b_LinfW_Intercept)
#> mutate (grouped): new variable 'param' (character) with one unique value and 0% NA
#> pivot_wider: reorganized (.variable, .value) into (b_LinfC_Intercept, b_LinfW_Intercept) [was 12000x6, now 6000x6]
#> rename: renamed 2 variables (full_b_LinfC_Intercept, full_b_LinfW_Intercept)
  
post_L_inf_sens3 <- m1_supp %>%
  gather_draws(b_LinfC_Intercept, b_LinfW_Intercept) %>% 
  mutate(param = "L_inf") %>% 
  pivot_wider(names_from = .variable, values_from = .value) %>%
  dplyr::select(b_LinfC_Intercept, b_LinfW_Intercept) %>% 
  rename(sub_b_LinfC_Intercept = b_LinfC_Intercept,
         sub_b_LinfW_Intercept = b_LinfW_Intercept)
#> mutate (grouped): new variable 'param' (character) with one unique value and 0% NA
#> pivot_wider: reorganized (.variable, .value) into (b_LinfC_Intercept, b_LinfW_Intercept) [was 12000x6, now 6000x6]
#> rename: renamed 2 variables (sub_b_LinfC_Intercept, sub_b_LinfW_Intercept)

comp <- bind_cols(post_L_inf3, post_L_inf_sens3)

pal <- brewer.pal(n = 3, name = "Dark2")

ggplot(comp) +
  stat_halfeye(aes(full_b_LinfC_Intercept - sub_b_LinfC_Intercept, fill = "Reference", color = "Reference"),
               alpha = 0.5, size = 5, .width = c(0.7)) +
  stat_halfeye(aes(full_b_LinfW_Intercept - sub_b_LinfW_Intercept, fill = "Heated", color = "Heated"),
               alpha = 0.5, size = 5, .width = c(0.7)) +
  scale_fill_brewer(palette = "Dark2") +
  scale_color_brewer(palette = "Dark2") +
  guides(color = "none", alpha = "none",
         fill = guide_legend(override.aes = list(linetype = rep(0, 2), shape = rep(NA, 2)))) +
  labs(x = expression(paste(~italic(L[infinity]))), y = "density", fill = "Model") +
  theme(legend.key.size = unit(0.2, "cm"),
        legend.background = element_blank(),
        aspect.ratio = 1, 
        legend.position = c(0.9, 0.9)) +
  NULL

ggsave("figures/supp/vbge_sensi2.pdf", width = 20, height = 20, unit = "cm")