From 0225751f3780eba0f5cd090b935b5cc6dcf035ba Mon Sep 17 00:00:00 2001 From: Quarto GHA Workflow Runner Date: Fri, 26 Jul 2024 18:55:02 +0000 Subject: [PATCH] Built site for gh-pages --- .nojekyll | 2 +- content/AFSC-BSAI-AtkaMackerel.html | 4 +- content/AFSC-GOA-pollock.html | 115 ++-- content/NEFSC-yellowtail.html | 810 +++++++++++------------ content/NWFSC-petrale.html | 13 +- content/PIFS-opakapaka.html | 2 +- content/SEFSC-scamp.html | 611 +++++++++--------- content/SWFSC-sardine.html | 957 ++++++++++++++-------------- content/acknowledgements.html | 2 +- content/case-study-template.html | 2 +- content/publishing.html | 2 +- content/rendering.html | 2 +- content/rmarkdown.html | 2 +- content/setup.html | 2 +- index.html | 2 +- search.json | 36 +- sitemap.xml | 28 +- 17 files changed, 1304 insertions(+), 1288 deletions(-) diff --git a/.nojekyll b/.nojekyll index afc9a66..0eb7379 100644 --- a/.nojekyll +++ b/.nojekyll @@ -1 +1 @@ -0f755ed6 \ No newline at end of file +81212dc3 \ No newline at end of file diff --git a/content/AFSC-BSAI-AtkaMackerel.html b/content/AFSC-BSAI-AtkaMackerel.html index 260811c..f6c92b7 100644 --- a/content/AFSC-BSAI-AtkaMackerel.html +++ b/content/AFSC-BSAI-AtkaMackerel.html @@ -2,7 +2,7 @@ - + @@ -303,7 +303,7 @@

The setup

  • TMB version: 1.9.14
    • -
  • FIMS commit: 39d0743
    +
  • FIMS commit: 081972c
  • Stock name: BSAI Atka mackerel
    • diff --git a/content/AFSC-GOA-pollock.html b/content/AFSC-GOA-pollock.html index 3ab1269..d387428 100644 --- a/content/AFSC-GOA-pollock.html +++ b/content/AFSC-GOA-pollock.html @@ -2,7 +2,7 @@ - + @@ -282,41 +282,41 @@

    The setup

    
 The downloaded binary packages are in
-    /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages
    + /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages
    Code 
    remotes::install_github("kaskr/TMB_contrib_R/TMBhelper")
    -
    Rcpp         (1.0.12 -> 1.0.13    ) [CRAN]
-RcppParallel (NA     -> 5.1.8     ) [CRAN]
-numDeriv     (NA     -> 2016.8-1.1) [CRAN]
-ps           (NA     -> 1.7.7     ) [CRAN]
-distribut... (NA     -> 0.4.0     ) [CRAN]
-tensorA      (NA     -> 0.36.2.1  ) [CRAN]
-abind        (NA     -> 1.4-5     ) [CRAN]
-backports    (NA     -> 1.5.0     ) [CRAN]
-processx     (NA     -> 3.8.4     ) [CRAN]
-desc         (NA     -> 1.4.3     ) [CRAN]
-callr        (NA     -> 3.7.6     ) [CRAN]
-posterior    (NA     -> 1.6.0     ) [CRAN]
-matrixStats  (NA     -> 1.3.0     ) [CRAN]
-checkmate    (NA     -> 2.3.1     ) [CRAN]
-BH           (NA     -> 1.84.0-0  ) [CRAN]
-QuickJSR     (NA     -> 1.3.1     ) [CRAN]
-pkgbuild     (NA     -> 1.4.4     ) [CRAN]
-loo          (NA     -> 2.8.0     ) [CRAN]
-gridExtra    (NA     -> 2.3       ) [CRAN]
-inline       (NA     -> 0.3.19    ) [CRAN]
-StanHeaders  (NA     -> 2.32.10   ) [CRAN]
-rstan        (NA     -> 2.32.6    ) [CRAN]
-tmbstan      (NA     -> 1.0.91    ) [CRAN]
+
    RcppParallel (NA    -> 5.1.8     ) [CRAN]
+colorspace   (2.1-0 -> 2.1-1     ) [CRAN]
+numDeriv     (NA    -> 2016.8-1.1) [CRAN]
+ps           (NA    -> 1.7.7     ) [CRAN]
+distribut... (NA    -> 0.4.0     ) [CRAN]
+tensorA      (NA    -> 0.36.2.1  ) [CRAN]
+abind        (NA    -> 1.4-5     ) [CRAN]
+backports    (NA    -> 1.5.0     ) [CRAN]
+processx     (NA    -> 3.8.4     ) [CRAN]
+desc         (NA    -> 1.4.3     ) [CRAN]
+callr        (NA    -> 3.7.6     ) [CRAN]
+posterior    (NA    -> 1.6.0     ) [CRAN]
+matrixStats  (NA    -> 1.3.0     ) [CRAN]
+checkmate    (NA    -> 2.3.1     ) [CRAN]
+BH           (NA    -> 1.84.0-0  ) [CRAN]
+QuickJSR     (NA    -> 1.3.1     ) [CRAN]
+pkgbuild     (NA    -> 1.4.4     ) [CRAN]
+loo          (NA    -> 2.8.0     ) [CRAN]
+gridExtra    (NA    -> 2.3       ) [CRAN]
+inline       (NA    -> 0.3.19    ) [CRAN]
+StanHeaders  (NA    -> 2.32.10   ) [CRAN]
+rstan        (NA    -> 2.32.6    ) [CRAN]
+tmbstan      (NA    -> 1.0.91    ) [CRAN]
 
 The downloaded binary packages are in
-    /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages
+    /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages
 ── R CMD build ─────────────────────────────────────────────────────────────────
-* checking for file ‘/private/var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T/RtmpDaSufj/remotes13b46ee1ffdf/kaskr-TMB_contrib_R-d275e52/TMBhelper/DESCRIPTION’ ... OK
+* checking for file ‘/private/var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T/Rtmp9VrHzZ/remotes119e6ee04f16/kaskr-TMB_contrib_R-d275e52/TMBhelper/DESCRIPTION’ ... OK
 * preparing ‘TMBhelper’:
 * checking DESCRIPTION meta-information ... OK
 * checking for LF line-endings in source and make files and shell scripts
@@ -328,12 +328,12 @@ 
    The setup
    
 
    remotes::install_github("NOAA-FIMS/FIMS")
    
 
 
    
-
    Rcpp (1.0.12 -> 1.0.13) [CRAN]
+
    colorspace (2.1-0 -> 2.1-1) [CRAN]
 
 The downloaded binary packages are in
-    /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages
+    /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages
 ── R CMD build ─────────────────────────────────────────────────────────────────
-* checking for file ‘/private/var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T/RtmpDaSufj/remotes13b45ca541b0/NOAA-FIMS-FIMS-39d0743/DESCRIPTION’ ... OK
+* checking for file ‘/private/var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T/Rtmp9VrHzZ/remotes119e5bff994d/NOAA-FIMS-FIMS-081972c/DESCRIPTION’ ... OK
 * preparing ‘FIMS’:
 * checking DESCRIPTION meta-information ... OK
 * cleaning src
@@ -346,37 +346,39 @@ 
    The setup
    
 
    remotes::install_github("r4ss/r4ss")
    
 
 
    
-
    systemfonts (NA -> 1.1.0   ) [CRAN]
-sys         (NA -> 3.4.2   ) [CRAN]
-askpass     (NA -> 1.2.0   ) [CRAN]
-openssl     (NA -> 2.2.0   ) [CRAN]
-curl        (NA -> 5.2.1   ) [CRAN]
-parallelly  (NA -> 1.37.1  ) [CRAN]
-listenv     (NA -> 0.9.1   ) [CRAN]
-globals     (NA -> 0.16.3  ) [CRAN]
-svglite     (NA -> 2.1.3   ) [CRAN]
-rstudioapi  (NA -> 0.16.0  ) [CRAN]
-xml2        (NA -> 1.3.6   ) [CRAN]
-ini         (NA -> 0.3.1   ) [CRAN]
-httr2       (NA -> 1.0.2   ) [CRAN]
-gitcreds    (NA -> 0.1.2   ) [CRAN]
-future      (NA -> 1.33.2  ) [CRAN]
-kableExtra  (NA -> 1.4.0   ) [CRAN]
-gh          (NA -> 1.4.1   ) [CRAN]
-furrr       (NA -> 0.3.1   ) [CRAN]
-forcats     (NA -> 1.0.0   ) [CRAN]
-corpcor     (NA -> 1.6.10  ) [CRAN]
-coda        (NA -> 0.19-4.1) [CRAN]
+
    systemfonts (NA    -> 1.1.0   ) [CRAN]
+colorspace  (2.1-0 -> 2.1-1   ) [CRAN]
+yaml        (2.3.9 -> 2.3.10  ) [CRAN]
+sys         (NA    -> 3.4.2   ) [CRAN]
+askpass     (NA    -> 1.2.0   ) [CRAN]
+openssl     (NA    -> 2.2.0   ) [CRAN]
+curl        (NA    -> 5.2.1   ) [CRAN]
+parallelly  (NA    -> 1.37.1  ) [CRAN]
+listenv     (NA    -> 0.9.1   ) [CRAN]
+globals     (NA    -> 0.16.3  ) [CRAN]
+svglite     (NA    -> 2.1.3   ) [CRAN]
+rstudioapi  (NA    -> 0.16.0  ) [CRAN]
+xml2        (NA    -> 1.3.6   ) [CRAN]
+ini         (NA    -> 0.3.1   ) [CRAN]
+httr2       (NA    -> 1.0.2   ) [CRAN]
+gitcreds    (NA    -> 0.1.2   ) [CRAN]
+future      (NA    -> 1.33.2  ) [CRAN]
+kableExtra  (NA    -> 1.4.0   ) [CRAN]
+gh          (NA    -> 1.4.1   ) [CRAN]
+furrr       (NA    -> 0.3.1   ) [CRAN]
+forcats     (NA    -> 1.0.0   ) [CRAN]
+corpcor     (NA    -> 1.6.10  ) [CRAN]
+coda        (NA    -> 0.19-4.1) [CRAN]
 
 The downloaded binary packages are in
-    /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages
+    /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages
 ── R CMD build ─────────────────────────────────────────────────────────────────
-* checking for file ‘/private/var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T/RtmpDaSufj/remotes13b47d24e8a/r4ss-r4ss-b6976cd/DESCRIPTION’ ... OK
+* checking for file ‘/private/var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T/Rtmp9VrHzZ/remotes119e7a917174/r4ss-r4ss-5be028c/DESCRIPTION’ ... OK
 * preparing ‘r4ss’:
 * checking DESCRIPTION meta-information ... OK
 * checking for LF line-endings in source and make files and shell scripts
 * checking for empty or unneeded directories
-* building ‘r4ss_1.49.2.tar.gz’
    
+* building ‘r4ss_1.49.3.tar.gz’
    
 
    
 
    
 Code
@@ -407,7 +409,7 @@ 
    The setup
    
 
 
  • TMB version: 1.9.14
    
 
    • 
-
  • FIMS commit: 39d0743
    
+
  • FIMS commit: 081972c
    
 
    • 
 
  • Stock name: Gulf of Alaska (GOA) Walleye Pollock
    
 
    • 
@@ -660,6 +662,9 @@ 
    # Clear C++ objects from memory
 clear()
    
 
+
    
+
    NULL
    
+
    diff --git a/content/NEFSC-yellowtail.html b/content/NEFSC-yellowtail.html index 3daf965..691f9ed 100644 --- a/content/NEFSC-yellowtail.html +++ b/content/NEFSC-yellowtail.html @@ -2,7 +2,7 @@ - + @@ -304,7 +304,7 @@

    The setup

  • TMB version: 1.9.14
    • -
  • FIMS commit: 39d0743
    +
  • FIMS commit: 081972c
  • Stock name: Southern New England-Mid Atlantic Yellowtail Flounder
    • @@ -342,396 +342,401 @@

    Scr
    Code 
    # clear memory
-clear()
-
-# read the ASAP rdat files
-rdat <- dget(file.path("data_files", "NEFSC_YT_SIMPLIFIED.RDAT")) # to be used in FIMS, lots of modifications from original
-orig <- dget(file.path("data_files", "NEFSC_YT_ORIGINAL.RDAT"))   # where started before modifications for use in FIMS
-
-# function to create equivalent of data_mile1, basic catch and survey data
-# need to think about how to deal with multiple fleets and indices - only use 1 of each for now
-get_asap_data <- function(rdat){
-  res <- data.frame(type = character(),
-                name = character(),
-                age = integer(),
-                datestart = character(),
-                dateend = character(),
-                value = double(),
-                unit = character(),
-                uncertainty = double())
-  
-  landings <- data.frame(type = "landings",
-                     name = "fleet1",
-                     age = NA,
-                     datestart = paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-01-01"),
-                     dateend = paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-12-31"),
-                     value = as.numeric(rdat$catch.obs[1,]),
-                     unit = "mt",
-                     uncertainty = rdat$control.parms$catch.tot.cv[,1])
-  
-  # loop over all indices
-  for (i in 1:rdat$parms$nindices){
-    index <- data.frame(type = "index",
-                        name = paste0("survey", i),
-                        age = NA,
-                        datestart = paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-01-01"),
-                        dateend = paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-12-31"),
-                        value = as.numeric(rdat$index.obs[[i]]),
-                        unit = "",
-                        uncertainty = rdat$index.cv[[i]])
-    if (i == 1){
-      allinds <- index
-    }else{
-      allinds <- rbind(allinds, index)
-    }
-  }
-  
-  catchage <- data.frame(type = "age",
-                     name = "fleet1",
-                     age = rep(seq(1,rdat$parms$nages), rdat$parms$nyears),
-                     datestart = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-01-01"), each=rdat$parms$nages),
-                     dateend = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-12-31"), each=rdat$parms$nages),
-                     value = as.numeric(t(rdat$catch.comp.mats$catch.fleet1.ob)),
-                     unit = "",
-                     uncertainty = rep(rdat$fleet.catch.Neff.init[1,], each=rdat$parms$nages))
-  
-  # loop over all indices
-  for (i in 1:rdat$parms$nindices){
-    indexage <- data.frame(type = "age",
-                           name = paste0("survey", i),
-                           age = rep(seq(1,rdat$parms$nages), rdat$parms$nyears),
-                           datestart = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-01-01"), each=rdat$parms$nages),
-                           dateend = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-12-31"), each=rdat$parms$nages),
-                           value = as.numeric(t(rdat$index.comp.mats[[i*2-1]])),
-                           unit = "",
-                           uncertainty = rep(rdat$index.Neff.init[i,], each=rdat$parms$nages))
-    if (i == 1){
-      allindsage <- indexage
-    }else{
-      allindsage <- rbind(allindsage, indexage)
-    }
-  }
-  
-  res <- rbind(res, landings, allinds, catchage, allindsage)
-  return(res)
-}
-
-mydat <- get_asap_data(rdat)
-
-myfimsframe <- FIMS::FIMSFrame(mydat)
-#str(myfimsframe)
-
-# define the dimensions
-nyears <- rdat$parms$nyears
-years <- seq(rdat$parms$styr, rdat$parms$endyr)
-nseasons <- 1 # ASAP only has one season
-nages <- rdat$parms$nages
-ages <- 1:nages # ASAP starts at age 1
-
-
-# set up FIMS data objects
-age_frame <- FIMS::FIMSFrame(mydat)
-
-fishery_catch <- FIMS::m_landings(age_frame)
-fishery_agecomp <- FIMS::m_agecomp(age_frame, "fleet1")
-survey_index <- list()
-survey_agecomp <- list()
-for (i in 1:rdat$parms$nindices){
-  survey_index[[i]] <- FIMS::m_index(age_frame, paste0("survey", i))
-  survey_agecomp[[i]] <- FIMS::m_agecomp(age_frame, paste0("survey", i))
-}
-
-# eventually change to allow multiple fishing fleets similar to multiple indices - only using 1 fishing fleet for now
-fishing_fleet_index <- methods::new(Index, nyears)
-fishing_fleet_age_comp <- methods::new(AgeComp, nyears, nages)
-fishing_fleet_index$index_data <- fishery_catch
-fishing_fleet_age_comp$age_comp_data <- fishery_agecomp * rep(rdat$fleet.catch.Neff.init[1,], each=rdat$parms$nages)
-
-
-# fleet selectivity
-#methods::show(LogisticSelectivity)
-fishing_fleet_selectivity <- methods::new(LogisticSelectivity)
-fishing_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$fleet.sel.ini[nages+1,1] # hardwired to assume only 1 fleet and logistic selectivity used
-fishing_fleet_selectivity$inflection_point$is_random_effect <- FALSE
-fishing_fleet_selectivity$inflection_point$estimated <- TRUE
-fishing_fleet_selectivity$slope$value <- rdat$sel.input.mats$fleet.sel.ini[nages+2,1] # hardwired to assume only 1 fleet and logistic selectivity used
-fishing_fleet_selectivity$slope$is_random_effect <- FALSE
-fishing_fleet_selectivity$slope$estimated <- TRUE
-
-# create fleet object
-fishing_fleet <- methods::new(Fleet)
-fishing_fleet$nages <- nages
-fishing_fleet$nyears <- nyears
-fishing_fleet$log_Fmort <- log(rep(rdat$initial.guesses$Fmult.year1.init[1], nyears)) # ASAP assumes Fmult devs = 0
-fishing_fleet$estimate_F <- TRUE
-fishing_fleet$random_F <- FALSE
-fishing_fleet$log_q <- log(rdat$initial.guesses$q.year1.init[1])
-fishing_fleet$estimate_q <- FALSE
-fishing_fleet$random_q <- FALSE
-fishing_fleet$log_obs_error <- rep(log(sqrt(log(as.numeric(mean(rdat$control.parms$catch.tot.cv[,1], na.rm=TRUE)^2) + 1))), nyears)
-fishing_fleet$estimate_obs_error <- FALSE
-# Next two lines not currently used by FIMS
-fishing_fleet$SetAgeCompLikelihood(1)
-fishing_fleet$SetIndexLikelihood(1)
-# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above
-fishing_fleet$SetObservedIndexData(fishing_fleet_index$get_id()) 
-fishing_fleet$SetObservedAgeCompData(fishing_fleet_age_comp$get_id())
-fishing_fleet$SetSelectivity(fishing_fleet_selectivity$get_id())
-
-# survey module now can handle multiple indices
-for (i in 1:rdat$parms$nindices){
-  survey_fleet_index <- methods::new(Index, nyears)
-  survey_fleet_age_comp <- methods::new(AgeComp, nyears, nages)
-  survey_fleet_index$index_data <- survey_index[[i]]
-  survey_fleet_age_comp$age_comp_data <- survey_agecomp[[i]] * rep(rdat$index.Neff.init[i,], each=rdat$parms$nages)
-  
-  # survey selectivity
-  survey_fleet_selectivity <- new(LogisticSelectivity)
-  survey_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$index.sel.ini[(i+1)*(nages+2+4)+nages+1,1] # hardwired for this example
-  survey_fleet_selectivity$inflection_point$is_random_effect <- FALSE
-  survey_fleet_selectivity$inflection_point$estimated <- TRUE
-  survey_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$index.sel.ini[(i+1)*(nages+2+4)+nages+1,1] # hardwired for this example
-  survey_fleet_selectivity$slope$is_random_effect <- FALSE
-  survey_fleet_selectivity$slope$estimated <- TRUE
-  
-  survey_fleet <- methods::new(Fleet)
-  survey_fleet$is_survey <- TRUE
-  survey_fleet$nages <- nages
-  survey_fleet$nyears <- nyears
-  survey_fleet$estimate_F <- FALSE
-  survey_fleet$random_F <- FALSE
-  survey_fleet$log_q <- log(rdat$initial.guesses$q.year1.init[i]) 
-  survey_fleet$estimate_q <- TRUE
-  survey_fleet$random_q <- FALSE
-  # sd = sqrt(log(cv^2 + 1)), sd is log transformed
-  survey_fleet$log_obs_error <- rep(log(sqrt(log(as.numeric(mean(rdat$index.cv[[i]], na.rm=TRUE)^2 + 1)))), nyears)
-  survey_fleet$estimate_obs_error <- FALSE
-  survey_fleet$SetAgeCompLikelihood(i)
-  survey_fleet$SetIndexLikelihood(i)
-  survey_fleet$SetSelectivity(survey_fleet_selectivity$get_id())
-  survey_fleet$SetObservedIndexData(survey_fleet_index$get_id())
-  survey_fleet$SetObservedAgeCompData(survey_fleet_age_comp$get_id())
-}
-
-# Population module
-
-# recruitment
-recruitment <- methods::new(BevertonHoltRecruitment)
-#methods::show(BevertonHoltRecruitment)
-
-recruitment$log_sigma_recruit$value <- log(mean(rdat$control.parms$recruit.cv)) # typically enter same value for every year in ASAP
-recruitment$log_rzero$value <- log(rdat$initial.guesses$SR.inits$SR.scaler.init) # ASAP can enter either R0 or SSB0, need to make sure use R0 in input file
-recruitment$log_rzero$is_random_effect <- FALSE
-recruitment$log_rzero$estimated <- TRUE
-# note: do not set steepness exactly equal to 1, use 0.99 instead in ASAP run
-recruitment$logit_steep$value <- -log(1.0 - rdat$initial.guesses$SR.inits$SR_steepness.init) + log(rdat$initial.guesses$SR.inits$SR_steepness.init - 0.2)
-recruitment$logit_steep$is_random_effect <- FALSE
-recruitment$logit_steep$estimated <- FALSE
-
-recruitment$estimate_log_devs <- TRUE
-recruitment$log_devs <- rep(1.0, nyears) # set to no deviations (multiplier) to start, just like ASAP
-
-# growth
-ewaa_growth <- methods::new(EWAAgrowth)
-ewaa_growth$ages <- ages
-# NOTE: FIMS currently cannot use matrix of WAA, so have to ensure constant WAA over time in ASAP file for now
-ewaa_growth$weights <- rdat$WAA.mats$WAA.catch.all[1,] 
-
-# NOTE: FIMS assumes SSB calculated at the start of the year, so need to adjust ASAP to do so as well for now, need to make timing of SSB calculation part of FIMS later
-
-# maturity
-# NOTE: for now tricking FIMS into thinking age 0 is age 1, so need to adjust A50 for maturity because FIMS calculations use ages 0-5+ instead of 1-6
-maturity <- new(LogisticMaturity)
-maturity$inflection_point$value <- 1.8 # hardwired for now, need to figure out a better way than this
-maturity$inflection_point$is_random_effect <- FALSE
-maturity$inflection_point$estimated <- FALSE
-maturity$slope$value <- 4 # hardwired for now, need to figure out a better way than this
-maturity$slope$is_random_effect <- FALSE
-maturity$slope$estimated <- FALSE
-
-# population
-population <- new(Population)
-population$log_M <- log(as.numeric(t(rdat$M.age)))
-population$estimate_M <- FALSE
-population$log_init_naa <- log(rdat$N.age[1,]) # log(rdat$initial.guesses$NAA.year1.init)
-population$estimate_init_naa <- FALSE # TRUE , NOTE: fixing at ASAP estimates to test SSB calculations
-population$nages <- nages
-population$ages <- ages
-population$nfleets <- rdat$parms$nfleets + rdat$parms$nindices # fleets plus surveys
-population$nseasons <- nseasons
-population$nyears <- nyears
-#population$prop_female <- 1.0 # ASAP assumption
-
-population$SetMaturity(maturity$get_id())
-population$SetGrowth(ewaa_growth$get_id())
-population$SetRecruitment(recruitment$get_id())
-
-# make FIMS model
-sucess <- CreateTMBModel()
-parameters <- list(p = get_fixed())
-obj <- MakeADFun(data = list(), parameters, DLL = "FIMS", silent = TRUE)
-
-
-# fitting the model
-opt <- nlminb(start=obj$par, objective=obj$fn, gradient=obj$gr,
-              control = list(eval.max = 8000, iter.max = 800))
-#  method = "BFGS",
-#   control = list(maxit=1000000, reltol = 1e-15))
-#print(opt)
-
-
-#max(abs(obj$gr())) # from Cole, can use TMBhelper::fit_tmb to get val to <1e-10
-
-#opt <- TMBhelper::fit_tmb(obj, newtonsteps=3, quiet = TRUE) # don't understand why quiet flag does not work in Quarto
-
-#max(abs(obj$gr()))
-
-sdr <- TMB::sdreport(obj)
-sdr_fixed <- summary(sdr, "fixed")
-report <- obj$report(obj$env$last.par.best)
-
-### Plotting
-
-mycols <- c("FIMS" = "blue", "ASAP" = "red", "ASAP_orig" = "darkgreen")
-
-for (i in 1:rdat$parms$nindices){
-  index_results <- data.frame(
-    survey = i,
-    year = years,
-    observed = rdat$index.obs[[i]],
-    FIMS = report$exp_index[[rdat$parms$nfleet+i]],
-    ASAP = rdat$index.pred[[i]]
-  )
-  if (i==1){
-    allinds_results <- index_results
-  }else{
-    allinds_results <- rbind(allinds_results, index_results)
-  }
-}
-#print(allinds_results)
-
-comp_index <- ggplot(allinds_results, aes(x = year, y = observed)) +
-  geom_point() +
-  geom_line(aes(x = year, y = FIMS), color = "blue") +
-  geom_line(aes(x = year, y = ASAP), color = "red") +
-  facet_wrap(~survey, scales = "free_y", nrow = 2) +
-  xlab("Year") +
-  ylab("Index") +
-  ggtitle("Blue=FIMS, Red=ASAP") +
-  theme_bw()
-#print(comp_index)
-
-catch_results <- data.frame(
-  observed = fishing_fleet_index$index_data,
-  FIMS = report$exp_index[[1]],
-  ASAP = as.numeric(rdat$catch.pred[1,])
-)
-#print(catch_results)
-
-comp_catch <- ggplot(catch_results, aes(x = years, y = observed)) +
-  geom_point() +
-  xlab("Year") +
-  ylab("Catch (mt)") +
-  geom_line(aes(x = years, y = FIMS), color = "blue") +
-  geom_line(aes(x = years, y = ASAP), color = "red") +
-  ggtitle("Blue=FIMS, Red=ASAP") +
-  theme_bw()
-#print(comp_catch)
-
-pop_results <- data.frame(
-  Year = c(years, max(years)+1, years, years, years, years, max(years)+1, years),
-  Metric = c(rep("SSB", 2*nyears+1), rep("F_mort", 2*nyears), rep("Recruitment", 2*nyears+1)),
-  Model = c(rep("FIMS", nyears+1), rep("ASAP", nyears), rep(c("FIMS", "ASAP"), each=nyears), 
-             rep("FIMS", nyears+1), rep("ASAP", nyears)),
-  Value = c(report$ssb[[1]], rdat$SSB, report$F_mort[[1]], rdat$F.report, report$recruitment[[1]], as.numeric(rdat$N.age[,1]))
-)
-#print(pop_results)
-
-# ggplot(filter(pop_results, Year <=2019), aes(x=Year, y=Value, color=Model)) +
-#   geom_line() +
-#   facet_wrap(~Metric, ncol=1, scales = "free_y") +
-#   theme_bw() +
-#   scale_color_manual(values = mycols)
-
-orig_years <- seq(orig$parms$styr, orig$parms$endyr)
-orig_pop_results <- data.frame(
-  Year = rep(orig_years, 3),
-  Metric = rep(c("SSB", "F_mort", "Recruitment"), each = length(orig_years)),
-  Model = "ASAP_orig",
-  Value = c(orig$SSB, orig$F.report, as.numeric(orig$N.age[,1]))
-)
-
-pop_results_3 <- rbind(pop_results, orig_pop_results)
-#print(pop_results_3)
-
-# ggplot(filter(pop_results_3, Year <=2019), aes(x=Year, y=Value, color=Model)) +
-#   geom_line() +
-#   facet_wrap(~Metric, ncol=1, scales = "free_y") +
-#   theme_bw() +
-#   scale_color_manual(values = mycols)
-
-comp_FRSSB3 <- ggplot(pop_results_3, aes(x=Year, y=Value, color=Model)) +
-  geom_line() +
-  facet_wrap(~Metric, ncol=1, scales = "free_y") +
-  theme_bw() +
-  scale_color_manual(values = mycols)
-#print(comp_FRSSB3)
-
-FIMS_naa_results <- data.frame(
-  Year = rep(c(years, max(years)+1), each = nages),
-  Age = rep(ages, nyears+1),
-  Metric = "NAA",
-  Model = "FIMS",
-  Value = report$naa[[1]]
-)
-
-ASAP_naa_results <- data.frame(
-  Year = rep(years, each = nages),
-  Age = rep(ages, nyears),
-  Metric = "NAA",
-  Model = "ASAP",
-  Value = as.numeric(t(rdat$N.age))
-)
-
-orig_naa_results <- data.frame(
-  Year = rep(orig_years, each = nages),
-  Age = rep(ages, length(orig_years)),
-  Metric = "NAA",
-  Model = "ASAP_orig",
-  Value = as.numeric(t(orig$N.age))
-)
-naa_results <- rbind(FIMS_naa_results, ASAP_naa_results, orig_naa_results)
-#print(naa_results)
-
-# ggplot(filter(naa_results, Year <= 2019), aes(x=Year, y=Value, color=Model)) +
-#   geom_line() +
-#   facet_wrap(~Age, ncol=1, scales = "free_y") +
-#   ylab("NAA") +
-#   theme_bw() +
-#   scale_color_manual(values = mycols)
-
-comp_naa2 <- ggplot(filter(naa_results, Year <= 2019, Model %in% c("ASAP", "FIMS")), aes(x=Year, y=Value, color=Model)) +
-  geom_line() +
-  facet_wrap(~Age, ncol=1, scales = "free_y") +
-  ylab("NAA") +
-  theme_bw() +
-  scale_color_manual(values = mycols)
-#print(comp_naa2)
-
-# ggplot(filter(naa_results, Year == 1973, Model %in% c("ASAP", "FIMS")), aes(x=Age, y=Value, color=Model)) +
-#   geom_line() +
-#   ylab("NAA in Year 1") +
-#   theme_bw() +
-#   scale_color_manual(values = mycols)
-
-
-saveplots <- TRUE
-if(saveplots){
-  ggsave(filename = "figures/NEFSC_YT_compare_index.png", plot = comp_index, width = 4, height = 4, units = "in")
-  ggsave(filename = "figures/NEFSC_YT_compare_catch.png", plot = comp_catch, width = 4, height = 4, units = "in")
-  ggsave(filename = "figures/NEFSC_YT_compare_FRSSB3.png", plot = comp_FRSSB3, width = 5, height = 6.5, units = "in")
-  ggsave(filename = "figures/NEFSC_YT_compare_NAA2.png", plot = comp_naa2, width = 5, height = 6.5, units = "in")
-}
    +clear()     +
    +
    +
    NULL
    +
    +
    +Code +
    # read the ASAP rdat files
