tests/test-action_spawn-multipleoutputs.R

In gadget3: Globally-Applicable Area Disaggregated General Ecosystem Toolbox V3

library(unittest)
if (!interactive()) options(warn=2, error = function() { sink(stderr()) ; traceback(3) ; q(status = 1) })

library(gadget3)

actions <- list()
area_names <- g3_areas(c('AA', 'BB', 'CC'))

st_imm_f <- g3_stock(c(species = "fish", maturity = 'imm', sex = 'f'), seq(5L, 25L, 5)) |>
  g3s_livesonareas(area_names["AA"]) |>
  g3s_age(1L, 5L)
st_imm_m <- g3_stock(c(species = "fish", maturity = 'imm', sex = 'm'), seq(5L, 25L, 5)) |>
  g3s_livesonareas(area_names["AA"]) |>
  g3s_age(1L, 5L)
st_mat <- g3_stock(c(species = "fish", maturity = 'mat'), seq(5L, 25L, 5)) |>
  g3s_livesonareas(area_names["AA"]) |>
  g3s_age(3L, 10L)

actions <- list(
  g3a_time(
    1980, 1995,
    step_lengths = c(6L, 6L)),
  g3a_initialconditions(st_imm_f, quote( 0 * stock__midlen ), quote( 0 * stock__midlen )),
  g3a_initialconditions(st_imm_m, quote( 0 * stock__midlen ), quote( 0 * stock__midlen )),
  g3a_initialconditions_normalcv(st_mat),
  g3a_spawn(
    st_mat,
    recruitment_f = g3a_spawn_recruitment_bevertonholt(
      mu = g3_parameterized('spawn_mu', value = 5, by_year = TRUE),
      lambda = g3_parameterized("spawn_lambda", value = 1, by_stock = TRUE) ),
    proportion_f = g3_suitability_exponentiall50(),
    output_stocks = list(st_imm_f, st_imm_m),
    output_ratios = list(
      st_imm_f = quote( g3_param('spawn_ratio', value = 0.5) ),
      st_imm_m = quote( 1 - g3_param('spawn_ratio', value = 0.5) )),
    run_f = quote( cur_step == 1 ) ),
  g3a_age(st_imm_f),
  g3a_age(st_imm_m),
  g3a_age(st_mat) )

# Compile model
model_fn <- g3_to_r(c(actions, list(
  g3a_report_history(actions, c(
      '__offspringnum$',
      '__num$',
      '__wgt$' )))))
if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  model_cpp <- g3_to_tmb(c(actions, list(
    g3a_report_history(actions, c(
        '__offspringnum$',
        '__num$',
        '__wgt$' )))))
    # model_cpp <- edit(model_cpp)
    model_tmb <- g3_tmb_adfun(model_cpp, compile_flags = c("-O0", "-g"))
} else {
    writeLines("# skip: not compiling TMB model")
}

estimate_l50 <- g3_stock_def(st_mat, "midlen")[[length(g3_stock_def(st_mat, "midlen")) / 2]]
estimate_linf <- max(g3_stock_def(st_mat, "midlen"))

for (spawn_ratio in runif(5)) ok_group(paste0("spawn_ratio: ", spawn_ratio), {
  attr(model_fn, 'parameter_template') |>
    g3_init_val("*.Linf", estimate_linf, spread = 0.2) |>
    g3_init_val("*.walpha", 0.01, optimise = FALSE) |>
    g3_init_val("*.wbeta", 3, optimise = FALSE) |>

    g3_init_val("*.*.l50", estimate_l50, spread = 0.25) |>
    g3_init_val("spawn_ratio", spawn_ratio) |>

    identity() -> params

  r <- attributes(model_fn(params))
  num_spawn <- colSums(r$hist_fish_mat__offspringnum, dims = 3)
  num_m <- colSums(r$hist_fish_imm_m__num, dims = 3)
  num_f <- colSums(r$hist_fish_imm_f__num, dims = 3)

  ok(ut_cmp_equal(
    cumsum(num_spawn * (1 - spawn_ratio)),
    num_m,
    tolerance = 1e-8), "hist_fish_imm_m__num: Cumulative proportion of __offspringnum")
  ok(ut_cmp_equal(
    cumsum(num_spawn * spawn_ratio),
    num_f,
    tolerance = 1e-8), "hist_fish_imm_f__num: Cumulatve proportion of __offspringnum")

    if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
        param_template <- attr(model_cpp, "parameter_template")
        param_template$value <- params[param_template$switch]
        gadget3:::ut_tmb_r_compare(model_fn, model_tmb, param_template)
    }
})