Skip to content

Commit

Permalink
feat, tests: add switch to run (or not) stock assessments in the last…
Browse files Browse the repository at this point in the history 
… year

The default is NOT to run the stock assessment, which is different than the previous default (the stock assessment would always run in the last year).
  • Loading branch information
@k-doering-NOAA
k-doering-NOAA committed Sep 9, 2020
1 parent 9d8675e commit 1b0cfd6
Show file tree
Hide file tree
Showing 4 changed files with 63 additions and 26 deletions.
75 changes: 50 additions & 25 deletions R/runSSMSE.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,9 @@
#' @param EM_in_dir_vec Relative or absolute path to the estimation model, if using
#' model outside of the SSMSE package. Note that this value should be NULL if
#' \code{MS} has a value other than "EM".
#' @param run_EM_last_yr Should the EM run in the last year if the last year
#' is an assessment year? TRUE/FALSE option, so the same for all scenarios and
#' iterations. Defaults to FALSE.
#' @param MS_vec Vector of management strategies.
#' @param use_SS_boot_vec Should a bootstrapped data set generated by SS be used?
#' Defaults to TRUE.
Expand Down Expand Up @@ -140,6 +143,7 @@ run_SSMSE <- function(scen_name_vec,
OM_in_dir_vec = NULL,
EM_name_vec = NULL,
EM_in_dir_vec = NULL,
run_EM_last_yr = FALSE,
MS_vec = c("EM", "no_catch"),
use_SS_boot_vec = TRUE,
nyrs_vec,
Expand Down Expand Up @@ -292,6 +296,7 @@ run_SSMSE <- function(scen_name_vec,
scen_seed = tmp_scen[["scen_seed"]],
sample_struct = tmp_scen[["sample_struct"]],
interim_struct = tmp_scen[["interim_struct"]],
run_EM_last_yr = run_EM_last_yr,
verbose = verbose,
run_parallel = run_parallel,
n_cores = n_cores)
Expand Down Expand Up @@ -328,6 +333,9 @@ run_SSMSE <- function(scen_name_vec,
#' @param EM_in_dir Relative or absolute path to the estimation model, if using a
#' model outside of the SSMSE package. Note that this value should be NULL if
#' \code{MS} has a value other than "EM".
#' @param run_EM_last_yr Should the EM run in the last year if the last year
#' is an assessment year? TRUE/FALSE option, so the same for all scenarios and
#' iterations. Defaults to FALSE.
#' @template MS
#' @param use_SS_boot Should a bootstrapped data set generated by SS be used?
#' Defaults to TRUE.
Expand Down Expand Up @@ -386,6 +394,7 @@ run_SSMSE_scen <- function(scen_name = "scen_1",
OM_in_dir = NULL,
EM_name = NULL,
EM_in_dir = NULL,
run_EM_last_yr = FALSE,
MS = "no_catch",
use_SS_boot = TRUE,
nyrs = 100,
Expand Down Expand Up @@ -457,6 +466,7 @@ run_SSMSE_scen <- function(scen_name = "scen_1",
rec_dev_iter = rec_devs_scen[[i]],
impl_error = impl_error[[i]],
niter = max_prev_iter + i,
run_EM_last_yr = run_EM_last_yr,
iter_seed = iter_seed,
sample_struct = sample_struct,
interim_struct = interim_struct,
Expand All @@ -482,6 +492,7 @@ run_SSMSE_scen <- function(scen_name = "scen_1",
rec_dev_iter = rec_devs_scen[[i]],
impl_error = impl_error[[i]],
niter = max_prev_iter + i,
run_EM_last_yr = run_EM_last_yr,
iter_seed = iter_seed,
sample_struct = sample_struct,
interim_struct = interim_struct,
Expand Down Expand Up @@ -531,7 +542,9 @@ run_SSMSE_scen <- function(scen_name = "scen_1",
#' @param EM_in_dir Relative or absolute path to the estimation model, if using a
#' model outside of the SSMSE package. Note that this value should be NULL if
#' \code{MS} has a value other than "EM".

#' @param run_EM_last_yr Should the EM run in the last year if the last year
#' is an assessment year? TRUE/FALSE option, so the same for all scenarios and
#' iterations. Defaults to FALSE.
#' @param use_SS_boot Should a bootstrapped data set generated by SS be used?
#' Defaults to TRUE.
#' @param nyrs Number of years beyond the years included in the OM to run the
Expand Down Expand Up @@ -609,6 +622,7 @@ run_SSMSE_iter <- function(out_dir = NULL,
OM_in_dir = NULL,
EM_name = NULL,
EM_in_dir = NULL,
run_EM_last_yr = FALSE,
MS = "last_yr_catch",
use_SS_boot = TRUE,
nyrs = 100,
Expand Down Expand Up @@ -722,6 +736,11 @@ run_SSMSE_iter <- function(out_dir = NULL,
# calculate years after the last assessment. The OM will need to run
# 1 additional time if this is the case.
extra_yrs <- nyrs - (assess_yrs[length(assess_yrs)] - styr_MSE)
if(extra_yrs == 0) {
test_run_EM_yr <- assess_yrs[length(assess_yrs)]
} else {
test_run_EM_yr <- NULL
}
# Loop over the assessment years.
for (yr in assess_yrs) {
# checks, esp. to make sure future catch is not larger than the population
Expand Down Expand Up @@ -771,31 +790,37 @@ run_SSMSE_iter <- function(out_dir = NULL,
}
message("Finished running and sampling OM through year ", new_OM_dat$endyr,
".")

# if using an EM, want to save results to a new folder
if (!is.null(EM_out_dir) & MS!="Interim") {
new_EM_out_dir <- paste0(EM_out_dir_basename, "_", yr)
dir.create(new_EM_out_dir)
success <- copy_model_files(EM_in_dir = EM_out_dir,
EM_out_dir = new_EM_out_dir)
EM_out_dir <- new_EM_out_dir
if(run_EM_last_yr == FALSE && isTRUE(yr == test_run_EM_yr)) {
skip_EM_run <- TRUE
} else {
skip_EM_run <- FALSE
}
if(skip_EM_run == FALSE) {
# if using an EM, want to save results to a new folder
if (!is.null(EM_out_dir) & MS!="Interim") {
new_EM_out_dir <- paste0(EM_out_dir_basename, "_", yr)
dir.create(new_EM_out_dir)
success <- copy_model_files(EM_in_dir = EM_out_dir,
EM_out_dir = new_EM_out_dir)
EM_out_dir <- new_EM_out_dir
}
# Only want data for the new years: (yr+nyrs_assess):yr
# create the new dataset to input into the EM
# loop EM and get management quantities.
new_catch_list <- parse_MS(MS = MS,
EM_out_dir = EM_out_dir,
EM_init_dir = paste0(EM_out_dir_basename, "_init"),
OM_dat = new_OM_dat,
init_loop = FALSE, verbose = verbose,
nyrs_assess = nyrs_assess,
OM_out_dir = OM_out_dir,
dat_yrs = (yr + 1):(yr + nyrs_assess),
sample_struct = sample_struct,
interim_struct = interim_struct,
seed = (iter_seed$iter[1]+5678901+yr))
message("Finished getting catch (years ", (yr + 1), " to ",
(yr + nyrs_assess), ") to feed into OM for iteration ", niter, ".")
}
# Only want data for the new years: (yr+nyrs_assess):yr
# create the new dataset to input into the EM
# loop EM and get management quantities.
new_catch_list <- parse_MS(MS = MS,
EM_out_dir = EM_out_dir,
EM_init_dir = paste0(EM_out_dir_basename, "_init"),
OM_dat = new_OM_dat,
init_loop = FALSE, verbose = verbose,
nyrs_assess = nyrs_assess,
OM_out_dir = OM_out_dir,
dat_yrs = (yr + 1):(yr + nyrs_assess),
sample_struct = sample_struct,
interim_struct = interim_struct,
seed = (iter_seed$iter[1]+5678901+yr))
message("Finished getting catch (years ", (yr + 1), " to ",
(yr + nyrs_assess), ") to feed into OM for iteration ", niter, ".")
}
if(extra_yrs > 0) {
message("Running the OM 1 final time, because last year extends past the last
Expand Down
1 change: 1 addition & 0 deletions README.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -228,6 +228,7 @@ run_SSMSE(scen_name_vec = c("H-ctl", "H-1"),# name of the scenario
rec_dev_pattern = "rand", # Don't use recruitment deviations
scope = "2", # to use the same recruitment devs across scenarios.
impl_error_pattern = "none", # Don't use implementation error
run_EM_last_yr = FALSE, # Run the EM in 106
run_parallel = TRUE,
sample_struct_list = sample_struct_list, # How to sample data for running the EM.
seed = 12345) #Set a fixed integer seed that allows replication
Expand Down
1 change: 1 addition & 0 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -381,6 +381,7 @@ run_SSMSE(scen_name_vec = c("H-ctl", "H-1"),# name of the scenario
rec_dev_pattern = "rand", # Don't use recruitment deviations
scope = "2", # to use the same recruitment devs across scenarios.
impl_error_pattern = "none", # Don't use implementation error
run_EM_last_yr = FALSE, # Run the EM in 106
run_parallel = TRUE,
sample_struct_list = sample_struct_list, # How to sample data for running the EM.
seed = 12345) #Set a fixed integer seed that allows replication
Expand Down
12 changes: 11 additions & 1 deletion tests/testthat/test-runSSMSE.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ test_that("run_SSMSE runs with an EM, and works with summary funs", {
EM_name_vec = "cod", # cod is included in package data
MS_vec = "EM", # The management strategy is specified in the EM
use_SS_boot_vec = TRUE, # use the SS bootstrap module for sampling
run_EM_last_yr = FALSE,
nyrs_vec = nyrs, # Years to project OM forward
nyrs_assess_vec = 3, # Years between assessments
rec_dev_pattern = "none", # Don't use recruitment deviations
Expand Down Expand Up @@ -52,6 +53,7 @@ test_that("run_SSMSE runs with an EM, and works with summary funs", {
# make sure OM ran through the last year.
expect_true((100 + nyrs) %in% summary$ts[summary$ts$model_run == "cod_OM", "year"])
})

test_that("run_SSMSE runs multiple iterations/scenarios and works with summary funs", {
# This tests takes a while to run, but is really helpful.
new_temp_path <- file.path(temp_path, "mult_scenarios")
Expand All @@ -73,6 +75,7 @@ test_that("run_SSMSE runs multiple iterations/scenarios and works with summary f
use_SS_boot_vec = TRUE, # use the SS bootstrap module for sampling
nyrs_vec = nyrs, # Years to project OM forward
nyrs_assess_vec = 3, # Years between assessments
run_EM_last_yr = FALSE,
rec_dev_pattern = "none", # Don't use recruitment deviations
run_parallel = FALSE,
impl_error_pattern = "none", # Don't use implementation error
Expand All @@ -82,12 +85,17 @@ test_that("run_SSMSE runs multiple iterations/scenarios and works with summary f
expect_true(file.exists(
file.path(new_temp_path, "H-ctl", "1", "cod_OM", "data.ss_new")))
expect_true(file.exists(
file.path(new_temp_path, "H-ctl", "1", "cod_EM_103", "data.ss_new")))
# this file should not exist b/c run_EM_last_yr is FALSE.
expect_true(!file.exists(
file.path(new_temp_path, "H-ctl", "1", "cod_EM_106", "data.ss_new")))
expect_equivalent(result$`H-scen-2`$errored_iterations,
"No errored iterations")
expect_true(file.exists(
file.path(new_temp_path, "H-scen-2", "1", "cod_OM", "data.ss_new")))
expect_true(file.exists(
file.path(new_temp_path, "H-scen-2", "1", "cod_EM_103", "data.ss_new")))
expect_true(!file.exists(
file.path(new_temp_path, "H-scen-2", "1", "cod_EM_106", "data.ss_new")))
expect_length(result, 2)
# summarize results
Expand Down Expand Up @@ -117,7 +125,7 @@ test_that("run_SSMSE_iter runs with no EM", {

OM_path_cod <- file.path(extdat_path, "models", "cod")
EM_path_cod <- file.path(extdat_path, "models", "cod")
test_that("cod works when treated as a custom model", {
test_that("cod works when treated as a custom model and run_EM_last_yr = TRUE works", {
skip_on_cran()
skip_on_travis()
skip_on_appveyor()
Expand All @@ -131,6 +139,7 @@ test_that("cod works when treated as a custom model", {
out_dir = new_temp_path,
EM_name = NULL,
EM_in_dir = EM_path_cod,
run_EM_last_yr = TRUE,
nyrs = 6,
rec_dev_iter = rep(0, times = 3 * 2), # Nfleets times nyrs_assess
impl_error = rep(1, times = 3 * 2), # Nfleets times nyrs_assess
Expand All @@ -147,6 +156,7 @@ test_that("cod works when treated as a custom model", {
)
)
expect_true(file.exists(file.path(new_temp_path, "1", "cod_OM", "data.ss_new")))
expect_true(file.exists(file.path(new_temp_path, "1", "cod_EM_106", "data.ss_new")))
expect_true(result)
})

Expand Down

0 comments on commit 1b0cfd6

Please sign in to comment.