+rdat <- dget(file.path("data_files", "NEFSC_YT_SIMPLIFIED.RDAT")) # to be used in FIMS, lots of modifications from original
+orig <- dget(file.path("data_files", "NEFSC_YT_ORIGINAL.RDAT"))   # where started before modifications for use in FIMS
+
+# function to create equivalent of data_mile1, basic catch and survey data
+# need to think about how to deal with multiple fleets and indices - only use 1 of each for now
+get_asap_data <- function(rdat){
+  res <- data.frame(type = character(),
+                name = character(),
+                age = integer(),
+                datestart = character(),
+                dateend = character(),
+                value = double(),
+                unit = character(),
+                uncertainty = double())
+  
+  landings <- data.frame(type = "landings",
+                     name = "fleet1",
+                     age = NA,
+                     datestart = paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-01-01"),
+                     dateend = paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-12-31"),
+                     value = as.numeric(rdat$catch.obs[1,]),
+                     unit = "mt",
+                     uncertainty = rdat$control.parms$catch.tot.cv[,1])
+  
+  # loop over all indices
+  for (i in 1:rdat$parms$nindices){
+    index <- data.frame(type = "index",
+                        name = paste0("survey", i),
+                        age = NA,
+                        datestart = paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-01-01"),
+                        dateend = paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-12-31"),
+                        value = as.numeric(rdat$index.obs[[i]]),
+                        unit = "",
+                        uncertainty = rdat$index.cv[[i]])
+    if (i == 1){
+      allinds <- index
+    }else{
+      allinds <- rbind(allinds, index)
+    }
+  }
+  
+  catchage <- data.frame(type = "age",
+                     name = "fleet1",
+                     age = rep(seq(1,rdat$parms$nages), rdat$parms$nyears),
+                     datestart = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-01-01"), each=rdat$parms$nages),
+                     dateend = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-12-31"), each=rdat$parms$nages),
+                     value = as.numeric(t(rdat$catch.comp.mats$catch.fleet1.ob)),
+                     unit = "",
+                     uncertainty = rep(rdat$fleet.catch.Neff.init[1,], each=rdat$parms$nages))
+  
+  # loop over all indices
+  for (i in 1:rdat$parms$nindices){
+    indexage <- data.frame(type = "age",
+                           name = paste0("survey", i),
+                           age = rep(seq(1,rdat$parms$nages), rdat$parms$nyears),
+                           datestart = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-01-01"), each=rdat$parms$nages),
+                           dateend = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), "-12-31"), each=rdat$parms$nages),
+                           value = as.numeric(t(rdat$index.comp.mats[[i*2-1]])),
+                           unit = "",
+                           uncertainty = rep(rdat$index.Neff.init[i,], each=rdat$parms$nages))
+    if (i == 1){
+      allindsage <- indexage
+    }else{
+      allindsage <- rbind(allindsage, indexage)
+    }
+  }
+  
+  res <- rbind(res, landings, allinds, catchage, allindsage)
+  return(res)
+}
+
+mydat <- get_asap_data(rdat)
+
+myfimsframe <- FIMS::FIMSFrame(mydat)
+#str(myfimsframe)
+
+# define the dimensions
+nyears <- rdat$parms$nyears
+years <- seq(rdat$parms$styr, rdat$parms$endyr)
+nseasons <- 1 # ASAP only has one season
+nages <- rdat$parms$nages
+ages <- 1:nages # ASAP starts at age 1
+
+
+# set up FIMS data objects
+age_frame <- FIMS::FIMSFrame(mydat)
+
+fishery_catch <- FIMS::m_landings(age_frame)
+fishery_agecomp <- FIMS::m_agecomp(age_frame, "fleet1")
+survey_index <- list()
+survey_agecomp <- list()
+for (i in 1:rdat$parms$nindices){
+  survey_index[[i]] <- FIMS::m_index(age_frame, paste0("survey", i))
+  survey_agecomp[[i]] <- FIMS::m_agecomp(age_frame, paste0("survey", i))
+}
+
+# eventually change to allow multiple fishing fleets similar to multiple indices - only using 1 fishing fleet for now
+fishing_fleet_index <- methods::new(Index, nyears)
+fishing_fleet_age_comp <- methods::new(AgeComp, nyears, nages)
+fishing_fleet_index$index_data <- fishery_catch
+fishing_fleet_age_comp$age_comp_data <- fishery_agecomp * rep(rdat$fleet.catch.Neff.init[1,], each=rdat$parms$nages)
+
+
+# fleet selectivity
+#methods::show(LogisticSelectivity)
+fishing_fleet_selectivity <- methods::new(LogisticSelectivity)
+fishing_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$fleet.sel.ini[nages+1,1] # hardwired to assume only 1 fleet and logistic selectivity used
+fishing_fleet_selectivity$inflection_point$is_random_effect <- FALSE
+fishing_fleet_selectivity$inflection_point$estimated <- TRUE
+fishing_fleet_selectivity$slope$value <- rdat$sel.input.mats$fleet.sel.ini[nages+2,1] # hardwired to assume only 1 fleet and logistic selectivity used
+fishing_fleet_selectivity$slope$is_random_effect <- FALSE
+fishing_fleet_selectivity$slope$estimated <- TRUE
+
+# create fleet object
+fishing_fleet <- methods::new(Fleet)
+fishing_fleet$nages <- nages
+fishing_fleet$nyears <- nyears
+fishing_fleet$log_Fmort <- log(rep(rdat$initial.guesses$Fmult.year1.init[1], nyears)) # ASAP assumes Fmult devs = 0
+fishing_fleet$estimate_F <- TRUE
+fishing_fleet$random_F <- FALSE
+fishing_fleet$log_q <- log(rdat$initial.guesses$q.year1.init[1])
+fishing_fleet$estimate_q <- FALSE
+fishing_fleet$random_q <- FALSE
+fishing_fleet$log_obs_error <- rep(log(sqrt(log(as.numeric(mean(rdat$control.parms$catch.tot.cv[,1], na.rm=TRUE)^2) + 1))), nyears)
+fishing_fleet$estimate_obs_error <- FALSE
+# Next two lines not currently used by FIMS
+fishing_fleet$SetAgeCompLikelihood(1)
+fishing_fleet$SetIndexLikelihood(1)
+# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above
+fishing_fleet$SetObservedIndexData(fishing_fleet_index$get_id()) 
+fishing_fleet$SetObservedAgeCompData(fishing_fleet_age_comp$get_id())
+fishing_fleet$SetSelectivity(fishing_fleet_selectivity$get_id())
+
+# survey module now can handle multiple indices
+for (i in 1:rdat$parms$nindices){
+  survey_fleet_index <- methods::new(Index, nyears)
+  survey_fleet_age_comp <- methods::new(AgeComp, nyears, nages)
+  survey_fleet_index$index_data <- survey_index[[i]]
+  survey_fleet_age_comp$age_comp_data <- survey_agecomp[[i]] * rep(rdat$index.Neff.init[i,], each=rdat$parms$nages)
+  
+  # survey selectivity
+  survey_fleet_selectivity <- new(LogisticSelectivity)
+  survey_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$index.sel.ini[(i+1)*(nages+2+4)+nages+1,1] # hardwired for this example
+  survey_fleet_selectivity$inflection_point$is_random_effect <- FALSE
+  survey_fleet_selectivity$inflection_point$estimated <- TRUE
+  survey_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$index.sel.ini[(i+1)*(nages+2+4)+nages+1,1] # hardwired for this example
+  survey_fleet_selectivity$slope$is_random_effect <- FALSE
+  survey_fleet_selectivity$slope$estimated <- TRUE
+  
+  survey_fleet <- methods::new(Fleet)
+  survey_fleet$is_survey <- TRUE
+  survey_fleet$nages <- nages
+  survey_fleet$nyears <- nyears
+  survey_fleet$estimate_F <- FALSE
+  survey_fleet$random_F <- FALSE
+  survey_fleet$log_q <- log(rdat$initial.guesses$q.year1.init[i]) 
+  survey_fleet$estimate_q <- TRUE
+  survey_fleet$random_q <- FALSE
+  # sd = sqrt(log(cv^2 + 1)), sd is log transformed
+  survey_fleet$log_obs_error <- rep(log(sqrt(log(as.numeric(mean(rdat$index.cv[[i]], na.rm=TRUE)^2 + 1)))), nyears)
+  survey_fleet$estimate_obs_error <- FALSE
+  survey_fleet$SetAgeCompLikelihood(i)
+  survey_fleet$SetIndexLikelihood(i)
+  survey_fleet$SetSelectivity(survey_fleet_selectivity$get_id())
+  survey_fleet$SetObservedIndexData(survey_fleet_index$get_id())
+  survey_fleet$SetObservedAgeCompData(survey_fleet_age_comp$get_id())
+}
+
+# Population module
+
+# recruitment
+recruitment <- methods::new(BevertonHoltRecruitment)
+#methods::show(BevertonHoltRecruitment)
+
+recruitment$log_sigma_recruit$value <- log(mean(rdat$control.parms$recruit.cv)) # typically enter same value for every year in ASAP
+recruitment$log_rzero$value <- log(rdat$initial.guesses$SR.inits$SR.scaler.init) # ASAP can enter either R0 or SSB0, need to make sure use R0 in input file
+recruitment$log_rzero$is_random_effect <- FALSE
+recruitment$log_rzero$estimated <- TRUE
+# note: do not set steepness exactly equal to 1, use 0.99 instead in ASAP run
+recruitment$logit_steep$value <- -log(1.0 - rdat$initial.guesses$SR.inits$SR_steepness.init) + log(rdat$initial.guesses$SR.inits$SR_steepness.init - 0.2)
+recruitment$logit_steep$is_random_effect <- FALSE
+recruitment$logit_steep$estimated <- FALSE
+
+recruitment$estimate_log_devs <- TRUE
+recruitment$log_devs <- rep(1.0, nyears) # set to no deviations (multiplier) to start, just like ASAP
+
+# growth
+ewaa_growth <- methods::new(EWAAgrowth)
+ewaa_growth$ages <- ages
+# NOTE: FIMS currently cannot use matrix of WAA, so have to ensure constant WAA over time in ASAP file for now
+ewaa_growth$weights <- rdat$WAA.mats$WAA.catch.all[1,] 
+
+# NOTE: FIMS assumes SSB calculated at the start of the year, so need to adjust ASAP to do so as well for now, need to make timing of SSB calculation part of FIMS later
+
+# maturity
+# NOTE: for now tricking FIMS into thinking age 0 is age 1, so need to adjust A50 for maturity because FIMS calculations use ages 0-5+ instead of 1-6
+maturity <- new(LogisticMaturity)
+maturity$inflection_point$value <- 1.8 # hardwired for now, need to figure out a better way than this
+maturity$inflection_point$is_random_effect <- FALSE
+maturity$inflection_point$estimated <- FALSE
+maturity$slope$value <- 4 # hardwired for now, need to figure out a better way than this
+maturity$slope$is_random_effect <- FALSE
+maturity$slope$estimated <- FALSE
+
+# population
+population <- new(Population)
+population$log_M <- log(as.numeric(t(rdat$M.age)))
+population$estimate_M <- FALSE
+population$log_init_naa <- log(rdat$N.age[1,]) # log(rdat$initial.guesses$NAA.year1.init)
+population$estimate_init_naa <- FALSE # TRUE , NOTE: fixing at ASAP estimates to test SSB calculations
+population$nages <- nages
+population$ages <- ages
+population$nfleets <- rdat$parms$nfleets + rdat$parms$nindices # fleets plus surveys
+population$nseasons <- nseasons
+population$nyears <- nyears
+#population$prop_female <- 1.0 # ASAP assumption
+
+population$SetMaturity(maturity$get_id())
+population$SetGrowth(ewaa_growth$get_id())
+population$SetRecruitment(recruitment$get_id())
+
+# make FIMS model
+sucess <- CreateTMBModel()
+parameters <- list(p = get_fixed())
+obj <- MakeADFun(data = list(), parameters, DLL = "FIMS", silent = TRUE)
+
+
+# fitting the model
+opt <- nlminb(start=obj$par, objective=obj$fn, gradient=obj$gr,
+              control = list(eval.max = 8000, iter.max = 800))
+#  method = "BFGS",
+#   control = list(maxit=1000000, reltol = 1e-15))
+#print(opt)
+
+
+#max(abs(obj$gr())) # from Cole, can use TMBhelper::fit_tmb to get val to <1e-10
+
+#opt <- TMBhelper::fit_tmb(obj, newtonsteps=3, quiet = TRUE) # don't understand why quiet flag does not work in Quarto
+
+#max(abs(obj$gr()))
+
+sdr <- TMB::sdreport(obj)
+sdr_fixed <- summary(sdr, "fixed")
+report <- obj$report(obj$env$last.par.best)
+
+### Plotting
+
+mycols <- c("FIMS" = "blue", "ASAP" = "red", "ASAP_orig" = "darkgreen")
+
+for (i in 1:rdat$parms$nindices){
+  index_results <- data.frame(
+    survey = i,
+    year = years,
+    observed = rdat$index.obs[[i]],
+    FIMS = report$exp_index[[rdat$parms$nfleet+i]],
+    ASAP = rdat$index.pred[[i]]
+  )
+  if (i==1){
+    allinds_results <- index_results
+  }else{
+    allinds_results <- rbind(allinds_results, index_results)
+  }
+}
+#print(allinds_results)
+
+comp_index <- ggplot(allinds_results, aes(x = year, y = observed)) +
+  geom_point() +
+  geom_line(aes(x = year, y = FIMS), color = "blue") +
+  geom_line(aes(x = year, y = ASAP), color = "red") +
+  facet_wrap(~survey, scales = "free_y", nrow = 2) +
+  xlab("Year") +
+  ylab("Index") +
+  ggtitle("Blue=FIMS, Red=ASAP") +
+  theme_bw()
+#print(comp_index)
+
+catch_results <- data.frame(
+  observed = fishing_fleet_index$index_data,
+  FIMS = report$exp_index[[1]],
+  ASAP = as.numeric(rdat$catch.pred[1,])
+)
+#print(catch_results)
+
+comp_catch <- ggplot(catch_results, aes(x = years, y = observed)) +
+  geom_point() +
+  xlab("Year") +
+  ylab("Catch (mt)") +
+  geom_line(aes(x = years, y = FIMS), color = "blue") +
+  geom_line(aes(x = years, y = ASAP), color = "red") +
+  ggtitle("Blue=FIMS, Red=ASAP") +
+  theme_bw()
+#print(comp_catch)
+
+pop_results <- data.frame(
+  Year = c(years, max(years)+1, years, years, years, years, max(years)+1, years),
+  Metric = c(rep("SSB", 2*nyears+1), rep("F_mort", 2*nyears), rep("Recruitment", 2*nyears+1)),
+  Model = c(rep("FIMS", nyears+1), rep("ASAP", nyears), rep(c("FIMS", "ASAP"), each=nyears), 
+             rep("FIMS", nyears+1), rep("ASAP", nyears)),
+  Value = c(report$ssb[[1]], rdat$SSB, report$F_mort[[1]], rdat$F.report, report$recruitment[[1]], as.numeric(rdat$N.age[,1]))
+)
+#print(pop_results)
+
+# ggplot(filter(pop_results, Year <=2019), aes(x=Year, y=Value, color=Model)) +
+#   geom_line() +
+#   facet_wrap(~Metric, ncol=1, scales = "free_y") +
+#   theme_bw() +
+#   scale_color_manual(values = mycols)
+
+orig_years <- seq(orig$parms$styr, orig$parms$endyr)
+orig_pop_results <- data.frame(
+  Year = rep(orig_years, 3),
+  Metric = rep(c("SSB", "F_mort", "Recruitment"), each = length(orig_years)),
+  Model = "ASAP_orig",
+  Value = c(orig$SSB, orig$F.report, as.numeric(orig$N.age[,1]))
+)
+
+pop_results_3 <- rbind(pop_results, orig_pop_results)
+#print(pop_results_3)
+
+# ggplot(filter(pop_results_3, Year <=2019), aes(x=Year, y=Value, color=Model)) +
+#   geom_line() +
+#   facet_wrap(~Metric, ncol=1, scales = "free_y") +
+#   theme_bw() +
+#   scale_color_manual(values = mycols)
+
+comp_FRSSB3 <- ggplot(pop_results_3, aes(x=Year, y=Value, color=Model)) +
+  geom_line() +
+  facet_wrap(~Metric, ncol=1, scales = "free_y") +
+  theme_bw() +
+  scale_color_manual(values = mycols)
+#print(comp_FRSSB3)
+
+FIMS_naa_results <- data.frame(
+  Year = rep(c(years, max(years)+1), each = nages),
+  Age = rep(ages, nyears+1),
+  Metric = "NAA",
+  Model = "FIMS",
+  Value = report$naa[[1]]
+)
+
+ASAP_naa_results <- data.frame(
+  Year = rep(years, each = nages),
+  Age = rep(ages, nyears),
+  Metric = "NAA",
+  Model = "ASAP",
+  Value = as.numeric(t(rdat$N.age))
+)
+
+orig_naa_results <- data.frame(
+  Year = rep(orig_years, each = nages),
+  Age = rep(ages, length(orig_years)),
+  Metric = "NAA",
+  Model = "ASAP_orig",
+  Value = as.numeric(t(orig$N.age))
+)
+naa_results <- rbind(FIMS_naa_results, ASAP_naa_results, orig_naa_results)
+#print(naa_results)
+
+# ggplot(filter(naa_results, Year <= 2019), aes(x=Year, y=Value, color=Model)) +
+#   geom_line() +
+#   facet_wrap(~Age, ncol=1, scales = "free_y") +
+#   ylab("NAA") +
+#   theme_bw() +
+#   scale_color_manual(values = mycols)
+
+comp_naa2 <- ggplot(filter(naa_results, Year <= 2019, Model %in% c("ASAP", "FIMS")), aes(x=Year, y=Value, color=Model)) +
+  geom_line() +
+  facet_wrap(~Age, ncol=1, scales = "free_y") +
+  ylab("NAA") +
+  theme_bw() +
+  scale_color_manual(values = mycols)
+#print(comp_naa2)
+
+# ggplot(filter(naa_results, Year == 1973, Model %in% c("ASAP", "FIMS")), aes(x=Age, y=Value, color=Model)) +
+#   geom_line() +
+#   ylab("NAA in Year 1") +
+#   theme_bw() +
+#   scale_color_manual(values = mycols)
+
+
+saveplots <- TRUE
+if(saveplots){
+  ggsave(filename = "figures/NEFSC_YT_compare_index.png", plot = comp_index, width = 4, height = 4, units = "in")
+  ggsave(filename = "figures/NEFSC_YT_compare_catch.png", plot = comp_catch, width = 4, height = 4, units = "in")
+  ggsave(filename = "figures/NEFSC_YT_compare_FRSSB3.png", plot = comp_FRSSB3, width = 5, height = 6.5, units = "in")
+  ggsave(filename = "figures/NEFSC_YT_compare_NAA2.png", plot = comp_naa2, width = 5, height = 6.5, units = "in")
+}
    @@ -745,13 +750,13 @@

    Comparison table

    Code -
    jnlltab <- data.frame(Component=c("Total","Index","Age Comp", "Rec"),
-                      FIMS = c(report$jnll, report$index_nll, report$age_comp_nll, report$rec_nll),
-                      ASAP = c(rdat$like$lk.total,
-                               (rdat$like$lk.catch.total + rdat$like$lk.index.fit.total),
-                               (rdat$like$lk.catch.age.comp + rdat$like$lk.index.age.comp),
-                               rdat$like$lk.Recruit.devs))
-print(jnlltab)
    +
    jnlltab <- data.frame(Component=c("Total","Index","Age Comp", "Rec"),
+                      FIMS = c(report$jnll, report$index_nll, report$age_comp_nll, report$rec_nll),
+                      ASAP = c(rdat$like$lk.total,
+                               (rdat$like$lk.catch.total + rdat$like$lk.index.fit.total),
+                               (rdat$like$lk.catch.age.comp + rdat$like$lk.index.age.comp),
+                               rdat$like$lk.Recruit.devs))
+print(jnlltab)
      Component      FIMS     ASAP
@@ -792,9 +797,12 @@ 
    
 
    
 Code
-
    # Clear C++ objects from memory
-clear()
    
+
    # Clear C++ objects from memory
+clear()
    
 
    
+
    
+
    NULL
    
+
    diff --git a/content/NWFSC-petrale.html b/content/NWFSC-petrale.html index 941e273..1e16d34 100644 --- a/content/NWFSC-petrale.html +++ b/content/NWFSC-petrale.html @@ -2,7 +2,7 @@ - + @@ -305,7 +305,7 @@

    The setup

  • TMB version: 1.9.14
    • -
  • FIMS commit: 39d0743
    +
  • FIMS commit: 081972c
  • Stock name: West Coast Petrale Sole
    • @@ -568,11 +568,10 @@

    Setup FIMS model

    population$nfleets <- 2 # fleets plus surveys population$nseasons <- nseasons population$nyears <- nyears -# population$proportion_female <- rep(0.5, nages) - -population$SetMaturity(maturity$get_id()) -population$SetGrowth(ewaa_growth$get_id()) -population$SetRecruitment(recruitment$get_id())
    + +population$SetMaturity(maturity$get_id()) +population$SetGrowth(ewaa_growth$get_id()) +population$SetRecruitment(recruitment$get_id()) diff --git a/content/PIFS-opakapaka.html b/content/PIFS-opakapaka.html index c4698db..a237757 100644 --- a/content/PIFS-opakapaka.html +++ b/content/PIFS-opakapaka.html @@ -2,7 +2,7 @@ - + diff --git a/content/SEFSC-scamp.html b/content/SEFSC-scamp.html index a83b891..3a1a96f 100644 --- a/content/SEFSC-scamp.html +++ b/content/SEFSC-scamp.html @@ -2,7 +2,7 @@ - + @@ -302,7 +302,7 @@

    Setup description

  • TMB version: 1.9.14
    • -
  • FIMS commit: 39d0743
    +
  • FIMS commit: 081972c
  • Stock name: South Atlantic scamp grouper
    • @@ -663,313 +663,312 @@

    population$estimate_M <- FALSE population$log_init_naa <- log(sca$N.age[1, ]) population$estimate_init_naa <- FALSE -# population$proportion_female <- rep(1.0,nages) #For scamp, assuming all females (see maturity note above) -population$nages <- nages -population$ages <- ages -population$nfleets <- 3 # 2 fleets and 1 survey -population$nseasons <- nseasons -population$nyears <- nyears - -# Link recruitment, growth, and maturity modules to this new popn module -population$SetMaturity(maturity$get_id()) -population$SetGrowth(ewaa_growth$get_id()) -population$SetRecruitment(recruitment$get_id()) - -#################################################################################### -# Put it all together, creating the FIMS model and making the TMB fcn -success <- CreateTMBModel() -parameters <- list(p = get_fixed()) -obj <- MakeADFun(data = list(), parameters, DLL = "FIMS", silent = TRUE) - -# Fitting the model -opt <- nlminb(obj$par, obj$fn, obj$gr, - control = list(eval.max = 800, iter.max = 800) -) # , method = "BFGS", -# control = list(maxit=1000000, reltol = 1e-15)) - -# print(opt) +population$nages <- nages +population$ages <- ages +population$nfleets <- 3 # 2 fleets and 1 survey +population$nseasons <- nseasons +population$nyears <- nyears + +# Link recruitment, growth, and maturity modules to this new popn module +population$SetMaturity(maturity$get_id()) +population$SetGrowth(ewaa_growth$get_id()) +population$SetRecruitment(recruitment$get_id()) + +#################################################################################### +# Put it all together, creating the FIMS model and making the TMB fcn +success <- CreateTMBModel() +parameters <- list(p = get_fixed()) +obj <- MakeADFun(data = list(), parameters, DLL = "FIMS", silent = TRUE) + +# Fitting the model +opt <- nlminb(obj$par, obj$fn, obj$gr, + control = list(eval.max = 800, iter.max = 800) +) # , method = "BFGS", +# control = list(maxit=1000000, reltol = 1e-15)) + +# print(opt) + - -# TMB reporting -sdr <- TMB::sdreport(obj) -sdr_fixed <- summary(sdr, "fixed") -report <- obj$report(obj$env$last.par.best) - -# print(sdr_fixed) - -###################################################################### -# Plot results -library(colorspace) -cols <- sequential_hcl(5, "Viridis") -out.folder <- "figures" -dir.create(out.folder, showWarnings = FALSE) -plot.type <- "png" - -selex.bam.fleet1 <- 1 / (1 + exp(-sca$parm.cons$selpar_slope_COM2[8] * (ages - sca$parm.cons$selpar_A50_COM2[8]))) -selex.fims.fleet1 <- 1 / (1 + exp(-opt$par[2] * (ages - opt$par[1]))) -selex.bam.fleet2 <- 1 / (1 + exp(-sca$parm.cons$selpar_slope1_REC2[8] * (ages - sca$parm.cons$selpar_A50_REC2[8]))) -selex.fims.fleet2 <- 1 / (1 + exp(-opt$par[4] * (ages - opt$par[3]))) -selex.bam.survey <- 1 / (1 + exp(-sca$parm.cons$selpar_slope1_CVT[8] * (ages - sca$parm.cons$selpar_A501_CVT[8]))) -selex.fims.survey <- 1 / (1 + exp(-opt$par[6] * (ages - opt$par[5]))) +# TMB reporting +sdr <- TMB::sdreport(obj) +sdr_fixed <- summary(sdr, "fixed") +report <- obj$report(obj$env$last.par.best) + +# print(sdr_fixed) + +###################################################################### +# Plot results +library(colorspace) +cols <- sequential_hcl(5, "Viridis") +out.folder <- "figures" +dir.create(out.folder, showWarnings = FALSE) +plot.type <- "png" + +selex.bam.fleet1 <- 1 / (1 + exp(-sca$parm.cons$selpar_slope_COM2[8] * (ages - sca$parm.cons$selpar_A50_COM2[8]))) +selex.fims.fleet1 <- 1 / (1 + exp(-opt$par[2] * (ages - opt$par[1]))) +selex.bam.fleet2 <- 1 / (1 + exp(-sca$parm.cons$selpar_slope1_REC2[8] * (ages - sca$parm.cons$selpar_A50_REC2[8]))) +selex.fims.fleet2 <- 1 / (1 + exp(-opt$par[4] * (ages - opt$par[3]))) +selex.bam.survey <- 1 / (1 + exp(-sca$parm.cons$selpar_slope1_CVT[8] * (ages - sca$parm.cons$selpar_A501_CVT[8]))) +selex.fims.survey <- 1 / (1 + exp(-opt$par[6] * (ages - opt$par[5]))) + - -index_results_allyr <- data.frame( - yr = styr:endyr, - observed = spp_survey1_index$index_data, - fims.expected = report$exp_index[[3]], - bam.expected = sca$t.series$U.CVT.pr -) -index_results <- index_results_allyr %>% filter(observed != -999.00) -fleet1_landings_results <- data.frame( - yr = styr:endyr, - observed = spp_fleet1_landings$index_data, - fims.expected = report$exp_index[[1]], - bam.expected = sca$t.series$L.COM.pr -) -fleet2_landings_results <- data.frame( - yr = styr:endyr, - observed = spp_fleet2_landings$index_data, - fims.expected = report$exp_index[[2]], - bam.expected = sca$t.series$L.REC.pr -) - -fleet1_F_results <- data.frame( - yr = styr:endyr, - fims.F.fleet1 = report$F_mort[[1]], - bam.F.fleet1 = sca$t.series$F.COM -) -fleet2_F_results <- data.frame( - yr = styr:endyr, - fims.F.fleet2 = report$F_mort[[2]], - bam.F.fleet2 = sca$t.series$F.REC -) - -# Dropping the last (extra) year from FIMS output, assuming it is a projection yr (not an initialization yr) -fims.naa <- matrix(report$naa[[1]], ncol = nages, byrow = TRUE) -fims.naa <- fims.naa[-54, ] -popn_results <- data.frame( - yr = styr:endyr, - fims.ssb = report$ssb[[1]][1:nyears], - fims.recruits = report$recruitment[[1]][1:nyears] / 1000, - fims.biomass = report$biomass[[1]][1:nyears], - fims.abundance = rowSums(fims.naa) / 1000, - bam.ssb = sca$t.series$SSB, - bam.recruits = sca$t.series$recruits / 1000, - bam.biomass = sca$t.series$B, - bam.abundance = sca$t.series$N / 1000 -) - -yr.ind <- 1:nyears - -yr.fleet1.ind <- yr.ind[fleet1_ac_n >= 0] -yr.fleet1.ac <- years[yr.fleet1.ind] -fims.fleet1.ncaa <- matrix(report$cnaa[[1]], ncol = nages, byrow = TRUE) -fims.fleet1.ncaa <- fims.fleet1.ncaa[yr.fleet1.ind, ] -fims.fleet1.caa <- fims.fleet1.ncaa / rowSums(fims.fleet1.ncaa) -bam.fleet1.caa <- sca$comp.mats$acomp.COM.pr -obs.fleet1.caa <- sca$comp.mats$acomp.COM.ob - -yr.fleet2.ind <- yr.ind[fleet2_ac_n >= 0] -yr.fleet2.ac <- years[yr.fleet2.ind] -fims.fleet2.ncaa <- matrix(report$cnaa[[2]], ncol = nages, byrow = TRUE) -fims.fleet2.ncaa <- fims.fleet2.ncaa[yr.fleet2.ind, ] -fims.fleet2.caa <- fims.fleet2.ncaa / rowSums(fims.fleet2.ncaa) -bam.fleet2.caa <- sca$comp.mats$acomp.REC.pr -obs.fleet2.caa <- sca$comp.mats$acomp.REC.ob - -yr.survey.ind <- yr.ind[survey_ac_n >= 0] -yr.survey.ac <- years[yr.survey.ind] -fims.survey.ncaa <- matrix(report$cnaa[[3]], ncol = nages, byrow = TRUE) -fims.survey.ncaa <- fims.survey.ncaa[yr.survey.ind, ] -fims.survey.caa <- fims.survey.ncaa / rowSums(fims.survey.ncaa) -bam.survey.caa <- sca$comp.mats$acomp.CVT.pr -obs.survey.caa <- sca$comp.mats$acomp.CVT.ob -###################################################################### -png(filename = paste(out.folder, "/SEFSC_scamp_tseries_fits.", plot.type, sep = ""), width = 8, height = 10, units="in", res=72) -mat <- matrix(1:3, ncol = 1) -layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) -par(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1) - -plot(index_results$yr, index_results$observed, - ylim = c(0, max(index_results[, -1])), - pch = 16, col = cols[1], ylab = "Index", xlab = "" -) -lines(index_results$yr, index_results$bam.expected, lwd = 3, col = cols[2]) -lines(index_results$yr, index_results$fims.expected, lwd = 3, col = cols[4]) -legend("topright", - legend = c("observed", "BAM expected", "FIMS expected"), - pch = c(16, -1, -1), lwd = c(-1, 3, 3), col = c(cols[1], cols[2], cols[4]) -) - -plot(fleet1_landings_results$yr, fleet1_landings_results$observed, - ylim = c(0, max(fleet1_landings_results[, -1])), - pch = 16, col = cols[1], ylab = "Fleet1 landings (mt)", xlab = "" -) -lines(fleet1_landings_results$yr, fleet1_landings_results$bam.expected, lwd = 3, col = cols[2]) -lines(fleet1_landings_results$yr, fleet1_landings_results$fims.expected, lwd = 3, col = cols[4]) - -plot(fleet2_landings_results$yr, fleet2_landings_results$observed, - ylim = c(0, max(fleet2_landings_results[, -1])), - pch = 16, col = cols[1], ylab = "Fleet2 landings (mt)", xlab = "" -) -lines(fleet2_landings_results$yr, fleet2_landings_results$bam.expected, lwd = 3, col = cols[2]) -lines(fleet2_landings_results$yr, fleet2_landings_results$fims.expected, lwd = 3, col = cols[4]) - -dev.off() - -###################################################################### -png(filename = paste(out.folder, "/SEFSC_scamp_tseries_F.", plot.type, sep = ""), width = 8, height = 8, units="in", res=72) -mat <- matrix(1:2, ncol = 1) -layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) -par(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1) - -plot(fleet1_F_results$yr, fleet1_F_results$bam.F.fleet1, - ylim = c(0, max(fleet1_F_results[, -1])), - type = "l", lwd = 3, col = cols[2], ylab = "Fleet 1 F", xlab = "" -) -lines(fleet1_F_results$yr, fleet1_F_results$fims.F.fleet1, lwd = 3, col = cols[4]) -legend("topleft", - legend = c("BAM predicted", "FIMS predicted"), - lwd = c(3, 3), col = c(cols[2], cols[4]) -) -plot(fleet2_F_results$yr, fleet2_F_results$bam.F.fleet2, - ylim = c(0, max(fleet2_F_results[, -1])), - type = "l", lwd = 3, col = cols[2], ylab = "Fleet 2 F", xlab = "" -) -lines(fleet2_F_results$yr, fleet2_F_results$fims.F.fleet2, lwd = 3, col = cols[4]) - -dev.off() - -###################################################################### -png(filename = paste(out.folder, "/SEFSC_scamp_selex.", plot.type, sep = ""), width = 8, height = 10, units="in", res=72) -mat <- matrix(1:3, ncol = 1) -layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) -par(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1) - -plot(ages, selex.bam.fleet1, lwd = 3, col = cols[2], type = "l", xlab = "", ylab = "Fleet1 selectivity") -lines(ages, selex.fims.fleet1, lwd = 3, col = cols[4]) -legend("bottomright", - legend = c("BAM predicted", "FIMS predicted"), - lwd = c(3, 3), col = c(cols[2], cols[4]) -) -plot(ages, selex.bam.fleet2, lwd = 3, col = cols[2], type = "l", xlab = "", ylab = "Fleet2 selectivity") -lines(ages, selex.fims.fleet2, lwd = 3, col = cols[4]) -plot(ages, selex.bam.survey, lwd = 3, col = cols[2], type = "l", xlab = "Age", ylab = "Survey selectivity") -lines(ages, selex.fims.survey, lwd = 3, col = cols[4]) - -dev.off() +index_results_allyr <- data.frame( + yr = styr:endyr, + observed = spp_survey1_index$index_data, + fims.expected = report$exp_index[[3]], + bam.expected = sca$t.series$U.CVT.pr +) +index_results <- index_results_allyr %>% filter(observed != -999.00) +fleet1_landings_results <- data.frame( + yr = styr:endyr, + observed = spp_fleet1_landings$index_data, + fims.expected = report$exp_index[[1]], + bam.expected = sca$t.series$L.COM.pr +) +fleet2_landings_results <- data.frame( + yr = styr:endyr, + observed = spp_fleet2_landings$index_data, + fims.expected = report$exp_index[[2]], + bam.expected = sca$t.series$L.REC.pr +) + +fleet1_F_results <- data.frame( + yr = styr:endyr, + fims.F.fleet1 = report$F_mort[[1]], + bam.F.fleet1 = sca$t.series$F.COM +) +fleet2_F_results <- data.frame( + yr = styr:endyr, + fims.F.fleet2 = report$F_mort[[2]], + bam.F.fleet2 = sca$t.series$F.REC +) + +# Dropping the last (extra) year from FIMS output, assuming it is a projection yr (not an initialization yr) +fims.naa <- matrix(report$naa[[1]], ncol = nages, byrow = TRUE) +fims.naa <- fims.naa[-54, ] +popn_results <- data.frame( + yr = styr:endyr, + fims.ssb = report$ssb[[1]][1:nyears], + fims.recruits = report$recruitment[[1]][1:nyears] / 1000, + fims.biomass = report$biomass[[1]][1:nyears], + fims.abundance = rowSums(fims.naa) / 1000, + bam.ssb = sca$t.series$SSB, + bam.recruits = sca$t.series$recruits / 1000, + bam.biomass = sca$t.series$B, + bam.abundance = sca$t.series$N / 1000 +) + +yr.ind <- 1:nyears + +yr.fleet1.ind <- yr.ind[fleet1_ac_n >= 0] +yr.fleet1.ac <- years[yr.fleet1.ind] +fims.fleet1.ncaa <- matrix(report$cnaa[[1]], ncol = nages, byrow = TRUE) +fims.fleet1.ncaa <- fims.fleet1.ncaa[yr.fleet1.ind, ] +fims.fleet1.caa <- fims.fleet1.ncaa / rowSums(fims.fleet1.ncaa) +bam.fleet1.caa <- sca$comp.mats$acomp.COM.pr +obs.fleet1.caa <- sca$comp.mats$acomp.COM.ob + +yr.fleet2.ind <- yr.ind[fleet2_ac_n >= 0] +yr.fleet2.ac <- years[yr.fleet2.ind] +fims.fleet2.ncaa <- matrix(report$cnaa[[2]], ncol = nages, byrow = TRUE) +fims.fleet2.ncaa <- fims.fleet2.ncaa[yr.fleet2.ind, ] +fims.fleet2.caa <- fims.fleet2.ncaa / rowSums(fims.fleet2.ncaa) +bam.fleet2.caa <- sca$comp.mats$acomp.REC.pr +obs.fleet2.caa <- sca$comp.mats$acomp.REC.ob + +yr.survey.ind <- yr.ind[survey_ac_n >= 0] +yr.survey.ac <- years[yr.survey.ind] +fims.survey.ncaa <- matrix(report$cnaa[[3]], ncol = nages, byrow = TRUE) +fims.survey.ncaa <- fims.survey.ncaa[yr.survey.ind, ] +fims.survey.caa <- fims.survey.ncaa / rowSums(fims.survey.ncaa) +bam.survey.caa <- sca$comp.mats$acomp.CVT.pr +obs.survey.caa <- sca$comp.mats$acomp.CVT.ob +###################################################################### +png(filename = paste(out.folder, "/SEFSC_scamp_tseries_fits.", plot.type, sep = ""), width = 8, height = 10, units="in", res=72) +mat <- matrix(1:3, ncol = 1) +layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) +par(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1) + +plot(index_results$yr, index_results$observed, + ylim = c(0, max(index_results[, -1])), + pch = 16, col = cols[1], ylab = "Index", xlab = "" +) +lines(index_results$yr, index_results$bam.expected, lwd = 3, col = cols[2]) +lines(index_results$yr, index_results$fims.expected, lwd = 3, col = cols[4]) +legend("topright", + legend = c("observed", "BAM expected", "FIMS expected"), + pch = c(16, -1, -1), lwd = c(-1, 3, 3), col = c(cols[1], cols[2], cols[4]) +) + +plot(fleet1_landings_results$yr, fleet1_landings_results$observed, + ylim = c(0, max(fleet1_landings_results[, -1])), + pch = 16, col = cols[1], ylab = "Fleet1 landings (mt)", xlab = "" +) +lines(fleet1_landings_results$yr, fleet1_landings_results$bam.expected, lwd = 3, col = cols[2]) +lines(fleet1_landings_results$yr, fleet1_landings_results$fims.expected, lwd = 3, col = cols[4]) + +plot(fleet2_landings_results$yr, fleet2_landings_results$observed, + ylim = c(0, max(fleet2_landings_results[, -1])), + pch = 16, col = cols[1], ylab = "Fleet2 landings (mt)", xlab = "" +) +lines(fleet2_landings_results$yr, fleet2_landings_results$bam.expected, lwd = 3, col = cols[2]) +lines(fleet2_landings_results$yr, fleet2_landings_results$fims.expected, lwd = 3, col = cols[4]) + +dev.off() + +###################################################################### +png(filename = paste(out.folder, "/SEFSC_scamp_tseries_F.", plot.type, sep = ""), width = 8, height = 8, units="in", res=72) +mat <- matrix(1:2, ncol = 1) +layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) +par(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1) + +plot(fleet1_F_results$yr, fleet1_F_results$bam.F.fleet1, + ylim = c(0, max(fleet1_F_results[, -1])), + type = "l", lwd = 3, col = cols[2], ylab = "Fleet 1 F", xlab = "" +) +lines(fleet1_F_results$yr, fleet1_F_results$fims.F.fleet1, lwd = 3, col = cols[4]) +legend("topleft", + legend = c("BAM predicted", "FIMS predicted"), + lwd = c(3, 3), col = c(cols[2], cols[4]) +) +plot(fleet2_F_results$yr, fleet2_F_results$bam.F.fleet2, + ylim = c(0, max(fleet2_F_results[, -1])), + type = "l", lwd = 3, col = cols[2], ylab = "Fleet 2 F", xlab = "" +) +lines(fleet2_F_results$yr, fleet2_F_results$fims.F.fleet2, lwd = 3, col = cols[4]) + +dev.off() + +###################################################################### +png(filename = paste(out.folder, "/SEFSC_scamp_selex.", plot.type, sep = ""), width = 8, height = 10, units="in", res=72) +mat <- matrix(1:3, ncol = 1) +layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) +par(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1) + +plot(ages, selex.bam.fleet1, lwd = 3, col = cols[2], type = "l", xlab = "", ylab = "Fleet1 selectivity") +lines(ages, selex.fims.fleet1, lwd = 3, col = cols[4]) +legend("bottomright", + legend = c("BAM predicted", "FIMS predicted"), + lwd = c(3, 3), col = c(cols[2], cols[4]) +) +plot(ages, selex.bam.fleet2, lwd = 3, col = cols[2], type = "l", xlab = "", ylab = "Fleet2 selectivity") +lines(ages, selex.fims.fleet2, lwd = 3, col = cols[4]) +plot(ages, selex.bam.survey, lwd = 3, col = cols[2], type = "l", xlab = "Age", ylab = "Survey selectivity") +lines(ages, selex.fims.survey, lwd = 3, col = cols[4]) + +dev.off() + - -###################################################################### - -png(filename = paste(out.folder, "/SEFSC_scamp_tseries_popn.", plot.type, sep = ""), width = 8, height = 7, units="in", res=72) -mat <- matrix(1:4, ncol = 2) -layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) -par(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1) - -plot(popn_results$yr, popn_results$bam.ssb, - ylim = c(0, max(popn_results[, c(2, 6)])), - type = "l", lwd = 3, col = cols[2], ylab = "SSB (mt)", xlab = "" -) -lines(popn_results$yr, popn_results$fims.ssb, lwd = 3, col = cols[4]) -legend("topleft", - legend = c("BAM predicted", "FIMS predicted"), - lwd = c(3, 3), col = c(cols[2], cols[4]) -) - -plot(popn_results$yr, popn_results$bam.biomass, - ylim = c(0, max(popn_results[, c(4, 8)])), - type = "l", lwd = 3, col = cols[2], ylab = "Biomass (mt)", xlab = "" -) -lines(popn_results$yr, popn_results$fims.biomass, lwd = 3, col = cols[4]) - -plot(popn_results$yr, popn_results$bam.recruits, - ylim = c(0, max(popn_results[, c(3, 7)])), - type = "l", lwd = 3, col = cols[2], ylab = "Recruits (1000s)", xlab = "" -) -lines(popn_results$yr, popn_results$fims.recruits, lwd = 3, col = cols[4]) - -plot(popn_results$yr, popn_results$bam.abundance, - ylim = c(0, max(popn_results[, c(5, 9)])), - type = "l", lwd = 3, col = cols[2], ylab = "Abundance (1000s)", xlab = "" -) -lines(popn_results$yr, popn_results$fims.abundance, lwd = 3, col = cols[4]) - -dev.off() - -###################################################################### -png(filename = paste(out.folder, "/SEFSC_scamp_caa_fleet1.", plot.type, sep = ""), width = 8, height = 11, units="in", res=72) -mat <- matrix(1:18, ncol = 3) -layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) -par(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75) - -for (i in 1:nrow(obs.fleet1.caa)) -{ - plot(1:nages, obs.fleet1.caa[i, ], col = cols[1], xlab = "", ylab = "", pch = 16) - lines(1:nages, bam.fleet1.caa[i, ], lwd = 3, col = cols[2]) - lines(1:nages, fims.fleet1.caa[i, ], lwd = 3, col = cols[4]) - if (i > 1) legend("topright", legend = yr.fleet1.ac[i], cex = 1, bty = "n") - if (i == 1) { - legend("topright", - legend = c("Fleet1 Age Comps", "observed", "BAM expected", "FIMS expected"), - pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.7 - ) - legend("right", legend = yr.fleet1.ac[i], cex = 1, bty = "n") - } -} - -dev.off() - -###################################################################### -png(filename = paste(out.folder, "/SEFSC_scamp_caa_fleet2.", plot.type, sep = ""), width = 8, height = 11, units="in", res=72) - -mat <- matrix(1:28, ncol = 4) -layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) -par(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75) - -for (i in 1:nrow(obs.fleet2.caa)) -{ - plot(1:nages, obs.fleet2.caa[i, ], col = cols[1], xlab = "", ylab = "", pch = 16) - lines(1:nages, bam.fleet2.caa[i, ], lwd = 3, col = cols[2]) - lines(1:nages, fims.fleet2.caa[i, ], lwd = 3, col = cols[4]) - if (i > 1) legend("topright", legend = yr.fleet2.ac[i], cex = 1, bty = "n") - if (i == 1) { - legend("topright", - legend = c("Fleet2 Age Comps", "observed", "BAM expected", "FIMS expected"), - pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.5 - ) - legend("right", legend = yr.fleet2.ac[i], cex = 1, bty = "n") - } -} - -dev.off() - -###################################################################### -png(filename = paste(out.folder, "/SEFSC_scamp_caa_survey.", plot.type, sep = ""), width = 8, height = 11, units="in", res=72) - -mat <- matrix(1:30, ncol = 5) -layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) -par(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75) - -for (i in 1:nrow(obs.survey.caa)) -{ - plot(1:nages, obs.survey.caa[i, ], col = cols[1], xlab = "", ylab = "", pch = 16) - lines(1:nages, bam.survey.caa[i, ], lwd = 3, col = cols[2]) - lines(1:nages, fims.survey.caa[i, ], lwd = 3, col = cols[4]) - if (i > 1) legend("topright", legend = yr.survey.ac[i], cex = 1, bty = "n") - if (i == 1) { - legend("topright", - legend = c("Survey Age Comps", "observed", "BAM expected", "FIMS expected"), - pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.5 - ) - legend("right", legend = yr.survey.ac[i], cex = 1, bty = "n") - } -} - -dev.off() - -clear() +###################################################################### + +png(filename = paste(out.folder, "/SEFSC_scamp_tseries_popn.", plot.type, sep = ""), width = 8, height = 7, units="in", res=72) +mat <- matrix(1:4, ncol = 2) +layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) +par(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1) + +plot(popn_results$yr, popn_results$bam.ssb, + ylim = c(0, max(popn_results[, c(2, 6)])), + type = "l", lwd = 3, col = cols[2], ylab = "SSB (mt)", xlab = "" +) +lines(popn_results$yr, popn_results$fims.ssb, lwd = 3, col = cols[4]) +legend("topleft", + legend = c("BAM predicted", "FIMS predicted"), + lwd = c(3, 3), col = c(cols[2], cols[4]) +) + +plot(popn_results$yr, popn_results$bam.biomass, + ylim = c(0, max(popn_results[, c(4, 8)])), + type = "l", lwd = 3, col = cols[2], ylab = "Biomass (mt)", xlab = "" +) +lines(popn_results$yr, popn_results$fims.biomass, lwd = 3, col = cols[4]) + +plot(popn_results$yr, popn_results$bam.recruits, + ylim = c(0, max(popn_results[, c(3, 7)])), + type = "l", lwd = 3, col = cols[2], ylab = "Recruits (1000s)", xlab = "" +) +lines(popn_results$yr, popn_results$fims.recruits, lwd = 3, col = cols[4]) + +plot(popn_results$yr, popn_results$bam.abundance, + ylim = c(0, max(popn_results[, c(5, 9)])), + type = "l", lwd = 3, col = cols[2], ylab = "Abundance (1000s)", xlab = "" +) +lines(popn_results$yr, popn_results$fims.abundance, lwd = 3, col = cols[4]) + +dev.off() + +###################################################################### +png(filename = paste(out.folder, "/SEFSC_scamp_caa_fleet1.", plot.type, sep = ""), width = 8, height = 11, units="in", res=72) +mat <- matrix(1:18, ncol = 3) +layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) +par(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75) + +for (i in 1:nrow(obs.fleet1.caa)) +{ + plot(1:nages, obs.fleet1.caa[i, ], col = cols[1], xlab = "", ylab = "", pch = 16) + lines(1:nages, bam.fleet1.caa[i, ], lwd = 3, col = cols[2]) + lines(1:nages, fims.fleet1.caa[i, ], lwd = 3, col = cols[4]) + if (i > 1) legend("topright", legend = yr.fleet1.ac[i], cex = 1, bty = "n") + if (i == 1) { + legend("topright", + legend = c("Fleet1 Age Comps", "observed", "BAM expected", "FIMS expected"), + pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.7 + ) + legend("right", legend = yr.fleet1.ac[i], cex = 1, bty = "n") + } +} + +dev.off() + +###################################################################### +png(filename = paste(out.folder, "/SEFSC_scamp_caa_fleet2.", plot.type, sep = ""), width = 8, height = 11, units="in", res=72) + +mat <- matrix(1:28, ncol = 4) +layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) +par(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75) + +for (i in 1:nrow(obs.fleet2.caa)) +{ + plot(1:nages, obs.fleet2.caa[i, ], col = cols[1], xlab = "", ylab = "", pch = 16) + lines(1:nages, bam.fleet2.caa[i, ], lwd = 3, col = cols[2]) + lines(1:nages, fims.fleet2.caa[i, ], lwd = 3, col = cols[4]) + if (i > 1) legend("topright", legend = yr.fleet2.ac[i], cex = 1, bty = "n") + if (i == 1) { + legend("topright", + legend = c("Fleet2 Age Comps", "observed", "BAM expected", "FIMS expected"), + pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.5 + ) + legend("right", legend = yr.fleet2.ac[i], cex = 1, bty = "n") + } +} + +dev.off() + +###################################################################### +png(filename = paste(out.folder, "/SEFSC_scamp_caa_survey.", plot.type, sep = ""), width = 8, height = 11, units="in", res=72) + +mat <- matrix(1:30, ncol = 5) +layout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat))) +par(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75) + +for (i in 1:nrow(obs.survey.caa)) +{ + plot(1:nages, obs.survey.caa[i, ], col = cols[1], xlab = "", ylab = "", pch = 16) + lines(1:nages, bam.survey.caa[i, ], lwd = 3, col = cols[2]) + lines(1:nages, fims.survey.caa[i, ], lwd = 3, col = cols[4]) + if (i > 1) legend("topright", legend = yr.survey.ac[i], cex = 1, bty = "n") + if (i == 1) { + legend("topright", + legend = c("Survey Age Comps", "observed", "BAM expected", "FIMS expected"), + pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.5 + ) + legend("right", legend = yr.survey.ac[i], cex = 1, bty = "n") + } +} + +dev.off() + +clear() @@ -1035,7 +1034,7 @@

    List any issues that you ran into or found

    -

    The FIMS feature to assign proportion female at age is not yet functional. FIMS accepts proportion female at age as input, but does not use that input and instead hard-codes a 50:50 sex ratio. Many stocks in the southeast are protogynous hermphrodites, such that individuals start life as females and later convert to males. This life history creates a sex ratio that is tilted toward females for younger ages and males for older ages.

    +

    The FIMS feature to assign proportion female at age is not yet functional and it is hard-coded using a 50:50 sex ratio. Many stocks in the southeast are protogynous hermphrodites, such that individuals start life as females and later convert to males. This life history creates a sex ratio that is tilted toward females for younger ages and males for older ages.

    What features are most important to add based on this case study?

    diff --git a/content/SWFSC-sardine.html b/content/SWFSC-sardine.html index 502d397..5a990d0 100644 --- a/content/SWFSC-sardine.html +++ b/content/SWFSC-sardine.html @@ -2,7 +2,7 @@ - + @@ -309,7 +309,7 @@

  • TMB version: 1.9.14
    • -
  • FIMS commit: 39d0743
    +
  • FIMS commit: 081972c
  • Stock name: Pacific sardine northern subpopulation
    • @@ -352,377 +352,382 @@

    # # library(FIMS) -clear() -rm(list = ls()) - -#-------------------------------------------------------- -#Logistic function for later use -logistic <- function(x, slope, inflection_point){ - out <- 1 / (1 + exp(-1 * slope * (x - inflection_point))) - out <- data.frame(x = x, value = out) - return(out) -} - -#-------------------------------------------------------- -#Manually enter data - -# setwd("C://Users//peter.kuriyama//SynologyDrive/Research//noaa//FIMS") - -#-----Catch -catch <- data.frame(year = 2005:2023, catch = c(29188.50, 53107.00, 69929.40, - 56317.80, 33546.40, 17466.40, 39383.10, 2585.38, 5705.77, 2558.63, 7.18, 428.26, - 347.11, 514.20, 619.04, 653.15, 285.89, 508.02, 152.31)) - -# ggplot(catch, aes(x = year, y = catch)) + geom_point() + -# geom_line() + scale_y_continuous(label = comma) - - -fimscatch <- tibble(type = "landings", name = "fleet1", - age = NA, datestart = paste0(catch$year, "-01-01"), - dateend = paste0(catch$year, "-12-31"), value = catch$catch, - unit = "mt", uncertainty = 0.05) - -#-----CPUE -cpue <- data.frame(year = 2005:2023, obs = c(649619.0, 899635.0, 956354.0, 863281.0, 652029.0, - 504970.0, 395783.0, 293980.0, 182417.0, 89260.1, - 46403.0, 40704.0, 44592.1, 48789.1, 53551.8, - 59765.8, 68451.7, 71612.5, 68957.9)) - - -# ggplot(cpue, aes(x = year, y = obs)) + geom_point() + geom_line() + -# scale_y_continuous(label = comma) - -fimsindex <- tibble(type = "index", name = "survey1", - age = NA, datestart = paste0(cpue$year, "-01-01"), - dateend = paste0(cpue$year, "-12-31"), - value = cpue$obs, unit = 'mt', uncertainty = .3) - -#-----Age compositions -acomps <- read.csv("data_files/sardine_acomps.csv") - -fimsage <- tibble(type = "age", name = acomps$name, - age = acomps$age, datestart = paste0(acomps$Yr, "-01-01"), - dateend = paste0(acomps$Yr, "-12-31"), - value = acomps$value, unit = "", uncertainty = acomps$Nsamp) - - -#fimsage$uncertainty <- 50 Leave as empirical values - -fimscatch$value <- fimscatch$value -fimsindex$unit <- "" - -#Combine everything -fimsdat <- rbind(fimscatch, fimsindex, fimsage) - -fimsdat$age <- as.integer(fimsdat$age) -fimsdat$value <- as.numeric(fimsdat$value) - -years <- 2005:2023 - -ages <- unique(fimsage$age) ##age 0:8 - -# ages <- ss3dat$agebin_vector -nages <- length(ages) -nyears <- length(years) -nseasons <- 1 - -# ages <- 0:ss3dat$Nages # population ages in SS3, starts at age 0 - -nfleets <- 2 #survey and one fishery - -#Which fleet is first input? This corresponds to the output I think - -#------------------------ -#FIMS data input -fimsdat <- as.data.frame(fimsdat) - -age_frame <- FIMS::FIMSFrame(fimsdat) #Cannot be FIMSFrame - -fishery_catch <- FIMS::m_landings(age_frame) -fishery_agecomp <- FIMS::m_agecomp(age_frame, "fleet1") -survey_index <- FIMS::m_index(age_frame, "survey1") -survey_agecomp <- FIMS::m_agecomp(age_frame, "survey1") - -#--------------------------------------- -#Fishing fleet index -fish_index <- methods::new(Index, nyears) -fish_age_comp <- methods::new(AgeComp, nyears, nages) -fish_index$index_data <- fishery_catch - - - -# Q: I'm confused about FIMSFrame being set up with age comps in proportions -# vs here needing age comps in numbers -# A: It's just not sorted out in FIMS yet, in the future this could be made simpler -fish_age_comp$age_comp_data <- age_frame@data |> - dplyr::filter(type == "age" & name == "fleet1") |> - dplyr::mutate(n = value * uncertainty) |> - dplyr::pull(n) |> - round(1) - -n_missing_data <- nyears * nages - length(fish_age_comp$age_comp_data) - - -#Check dimensions of age composition data -# matrix(fish_age_comp$age_comp_data, nyears, nages) - - -fish_age_comp$age_comp_data <- c(rep(-999, n_missing_data), - fish_age_comp$age_comp_data) - - -# switches to turn on or off estimation -estimate_fish_selex <- FALSE -estimate_survey_selex <- FALSE -estimate_q <- FALSE #Fix at 1 -estimate_F <- TRUE -estimate_recdevs <- TRUE -estimate_init_naa <- TRUE -estimate_log_rzero <- TRUE - -#--------------------------------------- -#Fishery module -#--------------------------------------- -#Just one combined MexCal fleet - -### set up fishery -## methods::show(DoubleLogisticSelectivity) -fish_selex <- methods::new(LogisticSelectivity) - -#Use parameters close to those estimated in SS model -fish_selex$inflection_point$value <- 1 #Fishery selectivity -fish_selex$inflection_point$is_random_effect <- FALSE -fish_selex$inflection_point$estimated <- estimate_fish_selex #Estimation on - -fish_selex$slope$value <- 5 -fish_selex$slope$is_random_effect <- FALSE -fish_selex$slope$estimated <- estimate_fish_selex #Estimation on -# - -## create fleet object for fishing -fish_fleet <- methods::new(Fleet) -fish_fleet$nages <- nages -fish_fleet$nyears <- nyears -fish_fleet$log_Fmort <- log(rep(0.2, nyears)) - - -fish_fleet$estimate_F <- estimate_F -fish_fleet$random_F <- FALSE -fish_fleet$log_q <- 0 #Not sure if this will be right -fish_fleet$estimate_q <- estimate_q -fish_fleet$random_q <- FALSE - - -fish_fleet$log_obs_error <- rep(log(sqrt(log(0.01^2 + 1))), nyears) - - -# The pos argument can specify the environment in which to assign the object in -#any of several ways: as -1 (the default), as a positive integer -#(the position in the search list); as the character string name of an element -#in the search list; or as an environment (including using sys.frame to access -#the currently active function calls). - -# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above -fish_fleet$SetAgeCompLikelihood(1) -fish_fleet$SetIndexLikelihood(1) -fish_fleet$SetObservedIndexData(fish_index$get_id()) -fish_fleet$SetObservedAgeCompData(fish_age_comp$get_id()) -fish_fleet$SetSelectivity(fish_selex$get_id()) - -##---- Setup survey -survey_fleet_index <- methods::new(Index, nyears) -survey_age_comp <- methods::new(AgeComp, nyears, nages) -survey_fleet_index$index_data <- survey_index - -survey_age_comp$age_comp_data <- age_frame@data |> - dplyr::filter(type == "age" & name == "survey1") |> - dplyr::mutate(n = value * uncertainty) |> - dplyr::pull(n) -n_missing_data <- nyears * nages - length(survey_age_comp$age_comp_data) -survey_age_comp$age_comp_data <- c(rep(-999, n_missing_data), survey_age_comp$age_comp_data) - - -## survey selectivity: ascending logistic -## methods::show(DoubleLogisticSelectivity) -survey_selex <- new(LogisticSelectivity) -survey_selex$inflection_point$value <- 1.2 -survey_selex$inflection_point$is_random_effect <- FALSE -survey_selex$inflection_point$estimated <- estimate_survey_selex -survey_selex$slope$value <- 2 -survey_selex$slope$is_random_effect <- FALSE -survey_selex$slope$estimated <- estimate_survey_selex - - -## create fleet object for survey -survey_fleet <- methods::new(Fleet) -survey_fleet$is_survey <- TRUE -survey_fleet$nages <- nages -survey_fleet$nyears <- nyears -survey_fleet$estimate_F <- FALSE -survey_fleet$random_F <- FALSE -survey_fleet$log_q <- 0 # catchability fixed ~1.0 = exp(0) -survey_fleet$estimate_q <- estimate_q -survey_fleet$random_q <- FALSE -# Q: why can't the index uncertainty come from FIMSFrame? -survey_fleet$log_obs_error <- rep(log(sqrt(log(0.1^2 + 1))), nyears) - -survey_fleet$SetAgeCompLikelihood(1) -survey_fleet$SetIndexLikelihood(1) -survey_fleet$SetSelectivity(survey_selex$get_id()) -survey_fleet$SetObservedIndexData(survey_fleet_index$get_id()) -survey_fleet$SetObservedAgeCompData(survey_age_comp$get_id()) - -# Population module - -# recruitment -recruitment <- methods::new(BevertonHoltRecruitment) -# methods::show(BevertonHoltRecruitment) - -#sardine sigmaR = 1.2 -recruitment$log_sigma_recruit$value <- log(1.2) #14.2 is log(R0) in sardine simplified model -recruitment$log_sigma_recruit$estimated <- FALSE - - -#14.2 is log(R0) in sardine simplified model -recruitment$log_rzero$value <- 17 -recruitment$log_rzero$is_random_effect <- FALSE -recruitment$log_rzero$estimated <- TRUE -# sardine steepness is fixed at 0.6 -steep <- .6 -recruitment$logit_steep$value <- -log(1.0 - steep) + log(steep - 0.2) -recruitment$logit_steep$is_random_effect <- FALSE -recruitment$logit_steep$estimated <- FALSE - -recruitment$estimate_log_devs <- estimate_recdevs -# Q: why are parameters "log_devs" when output is "report$log_recruit_dev"? -# and are they multipliers, not deviations from zero? -# needed to change from 1 to 0 to get stable population -recruitment$log_devs <- rep(log(1), nyears) # set to no deviations (multiplier) to start - -# growth -wtatage <- r4ss::SS_readwtatage("data_files/sardine_wtatage.ss_new") - -ewaa_growth <- methods::new(EWAAgrowth) -ewaa_growth$ages <- ages -# NOTE: getting weight-at-age vector from -# petrale_output$wtatage |> -# dplyr::filter(Sex == 1 & Fleet == -1 & Yr == 1876) |> -# dplyr::select(paste(0:40)) |> -# round(4) -# ewaa_growth$weights <- c(0.019490,0.077760,0.108865, -# 0.133855,0.154360,0.174905,0.184200, -# 0.196460,0.214155) - - -ewaa_growth$weights <- wtatage %>% filter(Fleet == 1, Yr == 2010) %>% select(as.character(0:10)) %>% t %>% - as.vector - -# maturity -maturity <- new(LogisticMaturity) -# approximate age-based equivalent to length-based maturity in petrale model -# based on looking at model$endgrowth |> dplyr::filter(Sex == 1) |> dplyr::select(Age_Beg, Len_Mat) -maturity$inflection_point$value <- 1.2 -maturity$inflection_point$is_random_effect <- FALSE -maturity$inflection_point$estimated <- FALSE -maturity$slope$value <- 1.5 # arbitrary guess -maturity$slope$is_random_effect <- FALSE -maturity$slope$estimated <- FALSE - -#Look at maturity curve -# logistic(0:8, slope = maturity$slope$value, -# inflection_point = maturity$inflection_point$value) %>% ggplot(aes(x = x, y = value)) + -# geom_point() + geom_line() + scale_y_continuous(limits = c(0, 1)) - - -# population -population <- new(Population) -# petrale natural mortality is estimated around 0.14 -M_value <- .8 #.8 worked pretty well -population$log_M <- rep(log(M_value), nages * nyears) - -population$estimate_M <- FALSE ###Anyway to control dimension of M estimation? - - -# initial numbers at age based on R0 + mortality -init_naa <- exp(recruitment$log_rzero$value) * exp(-(ages - 1) * M_value) -init_naa[nages] <- init_naa[nages] / M_value # sum of infinite series -population$log_init_naa <- log(init_naa) -population$estimate_init_naa <- estimate_init_naa - -population$nages <- nages -population$ages <- ages -population$nfleets <- 2 # fleets plus surveys -population$nseasons <- nseasons -population$nyears <- nyears -# population$proportion_female <- rep(0.5, nages) - -population$SetMaturity(maturity$get_id()) -population$SetGrowth(ewaa_growth$get_id()) -population$SetRecruitment(recruitment$get_id()) - -# make FIMS model -success <- CreateTMBModel() -parameters <- list(p = get_fixed()) - -###expand years and ages -# crossing(years, ages) %>% mutate(ya = paste(years, ages)) %>% pull(ya) - -#--------------------------------------------------------------------------- -#Clunky code to name parameter starting values/estimates to - -#Specification of estimation is estimated and estimate_F/estimate_M -parname <- 999 - -if(fish_selex$inflection_point$estimated) parname <- c(parname, - "fishery_selex_inf_poit") -if(fish_selex$slope$estimated) parname <- c(parname, "fishery_selec_slo") - - -if(fish_fleet$estimate_F) parname <- c(parname, paste0("F_", years)) -# if(fish_fleet$estimate_q) - -if(survey_selex$inflection_point$estimated) parname <- c(parname, "survey_inf_poi") -if(survey_selex$slope$estimated) parname <- c(parname, "survey_inf_slo" ) - -if(recruitment$log_sigma_recruit$estimated) parname <- c(parname, "ln_sig_rec") -if(recruitment$log_rzero$estimated) parname <- c(parname, "ln_rzero") -if(recruitment$logit_steep$estimated) parname <- c(parname, "logi_h") - -if(recruitment$estimate_log_devs) parname <- c(parname, paste0("recdev_", years)) - -if(maturity$inflection_point$estimated) parname <- c(parname, "mat_inf_poi") -if(maturity$slope$estimated) parname <- c(parname, "mat_slo") - -if(population$estimate_M) parname <- c(parname, paste0("M_", - crossing(years, ages) %>% - mutate(ya = paste(years, ages)) %>% pull(ya))) -if(population$estimate_init_naa) parname <- c(parname, paste0("naa_", ages)) - -parname <- parname[-1] - - -#--------------------------------------------------------------------------- -#Run model -#--------------------------------------------------------------------------- - -pars <- tibble(parname = parname, startingvals = parameters$p) - - -obj <- MakeADFun(data = list(), parameters, DLL = "FIMS", silent = TRUE) -report <- obj$report(obj$env$last.par.best) - -#Are there flags for when something is going wrong with the model where initial values -#are all 0? -opt <- nlminb(obj$par, obj$fn, obj$gr, - control = list(eval.max = 10000, iter.max = 10000) -) - -sds <- TMB::sdreport(obj) - -endres <- obj$report(obj$env$last.par.best) - -pars <- pars %>% mutate(endvals = sds$par.fixed) %>% - as.data.frame +clear() + +
    +
    NULL
    +
    +
    +Code +
    rm(list = ls())
+
+#--------------------------------------------------------
+#Logistic function for later use
+logistic <- function(x, slope, inflection_point){
+  out <- 1 / (1 + exp(-1 * slope * (x - inflection_point)))
+  out <- data.frame(x = x, value = out)
+  return(out)
+}
+
+#--------------------------------------------------------
+#Manually enter data
+
+# setwd("C://Users//peter.kuriyama//SynologyDrive/Research//noaa//FIMS")
+
+#-----Catch
+catch <- data.frame(year = 2005:2023, catch = c(29188.50, 53107.00, 69929.40, 
+                                                56317.80, 33546.40, 17466.40, 39383.10, 2585.38, 5705.77, 2558.63, 7.18, 428.26, 
+                                                347.11, 514.20, 619.04, 653.15, 285.89, 508.02, 152.31))
+
+# ggplot(catch, aes(x = year, y = catch)) + geom_point() + 
+#   geom_line() + scale_y_continuous(label = comma)
+
+
+fimscatch <- tibble(type = "landings", name = "fleet1",
+                    age = NA, datestart = paste0(catch$year, "-01-01"),
+                    dateend = paste0(catch$year, "-12-31"), value = catch$catch,
+                    unit = "mt", uncertainty = 0.05)
+
+#-----CPUE
+cpue <- data.frame(year = 2005:2023, obs = c(649619.0, 899635.0, 956354.0, 863281.0, 652029.0, 
+                                             504970.0, 395783.0, 293980.0, 182417.0, 89260.1, 
+                                             46403.0, 40704.0, 44592.1, 48789.1, 53551.8, 
+                                             59765.8, 68451.7, 71612.5, 68957.9))
+
+
+# ggplot(cpue, aes(x = year, y = obs)) + geom_point() + geom_line() + 
+#   scale_y_continuous(label = comma)
+
+fimsindex <- tibble(type = "index", name = "survey1",
+                    age = NA, datestart = paste0(cpue$year, "-01-01"),
+                    dateend = paste0(cpue$year, "-12-31"),
+                    value = cpue$obs, unit = 'mt', uncertainty = .3)
+
+#-----Age compositions
+acomps <- read.csv("data_files/sardine_acomps.csv")
+
+fimsage <- tibble(type = "age", name = acomps$name,
+                  age = acomps$age, datestart = paste0(acomps$Yr, "-01-01"),
+                  dateend = paste0(acomps$Yr, "-12-31"),
+                  value = acomps$value, unit = "", uncertainty = acomps$Nsamp)
+
+
+#fimsage$uncertainty <- 50 Leave as empirical values
+
+fimscatch$value <- fimscatch$value
+fimsindex$unit <- ""
+
+#Combine everything
+fimsdat <- rbind(fimscatch, fimsindex, fimsage)
+
+fimsdat$age <- as.integer(fimsdat$age) 
+fimsdat$value <- as.numeric(fimsdat$value)
+
+years <- 2005:2023
+
+ages <- unique(fimsage$age) ##age 0:8
+
+# ages <- ss3dat$agebin_vector
+nages <- length(ages)
+nyears <- length(years)
+nseasons <- 1
+
+# ages <- 0:ss3dat$Nages # population ages in SS3, starts at age 0
+
+nfleets <- 2 #survey and one fishery
+
+#Which fleet is first input? This corresponds to the output I think
+
+#------------------------
+#FIMS data input
+fimsdat <- as.data.frame(fimsdat)
+
+age_frame <- FIMS::FIMSFrame(fimsdat) #Cannot be FIMSFrame
+
+fishery_catch <- FIMS::m_landings(age_frame)
+fishery_agecomp <- FIMS::m_agecomp(age_frame, "fleet1")
+survey_index <- FIMS::m_index(age_frame, "survey1")
+survey_agecomp <- FIMS::m_agecomp(age_frame, "survey1")
+
+#---------------------------------------
+#Fishing fleet index
+fish_index <- methods::new(Index, nyears)
+fish_age_comp <- methods::new(AgeComp, nyears, nages)
+fish_index$index_data <- fishery_catch
+
+
+
+# Q: I'm confused about FIMSFrame being set up with age comps in proportions
+#   vs here needing age comps in numbers
+# A: It's just not sorted out in FIMS yet, in the future this could be made simpler
+fish_age_comp$age_comp_data <- age_frame@data |>
+  dplyr::filter(type == "age" & name == "fleet1") |>
+  dplyr::mutate(n = value * uncertainty) |>
+  dplyr::pull(n) |>
+  round(1)
+
+n_missing_data <- nyears * nages - length(fish_age_comp$age_comp_data) 
+
+
+#Check dimensions of age composition data
+# matrix(fish_age_comp$age_comp_data, nyears, nages)
+
+
+fish_age_comp$age_comp_data <- c(rep(-999, n_missing_data), 
+                                 fish_age_comp$age_comp_data)
+
+
+# switches to turn on or off estimation
+estimate_fish_selex <- FALSE
+estimate_survey_selex <- FALSE
+estimate_q <- FALSE #Fix at 1
+estimate_F <- TRUE
+estimate_recdevs <- TRUE
+estimate_init_naa <- TRUE 
+estimate_log_rzero <- TRUE
+
+#---------------------------------------
+#Fishery module
+#---------------------------------------
+#Just one combined MexCal fleet
+
+### set up fishery
+## methods::show(DoubleLogisticSelectivity)
+fish_selex <- methods::new(LogisticSelectivity)
+
+#Use parameters close to those estimated in SS model  
+fish_selex$inflection_point$value <- 1 #Fishery selectivity
+fish_selex$inflection_point$is_random_effect <- FALSE
+fish_selex$inflection_point$estimated <- estimate_fish_selex #Estimation on
+
+fish_selex$slope$value <- 5
+fish_selex$slope$is_random_effect <- FALSE
+fish_selex$slope$estimated <- estimate_fish_selex #Estimation on
+#
+
+## create fleet object for fishing 
+fish_fleet <- methods::new(Fleet)
+fish_fleet$nages <- nages
+fish_fleet$nyears <- nyears
+fish_fleet$log_Fmort <- log(rep(0.2, nyears))
+
+
+fish_fleet$estimate_F <- estimate_F
+fish_fleet$random_F <- FALSE
+fish_fleet$log_q <- 0 #Not sure if this will be right
+fish_fleet$estimate_q <- estimate_q
+fish_fleet$random_q <- FALSE
+
+
+fish_fleet$log_obs_error <- rep(log(sqrt(log(0.01^2 + 1))), nyears)
+
+
+# The pos argument can specify the environment in which to assign the object in 
+#any of several ways: as -1 (the default), as a positive integer 
+#(the position in the search list); as the character string name of an element 
+#in the search list; or as an environment (including using sys.frame to access 
+#the currently active function calls).
+
+# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above
+fish_fleet$SetAgeCompLikelihood(1)
+fish_fleet$SetIndexLikelihood(1)
+fish_fleet$SetObservedIndexData(fish_index$get_id()) 
+fish_fleet$SetObservedAgeCompData(fish_age_comp$get_id())
+fish_fleet$SetSelectivity(fish_selex$get_id())
+
+##---- Setup survey
+survey_fleet_index <- methods::new(Index, nyears)
+survey_age_comp <- methods::new(AgeComp, nyears, nages)
+survey_fleet_index$index_data <- survey_index
+
+survey_age_comp$age_comp_data <- age_frame@data |>
+  dplyr::filter(type == "age" & name == "survey1") |>
+  dplyr::mutate(n = value * uncertainty) |>
+  dplyr::pull(n)
+n_missing_data <- nyears * nages - length(survey_age_comp$age_comp_data) 
+survey_age_comp$age_comp_data <- c(rep(-999, n_missing_data), survey_age_comp$age_comp_data)
+
+
+## survey selectivity: ascending logistic
+## methods::show(DoubleLogisticSelectivity)
+survey_selex <- new(LogisticSelectivity)
+survey_selex$inflection_point$value <- 1.2
+survey_selex$inflection_point$is_random_effect <- FALSE
+survey_selex$inflection_point$estimated <- estimate_survey_selex
+survey_selex$slope$value <- 2
+survey_selex$slope$is_random_effect <- FALSE
+survey_selex$slope$estimated <- estimate_survey_selex
+
+
+## create fleet object for survey
+survey_fleet <- methods::new(Fleet)
+survey_fleet$is_survey <- TRUE
+survey_fleet$nages <- nages
+survey_fleet$nyears <- nyears
+survey_fleet$estimate_F <- FALSE
+survey_fleet$random_F <- FALSE
+survey_fleet$log_q <- 0 # catchability fixed ~1.0 = exp(0)
+survey_fleet$estimate_q <- estimate_q
+survey_fleet$random_q <- FALSE
+# Q: why can't the index uncertainty come from FIMSFrame?
+survey_fleet$log_obs_error <- rep(log(sqrt(log(0.1^2 + 1))), nyears)
+
+survey_fleet$SetAgeCompLikelihood(1)
+survey_fleet$SetIndexLikelihood(1)
+survey_fleet$SetSelectivity(survey_selex$get_id())
+survey_fleet$SetObservedIndexData(survey_fleet_index$get_id())
+survey_fleet$SetObservedAgeCompData(survey_age_comp$get_id())
+
+# Population module
+
+# recruitment
+recruitment <- methods::new(BevertonHoltRecruitment)
+# methods::show(BevertonHoltRecruitment)
+
+#sardine sigmaR = 1.2
+recruitment$log_sigma_recruit$value <- log(1.2) #14.2 is log(R0) in sardine simplified model
+recruitment$log_sigma_recruit$estimated <- FALSE
+
+
+#14.2 is log(R0) in sardine simplified model
+recruitment$log_rzero$value <- 17
+recruitment$log_rzero$is_random_effect <- FALSE
+recruitment$log_rzero$estimated <- TRUE
+# sardine steepness is fixed at 0.6
+steep <- .6
+recruitment$logit_steep$value <- -log(1.0 - steep) + log(steep - 0.2)
+recruitment$logit_steep$is_random_effect <- FALSE
+recruitment$logit_steep$estimated <- FALSE
+
+recruitment$estimate_log_devs <- estimate_recdevs
+# Q: why are parameters "log_devs" when output is "report$log_recruit_dev"?
+# and are they multipliers, not deviations from zero?
+# needed to change from 1 to 0 to get stable population
+recruitment$log_devs <- rep(log(1), nyears) # set to no deviations (multiplier) to start
+
+# growth
+wtatage <- r4ss::SS_readwtatage("data_files/sardine_wtatage.ss_new")
+
+ewaa_growth <- methods::new(EWAAgrowth)
+ewaa_growth$ages <- ages
+# NOTE: getting weight-at-age vector from
+# petrale_output$wtatage |>
+#   dplyr::filter(Sex == 1 & Fleet == -1 & Yr == 1876) |>
+#   dplyr::select(paste(0:40)) |>
+#   round(4)
+# ewaa_growth$weights <- c(0.019490,0.077760,0.108865,
+#                          0.133855,0.154360,0.174905,0.184200,
+#                          0.196460,0.214155)
+
+
+ewaa_growth$weights <- wtatage %>% filter(Fleet == 1, Yr == 2010) %>% select(as.character(0:10))  %>% t %>%
+  as.vector
+
+# maturity
+maturity <- new(LogisticMaturity)
+# approximate age-based equivalent to length-based maturity in petrale model
+# based on looking at model$endgrowth |> dplyr::filter(Sex == 1) |> dplyr::select(Age_Beg, Len_Mat)
+maturity$inflection_point$value <- 1.2
+maturity$inflection_point$is_random_effect <- FALSE
+maturity$inflection_point$estimated <- FALSE
+maturity$slope$value <- 1.5 # arbitrary guess
+maturity$slope$is_random_effect <- FALSE
+maturity$slope$estimated <- FALSE
+
+#Look at maturity curve
+# logistic(0:8, slope = maturity$slope$value,
+#          inflection_point = maturity$inflection_point$value) %>% ggplot(aes(x = x, y = value)) +
+#   geom_point() + geom_line() + scale_y_continuous(limits = c(0, 1))
+
+
+# population
+population <- new(Population)
+# petrale natural mortality is estimated around 0.14
+M_value <- .8 #.8 worked pretty well
+population$log_M <- rep(log(M_value), nages * nyears)
+
+population$estimate_M <- FALSE ###Anyway to control dimension of M estimation?
+
+
+# initial numbers at age based on R0 + mortality
+init_naa <- exp(recruitment$log_rzero$value) * exp(-(ages - 1) * M_value)
+init_naa[nages] <- init_naa[nages] / M_value # sum of infinite series
+population$log_init_naa <- log(init_naa)
+population$estimate_init_naa <- estimate_init_naa
+
+population$nages <- nages
+population$ages <- ages
+population$nfleets <- 2 # fleets plus surveys
+population$nseasons <- nseasons
+population$nyears <- nyears
+
+population$SetMaturity(maturity$get_id())
+population$SetGrowth(ewaa_growth$get_id())
+population$SetRecruitment(recruitment$get_id())
+
+# make FIMS model
+success <- CreateTMBModel()
+parameters <- list(p = get_fixed())
+
+###expand years and ages
+# crossing(years, ages) %>% mutate(ya = paste(years, ages)) %>% pull(ya)
+
+#---------------------------------------------------------------------------
+#Clunky code to name parameter starting values/estimates to 
+
+#Specification of estimation is estimated and estimate_F/estimate_M
+parname <- 999
+
+if(fish_selex$inflection_point$estimated) parname <- c(parname,
+                                                       "fishery_selex_inf_poit")
+if(fish_selex$slope$estimated) parname <- c(parname, "fishery_selec_slo")
+
+
+if(fish_fleet$estimate_F) parname <- c(parname, paste0("F_", years))
+# if(fish_fleet$estimate_q)
+    
+if(survey_selex$inflection_point$estimated) parname <- c(parname, "survey_inf_poi")
+if(survey_selex$slope$estimated) parname <- c(parname, "survey_inf_slo" )
+
+if(recruitment$log_sigma_recruit$estimated) parname <- c(parname, "ln_sig_rec")
+if(recruitment$log_rzero$estimated) parname <- c(parname, "ln_rzero")
+if(recruitment$logit_steep$estimated) parname <- c(parname, "logi_h")
+
+if(recruitment$estimate_log_devs) parname <- c(parname, paste0("recdev_", years))
+  
+if(maturity$inflection_point$estimated) parname <- c(parname, "mat_inf_poi")
+if(maturity$slope$estimated) parname <- c(parname, "mat_slo")
+
+if(population$estimate_M) parname <- c(parname, paste0("M_", 
+                                                       crossing(years, ages) %>% 
+                                                         mutate(ya = paste(years, ages)) %>% pull(ya)))
+if(population$estimate_init_naa) parname <- c(parname, paste0("naa_", ages))
+
+parname <- parname[-1]
+
+
+#---------------------------------------------------------------------------
+#Run model
+#---------------------------------------------------------------------------
+
+pars <- tibble(parname = parname, startingvals = parameters$p)
+
+
+obj <- MakeADFun(data = list(), parameters, DLL = "FIMS", silent = TRUE)
+report <- obj$report(obj$env$last.par.best)
+
+#Are there flags for when something is going wrong with the model where initial values
+#are all 0?
+opt <- nlminb(obj$par, obj$fn, obj$gr,
+              control = list(eval.max = 10000, iter.max = 10000)
+)
+
+sds <- TMB::sdreport(obj)
+
+endres <- obj$report(obj$env$last.par.best)
+
+pars <- pars %>% mutate(endvals = sds$par.fixed) %>%
+  as.data.frame

    @@ -731,18 +736,18 @@

    Add your compa
    Code -
    load("data_files/sardine_simplified_res.Rdata")
-
-#------------------------------------------------------------------------
-#------SSB
-ssbs <- ssres$timeseries %>% select(Yr, SpawnBio) %>% 
-  mutate(fims = c(0, 0,  endres$ssb[[1]]))
-names(ssbs)[2] <- 'ss3'
-
-ssbs %>% filter(Yr >= 2005, Yr < 2024) %>% melt(id.var = "Yr") %>%
-  ggplot(aes(x = Yr, y = value, group = variable, color = variable)) +
-  geom_point() + geom_line() + ylab("Spawning biomass (mt)") + theme_bw() +
-  xlab("year") + theme(legend.position = c(.9, .9))
    +
    load("data_files/sardine_simplified_res.Rdata")
+
+#------------------------------------------------------------------------
+#------SSB
+ssbs <- ssres$timeseries %>% select(Yr, SpawnBio) %>% 
+  mutate(fims = c(0, 0,  endres$ssb[[1]]))
+names(ssbs)[2] <- 'ss3'
+
+ssbs %>% filter(Yr >= 2005, Yr < 2024) %>% melt(id.var = "Yr") %>%
+  ggplot(aes(x = Yr, y = value, group = variable, color = variable)) +
+  geom_point() + geom_line() + ylab("Spawning biomass (mt)") + theme_bw() +
+  xlab("year") + theme(legend.position = c(.9, .9))
    Warning: A numeric `legend.position` argument in `theme()` was deprecated in ggplot2
@@ -758,18 +763,18 @@ 
    Add your compa
    Code -
    ggsave("figures/SWFSC-sardine-sb.png", width = 7.35, height = 4.8)
-
-#------------------------------------------------------------------------
-#------Index fits
-index <- ssres$cpue %>% select(Yr, Obs, Exp) 
-names(index) <- c("year", 'obs', 'ss3')
-index$fims <- endres$exp_index[[2]]
-index %>% melt(id.var = c("year", "obs")) %>%
-  ggplot(aes(x = year)) + geom_point(aes(y = obs)) + 
-  geom_line(aes(y = value, color = variable, group = variable)) +
-  theme_bw() + theme(legend.position = c(.9, .9)) + xlab("Year") +
-  ylab("Survey biomass value (mt)")
    +
    ggsave("figures/SWFSC-sardine-sb.png", width = 7.35, height = 4.8)
+
+#------------------------------------------------------------------------
+#------Index fits
+index <- ssres$cpue %>% select(Yr, Obs, Exp) 
+names(index) <- c("year", 'obs', 'ss3')
+index$fims <- endres$exp_index[[2]]
+index %>% melt(id.var = c("year", "obs")) %>%
+  ggplot(aes(x = year)) + geom_point(aes(y = obs)) + 
+  geom_line(aes(y = value, color = variable, group = variable)) +
+  theme_bw() + theme(legend.position = c(.9, .9)) + xlab("Year") +
+  ylab("Survey biomass value (mt)")
    @@ -780,47 +785,47 @@

    Add your compa

    Code -
    ggsave("figures/SWFSC-sardine-surveyfit.png", width = 6.8, height = 5.25)
-
-#------------------------------------------------------------------------
-#-----Calculate age-1+ biomass
-#Multiply numbers at age by weight at age and sum
-naa <- endres$naa[[1]]
-
-naa1 <- crossing(c(years, 2024), ages) %>% mutate(naa = naa) %>% as.data.frame
-names(naa1) <- c("year", 'age', 'value')
-naa1$cohort <- naa1$year - naa1$age
-
-#Format Weight at age
-waa <- data.frame(age = ewaa_growth$ages, waa = ewaa_growth$weights[1:length(ages)])
-
-naa1 <- naa1 %>% dplyr::left_join(waa)
    +
    ggsave("figures/SWFSC-sardine-surveyfit.png", width = 6.8, height = 5.25)
+
+#------------------------------------------------------------------------
+#-----Calculate age-1+ biomass
+#Multiply numbers at age by weight at age and sum
+naa <- endres$naa[[1]]
+
+naa1 <- crossing(c(years, 2024), ages) %>% mutate(naa = naa) %>% as.data.frame
+names(naa1) <- c("year", 'age', 'value')
+naa1$cohort <- naa1$year - naa1$age
+
+#Format Weight at age
+waa <- data.frame(age = ewaa_growth$ages, waa = ewaa_growth$weights[1:length(ages)])
+
+naa1 <- naa1 %>% dplyr::left_join(waa)
    Joining with `by = join_by(age)`
    Code -
    naa1 <- naa1 %>% mutate(weight = value * waa)
-age1plus <- naa1 %>% filter(age != 0) %>% group_by(year) %>% summarize(summbio = sum(weight))
-
-bio1 <- ssres$timeseries %>% filter(Seas == 1) %>% select(Yr, Bio_smry) %>%
-  mutate(year = Yr, ss3bio = Bio_smry) %>% select(-Yr, -Bio_smry)
-
-
-age1plus <- age1plus %>% dplyr::left_join(bio1)
    +
    naa1 <- naa1 %>% mutate(weight = value * waa)
+age1plus <- naa1 %>% filter(age != 0) %>% group_by(year) %>% summarize(summbio = sum(weight))
+
+bio1 <- ssres$timeseries %>% filter(Seas == 1) %>% select(Yr, Bio_smry) %>%
+  mutate(year = Yr, ss3bio = Bio_smry) %>% select(-Yr, -Bio_smry)
+
+
+age1plus <- age1plus %>% dplyr::left_join(bio1)
    Joining with `by = join_by(year)`
    Code -
    names(age1plus) <- c("year", "fims", "ss3")
-
-#Full time series of age-1+ biomass
-age1plus %>% melt(id.var = "year") %>% ggplot(aes(x = year, y = value, group = variable, color = variable)) +
-  geom_point() + geom_line() + 
-  ylab("Age-1+ biomass (mt)") + theme_bw() + theme(legend.position = c(.9, .9))
    +
    names(age1plus) <- c("year", "fims", "ss3")
+
+#Full time series of age-1+ biomass
+age1plus %>% melt(id.var = "year") %>% ggplot(aes(x = year, y = value, group = variable, color = variable)) +
+  geom_point() + geom_line() + 
+  ylab("Age-1+ biomass (mt)") + theme_bw() + theme(legend.position = c(.9, .9))
    @@ -831,13 +836,13 @@

    Add your compa

    Code -
    ggsave("figures/SWFSC-sardine-age1plusbio.png", width = 6.8, height = 5.25)
-
-#Zoomed in time series of age-1+
-age1plus %>% melt(id.var = "year") %>% filter(year >= 2010) %>%
-  ggplot(aes(x = year, y = value, group = variable, color = variable)) +
-  geom_point() + geom_line() + theme_bw() +
-  ylab("Age-1+ biomass (mt)") + theme(legend.position = c(.9, .9))
    +
    ggsave("figures/SWFSC-sardine-age1plusbio.png", width = 6.8, height = 5.25)
+
+#Zoomed in time series of age-1+
+age1plus %>% melt(id.var = "year") %>% filter(year >= 2010) %>%
+  ggplot(aes(x = year, y = value, group = variable, color = variable)) +
+  geom_point() + geom_line() + theme_bw() +
+  ylab("Age-1+ biomass (mt)") + theme(legend.position = c(.9, .9))
    @@ -848,19 +853,19 @@

    Add your compa

    Code -
    ggsave("figures/SWFSC-sardine-age1plusbio_zoomedin.png", width = 6.8, height = 5.25)
-
-
-#------------------------------------------------------------------------
-#------Recruitment
-recs <- ssres$timeseries %>% select(Yr, Recruit_0) %>%
-  mutate(fims = c(0, 0, endres$recruitment[[1]]))
-names(recs)[2] <- "ss3"
-
-recs %>% filter(Yr >= 2005, Yr < 2024) %>% melt(id.var = "Yr") %>%
-
-  ggplot(aes(x = Yr, y = value, group = variable, color = variable)) + theme_bw() +
-  geom_point() + geom_line() + theme(legend.position = c(.9, .9)) + ylab("Recruits (x1000)")
    +
    ggsave("figures/SWFSC-sardine-age1plusbio_zoomedin.png", width = 6.8, height = 5.25)
+
+
+#------------------------------------------------------------------------
+#------Recruitment
+recs <- ssres$timeseries %>% select(Yr, Recruit_0) %>%
+  mutate(fims = c(0, 0, endres$recruitment[[1]]))
+names(recs)[2] <- "ss3"
+
+recs %>% filter(Yr >= 2005, Yr < 2024) %>% melt(id.var = "Yr") %>%
+
+  ggplot(aes(x = Yr, y = value, group = variable, color = variable)) + theme_bw() +
+  geom_point() + geom_line() + theme(legend.position = c(.9, .9)) + ylab("Recruits (x1000)")
    @@ -871,23 +876,23 @@

    Add your compa

    Code -
    ggsave("figures/SWFSC-sardine-recruitment.png", width = 6.8, height = 5.25)
-
-
-#------------------------------------------------------------------------
-#------Fixed selectivities
-#Are fixed but plot for comparison's sake
-##Fishery
-
-sel_fishery <- logistic(ages, slope = fish_selex$slope$value, 
-                        inflection_point = fish_selex$inflection_point$value)
-
-names(sel_fishery) <- c("age", "fims")
-
-sel_fishery$ss3 <- ssres$ageselex %>% filter(Yr == 2005, 
-                                             Factor == "Asel", Fleet == 1) %>%
-  select(as.character(0:8)) %>% t
-sel_fishery <- sel_fishery %>% melt(id.var = "age")
    +
    ggsave("figures/SWFSC-sardine-recruitment.png", width = 6.8, height = 5.25)
+
+
+#------------------------------------------------------------------------
+#------Fixed selectivities
+#Are fixed but plot for comparison's sake
+##Fishery
+
+sel_fishery <- logistic(ages, slope = fish_selex$slope$value, 
+                        inflection_point = fish_selex$inflection_point$value)
+
+names(sel_fishery) <- c("age", "fims")
+
+sel_fishery$ss3 <- ssres$ageselex %>% filter(Yr == 2005, 
+                                             Factor == "Asel", Fleet == 1) %>%
+  select(as.character(0:8)) %>% t
+sel_fishery <- sel_fishery %>% melt(id.var = "age")
    Warning: attributes are not identical across measure variables; they will be
@@ -895,8 +900,8 @@ 
    Add your compa
    Code -
    ggplot(sel_fishery, aes(x = age, y = value, group = variable, color = variable)) + 
-  geom_point() + geom_line()
    +
    ggplot(sel_fishery, aes(x = age, y = value, group = variable, color = variable)) + 
+  geom_point() + geom_line()
    @@ -907,15 +912,15 @@

    Add your compa

    Code -
    #-----------Survey
-sel_survey <- logistic(ages, slope = survey_selex$slope$value, 
-                       inflection_point = survey_selex$inflection_point$value)
-
-names(sel_survey) <- c("age", 'fims')
-
-sel_survey$ss3 <- ssres$ageselex %>% filter(Yr == 2005, Factor == "Asel", Fleet == 2) %>%
-  select(as.character(0:8)) %>% t
-sel_survey <- sel_survey %>% melt(id.var = "age")
    +
    #-----------Survey
+sel_survey <- logistic(ages, slope = survey_selex$slope$value, 
+                       inflection_point = survey_selex$inflection_point$value)
+
+names(sel_survey) <- c("age", 'fims')
+
+sel_survey$ss3 <- ssres$ageselex %>% filter(Yr == 2005, Factor == "Asel", Fleet == 2) %>%
+  select(as.character(0:8)) %>% t
+sel_survey <- sel_survey %>% melt(id.var = "age")
    Warning: attributes are not identical across measure variables; they will be
@@ -923,8 +928,8 @@ 
    Add your compa
    Code -
    ggplot(sel_survey, aes(x = age, y = value, group = variable, color = variable)) + 
-  geom_point() + geom_line()
    +
    ggplot(sel_survey, aes(x = age, y = value, group = variable, color = variable)) + 
+  geom_point() + geom_line()
    diff --git a/content/acknowledgements.html b/content/acknowledgements.html index 9dc4d53..3a78749 100644 --- a/content/acknowledgements.html +++ b/content/acknowledgements.html @@ -2,7 +2,7 @@ - + diff --git a/content/case-study-template.html b/content/case-study-template.html index d2a3168..bc8910a 100644 --- a/content/case-study-template.html +++ b/content/case-study-template.html @@ -2,7 +2,7 @@ - + diff --git a/content/publishing.html b/content/publishing.html index 0afb8dd..4ebf625 100644 --- a/content/publishing.html +++ b/content/publishing.html @@ -2,7 +2,7 @@ - + diff --git a/content/rendering.html b/content/rendering.html index d6c9aeb..a23d2ed 100644 --- a/content/rendering.html +++ b/content/rendering.html @@ -2,7 +2,7 @@ - + diff --git a/content/rmarkdown.html b/content/rmarkdown.html index 7386eaa..07c97c1 100644 --- a/content/rmarkdown.html +++ b/content/rmarkdown.html @@ -2,7 +2,7 @@ - + diff --git a/content/setup.html b/content/setup.html index 86a77de..e4c2da8 100644 --- a/content/setup.html +++ b/content/setup.html @@ -2,7 +2,7 @@ - + diff --git a/index.html b/index.html index 7f19bfa..b42e1b0 100644 --- a/index.html +++ b/index.html @@ -2,7 +2,7 @@ - + diff --git a/search.json b/search.json index 7e1a2f4..6ed5059 100644 --- a/search.json +++ b/search.json @@ -21,7 +21,7 @@ "href": "content/AFSC-BSAI-AtkaMackerel.html", "title": "AFSC Case Study BSAI Atka mackerel", "section": "", - "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: BSAI Atka mackerel\n\nRegion: AFSC\n\nAnalyst: Jim Ianelli", + "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: BSAI Atka mackerel\n\nRegion: AFSC\n\nAnalyst: Jim Ianelli", "crumbs": [ "AFSC BSAI Atka Mackerel case study" ] @@ -31,7 +31,7 @@ "href": "content/AFSC-BSAI-AtkaMackerel.html#the-setup", "title": "AFSC Case Study BSAI Atka mackerel", "section": "", - "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: BSAI Atka mackerel\n\nRegion: AFSC\n\nAnalyst: Jim Ianelli", + "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: BSAI Atka mackerel\n\nRegion: AFSC\n\nAnalyst: Jim Ianelli", "crumbs": [ "AFSC BSAI Atka Mackerel case study" ] @@ -181,7 +181,7 @@ "href": "content/NWFSC-petrale.html", "title": "NWFSC Case Study Petrale Sole", "section": "", - "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: West Coast Petrale Sole\n\nRegion: NWFSC\n\nAnalyst: Ian G. Taylor", + "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: West Coast Petrale Sole\n\nRegion: NWFSC\n\nAnalyst: Ian G. Taylor", "crumbs": [ "NWFSC petrale case study" ] @@ -191,7 +191,7 @@ "href": "content/NWFSC-petrale.html#the-setup", "title": "NWFSC Case Study Petrale Sole", "section": "", - "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: West Coast Petrale Sole\n\nRegion: NWFSC\n\nAnalyst: Ian G. Taylor", + "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: West Coast Petrale Sole\n\nRegion: NWFSC\n\nAnalyst: Ian G. Taylor", "crumbs": [ "NWFSC petrale case study" ] @@ -221,7 +221,7 @@ "href": "content/NWFSC-petrale.html#setup-fims-model", "title": "NWFSC Case Study Petrale Sole", "section": "Setup FIMS model", - "text": "Setup FIMS model\n\n\nCode\n## set up FIMS data objects\nclear()\nclear_logs()\n\n# I don't know what these commands are doing\nage_frame <- FIMS::FIMSFrame(mydat) \nfishery_catch <- FIMS::m_landings(age_frame) # filtering for the landings only\nfishery_agecomp <- FIMS::m_agecomp(age_frame, \"fleet1\") # filtering for ages from fleet 1\nsurvey_index <- FIMS::m_index(age_frame, \"fleet2\") # filtering for index data from fleet 2\nsurvey_agecomp <- FIMS::m_agecomp(age_frame, \"fleet2\") # filtering for ages from fleet 2\n\nfish_index <- methods::new(Index, nyears)\nfish_index$index_data <- fishery_catch\nfish_age_comp <- methods::new(AgeComp, nyears, nages)\n# Q: I'm confused about FIMSFrame being set up with age comps in proportions\n# vs here needing age comps in numbers\n# A: It's just not sorted out in FIMS yet, in the future this could be made simpler\nfish_age_comp$age_comp_data <- age_frame@data |>\n dplyr::filter(type == \"age\" & name == \"fleet1\") |>\n dplyr::mutate(n = value * uncertainty) |>\n dplyr::pull(n) |>\n round(1)\n\n\n# switches to turn on or off estimation\nestimate_fish_selex <- TRUE\nestimate_survey_selex <- TRUE\nestimate_q <- TRUE\nestimate_F <- TRUE\nestimate_recdevs <- TRUE\nestimate_init_naa <- FALSE\nestimate_log_rzero <- TRUE\n\n### set up fishery\n## methods::show(DoubleLogisticSelectivity)\nfish_selex <- methods::new(LogisticSelectivity)\n\n# SS3 model had length-based selectivity which leads to sex-specific\n# age-based selectivity due to sexually-dimorphic growth.\n# I didn't bother to calculate an age-based inflection point averaged over sexes\nfish_selex$inflection_point$value <- 10\nfish_selex$inflection_point$is_random_effect <- FALSE\nfish_selex$inflection_point$estimated <- estimate_fish_selex\nfish_selex$slope$value <- 2\nfish_selex$slope$is_random_effect <- FALSE\nfish_selex$slope$estimated <- estimate_fish_selex\n\n## create fleet object for fishing fleet\nfish_fleet <- methods::new(Fleet)\nfish_fleet$nages <- nages\nfish_fleet$nyears <- nyears\nfish_fleet$log_Fmort <- log(rep(0.00001, nyears))\nfish_fleet$estimate_F <- estimate_F\nfish_fleet$random_F <- FALSE\nfish_fleet$log_q <- 0\nfish_fleet$estimate_q <- FALSE\nfish_fleet$random_q <- FALSE\nfish_fleet$log_obs_error <- rep(log(sqrt(log(0.01^2 + 1))), nyears)\n\n# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above\nfish_fleet$SetAgeCompLikelihood(1)\nfish_fleet$SetIndexLikelihood(1)\nfish_fleet$SetObservedIndexData(fish_index$get_id())\nfish_fleet$SetObservedAgeCompData(fish_age_comp$get_id())\nfish_fleet$SetSelectivity(fish_selex$get_id())\n\n## Setup survey\nsurvey_fleet_index <- methods::new(Index, nyears)\nsurvey_age_comp <- methods::new(AgeComp, nyears, nages)\nsurvey_fleet_index$index_data <- survey_index\nsurvey_age_comp$age_comp_data <- mydat |>\n dplyr::filter(type == \"age\" & name == \"fleet2\") |>\n dplyr::mutate(n = value * uncertainty) |>\n dplyr::pull(n)\n\n## survey selectivity: ascending logistic\n## methods::show(DoubleLogisticSelectivity)\nsurvey_selex <- new(LogisticSelectivity)\nsurvey_selex$inflection_point$value <- 6\nsurvey_selex$inflection_point$is_random_effect <- FALSE\nsurvey_selex$inflection_point$estimated <- estimate_survey_selex\nsurvey_selex$slope$value <- 2\nsurvey_selex$slope$is_random_effect <- FALSE\nsurvey_selex$slope$estimated <- estimate_survey_selex\n\n## create fleet object for survey\nsurvey_fleet <- methods::new(Fleet)\nsurvey_fleet$is_survey <- TRUE\nsurvey_fleet$nages <- nages\nsurvey_fleet$nyears <- nyears\nsurvey_fleet$estimate_F <- FALSE\nsurvey_fleet$random_F <- FALSE\nsurvey_fleet$log_q <- 1.4 # petrale sole catchability estimated ~4.0 = exp(1.4)\nsurvey_fleet$estimate_q <- estimate_q\nsurvey_fleet$random_q <- FALSE\n# Q: why can't the index uncertainty come from FIMSFrame?\nsurvey_fleet$log_obs_error <- age_frame@data |>\n dplyr::filter(type == \"index\" & name == \"fleet2\") |>\n dplyr::pull(uncertainty) |>\n log()\n\nsurvey_fleet$SetAgeCompLikelihood(1)\nsurvey_fleet$SetIndexLikelihood(1)\nsurvey_fleet$SetSelectivity(survey_selex$get_id())\nsurvey_fleet$SetObservedIndexData(survey_fleet_index$get_id())\nsurvey_fleet$SetObservedAgeCompData(survey_age_comp$get_id())\n\n# Population module\n\n# recruitment\nrecruitment <- methods::new(BevertonHoltRecruitment)\n# methods::show(BevertonHoltRecruitment)\n\n# petrale sigmaR is 0.5\nrecruitment$log_sigma_recruit$value <- log(ss3ctl$SR_parms[\"SR_sigmaR\", \"INIT\"])\n# petrale log(R0) is around 9.6 (where R0 is in thousands)\nrecruitment$log_rzero$value <- ss3ctl$SR_parms[\"SR_LN(R0)\", \"INIT\"]\n# Q: do we need to account for SS3 R0 in thousands?\n# A: formula below is thanks to Bai Li\n# in https://github.com/NOAA-FIMS/case-studies/commit/d7c0d645a18766d030f632e5818d91764e2297ef\n# but did not produce good results (perhaps due to some other issue) \n# recruitment$log_rzero$value <- log(exp(ss3ctl$SR_parms[\"SR_LN(R0)\", \"INIT\"])*1000)\nrecruitment$log_rzero$is_random_effect <- FALSE\nrecruitment$log_rzero$estimated <- estimate_log_rzero\n# petrale steepness is fixed at 0.8\nsteep <- ss3ctl$SR_parms[\"SR_BH_steep\", \"INIT\"]\nrecruitment$logit_steep$value <- -log(1.0 - steep) + log(steep - 0.2)\nrecruitment$logit_steep$is_random_effect <- FALSE\nrecruitment$logit_steep$estimated <- FALSE\n\nrecruitment$estimate_log_devs <- estimate_recdevs\n# Q: why are parameters \"log_devs\" when output is \"report$log_recruit_dev\"?\n# and are they multipliers, not deviations from zero?\n# needed to change from 1 to 0 to get stable population\nrecruitment$log_devs <- rep(0, nyears) # set to no deviations (multiplier) to start\n\n# growth\newaa_growth <- methods::new(EWAAgrowth)\newaa_growth$ages <- ages\n# NOTE: getting weight-at-age vector from\n# petrale_output$wtatage |>\n# dplyr::filter(Sex == 1 & Fleet == -1 & Yr == 1876) |>\n# dplyr::select(paste(0:40)) |>\n# round(4)\newaa_growth$weights <- c(\n # 0.0010, # age 0\n 0.0148, 0.0617, 0.1449, 0.2570, 0.3876, 0.5260, 0.6640, 0.7957, 0.9175,\n 1.0273, 1.1247, 1.2097, 1.2831, 1.3460, 1.3994, 1.4446, 1.4821\n)\n\n# maturity\nmaturity <- new(LogisticMaturity)\n# approximate age-based equivalent to length-based maturity in petrale model\n# based on looking at model$endgrowth |> dplyr::filter(Sex == 1) |> dplyr::select(Age_Beg, Len_Mat)\nmaturity$inflection_point$value <- 6.5\nmaturity$inflection_point$is_random_effect <- FALSE\nmaturity$inflection_point$estimated <- FALSE\nmaturity$slope$value <- 2 # arbitrary guess\nmaturity$slope$is_random_effect <- FALSE\nmaturity$slope$estimated <- FALSE\n\n# population\npopulation <- new(Population)\n# petrale natural mortality is estimated around 0.14\nM_value <- ss3ctl$MG_parms[\"NatM_p_1_Fem_GP_1\", \"INIT\"]\npopulation$log_M <- rep(log(M_value), nages * nyears)\npopulation$estimate_M <- FALSE\n# initial numbers at age based on R0 + mortality\ninit_naa <- exp(recruitment$log_rzero$value) * exp(-(ages - 1) * M_value)\ninit_naa[nages] <- init_naa[nages] / M_value # sum of infinite series\npopulation$log_init_naa <- log(init_naa)\npopulation$estimate_init_naa <- estimate_init_naa\npopulation$nages <- nages\npopulation$ages <- ages\npopulation$nfleets <- 2 # fleets plus surveys\npopulation$nseasons <- nseasons\npopulation$nyears <- nyears\n# population$proportion_female <- rep(0.5, nages)\n\npopulation$SetMaturity(maturity$get_id())\npopulation$SetGrowth(ewaa_growth$get_id())\npopulation$SetRecruitment(recruitment$get_id())", + "text": "Setup FIMS model\n\n\nCode\n## set up FIMS data objects\nclear()\nclear_logs()\n\n# I don't know what these commands are doing\nage_frame <- FIMS::FIMSFrame(mydat) \nfishery_catch <- FIMS::m_landings(age_frame) # filtering for the landings only\nfishery_agecomp <- FIMS::m_agecomp(age_frame, \"fleet1\") # filtering for ages from fleet 1\nsurvey_index <- FIMS::m_index(age_frame, \"fleet2\") # filtering for index data from fleet 2\nsurvey_agecomp <- FIMS::m_agecomp(age_frame, \"fleet2\") # filtering for ages from fleet 2\n\nfish_index <- methods::new(Index, nyears)\nfish_index$index_data <- fishery_catch\nfish_age_comp <- methods::new(AgeComp, nyears, nages)\n# Q: I'm confused about FIMSFrame being set up with age comps in proportions\n# vs here needing age comps in numbers\n# A: It's just not sorted out in FIMS yet, in the future this could be made simpler\nfish_age_comp$age_comp_data <- age_frame@data |>\n dplyr::filter(type == \"age\" & name == \"fleet1\") |>\n dplyr::mutate(n = value * uncertainty) |>\n dplyr::pull(n) |>\n round(1)\n\n\n# switches to turn on or off estimation\nestimate_fish_selex <- TRUE\nestimate_survey_selex <- TRUE\nestimate_q <- TRUE\nestimate_F <- TRUE\nestimate_recdevs <- TRUE\nestimate_init_naa <- FALSE\nestimate_log_rzero <- TRUE\n\n### set up fishery\n## methods::show(DoubleLogisticSelectivity)\nfish_selex <- methods::new(LogisticSelectivity)\n\n# SS3 model had length-based selectivity which leads to sex-specific\n# age-based selectivity due to sexually-dimorphic growth.\n# I didn't bother to calculate an age-based inflection point averaged over sexes\nfish_selex$inflection_point$value <- 10\nfish_selex$inflection_point$is_random_effect <- FALSE\nfish_selex$inflection_point$estimated <- estimate_fish_selex\nfish_selex$slope$value <- 2\nfish_selex$slope$is_random_effect <- FALSE\nfish_selex$slope$estimated <- estimate_fish_selex\n\n## create fleet object for fishing fleet\nfish_fleet <- methods::new(Fleet)\nfish_fleet$nages <- nages\nfish_fleet$nyears <- nyears\nfish_fleet$log_Fmort <- log(rep(0.00001, nyears))\nfish_fleet$estimate_F <- estimate_F\nfish_fleet$random_F <- FALSE\nfish_fleet$log_q <- 0\nfish_fleet$estimate_q <- FALSE\nfish_fleet$random_q <- FALSE\nfish_fleet$log_obs_error <- rep(log(sqrt(log(0.01^2 + 1))), nyears)\n\n# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above\nfish_fleet$SetAgeCompLikelihood(1)\nfish_fleet$SetIndexLikelihood(1)\nfish_fleet$SetObservedIndexData(fish_index$get_id())\nfish_fleet$SetObservedAgeCompData(fish_age_comp$get_id())\nfish_fleet$SetSelectivity(fish_selex$get_id())\n\n## Setup survey\nsurvey_fleet_index <- methods::new(Index, nyears)\nsurvey_age_comp <- methods::new(AgeComp, nyears, nages)\nsurvey_fleet_index$index_data <- survey_index\nsurvey_age_comp$age_comp_data <- mydat |>\n dplyr::filter(type == \"age\" & name == \"fleet2\") |>\n dplyr::mutate(n = value * uncertainty) |>\n dplyr::pull(n)\n\n## survey selectivity: ascending logistic\n## methods::show(DoubleLogisticSelectivity)\nsurvey_selex <- new(LogisticSelectivity)\nsurvey_selex$inflection_point$value <- 6\nsurvey_selex$inflection_point$is_random_effect <- FALSE\nsurvey_selex$inflection_point$estimated <- estimate_survey_selex\nsurvey_selex$slope$value <- 2\nsurvey_selex$slope$is_random_effect <- FALSE\nsurvey_selex$slope$estimated <- estimate_survey_selex\n\n## create fleet object for survey\nsurvey_fleet <- methods::new(Fleet)\nsurvey_fleet$is_survey <- TRUE\nsurvey_fleet$nages <- nages\nsurvey_fleet$nyears <- nyears\nsurvey_fleet$estimate_F <- FALSE\nsurvey_fleet$random_F <- FALSE\nsurvey_fleet$log_q <- 1.4 # petrale sole catchability estimated ~4.0 = exp(1.4)\nsurvey_fleet$estimate_q <- estimate_q\nsurvey_fleet$random_q <- FALSE\n# Q: why can't the index uncertainty come from FIMSFrame?\nsurvey_fleet$log_obs_error <- age_frame@data |>\n dplyr::filter(type == \"index\" & name == \"fleet2\") |>\n dplyr::pull(uncertainty) |>\n log()\n\nsurvey_fleet$SetAgeCompLikelihood(1)\nsurvey_fleet$SetIndexLikelihood(1)\nsurvey_fleet$SetSelectivity(survey_selex$get_id())\nsurvey_fleet$SetObservedIndexData(survey_fleet_index$get_id())\nsurvey_fleet$SetObservedAgeCompData(survey_age_comp$get_id())\n\n# Population module\n\n# recruitment\nrecruitment <- methods::new(BevertonHoltRecruitment)\n# methods::show(BevertonHoltRecruitment)\n\n# petrale sigmaR is 0.5\nrecruitment$log_sigma_recruit$value <- log(ss3ctl$SR_parms[\"SR_sigmaR\", \"INIT\"])\n# petrale log(R0) is around 9.6 (where R0 is in thousands)\nrecruitment$log_rzero$value <- ss3ctl$SR_parms[\"SR_LN(R0)\", \"INIT\"]\n# Q: do we need to account for SS3 R0 in thousands?\n# A: formula below is thanks to Bai Li\n# in https://github.com/NOAA-FIMS/case-studies/commit/d7c0d645a18766d030f632e5818d91764e2297ef\n# but did not produce good results (perhaps due to some other issue) \n# recruitment$log_rzero$value <- log(exp(ss3ctl$SR_parms[\"SR_LN(R0)\", \"INIT\"])*1000)\nrecruitment$log_rzero$is_random_effect <- FALSE\nrecruitment$log_rzero$estimated <- estimate_log_rzero\n# petrale steepness is fixed at 0.8\nsteep <- ss3ctl$SR_parms[\"SR_BH_steep\", \"INIT\"]\nrecruitment$logit_steep$value <- -log(1.0 - steep) + log(steep - 0.2)\nrecruitment$logit_steep$is_random_effect <- FALSE\nrecruitment$logit_steep$estimated <- FALSE\n\nrecruitment$estimate_log_devs <- estimate_recdevs\n# Q: why are parameters \"log_devs\" when output is \"report$log_recruit_dev\"?\n# and are they multipliers, not deviations from zero?\n# needed to change from 1 to 0 to get stable population\nrecruitment$log_devs <- rep(0, nyears) # set to no deviations (multiplier) to start\n\n# growth\newaa_growth <- methods::new(EWAAgrowth)\newaa_growth$ages <- ages\n# NOTE: getting weight-at-age vector from\n# petrale_output$wtatage |>\n# dplyr::filter(Sex == 1 & Fleet == -1 & Yr == 1876) |>\n# dplyr::select(paste(0:40)) |>\n# round(4)\newaa_growth$weights <- c(\n # 0.0010, # age 0\n 0.0148, 0.0617, 0.1449, 0.2570, 0.3876, 0.5260, 0.6640, 0.7957, 0.9175,\n 1.0273, 1.1247, 1.2097, 1.2831, 1.3460, 1.3994, 1.4446, 1.4821\n)\n\n# maturity\nmaturity <- new(LogisticMaturity)\n# approximate age-based equivalent to length-based maturity in petrale model\n# based on looking at model$endgrowth |> dplyr::filter(Sex == 1) |> dplyr::select(Age_Beg, Len_Mat)\nmaturity$inflection_point$value <- 6.5\nmaturity$inflection_point$is_random_effect <- FALSE\nmaturity$inflection_point$estimated <- FALSE\nmaturity$slope$value <- 2 # arbitrary guess\nmaturity$slope$is_random_effect <- FALSE\nmaturity$slope$estimated <- FALSE\n\n# population\npopulation <- new(Population)\n# petrale natural mortality is estimated around 0.14\nM_value <- ss3ctl$MG_parms[\"NatM_p_1_Fem_GP_1\", \"INIT\"]\npopulation$log_M <- rep(log(M_value), nages * nyears)\npopulation$estimate_M <- FALSE\n# initial numbers at age based on R0 + mortality\ninit_naa <- exp(recruitment$log_rzero$value) * exp(-(ages - 1) * M_value)\ninit_naa[nages] <- init_naa[nages] / M_value # sum of infinite series\npopulation$log_init_naa <- log(init_naa)\npopulation$estimate_init_naa <- estimate_init_naa\npopulation$nages <- nages\npopulation$ages <- ages\npopulation$nfleets <- 2 # fleets plus surveys\npopulation$nseasons <- nseasons\npopulation$nyears <- nyears\n\npopulation$SetMaturity(maturity$get_id())\npopulation$SetGrowth(ewaa_growth$get_id())\npopulation$SetRecruitment(recruitment$get_id())", "crumbs": [ "NWFSC petrale case study" ] @@ -399,7 +399,7 @@ "href": "content/AFSC-GOA-pollock.html", "title": "AFSC Case Study Gulf of Alaska Walleye Pollock", "section": "", - "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\n\n\nThe downloaded binary packages are in\n /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages\n\n\nCode\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\n\n\nRcpp (1.0.12 -> 1.0.13 ) [CRAN]\nRcppParallel (NA -> 5.1.8 ) [CRAN]\nnumDeriv (NA -> 2016.8-1.1) [CRAN]\nps (NA -> 1.7.7 ) [CRAN]\ndistribut... (NA -> 0.4.0 ) [CRAN]\ntensorA (NA -> 0.36.2.1 ) [CRAN]\nabind (NA -> 1.4-5 ) [CRAN]\nbackports (NA -> 1.5.0 ) [CRAN]\nprocessx (NA -> 3.8.4 ) [CRAN]\ndesc (NA -> 1.4.3 ) [CRAN]\ncallr (NA -> 3.7.6 ) [CRAN]\nposterior (NA -> 1.6.0 ) [CRAN]\nmatrixStats (NA -> 1.3.0 ) [CRAN]\ncheckmate (NA -> 2.3.1 ) [CRAN]\nBH (NA -> 1.84.0-0 ) [CRAN]\nQuickJSR (NA -> 1.3.1 ) [CRAN]\npkgbuild (NA -> 1.4.4 ) [CRAN]\nloo (NA -> 2.8.0 ) [CRAN]\ngridExtra (NA -> 2.3 ) [CRAN]\ninline (NA -> 0.3.19 ) [CRAN]\nStanHeaders (NA -> 2.32.10 ) [CRAN]\nrstan (NA -> 2.32.6 ) [CRAN]\ntmbstan (NA -> 1.0.91 ) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T/RtmpDaSufj/remotes13b46ee1ffdf/kaskr-TMB_contrib_R-d275e52/TMBhelper/DESCRIPTION’ ... OK\n* preparing ‘TMBhelper’:\n* checking DESCRIPTION meta-information ... OK\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘TMBhelper_1.4.0.tar.gz’\n\n\nCode\nremotes::install_github(\"NOAA-FIMS/FIMS\")\n\n\nRcpp (1.0.12 -> 1.0.13) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T/RtmpDaSufj/remotes13b45ca541b0/NOAA-FIMS-FIMS-39d0743/DESCRIPTION’ ... OK\n* preparing ‘FIMS’:\n* checking DESCRIPTION meta-information ... OK\n* cleaning src\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘FIMS_0.2.0.0.tar.gz’\n\n\nCode\nremotes::install_github(\"r4ss/r4ss\")\n\n\nsystemfonts (NA -> 1.1.0 ) [CRAN]\nsys (NA -> 3.4.2 ) [CRAN]\naskpass (NA -> 1.2.0 ) [CRAN]\nopenssl (NA -> 2.2.0 ) [CRAN]\ncurl (NA -> 5.2.1 ) [CRAN]\nparallelly (NA -> 1.37.1 ) [CRAN]\nlistenv (NA -> 0.9.1 ) [CRAN]\nglobals (NA -> 0.16.3 ) [CRAN]\nsvglite (NA -> 2.1.3 ) [CRAN]\nrstudioapi (NA -> 0.16.0 ) [CRAN]\nxml2 (NA -> 1.3.6 ) [CRAN]\nini (NA -> 0.3.1 ) [CRAN]\nhttr2 (NA -> 1.0.2 ) [CRAN]\ngitcreds (NA -> 0.1.2 ) [CRAN]\nfuture (NA -> 1.33.2 ) [CRAN]\nkableExtra (NA -> 1.4.0 ) [CRAN]\ngh (NA -> 1.4.1 ) [CRAN]\nfurrr (NA -> 0.3.1 ) [CRAN]\nforcats (NA -> 1.0.0 ) [CRAN]\ncorpcor (NA -> 1.6.10 ) [CRAN]\ncoda (NA -> 0.19-4.1) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T/RtmpDaSufj/remotes13b47d24e8a/r4ss-r4ss-b6976cd/DESCRIPTION’ ... OK\n* preparing ‘r4ss’:\n* checking DESCRIPTION meta-information ... OK\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘r4ss_1.49.2.tar.gz’\n\n\nCode\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: Gulf of Alaska (GOA) Walleye Pollock\n\nRegion: AFSC\n\nAnalyst: Cole Monnahan", + "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\n\n\nThe downloaded binary packages are in\n /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages\n\n\nCode\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\n\n\nRcppParallel (NA -> 5.1.8 ) [CRAN]\ncolorspace (2.1-0 -> 2.1-1 ) [CRAN]\nnumDeriv (NA -> 2016.8-1.1) [CRAN]\nps (NA -> 1.7.7 ) [CRAN]\ndistribut... (NA -> 0.4.0 ) [CRAN]\ntensorA (NA -> 0.36.2.1 ) [CRAN]\nabind (NA -> 1.4-5 ) [CRAN]\nbackports (NA -> 1.5.0 ) [CRAN]\nprocessx (NA -> 3.8.4 ) [CRAN]\ndesc (NA -> 1.4.3 ) [CRAN]\ncallr (NA -> 3.7.6 ) [CRAN]\nposterior (NA -> 1.6.0 ) [CRAN]\nmatrixStats (NA -> 1.3.0 ) [CRAN]\ncheckmate (NA -> 2.3.1 ) [CRAN]\nBH (NA -> 1.84.0-0 ) [CRAN]\nQuickJSR (NA -> 1.3.1 ) [CRAN]\npkgbuild (NA -> 1.4.4 ) [CRAN]\nloo (NA -> 2.8.0 ) [CRAN]\ngridExtra (NA -> 2.3 ) [CRAN]\ninline (NA -> 0.3.19 ) [CRAN]\nStanHeaders (NA -> 2.32.10 ) [CRAN]\nrstan (NA -> 2.32.6 ) [CRAN]\ntmbstan (NA -> 1.0.91 ) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T/Rtmp9VrHzZ/remotes119e6ee04f16/kaskr-TMB_contrib_R-d275e52/TMBhelper/DESCRIPTION’ ... OK\n* preparing ‘TMBhelper’:\n* checking DESCRIPTION meta-information ... OK\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘TMBhelper_1.4.0.tar.gz’\n\n\nCode\nremotes::install_github(\"NOAA-FIMS/FIMS\")\n\n\ncolorspace (2.1-0 -> 2.1-1) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T/Rtmp9VrHzZ/remotes119e5bff994d/NOAA-FIMS-FIMS-081972c/DESCRIPTION’ ... OK\n* preparing ‘FIMS’:\n* checking DESCRIPTION meta-information ... OK\n* cleaning src\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘FIMS_0.2.0.0.tar.gz’\n\n\nCode\nremotes::install_github(\"r4ss/r4ss\")\n\n\nsystemfonts (NA -> 1.1.0 ) [CRAN]\ncolorspace (2.1-0 -> 2.1-1 ) [CRAN]\nyaml (2.3.9 -> 2.3.10 ) [CRAN]\nsys (NA -> 3.4.2 ) [CRAN]\naskpass (NA -> 1.2.0 ) [CRAN]\nopenssl (NA -> 2.2.0 ) [CRAN]\ncurl (NA -> 5.2.1 ) [CRAN]\nparallelly (NA -> 1.37.1 ) [CRAN]\nlistenv (NA -> 0.9.1 ) [CRAN]\nglobals (NA -> 0.16.3 ) [CRAN]\nsvglite (NA -> 2.1.3 ) [CRAN]\nrstudioapi (NA -> 0.16.0 ) [CRAN]\nxml2 (NA -> 1.3.6 ) [CRAN]\nini (NA -> 0.3.1 ) [CRAN]\nhttr2 (NA -> 1.0.2 ) [CRAN]\ngitcreds (NA -> 0.1.2 ) [CRAN]\nfuture (NA -> 1.33.2 ) [CRAN]\nkableExtra (NA -> 1.4.0 ) [CRAN]\ngh (NA -> 1.4.1 ) [CRAN]\nfurrr (NA -> 0.3.1 ) [CRAN]\nforcats (NA -> 1.0.0 ) [CRAN]\ncorpcor (NA -> 1.6.10 ) [CRAN]\ncoda (NA -> 0.19-4.1) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T/Rtmp9VrHzZ/remotes119e7a917174/r4ss-r4ss-5be028c/DESCRIPTION’ ... OK\n* preparing ‘r4ss’:\n* checking DESCRIPTION meta-information ... OK\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘r4ss_1.49.3.tar.gz’\n\n\nCode\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: Gulf of Alaska (GOA) Walleye Pollock\n\nRegion: AFSC\n\nAnalyst: Cole Monnahan", "crumbs": [ "AFSC GOA pollock case study" ] @@ -409,7 +409,7 @@ "href": "content/AFSC-GOA-pollock.html#the-setup", "title": "AFSC Case Study Gulf of Alaska Walleye Pollock", "section": "", - "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\n\n\nThe downloaded binary packages are in\n /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages\n\n\nCode\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\n\n\nRcpp (1.0.12 -> 1.0.13 ) [CRAN]\nRcppParallel (NA -> 5.1.8 ) [CRAN]\nnumDeriv (NA -> 2016.8-1.1) [CRAN]\nps (NA -> 1.7.7 ) [CRAN]\ndistribut... (NA -> 0.4.0 ) [CRAN]\ntensorA (NA -> 0.36.2.1 ) [CRAN]\nabind (NA -> 1.4-5 ) [CRAN]\nbackports (NA -> 1.5.0 ) [CRAN]\nprocessx (NA -> 3.8.4 ) [CRAN]\ndesc (NA -> 1.4.3 ) [CRAN]\ncallr (NA -> 3.7.6 ) [CRAN]\nposterior (NA -> 1.6.0 ) [CRAN]\nmatrixStats (NA -> 1.3.0 ) [CRAN]\ncheckmate (NA -> 2.3.1 ) [CRAN]\nBH (NA -> 1.84.0-0 ) [CRAN]\nQuickJSR (NA -> 1.3.1 ) [CRAN]\npkgbuild (NA -> 1.4.4 ) [CRAN]\nloo (NA -> 2.8.0 ) [CRAN]\ngridExtra (NA -> 2.3 ) [CRAN]\ninline (NA -> 0.3.19 ) [CRAN]\nStanHeaders (NA -> 2.32.10 ) [CRAN]\nrstan (NA -> 2.32.6 ) [CRAN]\ntmbstan (NA -> 1.0.91 ) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T/RtmpDaSufj/remotes13b46ee1ffdf/kaskr-TMB_contrib_R-d275e52/TMBhelper/DESCRIPTION’ ... OK\n* preparing ‘TMBhelper’:\n* checking DESCRIPTION meta-information ... OK\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘TMBhelper_1.4.0.tar.gz’\n\n\nCode\nremotes::install_github(\"NOAA-FIMS/FIMS\")\n\n\nRcpp (1.0.12 -> 1.0.13) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T/RtmpDaSufj/remotes13b45ca541b0/NOAA-FIMS-FIMS-39d0743/DESCRIPTION’ ... OK\n* preparing ‘FIMS’:\n* checking DESCRIPTION meta-information ... OK\n* cleaning src\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘FIMS_0.2.0.0.tar.gz’\n\n\nCode\nremotes::install_github(\"r4ss/r4ss\")\n\n\nsystemfonts (NA -> 1.1.0 ) [CRAN]\nsys (NA -> 3.4.2 ) [CRAN]\naskpass (NA -> 1.2.0 ) [CRAN]\nopenssl (NA -> 2.2.0 ) [CRAN]\ncurl (NA -> 5.2.1 ) [CRAN]\nparallelly (NA -> 1.37.1 ) [CRAN]\nlistenv (NA -> 0.9.1 ) [CRAN]\nglobals (NA -> 0.16.3 ) [CRAN]\nsvglite (NA -> 2.1.3 ) [CRAN]\nrstudioapi (NA -> 0.16.0 ) [CRAN]\nxml2 (NA -> 1.3.6 ) [CRAN]\nini (NA -> 0.3.1 ) [CRAN]\nhttr2 (NA -> 1.0.2 ) [CRAN]\ngitcreds (NA -> 0.1.2 ) [CRAN]\nfuture (NA -> 1.33.2 ) [CRAN]\nkableExtra (NA -> 1.4.0 ) [CRAN]\ngh (NA -> 1.4.1 ) [CRAN]\nfurrr (NA -> 0.3.1 ) [CRAN]\nforcats (NA -> 1.0.0 ) [CRAN]\ncorpcor (NA -> 1.6.10 ) [CRAN]\ncoda (NA -> 0.19-4.1) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T//RtmpDaSufj/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/6g/_ypptv3n2fs80_zc0xz8p1d40000gn/T/RtmpDaSufj/remotes13b47d24e8a/r4ss-r4ss-b6976cd/DESCRIPTION’ ... OK\n* preparing ‘r4ss’:\n* checking DESCRIPTION meta-information ... OK\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘r4ss_1.49.2.tar.gz’\n\n\nCode\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: Gulf of Alaska (GOA) Walleye Pollock\n\nRegion: AFSC\n\nAnalyst: Cole Monnahan", + "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\n\n\nThe downloaded binary packages are in\n /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages\n\n\nCode\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\n\n\nRcppParallel (NA -> 5.1.8 ) [CRAN]\ncolorspace (2.1-0 -> 2.1-1 ) [CRAN]\nnumDeriv (NA -> 2016.8-1.1) [CRAN]\nps (NA -> 1.7.7 ) [CRAN]\ndistribut... (NA -> 0.4.0 ) [CRAN]\ntensorA (NA -> 0.36.2.1 ) [CRAN]\nabind (NA -> 1.4-5 ) [CRAN]\nbackports (NA -> 1.5.0 ) [CRAN]\nprocessx (NA -> 3.8.4 ) [CRAN]\ndesc (NA -> 1.4.3 ) [CRAN]\ncallr (NA -> 3.7.6 ) [CRAN]\nposterior (NA -> 1.6.0 ) [CRAN]\nmatrixStats (NA -> 1.3.0 ) [CRAN]\ncheckmate (NA -> 2.3.1 ) [CRAN]\nBH (NA -> 1.84.0-0 ) [CRAN]\nQuickJSR (NA -> 1.3.1 ) [CRAN]\npkgbuild (NA -> 1.4.4 ) [CRAN]\nloo (NA -> 2.8.0 ) [CRAN]\ngridExtra (NA -> 2.3 ) [CRAN]\ninline (NA -> 0.3.19 ) [CRAN]\nStanHeaders (NA -> 2.32.10 ) [CRAN]\nrstan (NA -> 2.32.6 ) [CRAN]\ntmbstan (NA -> 1.0.91 ) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T/Rtmp9VrHzZ/remotes119e6ee04f16/kaskr-TMB_contrib_R-d275e52/TMBhelper/DESCRIPTION’ ... OK\n* preparing ‘TMBhelper’:\n* checking DESCRIPTION meta-information ... OK\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘TMBhelper_1.4.0.tar.gz’\n\n\nCode\nremotes::install_github(\"NOAA-FIMS/FIMS\")\n\n\ncolorspace (2.1-0 -> 2.1-1) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T/Rtmp9VrHzZ/remotes119e5bff994d/NOAA-FIMS-FIMS-081972c/DESCRIPTION’ ... OK\n* preparing ‘FIMS’:\n* checking DESCRIPTION meta-information ... OK\n* cleaning src\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘FIMS_0.2.0.0.tar.gz’\n\n\nCode\nremotes::install_github(\"r4ss/r4ss\")\n\n\nsystemfonts (NA -> 1.1.0 ) [CRAN]\ncolorspace (2.1-0 -> 2.1-1 ) [CRAN]\nyaml (2.3.9 -> 2.3.10 ) [CRAN]\nsys (NA -> 3.4.2 ) [CRAN]\naskpass (NA -> 1.2.0 ) [CRAN]\nopenssl (NA -> 2.2.0 ) [CRAN]\ncurl (NA -> 5.2.1 ) [CRAN]\nparallelly (NA -> 1.37.1 ) [CRAN]\nlistenv (NA -> 0.9.1 ) [CRAN]\nglobals (NA -> 0.16.3 ) [CRAN]\nsvglite (NA -> 2.1.3 ) [CRAN]\nrstudioapi (NA -> 0.16.0 ) [CRAN]\nxml2 (NA -> 1.3.6 ) [CRAN]\nini (NA -> 0.3.1 ) [CRAN]\nhttr2 (NA -> 1.0.2 ) [CRAN]\ngitcreds (NA -> 0.1.2 ) [CRAN]\nfuture (NA -> 1.33.2 ) [CRAN]\nkableExtra (NA -> 1.4.0 ) [CRAN]\ngh (NA -> 1.4.1 ) [CRAN]\nfurrr (NA -> 0.3.1 ) [CRAN]\nforcats (NA -> 1.0.0 ) [CRAN]\ncorpcor (NA -> 1.6.10 ) [CRAN]\ncoda (NA -> 0.19-4.1) [CRAN]\n\nThe downloaded binary packages are in\n /var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T//Rtmp9VrHzZ/downloaded_packages\n── R CMD build ─────────────────────────────────────────────────────────────────\n* checking for file ‘/private/var/folders/hn/5bx1f4_d4ds5vhwhkxc7vdcr0000gn/T/Rtmp9VrHzZ/remotes119e7a917174/r4ss-r4ss-5be028c/DESCRIPTION’ ... OK\n* preparing ‘r4ss’:\n* checking DESCRIPTION meta-information ... OK\n* checking for LF line-endings in source and make files and shell scripts\n* checking for empty or unneeded directories\n* building ‘r4ss_1.49.3.tar.gz’\n\n\nCode\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: Gulf of Alaska (GOA) Walleye Pollock\n\nRegion: AFSC\n\nAnalyst: Cole Monnahan", "crumbs": [ "AFSC GOA pollock case study" ] @@ -509,7 +509,7 @@ "href": "content/AFSC-GOA-pollock.html#what-features-are-most-important-to-add-based-on-this-case-study", "title": "AFSC Case Study Gulf of Alaska Walleye Pollock", "section": "What features are most important to add based on this case study?", - "text": "What features are most important to add based on this case study?\n\nMore sophisticated control over selectivity so that ages 1 and 2 can be zeroed out for a double-logistic form, overriding the selectivity curve.\n\n\n\nCode\n# Clear C++ objects from memory\nclear()", + "text": "What features are most important to add based on this case study?\n\nMore sophisticated control over selectivity so that ages 1 and 2 can be zeroed out for a double-logistic form, overriding the selectivity curve.\n\n\n\nCode\n# Clear C++ objects from memory\nclear()\n\n\nNULL", "crumbs": [ "AFSC GOA pollock case study" ] @@ -519,7 +519,7 @@ "href": "content/NEFSC-yellowtail.html", "title": "NEFSC Case Study Southern New England-Mid Atlantic Yellowtail Flounder", "section": "", - "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: Southern New England-Mid Atlantic Yellowtail Flounder\n\nRegion: NEFSC\n\nAnalyst: Chris Legault", + "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: Southern New England-Mid Atlantic Yellowtail Flounder\n\nRegion: NEFSC\n\nAnalyst: Chris Legault", "crumbs": [ "NEFSC yellowtail flounder case study" ] @@ -529,7 +529,7 @@ "href": "content/NEFSC-yellowtail.html#the-setup", "title": "NEFSC Case Study Southern New England-Mid Atlantic Yellowtail Flounder", "section": "", - "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: Southern New England-Mid Atlantic Yellowtail Flounder\n\nRegion: NEFSC\n\nAnalyst: Chris Legault", + "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\n# R_version <- version$version.string\n# TMB_version <- packageDescription(\"TMB\")$Version\n# FIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: Southern New England-Mid Atlantic Yellowtail Flounder\n\nRegion: NEFSC\n\nAnalyst: Chris Legault", "crumbs": [ "NEFSC yellowtail flounder case study" ] @@ -549,7 +549,7 @@ "href": "content/NEFSC-yellowtail.html#script-that-sets-up-and-runs-the-model", "title": "NEFSC Case Study Southern New England-Mid Atlantic Yellowtail Flounder", "section": "Script that sets up and runs the model", - "text": "Script that sets up and runs the model\n\n\nCode\n# clear memory\nclear()\n\n# read the ASAP rdat files\nrdat <- dget(file.path(\"data_files\", \"NEFSC_YT_SIMPLIFIED.RDAT\")) # to be used in FIMS, lots of modifications from original\norig <- dget(file.path(\"data_files\", \"NEFSC_YT_ORIGINAL.RDAT\")) # where started before modifications for use in FIMS\n\n# function to create equivalent of data_mile1, basic catch and survey data\n# need to think about how to deal with multiple fleets and indices - only use 1 of each for now\nget_asap_data <- function(rdat){\n res <- data.frame(type = character(),\n name = character(),\n age = integer(),\n datestart = character(),\n dateend = character(),\n value = double(),\n unit = character(),\n uncertainty = double())\n \n landings <- data.frame(type = \"landings\",\n name = \"fleet1\",\n age = NA,\n datestart = paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-01-01\"),\n dateend = paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-12-31\"),\n value = as.numeric(rdat$catch.obs[1,]),\n unit = \"mt\",\n uncertainty = rdat$control.parms$catch.tot.cv[,1])\n \n # loop over all indices\n for (i in 1:rdat$parms$nindices){\n index <- data.frame(type = \"index\",\n name = paste0(\"survey\", i),\n age = NA,\n datestart = paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-01-01\"),\n dateend = paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-12-31\"),\n value = as.numeric(rdat$index.obs[[i]]),\n unit = \"\",\n uncertainty = rdat$index.cv[[i]])\n if (i == 1){\n allinds <- index\n }else{\n allinds <- rbind(allinds, index)\n }\n }\n \n catchage <- data.frame(type = \"age\",\n name = \"fleet1\",\n age = rep(seq(1,rdat$parms$nages), rdat$parms$nyears),\n datestart = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-01-01\"), each=rdat$parms$nages),\n dateend = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-12-31\"), each=rdat$parms$nages),\n value = as.numeric(t(rdat$catch.comp.mats$catch.fleet1.ob)),\n unit = \"\",\n uncertainty = rep(rdat$fleet.catch.Neff.init[1,], each=rdat$parms$nages))\n \n # loop over all indices\n for (i in 1:rdat$parms$nindices){\n indexage <- data.frame(type = \"age\",\n name = paste0(\"survey\", i),\n age = rep(seq(1,rdat$parms$nages), rdat$parms$nyears),\n datestart = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-01-01\"), each=rdat$parms$nages),\n dateend = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-12-31\"), each=rdat$parms$nages),\n value = as.numeric(t(rdat$index.comp.mats[[i*2-1]])),\n unit = \"\",\n uncertainty = rep(rdat$index.Neff.init[i,], each=rdat$parms$nages))\n if (i == 1){\n allindsage <- indexage\n }else{\n allindsage <- rbind(allindsage, indexage)\n }\n }\n \n res <- rbind(res, landings, allinds, catchage, allindsage)\n return(res)\n}\n\nmydat <- get_asap_data(rdat)\n\nmyfimsframe <- FIMS::FIMSFrame(mydat)\n#str(myfimsframe)\n\n# define the dimensions\nnyears <- rdat$parms$nyears\nyears <- seq(rdat$parms$styr, rdat$parms$endyr)\nnseasons <- 1 # ASAP only has one season\nnages <- rdat$parms$nages\nages <- 1:nages # ASAP starts at age 1\n\n\n# set up FIMS data objects\nage_frame <- FIMS::FIMSFrame(mydat)\n\nfishery_catch <- FIMS::m_landings(age_frame)\nfishery_agecomp <- FIMS::m_agecomp(age_frame, \"fleet1\")\nsurvey_index <- list()\nsurvey_agecomp <- list()\nfor (i in 1:rdat$parms$nindices){\n survey_index[[i]] <- FIMS::m_index(age_frame, paste0(\"survey\", i))\n survey_agecomp[[i]] <- FIMS::m_agecomp(age_frame, paste0(\"survey\", i))\n}\n\n# eventually change to allow multiple fishing fleets similar to multiple indices - only using 1 fishing fleet for now\nfishing_fleet_index <- methods::new(Index, nyears)\nfishing_fleet_age_comp <- methods::new(AgeComp, nyears, nages)\nfishing_fleet_index$index_data <- fishery_catch\nfishing_fleet_age_comp$age_comp_data <- fishery_agecomp * rep(rdat$fleet.catch.Neff.init[1,], each=rdat$parms$nages)\n\n\n# fleet selectivity\n#methods::show(LogisticSelectivity)\nfishing_fleet_selectivity <- methods::new(LogisticSelectivity)\nfishing_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$fleet.sel.ini[nages+1,1] # hardwired to assume only 1 fleet and logistic selectivity used\nfishing_fleet_selectivity$inflection_point$is_random_effect <- FALSE\nfishing_fleet_selectivity$inflection_point$estimated <- TRUE\nfishing_fleet_selectivity$slope$value <- rdat$sel.input.mats$fleet.sel.ini[nages+2,1] # hardwired to assume only 1 fleet and logistic selectivity used\nfishing_fleet_selectivity$slope$is_random_effect <- FALSE\nfishing_fleet_selectivity$slope$estimated <- TRUE\n\n# create fleet object\nfishing_fleet <- methods::new(Fleet)\nfishing_fleet$nages <- nages\nfishing_fleet$nyears <- nyears\nfishing_fleet$log_Fmort <- log(rep(rdat$initial.guesses$Fmult.year1.init[1], nyears)) # ASAP assumes Fmult devs = 0\nfishing_fleet$estimate_F <- TRUE\nfishing_fleet$random_F <- FALSE\nfishing_fleet$log_q <- log(rdat$initial.guesses$q.year1.init[1])\nfishing_fleet$estimate_q <- FALSE\nfishing_fleet$random_q <- FALSE\nfishing_fleet$log_obs_error <- rep(log(sqrt(log(as.numeric(mean(rdat$control.parms$catch.tot.cv[,1], na.rm=TRUE)^2) + 1))), nyears)\nfishing_fleet$estimate_obs_error <- FALSE\n# Next two lines not currently used by FIMS\nfishing_fleet$SetAgeCompLikelihood(1)\nfishing_fleet$SetIndexLikelihood(1)\n# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above\nfishing_fleet$SetObservedIndexData(fishing_fleet_index$get_id()) \nfishing_fleet$SetObservedAgeCompData(fishing_fleet_age_comp$get_id())\nfishing_fleet$SetSelectivity(fishing_fleet_selectivity$get_id())\n\n# survey module now can handle multiple indices\nfor (i in 1:rdat$parms$nindices){\n survey_fleet_index <- methods::new(Index, nyears)\n survey_fleet_age_comp <- methods::new(AgeComp, nyears, nages)\n survey_fleet_index$index_data <- survey_index[[i]]\n survey_fleet_age_comp$age_comp_data <- survey_agecomp[[i]] * rep(rdat$index.Neff.init[i,], each=rdat$parms$nages)\n \n # survey selectivity\n survey_fleet_selectivity <- new(LogisticSelectivity)\n survey_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$index.sel.ini[(i+1)*(nages+2+4)+nages+1,1] # hardwired for this example\n survey_fleet_selectivity$inflection_point$is_random_effect <- FALSE\n survey_fleet_selectivity$inflection_point$estimated <- TRUE\n survey_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$index.sel.ini[(i+1)*(nages+2+4)+nages+1,1] # hardwired for this example\n survey_fleet_selectivity$slope$is_random_effect <- FALSE\n survey_fleet_selectivity$slope$estimated <- TRUE\n \n survey_fleet <- methods::new(Fleet)\n survey_fleet$is_survey <- TRUE\n survey_fleet$nages <- nages\n survey_fleet$nyears <- nyears\n survey_fleet$estimate_F <- FALSE\n survey_fleet$random_F <- FALSE\n survey_fleet$log_q <- log(rdat$initial.guesses$q.year1.init[i]) \n survey_fleet$estimate_q <- TRUE\n survey_fleet$random_q <- FALSE\n # sd = sqrt(log(cv^2 + 1)), sd is log transformed\n survey_fleet$log_obs_error <- rep(log(sqrt(log(as.numeric(mean(rdat$index.cv[[i]], na.rm=TRUE)^2 + 1)))), nyears)\n survey_fleet$estimate_obs_error <- FALSE\n survey_fleet$SetAgeCompLikelihood(i)\n survey_fleet$SetIndexLikelihood(i)\n survey_fleet$SetSelectivity(survey_fleet_selectivity$get_id())\n survey_fleet$SetObservedIndexData(survey_fleet_index$get_id())\n survey_fleet$SetObservedAgeCompData(survey_fleet_age_comp$get_id())\n}\n\n# Population module\n\n# recruitment\nrecruitment <- methods::new(BevertonHoltRecruitment)\n#methods::show(BevertonHoltRecruitment)\n\nrecruitment$log_sigma_recruit$value <- log(mean(rdat$control.parms$recruit.cv)) # typically enter same value for every year in ASAP\nrecruitment$log_rzero$value <- log(rdat$initial.guesses$SR.inits$SR.scaler.init) # ASAP can enter either R0 or SSB0, need to make sure use R0 in input file\nrecruitment$log_rzero$is_random_effect <- FALSE\nrecruitment$log_rzero$estimated <- TRUE\n# note: do not set steepness exactly equal to 1, use 0.99 instead in ASAP run\nrecruitment$logit_steep$value <- -log(1.0 - rdat$initial.guesses$SR.inits$SR_steepness.init) + log(rdat$initial.guesses$SR.inits$SR_steepness.init - 0.2)\nrecruitment$logit_steep$is_random_effect <- FALSE\nrecruitment$logit_steep$estimated <- FALSE\n\nrecruitment$estimate_log_devs <- TRUE\nrecruitment$log_devs <- rep(1.0, nyears) # set to no deviations (multiplier) to start, just like ASAP\n\n# growth\newaa_growth <- methods::new(EWAAgrowth)\newaa_growth$ages <- ages\n# NOTE: FIMS currently cannot use matrix of WAA, so have to ensure constant WAA over time in ASAP file for now\newaa_growth$weights <- rdat$WAA.mats$WAA.catch.all[1,] \n\n# NOTE: FIMS assumes SSB calculated at the start of the year, so need to adjust ASAP to do so as well for now, need to make timing of SSB calculation part of FIMS later\n\n# maturity\n# NOTE: for now tricking FIMS into thinking age 0 is age 1, so need to adjust A50 for maturity because FIMS calculations use ages 0-5+ instead of 1-6\nmaturity <- new(LogisticMaturity)\nmaturity$inflection_point$value <- 1.8 # hardwired for now, need to figure out a better way than this\nmaturity$inflection_point$is_random_effect <- FALSE\nmaturity$inflection_point$estimated <- FALSE\nmaturity$slope$value <- 4 # hardwired for now, need to figure out a better way than this\nmaturity$slope$is_random_effect <- FALSE\nmaturity$slope$estimated <- FALSE\n\n# population\npopulation <- new(Population)\npopulation$log_M <- log(as.numeric(t(rdat$M.age)))\npopulation$estimate_M <- FALSE\npopulation$log_init_naa <- log(rdat$N.age[1,]) # log(rdat$initial.guesses$NAA.year1.init)\npopulation$estimate_init_naa <- FALSE # TRUE , NOTE: fixing at ASAP estimates to test SSB calculations\npopulation$nages <- nages\npopulation$ages <- ages\npopulation$nfleets <- rdat$parms$nfleets + rdat$parms$nindices # fleets plus surveys\npopulation$nseasons <- nseasons\npopulation$nyears <- nyears\n#population$prop_female <- 1.0 # ASAP assumption\n\npopulation$SetMaturity(maturity$get_id())\npopulation$SetGrowth(ewaa_growth$get_id())\npopulation$SetRecruitment(recruitment$get_id())\n\n# make FIMS model\nsucess <- CreateTMBModel()\nparameters <- list(p = get_fixed())\nobj <- MakeADFun(data = list(), parameters, DLL = \"FIMS\", silent = TRUE)\n\n\n# fitting the model\nopt <- nlminb(start=obj$par, objective=obj$fn, gradient=obj$gr,\n control = list(eval.max = 8000, iter.max = 800))\n# method = \"BFGS\",\n# control = list(maxit=1000000, reltol = 1e-15))\n#print(opt)\n\n\n#max(abs(obj$gr())) # from Cole, can use TMBhelper::fit_tmb to get val to <1e-10\n\n#opt <- TMBhelper::fit_tmb(obj, newtonsteps=3, quiet = TRUE) # don't understand why quiet flag does not work in Quarto\n\n#max(abs(obj$gr()))\n\nsdr <- TMB::sdreport(obj)\nsdr_fixed <- summary(sdr, \"fixed\")\nreport <- obj$report(obj$env$last.par.best)\n\n### Plotting\n\nmycols <- c(\"FIMS\" = \"blue\", \"ASAP\" = \"red\", \"ASAP_orig\" = \"darkgreen\")\n\nfor (i in 1:rdat$parms$nindices){\n index_results <- data.frame(\n survey = i,\n year = years,\n observed = rdat$index.obs[[i]],\n FIMS = report$exp_index[[rdat$parms$nfleet+i]],\n ASAP = rdat$index.pred[[i]]\n )\n if (i==1){\n allinds_results <- index_results\n }else{\n allinds_results <- rbind(allinds_results, index_results)\n }\n}\n#print(allinds_results)\n\ncomp_index <- ggplot(allinds_results, aes(x = year, y = observed)) +\n geom_point() +\n geom_line(aes(x = year, y = FIMS), color = \"blue\") +\n geom_line(aes(x = year, y = ASAP), color = \"red\") +\n facet_wrap(~survey, scales = \"free_y\", nrow = 2) +\n xlab(\"Year\") +\n ylab(\"Index\") +\n ggtitle(\"Blue=FIMS, Red=ASAP\") +\n theme_bw()\n#print(comp_index)\n\ncatch_results <- data.frame(\n observed = fishing_fleet_index$index_data,\n FIMS = report$exp_index[[1]],\n ASAP = as.numeric(rdat$catch.pred[1,])\n)\n#print(catch_results)\n\ncomp_catch <- ggplot(catch_results, aes(x = years, y = observed)) +\n geom_point() +\n xlab(\"Year\") +\n ylab(\"Catch (mt)\") +\n geom_line(aes(x = years, y = FIMS), color = \"blue\") +\n geom_line(aes(x = years, y = ASAP), color = \"red\") +\n ggtitle(\"Blue=FIMS, Red=ASAP\") +\n theme_bw()\n#print(comp_catch)\n\npop_results <- data.frame(\n Year = c(years, max(years)+1, years, years, years, years, max(years)+1, years),\n Metric = c(rep(\"SSB\", 2*nyears+1), rep(\"F_mort\", 2*nyears), rep(\"Recruitment\", 2*nyears+1)),\n Model = c(rep(\"FIMS\", nyears+1), rep(\"ASAP\", nyears), rep(c(\"FIMS\", \"ASAP\"), each=nyears), \n rep(\"FIMS\", nyears+1), rep(\"ASAP\", nyears)),\n Value = c(report$ssb[[1]], rdat$SSB, report$F_mort[[1]], rdat$F.report, report$recruitment[[1]], as.numeric(rdat$N.age[,1]))\n)\n#print(pop_results)\n\n# ggplot(filter(pop_results, Year <=2019), aes(x=Year, y=Value, color=Model)) +\n# geom_line() +\n# facet_wrap(~Metric, ncol=1, scales = \"free_y\") +\n# theme_bw() +\n# scale_color_manual(values = mycols)\n\norig_years <- seq(orig$parms$styr, orig$parms$endyr)\norig_pop_results <- data.frame(\n Year = rep(orig_years, 3),\n Metric = rep(c(\"SSB\", \"F_mort\", \"Recruitment\"), each = length(orig_years)),\n Model = \"ASAP_orig\",\n Value = c(orig$SSB, orig$F.report, as.numeric(orig$N.age[,1]))\n)\n\npop_results_3 <- rbind(pop_results, orig_pop_results)\n#print(pop_results_3)\n\n# ggplot(filter(pop_results_3, Year <=2019), aes(x=Year, y=Value, color=Model)) +\n# geom_line() +\n# facet_wrap(~Metric, ncol=1, scales = \"free_y\") +\n# theme_bw() +\n# scale_color_manual(values = mycols)\n\ncomp_FRSSB3 <- ggplot(pop_results_3, aes(x=Year, y=Value, color=Model)) +\n geom_line() +\n facet_wrap(~Metric, ncol=1, scales = \"free_y\") +\n theme_bw() +\n scale_color_manual(values = mycols)\n#print(comp_FRSSB3)\n\nFIMS_naa_results <- data.frame(\n Year = rep(c(years, max(years)+1), each = nages),\n Age = rep(ages, nyears+1),\n Metric = \"NAA\",\n Model = \"FIMS\",\n Value = report$naa[[1]]\n)\n\nASAP_naa_results <- data.frame(\n Year = rep(years, each = nages),\n Age = rep(ages, nyears),\n Metric = \"NAA\",\n Model = \"ASAP\",\n Value = as.numeric(t(rdat$N.age))\n)\n\norig_naa_results <- data.frame(\n Year = rep(orig_years, each = nages),\n Age = rep(ages, length(orig_years)),\n Metric = \"NAA\",\n Model = \"ASAP_orig\",\n Value = as.numeric(t(orig$N.age))\n)\nnaa_results <- rbind(FIMS_naa_results, ASAP_naa_results, orig_naa_results)\n#print(naa_results)\n\n# ggplot(filter(naa_results, Year <= 2019), aes(x=Year, y=Value, color=Model)) +\n# geom_line() +\n# facet_wrap(~Age, ncol=1, scales = \"free_y\") +\n# ylab(\"NAA\") +\n# theme_bw() +\n# scale_color_manual(values = mycols)\n\ncomp_naa2 <- ggplot(filter(naa_results, Year <= 2019, Model %in% c(\"ASAP\", \"FIMS\")), aes(x=Year, y=Value, color=Model)) +\n geom_line() +\n facet_wrap(~Age, ncol=1, scales = \"free_y\") +\n ylab(\"NAA\") +\n theme_bw() +\n scale_color_manual(values = mycols)\n#print(comp_naa2)\n\n# ggplot(filter(naa_results, Year == 1973, Model %in% c(\"ASAP\", \"FIMS\")), aes(x=Age, y=Value, color=Model)) +\n# geom_line() +\n# ylab(\"NAA in Year 1\") +\n# theme_bw() +\n# scale_color_manual(values = mycols)\n\n\nsaveplots <- TRUE\nif(saveplots){\n ggsave(filename = \"figures/NEFSC_YT_compare_index.png\", plot = comp_index, width = 4, height = 4, units = \"in\")\n ggsave(filename = \"figures/NEFSC_YT_compare_catch.png\", plot = comp_catch, width = 4, height = 4, units = \"in\")\n ggsave(filename = \"figures/NEFSC_YT_compare_FRSSB3.png\", plot = comp_FRSSB3, width = 5, height = 6.5, units = \"in\")\n ggsave(filename = \"figures/NEFSC_YT_compare_NAA2.png\", plot = comp_naa2, width = 5, height = 6.5, units = \"in\")\n}", + "text": "Script that sets up and runs the model\n\n\nCode\n# clear memory\nclear()\n\n\nNULL\n\n\nCode\n# read the ASAP rdat files\nrdat <- dget(file.path(\"data_files\", \"NEFSC_YT_SIMPLIFIED.RDAT\")) # to be used in FIMS, lots of modifications from original\norig <- dget(file.path(\"data_files\", \"NEFSC_YT_ORIGINAL.RDAT\")) # where started before modifications for use in FIMS\n\n# function to create equivalent of data_mile1, basic catch and survey data\n# need to think about how to deal with multiple fleets and indices - only use 1 of each for now\nget_asap_data <- function(rdat){\n res <- data.frame(type = character(),\n name = character(),\n age = integer(),\n datestart = character(),\n dateend = character(),\n value = double(),\n unit = character(),\n uncertainty = double())\n \n landings <- data.frame(type = \"landings\",\n name = \"fleet1\",\n age = NA,\n datestart = paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-01-01\"),\n dateend = paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-12-31\"),\n value = as.numeric(rdat$catch.obs[1,]),\n unit = \"mt\",\n uncertainty = rdat$control.parms$catch.tot.cv[,1])\n \n # loop over all indices\n for (i in 1:rdat$parms$nindices){\n index <- data.frame(type = \"index\",\n name = paste0(\"survey\", i),\n age = NA,\n datestart = paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-01-01\"),\n dateend = paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-12-31\"),\n value = as.numeric(rdat$index.obs[[i]]),\n unit = \"\",\n uncertainty = rdat$index.cv[[i]])\n if (i == 1){\n allinds <- index\n }else{\n allinds <- rbind(allinds, index)\n }\n }\n \n catchage <- data.frame(type = \"age\",\n name = \"fleet1\",\n age = rep(seq(1,rdat$parms$nages), rdat$parms$nyears),\n datestart = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-01-01\"), each=rdat$parms$nages),\n dateend = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-12-31\"), each=rdat$parms$nages),\n value = as.numeric(t(rdat$catch.comp.mats$catch.fleet1.ob)),\n unit = \"\",\n uncertainty = rep(rdat$fleet.catch.Neff.init[1,], each=rdat$parms$nages))\n \n # loop over all indices\n for (i in 1:rdat$parms$nindices){\n indexage <- data.frame(type = \"age\",\n name = paste0(\"survey\", i),\n age = rep(seq(1,rdat$parms$nages), rdat$parms$nyears),\n datestart = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-01-01\"), each=rdat$parms$nages),\n dateend = rep(paste0(seq(rdat$parms$styr, rdat$parms$endyr), \"-12-31\"), each=rdat$parms$nages),\n value = as.numeric(t(rdat$index.comp.mats[[i*2-1]])),\n unit = \"\",\n uncertainty = rep(rdat$index.Neff.init[i,], each=rdat$parms$nages))\n if (i == 1){\n allindsage <- indexage\n }else{\n allindsage <- rbind(allindsage, indexage)\n }\n }\n \n res <- rbind(res, landings, allinds, catchage, allindsage)\n return(res)\n}\n\nmydat <- get_asap_data(rdat)\n\nmyfimsframe <- FIMS::FIMSFrame(mydat)\n#str(myfimsframe)\n\n# define the dimensions\nnyears <- rdat$parms$nyears\nyears <- seq(rdat$parms$styr, rdat$parms$endyr)\nnseasons <- 1 # ASAP only has one season\nnages <- rdat$parms$nages\nages <- 1:nages # ASAP starts at age 1\n\n\n# set up FIMS data objects\nage_frame <- FIMS::FIMSFrame(mydat)\n\nfishery_catch <- FIMS::m_landings(age_frame)\nfishery_agecomp <- FIMS::m_agecomp(age_frame, \"fleet1\")\nsurvey_index <- list()\nsurvey_agecomp <- list()\nfor (i in 1:rdat$parms$nindices){\n survey_index[[i]] <- FIMS::m_index(age_frame, paste0(\"survey\", i))\n survey_agecomp[[i]] <- FIMS::m_agecomp(age_frame, paste0(\"survey\", i))\n}\n\n# eventually change to allow multiple fishing fleets similar to multiple indices - only using 1 fishing fleet for now\nfishing_fleet_index <- methods::new(Index, nyears)\nfishing_fleet_age_comp <- methods::new(AgeComp, nyears, nages)\nfishing_fleet_index$index_data <- fishery_catch\nfishing_fleet_age_comp$age_comp_data <- fishery_agecomp * rep(rdat$fleet.catch.Neff.init[1,], each=rdat$parms$nages)\n\n\n# fleet selectivity\n#methods::show(LogisticSelectivity)\nfishing_fleet_selectivity <- methods::new(LogisticSelectivity)\nfishing_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$fleet.sel.ini[nages+1,1] # hardwired to assume only 1 fleet and logistic selectivity used\nfishing_fleet_selectivity$inflection_point$is_random_effect <- FALSE\nfishing_fleet_selectivity$inflection_point$estimated <- TRUE\nfishing_fleet_selectivity$slope$value <- rdat$sel.input.mats$fleet.sel.ini[nages+2,1] # hardwired to assume only 1 fleet and logistic selectivity used\nfishing_fleet_selectivity$slope$is_random_effect <- FALSE\nfishing_fleet_selectivity$slope$estimated <- TRUE\n\n# create fleet object\nfishing_fleet <- methods::new(Fleet)\nfishing_fleet$nages <- nages\nfishing_fleet$nyears <- nyears\nfishing_fleet$log_Fmort <- log(rep(rdat$initial.guesses$Fmult.year1.init[1], nyears)) # ASAP assumes Fmult devs = 0\nfishing_fleet$estimate_F <- TRUE\nfishing_fleet$random_F <- FALSE\nfishing_fleet$log_q <- log(rdat$initial.guesses$q.year1.init[1])\nfishing_fleet$estimate_q <- FALSE\nfishing_fleet$random_q <- FALSE\nfishing_fleet$log_obs_error <- rep(log(sqrt(log(as.numeric(mean(rdat$control.parms$catch.tot.cv[,1], na.rm=TRUE)^2) + 1))), nyears)\nfishing_fleet$estimate_obs_error <- FALSE\n# Next two lines not currently used by FIMS\nfishing_fleet$SetAgeCompLikelihood(1)\nfishing_fleet$SetIndexLikelihood(1)\n# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above\nfishing_fleet$SetObservedIndexData(fishing_fleet_index$get_id()) \nfishing_fleet$SetObservedAgeCompData(fishing_fleet_age_comp$get_id())\nfishing_fleet$SetSelectivity(fishing_fleet_selectivity$get_id())\n\n# survey module now can handle multiple indices\nfor (i in 1:rdat$parms$nindices){\n survey_fleet_index <- methods::new(Index, nyears)\n survey_fleet_age_comp <- methods::new(AgeComp, nyears, nages)\n survey_fleet_index$index_data <- survey_index[[i]]\n survey_fleet_age_comp$age_comp_data <- survey_agecomp[[i]] * rep(rdat$index.Neff.init[i,], each=rdat$parms$nages)\n \n # survey selectivity\n survey_fleet_selectivity <- new(LogisticSelectivity)\n survey_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$index.sel.ini[(i+1)*(nages+2+4)+nages+1,1] # hardwired for this example\n survey_fleet_selectivity$inflection_point$is_random_effect <- FALSE\n survey_fleet_selectivity$inflection_point$estimated <- TRUE\n survey_fleet_selectivity$inflection_point$value <- rdat$sel.input.mats$index.sel.ini[(i+1)*(nages+2+4)+nages+1,1] # hardwired for this example\n survey_fleet_selectivity$slope$is_random_effect <- FALSE\n survey_fleet_selectivity$slope$estimated <- TRUE\n \n survey_fleet <- methods::new(Fleet)\n survey_fleet$is_survey <- TRUE\n survey_fleet$nages <- nages\n survey_fleet$nyears <- nyears\n survey_fleet$estimate_F <- FALSE\n survey_fleet$random_F <- FALSE\n survey_fleet$log_q <- log(rdat$initial.guesses$q.year1.init[i]) \n survey_fleet$estimate_q <- TRUE\n survey_fleet$random_q <- FALSE\n # sd = sqrt(log(cv^2 + 1)), sd is log transformed\n survey_fleet$log_obs_error <- rep(log(sqrt(log(as.numeric(mean(rdat$index.cv[[i]], na.rm=TRUE)^2 + 1)))), nyears)\n survey_fleet$estimate_obs_error <- FALSE\n survey_fleet$SetAgeCompLikelihood(i)\n survey_fleet$SetIndexLikelihood(i)\n survey_fleet$SetSelectivity(survey_fleet_selectivity$get_id())\n survey_fleet$SetObservedIndexData(survey_fleet_index$get_id())\n survey_fleet$SetObservedAgeCompData(survey_fleet_age_comp$get_id())\n}\n\n# Population module\n\n# recruitment\nrecruitment <- methods::new(BevertonHoltRecruitment)\n#methods::show(BevertonHoltRecruitment)\n\nrecruitment$log_sigma_recruit$value <- log(mean(rdat$control.parms$recruit.cv)) # typically enter same value for every year in ASAP\nrecruitment$log_rzero$value <- log(rdat$initial.guesses$SR.inits$SR.scaler.init) # ASAP can enter either R0 or SSB0, need to make sure use R0 in input file\nrecruitment$log_rzero$is_random_effect <- FALSE\nrecruitment$log_rzero$estimated <- TRUE\n# note: do not set steepness exactly equal to 1, use 0.99 instead in ASAP run\nrecruitment$logit_steep$value <- -log(1.0 - rdat$initial.guesses$SR.inits$SR_steepness.init) + log(rdat$initial.guesses$SR.inits$SR_steepness.init - 0.2)\nrecruitment$logit_steep$is_random_effect <- FALSE\nrecruitment$logit_steep$estimated <- FALSE\n\nrecruitment$estimate_log_devs <- TRUE\nrecruitment$log_devs <- rep(1.0, nyears) # set to no deviations (multiplier) to start, just like ASAP\n\n# growth\newaa_growth <- methods::new(EWAAgrowth)\newaa_growth$ages <- ages\n# NOTE: FIMS currently cannot use matrix of WAA, so have to ensure constant WAA over time in ASAP file for now\newaa_growth$weights <- rdat$WAA.mats$WAA.catch.all[1,] \n\n# NOTE: FIMS assumes SSB calculated at the start of the year, so need to adjust ASAP to do so as well for now, need to make timing of SSB calculation part of FIMS later\n\n# maturity\n# NOTE: for now tricking FIMS into thinking age 0 is age 1, so need to adjust A50 for maturity because FIMS calculations use ages 0-5+ instead of 1-6\nmaturity <- new(LogisticMaturity)\nmaturity$inflection_point$value <- 1.8 # hardwired for now, need to figure out a better way than this\nmaturity$inflection_point$is_random_effect <- FALSE\nmaturity$inflection_point$estimated <- FALSE\nmaturity$slope$value <- 4 # hardwired for now, need to figure out a better way than this\nmaturity$slope$is_random_effect <- FALSE\nmaturity$slope$estimated <- FALSE\n\n# population\npopulation <- new(Population)\npopulation$log_M <- log(as.numeric(t(rdat$M.age)))\npopulation$estimate_M <- FALSE\npopulation$log_init_naa <- log(rdat$N.age[1,]) # log(rdat$initial.guesses$NAA.year1.init)\npopulation$estimate_init_naa <- FALSE # TRUE , NOTE: fixing at ASAP estimates to test SSB calculations\npopulation$nages <- nages\npopulation$ages <- ages\npopulation$nfleets <- rdat$parms$nfleets + rdat$parms$nindices # fleets plus surveys\npopulation$nseasons <- nseasons\npopulation$nyears <- nyears\n#population$prop_female <- 1.0 # ASAP assumption\n\npopulation$SetMaturity(maturity$get_id())\npopulation$SetGrowth(ewaa_growth$get_id())\npopulation$SetRecruitment(recruitment$get_id())\n\n# make FIMS model\nsucess <- CreateTMBModel()\nparameters <- list(p = get_fixed())\nobj <- MakeADFun(data = list(), parameters, DLL = \"FIMS\", silent = TRUE)\n\n\n# fitting the model\nopt <- nlminb(start=obj$par, objective=obj$fn, gradient=obj$gr,\n control = list(eval.max = 8000, iter.max = 800))\n# method = \"BFGS\",\n# control = list(maxit=1000000, reltol = 1e-15))\n#print(opt)\n\n\n#max(abs(obj$gr())) # from Cole, can use TMBhelper::fit_tmb to get val to <1e-10\n\n#opt <- TMBhelper::fit_tmb(obj, newtonsteps=3, quiet = TRUE) # don't understand why quiet flag does not work in Quarto\n\n#max(abs(obj$gr()))\n\nsdr <- TMB::sdreport(obj)\nsdr_fixed <- summary(sdr, \"fixed\")\nreport <- obj$report(obj$env$last.par.best)\n\n### Plotting\n\nmycols <- c(\"FIMS\" = \"blue\", \"ASAP\" = \"red\", \"ASAP_orig\" = \"darkgreen\")\n\nfor (i in 1:rdat$parms$nindices){\n index_results <- data.frame(\n survey = i,\n year = years,\n observed = rdat$index.obs[[i]],\n FIMS = report$exp_index[[rdat$parms$nfleet+i]],\n ASAP = rdat$index.pred[[i]]\n )\n if (i==1){\n allinds_results <- index_results\n }else{\n allinds_results <- rbind(allinds_results, index_results)\n }\n}\n#print(allinds_results)\n\ncomp_index <- ggplot(allinds_results, aes(x = year, y = observed)) +\n geom_point() +\n geom_line(aes(x = year, y = FIMS), color = \"blue\") +\n geom_line(aes(x = year, y = ASAP), color = \"red\") +\n facet_wrap(~survey, scales = \"free_y\", nrow = 2) +\n xlab(\"Year\") +\n ylab(\"Index\") +\n ggtitle(\"Blue=FIMS, Red=ASAP\") +\n theme_bw()\n#print(comp_index)\n\ncatch_results <- data.frame(\n observed = fishing_fleet_index$index_data,\n FIMS = report$exp_index[[1]],\n ASAP = as.numeric(rdat$catch.pred[1,])\n)\n#print(catch_results)\n\ncomp_catch <- ggplot(catch_results, aes(x = years, y = observed)) +\n geom_point() +\n xlab(\"Year\") +\n ylab(\"Catch (mt)\") +\n geom_line(aes(x = years, y = FIMS), color = \"blue\") +\n geom_line(aes(x = years, y = ASAP), color = \"red\") +\n ggtitle(\"Blue=FIMS, Red=ASAP\") +\n theme_bw()\n#print(comp_catch)\n\npop_results <- data.frame(\n Year = c(years, max(years)+1, years, years, years, years, max(years)+1, years),\n Metric = c(rep(\"SSB\", 2*nyears+1), rep(\"F_mort\", 2*nyears), rep(\"Recruitment\", 2*nyears+1)),\n Model = c(rep(\"FIMS\", nyears+1), rep(\"ASAP\", nyears), rep(c(\"FIMS\", \"ASAP\"), each=nyears), \n rep(\"FIMS\", nyears+1), rep(\"ASAP\", nyears)),\n Value = c(report$ssb[[1]], rdat$SSB, report$F_mort[[1]], rdat$F.report, report$recruitment[[1]], as.numeric(rdat$N.age[,1]))\n)\n#print(pop_results)\n\n# ggplot(filter(pop_results, Year <=2019), aes(x=Year, y=Value, color=Model)) +\n# geom_line() +\n# facet_wrap(~Metric, ncol=1, scales = \"free_y\") +\n# theme_bw() +\n# scale_color_manual(values = mycols)\n\norig_years <- seq(orig$parms$styr, orig$parms$endyr)\norig_pop_results <- data.frame(\n Year = rep(orig_years, 3),\n Metric = rep(c(\"SSB\", \"F_mort\", \"Recruitment\"), each = length(orig_years)),\n Model = \"ASAP_orig\",\n Value = c(orig$SSB, orig$F.report, as.numeric(orig$N.age[,1]))\n)\n\npop_results_3 <- rbind(pop_results, orig_pop_results)\n#print(pop_results_3)\n\n# ggplot(filter(pop_results_3, Year <=2019), aes(x=Year, y=Value, color=Model)) +\n# geom_line() +\n# facet_wrap(~Metric, ncol=1, scales = \"free_y\") +\n# theme_bw() +\n# scale_color_manual(values = mycols)\n\ncomp_FRSSB3 <- ggplot(pop_results_3, aes(x=Year, y=Value, color=Model)) +\n geom_line() +\n facet_wrap(~Metric, ncol=1, scales = \"free_y\") +\n theme_bw() +\n scale_color_manual(values = mycols)\n#print(comp_FRSSB3)\n\nFIMS_naa_results <- data.frame(\n Year = rep(c(years, max(years)+1), each = nages),\n Age = rep(ages, nyears+1),\n Metric = \"NAA\",\n Model = \"FIMS\",\n Value = report$naa[[1]]\n)\n\nASAP_naa_results <- data.frame(\n Year = rep(years, each = nages),\n Age = rep(ages, nyears),\n Metric = \"NAA\",\n Model = \"ASAP\",\n Value = as.numeric(t(rdat$N.age))\n)\n\norig_naa_results <- data.frame(\n Year = rep(orig_years, each = nages),\n Age = rep(ages, length(orig_years)),\n Metric = \"NAA\",\n Model = \"ASAP_orig\",\n Value = as.numeric(t(orig$N.age))\n)\nnaa_results <- rbind(FIMS_naa_results, ASAP_naa_results, orig_naa_results)\n#print(naa_results)\n\n# ggplot(filter(naa_results, Year <= 2019), aes(x=Year, y=Value, color=Model)) +\n# geom_line() +\n# facet_wrap(~Age, ncol=1, scales = \"free_y\") +\n# ylab(\"NAA\") +\n# theme_bw() +\n# scale_color_manual(values = mycols)\n\ncomp_naa2 <- ggplot(filter(naa_results, Year <= 2019, Model %in% c(\"ASAP\", \"FIMS\")), aes(x=Year, y=Value, color=Model)) +\n geom_line() +\n facet_wrap(~Age, ncol=1, scales = \"free_y\") +\n ylab(\"NAA\") +\n theme_bw() +\n scale_color_manual(values = mycols)\n#print(comp_naa2)\n\n# ggplot(filter(naa_results, Year == 1973, Model %in% c(\"ASAP\", \"FIMS\")), aes(x=Age, y=Value, color=Model)) +\n# geom_line() +\n# ylab(\"NAA in Year 1\") +\n# theme_bw() +\n# scale_color_manual(values = mycols)\n\n\nsaveplots <- TRUE\nif(saveplots){\n ggsave(filename = \"figures/NEFSC_YT_compare_index.png\", plot = comp_index, width = 4, height = 4, units = \"in\")\n ggsave(filename = \"figures/NEFSC_YT_compare_catch.png\", plot = comp_catch, width = 4, height = 4, units = \"in\")\n ggsave(filename = \"figures/NEFSC_YT_compare_FRSSB3.png\", plot = comp_FRSSB3, width = 5, height = 6.5, units = \"in\")\n ggsave(filename = \"figures/NEFSC_YT_compare_NAA2.png\", plot = comp_naa2, width = 5, height = 6.5, units = \"in\")\n}", "crumbs": [ "NEFSC yellowtail flounder case study" ] @@ -599,7 +599,7 @@ "href": "content/NEFSC-yellowtail.html#what-features-are-most-important-to-add-based-on-this-case-study", "title": "NEFSC Case Study Southern New England-Mid Atlantic Yellowtail Flounder", "section": "What features are most important to add based on this case study?", - "text": "What features are most important to add based on this case study?\n\nMissing values, would allow inclusion of the other 3 indices (too many missing years to fill for this example)\n\n\n\nCode\n# Clear C++ objects from memory\nclear()", + "text": "What features are most important to add based on this case study?\n\nMissing values, would allow inclusion of the other 3 indices (too many missing years to fill for this example)\n\n\n\nCode\n# Clear C++ objects from memory\nclear()\n\n\nNULL", "crumbs": [ "NEFSC yellowtail flounder case study" ] @@ -689,7 +689,7 @@ "href": "content/SEFSC-scamp.html", "title": "FIMS Case Study of South Atlantic Scamp (SEFSC)", "section": "", - "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: South Atlantic scamp grouper\n\nRegion: SEFSC\n\nAnalyst: Kyle Shertzer\n\nAnalyses completed on 1 July 2024", + "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: South Atlantic scamp grouper\n\nRegion: SEFSC\n\nAnalyst: Kyle Shertzer\n\nAnalyses completed on 1 July 2024", "crumbs": [ "SEFSC scamp case study" ] @@ -699,7 +699,7 @@ "href": "content/SEFSC-scamp.html#setup-description", "title": "FIMS Case Study of South Atlantic Scamp (SEFSC)", "section": "", - "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: South Atlantic scamp grouper\n\nRegion: SEFSC\n\nAnalyst: Kyle Shertzer\n\nAnalyses completed on 1 July 2024", + "text": "Code\n# Names of required packages\npackages <- c(\"dplyr\", \"tidyr\", \"ggplot2\", \"TMB\", \"reshape2\", \"here\", \"remotes\", \"lubridate\")\n\n# Install packages not yet installed\ninstalled_packages <- packages %in% rownames(installed.packages())\nif (any(installed_packages == FALSE)) {\n install.packages(packages[!installed_packages], repos = \"http://cran.us.r-project.org\")\n}\n\nremotes::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\nremotes::install_github(\"NOAA-FIMS/FIMS\")\nremotes::install_github(\"r4ss/r4ss\")\n\n# Load packages\ninvisible(lapply(packages, library, character.only = TRUE))\n\nlibrary(FIMS)\nlibrary(TMBhelper)\n\nR_version <- version$version.string\nTMB_version <- packageDescription(\"TMB\")$Version\nFIMS_commit <- substr(packageDescription(\"FIMS\")$GithubSHA1, 1, 7)\n\n\n\n\nCode\ntheme_set(theme_bw())\n\n\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: South Atlantic scamp grouper\n\nRegion: SEFSC\n\nAnalyst: Kyle Shertzer\n\nAnalyses completed on 1 July 2024", "crumbs": [ "SEFSC scamp case study" ] @@ -719,7 +719,7 @@ "href": "content/SEFSC-scamp.html#add-your-script-that-sets-up-and-runs-the-model", "title": "FIMS Case Study of South Atlantic Scamp (SEFSC)", "section": "Add your script that sets up and runs the model", - "text": "Add your script that sets up and runs the model\n\n\nCode\n###############################################\n# South Atlantic scamp grouper example assessment\n# Compare output from FIMS and a simplified version of BAM\n##############################################\n\n# clear memory\nclear()\ngraphics.off()\n\nsca <- dget(\"data_files/scamp32o.rdat\") # get scamp data and output from simplified version of BAM\n\n# Set dimensions\nstyr <- dplyr::first(sca$t.series$year)\nendyr <- dplyr::last(sca$t.series$year)\nyears <- styr:endyr\nnyears <- endyr - styr + 1 # the number of years which we have data for\nnseasons <- 1 # the number of seasons in each year. FIMS currently defaults to 1\nages <- sca$a.series$age # age vector.\nnages <- length(ages) # the number of age groups.\n\n# Prepare data; initialize all values with -999 (missing)\n# fleet1 is commercial, fleet2 is recreational\nfleet1_landings <- fleet2_landings <- rep(-999, nyears)\nfleet1_landings_cv <- fleet2_landings_cv <- rep(-999, nyears)\nsurvey_index <- rep(-999, nyears)\nsurvey_index_cv <- rep(-999, nyears)\nfleet1_ac <- fleet2_ac <- survey_ac <- matrix(-999, nrow = nyears, ncol = nages)\nfleet1_ac_n <- fleet2_ac_n <- survey_ac_n <- rep(-999, nyears)\n\nfleet1_landings <- sca$t.series$L.COM.ob\nfleet1_landings_cv <- sca$t.series$cv.L.COM\nfleet1_landings_logSD <- log(sqrt(log(1.0 + fleet1_landings_cv^2)))\nfleet2_landings <- sca$t.series$L.REC.ob\nfleet2_landings_cv <- sca$t.series$cv.L.REC\nfleet2_landings_logSD <- log(sqrt(log(1.0 + fleet2_landings_cv^2)))\n\nsurvey_index <- sca$t.series$U.CVT.ob\nsurvey_index <- replace_na(survey_index, -999)\nsurvey_index_cv <- sca$t.series$cv.U.CVT\nsurvey_index_logSD <- log(sqrt(log(1.0 + survey_index_cv^2)))\nsurvey_index_logSD <- replace_na(survey_index_logSD, -999)\nsurvey_index_logSD[nyears - 1] <- -999 # manually replacing the 2020 CV as a missing value\n\n\n# COMMENT: These multinomial entries are not whole numbers and many <1.This is not technically\n# correct, but it does not seem to make a difference based on my testing.\nfleet1_ac_n <- sca$t.series$acomp.COM.n\nfleet1_ac_n <- replace_na(fleet1_ac_n, -999)\nfleet2_ac_n <- sca$t.series$acomp.REC.n\nfleet2_ac_n <- replace_na(fleet2_ac_n, -999)\nsurvey_ac_n <- sca$t.series$acomp.CVT.n\nsurvey_ac_n <- replace_na(survey_ac_n, -999)\n\nfleet1_ac[!is.na(sca$t.series$acomp.COM.n), ] <- sca$comp.mats$acomp.COM.ob * fleet1_ac_n[!is.na(sca$t.series$acomp.COM.n)]\nfleet2_ac[!is.na(sca$t.series$acomp.REC.n), ] <- sca$comp.mats$acomp.REC.ob * fleet2_ac_n[!is.na(sca$t.series$acomp.REC.n)]\nsurvey_ac[!is.na(sca$t.series$acomp.CVT.n), ] <- sca$comp.mats$acomp.CVT.ob * survey_ac_n[!is.na(sca$t.series$acomp.CVT.n)]\n\n\n\n## put data into fims friendly form\nres <- data.frame(\n type = character(),\n name = character(),\n age = integer(),\n datestart = character(),\n dateend = character(),\n value = double(),\n unit = character(),\n uncertainty = double()\n)\n\nfleet1_landings_df <- data.frame(\n type = \"landings\",\n name = \"fleet1\",\n age = NA,\n datestart = paste0(seq(styr, endyr), \"-01-01\"),\n dateend = paste0(seq(styr, endyr), \"-12-31\"),\n value = as.numeric(fleet1_landings),\n unit = \"mt\",\n uncertainty = fleet1_landings_logSD\n)\n\nfleet2_landings_df <- data.frame(\n type = \"landings\",\n name = \"fleet2\",\n age = NA,\n datestart = paste0(seq(styr, endyr), \"-01-01\"),\n dateend = paste0(seq(styr, endyr), \"-12-31\"),\n value = as.numeric(fleet2_landings),\n unit = \"mt\",\n uncertainty = fleet2_landings_logSD\n)\n\nsurvey_index_df <- data.frame(\n type = \"index\",\n name = \"survey1\",\n age = NA,\n datestart = paste0(seq(styr, endyr), \"-01-01\"),\n dateend = paste0(seq(styr, endyr), \"-12-31\"),\n value = as.numeric(survey_index),\n unit = \"\",\n uncertainty = survey_index_logSD\n)\n\nfleet1_ac_df <- data.frame(\n type = \"age\",\n name = \"fleet1\",\n age = rep(seq(1, nages), nyears),\n datestart = rep(paste0(seq(styr, endyr), \"-01-01\"), each = nages),\n dateend = rep(paste0(seq(styr, endyr), \"-12-31\"), each = nages),\n value = as.numeric(t(fleet1_ac)),\n unit = \"\",\n uncertainty = rep(fleet1_ac_n, each = nages)\n)\n\nfleet2_ac_df <- data.frame(\n type = \"age\",\n name = \"fleet2\",\n age = rep(seq(1, nages), nyears),\n datestart = rep(paste0(seq(styr, endyr), \"-01-01\"), each = nages),\n dateend = rep(paste0(seq(styr, endyr), \"-12-31\"), each = nages),\n value = as.numeric(t(fleet2_ac)),\n unit = \"\",\n uncertainty = rep(fleet2_ac_n, each = nages)\n)\n\nsurvey_ac_df <- data.frame(\n type = \"age\",\n name = \"survey1\",\n age = rep(seq(1, nages), nyears),\n datestart = rep(paste0(seq(styr, endyr), \"-01-01\"), each = nages),\n dateend = rep(paste0(seq(styr, endyr), \"-12-31\"), each = nages),\n value = as.numeric(t(survey_ac)),\n unit = \"\",\n uncertainty = rep(survey_ac_n, each = nages)\n)\n\nlandings <- rbind(fleet1_landings_df, fleet2_landings_df)\nindex <- survey_index_df\nagecomps <- rbind(fleet1_ac_df, fleet2_ac_df, survey_ac_df)\n\nres <- rbind(res, landings, index, agecomps)\n\nfims_frame <- FIMS::FIMSFrame(res)\n# COMMENT: m_landings concatenates fleets' landings, and does not take fleet as an argument, as m_index or m_agecomp do\n# This seems error-prone as it requires specifying landings through hard indexing (see lines 221 and 223) \nfims_fleets_landings <- FIMS::m_landings(fims_frame)\nfims_survey1_index <- FIMS::m_index(fims_frame, \"survey1\")\nfims_fleet1_agecomp <- FIMS::m_agecomp(fims_frame, \"fleet1\")\nfims_fleet2_agecomp <- FIMS::m_agecomp(fims_frame, \"fleet2\")\nfims_survey1_agecomp <- FIMS::m_agecomp(fims_frame, \"survey1\")\n\n####################################################################################\n# COMMENT: It's confusing to specify landings as an Index (lines 220 and 222)\nspp_fleet1_landings <- methods::new(Index, nyears)\nspp_fleet1_landings$index_data <- fims_fleets_landings[1:nyears] # NOTE: This poor coding appears necessary bc m_landings doesn't take fleet as an argument\nspp_fleet2_landings <- methods::new(Index, nyears)\nspp_fleet2_landings$index_data <- fims_fleets_landings[(nyears + 1):(2 * nyears)] # NOTE: See note two lines above.\nspp_survey1_index <- methods::new(Index, nyears)\nspp_survey1_index$index_data <- fims_survey1_index\n\nspp_fleet1_ac <- methods::new(AgeComp, nyears, nages)\nspp_fleet1_ac$age_comp_data <- fims_fleet1_agecomp\nspp_fleet2_ac <- methods::new(AgeComp, nyears, nages)\nspp_fleet2_ac$age_comp_data <- fims_fleet2_agecomp\nspp_survey1_ac <- methods::new(AgeComp, nyears, nages)\nspp_survey1_ac$age_comp_data <- fims_survey1_agecomp\n\n####################################################################################\n# set up selectivities for fleets and survey\nspp_fleet1_selectivity <- methods::new(LogisticSelectivity)\nspp_fleet1_selectivity$inflection_point$value <- sca$parm.cons$selpar_A50_COM2[8]\nspp_fleet1_selectivity$inflection_point$is_random_effect <- FALSE\nspp_fleet1_selectivity$inflection_point$estimated <- TRUE\nspp_fleet1_selectivity$slope$value <- sca$parm.cons$selpar_slope_COM2[8]\nspp_fleet1_selectivity$slope$is_random_effect <- FALSE\nspp_fleet1_selectivity$slope$estimated <- TRUE\n\nspp_fleet2_selectivity <- methods::new(LogisticSelectivity)\nspp_fleet2_selectivity$inflection_point$value <- sca$parm.cons$selpar_A50_REC2[8]\nspp_fleet2_selectivity$inflection_point$is_random_effect <- FALSE\nspp_fleet2_selectivity$inflection_point$estimated <- TRUE\nspp_fleet2_selectivity$slope$value <- sca$parm.cons$selpar_slope1_REC2[8]\nspp_fleet2_selectivity$slope$is_random_effect <- FALSE\nspp_fleet2_selectivity$slope$estimated <- TRUE\n\nspp_survey1_selectivity <- methods::new(LogisticSelectivity)\nspp_survey1_selectivity$inflection_point$value <- sca$parm.cons$selpar_A501_CVT[8]\nspp_survey1_selectivity$inflection_point$is_random_effect <- FALSE\nspp_survey1_selectivity$inflection_point$estimated <- TRUE\nspp_survey1_selectivity$slope$value <- sca$parm.cons$selpar_slope1_CVT[8]\nspp_survey1_selectivity$slope$is_random_effect <- FALSE\nspp_survey1_selectivity$slope$estimated <- TRUE\n\n####################################################################################\n# Create the fleet1 object\n# See all fields with show(Fleet1)\nspp_fleet1 <- methods::new(Fleet)\n# Set nyears and nages\nspp_fleet1$nages <- nages\nspp_fleet1$nyears <- nyears\n# Set values for log_Fmort\nspp_fleet1$log_Fmort <- log(sca$t.series$F.COM) # rep(0, nyears)\n# Turn on estimation for F\nspp_fleet1$estimate_F <- TRUE\nspp_fleet1$random_F <- FALSE\nspp_fleet1$log_obs_error <- fleet1_landings_logSD\nspp_fleet1$estimate_obs_error <- FALSE\n# Next two lines not currently used by FIMS\nspp_fleet1$SetAgeCompLikelihood(1)\nspp_fleet1$SetIndexLikelihood(1)\n# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above\nspp_fleet1$SetObservedIndexData(spp_fleet1_landings$get_id())\nspp_fleet1$SetObservedAgeCompData(spp_fleet1_ac$get_id())\nspp_fleet1$SetSelectivity(spp_fleet1_selectivity$get_id())\n\n####################################################################################\n# Create the fleet2 object\n# See all fields with show(fleet2)\nspp_fleet2 <- methods::new(Fleet)\n# Set nyears and nages\nspp_fleet2$nages <- nages\nspp_fleet2$nyears <- nyears\n# Set values for log_Fmort\nspp_fleet2$log_Fmort <- log(sca$t.series$F.REC) # rep(0, nyears)\n# Turn on estimation for F\nspp_fleet2$estimate_F <- TRUE\nspp_fleet2$random_F <- FALSE\nspp_fleet2$log_obs_error <- fleet2_landings_logSD\nspp_fleet2$estimate_obs_error <- FALSE\n# Next two lines not currently used by FIMS\nspp_fleet2$SetAgeCompLikelihood(1)\nspp_fleet2$SetIndexLikelihood(1)\n# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above\nspp_fleet2$SetObservedIndexData(spp_fleet2_landings$get_id())\nspp_fleet2$SetObservedAgeCompData(spp_fleet2_ac$get_id())\nspp_fleet2$SetSelectivity(spp_fleet2_selectivity$get_id())\n\n####################################################################################\n# Create the survey object\nspp_survey1 <- methods::new(Fleet) # COMMENT: it is confusing to specify surveys as \"Fleet\" (line 306)\nspp_survey1$is_survey <- TRUE\nspp_survey1$nages <- nages\nspp_survey1$nyears <- nyears\nspp_survey1$estimate_F <- FALSE\nspp_survey1$random_F <- FALSE\nspp_survey1$log_q <- log(sca$parms$q.CVT)\nspp_survey1$estimate_q <- TRUE\nspp_survey1$random_q <- FALSE\nspp_survey1$log_obs_error <- survey_index_logSD\nspp_survey1$estimate_obs_error <- FALSE\nspp_survey1$SetAgeCompLikelihood(1)\nspp_survey1$SetIndexLikelihood(1)\nspp_survey1$SetSelectivity(spp_survey1_selectivity$get_id())\nspp_survey1$SetObservedIndexData(spp_survey1_index$get_id())\nspp_survey1$SetObservedAgeCompData(spp_survey1_ac$get_id())\n\n####################################################################################\n# Create population\n\n# Recruitment\nrecruitment <- methods::new(BevertonHoltRecruitment)\n# methods::show(BevertonHoltRecruitment)\n\nrecruitment$log_sigma_recruit$value <- log(sca$parm.cons$rec_sigma[8])\nrecruitment$log_rzero$value <- sca$parm.cons$log_R0[8]\nrecruitment$log_rzero$is_random_effect <- FALSE\nrecruitment$log_rzero$estimated <- TRUE\nrecruitment$logit_steep$value <- 0.999 # Scamp used the null recruitment model -log(1.0 - 0.75) + log(0.75 - 0.2)\nrecruitment$logit_steep$is_random_effect <- FALSE\nrecruitment$logit_steep$estimated <- FALSE\n\nrecruitment$estimate_log_devs <- TRUE\nrecruitment$log_devs <- sca$t.series$logR.dev # rep(0, nyears)\n\n# Growth (here, empirical weight at age)\n# NOTE: Use the same units as landings and ssb (here, mt)\newaa_growth <- methods::new(EWAAgrowth)\newaa_growth$ages <- ages\newaa_growth$weights <- sca$a.series$wgt.mt\n\n\n# Maturity\n# NOTE, to match FIMS for a protogynous stock, these maturity values were obtained by fitting a logistic fcn to the age vector,\n# mat.female*prop.female + mat.male*prop.male and then assuming an all female population \n\nmaturity <- new(LogisticMaturity)\nmaturity$inflection_point$value <- 2.254187\nmaturity$inflection_point$is_random_effect <- FALSE\nmaturity$inflection_point$estimated <- FALSE\nmaturity$slope$value <- 1.659077\nmaturity$slope$is_random_effect <- FALSE\nmaturity$slope$estimated <- FALSE\n\n# Population\npopulation <- new(Population)\n\n# M is vector of age1 M X nyrs then age2 M X nyrs\npopulation$log_M <-\n log(as.numeric(matrix(\n rep(sca$a.series$M, each = nyears),\n nrow = nyears\n )))\n\npopulation$estimate_M <- FALSE\npopulation$log_init_naa <- log(sca$N.age[1, ])\npopulation$estimate_init_naa <- FALSE\n# population$proportion_female <- rep(1.0,nages) #For scamp, assuming all females (see maturity note above)\npopulation$nages <- nages\npopulation$ages <- ages\npopulation$nfleets <- 3 # 2 fleets and 1 survey\npopulation$nseasons <- nseasons\npopulation$nyears <- nyears\n\n# Link recruitment, growth, and maturity modules to this new popn module\npopulation$SetMaturity(maturity$get_id())\npopulation$SetGrowth(ewaa_growth$get_id())\npopulation$SetRecruitment(recruitment$get_id())\n\n####################################################################################\n# Put it all together, creating the FIMS model and making the TMB fcn\nsuccess <- CreateTMBModel()\nparameters <- list(p = get_fixed())\nobj <- MakeADFun(data = list(), parameters, DLL = \"FIMS\", silent = TRUE)\n\n# Fitting the model\nopt <- nlminb(obj$par, obj$fn, obj$gr,\n control = list(eval.max = 800, iter.max = 800)\n) # , method = \"BFGS\",\n# control = list(maxit=1000000, reltol = 1e-15))\n\n# print(opt)\n\n\n# TMB reporting\nsdr <- TMB::sdreport(obj)\nsdr_fixed <- summary(sdr, \"fixed\")\nreport <- obj$report(obj$env$last.par.best)\n\n# print(sdr_fixed)\n\n######################################################################\n# Plot results\nlibrary(colorspace)\ncols <- sequential_hcl(5, \"Viridis\")\nout.folder <- \"figures\"\ndir.create(out.folder, showWarnings = FALSE)\nplot.type <- \"png\"\n\nselex.bam.fleet1 <- 1 / (1 + exp(-sca$parm.cons$selpar_slope_COM2[8] * (ages - sca$parm.cons$selpar_A50_COM2[8])))\nselex.fims.fleet1 <- 1 / (1 + exp(-opt$par[2] * (ages - opt$par[1])))\nselex.bam.fleet2 <- 1 / (1 + exp(-sca$parm.cons$selpar_slope1_REC2[8] * (ages - sca$parm.cons$selpar_A50_REC2[8])))\nselex.fims.fleet2 <- 1 / (1 + exp(-opt$par[4] * (ages - opt$par[3])))\nselex.bam.survey <- 1 / (1 + exp(-sca$parm.cons$selpar_slope1_CVT[8] * (ages - sca$parm.cons$selpar_A501_CVT[8])))\nselex.fims.survey <- 1 / (1 + exp(-opt$par[6] * (ages - opt$par[5])))\n\n\nindex_results_allyr <- data.frame(\n yr = styr:endyr,\n observed = spp_survey1_index$index_data,\n fims.expected = report$exp_index[[3]],\n bam.expected = sca$t.series$U.CVT.pr\n)\nindex_results <- index_results_allyr %>% filter(observed != -999.00)\nfleet1_landings_results <- data.frame(\n yr = styr:endyr,\n observed = spp_fleet1_landings$index_data,\n fims.expected = report$exp_index[[1]],\n bam.expected = sca$t.series$L.COM.pr\n)\nfleet2_landings_results <- data.frame(\n yr = styr:endyr,\n observed = spp_fleet2_landings$index_data,\n fims.expected = report$exp_index[[2]],\n bam.expected = sca$t.series$L.REC.pr\n)\n\nfleet1_F_results <- data.frame(\n yr = styr:endyr,\n fims.F.fleet1 = report$F_mort[[1]],\n bam.F.fleet1 = sca$t.series$F.COM\n)\nfleet2_F_results <- data.frame(\n yr = styr:endyr,\n fims.F.fleet2 = report$F_mort[[2]],\n bam.F.fleet2 = sca$t.series$F.REC\n)\n\n# Dropping the last (extra) year from FIMS output, assuming it is a projection yr (not an initialization yr)\nfims.naa <- matrix(report$naa[[1]], ncol = nages, byrow = TRUE)\nfims.naa <- fims.naa[-54, ]\npopn_results <- data.frame(\n yr = styr:endyr,\n fims.ssb = report$ssb[[1]][1:nyears],\n fims.recruits = report$recruitment[[1]][1:nyears] / 1000,\n fims.biomass = report$biomass[[1]][1:nyears],\n fims.abundance = rowSums(fims.naa) / 1000,\n bam.ssb = sca$t.series$SSB,\n bam.recruits = sca$t.series$recruits / 1000,\n bam.biomass = sca$t.series$B,\n bam.abundance = sca$t.series$N / 1000\n)\n\nyr.ind <- 1:nyears\n\nyr.fleet1.ind <- yr.ind[fleet1_ac_n >= 0]\nyr.fleet1.ac <- years[yr.fleet1.ind]\nfims.fleet1.ncaa <- matrix(report$cnaa[[1]], ncol = nages, byrow = TRUE)\nfims.fleet1.ncaa <- fims.fleet1.ncaa[yr.fleet1.ind, ]\nfims.fleet1.caa <- fims.fleet1.ncaa / rowSums(fims.fleet1.ncaa)\nbam.fleet1.caa <- sca$comp.mats$acomp.COM.pr\nobs.fleet1.caa <- sca$comp.mats$acomp.COM.ob\n\nyr.fleet2.ind <- yr.ind[fleet2_ac_n >= 0]\nyr.fleet2.ac <- years[yr.fleet2.ind]\nfims.fleet2.ncaa <- matrix(report$cnaa[[2]], ncol = nages, byrow = TRUE)\nfims.fleet2.ncaa <- fims.fleet2.ncaa[yr.fleet2.ind, ]\nfims.fleet2.caa <- fims.fleet2.ncaa / rowSums(fims.fleet2.ncaa)\nbam.fleet2.caa <- sca$comp.mats$acomp.REC.pr\nobs.fleet2.caa <- sca$comp.mats$acomp.REC.ob\n\nyr.survey.ind <- yr.ind[survey_ac_n >= 0]\nyr.survey.ac <- years[yr.survey.ind]\nfims.survey.ncaa <- matrix(report$cnaa[[3]], ncol = nages, byrow = TRUE)\nfims.survey.ncaa <- fims.survey.ncaa[yr.survey.ind, ]\nfims.survey.caa <- fims.survey.ncaa / rowSums(fims.survey.ncaa)\nbam.survey.caa <- sca$comp.mats$acomp.CVT.pr\nobs.survey.caa <- sca$comp.mats$acomp.CVT.ob\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_tseries_fits.\", plot.type, sep = \"\"), width = 8, height = 10, units=\"in\", res=72)\nmat <- matrix(1:3, ncol = 1)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1)\n\nplot(index_results$yr, index_results$observed,\n ylim = c(0, max(index_results[, -1])),\n pch = 16, col = cols[1], ylab = \"Index\", xlab = \"\"\n)\nlines(index_results$yr, index_results$bam.expected, lwd = 3, col = cols[2])\nlines(index_results$yr, index_results$fims.expected, lwd = 3, col = cols[4])\nlegend(\"topright\",\n legend = c(\"observed\", \"BAM expected\", \"FIMS expected\"),\n pch = c(16, -1, -1), lwd = c(-1, 3, 3), col = c(cols[1], cols[2], cols[4])\n)\n\nplot(fleet1_landings_results$yr, fleet1_landings_results$observed,\n ylim = c(0, max(fleet1_landings_results[, -1])),\n pch = 16, col = cols[1], ylab = \"Fleet1 landings (mt)\", xlab = \"\"\n)\nlines(fleet1_landings_results$yr, fleet1_landings_results$bam.expected, lwd = 3, col = cols[2])\nlines(fleet1_landings_results$yr, fleet1_landings_results$fims.expected, lwd = 3, col = cols[4])\n\nplot(fleet2_landings_results$yr, fleet2_landings_results$observed,\n ylim = c(0, max(fleet2_landings_results[, -1])),\n pch = 16, col = cols[1], ylab = \"Fleet2 landings (mt)\", xlab = \"\"\n)\nlines(fleet2_landings_results$yr, fleet2_landings_results$bam.expected, lwd = 3, col = cols[2])\nlines(fleet2_landings_results$yr, fleet2_landings_results$fims.expected, lwd = 3, col = cols[4])\n\ndev.off()\n\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_tseries_F.\", plot.type, sep = \"\"), width = 8, height = 8, units=\"in\", res=72)\nmat <- matrix(1:2, ncol = 1)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1)\n\nplot(fleet1_F_results$yr, fleet1_F_results$bam.F.fleet1,\n ylim = c(0, max(fleet1_F_results[, -1])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"Fleet 1 F\", xlab = \"\"\n)\nlines(fleet1_F_results$yr, fleet1_F_results$fims.F.fleet1, lwd = 3, col = cols[4])\nlegend(\"topleft\",\n legend = c(\"BAM predicted\", \"FIMS predicted\"),\n lwd = c(3, 3), col = c(cols[2], cols[4])\n)\nplot(fleet2_F_results$yr, fleet2_F_results$bam.F.fleet2,\n ylim = c(0, max(fleet2_F_results[, -1])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"Fleet 2 F\", xlab = \"\"\n)\nlines(fleet2_F_results$yr, fleet2_F_results$fims.F.fleet2, lwd = 3, col = cols[4])\n\ndev.off()\n\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_selex.\", plot.type, sep = \"\"), width = 8, height = 10, units=\"in\", res=72)\nmat <- matrix(1:3, ncol = 1)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1)\n\nplot(ages, selex.bam.fleet1, lwd = 3, col = cols[2], type = \"l\", xlab = \"\", ylab = \"Fleet1 selectivity\")\nlines(ages, selex.fims.fleet1, lwd = 3, col = cols[4])\nlegend(\"bottomright\",\n legend = c(\"BAM predicted\", \"FIMS predicted\"),\n lwd = c(3, 3), col = c(cols[2], cols[4])\n)\nplot(ages, selex.bam.fleet2, lwd = 3, col = cols[2], type = \"l\", xlab = \"\", ylab = \"Fleet2 selectivity\")\nlines(ages, selex.fims.fleet2, lwd = 3, col = cols[4])\nplot(ages, selex.bam.survey, lwd = 3, col = cols[2], type = \"l\", xlab = \"Age\", ylab = \"Survey selectivity\")\nlines(ages, selex.fims.survey, lwd = 3, col = cols[4])\n\ndev.off()\n\n\n\n######################################################################\n\npng(filename = paste(out.folder, \"/SEFSC_scamp_tseries_popn.\", plot.type, sep = \"\"), width = 8, height = 7, units=\"in\", res=72)\nmat <- matrix(1:4, ncol = 2)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1)\n\nplot(popn_results$yr, popn_results$bam.ssb,\n ylim = c(0, max(popn_results[, c(2, 6)])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"SSB (mt)\", xlab = \"\"\n)\nlines(popn_results$yr, popn_results$fims.ssb, lwd = 3, col = cols[4])\nlegend(\"topleft\",\n legend = c(\"BAM predicted\", \"FIMS predicted\"),\n lwd = c(3, 3), col = c(cols[2], cols[4])\n)\n\nplot(popn_results$yr, popn_results$bam.biomass,\n ylim = c(0, max(popn_results[, c(4, 8)])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"Biomass (mt)\", xlab = \"\"\n)\nlines(popn_results$yr, popn_results$fims.biomass, lwd = 3, col = cols[4])\n\nplot(popn_results$yr, popn_results$bam.recruits,\n ylim = c(0, max(popn_results[, c(3, 7)])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"Recruits (1000s)\", xlab = \"\"\n)\nlines(popn_results$yr, popn_results$fims.recruits, lwd = 3, col = cols[4])\n\nplot(popn_results$yr, popn_results$bam.abundance,\n ylim = c(0, max(popn_results[, c(5, 9)])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"Abundance (1000s)\", xlab = \"\"\n)\nlines(popn_results$yr, popn_results$fims.abundance, lwd = 3, col = cols[4])\n\ndev.off()\n\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_caa_fleet1.\", plot.type, sep = \"\"), width = 8, height = 11, units=\"in\", res=72)\nmat <- matrix(1:18, ncol = 3)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75)\n\nfor (i in 1:nrow(obs.fleet1.caa))\n{\n plot(1:nages, obs.fleet1.caa[i, ], col = cols[1], xlab = \"\", ylab = \"\", pch = 16)\n lines(1:nages, bam.fleet1.caa[i, ], lwd = 3, col = cols[2])\n lines(1:nages, fims.fleet1.caa[i, ], lwd = 3, col = cols[4])\n if (i > 1) legend(\"topright\", legend = yr.fleet1.ac[i], cex = 1, bty = \"n\")\n if (i == 1) {\n legend(\"topright\",\n legend = c(\"Fleet1 Age Comps\", \"observed\", \"BAM expected\", \"FIMS expected\"),\n pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.7\n )\n legend(\"right\", legend = yr.fleet1.ac[i], cex = 1, bty = \"n\")\n }\n}\n\ndev.off()\n\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_caa_fleet2.\", plot.type, sep = \"\"), width = 8, height = 11, units=\"in\", res=72)\n\nmat <- matrix(1:28, ncol = 4)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75)\n\nfor (i in 1:nrow(obs.fleet2.caa))\n{\n plot(1:nages, obs.fleet2.caa[i, ], col = cols[1], xlab = \"\", ylab = \"\", pch = 16)\n lines(1:nages, bam.fleet2.caa[i, ], lwd = 3, col = cols[2])\n lines(1:nages, fims.fleet2.caa[i, ], lwd = 3, col = cols[4])\n if (i > 1) legend(\"topright\", legend = yr.fleet2.ac[i], cex = 1, bty = \"n\")\n if (i == 1) {\n legend(\"topright\",\n legend = c(\"Fleet2 Age Comps\", \"observed\", \"BAM expected\", \"FIMS expected\"),\n pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.5\n )\n legend(\"right\", legend = yr.fleet2.ac[i], cex = 1, bty = \"n\")\n }\n}\n\ndev.off()\n\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_caa_survey.\", plot.type, sep = \"\"), width = 8, height = 11, units=\"in\", res=72)\n\nmat <- matrix(1:30, ncol = 5)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75)\n\nfor (i in 1:nrow(obs.survey.caa))\n{\n plot(1:nages, obs.survey.caa[i, ], col = cols[1], xlab = \"\", ylab = \"\", pch = 16)\n lines(1:nages, bam.survey.caa[i, ], lwd = 3, col = cols[2])\n lines(1:nages, fims.survey.caa[i, ], lwd = 3, col = cols[4])\n if (i > 1) legend(\"topright\", legend = yr.survey.ac[i], cex = 1, bty = \"n\")\n if (i == 1) {\n legend(\"topright\",\n legend = c(\"Survey Age Comps\", \"observed\", \"BAM expected\", \"FIMS expected\"),\n pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.5\n )\n legend(\"right\", legend = yr.survey.ac[i], cex = 1, bty = \"n\")\n }\n}\n\ndev.off()\n\nclear()", + "text": "Add your script that sets up and runs the model\n\n\nCode\n###############################################\n# South Atlantic scamp grouper example assessment\n# Compare output from FIMS and a simplified version of BAM\n##############################################\n\n# clear memory\nclear()\ngraphics.off()\n\nsca <- dget(\"data_files/scamp32o.rdat\") # get scamp data and output from simplified version of BAM\n\n# Set dimensions\nstyr <- dplyr::first(sca$t.series$year)\nendyr <- dplyr::last(sca$t.series$year)\nyears <- styr:endyr\nnyears <- endyr - styr + 1 # the number of years which we have data for\nnseasons <- 1 # the number of seasons in each year. FIMS currently defaults to 1\nages <- sca$a.series$age # age vector.\nnages <- length(ages) # the number of age groups.\n\n# Prepare data; initialize all values with -999 (missing)\n# fleet1 is commercial, fleet2 is recreational\nfleet1_landings <- fleet2_landings <- rep(-999, nyears)\nfleet1_landings_cv <- fleet2_landings_cv <- rep(-999, nyears)\nsurvey_index <- rep(-999, nyears)\nsurvey_index_cv <- rep(-999, nyears)\nfleet1_ac <- fleet2_ac <- survey_ac <- matrix(-999, nrow = nyears, ncol = nages)\nfleet1_ac_n <- fleet2_ac_n <- survey_ac_n <- rep(-999, nyears)\n\nfleet1_landings <- sca$t.series$L.COM.ob\nfleet1_landings_cv <- sca$t.series$cv.L.COM\nfleet1_landings_logSD <- log(sqrt(log(1.0 + fleet1_landings_cv^2)))\nfleet2_landings <- sca$t.series$L.REC.ob\nfleet2_landings_cv <- sca$t.series$cv.L.REC\nfleet2_landings_logSD <- log(sqrt(log(1.0 + fleet2_landings_cv^2)))\n\nsurvey_index <- sca$t.series$U.CVT.ob\nsurvey_index <- replace_na(survey_index, -999)\nsurvey_index_cv <- sca$t.series$cv.U.CVT\nsurvey_index_logSD <- log(sqrt(log(1.0 + survey_index_cv^2)))\nsurvey_index_logSD <- replace_na(survey_index_logSD, -999)\nsurvey_index_logSD[nyears - 1] <- -999 # manually replacing the 2020 CV as a missing value\n\n\n# COMMENT: These multinomial entries are not whole numbers and many <1.This is not technically\n# correct, but it does not seem to make a difference based on my testing.\nfleet1_ac_n <- sca$t.series$acomp.COM.n\nfleet1_ac_n <- replace_na(fleet1_ac_n, -999)\nfleet2_ac_n <- sca$t.series$acomp.REC.n\nfleet2_ac_n <- replace_na(fleet2_ac_n, -999)\nsurvey_ac_n <- sca$t.series$acomp.CVT.n\nsurvey_ac_n <- replace_na(survey_ac_n, -999)\n\nfleet1_ac[!is.na(sca$t.series$acomp.COM.n), ] <- sca$comp.mats$acomp.COM.ob * fleet1_ac_n[!is.na(sca$t.series$acomp.COM.n)]\nfleet2_ac[!is.na(sca$t.series$acomp.REC.n), ] <- sca$comp.mats$acomp.REC.ob * fleet2_ac_n[!is.na(sca$t.series$acomp.REC.n)]\nsurvey_ac[!is.na(sca$t.series$acomp.CVT.n), ] <- sca$comp.mats$acomp.CVT.ob * survey_ac_n[!is.na(sca$t.series$acomp.CVT.n)]\n\n\n\n## put data into fims friendly form\nres <- data.frame(\n type = character(),\n name = character(),\n age = integer(),\n datestart = character(),\n dateend = character(),\n value = double(),\n unit = character(),\n uncertainty = double()\n)\n\nfleet1_landings_df <- data.frame(\n type = \"landings\",\n name = \"fleet1\",\n age = NA,\n datestart = paste0(seq(styr, endyr), \"-01-01\"),\n dateend = paste0(seq(styr, endyr), \"-12-31\"),\n value = as.numeric(fleet1_landings),\n unit = \"mt\",\n uncertainty = fleet1_landings_logSD\n)\n\nfleet2_landings_df <- data.frame(\n type = \"landings\",\n name = \"fleet2\",\n age = NA,\n datestart = paste0(seq(styr, endyr), \"-01-01\"),\n dateend = paste0(seq(styr, endyr), \"-12-31\"),\n value = as.numeric(fleet2_landings),\n unit = \"mt\",\n uncertainty = fleet2_landings_logSD\n)\n\nsurvey_index_df <- data.frame(\n type = \"index\",\n name = \"survey1\",\n age = NA,\n datestart = paste0(seq(styr, endyr), \"-01-01\"),\n dateend = paste0(seq(styr, endyr), \"-12-31\"),\n value = as.numeric(survey_index),\n unit = \"\",\n uncertainty = survey_index_logSD\n)\n\nfleet1_ac_df <- data.frame(\n type = \"age\",\n name = \"fleet1\",\n age = rep(seq(1, nages), nyears),\n datestart = rep(paste0(seq(styr, endyr), \"-01-01\"), each = nages),\n dateend = rep(paste0(seq(styr, endyr), \"-12-31\"), each = nages),\n value = as.numeric(t(fleet1_ac)),\n unit = \"\",\n uncertainty = rep(fleet1_ac_n, each = nages)\n)\n\nfleet2_ac_df <- data.frame(\n type = \"age\",\n name = \"fleet2\",\n age = rep(seq(1, nages), nyears),\n datestart = rep(paste0(seq(styr, endyr), \"-01-01\"), each = nages),\n dateend = rep(paste0(seq(styr, endyr), \"-12-31\"), each = nages),\n value = as.numeric(t(fleet2_ac)),\n unit = \"\",\n uncertainty = rep(fleet2_ac_n, each = nages)\n)\n\nsurvey_ac_df <- data.frame(\n type = \"age\",\n name = \"survey1\",\n age = rep(seq(1, nages), nyears),\n datestart = rep(paste0(seq(styr, endyr), \"-01-01\"), each = nages),\n dateend = rep(paste0(seq(styr, endyr), \"-12-31\"), each = nages),\n value = as.numeric(t(survey_ac)),\n unit = \"\",\n uncertainty = rep(survey_ac_n, each = nages)\n)\n\nlandings <- rbind(fleet1_landings_df, fleet2_landings_df)\nindex <- survey_index_df\nagecomps <- rbind(fleet1_ac_df, fleet2_ac_df, survey_ac_df)\n\nres <- rbind(res, landings, index, agecomps)\n\nfims_frame <- FIMS::FIMSFrame(res)\n# COMMENT: m_landings concatenates fleets' landings, and does not take fleet as an argument, as m_index or m_agecomp do\n# This seems error-prone as it requires specifying landings through hard indexing (see lines 221 and 223) \nfims_fleets_landings <- FIMS::m_landings(fims_frame)\nfims_survey1_index <- FIMS::m_index(fims_frame, \"survey1\")\nfims_fleet1_agecomp <- FIMS::m_agecomp(fims_frame, \"fleet1\")\nfims_fleet2_agecomp <- FIMS::m_agecomp(fims_frame, \"fleet2\")\nfims_survey1_agecomp <- FIMS::m_agecomp(fims_frame, \"survey1\")\n\n####################################################################################\n# COMMENT: It's confusing to specify landings as an Index (lines 220 and 222)\nspp_fleet1_landings <- methods::new(Index, nyears)\nspp_fleet1_landings$index_data <- fims_fleets_landings[1:nyears] # NOTE: This poor coding appears necessary bc m_landings doesn't take fleet as an argument\nspp_fleet2_landings <- methods::new(Index, nyears)\nspp_fleet2_landings$index_data <- fims_fleets_landings[(nyears + 1):(2 * nyears)] # NOTE: See note two lines above.\nspp_survey1_index <- methods::new(Index, nyears)\nspp_survey1_index$index_data <- fims_survey1_index\n\nspp_fleet1_ac <- methods::new(AgeComp, nyears, nages)\nspp_fleet1_ac$age_comp_data <- fims_fleet1_agecomp\nspp_fleet2_ac <- methods::new(AgeComp, nyears, nages)\nspp_fleet2_ac$age_comp_data <- fims_fleet2_agecomp\nspp_survey1_ac <- methods::new(AgeComp, nyears, nages)\nspp_survey1_ac$age_comp_data <- fims_survey1_agecomp\n\n####################################################################################\n# set up selectivities for fleets and survey\nspp_fleet1_selectivity <- methods::new(LogisticSelectivity)\nspp_fleet1_selectivity$inflection_point$value <- sca$parm.cons$selpar_A50_COM2[8]\nspp_fleet1_selectivity$inflection_point$is_random_effect <- FALSE\nspp_fleet1_selectivity$inflection_point$estimated <- TRUE\nspp_fleet1_selectivity$slope$value <- sca$parm.cons$selpar_slope_COM2[8]\nspp_fleet1_selectivity$slope$is_random_effect <- FALSE\nspp_fleet1_selectivity$slope$estimated <- TRUE\n\nspp_fleet2_selectivity <- methods::new(LogisticSelectivity)\nspp_fleet2_selectivity$inflection_point$value <- sca$parm.cons$selpar_A50_REC2[8]\nspp_fleet2_selectivity$inflection_point$is_random_effect <- FALSE\nspp_fleet2_selectivity$inflection_point$estimated <- TRUE\nspp_fleet2_selectivity$slope$value <- sca$parm.cons$selpar_slope1_REC2[8]\nspp_fleet2_selectivity$slope$is_random_effect <- FALSE\nspp_fleet2_selectivity$slope$estimated <- TRUE\n\nspp_survey1_selectivity <- methods::new(LogisticSelectivity)\nspp_survey1_selectivity$inflection_point$value <- sca$parm.cons$selpar_A501_CVT[8]\nspp_survey1_selectivity$inflection_point$is_random_effect <- FALSE\nspp_survey1_selectivity$inflection_point$estimated <- TRUE\nspp_survey1_selectivity$slope$value <- sca$parm.cons$selpar_slope1_CVT[8]\nspp_survey1_selectivity$slope$is_random_effect <- FALSE\nspp_survey1_selectivity$slope$estimated <- TRUE\n\n####################################################################################\n# Create the fleet1 object\n# See all fields with show(Fleet1)\nspp_fleet1 <- methods::new(Fleet)\n# Set nyears and nages\nspp_fleet1$nages <- nages\nspp_fleet1$nyears <- nyears\n# Set values for log_Fmort\nspp_fleet1$log_Fmort <- log(sca$t.series$F.COM) # rep(0, nyears)\n# Turn on estimation for F\nspp_fleet1$estimate_F <- TRUE\nspp_fleet1$random_F <- FALSE\nspp_fleet1$log_obs_error <- fleet1_landings_logSD\nspp_fleet1$estimate_obs_error <- FALSE\n# Next two lines not currently used by FIMS\nspp_fleet1$SetAgeCompLikelihood(1)\nspp_fleet1$SetIndexLikelihood(1)\n# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above\nspp_fleet1$SetObservedIndexData(spp_fleet1_landings$get_id())\nspp_fleet1$SetObservedAgeCompData(spp_fleet1_ac$get_id())\nspp_fleet1$SetSelectivity(spp_fleet1_selectivity$get_id())\n\n####################################################################################\n# Create the fleet2 object\n# See all fields with show(fleet2)\nspp_fleet2 <- methods::new(Fleet)\n# Set nyears and nages\nspp_fleet2$nages <- nages\nspp_fleet2$nyears <- nyears\n# Set values for log_Fmort\nspp_fleet2$log_Fmort <- log(sca$t.series$F.REC) # rep(0, nyears)\n# Turn on estimation for F\nspp_fleet2$estimate_F <- TRUE\nspp_fleet2$random_F <- FALSE\nspp_fleet2$log_obs_error <- fleet2_landings_logSD\nspp_fleet2$estimate_obs_error <- FALSE\n# Next two lines not currently used by FIMS\nspp_fleet2$SetAgeCompLikelihood(1)\nspp_fleet2$SetIndexLikelihood(1)\n# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above\nspp_fleet2$SetObservedIndexData(spp_fleet2_landings$get_id())\nspp_fleet2$SetObservedAgeCompData(spp_fleet2_ac$get_id())\nspp_fleet2$SetSelectivity(spp_fleet2_selectivity$get_id())\n\n####################################################################################\n# Create the survey object\nspp_survey1 <- methods::new(Fleet) # COMMENT: it is confusing to specify surveys as \"Fleet\" (line 306)\nspp_survey1$is_survey <- TRUE\nspp_survey1$nages <- nages\nspp_survey1$nyears <- nyears\nspp_survey1$estimate_F <- FALSE\nspp_survey1$random_F <- FALSE\nspp_survey1$log_q <- log(sca$parms$q.CVT)\nspp_survey1$estimate_q <- TRUE\nspp_survey1$random_q <- FALSE\nspp_survey1$log_obs_error <- survey_index_logSD\nspp_survey1$estimate_obs_error <- FALSE\nspp_survey1$SetAgeCompLikelihood(1)\nspp_survey1$SetIndexLikelihood(1)\nspp_survey1$SetSelectivity(spp_survey1_selectivity$get_id())\nspp_survey1$SetObservedIndexData(spp_survey1_index$get_id())\nspp_survey1$SetObservedAgeCompData(spp_survey1_ac$get_id())\n\n####################################################################################\n# Create population\n\n# Recruitment\nrecruitment <- methods::new(BevertonHoltRecruitment)\n# methods::show(BevertonHoltRecruitment)\n\nrecruitment$log_sigma_recruit$value <- log(sca$parm.cons$rec_sigma[8])\nrecruitment$log_rzero$value <- sca$parm.cons$log_R0[8]\nrecruitment$log_rzero$is_random_effect <- FALSE\nrecruitment$log_rzero$estimated <- TRUE\nrecruitment$logit_steep$value <- 0.999 # Scamp used the null recruitment model -log(1.0 - 0.75) + log(0.75 - 0.2)\nrecruitment$logit_steep$is_random_effect <- FALSE\nrecruitment$logit_steep$estimated <- FALSE\n\nrecruitment$estimate_log_devs <- TRUE\nrecruitment$log_devs <- sca$t.series$logR.dev # rep(0, nyears)\n\n# Growth (here, empirical weight at age)\n# NOTE: Use the same units as landings and ssb (here, mt)\newaa_growth <- methods::new(EWAAgrowth)\newaa_growth$ages <- ages\newaa_growth$weights <- sca$a.series$wgt.mt\n\n\n# Maturity\n# NOTE, to match FIMS for a protogynous stock, these maturity values were obtained by fitting a logistic fcn to the age vector,\n# mat.female*prop.female + mat.male*prop.male and then assuming an all female population \n\nmaturity <- new(LogisticMaturity)\nmaturity$inflection_point$value <- 2.254187\nmaturity$inflection_point$is_random_effect <- FALSE\nmaturity$inflection_point$estimated <- FALSE\nmaturity$slope$value <- 1.659077\nmaturity$slope$is_random_effect <- FALSE\nmaturity$slope$estimated <- FALSE\n\n# Population\npopulation <- new(Population)\n\n# M is vector of age1 M X nyrs then age2 M X nyrs\npopulation$log_M <-\n log(as.numeric(matrix(\n rep(sca$a.series$M, each = nyears),\n nrow = nyears\n )))\n\npopulation$estimate_M <- FALSE\npopulation$log_init_naa <- log(sca$N.age[1, ])\npopulation$estimate_init_naa <- FALSE\npopulation$nages <- nages\npopulation$ages <- ages\npopulation$nfleets <- 3 # 2 fleets and 1 survey\npopulation$nseasons <- nseasons\npopulation$nyears <- nyears\n\n# Link recruitment, growth, and maturity modules to this new popn module\npopulation$SetMaturity(maturity$get_id())\npopulation$SetGrowth(ewaa_growth$get_id())\npopulation$SetRecruitment(recruitment$get_id())\n\n####################################################################################\n# Put it all together, creating the FIMS model and making the TMB fcn\nsuccess <- CreateTMBModel()\nparameters <- list(p = get_fixed())\nobj <- MakeADFun(data = list(), parameters, DLL = \"FIMS\", silent = TRUE)\n\n# Fitting the model\nopt <- nlminb(obj$par, obj$fn, obj$gr,\n control = list(eval.max = 800, iter.max = 800)\n) # , method = \"BFGS\",\n# control = list(maxit=1000000, reltol = 1e-15))\n\n# print(opt)\n\n\n# TMB reporting\nsdr <- TMB::sdreport(obj)\nsdr_fixed <- summary(sdr, \"fixed\")\nreport <- obj$report(obj$env$last.par.best)\n\n# print(sdr_fixed)\n\n######################################################################\n# Plot results\nlibrary(colorspace)\ncols <- sequential_hcl(5, \"Viridis\")\nout.folder <- \"figures\"\ndir.create(out.folder, showWarnings = FALSE)\nplot.type <- \"png\"\n\nselex.bam.fleet1 <- 1 / (1 + exp(-sca$parm.cons$selpar_slope_COM2[8] * (ages - sca$parm.cons$selpar_A50_COM2[8])))\nselex.fims.fleet1 <- 1 / (1 + exp(-opt$par[2] * (ages - opt$par[1])))\nselex.bam.fleet2 <- 1 / (1 + exp(-sca$parm.cons$selpar_slope1_REC2[8] * (ages - sca$parm.cons$selpar_A50_REC2[8])))\nselex.fims.fleet2 <- 1 / (1 + exp(-opt$par[4] * (ages - opt$par[3])))\nselex.bam.survey <- 1 / (1 + exp(-sca$parm.cons$selpar_slope1_CVT[8] * (ages - sca$parm.cons$selpar_A501_CVT[8])))\nselex.fims.survey <- 1 / (1 + exp(-opt$par[6] * (ages - opt$par[5])))\n\n\nindex_results_allyr <- data.frame(\n yr = styr:endyr,\n observed = spp_survey1_index$index_data,\n fims.expected = report$exp_index[[3]],\n bam.expected = sca$t.series$U.CVT.pr\n)\nindex_results <- index_results_allyr %>% filter(observed != -999.00)\nfleet1_landings_results <- data.frame(\n yr = styr:endyr,\n observed = spp_fleet1_landings$index_data,\n fims.expected = report$exp_index[[1]],\n bam.expected = sca$t.series$L.COM.pr\n)\nfleet2_landings_results <- data.frame(\n yr = styr:endyr,\n observed = spp_fleet2_landings$index_data,\n fims.expected = report$exp_index[[2]],\n bam.expected = sca$t.series$L.REC.pr\n)\n\nfleet1_F_results <- data.frame(\n yr = styr:endyr,\n fims.F.fleet1 = report$F_mort[[1]],\n bam.F.fleet1 = sca$t.series$F.COM\n)\nfleet2_F_results <- data.frame(\n yr = styr:endyr,\n fims.F.fleet2 = report$F_mort[[2]],\n bam.F.fleet2 = sca$t.series$F.REC\n)\n\n# Dropping the last (extra) year from FIMS output, assuming it is a projection yr (not an initialization yr)\nfims.naa <- matrix(report$naa[[1]], ncol = nages, byrow = TRUE)\nfims.naa <- fims.naa[-54, ]\npopn_results <- data.frame(\n yr = styr:endyr,\n fims.ssb = report$ssb[[1]][1:nyears],\n fims.recruits = report$recruitment[[1]][1:nyears] / 1000,\n fims.biomass = report$biomass[[1]][1:nyears],\n fims.abundance = rowSums(fims.naa) / 1000,\n bam.ssb = sca$t.series$SSB,\n bam.recruits = sca$t.series$recruits / 1000,\n bam.biomass = sca$t.series$B,\n bam.abundance = sca$t.series$N / 1000\n)\n\nyr.ind <- 1:nyears\n\nyr.fleet1.ind <- yr.ind[fleet1_ac_n >= 0]\nyr.fleet1.ac <- years[yr.fleet1.ind]\nfims.fleet1.ncaa <- matrix(report$cnaa[[1]], ncol = nages, byrow = TRUE)\nfims.fleet1.ncaa <- fims.fleet1.ncaa[yr.fleet1.ind, ]\nfims.fleet1.caa <- fims.fleet1.ncaa / rowSums(fims.fleet1.ncaa)\nbam.fleet1.caa <- sca$comp.mats$acomp.COM.pr\nobs.fleet1.caa <- sca$comp.mats$acomp.COM.ob\n\nyr.fleet2.ind <- yr.ind[fleet2_ac_n >= 0]\nyr.fleet2.ac <- years[yr.fleet2.ind]\nfims.fleet2.ncaa <- matrix(report$cnaa[[2]], ncol = nages, byrow = TRUE)\nfims.fleet2.ncaa <- fims.fleet2.ncaa[yr.fleet2.ind, ]\nfims.fleet2.caa <- fims.fleet2.ncaa / rowSums(fims.fleet2.ncaa)\nbam.fleet2.caa <- sca$comp.mats$acomp.REC.pr\nobs.fleet2.caa <- sca$comp.mats$acomp.REC.ob\n\nyr.survey.ind <- yr.ind[survey_ac_n >= 0]\nyr.survey.ac <- years[yr.survey.ind]\nfims.survey.ncaa <- matrix(report$cnaa[[3]], ncol = nages, byrow = TRUE)\nfims.survey.ncaa <- fims.survey.ncaa[yr.survey.ind, ]\nfims.survey.caa <- fims.survey.ncaa / rowSums(fims.survey.ncaa)\nbam.survey.caa <- sca$comp.mats$acomp.CVT.pr\nobs.survey.caa <- sca$comp.mats$acomp.CVT.ob\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_tseries_fits.\", plot.type, sep = \"\"), width = 8, height = 10, units=\"in\", res=72)\nmat <- matrix(1:3, ncol = 1)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1)\n\nplot(index_results$yr, index_results$observed,\n ylim = c(0, max(index_results[, -1])),\n pch = 16, col = cols[1], ylab = \"Index\", xlab = \"\"\n)\nlines(index_results$yr, index_results$bam.expected, lwd = 3, col = cols[2])\nlines(index_results$yr, index_results$fims.expected, lwd = 3, col = cols[4])\nlegend(\"topright\",\n legend = c(\"observed\", \"BAM expected\", \"FIMS expected\"),\n pch = c(16, -1, -1), lwd = c(-1, 3, 3), col = c(cols[1], cols[2], cols[4])\n)\n\nplot(fleet1_landings_results$yr, fleet1_landings_results$observed,\n ylim = c(0, max(fleet1_landings_results[, -1])),\n pch = 16, col = cols[1], ylab = \"Fleet1 landings (mt)\", xlab = \"\"\n)\nlines(fleet1_landings_results$yr, fleet1_landings_results$bam.expected, lwd = 3, col = cols[2])\nlines(fleet1_landings_results$yr, fleet1_landings_results$fims.expected, lwd = 3, col = cols[4])\n\nplot(fleet2_landings_results$yr, fleet2_landings_results$observed,\n ylim = c(0, max(fleet2_landings_results[, -1])),\n pch = 16, col = cols[1], ylab = \"Fleet2 landings (mt)\", xlab = \"\"\n)\nlines(fleet2_landings_results$yr, fleet2_landings_results$bam.expected, lwd = 3, col = cols[2])\nlines(fleet2_landings_results$yr, fleet2_landings_results$fims.expected, lwd = 3, col = cols[4])\n\ndev.off()\n\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_tseries_F.\", plot.type, sep = \"\"), width = 8, height = 8, units=\"in\", res=72)\nmat <- matrix(1:2, ncol = 1)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1)\n\nplot(fleet1_F_results$yr, fleet1_F_results$bam.F.fleet1,\n ylim = c(0, max(fleet1_F_results[, -1])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"Fleet 1 F\", xlab = \"\"\n)\nlines(fleet1_F_results$yr, fleet1_F_results$fims.F.fleet1, lwd = 3, col = cols[4])\nlegend(\"topleft\",\n legend = c(\"BAM predicted\", \"FIMS predicted\"),\n lwd = c(3, 3), col = c(cols[2], cols[4])\n)\nplot(fleet2_F_results$yr, fleet2_F_results$bam.F.fleet2,\n ylim = c(0, max(fleet2_F_results[, -1])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"Fleet 2 F\", xlab = \"\"\n)\nlines(fleet2_F_results$yr, fleet2_F_results$fims.F.fleet2, lwd = 3, col = cols[4])\n\ndev.off()\n\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_selex.\", plot.type, sep = \"\"), width = 8, height = 10, units=\"in\", res=72)\nmat <- matrix(1:3, ncol = 1)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1)\n\nplot(ages, selex.bam.fleet1, lwd = 3, col = cols[2], type = \"l\", xlab = \"\", ylab = \"Fleet1 selectivity\")\nlines(ages, selex.fims.fleet1, lwd = 3, col = cols[4])\nlegend(\"bottomright\",\n legend = c(\"BAM predicted\", \"FIMS predicted\"),\n lwd = c(3, 3), col = c(cols[2], cols[4])\n)\nplot(ages, selex.bam.fleet2, lwd = 3, col = cols[2], type = \"l\", xlab = \"\", ylab = \"Fleet2 selectivity\")\nlines(ages, selex.fims.fleet2, lwd = 3, col = cols[4])\nplot(ages, selex.bam.survey, lwd = 3, col = cols[2], type = \"l\", xlab = \"Age\", ylab = \"Survey selectivity\")\nlines(ages, selex.fims.survey, lwd = 3, col = cols[4])\n\ndev.off()\n\n\n\n######################################################################\n\npng(filename = paste(out.folder, \"/SEFSC_scamp_tseries_popn.\", plot.type, sep = \"\"), width = 8, height = 7, units=\"in\", res=72)\nmat <- matrix(1:4, ncol = 2)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(4.1, 4.25, 1.0, 0.5), cex = 1)\n\nplot(popn_results$yr, popn_results$bam.ssb,\n ylim = c(0, max(popn_results[, c(2, 6)])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"SSB (mt)\", xlab = \"\"\n)\nlines(popn_results$yr, popn_results$fims.ssb, lwd = 3, col = cols[4])\nlegend(\"topleft\",\n legend = c(\"BAM predicted\", \"FIMS predicted\"),\n lwd = c(3, 3), col = c(cols[2], cols[4])\n)\n\nplot(popn_results$yr, popn_results$bam.biomass,\n ylim = c(0, max(popn_results[, c(4, 8)])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"Biomass (mt)\", xlab = \"\"\n)\nlines(popn_results$yr, popn_results$fims.biomass, lwd = 3, col = cols[4])\n\nplot(popn_results$yr, popn_results$bam.recruits,\n ylim = c(0, max(popn_results[, c(3, 7)])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"Recruits (1000s)\", xlab = \"\"\n)\nlines(popn_results$yr, popn_results$fims.recruits, lwd = 3, col = cols[4])\n\nplot(popn_results$yr, popn_results$bam.abundance,\n ylim = c(0, max(popn_results[, c(5, 9)])),\n type = \"l\", lwd = 3, col = cols[2], ylab = \"Abundance (1000s)\", xlab = \"\"\n)\nlines(popn_results$yr, popn_results$fims.abundance, lwd = 3, col = cols[4])\n\ndev.off()\n\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_caa_fleet1.\", plot.type, sep = \"\"), width = 8, height = 11, units=\"in\", res=72)\nmat <- matrix(1:18, ncol = 3)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75)\n\nfor (i in 1:nrow(obs.fleet1.caa))\n{\n plot(1:nages, obs.fleet1.caa[i, ], col = cols[1], xlab = \"\", ylab = \"\", pch = 16)\n lines(1:nages, bam.fleet1.caa[i, ], lwd = 3, col = cols[2])\n lines(1:nages, fims.fleet1.caa[i, ], lwd = 3, col = cols[4])\n if (i > 1) legend(\"topright\", legend = yr.fleet1.ac[i], cex = 1, bty = \"n\")\n if (i == 1) {\n legend(\"topright\",\n legend = c(\"Fleet1 Age Comps\", \"observed\", \"BAM expected\", \"FIMS expected\"),\n pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.7\n )\n legend(\"right\", legend = yr.fleet1.ac[i], cex = 1, bty = \"n\")\n }\n}\n\ndev.off()\n\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_caa_fleet2.\", plot.type, sep = \"\"), width = 8, height = 11, units=\"in\", res=72)\n\nmat <- matrix(1:28, ncol = 4)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75)\n\nfor (i in 1:nrow(obs.fleet2.caa))\n{\n plot(1:nages, obs.fleet2.caa[i, ], col = cols[1], xlab = \"\", ylab = \"\", pch = 16)\n lines(1:nages, bam.fleet2.caa[i, ], lwd = 3, col = cols[2])\n lines(1:nages, fims.fleet2.caa[i, ], lwd = 3, col = cols[4])\n if (i > 1) legend(\"topright\", legend = yr.fleet2.ac[i], cex = 1, bty = \"n\")\n if (i == 1) {\n legend(\"topright\",\n legend = c(\"Fleet2 Age Comps\", \"observed\", \"BAM expected\", \"FIMS expected\"),\n pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.5\n )\n legend(\"right\", legend = yr.fleet2.ac[i], cex = 1, bty = \"n\")\n }\n}\n\ndev.off()\n\n######################################################################\npng(filename = paste(out.folder, \"/SEFSC_scamp_caa_survey.\", plot.type, sep = \"\"), width = 8, height = 11, units=\"in\", res=72)\n\nmat <- matrix(1:30, ncol = 5)\nlayout(mat = mat, widths = rep.int(1, ncol(mat)), heights = rep.int(1, nrow(mat)))\npar(las = 1, mar = c(2.2, 2.7, 0.5, 0.5), cex = 0.75)\n\nfor (i in 1:nrow(obs.survey.caa))\n{\n plot(1:nages, obs.survey.caa[i, ], col = cols[1], xlab = \"\", ylab = \"\", pch = 16)\n lines(1:nages, bam.survey.caa[i, ], lwd = 3, col = cols[2])\n lines(1:nages, fims.survey.caa[i, ], lwd = 3, col = cols[4])\n if (i > 1) legend(\"topright\", legend = yr.survey.ac[i], cex = 1, bty = \"n\")\n if (i == 1) {\n legend(\"topright\",\n legend = c(\"Survey Age Comps\", \"observed\", \"BAM expected\", \"FIMS expected\"),\n pch = c(-1, 16, -1, -1), lwd = c(-1, -1, 3, 3), col = c(cols[1], cols[1], cols[2], cols[4]), cex = 0.5\n )\n legend(\"right\", legend = yr.survey.ac[i], cex = 1, bty = \"n\")\n }\n}\n\ndev.off()\n\nclear()", "crumbs": [ "SEFSC scamp case study" ] @@ -749,7 +749,7 @@ "href": "content/SEFSC-scamp.html#list-any-issues-that-you-ran-into-or-found", "title": "FIMS Case Study of South Atlantic Scamp (SEFSC)", "section": "List any issues that you ran into or found", - "text": "List any issues that you ran into or found\nThe FIMS feature to assign proportion female at age is not yet functional. FIMS accepts proportion female at age as input, but does not use that input and instead hard-codes a 50:50 sex ratio. Many stocks in the southeast are protogynous hermphrodites, such that individuals start life as females and later convert to males. This life history creates a sex ratio that is tilted toward females for younger ages and males for older ages.", + "text": "List any issues that you ran into or found\nThe FIMS feature to assign proportion female at age is not yet functional and it is hard-coded using a 50:50 sex ratio. Many stocks in the southeast are protogynous hermphrodites, such that individuals start life as females and later convert to males. This life history creates a sex ratio that is tilted toward females for younger ages and males for older ages.", "crumbs": [ "SEFSC scamp case study" ] @@ -799,7 +799,7 @@ "href": "content/SWFSC-sardine.html#add-a-chunk-of-code-describing-your-setup", "title": "SWFSC Case Study Pacific sardine", "section": "Add a chunk of code describing your setup", - "text": "Add a chunk of code describing your setup\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 39d0743\n\nStock name: Pacific sardine northern subpopulation\n\nRegion: SWFSC\n\nAnalyst: Peter Kuriyama", + "text": "Add a chunk of code describing your setup\n\nR version: R version 4.4.1 (2024-06-14)\n\nTMB version: 1.9.14\n\nFIMS commit: 081972c\n\nStock name: Pacific sardine northern subpopulation\n\nRegion: SWFSC\n\nAnalyst: Peter Kuriyama", "crumbs": [ "SWFSC sardine case study" ] @@ -819,7 +819,7 @@ "href": "content/SWFSC-sardine.html#add-your-script-that-sets-up-and-runs-the-model", "title": "SWFSC Case Study Pacific sardine", "section": "Add your script that sets up and runs the model", - "text": "Add your script that sets up and runs the model\n\n\nCode\n# options(max.print = 1000, device = 'windows')\n# \n# library(plyr)\n# library(reshape2)\n# library(tidyverse)\n# library(devtools)\n# library(patchwork)\n# library(scales)\n# withr::local_options(pkg.build_extra_flags = FALSE)\n# \n# library(TMB)\n# # devtools::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\n# library(TMBhelper)\n# library(r4ss)\n# \n# #Local version of FIMS downloaded last week\n# # devtools::load_all(\"../fims_v2/FIMS\")\n# \n# \n# # devtools::install_github(\"NOAA-FIMS/FIMS\")\n# # pak::pkg_install(\"NOAA-FIMS/FIMS\")\n# \n# library(FIMS)\n\nclear()\nrm(list = ls())\n\n#--------------------------------------------------------\n#Logistic function for later use\nlogistic <- function(x, slope, inflection_point){\n out <- 1 / (1 + exp(-1 * slope * (x - inflection_point)))\n out <- data.frame(x = x, value = out)\n return(out)\n}\n\n#--------------------------------------------------------\n#Manually enter data\n\n# setwd(\"C://Users//peter.kuriyama//SynologyDrive/Research//noaa//FIMS\")\n\n#-----Catch\ncatch <- data.frame(year = 2005:2023, catch = c(29188.50, 53107.00, 69929.40, \n 56317.80, 33546.40, 17466.40, 39383.10, 2585.38, 5705.77, 2558.63, 7.18, 428.26, \n 347.11, 514.20, 619.04, 653.15, 285.89, 508.02, 152.31))\n\n# ggplot(catch, aes(x = year, y = catch)) + geom_point() + \n# geom_line() + scale_y_continuous(label = comma)\n\n\nfimscatch <- tibble(type = \"landings\", name = \"fleet1\",\n age = NA, datestart = paste0(catch$year, \"-01-01\"),\n dateend = paste0(catch$year, \"-12-31\"), value = catch$catch,\n unit = \"mt\", uncertainty = 0.05)\n\n#-----CPUE\ncpue <- data.frame(year = 2005:2023, obs = c(649619.0, 899635.0, 956354.0, 863281.0, 652029.0, \n 504970.0, 395783.0, 293980.0, 182417.0, 89260.1, \n 46403.0, 40704.0, 44592.1, 48789.1, 53551.8, \n 59765.8, 68451.7, 71612.5, 68957.9))\n\n\n# ggplot(cpue, aes(x = year, y = obs)) + geom_point() + geom_line() + \n# scale_y_continuous(label = comma)\n\nfimsindex <- tibble(type = \"index\", name = \"survey1\",\n age = NA, datestart = paste0(cpue$year, \"-01-01\"),\n dateend = paste0(cpue$year, \"-12-31\"),\n value = cpue$obs, unit = 'mt', uncertainty = .3)\n\n#-----Age compositions\nacomps <- read.csv(\"data_files/sardine_acomps.csv\")\n\nfimsage <- tibble(type = \"age\", name = acomps$name,\n age = acomps$age, datestart = paste0(acomps$Yr, \"-01-01\"),\n dateend = paste0(acomps$Yr, \"-12-31\"),\n value = acomps$value, unit = \"\", uncertainty = acomps$Nsamp)\n\n\n#fimsage$uncertainty <- 50 Leave as empirical values\n\nfimscatch$value <- fimscatch$value\nfimsindex$unit <- \"\"\n\n#Combine everything\nfimsdat <- rbind(fimscatch, fimsindex, fimsage)\n\nfimsdat$age <- as.integer(fimsdat$age) \nfimsdat$value <- as.numeric(fimsdat$value)\n\nyears <- 2005:2023\n\nages <- unique(fimsage$age) ##age 0:8\n\n# ages <- ss3dat$agebin_vector\nnages <- length(ages)\nnyears <- length(years)\nnseasons <- 1\n\n# ages <- 0:ss3dat$Nages # population ages in SS3, starts at age 0\n\nnfleets <- 2 #survey and one fishery\n\n#Which fleet is first input? This corresponds to the output I think\n\n#------------------------\n#FIMS data input\nfimsdat <- as.data.frame(fimsdat)\n\nage_frame <- FIMS::FIMSFrame(fimsdat) #Cannot be FIMSFrame\n\nfishery_catch <- FIMS::m_landings(age_frame)\nfishery_agecomp <- FIMS::m_agecomp(age_frame, \"fleet1\")\nsurvey_index <- FIMS::m_index(age_frame, \"survey1\")\nsurvey_agecomp <- FIMS::m_agecomp(age_frame, \"survey1\")\n\n#---------------------------------------\n#Fishing fleet index\nfish_index <- methods::new(Index, nyears)\nfish_age_comp <- methods::new(AgeComp, nyears, nages)\nfish_index$index_data <- fishery_catch\n\n\n\n# Q: I'm confused about FIMSFrame being set up with age comps in proportions\n# vs here needing age comps in numbers\n# A: It's just not sorted out in FIMS yet, in the future this could be made simpler\nfish_age_comp$age_comp_data <- age_frame@data |>\n dplyr::filter(type == \"age\" & name == \"fleet1\") |>\n dplyr::mutate(n = value * uncertainty) |>\n dplyr::pull(n) |>\n round(1)\n\nn_missing_data <- nyears * nages - length(fish_age_comp$age_comp_data) \n\n\n#Check dimensions of age composition data\n# matrix(fish_age_comp$age_comp_data, nyears, nages)\n\n\nfish_age_comp$age_comp_data <- c(rep(-999, n_missing_data), \n fish_age_comp$age_comp_data)\n\n\n# switches to turn on or off estimation\nestimate_fish_selex <- FALSE\nestimate_survey_selex <- FALSE\nestimate_q <- FALSE #Fix at 1\nestimate_F <- TRUE\nestimate_recdevs <- TRUE\nestimate_init_naa <- TRUE \nestimate_log_rzero <- TRUE\n\n#---------------------------------------\n#Fishery module\n#---------------------------------------\n#Just one combined MexCal fleet\n\n### set up fishery\n## methods::show(DoubleLogisticSelectivity)\nfish_selex <- methods::new(LogisticSelectivity)\n\n#Use parameters close to those estimated in SS model \nfish_selex$inflection_point$value <- 1 #Fishery selectivity\nfish_selex$inflection_point$is_random_effect <- FALSE\nfish_selex$inflection_point$estimated <- estimate_fish_selex #Estimation on\n\nfish_selex$slope$value <- 5\nfish_selex$slope$is_random_effect <- FALSE\nfish_selex$slope$estimated <- estimate_fish_selex #Estimation on\n#\n\n## create fleet object for fishing \nfish_fleet <- methods::new(Fleet)\nfish_fleet$nages <- nages\nfish_fleet$nyears <- nyears\nfish_fleet$log_Fmort <- log(rep(0.2, nyears))\n\n\nfish_fleet$estimate_F <- estimate_F\nfish_fleet$random_F <- FALSE\nfish_fleet$log_q <- 0 #Not sure if this will be right\nfish_fleet$estimate_q <- estimate_q\nfish_fleet$random_q <- FALSE\n\n\nfish_fleet$log_obs_error <- rep(log(sqrt(log(0.01^2 + 1))), nyears)\n\n\n# The pos argument can specify the environment in which to assign the object in \n#any of several ways: as -1 (the default), as a positive integer \n#(the position in the search list); as the character string name of an element \n#in the search list; or as an environment (including using sys.frame to access \n#the currently active function calls).\n\n# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above\nfish_fleet$SetAgeCompLikelihood(1)\nfish_fleet$SetIndexLikelihood(1)\nfish_fleet$SetObservedIndexData(fish_index$get_id()) \nfish_fleet$SetObservedAgeCompData(fish_age_comp$get_id())\nfish_fleet$SetSelectivity(fish_selex$get_id())\n\n##---- Setup survey\nsurvey_fleet_index <- methods::new(Index, nyears)\nsurvey_age_comp <- methods::new(AgeComp, nyears, nages)\nsurvey_fleet_index$index_data <- survey_index\n\nsurvey_age_comp$age_comp_data <- age_frame@data |>\n dplyr::filter(type == \"age\" & name == \"survey1\") |>\n dplyr::mutate(n = value * uncertainty) |>\n dplyr::pull(n)\nn_missing_data <- nyears * nages - length(survey_age_comp$age_comp_data) \nsurvey_age_comp$age_comp_data <- c(rep(-999, n_missing_data), survey_age_comp$age_comp_data)\n\n\n## survey selectivity: ascending logistic\n## methods::show(DoubleLogisticSelectivity)\nsurvey_selex <- new(LogisticSelectivity)\nsurvey_selex$inflection_point$value <- 1.2\nsurvey_selex$inflection_point$is_random_effect <- FALSE\nsurvey_selex$inflection_point$estimated <- estimate_survey_selex\nsurvey_selex$slope$value <- 2\nsurvey_selex$slope$is_random_effect <- FALSE\nsurvey_selex$slope$estimated <- estimate_survey_selex\n\n\n## create fleet object for survey\nsurvey_fleet <- methods::new(Fleet)\nsurvey_fleet$is_survey <- TRUE\nsurvey_fleet$nages <- nages\nsurvey_fleet$nyears <- nyears\nsurvey_fleet$estimate_F <- FALSE\nsurvey_fleet$random_F <- FALSE\nsurvey_fleet$log_q <- 0 # catchability fixed ~1.0 = exp(0)\nsurvey_fleet$estimate_q <- estimate_q\nsurvey_fleet$random_q <- FALSE\n# Q: why can't the index uncertainty come from FIMSFrame?\nsurvey_fleet$log_obs_error <- rep(log(sqrt(log(0.1^2 + 1))), nyears)\n\nsurvey_fleet$SetAgeCompLikelihood(1)\nsurvey_fleet$SetIndexLikelihood(1)\nsurvey_fleet$SetSelectivity(survey_selex$get_id())\nsurvey_fleet$SetObservedIndexData(survey_fleet_index$get_id())\nsurvey_fleet$SetObservedAgeCompData(survey_age_comp$get_id())\n\n# Population module\n\n# recruitment\nrecruitment <- methods::new(BevertonHoltRecruitment)\n# methods::show(BevertonHoltRecruitment)\n\n#sardine sigmaR = 1.2\nrecruitment$log_sigma_recruit$value <- log(1.2) #14.2 is log(R0) in sardine simplified model\nrecruitment$log_sigma_recruit$estimated <- FALSE\n\n\n#14.2 is log(R0) in sardine simplified model\nrecruitment$log_rzero$value <- 17\nrecruitment$log_rzero$is_random_effect <- FALSE\nrecruitment$log_rzero$estimated <- TRUE\n# sardine steepness is fixed at 0.6\nsteep <- .6\nrecruitment$logit_steep$value <- -log(1.0 - steep) + log(steep - 0.2)\nrecruitment$logit_steep$is_random_effect <- FALSE\nrecruitment$logit_steep$estimated <- FALSE\n\nrecruitment$estimate_log_devs <- estimate_recdevs\n# Q: why are parameters \"log_devs\" when output is \"report$log_recruit_dev\"?\n# and are they multipliers, not deviations from zero?\n# needed to change from 1 to 0 to get stable population\nrecruitment$log_devs <- rep(log(1), nyears) # set to no deviations (multiplier) to start\n\n# growth\nwtatage <- r4ss::SS_readwtatage(\"data_files/sardine_wtatage.ss_new\")\n\newaa_growth <- methods::new(EWAAgrowth)\newaa_growth$ages <- ages\n# NOTE: getting weight-at-age vector from\n# petrale_output$wtatage |>\n# dplyr::filter(Sex == 1 & Fleet == -1 & Yr == 1876) |>\n# dplyr::select(paste(0:40)) |>\n# round(4)\n# ewaa_growth$weights <- c(0.019490,0.077760,0.108865,\n# 0.133855,0.154360,0.174905,0.184200,\n# 0.196460,0.214155)\n\n\newaa_growth$weights <- wtatage %>% filter(Fleet == 1, Yr == 2010) %>% select(as.character(0:10)) %>% t %>%\n as.vector\n\n# maturity\nmaturity <- new(LogisticMaturity)\n# approximate age-based equivalent to length-based maturity in petrale model\n# based on looking at model$endgrowth |> dplyr::filter(Sex == 1) |> dplyr::select(Age_Beg, Len_Mat)\nmaturity$inflection_point$value <- 1.2\nmaturity$inflection_point$is_random_effect <- FALSE\nmaturity$inflection_point$estimated <- FALSE\nmaturity$slope$value <- 1.5 # arbitrary guess\nmaturity$slope$is_random_effect <- FALSE\nmaturity$slope$estimated <- FALSE\n\n#Look at maturity curve\n# logistic(0:8, slope = maturity$slope$value,\n# inflection_point = maturity$inflection_point$value) %>% ggplot(aes(x = x, y = value)) +\n# geom_point() + geom_line() + scale_y_continuous(limits = c(0, 1))\n\n\n# population\npopulation <- new(Population)\n# petrale natural mortality is estimated around 0.14\nM_value <- .8 #.8 worked pretty well\npopulation$log_M <- rep(log(M_value), nages * nyears)\n\npopulation$estimate_M <- FALSE ###Anyway to control dimension of M estimation?\n\n\n# initial numbers at age based on R0 + mortality\ninit_naa <- exp(recruitment$log_rzero$value) * exp(-(ages - 1) * M_value)\ninit_naa[nages] <- init_naa[nages] / M_value # sum of infinite series\npopulation$log_init_naa <- log(init_naa)\npopulation$estimate_init_naa <- estimate_init_naa\n\npopulation$nages <- nages\npopulation$ages <- ages\npopulation$nfleets <- 2 # fleets plus surveys\npopulation$nseasons <- nseasons\npopulation$nyears <- nyears\n# population$proportion_female <- rep(0.5, nages)\n\npopulation$SetMaturity(maturity$get_id())\npopulation$SetGrowth(ewaa_growth$get_id())\npopulation$SetRecruitment(recruitment$get_id())\n\n# make FIMS model\nsuccess <- CreateTMBModel()\nparameters <- list(p = get_fixed())\n\n###expand years and ages\n# crossing(years, ages) %>% mutate(ya = paste(years, ages)) %>% pull(ya)\n\n#---------------------------------------------------------------------------\n#Clunky code to name parameter starting values/estimates to \n\n#Specification of estimation is estimated and estimate_F/estimate_M\nparname <- 999\n\nif(fish_selex$inflection_point$estimated) parname <- c(parname,\n \"fishery_selex_inf_poit\")\nif(fish_selex$slope$estimated) parname <- c(parname, \"fishery_selec_slo\")\n\n\nif(fish_fleet$estimate_F) parname <- c(parname, paste0(\"F_\", years))\n# if(fish_fleet$estimate_q)\n \nif(survey_selex$inflection_point$estimated) parname <- c(parname, \"survey_inf_poi\")\nif(survey_selex$slope$estimated) parname <- c(parname, \"survey_inf_slo\" )\n\nif(recruitment$log_sigma_recruit$estimated) parname <- c(parname, \"ln_sig_rec\")\nif(recruitment$log_rzero$estimated) parname <- c(parname, \"ln_rzero\")\nif(recruitment$logit_steep$estimated) parname <- c(parname, \"logi_h\")\n\nif(recruitment$estimate_log_devs) parname <- c(parname, paste0(\"recdev_\", years))\n \nif(maturity$inflection_point$estimated) parname <- c(parname, \"mat_inf_poi\")\nif(maturity$slope$estimated) parname <- c(parname, \"mat_slo\")\n\nif(population$estimate_M) parname <- c(parname, paste0(\"M_\", \n crossing(years, ages) %>% \n mutate(ya = paste(years, ages)) %>% pull(ya)))\nif(population$estimate_init_naa) parname <- c(parname, paste0(\"naa_\", ages))\n\nparname <- parname[-1]\n\n\n#---------------------------------------------------------------------------\n#Run model\n#---------------------------------------------------------------------------\n\npars <- tibble(parname = parname, startingvals = parameters$p)\n\n\nobj <- MakeADFun(data = list(), parameters, DLL = \"FIMS\", silent = TRUE)\nreport <- obj$report(obj$env$last.par.best)\n\n#Are there flags for when something is going wrong with the model where initial values\n#are all 0?\nopt <- nlminb(obj$par, obj$fn, obj$gr,\n control = list(eval.max = 10000, iter.max = 10000)\n)\n\nsds <- TMB::sdreport(obj)\n\nendres <- obj$report(obj$env$last.par.best)\n\npars <- pars %>% mutate(endvals = sds$par.fixed) %>%\n as.data.frame", + "text": "Add your script that sets up and runs the model\n\n\nCode\n# options(max.print = 1000, device = 'windows')\n# \n# library(plyr)\n# library(reshape2)\n# library(tidyverse)\n# library(devtools)\n# library(patchwork)\n# library(scales)\n# withr::local_options(pkg.build_extra_flags = FALSE)\n# \n# library(TMB)\n# # devtools::install_github(\"kaskr/TMB_contrib_R/TMBhelper\")\n# library(TMBhelper)\n# library(r4ss)\n# \n# #Local version of FIMS downloaded last week\n# # devtools::load_all(\"../fims_v2/FIMS\")\n# \n# \n# # devtools::install_github(\"NOAA-FIMS/FIMS\")\n# # pak::pkg_install(\"NOAA-FIMS/FIMS\")\n# \n# library(FIMS)\n\nclear()\n\n\nNULL\n\n\nCode\nrm(list = ls())\n\n#--------------------------------------------------------\n#Logistic function for later use\nlogistic <- function(x, slope, inflection_point){\n out <- 1 / (1 + exp(-1 * slope * (x - inflection_point)))\n out <- data.frame(x = x, value = out)\n return(out)\n}\n\n#--------------------------------------------------------\n#Manually enter data\n\n# setwd(\"C://Users//peter.kuriyama//SynologyDrive/Research//noaa//FIMS\")\n\n#-----Catch\ncatch <- data.frame(year = 2005:2023, catch = c(29188.50, 53107.00, 69929.40, \n 56317.80, 33546.40, 17466.40, 39383.10, 2585.38, 5705.77, 2558.63, 7.18, 428.26, \n 347.11, 514.20, 619.04, 653.15, 285.89, 508.02, 152.31))\n\n# ggplot(catch, aes(x = year, y = catch)) + geom_point() + \n# geom_line() + scale_y_continuous(label = comma)\n\n\nfimscatch <- tibble(type = \"landings\", name = \"fleet1\",\n age = NA, datestart = paste0(catch$year, \"-01-01\"),\n dateend = paste0(catch$year, \"-12-31\"), value = catch$catch,\n unit = \"mt\", uncertainty = 0.05)\n\n#-----CPUE\ncpue <- data.frame(year = 2005:2023, obs = c(649619.0, 899635.0, 956354.0, 863281.0, 652029.0, \n 504970.0, 395783.0, 293980.0, 182417.0, 89260.1, \n 46403.0, 40704.0, 44592.1, 48789.1, 53551.8, \n 59765.8, 68451.7, 71612.5, 68957.9))\n\n\n# ggplot(cpue, aes(x = year, y = obs)) + geom_point() + geom_line() + \n# scale_y_continuous(label = comma)\n\nfimsindex <- tibble(type = \"index\", name = \"survey1\",\n age = NA, datestart = paste0(cpue$year, \"-01-01\"),\n dateend = paste0(cpue$year, \"-12-31\"),\n value = cpue$obs, unit = 'mt', uncertainty = .3)\n\n#-----Age compositions\nacomps <- read.csv(\"data_files/sardine_acomps.csv\")\n\nfimsage <- tibble(type = \"age\", name = acomps$name,\n age = acomps$age, datestart = paste0(acomps$Yr, \"-01-01\"),\n dateend = paste0(acomps$Yr, \"-12-31\"),\n value = acomps$value, unit = \"\", uncertainty = acomps$Nsamp)\n\n\n#fimsage$uncertainty <- 50 Leave as empirical values\n\nfimscatch$value <- fimscatch$value\nfimsindex$unit <- \"\"\n\n#Combine everything\nfimsdat <- rbind(fimscatch, fimsindex, fimsage)\n\nfimsdat$age <- as.integer(fimsdat$age) \nfimsdat$value <- as.numeric(fimsdat$value)\n\nyears <- 2005:2023\n\nages <- unique(fimsage$age) ##age 0:8\n\n# ages <- ss3dat$agebin_vector\nnages <- length(ages)\nnyears <- length(years)\nnseasons <- 1\n\n# ages <- 0:ss3dat$Nages # population ages in SS3, starts at age 0\n\nnfleets <- 2 #survey and one fishery\n\n#Which fleet is first input? This corresponds to the output I think\n\n#------------------------\n#FIMS data input\nfimsdat <- as.data.frame(fimsdat)\n\nage_frame <- FIMS::FIMSFrame(fimsdat) #Cannot be FIMSFrame\n\nfishery_catch <- FIMS::m_landings(age_frame)\nfishery_agecomp <- FIMS::m_agecomp(age_frame, \"fleet1\")\nsurvey_index <- FIMS::m_index(age_frame, \"survey1\")\nsurvey_agecomp <- FIMS::m_agecomp(age_frame, \"survey1\")\n\n#---------------------------------------\n#Fishing fleet index\nfish_index <- methods::new(Index, nyears)\nfish_age_comp <- methods::new(AgeComp, nyears, nages)\nfish_index$index_data <- fishery_catch\n\n\n\n# Q: I'm confused about FIMSFrame being set up with age comps in proportions\n# vs here needing age comps in numbers\n# A: It's just not sorted out in FIMS yet, in the future this could be made simpler\nfish_age_comp$age_comp_data <- age_frame@data |>\n dplyr::filter(type == \"age\" & name == \"fleet1\") |>\n dplyr::mutate(n = value * uncertainty) |>\n dplyr::pull(n) |>\n round(1)\n\nn_missing_data <- nyears * nages - length(fish_age_comp$age_comp_data) \n\n\n#Check dimensions of age composition data\n# matrix(fish_age_comp$age_comp_data, nyears, nages)\n\n\nfish_age_comp$age_comp_data <- c(rep(-999, n_missing_data), \n fish_age_comp$age_comp_data)\n\n\n# switches to turn on or off estimation\nestimate_fish_selex <- FALSE\nestimate_survey_selex <- FALSE\nestimate_q <- FALSE #Fix at 1\nestimate_F <- TRUE\nestimate_recdevs <- TRUE\nestimate_init_naa <- TRUE \nestimate_log_rzero <- TRUE\n\n#---------------------------------------\n#Fishery module\n#---------------------------------------\n#Just one combined MexCal fleet\n\n### set up fishery\n## methods::show(DoubleLogisticSelectivity)\nfish_selex <- methods::new(LogisticSelectivity)\n\n#Use parameters close to those estimated in SS model \nfish_selex$inflection_point$value <- 1 #Fishery selectivity\nfish_selex$inflection_point$is_random_effect <- FALSE\nfish_selex$inflection_point$estimated <- estimate_fish_selex #Estimation on\n\nfish_selex$slope$value <- 5\nfish_selex$slope$is_random_effect <- FALSE\nfish_selex$slope$estimated <- estimate_fish_selex #Estimation on\n#\n\n## create fleet object for fishing \nfish_fleet <- methods::new(Fleet)\nfish_fleet$nages <- nages\nfish_fleet$nyears <- nyears\nfish_fleet$log_Fmort <- log(rep(0.2, nyears))\n\n\nfish_fleet$estimate_F <- estimate_F\nfish_fleet$random_F <- FALSE\nfish_fleet$log_q <- 0 #Not sure if this will be right\nfish_fleet$estimate_q <- estimate_q\nfish_fleet$random_q <- FALSE\n\n\nfish_fleet$log_obs_error <- rep(log(sqrt(log(0.01^2 + 1))), nyears)\n\n\n# The pos argument can specify the environment in which to assign the object in \n#any of several ways: as -1 (the default), as a positive integer \n#(the position in the search list); as the character string name of an element \n#in the search list; or as an environment (including using sys.frame to access \n#the currently active function calls).\n\n# Set Index, AgeComp, and Selectivity using the IDs from the modules defined above\nfish_fleet$SetAgeCompLikelihood(1)\nfish_fleet$SetIndexLikelihood(1)\nfish_fleet$SetObservedIndexData(fish_index$get_id()) \nfish_fleet$SetObservedAgeCompData(fish_age_comp$get_id())\nfish_fleet$SetSelectivity(fish_selex$get_id())\n\n##---- Setup survey\nsurvey_fleet_index <- methods::new(Index, nyears)\nsurvey_age_comp <- methods::new(AgeComp, nyears, nages)\nsurvey_fleet_index$index_data <- survey_index\n\nsurvey_age_comp$age_comp_data <- age_frame@data |>\n dplyr::filter(type == \"age\" & name == \"survey1\") |>\n dplyr::mutate(n = value * uncertainty) |>\n dplyr::pull(n)\nn_missing_data <- nyears * nages - length(survey_age_comp$age_comp_data) \nsurvey_age_comp$age_comp_data <- c(rep(-999, n_missing_data), survey_age_comp$age_comp_data)\n\n\n## survey selectivity: ascending logistic\n## methods::show(DoubleLogisticSelectivity)\nsurvey_selex <- new(LogisticSelectivity)\nsurvey_selex$inflection_point$value <- 1.2\nsurvey_selex$inflection_point$is_random_effect <- FALSE\nsurvey_selex$inflection_point$estimated <- estimate_survey_selex\nsurvey_selex$slope$value <- 2\nsurvey_selex$slope$is_random_effect <- FALSE\nsurvey_selex$slope$estimated <- estimate_survey_selex\n\n\n## create fleet object for survey\nsurvey_fleet <- methods::new(Fleet)\nsurvey_fleet$is_survey <- TRUE\nsurvey_fleet$nages <- nages\nsurvey_fleet$nyears <- nyears\nsurvey_fleet$estimate_F <- FALSE\nsurvey_fleet$random_F <- FALSE\nsurvey_fleet$log_q <- 0 # catchability fixed ~1.0 = exp(0)\nsurvey_fleet$estimate_q <- estimate_q\nsurvey_fleet$random_q <- FALSE\n# Q: why can't the index uncertainty come from FIMSFrame?\nsurvey_fleet$log_obs_error <- rep(log(sqrt(log(0.1^2 + 1))), nyears)\n\nsurvey_fleet$SetAgeCompLikelihood(1)\nsurvey_fleet$SetIndexLikelihood(1)\nsurvey_fleet$SetSelectivity(survey_selex$get_id())\nsurvey_fleet$SetObservedIndexData(survey_fleet_index$get_id())\nsurvey_fleet$SetObservedAgeCompData(survey_age_comp$get_id())\n\n# Population module\n\n# recruitment\nrecruitment <- methods::new(BevertonHoltRecruitment)\n# methods::show(BevertonHoltRecruitment)\n\n#sardine sigmaR = 1.2\nrecruitment$log_sigma_recruit$value <- log(1.2) #14.2 is log(R0) in sardine simplified model\nrecruitment$log_sigma_recruit$estimated <- FALSE\n\n\n#14.2 is log(R0) in sardine simplified model\nrecruitment$log_rzero$value <- 17\nrecruitment$log_rzero$is_random_effect <- FALSE\nrecruitment$log_rzero$estimated <- TRUE\n# sardine steepness is fixed at 0.6\nsteep <- .6\nrecruitment$logit_steep$value <- -log(1.0 - steep) + log(steep - 0.2)\nrecruitment$logit_steep$is_random_effect <- FALSE\nrecruitment$logit_steep$estimated <- FALSE\n\nrecruitment$estimate_log_devs <- estimate_recdevs\n# Q: why are parameters \"log_devs\" when output is \"report$log_recruit_dev\"?\n# and are they multipliers, not deviations from zero?\n# needed to change from 1 to 0 to get stable population\nrecruitment$log_devs <- rep(log(1), nyears) # set to no deviations (multiplier) to start\n\n# growth\nwtatage <- r4ss::SS_readwtatage(\"data_files/sardine_wtatage.ss_new\")\n\newaa_growth <- methods::new(EWAAgrowth)\newaa_growth$ages <- ages\n# NOTE: getting weight-at-age vector from\n# petrale_output$wtatage |>\n# dplyr::filter(Sex == 1 & Fleet == -1 & Yr == 1876) |>\n# dplyr::select(paste(0:40)) |>\n# round(4)\n# ewaa_growth$weights <- c(0.019490,0.077760,0.108865,\n# 0.133855,0.154360,0.174905,0.184200,\n# 0.196460,0.214155)\n\n\newaa_growth$weights <- wtatage %>% filter(Fleet == 1, Yr == 2010) %>% select(as.character(0:10)) %>% t %>%\n as.vector\n\n# maturity\nmaturity <- new(LogisticMaturity)\n# approximate age-based equivalent to length-based maturity in petrale model\n# based on looking at model$endgrowth |> dplyr::filter(Sex == 1) |> dplyr::select(Age_Beg, Len_Mat)\nmaturity$inflection_point$value <- 1.2\nmaturity$inflection_point$is_random_effect <- FALSE\nmaturity$inflection_point$estimated <- FALSE\nmaturity$slope$value <- 1.5 # arbitrary guess\nmaturity$slope$is_random_effect <- FALSE\nmaturity$slope$estimated <- FALSE\n\n#Look at maturity curve\n# logistic(0:8, slope = maturity$slope$value,\n# inflection_point = maturity$inflection_point$value) %>% ggplot(aes(x = x, y = value)) +\n# geom_point() + geom_line() + scale_y_continuous(limits = c(0, 1))\n\n\n# population\npopulation <- new(Population)\n# petrale natural mortality is estimated around 0.14\nM_value <- .8 #.8 worked pretty well\npopulation$log_M <- rep(log(M_value), nages * nyears)\n\npopulation$estimate_M <- FALSE ###Anyway to control dimension of M estimation?\n\n\n# initial numbers at age based on R0 + mortality\ninit_naa <- exp(recruitment$log_rzero$value) * exp(-(ages - 1) * M_value)\ninit_naa[nages] <- init_naa[nages] / M_value # sum of infinite series\npopulation$log_init_naa <- log(init_naa)\npopulation$estimate_init_naa <- estimate_init_naa\n\npopulation$nages <- nages\npopulation$ages <- ages\npopulation$nfleets <- 2 # fleets plus surveys\npopulation$nseasons <- nseasons\npopulation$nyears <- nyears\n\npopulation$SetMaturity(maturity$get_id())\npopulation$SetGrowth(ewaa_growth$get_id())\npopulation$SetRecruitment(recruitment$get_id())\n\n# make FIMS model\nsuccess <- CreateTMBModel()\nparameters <- list(p = get_fixed())\n\n###expand years and ages\n# crossing(years, ages) %>% mutate(ya = paste(years, ages)) %>% pull(ya)\n\n#---------------------------------------------------------------------------\n#Clunky code to name parameter starting values/estimates to \n\n#Specification of estimation is estimated and estimate_F/estimate_M\nparname <- 999\n\nif(fish_selex$inflection_point$estimated) parname <- c(parname,\n \"fishery_selex_inf_poit\")\nif(fish_selex$slope$estimated) parname <- c(parname, \"fishery_selec_slo\")\n\n\nif(fish_fleet$estimate_F) parname <- c(parname, paste0(\"F_\", years))\n# if(fish_fleet$estimate_q)\n \nif(survey_selex$inflection_point$estimated) parname <- c(parname, \"survey_inf_poi\")\nif(survey_selex$slope$estimated) parname <- c(parname, \"survey_inf_slo\" )\n\nif(recruitment$log_sigma_recruit$estimated) parname <- c(parname, \"ln_sig_rec\")\nif(recruitment$log_rzero$estimated) parname <- c(parname, \"ln_rzero\")\nif(recruitment$logit_steep$estimated) parname <- c(parname, \"logi_h\")\n\nif(recruitment$estimate_log_devs) parname <- c(parname, paste0(\"recdev_\", years))\n \nif(maturity$inflection_point$estimated) parname <- c(parname, \"mat_inf_poi\")\nif(maturity$slope$estimated) parname <- c(parname, \"mat_slo\")\n\nif(population$estimate_M) parname <- c(parname, paste0(\"M_\", \n crossing(years, ages) %>% \n mutate(ya = paste(years, ages)) %>% pull(ya)))\nif(population$estimate_init_naa) parname <- c(parname, paste0(\"naa_\", ages))\n\nparname <- parname[-1]\n\n\n#---------------------------------------------------------------------------\n#Run model\n#---------------------------------------------------------------------------\n\npars <- tibble(parname = parname, startingvals = parameters$p)\n\n\nobj <- MakeADFun(data = list(), parameters, DLL = \"FIMS\", silent = TRUE)\nreport <- obj$report(obj$env$last.par.best)\n\n#Are there flags for when something is going wrong with the model where initial values\n#are all 0?\nopt <- nlminb(obj$par, obj$fn, obj$gr,\n control = list(eval.max = 10000, iter.max = 10000)\n)\n\nsds <- TMB::sdreport(obj)\n\nendres <- obj$report(obj$env$last.par.best)\n\npars <- pars %>% mutate(endvals = sds$par.fixed) %>%\n as.data.frame", "crumbs": [ "SWFSC sardine case study" ] diff --git a/sitemap.xml b/sitemap.xml index 17e325d..e9000aa 100644 --- a/sitemap.xml +++ b/sitemap.xml @@ -2,58 +2,58 @@ https://noaa-fims.github.io/case-studies/index.html - 2024-07-17T22:38:10.111Z + 2024-07-26T18:50:11.145Z https://noaa-fims.github.io/case-studies/content/setup.html - 2024-07-17T22:38:10.110Z + 2024-07-26T18:50:11.145Z https://noaa-fims.github.io/case-studies/content/AFSC-BSAI-AtkaMackerel.html - 2024-07-17T22:38:10.064Z + 2024-07-26T18:50:11.080Z https://noaa-fims.github.io/case-studies/content/case-study-template.html - 2024-07-17T22:38:10.065Z + 2024-07-26T18:50:11.081Z https://noaa-fims.github.io/case-studies/content/NWFSC-petrale.html - 2024-07-17T22:38:10.064Z + 2024-07-26T18:50:11.080Z https://noaa-fims.github.io/case-studies/content/PIFS-opakapaka.html - 2024-07-17T22:38:10.064Z + 2024-07-26T18:50:11.080Z https://noaa-fims.github.io/case-studies/content/publishing.html - 2024-07-17T22:38:10.110Z + 2024-07-26T18:50:11.144Z https://noaa-fims.github.io/case-studies/content/AFSC-GOA-pollock.html - 2024-07-17T22:38:10.064Z + 2024-07-26T18:50:11.080Z https://noaa-fims.github.io/case-studies/content/NEFSC-yellowtail.html - 2024-07-17T22:38:10.064Z + 2024-07-26T18:50:11.080Z https://noaa-fims.github.io/case-studies/content/rendering.html - 2024-07-17T22:38:10.110Z + 2024-07-26T18:50:11.144Z https://noaa-fims.github.io/case-studies/content/acknowledgements.html - 2024-07-17T22:38:10.065Z + 2024-07-26T18:50:11.081Z https://noaa-fims.github.io/case-studies/content/rmarkdown.html - 2024-07-17T22:38:10.110Z + 2024-07-26T18:50:11.144Z https://noaa-fims.github.io/case-studies/content/SEFSC-scamp.html - 2024-07-17T22:38:10.065Z + 2024-07-26T18:50:11.081Z https://noaa-fims.github.io/case-studies/content/SWFSC-sardine.html - 2024-07-17T22:38:10.065Z + 2024-07-26T18:50:11.081Z