Running 'test-aab_env.R' [1s]
  Running 'test-action_age.R' [2s]
  Running 'test-action_grow.R' [155s]
  Running 'test-action_mature.R' [155s]
  Running 'test-action_migrate.R' [162s]
  Running 'test-action_naturalmortality.R' [1s]
  Running 'test-action_predate-catchability.R' [3s]
  Running 'test-action_predate-numberfleet.R' [2s]
  Running 'test-action_predate.R' [3s]
  Running 'test-action_renewal.R' [155s]
  Running 'test-action_report.R' [173s]
  Running 'test-action_spawn.R' [3s]
  Running 'test-action_tagging.R' [173s]
  Running 'test-action_time.R' [162s]
  Running 'test-eval.R' [174s]
  Running 'test-formula_utils.R' [1s]
  Running 'test-init_val.R' [1s]
  Running 'test-likelihood_bounds.R' [159s]
  Running 'test-likelihood_data.R' [1s]
  Running 'test-likelihood_distribution-surveyindices.R' [2s]
  Running 'test-likelihood_distribution.R' [9s]
  Running 'test-likelihood_random.R' [157s]
  Running 'test-likelihood_tagging_ckmr.R' [2s]
  Running 'test-likelihood_understocking.R' [0s]
  Running 'test-params.R' [1s]
  Running 'test-run.R' [159s]
  Running 'test-run_r.R' [1s]
  Running 'test-run_tmb-reporting_enabled.R' [173s]
  Running 'test-run_tmb.R' [165s]
  Running 'test-step.R' [1s]
  Running 'test-stock.R' [1s]
  Running 'test-stock_age.R' [1s]
  Running 'test-stock_areas.R' [1s]
  Running 'test-stock_tag.R' [0s]
  Running 'test-stock_time.R' [1s]
  Running 'test-suitability.R' [2s]
  Running 'test-timedata.R' [1s]
  Running 'test-timevariable.R' [1s]
Running the tests in 'tests/test-action_grow.R' failed.
Complete output:
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > read.matrix <- function (x, ...) unname(as.matrix(read.table(text=x, ...)))
  > 
  > teststock <- g3_stock('teststock', seq(10, 35, 5))
  > 
  > ok_group("g3a_grow_lengthvbsimple", {
  +     # Run g3a_grow_lengthvbsimple for given linf and midlen
  +     lvs <- function (linf, kappa = 100) {
  +         as.numeric(g3_eval(
  +             g3a_grow_lengthvbsimple(linf, kappa),
  +             stock = g3_stock("s", seq(10, 100, 10) - 5),
  +             cur_step_size = 1))
  +     }
  +     ok(ut_cmp_equal(
  +         lvs(linf = 150), 
  +         c(140, 130, 120, 110, 100, 90, 80, 70, 60, 50)), "linf = 150")
  +     ok(ut_cmp_equal(
  +         lvs(linf = 55), 
  +         c(45, 35, 25, 15, 5, 0, 0, 0, 0, 0), tolerance = 1e-7), "linf = 55 (linf doesn't fall negative)")
  + })
  # g3a_grow_lengthvbsimple
  ok - linf = 150
  ok - linf = 55 (linf doesn't fall negative)
  > 
  > ok_group("g3a_grow_impl_bbinom:zero-growth", {
  +     # Run g3a_grow_impl_bbinom for given linf and midlen
  +     gim <- function (linf, kappa = 20, beta = 0.5, maxlengthgroupgrowth = 10) {
  +         g3_eval(
  +             g3a_grow_impl_bbinom(g3a_grow_lengthvbsimple(linf, kappa), ~0, beta, maxlengthgroupgrowth)$len,
  +             stock = g3_stock("s", seq(10, 100, 10) - 5),
  +             cur_step_size = 1)
  +     }
  + 
  +     ok(ut_cmp_equal(round(gim(linf = 120, maxlengthgroupgrowth = 5), 2), read.matrix('
  +         8.29  8.44  0.40  0.17 0.12 0.15
  +         9.00 10.00  0.00  0.00 0.00 0.00
  +        11.43 14.29  1.02  0.36 0.22 0.26
  +        26.56 39.35  7.50  2.00 1.11 1.18
  +        26.18 50.91 21.82  2.18 0.91 0.82
  +        21.00 70.00 80.00 32.00 0.00 0.00
  +         0.00  0.00  0.00  0.00 0.00 1.00
  +         0.02  0.05  0.08  0.13 0.21 0.51
  +         0.14  0.12  0.12  0.13 0.17 0.32
  +         0.37  0.14  0.10  0.10 0.11 0.19
  +      ')),"linf=120, maxlengthgroupgrowth=5")
  +      # TODO: rowSums(gim(linf = 120, maxlengthgroupgrowth = 5)) should be 1?
  + 
  +     ok(ut_cmp_equal(round(gim(linf = 40, maxlengthgroupgrowth = 5), 2), read.matrix('
  +         0.14 0.12 0.12 0.13 0.17 0.32
  +         0.37 0.14 0.10 0.10 0.11 0.19
  +         0.66 0.09 0.06 0.05 0.05 0.09
  +         1.00 0.00 0.00 0.00 0.00 0.00
  +         1.00 0.00 0.00 0.00 0.00 0.00
  +         1.00 0.00 0.00 0.00 0.00 0.00
  +         1.00 0.00 0.00 0.00 0.00 0.00
  +         1.00 0.00 0.00 0.00 0.00 0.00
  +         1.00 0.00 0.00 0.00 0.00 0.00
  +         1.00 0.00 0.00 0.00 0.00 0.00
  +     ')),"linf=40, maxlengthgroupgrowth=5 - Linf lower than Lmax produces valid output")
  +     ok(ut_cmp_equal(
  +         rowSums(gim(linf = 40, maxlengthgroupgrowth = 5)),
  +         rep(1, 10), tolerance = 1e-2), "linf=40, maxlengthgroupgrowth=5 - Rows sum to 1")
  + })
  # g3a_grow_impl_bbinom:zero-growth
  ok - linf=120, maxlengthgroupgrowth=5
  ok - linf=40, maxlengthgroupgrowth=5 - Linf lower than Lmax produces valid output
  ok - linf=40, maxlengthgroupgrowth=5 - Rows sum to 1
  > 
  > ok_group("g3a_grow_impl_bbinom", {
  +     actions <- list(  # dmu, lengthgrouplen, binn, beta
  +         g3a_time(2000, 2001, project_years = 0),
  +         g3a_initialconditions(teststock, ~g3_param_vector("initial", value = c(10, 100, 1000, 1000, 10000, 100000)), ~0 * teststock__minlen),
  +         g3a_growmature(teststock,
  +             impl_f = g3a_grow_impl_bbinom(
  +                 delta_len_f = g3a_grow_lengthvbsimple(~g3_param('linf', value = 160), ~g3_param('kappa', value = 90)),
  +                 delta_wgt_f = g3a_grow_weightsimple(~g3_param('walpha', value = 3), ~g3_param('wbeta', value = 2)),
  +                 beta = ~g3_param('beta', value = 30),
  +                 maxlengthgroupgrowth = 4)),
  +         list(
  +             "999" = ~{
  +                 REPORT(teststock__growth_l)
  +                 REPORT(teststock__growth_w)
  +                 nll <- nll + g3_param('x', value = 1.0)
  +                 return(nll)
  +             }))
  + 
  +     # Compile model
  +     # NB: Growth not valid, but not testing growth at this point
  +     model_fn <- g3_to_r(actions, trace = FALSE, strict = FALSE)
  +     # model_fn <- edit(model_fn)
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_cpp <- g3_to_tmb(actions, trace = FALSE, strict = FALSE)
  +         # model_cpp <- edit(model_cpp)
  +         model_tmb <- g3_tmb_adfun(model_cpp,  attr(model_fn, 'parameter_template'), compile_flags = c("-O0", "-g"))
  +     } else {
  +         writeLines("# skip: not compiling TMB model")
  +     }
  + 
  +     params <- attr(model_fn, 'parameter_template')
  +     result <- model_fn(params)
  +     r <- attributes(result)
  +     # str(result)
  +     # str(as.list(r), vec.len = 10000)
  + 
  +     #writeLines(deparse(r$teststock__growth_l))
  +     ok(ut_cmp_equal(r$teststock__growth_l, structure(c(12199.8976226175, 9352.23228375502, 7157.83523789257,
  +     5463.49450549465, 4154.31593595054, 3143.22179218075, 51322.2074676947,
  +     39560.4630926918, 30458.8733527337, 23399.2087912083, 17917.1342692155,
  +     13660.121314133, 81087.2009530949, 62860.2639001552, 48695.7187344743,
  +     37658.1016483506, 29043.7267350904, 22317.4314305221, 57032.8699935755,
  +     44472.5676572519, 34669.6583623158, 26995.0549450546, 20974.8144063369,
  +     16247.8860873661, 15068.9788855573, 11821.5345660349, 9275.97774268346,
  +     7273.66758241751, 5694.90600451131, 4448.35417879727),
  +         .Dimnames = list(length = c("10:15", "15:20", "20:25", "25:30", "30:35", "35:Inf"), delta = c("0", "1", "2", "3", "4")),
  +         .Dim = c(length = 6, delta = 5)), tolerance = 1e-5), "Matches baseline")
  + 
  +     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)
  +     }
  + 
  +     # Try comparing with a few different inputs
  +     for (x in 1:10) ok_group("g3a_grow_impl_bbinom random params", {
  +         params <- attr(model_fn, 'parameter_template')
  +         params$linf <- runif(1, 100, 200)
  +         params$kappa <- runif(1, 50, 100)
  +         params$walpha <- runif(1, 0.1, 3)
  +         params$wbeta <- runif(1, 0.1, 2)
  +         params$beta <- runif(1, 10, 30)
  +         params$initial <- runif(6, 1000, 9000)
  +         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)
  +         }
  +     })
  + })
  # g3a_grow_impl_bbinom
  # skip: not compiling TMB model
  ok - Matches baseline
  # g3a_grow_impl_bbinom random params
  # g3a_grow_impl_bbinom random params
  # g3a_grow_impl_bbinom random params
  # g3a_grow_impl_bbinom random params
  # g3a_grow_impl_bbinom random params
  # g3a_grow_impl_bbinom random params
  # g3a_grow_impl_bbinom random params
  # g3a_grow_impl_bbinom random params
  # g3a_grow_impl_bbinom random params
  # g3a_grow_impl_bbinom random params
  > 
  > ok_group("g3a_growmature", {
  +     actions <- list(
  +         g3a_time(2000, 2001, project_years = 0),
  +         g3a_initialconditions(teststock,
  +             ~g3_param_vector("initial_num"),
  +             ~g3_param_vector("initial_wgt")),
  +         g3a_growmature(teststock,
  +             impl_f = list(
  +                 delta_dim = as.character(0:6),
  +                 len = ~g3_param_array('growth_matrix'),
  +                 wgt = ~g3_param_array('weight_matrix'))),
  +         list(
  +             "999" = ~{
  +                 REPORT(teststock__num)
  +                 REPORT(teststock__wgt)
  +                 nll <- nll + g3_param('x')
  +                 return(nll)
  +             }))
  +     params <- attr(model_fn, 'parameter_template')
  +     params$initial_num <- c(10, 100, 1000, 1000, 10000, 100000)
  +     params$initial_wgt <- c(100, 200, 300, 400, 500, 600)
  +     params$growth_matrix <- array(dim = c(6, 7))
  +     params$weight_matrix <- array(0, dim = c(6, 7))
  + 
  +     # Compile model
  +     # NB: Our tests don't preserve counts, so we can't enable strict here
  +     model_fn <- g3_to_r(actions, trace = FALSE, strict = FALSE)
  +     # model_fn <- edit(model_fn)
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_cpp <- g3_to_tmb(actions, trace = FALSE, strict = FALSE)
  +         # model_cpp <- edit(model_cpp)
  +         model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g"))
  +     } else {
  +         writeLines("# skip: not compiling TMB model")
  +     }
  + 
  +     gm <- array(c(
  +      # 10    15 20   25   30 35
  +         0, 0.25, 1, 0.5, 0.5, 1,  # 0
  +         0,    0, 0,   0,   0, 0,  # +1
  +         1, 0.75, 0,   0,   0, 0,  # +2
  +         0,    0, 0,   0,   0, 0,  # +3
  +         0,    0, 0,   0, 0.5, 0,  # +4
  +         0,    0, 0,   0,   0, 0,  # +5
  +         0,    0, 0, 0.5,   0, 0), dim = c(6,7))
  +     params <- attr(model_fn, 'parameter_template')
  +     params$initial_num <- c(10, 100, 1000, 1000, 10000, 100000)
  +     params$initial_wgt <- c(100, 200, 300, 400, 500, 600)
  +     params$growth_matrix <- gm
  +     params$weight_matrix <- array(0, dim = c(6, 7))
  +     result <- model_fn(params)
  +     r <- attributes(result)
  +     # str(result)
  +     # str(as.list(r), vec.len = 10000)
  + 
  +     # model_fn <- edit(model_fn)
  +     result <- model_fn(params)
  +     ok(ut_cmp_identical(
  +         as.vector(r$teststock__num),
  +         c(0, 25, 1010, 575, 5000, 105500)), "Stock individuals have been scaled by matrix, can't escape plus-group")
  +     ok(ut_cmp_equal(as.vector(r$teststock__wgt), c(
  +         0 / g3_env$logspace_add(0, 0),
  +         (200 * 100*0.25) / 25,
  +         (300 * 1000 + 100 * 10) / 1010,
  +         (400 * 1000*0.5 + 200 * 100*0.75) / 575,
  +         (500 * 10000*0.5) / 5000,
  +         (600 * 100000 + 500 * 10000*0.5 + 400 * 1000*0.5) / 105500,
  +         NULL), tolerance = 1e-5), "Weight scaled, didn't let weight go to infinity when dividing by zero")
  + 
  +     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)
  +     }
  + })
  # g3a_growmature
  # skip: not compiling TMB model
  ok - Stock individuals have been scaled by matrix, can't escape plus-group
  ok - Weight scaled, didn't let weight go to infinity when dividing by zero
  > 
  > proc.time()
     user  system elapsed 
     1.34    0.09    1.42 
Running the tests in 'tests/test-action_mature.R' failed.
Complete output:
  > if (!interactive()) options(warn=2, error = function() { sink(stderr()) ; traceback(3) ; q(status = 1) })
  > library(magrittr)
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > ok_group('g3a_mature_constant', {
  +     cmp_code <- function(a, b) ut_cmp_identical(rlang::f_rhs(a), rlang::f_rhs(b))
  + 
  +     ok(cmp_code(
  +         g3a_mature_constant(),
  +         ~1/(1 + exp(0)) ), "No arguments")
  + 
  +     # Invalid combinations
  +     ok(ut_cmp_error(g3a_mature_constant(alpha = 2), "l50"), "Missing l50")
  +     ok(ut_cmp_error(g3a_mature_constant(beta = 2), "a50"), "Missing a50")
  +     ok(ut_cmp_error(g3a_mature_constant(gamma = 2), "k50"), "Missing k50")
  + 
  +     # Single alpha/beta/gamma
  +     ok(cmp_code(
  +         g3a_mature_constant(alpha = 28, l50 = 24),
  +         ~1/(1 + exp((0 - (28) * (stock__midlen - (24))))) ), "alpha = 28, l50 = 24")
  +     ok(cmp_code(
  +         g3a_mature_constant(beta = 18, a50 = 83),
  +         ~1/(1 + exp((0 - (18) * (age - (83))))) ), "beta = 18, a50 = 83")
  +     ok(cmp_code(
  +         g3a_mature_constant(gamma = 82, k50 = 27),
  +         ~1/(1 + exp((0 - (82) * (stock_ss(stock__wgt) - (27))))) ), "gamma = 82, k50 = 27")
  + 
  +     # Zero will also remove conditions
  +     ok(cmp_code(
  +         g3a_mature_constant(alpha = 28, l50 = 24, beta = 0, gamma = 0),
  +         ~1/(1 + exp((0 - (28) * (stock__midlen - (24))))) ), "alpha = 28, l50 = 24")
  +     ok(cmp_code(
  +         g3a_mature_constant(beta = 18, a50 = 83, alpha = 0, gamma = 0),
  +         ~1/(1 + exp((0 - (18) * (age - (83))))) ), "beta = 18, a50 = 83")
  + 
  +     # Can combine parameters
  +     ok(cmp_code(
  +         g3a_mature_constant(alpha = 73, l50 = 16, beta = 54, a50 = 32),
  +         ~1/(1 + exp(((0 - (73) * (stock__midlen - (16)))
  +                       - (54) * (age - (32)))
  +                       ))), "alpha = 73, l50 = 16, beta = 54, a50 = 32")
  +     ok(cmp_code(
  +         g3a_mature_constant(beta = 73, a50 = 67, gamma = 39, k50 = 73),
  +         ~1/(1 + exp(((0 - (73) * (age - (67)))
  +                       - (39) * (stock_ss(stock__wgt) - (73))
  +                       )))), "beta = 73, a50 = 67, gamma = 39, k50 = 73")
  + 
  +     # alpha/beta/gamma can be formula
  +     ok(cmp_code(
  +         g3a_mature_constant(alpha = ~g3_param("ling.mat1"), l50 = ~g3_param("ling.mat2")),
  +         ~1/(1 + exp((0 - (g3_param("ling.mat1")) * (stock__midlen - (g3_param("ling.mat2"))))))), "alpha = formula")
  + 
  +     ok(cmp_code(
  +         g3a_mature_constant(beta = ~g3_param("ling.mat1"), a50 = ~g3_param("ling.mat2")),
  +         ~1/(1 + exp((0 - (g3_param("ling.mat1")) * (age - (g3_param("ling.mat2"))))))), "beta = formula")
  + 
  +     ok(cmp_code(
  +         g3a_mature_constant(gamma = ~g3_param("ling.mat1"), k50 = ~g3_param("ling.mat2")),
  +         ~1/(1 + exp((0 - (g3_param("ling.mat1")) * (stock_ss(stock__wgt) - (g3_param("ling.mat2"))))))), "gamma = formula")
  + })
  # g3a_mature_constant
  ok - No arguments
  ok - Missing l50
  ok - Missing a50
  ok - Missing k50
  ok - alpha = 28, l50 = 24
  ok - beta = 18, a50 = 83
  ok - gamma = 82, k50 = 27
  ok - alpha = 28, l50 = 24
  ok - beta = 18, a50 = 83
  ok - alpha = 73, l50 = 16, beta = 54, a50 = 32
  ok - beta = 73, a50 = 67, gamma = 39, k50 = 73
  ok - alpha = formula
  ok - beta = formula
  ok - gamma = formula
  > 
  > ok_group('g3a_mature', {
  +     stock_imm <- g3_stock('stock_imm', seq(10, 40, 10)) %>% g3s_age(3, 7)
  +     stock_mat1 <- g3_stock('stock_mat1', seq(10, 40, 10)) %>% g3s_age(4, 7)
  +     stock_mat2 <- g3_stock('stock_mat2', seq(10, 40, 10)) %>% g3s_age(5, 7)
  + 
  +     ok(ut_cmp_error(
  +         g3a_mature(stock_imm, ~g3_param_vector("maturity"), list(stock_mat1, stock_mat2), output_ratios = c(9,9,9)),
  +         "output_ratios"), "Length of output_ratios must match")
  +     ok(ut_cmp_error(
  +         g3a_mature(stock_imm, ~g3_param_vector("maturity"), list(stock_mat1, stock_mat2), output_ratios = c(9,9)),
  +         "output_ratios"), "output_ratios must sum to 1")
  + 
  +     actions <- list(
  +         g3a_time(2000, 2000, project_years = 0),
  +         g3a_initialconditions(stock_imm, ~max(6L - age, 1L) * g3_param_vector("imm_init_num"), ~g3_param_vector("imm_init_wgt")),
  +         g3a_initialconditions(stock_mat1, ~max(6L - age, 1L) * g3_param_vector("mat1_init_num"), ~g3_param_vector("mat1_init_wgt")),
  +         g3a_initialconditions(stock_mat2, ~max(6L - age, 1L) * g3_param_vector("mat2_init_num"), ~g3_param_vector("mat2_init_wgt")),
  +         g3a_mature(stock_imm,
  +             ~g3_param_vector("maturity"),
  +             list(stock_mat1, stock_mat2),
  +             output_ratios = list(~g3_param("ratio_mat1"), ~g3_param("ratio_mat2")),
  +             run_f = ~g3_param("run_f") == 1),
  +         list(
  +             '999' = ~{
  +                 REPORT(stock_imm__num)
  +                 REPORT(stock_imm__wgt)
  +                 REPORT(stock_mat1__num)
  +                 REPORT(stock_mat1__wgt)
  +                 REPORT(stock_mat2__num)
  +                 REPORT(stock_mat2__wgt)
  +                 nll <- nll + g3_param('x')
  +                 return(nll)
  +             }))
  + 
  +     # Compile model
  +     model_fn <- g3_to_r(actions, trace = FALSE)
  +     # model_fn <- edit(model_fn)
  +     params <- attr(model_fn, 'parameter_template')
  +     params$imm_init_num <- c(101, 102, 103, 104)
  +     params$imm_init_wgt <- c(1, 2, 3, 4)
  +     params$maturity <- c(0, 0, 1, 0)
  +     params$mat1_init_num <- c(10, 20, 30, 40)
  +     params$mat1_init_wgt <- c(9, 8, 7, 6)
  +     params$mat2_init_num <- c(0, 0, 0, 0)
  +     params$mat2_init_wgt <- c(0, 0, 0, 0)
  +     params$ratio_mat1 <- 0.5
  +     params$ratio_mat2 <- 0.5
  +     params$run_f <- 1  # TODO: if(param) is naughty
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_cpp <- g3_to_tmb(actions, trace = FALSE)
  +         # model_cpp <- edit(model_cpp)
  +         model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g"))
  +     } else {
  +         writeLines("# skip: not compiling TMB model")
  +     }
  + 
  +     ok_group("Move all of length 30 into mat1/mat2", {
  +         params <- attr(model_fn, 'parameter_template')
  +         params$imm_init_num <- c(101, 102, 103, 104)
  +         params$imm_init_wgt <- c(1, 2, 3, 4)
  +         params$maturity <- c(0, 0, 1, 0)
  +         params$mat1_init_num <- c(10, 20, 30, 40)
  +         params$mat1_init_wgt <- c(9, 8, 7, 6)
  +         params$mat2_init_num <- c(0, 0, 0, 0)
  +         params$mat2_init_wgt <- c(0, 0, 0, 0)
  +         params$ratio_mat1 <- 0.5
  +         params$ratio_mat2 <- 0.5
  +         params$run_f <- 1
  + 
  +         result <- model_fn(params)
  +         r <- attributes(result)
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_imm__num[,'age5']),
  +             c(101, 102, 0, 104)), "stock_imm__num")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_imm__num[length = '30:40',]),
  +             c(103 * 3, (103 * 2) / 2, 0, 0, 0)), "stock_imm__num: age3 and half of age4 left behind, since they don't fit in mature stocks")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_mat1__num[,'age5']),
  +             c(10, 20, 30 + (103 / 2), 40)), "stock_mat1__num (NB: Added to existing numbers)")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_mat1__num[length = '30:40',]),
  +             c(60 + (103 * 2) / 2, 81.5, 81.5, 81.5)), "stock_mat1__num: Got half of age4")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_mat2__num[,'age5']),
  +             c(0, 0, 103 / 2, 0)), "stock_mat2__num")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_mat2__num[length = '30:40',]),
  +             c(51.5, 51.5, 51.5)), "stock_mat2__num: Just age 5/6/7")
  + 
  +         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)
  +         }
  +     })
  + 
  +     ok_group("Move all of length 30 into 90% mat1, 10% mat2", {
  +         params <- attr(model_fn, 'parameter_template')
  +         params$imm_init_num <- c(101, 102, 103, 104)
  +         params$imm_init_wgt <- c(1, 2, 3, 4)
  +         params$maturity <- c(0, 0, 1, 0)
  +         params$mat1_init_num <- c(10, 20, 30, 40)
  +         params$mat1_init_wgt <- c(9, 8, 7, 6)
  +         params$mat2_init_num <- c(0, 0, 0, 0)
  +         params$mat2_init_wgt <- c(0, 0, 0, 0)
  +         params$ratio_mat1 <- 0.9
  +         params$ratio_mat2 <- 0.1
  +         params$run_f <- 1
  + 
  +         result <- model_fn(params)
  +         r <- attributes(result)
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_imm__num[,'age5']),
  +             c(101, 102, 0, 104)), "stock_imm__num")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_mat1__num[,'age5']),
  +             c(10, 20, 30 + (103 * 0.9), 40)), "stock_mat1__num (NB: Added to existing numbers)")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_mat2__num[,'age5']),
  +             c(0, 0, 103 * 0.1, 0)), "stock_mat2__num")
  + 
  +         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)
  +         }
  +     })
  + 
  +     ok_group("Move 50% of length 30, 75% of length 40", {
  +         params <- attr(model_fn, 'parameter_template')
  +         params$imm_init_num <- c(101, 102, 103, 104)
  +         params$imm_init_wgt <- c(1, 2, 3, 4)
  +         params$maturity <- c(0, 0, 0.5, 0.75)
  +         params$mat1_init_num <- c(10, 20, 30, 40)
  +         params$mat1_init_wgt <- c(9, 8, 7, 6)
  +         params$mat2_init_num <- c(0, 0, 0, 0)
  +         params$mat2_init_wgt <- c(0, 0, 0, 0)
  +         params$ratio_mat1 <- 0.5
  +         params$ratio_mat2 <- 0.5
  +         params$run_f <- 1
  + 
  +         result <- model_fn(params)
  +         r <- attributes(result)
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_imm__num[,'age5']),
  +             c(101, 102, 103 * 0.5, 104 * 0.25)), "stock_imm__num")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_mat1__num[,'age5']),
  +             c(10, 20, 30 + (103 * 0.5 / 2), 40 + (104 * 0.75 / 2))), "stock_mat1__num (NB: Added to existing numbers)")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_mat2__num[,'age5']),
  +             c(0, 0, 103 * 0.5 / 2, 104 * 0.75 / 2)), "stock_mat2__num")
  + 
  +         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)
  +         }
  +     })
  + 
  +     ok_group("Disable with run_f = 0", {
  +         params <- attr(model_fn, 'parameter_template')
  +         params$imm_init_num <- c(101, 102, 103, 104)
  +         params$imm_init_wgt <- c(1, 2, 3, 4)
  +         params$maturity <- c(0, 0, 0.5, 0.75)
  +         params$mat1_init_num <- c(10, 20, 30, 40)
  +         params$mat1_init_wgt <- c(9, 8, 7, 6)
  +         params$mat2_init_num <- c(0, 0, 0, 0)
  +         params$mat2_init_wgt <- c(0, 0, 0, 0)
  +         params$ratio_mat1 <- 0.5
  +         params$ratio_mat2 <- 0.5
  +         params$run_f <- 0  # NB: Turned off
  + 
  +         result <- model_fn(params)
  +         r <- attributes(result)
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_imm__num[,'age5']),
  +             c(101, 102, 103, 104)), "stock_imm__num same as start")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_mat1__num[,'age5']),
  +             c(10, 20, 30, 40)), "stock_mat1__num same as start")
  +         ok(ut_cmp_equal(
  +             as.vector(r$stock_mat2__num[,'age5']),
  +             c(0, 0, 0, 0)), "stock_mat2__num same as start")
  + 
  +         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)
  +         }
  +     })
  + })
  # g3a_mature
  ok - Length of output_ratios must match
  ok - output_ratios must sum to 1
  # skip: not compiling TMB model
  # Move all of length 30 into mat1/mat2
  ok - stock_imm__num
  ok - stock_imm__num: age3 and half of age4 left behind, since they don't fit in mature stocks
  ok - stock_mat1__num (NB: Added to existing numbers)
  ok - stock_mat1__num: Got half of age4
  ok - stock_mat2__num
  ok - stock_mat2__num: Just age 5/6/7
  # Move all of length 30 into 90% mat1, 10% mat2
  ok - stock_imm__num
  ok - stock_mat1__num (NB: Added to existing numbers)
  ok - stock_mat2__num
  # Move 50% of length 30, 75% of length 40
  ok - stock_imm__num
  ok - stock_mat1__num (NB: Added to existing numbers)
  ok - stock_mat2__num
  # Disable with run_f = 0
  ok - stock_imm__num same as start
  ok - stock_mat1__num same as start
  ok - stock_mat2__num same as start
  > 
  > ok_group('movement with non-conforming stocks', {
  +     # Transform required from a -> b+c, make sure we can form a model
  +     prey_a <- g3_stock('prey_a', seq(20, 160, 4)) %>% g3s_age(11, 12)
  +     prey_b <- g3_stock('prey_b', seq(20, 160, 4)) %>% g3s_age(11, 15)
  +     prey_c <- g3_stock('prey_c', seq(20, 164, 4)) %>% g3s_age(11, 15)
  +     # Build model, if missing vars are present the warning will be translated into error
  +     m <- g3_to_r(list(
  +         g3a_time(2000, 2002, step_lengths = c(6, 6), project_years = 0),
  +         g3a_age(prey_a, output_stocks = list(prey_b, prey_c), output_ratios = c(0.5,0.5))))
  + })
  # movement with non-conforming stocks
  > 
  > proc.time()
     user  system elapsed 
     1.85    0.12    1.96 
Running the tests in 'tests/test-action_migrate.R' failed.
Complete output:
  > library(magrittr)
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > areas <- list(a=1, b=2, c=3, d=4)
  > # NB: stock doesn't live in b, shouldn't try to migrate there
  > stock_acd <- (g3_stock('stock_acd', seq(10, 40, 10))
  +     %>% g3s_age(3, 7)
  +     %>% g3s_livesonareas(areas[c('a', 'c', 'd')]))
  > 
  > ok_group("g3a_migrate_normalize", {
  +     mn <- function (migratematrix, area_idx, row_total = 1) {
  +         g3_eval(g3a_migrate_normalize(row_total), list(
  +             stock__migratematrix = migratematrix,
  +             stock__area_idx = area_idx))
  +     }
  + 
  +     ok(ut_cmp_equal(
  +         mn(array(c(sqrt(0.2), 0), dim = c(3,3)), 1),
  +         c(0.8, 0, 0.2)), "Correct row selected, output balanced by adjusting stationary individuals")
  +     ok(ut_cmp_equal(
  +         mn(array(c(sqrt(0.2), 0), dim = c(3,3)), 2),
  +         c(0, 1, 0)), "Attempts to set proportion of stationary individuals ignored")
  +     ok(ut_cmp_equal(
  +         mn(array(c(sqrt(0.2), 0, 0), dim = c(3,3)), 3),
  +         c(0.2, 0, 0.8)), "Output balanced by adjusting stationary individuals")
  + 
  +     ok(ut_cmp_equal(
  +         mn(array(c(sqrt(0.2), 0), dim = c(3,3)), 1, row_total = 10),
  +         c(0.98, 0, 0.02)), "Correct row selected, output balanced by adjusting stationary individuals")
  + })
  # g3a_migrate_normalize
  ok - Correct row selected, output balanced by adjusting stationary individuals
  ok - Attempts to set proportion of stationary individuals ignored
  ok - Output balanced by adjusting stationary individuals
  ok - Correct row selected, output balanced by adjusting stationary individuals
  > 
  > ok_group("g3a_migrate", {
  +     actions <- list(
  +         g3a_time(start_year = 2000, end_year = 2004, step_lengths = c(3,3,3,3), project_years = 0),
  +         g3a_initialconditions(stock_acd,
  +             ~area * 100 + stock_acd__minlen,
  +             ~area * 10 + stock_acd__minlen),
  +         g3a_migrate(
  +             stock_acd,
  +             # 0.6324555 == sqrt(0.4)
  +             ~if (area == area_d && dest_area == area_a) g3_param("migrate_spring", value = 0.6324555320336759) else 0,
  +             run_f = ~cur_step == 2),
  +         g3a_migrate(
  +             stock_acd,
  +             ~if (area == area_a && dest_area == area_c) g3_param("migrate_winter", value = 0.7745966692414834)
  +               else if (area == area_c && dest_area == area_d) g3_param("migrate_winter", value = 0.7745966692414834)
  +               else 0,
  +             run_f = ~cur_step == 4),
  +         g3a_report_stock(g3s_clone(stock_acd, 'report_acd') %>% gadget3:::g3s_modeltime(), stock_acd, ~stock_ss(input_stock__num)),
  +         g3a_report_stock(g3s_clone(stock_acd, 'report_acd') %>% gadget3:::g3s_modeltime(), stock_acd, ~stock_ss(input_stock__wgt)),
  +         list())
  + 
  +     # Compile model
  +     model_fn <- g3_to_r(actions)
  +     # model_fn <- edit(model_fn)
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_cpp <- g3_to_tmb(actions, trace = FALSE)
  +         # model_cpp <- edit(model_cpp)
  +         model_tmb <- g3_tmb_adfun(model_cpp, compile_flags = c("-O0", "-g"))
  +     } else {
  +         writeLines("# skip: not compiling TMB model")
  +     }
  + 
  +     params <- attr(model_fn, 'parameter_template')
  +     result <- model_fn(params)
  + 
  +     # Make sure the model produces identical output in TMB and R
  +     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)
  +     }
  + 
  +     for (a in paste0('age', 4:7)) {
  +         ok(ut_cmp_equal(
  +             attr(result, 'report_acd__num')[, age = 'age3',,],
  +             attr(result, 'report_acd__num')[, age = a,,]), "Age ranges match, we're not selecting by age")
  +     }
  + 
  +     # Check one age/length pair to simplify matters
  +     model_nums <- attr(result, 'report_acd__num')[length = '10:20', age = 'age3',,]
  +     model_wgts <- attr(result, 'report_acd__wgt')[length = '10:20', age = 'age3',,]
  +     expected_nums <- model_nums[,1]
  +     expected_wgts <- model_wgts[,1]
  +     ratio_add_vec <- function (orig_vec, orig_amount, new_vec, new_amount) (orig_vec * orig_amount + new_vec * new_amount)/(orig_amount + new_amount)
  +     for (t in 1:((2004 - 2000) * 3)) {
  +         if ((t-1) %% 4 == 1) {
  +             # Spring migration, apply it ourselves
  +             expected_wgts['a'] <- ratio_add_vec(
  +                 expected_wgts['a'], expected_nums['a'],
  +                 expected_wgts['d'], expected_nums['d'] * 0.4)
  +             expected_nums['a'] <- expected_nums['a'] + expected_nums['d'] * 0.4
  +             expected_nums['d'] <- expected_nums['d'] - expected_nums['d'] * 0.4
  +         }
  +         if ((t-1) %% 4 == 3) {
  +             # Autumn migration, apply it ourselves
  +             # NB: We shouldn't be migrating anything direct a -> d
  +             # c -> d
  +             expected_wgts['d'] <- ratio_add_vec(
  +                 expected_wgts['d'], expected_nums['d'],
  +                 expected_wgts['c'], expected_nums['c'] * 0.6)
  +             expected_nums['d'] <- expected_nums['d'] + expected_nums['c'] * 0.6
  +             expected_nums['c'] <- expected_nums['c'] - expected_nums['c'] * 0.6
  +             # a -> c
  +             expected_wgts['c'] <- ratio_add_vec(
  +                 expected_wgts['c'], expected_nums['c'],
  +                 expected_wgts['a'], expected_nums['a'] * 0.6)
  +             expected_nums['c'] <- expected_nums['c'] + expected_nums['a'] * 0.6
  +             expected_nums['a'] <- expected_nums['a'] - expected_nums['a'] * 0.6
  +         }
  +         ok(ut_cmp_equal(model_nums[,t], expected_nums), paste0("Model numbers matched expected, t = ", t))
  +         ok(ut_cmp_equal(model_wgts[,t], expected_wgts), paste0("Model weights matched expected, t = ", t))
  +     }
  + })
  # g3a_migrate
  # skip: not compiling TMB model
  ok - Age ranges match, we're not selecting by age
  ok - Age ranges match, we're not selecting by age
  ok - Age ranges match, we're not selecting by age
  ok - Age ranges match, we're not selecting by age
  ok - Model numbers matched expected, t = 1
  ok - Model weights matched expected, t = 1
  ok - Model numbers matched expected, t = 2
  ok - Model weights matched expected, t = 2
  ok - Model numbers matched expected, t = 3
  ok - Model weights matched expected, t = 3
  ok - Model numbers matched expected, t = 4
  ok - Model weights matched expected, t = 4
  ok - Model numbers matched expected, t = 5
  ok - Model weights matched expected, t = 5
  ok - Model numbers matched expected, t = 6
  ok - Model weights matched expected, t = 6
  ok - Model numbers matched expected, t = 7
  ok - Model weights matched expected, t = 7
  ok - Model numbers matched expected, t = 8
  ok - Model weights matched expected, t = 8
  ok - Model numbers matched expected, t = 9
  ok - Model weights matched expected, t = 9
  ok - Model numbers matched expected, t = 10
  ok - Model weights matched expected, t = 10
  ok - Model numbers matched expected, t = 11
  ok - Model weights matched expected, t = 11
  ok - Model numbers matched expected, t = 12
  ok - Model weights matched expected, t = 12
  > 
  > proc.time()
     user  system elapsed 
     1.31    0.07    1.39 
Running the tests in 'tests/test-action_renewal.R' failed.
Complete output:
  > library(magrittr)
  > library(unittest)
  > 
  > cmp_formula <- function (a, b) {
  +     ordered_list <- function (x) {
  +         x <- as.list(x)
  +         # NB: Can't order an empty list
  +         if (length(x) > 0) x[order(names(x))] else x
  +     }
  + 
  +     out <- ut_cmp_identical(rlang::f_rhs(a), rlang::f_rhs(b))
  +     if (!identical(out, TRUE)) return(out)
  +     out <- ut_cmp_identical(ordered_list(environment(a)), ordered_list(environment(b)))
  +     return(out)
  + }
  > 
  > library(gadget3)
  > 
  > ok_group('g3a_renewal_vonb_recl', {
  +     ok(cmp_formula(g3a_renewal_vonb_recl(), g3_formula(
  +         stock_prepend(stock, g3_param("Linf", value = 1), name_part = NULL) * (1 - exp(-1 *
  +             stock_prepend(stock, g3_param("K", value = 1), name_part = NULL) *
  +             (age - (g3_param("recage", optimise = FALSE) + 
  +                       log(1 - stock_prepend(stock, g3_param("recl"), name_part = NULL) /
  +                 stock_prepend(stock, g3_param("Linf", value = 1), name_part = NULL)) /
  +                 stock_prepend(stock, g3_param("K", value = 1), name_part = NULL)))))
  +             )), "Default params by stock")
  + 
  +     ok(cmp_formula(g3a_renewal_vonb_recl(by_stock = "species"), g3_formula(
  +         stock_prepend(stock, g3_param("Linf", value = 1), name_part = "species") * (1 - exp(-1 *
  +             stock_prepend(stock, g3_param("K", value = 1), name_part = "species") *
  +             (age - (g3_param("recage", optimise = FALSE) + 
  +                       log(1 - stock_prepend(stock, g3_param("recl"), name_part = "species") /
  +                 stock_prepend(stock, g3_param("Linf", value = 1), name_part = "species")) /
  +                 stock_prepend(stock, g3_param("K", value = 1), name_part = "species")))))
  +             )), "by_stock works for all default params")
  + 
  +     ok(cmp_formula(g3a_renewal_vonb_recl(Linf = 'Linf', K = g3_formula( x * 2, x = 10), recl = 'recl', recage = 'recage'), 
  +                    g3_formula(
  +                      "Linf" * (1 - exp(-1 * (x * 2) * (age - ("recage" + log(1 - "recl"/"Linf")/(x * 2))))),
  +                      x = 10)), "Can override with values, formulas")
  + })
  # g3a_renewal_vonb_recl
  ok - Default params by stock
  ok - by_stock works for all default params
  ok - Can override with values, formulas
  > 
  > ok_group('g3a_renewal_vonb_t0', {
  +     ok(cmp_formula(g3a_renewal_vonb_t0(), g3_formula(
  +         stock_prepend(stock, g3_param("Linf", value = 1), name_part = NULL) * (1 -
  +             exp(-1 * stock_prepend(stock, g3_param("K", value = 1), name_part = NULL) *
  +                 (age - stock_prepend(stock, g3_param("t0"), name_part = NULL) )))
  +             )), "Default params by stock")
  + 
  +     ok(cmp_formula(g3a_renewal_vonb_t0(by_stock = "species"), g3_formula(
  +         stock_prepend(stock, g3_param("Linf", value = 1), name_part = "species") *
  +             (1 - exp(-1 * stock_prepend(stock, g3_param("K",
  +                 value = 1), name_part = "species") * (age - stock_prepend(stock, g3_param("t0"), name_part = "species"))))
  +             )), "by_stock works for all default params")
  + 
  +     ok(cmp_formula(g3a_renewal_vonb_t0(Linf = 'Linf', K = g3_formula( x * 2, x = 10)), g3_formula(
  +         "Linf" * (1 - exp(-1 * (x * 2) * (age - stock_prepend(stock, g3_param("t0"), name_part = NULL))
  +         )), x = 10)), "Can override with values, formulas")
  + })
  # g3a_renewal_vonb_t0
  ok - Default params by stock
  ok - by_stock works for all default params
  ok - Can override with values, formulas
  > 
  > ok_group('g3a_renewal:run_f default parameterisation', {
  +     run_cond <- function (...) {
  +         fish <- g3s_age(g3_stock('fish', seq(20, 156, 4)), 3, 10)
  +         x <- g3a_renewal_normalparam(fish, ...)[[1]]
  +         # Find the contents of the first if statement
  +         gadget3:::f_find(x, as.symbol('if'))[[1]][[2]]
  +     }
  + 
  +     ok(ut_cmp_identical(run_cond(), quote(
  +         age == fish__minage && cur_step == 1 && (!cur_year_projection)
  +     )), "No params, got default")
  + 
  +     ok(ut_cmp_identical(run_cond(run_age = 5), quote(
  +         age == 5 && cur_step == 1 && (!cur_year_projection)
  +     )), "Overrode age")
  + 
  +     ok(ut_cmp_identical(run_cond(run_age = 2, run_projection = TRUE), quote(
  +         age == 2 && cur_step == 1
  +     )), "Overrode age & projection")
  + 
  +     ok(ut_cmp_identical(run_cond(run_step = 2), quote(
  +         age == fish__minage && cur_step == 2 && (!cur_year_projection)
  +     )), "Overrode run_step")
  + 
  +     ok(ut_cmp_identical(run_cond(run_step = NULL), quote(
  +         age == fish__minage && (!cur_year_projection)
  +     )), "run_step can be turned off entirely")
  + })
  # g3a_renewal:run_f default parameterisation
  ok - No params, got default
  ok - Overrode age
  ok - Overrode age & projection
  ok - Overrode run_step
  ok - run_step can be turned off entirely
  > 
  > ok_group('g3a_renewal:default parameterisation', {
  +     renewal_params <- function (...) {
  +         fish <- g3s_age(g3_stock('fish', seq(20, 156, 4)), 3, 10)
  +         fn <- g3_to_r(c(g3a_time(1990, 1994, c(3L, 3L, 3L, 3L)), g3a_renewal_normalparam(fish, ...)))
  +         sort(grep("^fish\\.rec\\.", names(attr(fn, 'parameter_template')), value = TRUE))
  +     }
  + 
  +     ok(ut_cmp_identical(renewal_params(), c(
  +         "fish.rec.1990", "fish.rec.1991", "fish.rec.1992", "fish.rec.1993", "fish.rec.1994",
  +         "fish.rec.scalar",
  +         "fish.rec.sd")), "Default, per-year rec, one scalar property")
  + })
  # g3a_renewal:default parameterisation
  ok - Default, per-year rec, one scalar property
  > 
  > ok_group('g3a_initialconditions_normalparam:age_offset', {
  +     extract_dnorm <- function (renewal_f, var_sym = as.symbol("dnorm")) {
  +         for (f in gadget3:::f_find(renewal_f[[1]], ":=")) {
  +             if (f[[2]] == var_sym) return(f[[3]])
  +         }
  +         stop("Could not find ", var_sym)
  +     }
  +     fish <- g3s_age(g3_stock('fish', seq(20, 156, 4)), 3, 10)
  + 
  +     out_f <- extract_dnorm(g3a_initialconditions_normalparam(
  +         fish,
  +         mean_f = quote(m_f),
  +         stddev_f = quote(stddev)))
  +     ok(cmp_formula(out_f, g3_formula(quote(
  +         (fish__midlen - m_f)/stddev)
  +     )), "mean_f = m_f, nothing to replace")
  + 
  +     out_f <- extract_dnorm(g3a_initialconditions_normalparam(
  +         fish,
  +         mean_f = quote(m_f + age - 4),
  +         stddev_f = quote(stddev)))
  +     ok(cmp_formula(out_f, g3_formula(quote(
  +         (fish__midlen - (m_f + (age - cur_step_size) - 4))/stddev)
  +     )), "mean_f = m_f + age - 4, replaced inner age")
  + 
  +     out_f <- extract_dnorm(g3a_initialconditions_normalparam(
  +         fish,
  +         mean_f = quote(m_f + age - 4),
  +         age_offset = 99,
  +         stddev_f = quote(stddev)))
  +     ok(cmp_formula(out_f, g3_formula(quote(
  +         (fish__midlen - (m_f + (age - 99) - 4))/stddev)
  +     )), "mean_f = m_f + age - 4, overrode age_offset")
  + 
  +     out_f <- extract_dnorm(g3a_initialconditions_normalparam(
  +         fish,
  +         mean_f = quote(m_f + age - 4),
  +         age_offset = NULL,
  +         stddev_f = quote(stddev)))
  +     ok(cmp_formula(out_f, g3_formula(quote(
  +         (fish__midlen - (m_f + age - 4))/stddev)
  +     )), "mean_f = m_f + age - 4, disabled age_offset")
  + 
  +     out_f <- extract_dnorm(g3a_initialconditions_normalcv(
  +         fish,
  +         mean_f = quote(m_f + age)))
  +     ok(cmp_formula(out_f, g3_formula(quote(
  +         (fish__midlen - (m_f + (age - cur_step_size)))
  +           /
  +         ((m_f + (age - cur_step_size)) * g3_param("fish.lencv", value = 0.1, optimise = FALSE))
  +     ))), "normalcv: Replaced age in both mean_f & stddev_f")
  + })
  # g3a_initialconditions_normalparam:age_offset
  ok - mean_f = m_f, nothing to replace
  ok - mean_f = m_f + age - 4, replaced inner age
  ok - mean_f = m_f + age - 4, overrode age_offset
  ok - mean_f = m_f + age - 4, disabled age_offset
  ok - normalcv: Replaced age in both mean_f & stddev_f
  > 
  > ok_group('g3a_initialconditions_cv', {
  +     extract_dnorm <- function (renewal_f, var_sym = as.symbol("dnorm")) {
  +         for (f in gadget3:::f_find(renewal_f[[1]], ":=")) {
  +             if (f[[2]] == var_sym) return(f[[3]])
  +         }
  +         stop("Could not find ", var_sym)
  +     }
  +     fish <- g3s_age(g3_stock('fish', seq(20, 156, 4)), 3, 10)
  + 
  +     ok(cmp_formula(extract_dnorm(g3a_initialconditions_normalparam(fish)), g3_formula(quote(
  +         (fish__midlen - (g3_param("fish.Linf", value = 1) * (1 - exp(-1 *
  +             g3_param("fish.K", value = 1) * ((age - cur_step_size) - g3_param("fish.t0"))))))
  +         / g3_param("fish.init.sd", value = 10)
  +     ))), "g3a_initialconditions_normalparam default")
  + 
  +     ok(cmp_formula(extract_dnorm(g3a_initialconditions_normalcv(fish)), g3_formula(quote(
  +         (fish__midlen - (g3_param("fish.Linf", value = 1) * (1 - exp(-1 *
  +             g3_param("fish.K", value = 1) * ((age - cur_step_size) - g3_param("fish.t0"))))))
  +         / (
  +           (g3_param("fish.Linf", value = 1) * (1 - exp(-1 * g3_param("fish.K", value = 1) * ((age - cur_step_size) - g3_param("fish.t0"))))) *
  +           g3_param("fish.lencv", value = 0.1, optimise = FALSE))
  +     ))), "g3a_initialconditions_normalcv default")
  + 
  +     ok(cmp_formula(extract_dnorm(g3a_renewal_normalcv(fish)), g3_formula(quote(
  +         (fish__midlen - (g3_param("fish.Linf", value = 1) * (1 - exp(-1 *
  +             g3_param("fish.K", value = 1) * (age - g3_param("fish.t0"))))))
  +         / (
  +           (g3_param("fish.Linf", value = 1) * (1 - exp(-1 * g3_param("fish.K", value = 1) * (age - g3_param("fish.t0"))))) *
  +           g3_param("fish.lencv", value = 0.1, optimise = FALSE))
  +     ))), "g3a_renewal_normalcv default")
  + })
  # g3a_initialconditions_cv
  ok - g3a_initialconditions_normalparam default
  ok - g3a_initialconditions_normalcv default
  ok - g3a_renewal_normalcv default
  > 
  > areas <- list(a=1, b=2, c=3, d=4)
  > stock_a <- g3_stock('stock_a', seq(10, 10, 5)) %>% g3s_livesonareas(areas[c('a')])
  > stock_ac <- g3_stock('stock_ac', seq(10, 10, 5)) %>% g3s_livesonareas(areas[c('a', 'c')])
  > stock_b <- g3_stock('stock_b', seq(10, 100, 10)) %>% g3s_age(5, 10)
  > stock_b_report <- g3s_clone(stock_b, 'report_b') %>% g3s_time(year = 2000:2003)
  >     
  > actions <- list(
  +     g3a_time(2000, 2003, project_years = 0),
  +     g3a_initialconditions(stock_a, ~area * 100 + stock_a__minlen, ~stock_a__minlen + 100),
  +     g3a_initialconditions(stock_ac, ~area * 1000 + stock_ac__minlen, ~stock_a__minlen + 200),
  +     g3a_initialconditions_normalparam(stock_b,
  +         factor_f = ~g3_param("init.factor", value = 10),
  +         mean_f = ~g3_param("init.mean", value = 50),
  +         stddev_f = ~g3_param("init.stddev", value = 10),
  +         alpha_f = ~g3_param("init.walpha", value = 3e-6),
  +         beta_f = ~g3_param("init.wbeta", value = 3)),
  +     g3a_renewal_normalparam(stock_b,
  +         factor_f = ~g3_param("renewal.factor", value = 10),
  +         mean_f = ~g3_param("renewal.mean", value = 50),
  +         stddev_f = ~g3_param("renewal.stddev", value = 10),
  +         alpha_f = ~g3_param("renewal.walpha", value = 3e-3),
  +         beta_f = ~g3_param("renewal.wbeta", value = 3),
  +         run_f = ~age == 5),
  +     g3a_renewal_normalparam(stock_b,
  +         factor_f = ~g3_param("renewal.factor", value = 10) * 0.000001,
  +         mean_f = ~g3_param("renewal.mean", value = 50),
  +         stddev_f = ~g3_param("renewal.stddev", value = 10),
  +         alpha_f = ~g3_param("renewal.walpha", value = 3e-3) * 0.000001,
  +         beta_f = ~g3_param("renewal.wbeta", value = 3) * 0.0001,
  +         run_f = ~age == 7),
  +     g3a_report_stock(stock_b_report, stock_b, ~stock_ss(stock_b__num)),
  +     g3a_report_stock(stock_b_report, stock_b, ~stock_ss(stock_b__wgt)),
  +     list(
  +         '999' = ~{
  +             REPORT(stock_a__num)
  +             REPORT(stock_ac__num)
  +             REPORT(stock_a__wgt)
  +             REPORT(stock_ac__wgt)
  + 
  +             nll <- nll + g3_param('x', value = 1.0)
  +         }))
  > 
  > # Compile model
  > model_fn <- g3_to_r(actions, trace = FALSE)
  > # model_fn <- edit(model_fn)
  > if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +     model_cpp <- g3_to_tmb(actions, trace = FALSE)
  +     # model_cpp <- edit(model_cpp)
  +     model_tmb <- g3_tmb_adfun(model_cpp, compile_flags = c("-O0", "-g"))
  + } else {
  +     writeLines("# skip: not compiling TMB model")
  + }
  # skip: not compiling TMB model
  > 
  > params <- attr(model_fn, 'parameter_template')
  > result <- model_fn(params)
  > r <- attributes(result)
  > #str(as.list(r), vec.len = 10000)
  > 
  > # Populated numbers
  > ok(ut_cmp_identical(
  +     as.vector(r$stock_a__num),
  +     c(110)), "stock_a__num populated")
  ok - stock_a__num populated
  > ok(ut_cmp_identical(
  +     as.vector(r$stock_ac__num),
  +     c(1010, 3010)), "stock_ac__num populated")
  ok - stock_ac__num populated
  > 
  > # Populated mean weights
  > ok(ut_cmp_identical(
  +     as.vector(r$stock_a__wgt),
  +     c(110)), "stock_a__wgt populated")
  ok - stock_a__wgt populated
  > ok(ut_cmp_identical(
  +     as.vector(r$stock_ac__wgt),
  +     c(210, 210)), "stock_ac__wgt populated")
  ok - stock_ac__wgt populated
  > 
  > ok(ut_cmp_equal(
  +     as.data.frame(round(r$report_b__num[,,'2000'], 5)),
  +     read.table(header=TRUE,row.names=1,check.names=FALSE,text = '
  + length          age5        age6        age7        age8        age9       age10
  +   10:20    174.53935    87.26967    87.26976    87.26967    87.26967    87.26967
  +   20:30   3505.71653  1752.85827  1752.86002  1752.85827  1752.85827  1752.85827
  +   30:40  25903.93612 12951.96806 12951.98101 12951.96806 12951.96806 12951.96806
  +   40:50  70414.19883 35207.09942 35207.13462 35207.09942 35207.09942 35207.09942
  +   50:60  70414.19883 35207.09942 35207.13462 35207.09942 35207.09942 35207.09942
  +   60:70  25903.93612 12951.96806 12951.98101 12951.96806 12951.96806 12951.96806
  +   70:80   3505.71653  1752.85827  1752.86002  1752.85827  1752.85827  1752.85827
  +   80:90    174.53935    87.26967    87.26976    87.26967    87.26967    87.26967
  +  90:100      3.19680     1.59840     1.59840     1.59840     1.59840     1.59840
  + 100:Inf      0.02154     0.01077     0.01077     0.01077     0.01077     0.01077
  + ')), "report_b__num: Initial values populaed by g3a_initialconditions_normalparam")
  ok - report_b__num: Initial values populaed by g3a_initialconditions_normalparam
  > 
  > ok(ut_cmp_equal(
  +     as.data.frame(round(r$report_b__wgt[,,'2000'], 5)),
  +     read.table(header=TRUE,row.names=1,check.names=FALSE,text = '
  + length         age5    age6    age7    age8    age9   age10
  +   10:20     5.06756 0.01012 0.01012 0.01012 0.01012 0.01012
  +   20:30    23.46094 0.04688 0.04687 0.04688 0.04688 0.04688
  +   30:40    64.37681 0.12863 0.12862 0.12863 0.12863 0.12863
  +   40:50   136.82419 0.27338 0.27337 0.27338 0.27338 0.27338
  +   50:60   249.81206 0.49912 0.49912 0.49912 0.49912 0.49912
  +   60:70   412.34944 0.82388 0.82387 0.82388 0.82388 0.82388
  +   70:80   633.44531 1.26562 1.26562 1.26562 1.26562 1.26562
  +   80:90   922.10869 1.84238 1.84237 1.84238 1.84238 1.84238
  +  90:100  1287.34856 2.57213 2.57212 2.57213 2.57213 2.57213
  + 100:Inf  1738.17394 3.47288 3.47286 3.47288 3.47288 3.47288
  + ')), "report_b__wgt: Initial values populaed by g3a_initialconditions_normalparam")
  ok - report_b__wgt: Initial values populaed by g3a_initialconditions_normalparam
  > 
  > ok(ut_cmp_equal(
  +     as.data.frame(round(r$report_b__num[,'age5',], 5)),
  +     read.table(header=TRUE,row.names=1,check.names=FALSE,text = '
  + length          2000         2001         2002         2003
  +   10:20    174.53935    261.80902    349.07870    436.34837
  +   20:30   3505.71653   5258.57480   7011.43306   8764.29133
  +   30:40  25903.93612  38855.90418  51807.87223  64759.84029
  +   40:50  70414.19883 105621.29825 140828.39767 176035.49708
  +   50:60  70414.19883 105621.29825 140828.39767 176035.49708
  +   60:70  25903.93612  38855.90418  51807.87223  64759.84029
  +   70:80   3505.71653   5258.57480   7011.43306   8764.29133
  +   80:90    174.53935    261.80902    349.07870    436.34837
  +  90:100      3.19680      4.79520      6.39360      7.99200
  + 100:Inf      0.02154      0.03231      0.04308      0.05385
  + '), tolerance = 1e-7), "report_b__num: age5 has increased with time")
  ok - report_b__num: age5 has increased with time
  > ok(ut_cmp_equal(
  +     as.data.frame(round(r$report_b__wgt[,'age5',], 5)),
  +     read.table(header=TRUE,row.names=1,check.names=FALSE,text = '
  + length         2000       2001       2002       2003
  +   10:20     5.06756    6.75337    7.59628    8.10202
  +   20:30    23.46094   31.26562   35.16797   37.50937
  +   30:40    64.37681   85.79287   96.50091  102.92572
  +   40:50   136.82419  182.34113  205.09959  218.75468
  +   50:60   249.81206  332.91637  374.46853  399.39983
  +   60:70   412.34944  549.52463  618.11222  659.26477
  +   70:80   633.44531  844.17187  949.53516 1012.75312
  +   80:90   922.10869 1228.86413 1382.24184 1474.26847
  +  90:100  1287.34856 1715.60737 1929.73678 2058.21442
  + 100:Inf  1738.17394 2316.40762 2605.52447 2778.99457
  + '), tolerance = 1e-7), "report_b__wgt: age5 has increased with time")
  ok - report_b__wgt: age5 has increased with time
  > 
  > ok(ut_cmp_equal(
  +     as.data.frame(round(r$report_b__num[,'age5',], 5)),
  +     read.table(header=TRUE,row.names=1,check.names=FALSE,text = '
  + length          2000         2001         2002         2003
  +   10:20    174.53935    261.80902    349.07870    436.34837
  +   20:30   3505.71653   5258.57480   7011.43306   8764.29133
  +   30:40  25903.93612  38855.90418  51807.87223  64759.84029
  +   40:50  70414.19883 105621.29825 140828.39767 176035.49708
  +   50:60  70414.19883 105621.29825 140828.39767 176035.49708
  +   60:70  25903.93612  38855.90418  51807.87223  64759.84029
  +   70:80   3505.71653   5258.57480   7011.43306   8764.29133
  +   80:90    174.53935    261.80902    349.07870    436.34837
  +  90:100      3.19680      4.79520      6.39360      7.99200
  + 100:Inf      0.02154      0.03231      0.04308      0.05385
  + ')), "report_b__num: age5 increasing rapidly")
  ok - report_b__num: age5 increasing rapidly
  > 
  > ok(ut_cmp_equal(
  +     as.data.frame(round(r$report_b__num[,'age7',], 5)),
  +     read.table(header=TRUE,row.names=1,check.names=FALSE,text = '
  + length          2000        2001        2002        2003
  +   10:20     87.26976    87.26985    87.26994    87.27002
  +   20:30   1752.86002  1752.86177  1752.86352  1752.86528
  +   30:40  12951.98101 12951.99396 12952.00691 12952.01987
  +   40:50  35207.13462 35207.16983 35207.20504 35207.24024
  +   50:60  35207.13462 35207.16983 35207.20504 35207.24024
  +   60:70  12951.98101 12951.99396 12952.00691 12952.01987
  +   70:80   1752.86002  1752.86177  1752.86352  1752.86528
  +   80:90     87.26976    87.26985    87.26994    87.27002
  +  90:100      1.59840     1.59840     1.59840     1.59841
  + 100:Inf      0.01077     0.01077     0.01077     0.01077
  + ')), "report_b__num: age7 increasing slowly")
  ok - report_b__num: age7 increasing slowly
  > 
  > for (age in c('age6', 'age8', 'age9', 'age10')) {
  +     for (year in c('2001', '2002', '2003')) {
  +         ok(ut_cmp_equal(
  +             r$report_b__num[,age,'2000'],
  +             r$report_b__num[,age,year]), paste0("report_b__num: ", age, " doesn't grow in year ", year))
  +         ok(ut_cmp_equal(
  +             r$report_b__wgt[,age,'2000'],
  +             r$report_b__wgt[,age,year]), paste0("report_b__wgt: ", age, " doesn't grow in year ", year))
  +     }
  + }
  ok - report_b__num: age6 doesn't grow in year 2001
  ok - report_b__wgt: age6 doesn't grow in year 2001
  ok - report_b__num: age6 doesn't grow in year 2002
  ok - report_b__wgt: age6 doesn't grow in year 2002
  ok - report_b__num: age6 doesn't grow in year 2003
  ok - report_b__wgt: age6 doesn't grow in year 2003
  ok - report_b__num: age8 doesn't grow in year 2001
  ok - report_b__wgt: age8 doesn't grow in year 2001
  ok - report_b__num: age8 doesn't grow in year 2002
  ok - report_b__wgt: age8 doesn't grow in year 2002
  ok - report_b__num: age8 doesn't grow in year 2003
  ok - report_b__wgt: age8 doesn't grow in year 2003
  ok - report_b__num: age9 doesn't grow in year 2001
  ok - report_b__wgt: age9 doesn't grow in year 2001
  ok - report_b__num: age9 doesn't grow in year 2002
  ok - report_b__wgt: age9 doesn't grow in year 2002
  ok - report_b__num: age9 doesn't grow in year 2003
  ok - report_b__wgt: age9 doesn't grow in year 2003
  ok - report_b__num: age10 doesn't grow in year 2001
  ok - report_b__wgt: age10 doesn't grow in year 2001
  ok - report_b__num: age10 doesn't grow in year 2002
  ok - report_b__wgt: age10 doesn't grow in year 2002
  ok - report_b__num: age10 doesn't grow in year 2003
  ok - report_b__wgt: age10 doesn't grow in year 2003
  > 
  > proc.time()
     user  system elapsed 
     2.35    0.15    2.45 
Running the tests in 'tests/test-action_report.R' failed.
Complete output:
  > library(magrittr)
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > # Compare array by turning it back into a table first
  > cmp_array <- function (ar, table_text) {
  +     tbl <- read.table(
  +         header = TRUE,
  +         stringsAsFactors = FALSE,
  +         colClasses = c(rep("character", length(dim(ar))), "numeric"),
  +         text = table_text)
  +     ut_cmp_identical(as.data.frame.table(ar, stringsAsFactors = FALSE), tbl)
  + }
  > 
  > capture_warnings <- function(x, full_object = FALSE) {
  +     all_warnings <- list()
  +     rv <- withCallingHandlers(x, warning = function (w) {
  +         all_warnings <<- c(all_warnings, list(w))
  +         invokeRestart("muffleWarning")
  +     })
  +     if (!full_object) all_warnings <- vapply(all_warnings, function (w) w$message, character(1))
  +     return(list(rv = rv, warnings = all_warnings))
  + }
  > 
  > ok_group("action_reports")
  # action_reports
  > ok(ut_cmp_equal(
  +     gadget3:::action_reports(list(g3_formula(quote({
  +         const_var <- 4
  +         arr_var[2] <- 4
  +         doublearr_var[2][[1]] <- 4
  +     }))), REPORT = '.'), quote({
  +         REPORT(arr_var)
  +         REPORT(const_var)
  +         REPORT(doublearr_var)
  +     })), "action_reports: Removed subsets")
  ok - action_reports: Removed subsets
  > 
  > #######################################
  > 
  > prey_a <- g3_stock('prey_a', c(1)) %>% g3s_age(1, 5)
  > 
  > # Report that aggregates ages together
  > agg_report <- g3_stock('agg_report', c(1)) %>% 
  +     g3s_agegroup(list(young = 1:3, old = 4:5)) %>%
  +     g3s_time(year = 2000:2002)
  > # Generate dissaggregated report by cloning the source stock, adding time
  > raw_report <- g3s_clone(prey_a, 'raw_report') %>%
  +     g3s_time(year = 2000:2002)
  > 
  > actions <- list(
  +     g3a_time(2000, 2002, step_lengths = c(6, 6), project_years = 0),
  +     g3a_initialconditions(prey_a, ~10 * age + prey_a__midlen * 0, ~100 * age + prey_a__midlen * 0),
  +     g3a_age(prey_a),
  +     g3a_report_stock(agg_report, prey_a, ~stock_ss(prey_a__num), include_adreport = TRUE),
  +     g3a_report_stock(raw_report, prey_a, ~stock_ss(input_stock__num)),  # NB: We can let g3_step rename it for us
  +     list('999' = ~{ nll <- nll + g3_param('x', value = 1.0) }))
  > actions <- c(actions, list(g3a_report_history(actions, '^prey_a__(num|wgt)')))
  >             
  > # Compile model
  > model_fn <- g3_to_r(actions, trace = FALSE)
  > # model_fn <- edit(model_fn)
  > if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +     model_cpp <- g3_to_tmb(actions, trace = FALSE)
  +     # model_cpp <- edit(model_cpp)
  +     model_tmb <- g3_tmb_adfun(model_cpp, compile_flags = c("-O0", "-g"))
  + } else {
  +     writeLines("# skip: not compiling TMB model")
  + }
  # skip: not compiling TMB model
  > 
  > ok_group("report", {
  +     params <- attr(model_fn, 'parameter_template')
  +     result <- capture_warnings(model_fn(params))
  +     ok(ut_cmp_identical(result$warnings, "No ADREPORT functionality available in R"), "Tried to ADREPORT, moved on")
  +     result <- result$rv
  +     r <- attributes(result)
  +     # str(result)
  +     # str(as.list(r), vec.len = 10000)
  + 
  +     ok(cmp_array(r$raw_report__num, "
  +         length  age time Freq
  +          1:Inf age1 2000   20
  +          1:Inf age2 2000   40
  +          1:Inf age3 2000   60
  +          1:Inf age4 2000   80
  +          1:Inf age5 2000  100
  +          1:Inf age1 2001    0
  +          1:Inf age2 2001   20
  +          1:Inf age3 2001   40
  +          1:Inf age4 2001   60
  +          1:Inf age5 2001  180
  +          1:Inf age1 2002    0
  +          1:Inf age2 2002    0
  +          1:Inf age3 2002   20
  +          1:Inf age4 2002   40
  +          1:Inf age5 2002  240
  +     "), "raw_report__num: Can see growth happening")
  + 
  +     ok(cmp_array(r$agg_report__num, "
  +         length   age time Freq
  +          1:Inf young 2000  120
  +          1:Inf   old 2000  180
  +          1:Inf young 2001   60
  +          1:Inf   old 2001  240
  +          1:Inf young 2002   20
  +          1:Inf   old 2002  280
  +     "), "agg_report__num: Aggregated report only has young/old")
  + 
  +     ok(ut_cmp_identical(
  +         grep('^hist_', names(r), value = TRUE),
  +         c("hist_prey_a__num", "hist_prey_a__wgt")), "Logged history of numbers / weight (ignored reports though)")
  +     ok(cmp_array(r$hist_prey_a__num, "
  +         length   age    time Freq
  +          1:Inf  age1 2000-01   10
  +          1:Inf  age2 2000-01   20
  +          1:Inf  age3 2000-01   30
  +          1:Inf  age4 2000-01   40
  +          1:Inf  age5 2000-01   50
  +          1:Inf  age1 2000-02   10
  +          1:Inf  age2 2000-02   20
  +          1:Inf  age3 2000-02   30
  +          1:Inf  age4 2000-02   40
  +          1:Inf  age5 2000-02   50
  +          1:Inf  age1 2001-01    0
  +          1:Inf  age2 2001-01   10
  +          1:Inf  age3 2001-01   20
  +          1:Inf  age4 2001-01   30
  +          1:Inf  age5 2001-01   90
  +          1:Inf  age1 2001-02    0
  +          1:Inf  age2 2001-02   10
  +          1:Inf  age3 2001-02   20
  +          1:Inf  age4 2001-02   30
  +          1:Inf  age5 2001-02   90
  +          1:Inf  age1 2002-01    0
  +          1:Inf  age2 2002-01    0
  +          1:Inf  age3 2002-01   10
  +          1:Inf  age4 2002-01   20
  +          1:Inf  age5 2002-01  120
  +          1:Inf  age1 2002-02    0
  +          1:Inf  age2 2002-02    0
  +          1:Inf  age3 2002-02   10
  +          1:Inf  age4 2002-02   20
  +          1:Inf  age5 2002-02  120
  +   "), "hist_prey_a__num: Full history")
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         param_template <- attr(model_cpp, "parameter_template")
  +         param_template$value <- params[param_template$switch]
  +         capture_warnings(gadget3:::ut_tmb_r_compare(model_fn, model_tmb, param_template))
  +     }
  + })
  # report
  ok - Tried to ADREPORT, moved on
  ok - raw_report__num: Can see growth happening
  ok - agg_report__num: Aggregated report only has young/old
  ok - Logged history of numbers / weight (ignored reports though)
  ok - hist_prey_a__num: Full history
  > 
  > ok_group("adreport", {
  +     params <- attr(model_fn, 'parameter_template')
  +     result <- capture_warnings(model_fn(params))
  +     ok(ut_cmp_identical(result$warnings, "No ADREPORT functionality available in R"), "Tried to ADREPORT, moved on")
  +     result <- result$rv
  +     r <- attributes(result)
  +     # str(result)
  +     # str(as.list(r), vec.len = 10000)
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         sdrep <- TMB::sdreport(model_tmb)
  +         ok(ut_cmp_equal(
  +             summary(sdrep, 'report'),
  +             array(
  +               c(rep(0, 15), rep(NaN, 15)),
  +               dim = c(15, 2),
  +               dimnames = list(
  +                   rep("report_stock__num", 15),
  +                   c("Estimate", "Std. Error")))), "TMB included report_stock__num in adreport")
  +     }
  + })
  # adreport
  ok - Tried to ADREPORT, moved on
  > 
  > proc.time()
     user  system elapsed 
     1.04    0.09    1.12 
Running the tests in 'tests/test-action_tagging.R' failed.
Complete output:
  > library(magrittr)
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > tags <- c('H1-00', 'H1-01')
  > tags <- structure(seq_along(tags), names = tags)
  > 
  > prey_a <- g3_stock('prey_a', seq(1, 10)) %>% g3s_tag(tags)
  > fleet_a <- g3_fleet('fleet_a')
  > 
  > actions <- list(
  +     g3a_time(2000, ~2000 + g3_param('years', value = 1) - 1, step_lengths = c(6,6), project_years = 0),
  +     g3a_initialconditions(prey_a, ~10 * prey_a__midlen, ~100 * prey_a__midlen),
  +     g3a_predate_tagrelease(
  +         fleet_a,
  +         list(prey_a),
  +         suitabilities = list(
  +             prey_a = 1),
  +         catchability_f = g3a_predate_catchability_numberfleet(~100),
  +         # NB: 1000 enough to disable mortality
  +         mortality_f = g3_suitability_straightline(~g3_param('mort_alpha', value = 1000), ~g3_param('mort_beta', value = 0)),
  +         output_tag_f = g3_timeareadata('fleet_a_tags', data.frame(
  +             year = c(2000, 2001),
  +             tag = tags[c('H1-00', 'H1-01')],
  +             stringsAsFactors = FALSE), value_field = "tag"),
  +         run_f = ~cur_step == 2 && cur_year < g3_param('harvest_end', value = 2999)),
  +     g3a_tag_shedding(
  +         list(prey_a),
  +         tagshed_f = log(8),  # i.e. 0.125 will loose their tag
  +         run_f = ~cur_year >= g3_param('tagshed_start', value = 2999)),
  +     list())
  > actions <- c(actions, list(
  +     g3a_report_history(actions, "prey_.*__predby_fleet_.*"),
  +     g3a_report_history(actions)))
  > 
  > # Compile model
  > model_fn <- g3_to_r(actions, trace = FALSE)
  > # model_fn <- edit(model_fn)
  > if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +     model_cpp <- g3_to_tmb(actions, trace = FALSE)
  +     # model_cpp <- edit(model_cpp)
  +     model_tmb <- g3_tmb_adfun(model_cpp, compile_flags = c("-O0", "-g"), output_script = FALSE)
  +     #writeLines(TMB::gdbsource(model_tmb))
  + } else {
  +     writeLines("# skip: not compiling TMB model")
  + }
  # skip: not compiling TMB model
  > 
  > ok_group("tagging without mortality", {
  +     params <- attr(model_fn, 'parameter_template')
  +     params$years <- 5
  +     params$mort_alpha <- 1000  # NB: Enough to disable mortality
  +     params$mort_beta <- 0
  +     params$harvest_end <- 2999
  +     params$tagshed_start <- 2999
  +     result <- model_fn(params)
  +     # str(as.list(r), vec.len = 10000)
  + 
  +     for (l in seq_len(dim(attr(result, "hist_prey_a__num"))[['length']])) {
  +         ok(ut_cmp_equal(
  +             as.numeric(colSums(attr(result, "hist_prey_a__num")[l,,])),
  +             rep(l * 10 + 5, dim(attr(result, "hist_prey_a__num"))[['length']]),
  +             tolerance = 1e-7), paste0("hist_prey_a__num[", l, ",,]: No fish disappear"))
  +     }
  + 
  +     for (t in seq_len(dim(attr(result, "hist_prey_a__num"))[['time']])) {
  +         if (t == 1) {
  +             # Start, not interesting
  +         } else if (t %% 2 == 0) {
  +             # Predation step
  +             nums_caught <- rowSums(attr(result, "hist_prey_a__predby_fleet_a")[,,t] / attr(result, "hist_prey_a__wgt")[,,t])
  +             if (t == 2) {
  +                 ok(ut_cmp_equal(
  +                     as.numeric(attr(result, "hist_prey_a__num")[,2,t]),
  +                     as.numeric(nums_caught)), paste0("hist_prey_a__num[,2,", t, "]: Fish assigned to first tag"))
  +                 ok(ut_cmp_equal(
  +                     attr(result, "hist_prey_a__wgt")[,1,t],
  +                     attr(result, "hist_prey_a__wgt")[,2,t]), paste0("hist_prey_a__wgt[,2,", t, "]: Untagged weight copied"))
  +             } else if (t == 4) {
  +                 ok(ut_cmp_equal(
  +                     as.numeric(attr(result, "hist_prey_a__num")[,3,t]),
  +                     as.numeric(nums_caught)), paste0("hist_prey_a__num[,3,", t, "]: Fish assigned to second tag"))
  +                 ok(ut_cmp_equal(
  +                     attr(result, "hist_prey_a__wgt")[,1,t],
  +                     attr(result, "hist_prey_a__wgt")[,3,t]), paste0("hist_prey_a__wgt[,3,", t, "]: Untagged weight copied"))
  +             }
  +         } else {
  +             ok(ut_cmp_equal(
  +                 attr(result, "hist_prey_a__num")[,,t],
  +                 attr(result, "hist_prey_a__num")[,,t - 1]), paste0("hist_prey_a__num[,,", t, "]: Nothing happens outside tagrelease cycles"))
  +         }
  +     }
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         param_template <- attr(model_cpp, "parameter_template")
  +         param_template$value <- params[param_template$switch]
  +         model_tmb <- g3_tmb_adfun(model_cpp, param_template, compile_flags = c("-O0", "-g"))
  +         gadget3:::ut_tmb_r_compare(model_fn, model_tmb, param_template)
  +     }
  + })
  # tagging without mortality
  ok - hist_prey_a__num[1,,]: No fish disappear
  ok - hist_prey_a__num[2,,]: No fish disappear
  ok - hist_prey_a__num[3,,]: No fish disappear
  ok - hist_prey_a__num[4,,]: No fish disappear
  ok - hist_prey_a__num[5,,]: No fish disappear
  ok - hist_prey_a__num[6,,]: No fish disappear
  ok - hist_prey_a__num[7,,]: No fish disappear
  ok - hist_prey_a__num[8,,]: No fish disappear
  ok - hist_prey_a__num[9,,]: No fish disappear
  ok - hist_prey_a__num[10,,]: No fish disappear
  ok - hist_prey_a__num[,2,2]: Fish assigned to first tag
  ok - hist_prey_a__wgt[,2,2]: Untagged weight copied
  ok - hist_prey_a__num[,,3]: Nothing happens outside tagrelease cycles
  ok - hist_prey_a__num[,3,4]: Fish assigned to second tag
  ok - hist_prey_a__wgt[,3,4]: Untagged weight copied
  ok - hist_prey_a__num[,,5]: Nothing happens outside tagrelease cycles
  ok - hist_prey_a__num[,,7]: Nothing happens outside tagrelease cycles
  ok - hist_prey_a__num[,,9]: Nothing happens outside tagrelease cycles
  > 
  > ok_group("tagging with mortality", {
  +     params <- attr(model_fn, 'parameter_template')
  +     params$years <- 5
  +     params$mort_alpha <- log(4)  # NB: i.e. 0.25 tagged will die
  +     params$mort_beta <- 0
  +     params$harvest_end <- 2999
  +     params$tagshed_start <- 2999
  +     result <- model_fn(params)
  +     # str(as.list(r), vec.len = 10000)
  + 
  +     for (t in seq_len(dim(attr(result, "hist_prey_a__num"))[['time']])) {
  +         if (t == 1) {
  +             # Start, not interesting
  +         } else if (t %% 2 == 0) {
  +             # Predation step
  +             nums_caught <- rowSums(attr(result, "hist_prey_a__predby_fleet_a")[,,t] / attr(result, "hist_prey_a__wgt")[,,t])
  +             if (t == 2) {
  +                 ok(ut_cmp_equal(
  +                     as.numeric(attr(result, "hist_prey_a__num")[,2,t]),
  +                     as.numeric(nums_caught * 0.75),
  +                     tolerance = 1e-8), paste0("hist_prey_a__num[,2,", t, "]: Fish assigned to first tag, after mortality"))
  +                 ok(ut_cmp_equal(
  +                     attr(result, "hist_prey_a__wgt")[,1,t],
  +                     attr(result, "hist_prey_a__wgt")[,2,t],
  +                     tolerance = 1e-6), paste0("hist_prey_a__wgt[,2,", t, "]: Untagged weight copied"))
  +             } else if (t == 4) {
  +                 ok(ut_cmp_equal(
  +                     as.numeric(attr(result, "hist_prey_a__num")[,3,t]),
  +                     as.numeric(nums_caught * 0.75),
  +                     tolerance = 1e-8), paste0("hist_prey_a__num[,3,", t, "]: Fish assigned to second tag, after mortality"))
  +                 ok(ut_cmp_equal(
  +                     attr(result, "hist_prey_a__wgt")[,1,t],
  +                     attr(result, "hist_prey_a__wgt")[,3,t],
  +                     tolerance = 1e-6), paste0("hist_prey_a__wgt[,3,", t, "]: Untagged weight copied"))
  +             }
  +         } else {
  +             ok(ut_cmp_equal(
  +                 attr(result, "hist_prey_a__num")[,,t],
  +                 attr(result, "hist_prey_a__num")[,,t - 1]), paste0("hist_prey_a__num[,,", t, "]: Nothing happens outside tagrelease cycles"))
  +         }
  +     }
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         param_template <- attr(model_cpp, "parameter_template")
  +         param_template$value <- params[param_template$switch]
  +         model_tmb <- g3_tmb_adfun(model_cpp, param_template, compile_flags = c("-O0", "-g"))
  +         gadget3:::ut_tmb_r_compare(model_fn, model_tmb, param_template)
  +     }
  + })
  # tagging with mortality
  ok - hist_prey_a__num[,2,2]: Fish assigned to first tag, after mortality
  ok - hist_prey_a__wgt[,2,2]: Untagged weight copied
  ok - hist_prey_a__num[,,3]: Nothing happens outside tagrelease cycles
  ok - hist_prey_a__num[,3,4]: Fish assigned to second tag, after mortality
  ok - hist_prey_a__wgt[,3,4]: Untagged weight copied
  ok - hist_prey_a__num[,,5]: Nothing happens outside tagrelease cycles
  ok - hist_prey_a__num[,,7]: Nothing happens outside tagrelease cycles
  ok - hist_prey_a__num[,,9]: Nothing happens outside tagrelease cycles
  > 
  > ok_group("tag shedding", {
  +     params <- attr(model_fn, 'parameter_template')
  +     params$years <- 5
  +     params$mort_alpha <- 1000  # NB: Enough to disable mortality
  +     params$mort_beta <- 0
  +     params$harvest_end <- 2001
  +     params$tagshed_start <- 2003
  +     result <- model_fn(params)
  +     # str(as.list(r), vec.len = 10000)
  + 
  +     for (l in seq_len(dim(attr(result, "hist_prey_a__num"))[['length']])) {
  +         ok(ut_cmp_equal(
  +             as.numeric(colSums(attr(result, "hist_prey_a__num")[l,,])),
  +             rep(l * 10 + 5, dim(attr(result, "hist_prey_a__num"))[['length']]),
  +             tolerance = 1e-7), paste0("hist_prey_a__num[", l, ",,]: No fish disappear"))
  +     }
  + 
  +     for (t in seq_len(dim(attr(result, "hist_prey_a__num"))[['time']])) {
  +         if (t == 1) {
  +             # Start, not interesting
  +         } else if (t >= 7) {
  +             # Tag shedding enabled
  +             ok(ut_cmp_equal(
  +                 as.numeric(attr(result, "hist_prey_a__num")[,'untagged',t]),
  +                 as.numeric(attr(result, "hist_prey_a__num")[,'untagged',t-1]
  +                     + 0.125 * attr(result, "hist_prey_a__num")[,'H1-00', t-1]
  +                     + 0.125 * attr(result, "hist_prey_a__num")[,'H1-01', t-1]),
  +                 tolerance = 1e-7), paste0("hist_prey_a__num[,'untagged',", t, "]: Fish lose tag and return to untagged"))
  +         } else if (t %% 2 == 0) {
  +             # Predation step
  +             nums_caught <- rowSums(attr(result, "hist_prey_a__predby_fleet_a")[,,t] / attr(result, "hist_prey_a__wgt")[,,t])
  +             if (t == 2) {
  +                 ok(ut_cmp_equal(
  +                     as.numeric(attr(result, "hist_prey_a__num")[,2,t]),
  +                     as.numeric(nums_caught)), paste0("hist_prey_a__num[,2,", t, "]: Fish assigned to first tag"))
  +                 ok(ut_cmp_equal(
  +                     attr(result, "hist_prey_a__wgt")[,1,t],
  +                     attr(result, "hist_prey_a__wgt")[,2,t]), paste0("hist_prey_a__wgt[,2,", t, "]: Untagged weight copied"))
  +             }
  +         } else {
  +             ok(ut_cmp_equal(
  +                 attr(result, "hist_prey_a__num")[,,t],
  +                 attr(result, "hist_prey_a__num")[,,t - 1]), paste0("hist_prey_a__num[,,", t, "]: Nothing happens outside tagrelease cycles"))
  +         }
  +     }
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         param_template <- attr(model_cpp, "parameter_template")
  +         param_template$value <- params[param_template$switch]
  +         model_tmb <- g3_tmb_adfun(model_cpp, param_template, compile_flags = c("-O0", "-g"))
  +         gadget3:::ut_tmb_r_compare(model_fn, model_tmb, param_template)
  +     }
  + })
  # tag shedding
  ok - hist_prey_a__num[1,,]: No fish disappear
  ok - hist_prey_a__num[2,,]: No fish disappear
  ok - hist_prey_a__num[3,,]: No fish disappear
  ok - hist_prey_a__num[4,,]: No fish disappear
  ok - hist_prey_a__num[5,,]: No fish disappear
  ok - hist_prey_a__num[6,,]: No fish disappear
  ok - hist_prey_a__num[7,,]: No fish disappear
  ok - hist_prey_a__num[8,,]: No fish disappear
  ok - hist_prey_a__num[9,,]: No fish disappear
  ok - hist_prey_a__num[10,,]: No fish disappear
  ok - hist_prey_a__num[,2,2]: Fish assigned to first tag
  ok - hist_prey_a__wgt[,2,2]: Untagged weight copied
  ok - hist_prey_a__num[,,3]: Nothing happens outside tagrelease cycles
  ok - hist_prey_a__num[,,5]: Nothing happens outside tagrelease cycles
  ok - hist_prey_a__num[,'untagged',7]: Fish lose tag and return to untagged
  ok - hist_prey_a__num[,'untagged',8]: Fish lose tag and return to untagged
  ok - hist_prey_a__num[,'untagged',9]: Fish lose tag and return to untagged
  ok - hist_prey_a__num[,'untagged',10]: Fish lose tag and return to untagged
  > 
  > proc.time()
     user  system elapsed 
     1.45    0.21    1.65 
Running the tests in 'tests/test-action_time.R' failed.
Complete output:
  > library(magrittr)
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > # rep(), but allow (times) to extract fractional portions of (x)
  > frac_rep <- function (x, times = 1) {
  +     x <- c(
  +         # Repeat sequence whole-part times
  +         rep(x, times = floor(times)),
  +         # Fractional part is proportion of sequence
  +         head(x, round((times - floor(times)) * length(x))),
  +         NULL)
  +     return(x)
  + }
  > 
  > ok_group("MFDB compatibility", {
  +     # Fake mfdb default groupings
  +     timestep_quarterly <- structure(
  +         list("1" = 1:3, "2" = 4:6, "3" = 7:9, "4" = 10:12),
  +         table_name = "temp_rvtbi",
  +         class = c("mfdb_group", "mfdb_aggregate"))
  +     timestep_biannually <- structure(
  +         list("1" = 1:6, "2" = 7:12),
  +         table_name = "temp_wntki",
  +         class = c("mfdb_group", "mfdb_aggregate"))
  + 
  +     a <- g3a_time(1990, 1997, step_lengths = timestep_quarterly)
  +     ok(ut_cmp_identical(
  +         as.vector(environment(a[[1]])$step_lengths),
  +         c(3L,3L,3L,3L)), "mfdb::mfdb_timestep_quarterly converted")
  + 
  +     a <- g3a_time(1990, 1997, step_lengths = timestep_biannually)
  +     ok(ut_cmp_identical(
  +         as.vector(environment(a[[1]])$step_lengths),
  +         c(6L,6L)), "mfdb::mfdb_timestep_biannually converted")
  + })
  # MFDB compatibility
  ok - mfdb::mfdb_timestep_quarterly converted
  ok - mfdb::mfdb_timestep_biannually converted
  > 
  > 
  > all_time <- array(dim = c(1))
  > attr(all_time, 'dynamic_dim') <- list(quote(as_integer(total_steps + 1L)))
  > all_step <- array(dim = c(1))
  > attr(all_step, 'dynamic_dim') <- list(quote(as_integer(total_steps + 1L)))
  > all_step_size <- array(dim = c(1))
  > attr(all_step_size, 'dynamic_dim') <- list(quote(as_integer(total_steps + 1L)))
  > all_year <- array(dim = c(1))
  > attr(all_year, 'dynamic_dim') <- list(quote(as_integer(total_steps + 1L)))
  > all_step_final <- array(FALSE, dim = c(1))
  > attr(all_step_final, 'dynamic_dim') <- list(quote(as_integer(total_steps + 1L)))
  > all_cur_year_projection <- array(FALSE, dim = c(1))
  > attr(all_cur_year_projection, 'dynamic_dim') <- list(quote(as_integer(total_steps + 1L)))
  > 
  > actions <- list(
  +     g3a_time(
  +         start_year = ~as_integer(g3_param('p_start_year', value = 1990)),
  +         end_year = ~as_integer(g3_param('p_end_year', value = 1997)),
  +         step_lengths = ~g3_param_vector('step_lengths'),
  +         final_year_steps = ~as_integer(g3_param('final_year_steps', value = 3))),
  +     list(
  +         '999' = ~{
  +             all_time[[cur_time + 1]] <- cur_time
  +             all_step[[cur_time + 1]] <- cur_step
  +             all_step_size[[cur_time + 1]] <- cur_step_size
  +             all_year[[cur_time + 1]] <- cur_year
  +             all_step_final[[cur_time + 1]] <- cur_step_final
  +             all_cur_year_projection[[cur_time + 1]] <- cur_year_projection
  +             REPORT(all_time)
  +             REPORT(all_step)
  +             REPORT(all_step_size)
  +             REPORT(all_year)
  +             REPORT(all_step_final)
  +             REPORT(all_cur_year_projection)
  +             REPORT(total_years)
  + 
  +             nll <- nll + g3_param('x', value = 1.0)  # ...or TMB falls over
  +         }))
  > 
  > model_fn <- g3_to_r(actions)
  > # model_fn <- edit(model_fn)
  > if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +     params <- attr(model_fn, 'parameter_template')
  +     params$step_lengths <- c(3,3,6)
  + 
  +     model_cpp <- g3_to_tmb(actions, trace = FALSE)
  +     # model_cpp <- edit(model_cpp)
  +     model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g"))
  + } else {
  +     writeLines("# skip: not compiling TMB model")
  +     model_cpp <- c()
  + }
  # skip: not compiling TMB model
  > 
  > params <- attr(model_fn, 'parameter_template')
  > params$step_lengths <- c(3,3,6)
  > result <- model_fn(params)
  > 
  > ok(ut_cmp_identical(
  +     as.vector(attr(result, 'all_time')),
  +     as.integer(1:((1997 - 1990 + 1) * 3) - 1)), "cur_time populated")
  ok - cur_time populated
  > ok(ut_cmp_identical(
  +     as.vector(attr(result, 'all_step')),
  +     as.integer(rep(c(1,2,3), 8))), "cur_step populated")
  ok - cur_step populated
  > ok(ut_cmp_identical(
  +     as.vector(attr(result, 'all_step_size')),
  +     as.numeric(rep(c(3/12,3/12,6/12), 8))), "cur_step_size populated")
  ok - cur_step_size populated
  > ok(ut_cmp_identical(
  +     as.vector(attr(result, 'all_year')),
  +     as.integer(rep(1990:1997, each = 3))), "cur_year populated")
  ok - cur_year populated
  > ok(ut_cmp_identical(
  +     as.vector(attr(result, 'all_step_final')),
  +     rep(c(FALSE, FALSE, TRUE), 8)), "cur_step_final populated")
  ok - cur_step_final populated
  > ok(ut_cmp_identical(
  +     as.vector(attr(result, 'all_cur_year_projection')),
  +     rep(FALSE, (1997 - 1990 + 1) * 3)), "cur_year_projection populated")
  ok - cur_year_projection populated
  > ok(ut_cmp_identical(
  +     attr(result, 'total_years'),
  +     1997 - 1990 + 1), "total_years populated")
  ok - total_years populated
  > 
  > 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)
  + } else {
  +     writeLines("# skip: not running TMB tests")
  + }
  # skip: not running TMB tests
  > 
  > ok_group('even steps', {
  +     params <- attr(model_fn, 'parameter_template')
  +     params$p_start_year <- 1992
  +     params$p_end_year <- 1999
  +     params$step_lengths <- c(4,4,4)
  +     params$final_year_steps <- 3
  +     params$project_years <- 0
  +     result <- model_fn(params)
  +     # str(r)
  + 
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_time')),
  +         as.integer(1:((1999 - 1992 + 1) * 3) - 1)), "cur_time populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_step')),
  +         as.integer(rep(c(1,2,3), 8))), "cur_step populated")
  +     ok(ut_cmp_equal(
  +         as.vector(attr(result, 'all_step_size')),
  +         as.numeric(rep(c(4/12,4/12,4/12), 8))), "cur_step_size populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_year')),
  +         as.integer(rep(1992:1999, each = 3))), "cur_year populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_step_final')),
  +         rep(c(FALSE, FALSE, TRUE), 8)), "cur_step_final populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_cur_year_projection')),
  +         rep(FALSE, (1999 - 1992 + 1) * 3)), "cur_year_projection populated")
  +     ok(ut_cmp_identical(
  +         attr(result, 'total_years'),
  +         1999 - 1992 + 1), "total_years populated")
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g"))
  +         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)
  +     } else {
  +         writeLines("# skip: not running TMB tests")
  +     }
  + })
  # even steps
  ok - cur_time populated
  ok - cur_step populated
  ok - cur_step_size populated
  ok - cur_year populated
  ok - cur_step_final populated
  ok - cur_year_projection populated
  ok - total_years populated
  # skip: not running TMB tests
  > 
  > ok_group("projection: Project_years = 4", {
  +     params <- attr(model_fn, 'parameter_template')
  +     params$p_start_year <- 1992
  +     params$p_end_year <- 1999
  +     params$step_lengths <- c(4,4,4)
  +     params$final_year_steps <- 3
  +     params$project_years <- 4
  +     result <- model_fn(params)
  + 
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_time')),
  +         as.integer(1:(3 * (1999 - 1992 + 1 + 4)) - 1)), "cur_time populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_step')),
  +         as.integer(rep(c(1,2,3), 1999 - 1992 + 1 + 4))), "cur_step populated")
  +     ok(ut_cmp_equal(
  +         as.vector(attr(result, 'all_step_size')),
  +         as.numeric(rep(c(4/12,4/12,4/12), 1999 - 1992 + 1 + 4))), "cur_step_size populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_year')),
  +         as.integer(rep(1992:(1999 + 4), each = 3))), "cur_year populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_step_final')),
  +         rep(c(FALSE, FALSE, TRUE), 1999 - 1992 + 1 + 4)), "cur_step_final populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_cur_year_projection')),
  +         c(rep(FALSE, (1999 - 1992 + 1) * 3), rep(TRUE, 4 * 3))), "cur_year_projection populated")
  +     ok(ut_cmp_identical(
  +         attr(result, 'total_years'),
  +         1999 - 1992 + 1 + 4), "total_years populated")
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g"))
  +         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)
  +     } else {
  +         writeLines("# skip: not running TMB tests")
  +     }
  + })
  # projection: Project_years = 4
  ok - cur_time populated
  ok - cur_step populated
  ok - cur_step_size populated
  ok - cur_year populated
  ok - cur_step_final populated
  ok - cur_year_projection populated
  ok - total_years populated
  # skip: not running TMB tests
  > 
  > ok_group("projection: retro_years = 3", {
  +     params <- attr(model_fn, 'parameter_template')
  +     params$p_start_year <- 1992
  +     params$p_end_year <- 1999
  +     params$step_lengths <- c(4,4,4)
  +     params$final_year_steps <- 3
  +     params$retro_years <- 3
  +     result <- model_fn(params)
  + 
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_time')),
  +         as.integer(1:(3 * (1999 - 1992 + 1 - 3)) - 1)), "cur_time populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_step')),
  +         as.integer(rep(c(1,2,3), 1999 - 1992 + 1 - 3))), "cur_step populated")
  +     ok(ut_cmp_equal(
  +         as.vector(attr(result, 'all_step_size')),
  +         as.numeric(rep(c(4/12,4/12,4/12), 1999 - 1992 + 1 - 3))), "cur_step_size populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_year')),
  +         as.integer(rep(1992:(1999 - 3), each = 3))), "cur_year populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_step_final')),
  +         rep(c(FALSE, FALSE, TRUE), 1999 - 1992 + 1 - 3)), "cur_step_final populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_cur_year_projection')),
  +         c(rep(FALSE, (1999 - 1992 + 1 - 3) * 3), rep(TRUE, 0))), "cur_year_projection populated (NB: No projection since we removed years)")
  +     ok(ut_cmp_identical(
  +         attr(result, 'total_years'),
  +         1999 - 1992 + 1 - 3), "total_years populated")
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g"))
  +         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)
  +     } else {
  +         writeLines("# skip: not running TMB tests")
  +     }
  + })
  # projection: retro_years = 3
  ok - cur_time populated
  ok - cur_step populated
  ok - cur_step_size populated
  ok - cur_year populated
  ok - cur_step_final populated
  ok - cur_year_projection populated (NB: No projection since we removed years)
  ok - total_years populated
  # skip: not running TMB tests
  > 
  > ok_group("retro_years, project_years must have correct sense", {
  +     cmp_warn <- function(x, expected_regexp, ...) {
  +         last_warn <- NULL
  +         rv <- withCallingHandlers(x, warning = function (w) {
  +             last_warn <<- w
  +             invokeRestart("muffleWarning")
  +         })
  +         # NB: This would need moving in a generic version
  +         ok(ut_cmp_identical(rv, NaN), "Function returned NaN")
  + 
  +         if (is.null(last_warn)) return(c("No warning returned"))
  +         if (grepl(expected_regexp, last_warn$message, ...)) {
  +             return(TRUE)
  +         }
  +         return(c(last_warn$message, "Did not match:-", expected_regexp))
  +     }
  + 
  +     params <- attr(model_fn, 'parameter_template')
  +     params$p_start_year <- 1992
  +     params$p_end_year <- 1999
  +     params$step_lengths <- c(4,4,4)
  +     params$project_years <- -1
  +     ok(cmp_warn({
  +         model_fn(params)
  +     }, 'project_years'), "project_years: Can't be negative")
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         param_template <- attr(model_cpp, "parameter_template")
  +         param_template$value <- params[param_template$switch]
  +         ok(cmp_warn({
  +             result <- model_fn(params)
  +         }, 'project_years'), "project_years: Can't be negative")
  +     } else {
  +         writeLines("# skip: not running TMB tests")
  +     }
  + 
  +     params <- attr(model_fn, 'parameter_template')
  +     params$p_start_year <- 1992
  +     params$p_end_year <- 1999
  +     params$step_lengths <- c(4,4,4)
  +     params$retro_years <- -1
  +     ok(cmp_warn({
  +         result <- model_fn(params)
  +     }, 'retro_years'), "retro_years: Can't be negative")
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g"))
  +         param_template <- attr(model_cpp, "parameter_template")
  +         param_template$value <- params[param_template$switch]
  +         ok(cmp_warn({
  +             result <- model_fn(params)
  +         }, 'retro_years'), "retro_years: Can't be negative")
  +     } else {
  +         writeLines("# skip: not running TMB tests")
  +     }
  + })
  # retro_years, project_years must have correct sense
  ok - Function returned NaN
  ok - project_years: Can't be negative
  # skip: not running TMB tests
  ok - Function returned NaN
  ok - retro_years: Can't be negative
  # skip: not running TMB tests
  > 
  > ok_group("Short final year: final_year_steps = 1", {
  +     params <- attr(model_fn, 'parameter_template')
  +     params$p_start_year <- 1992
  +     params$p_end_year <- 1999
  +     params$step_lengths <- c(4,4,4)
  +     params$final_year_steps <- 1
  +     params$project_years <- 0
  +     result <- model_fn(params)
  + 
  +     # 1992..1998 whole years, and single step for 1999
  +     test_total_steps <- 3 * (1998 - 1992 + 1) + 1
  + 
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_time')),
  +         as.integer(0:(test_total_steps - 1))), "cur_time populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_step')),
  +         as.integer(frac_rep(c(1,2,3), test_total_steps / 3 ))), "cur_step populated")
  +     ok(ut_cmp_equal(
  +         as.vector(attr(result, 'all_step_size')),
  +         as.numeric(frac_rep(c(4/12,4/12,4/12), test_total_steps / 3 ))), "cur_step_size populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_year')),
  +         as.integer(c(
  +             rep(1992:1998, each = 3),
  +             1999))), "cur_year populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_step_final')),
  +         frac_rep(c(FALSE, FALSE, TRUE), test_total_steps / 3)), "cur_step_final populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_cur_year_projection')),
  +         frac_rep(FALSE, test_total_steps )), "cur_year_projection populated (NB: No projection since we removed years)")
  +     ok(ut_cmp_identical(
  +         attr(result, 'total_years'),
  +         ceiling(test_total_steps / 3)), "total_years populated (NB: Ignores final_year_steps)")
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g"))
  +         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)
  +     } else {
  +         writeLines("# skip: not running TMB tests")
  +     }
  + })
  # Short final year: final_year_steps = 1
  ok - cur_time populated
  ok - cur_step populated
  ok - cur_step_size populated
  ok - cur_year populated
  ok - cur_step_final populated
  ok - cur_year_projection populated (NB: No projection since we removed years)
  ok - total_years populated (NB: Ignores final_year_steps)
  # skip: not running TMB tests
  > 
  > ok_group("1 year forecast from 2nd retro peel: retro_years = 2, project_years = 1", {
  +     params <- attr(model_fn, 'parameter_template')
  +     params$p_start_year <- 1992
  +     params$p_end_year <- 1999
  +     params$step_lengths <- c(4,4,4)
  +     params$retro_years <- 2
  +     params$project_years <- 1
  +     result <- model_fn(params)
  + 
  +     # 1992..1998 whole years (2 less for retro_years, +1 for project years)
  +     test_year_steps <- length(params$step_lengths)
  +     test_total_steps <- test_year_steps * (
  +         params$p_end_year - params$p_start_year + 1 +
  +         params$project_years - params$retro_years)
  + 
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_time')),
  +         as.integer(0:(test_total_steps - 1))), "cur_time populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_step')),
  +         as.integer(frac_rep(c(1,2,3), test_total_steps / 3 ))), "cur_step populated")
  +     ok(ut_cmp_equal(
  +         as.vector(attr(result, 'all_step_size')),
  +         as.numeric(frac_rep(c(4/12,4/12,4/12), test_total_steps / 3 ))), "cur_step_size populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_year')),
  +         as.integer(rep(1992:1998, each = 3))), "cur_year populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_step_final')),
  +         frac_rep(c(FALSE, FALSE, TRUE), test_total_steps / 3)), "cur_step_final populated")
  +     ok(ut_cmp_identical(
  +         as.vector(attr(result, 'all_cur_year_projection')),
  +         c(
  +             frac_rep(FALSE, test_total_steps - params$project_years * 3 ),
  +             frac_rep(TRUE, params$project_years * 3 ),
  +             NULL)), "cur_year_projection populated")
  +     ok(ut_cmp_identical(
  +         attr(result, 'total_years'),
  +         ceiling(test_total_steps / 3)), "total_years populated")
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g"))
  +         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)
  +     } else {
  +         writeLines("# skip: not running TMB tests")
  +     }
  + })
  # 1 year forecast from 2nd retro peel: retro_years = 2, project_years = 1
  ok - cur_time populated
  ok - cur_step populated
  ok - cur_step_size populated
  ok - cur_year populated
  ok - cur_step_final populated
  ok - cur_year_projection populated
  ok - total_years populated
  # skip: not running TMB tests
  > 
  > proc.time()
     user  system elapsed 
     0.79    0.12    0.90 
Running the tests in 'tests/test-eval.R' failed.
Complete output:
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > ok(ut_cmp_equal(as.numeric(g3_eval(
  +     g3_suitability_andersen(0,1,2,3,4),
  +     predstock = g3_stock('pred', 11:20),
  +     stock = g3_stock('prey', 1:10))), as.numeric(c(
  +         "11:12" = 1.39762234830867,
  +         "12:13" = 1.76710448730415,
  +         "13:14" = 1.92001105688051,
  +         "14:15" = 1.98080983811489,
  +         "15:16" = 1.99913177015507,
  +         "16:17" = 1.99765923114992,
  +         "17:18" = 1.98837494524607,
  +         "18:19" = 1.97544436079439,
  +         "19:20" = 1.96094041453242,
  +         "20:Inf" = 1.94597890503981))), "g3_eval: substituted 2 stocks")
  ok - g3_eval: substituted 2 stocks
  > 
  > ok(ut_cmp_equal(
  +     g3_eval(quote( g3_param('x', value = 99) )),
  +     99), "Used default value for param")
  ok - Used default value for param
  > ok(ut_cmp_equal(
  +     g3_eval(quote( g3_param('x', value = 99) ), param.x = 88),
  +     88), "Overrode g3_param with environment")
  ok - Overrode g3_param with environment
  > ok(ut_cmp_equal(
  +     g3_eval(
  +         g3_parameterized('lln.alpha', by_stock = TRUE, value = 99),
  +         stock = g3_stock("fish", 1:10),
  +         param.fish.lln.alpha = 123),
  +     123), "Both evaluated stock-ified parameter and substituted")
  ok - Both evaluated stock-ified parameter and substituted
  > 
  > ok_group("g3_eval error output", {
  +     ok(ut_cmp_error({
  +         g3_eval(quote( stock_prepend(stock, g3_param("x")) + stop('erk') ), stock = g3_stock("camel", 1), x = 99123)
  +     }, 'erk'), "Show error message")
  +     ok(ut_cmp_error({
  +         g3_eval(quote( stock_prepend(stock, g3_param("x")) + stop('erk') ), stock = g3_stock("camel", 1), x = 99123)
  +     }, 'g3_param\\("camel\\.x"\\)'), "Show converted formula")
  +     ok(ut_cmp_error({
  +         g3_eval(quote( stock_prepend(stock, g3_param("x")) + stop('erk') ), stock = g3_stock("camel", 1), x = 99123)
  +     }, '99123'), "Show content of environment")
  + })
  # g3_eval error output
  ok - Show error message
  ok - Show converted formula
  ok - Show content of environment
  > 
  > proc.time()
     user  system elapsed 
     0.48    0.06    0.53 
Running the tests in 'tests/test-likelihood_bounds.R' failed.
Complete output:
  > library(magrittr)
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > ############# Tests for parameter_template mode
  > 
  > actions <- list()
  > area_names <- g3_areas(c("IXa"))
  > 
  > actions_time <- list(
  +   g3a_time(
  +     1979L, 2023L,
  +     step_lengths = c(3L, 3L, 3L, 3L)),
  +   NULL)
  > actions <- c(actions, actions_time)
  > 
  > anch <- g3_stock("anch", seq(3L, 22L, 0.5)) |>
  +   g3s_livesonareas(area_names["IXa"]) |>
  +   g3s_age(0L, 3L)
  > actions_anch <- list(
  +   g3a_growmature(anch, g3a_grow_impl_bbinom(
  +     maxlengthgroupgrowth = 38L)),
  +   g3a_naturalmortality(anch),
  +   g3a_initialconditions_normalparam(anch),
  +   g3a_renewal_normalparam(anch,
  +     run_step = NULL),
  +   g3a_age(anch),
  +   NULL)
  > actions <- c(actions, actions_anch)
  > 
  > 
  > model_code <- g3_to_tmb(actions)
  > params.in <- attr(model_code, "parameter_template")
  > 
  > params.in[, 'optimise'] <- FALSE
  > params.in[, 'lower'] <- NA
  > params.in[, 'upper'] <- NA
  > 
  > ok(ut_cmp_identical(
  +     g3l_bounds_penalty(params.in),
  +     list()), "No penalty functions if nothing to optimise")
  ok - No penalty functions if nothing to optimise
  > 
  > params.in[, 'optimise'] <- TRUE
  > ok(ut_cmp_identical(
  +     g3l_bounds_penalty(params.in),
  +     list()), "No penalty functions if no lower/upper bounds")
  ok - No penalty functions if no lower/upper bounds
  > 
  > params.in['anch.rec.1990', 'lower'] <- 4
  > params.in['anch.rec.1991', 'lower'] <- 40
  > ok(ut_cmp_identical(
  +     g3l_bounds_penalty(params.in),
  +     list()), "No penalty functions if no upper bounds")
  ok - No penalty functions if no upper bounds
  > 
  > params.in['anch.rec.1990', 'upper'] <- 9
  > params.in['anch.rec.1991', 'upper'] <- 99
  > ok(ut_cmp_identical(lapply(g3l_bounds_penalty(params.in), deparse), list(
  +     "010:g3l_bounds_penalty  :anch.rec.1990       " = c(
  +         "~{",
  +         "    debug_label(\"g3l_bounds_penalty for anch.rec.1990\")",
  +         "    if (cur_time == 0) {", "        nll <- nll + 1 * ((logspace_add(1e+06 * (g3_param(\"anch.rec.1990\") - ",
  +         "            9)/(9 - 4), 0) + logspace_add(1e+06 * (4 - g3_param(\"anch.rec.1990\"))/(9 - ",
  +         "            4), 0))^2)",
  +         "    }",
  +         "}"),
  +     "010:g3l_bounds_penalty  :anch.rec.1991       " = c("~{",
  +         "    debug_label(\"g3l_bounds_penalty for anch.rec.1991\")",
  +         "    if (cur_time == 0) {", "        nll <- nll + 1 * ((logspace_add(1e+06 * (g3_param(\"anch.rec.1991\") - ",
  +         "            99)/(99 - 40), 0) + logspace_add(1e+06 * (40 - g3_param(\"anch.rec.1991\"))/(99 - ",
  +         "            40), 0))^2)", 
  +         "    }",
  +     "}"))), "Generated code for 2 parameters")
  ok - Generated code for 2 parameters
  > 
  > ############# Tests for actions mode
  > 
  > actions <- list(g3a_time(2000, 2000), list("555" = g3_formula({
  +     # TMB will fail mysteriously if at least one parameter isn't optimisable
  +     nll <- nll + g3_param('p0', value = 0, optimise = TRUE)
  +     nll <- nll + g3_param('pa')
  +     nll <- nll + g3_param('pb')
  +     nll <- nll + g3_param('pc')
  + })))
  > model_code <- g3_to_tmb(c(actions, list( g3l_bounds_penalty(actions) )))
  > fn <- g3_to_r(c(actions, list( g3l_bounds_penalty(actions) )))
  > 
  > ok(ut_cmp_equal(
  +     as.numeric(fn(c(list(pa=1, pb=2, pc=3), attr(fn, 'parameter_template')))),
  +     1 + 2 + 3), "nll: R version ignores g3l_bounds_penalty()")
  ok - nll: R version ignores g3l_bounds_penalty()
  > 
  > if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +     attr(model_code, 'parameter_template') |>
  +         g3_init_val('pa', 100.45) |>
  +         g3_init_val('pb', 200) |>
  +         g3_init_val('pc', 300.5342) |>
  +         identity() -> params.in
  +     obj.fn <- g3_tmb_adfun(model_code, params.in)
  +     ok(ut_cmp_equal(
  +         obj.fn$fn(),
  +         sum(unlist(params.in$value)) ), "nll: TMB version with no bounds enabled")
  + 
  +     attr(model_code, 'parameter_template') |>
  +         g3_init_val('pa', 100, lower = 50, upper = 150) |>
  +         g3_init_val('pb', 200) |>
  +         g3_init_val('pc', 300) |>
  +         identity() -> params.in
  +     obj.fn <- g3_tmb_adfun(model_code, params.in)
  +     ok(ut_cmp_equal(
  +         obj.fn$fn(),
  +         sum(unlist(params.in$value)) ), "nll: TMB version, within bounds")
  + 
  +     attr(model_code, 'parameter_template') |>
  +         g3_init_val('pa', 100, lower = 10, upper = 50) |>
  +         g3_init_val('pb', 200) |>
  +         g3_init_val('pc', 300) |>
  +         identity() -> params.in
  +     obj.fn <- g3_tmb_adfun(model_code, params.in)
  +     ok(ut_cmp_equal(
  +         obj.fn$fn(),
  +         1.6e12,
  +         tolerance=1e1), "nll: TMB version, above bounds")
  + 
  +     attr(model_code, 'parameter_template') |>
  +         g3_init_val('pa', 10, lower = 20, upper = 50) |>
  +         g3_init_val('pb', 200) |>
  +         g3_init_val('pc', 300) |>
  +         identity() -> params.in
  +     obj.fn <- g3_tmb_adfun(model_code, params.in)
  +     ok(ut_cmp_equal(
  +         obj.fn$fn(),
  +         1e+11,
  +         tolerance=1e1), "nll: TMB version, outside bounds")
  + 
  +     attr(model_code, 'parameter_template') |>
  +         g3_init_val('pa', 10, lower = 20, upper = 50) |>
  +         g3_init_val('pb', 90, lower = 20, upper = 50) |>
  +         g3_init_val('pc', 300) |>
  +         identity() -> params.in
  +     obj.fn <- g3_tmb_adfun(model_code, params.in)
  +     ok(ut_cmp_equal(
  +         obj.fn$fn(),
  +         2e12,
  +         tolerance=1e1), "nll: TMB version, 2 parameters outside bounds")
  + } else {
  +     writeLines("# skip: not compiling TMB model")
  + }
  # skip: not compiling TMB model
  > 
  > proc.time()
     user  system elapsed 
     1.78    0.09    1.85 
Running the tests in 'tests/test-likelihood_random.R' failed.
Complete output:
  > library(magrittr)
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > actions <- list(
  +     g3a_time(
  +         start_year = 1990,
  +         end_year = 1994,
  +         c(3,3,3,3)),
  +     g3l_random_dnorm('dnorm_log',
  +         ~g3_param('dnorm_log', value = 0, random = TRUE),
  +         mean_f = ~g3_param('dnorm_log_mean', value = 0, optimise = FALSE),
  +         sigma_f = ~g3_param('dnorm_log_sigma', value = 1, optimise = FALSE),
  +         weight = ~g3_param('dnorm_log_enabled', value = 0, optimise = FALSE)),
  +     g3l_random_dnorm('dnorm_lin',
  +         ~g3_param('dnorm_lin', value = 0, random = TRUE),
  +         mean_f = ~g3_param('dnorm_lin_mean', value = 0, optimise = FALSE),
  +         sigma_f = ~g3_param('dnorm_lin_sigma', value = 1, optimise = FALSE),
  +         log_f = FALSE,
  +         weight = ~g3_param('dnorm_lin_enabled', value = 0, optimise = FALSE)),
  +     g3l_random_walk('walk_year',
  +         ~g3_param_table('walk_year', expand.grid(cur_year = seq(start_year,  end_year)), value = 0, random = TRUE),
  +         sigma_f = ~g3_param('walk_year_sigma', value = 1, optimise = FALSE),
  +         weight = ~g3_param('walk_year_enabled', value = 0, optimise = FALSE)),
  +     g3l_random_walk('walk_step',
  +         ~g3_param_table('walk_step', expand.grid(
  +             cur_year = seq(start_year,  end_year),
  +             cur_step = 1:4), value = 0, random = TRUE),
  +         sigma_f = ~g3_param('walk_step_sigma', value = 1, optimise = FALSE),
  +         weight = ~g3_param('walk_step_enabled', value = 0, optimise = FALSE)),
  +     list('999' = ~{}))
  > 
  > model_fn <- g3_to_r(actions)
  > # model_fn <- edit(model_fn)
  > if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +     model_cpp <- g3_to_tmb(actions, trace = FALSE)
  +     # model_cpp <- edit(model_cpp)
  +     model_tmb <- g3_tmb_adfun(model_cpp, compile_flags = c("-O0", "-g"))
  + } else {
  +     writeLines("# skip: not compiling TMB model")
  +     model_cpp <- c()
  + }
  # skip: not compiling TMB model
  > 
  > ok_group('g3l_random_dnorm', {
  +     params <- attr(model_fn, 'parameter_template')
  +     params['dnorm_log'] <- runif(1, 0, 10)
  +     params['dnorm_log_mean'] <- runif(1, 0, 10)
  +     params['dnorm_log_sigma'] <- runif(1, 0, 10)
  +     params['dnorm_log_enabled'] <- 1
  +     params['dnorm_lin'] <- runif(1, 0, 10)
  +     params['dnorm_lin_mean'] <- runif(1, 0, 10)
  +     params['dnorm_lin_sigma'] <- runif(1, 0, 10)
  +     params['dnorm_lin_enabled'] <- 1
  +     result <- model_fn(params)
  + 
  +     ok(ut_cmp_equal(
  +         as.vector(attr(result, "nll_random_dnorm_dnorm_log__dnorm")),
  +         -dnorm(params$dnorm_log, params$dnorm_log_mean, params$dnorm_log_sigma, TRUE),
  +         tolerance = 1e-7), "dnorm_log matches dnorm")
  +     ok(ut_cmp_equal(
  +         as.vector(attr(result, "nll_random_dnorm_dnorm_lin__dnorm")),
  +         dnorm(params$dnorm_lin, params$dnorm_lin_mean, params$dnorm_lin_sigma, FALSE),
  +         tolerance = 1e-7), "dnorm_lin matches dnorm")
  +     ok(ut_cmp_equal(
  +         as.vector(result),
  +         sum(c(
  +             -dnorm(params$dnorm_log, params$dnorm_log_mean, params$dnorm_log_sigma, TRUE),
  +             dnorm(params$dnorm_lin, params$dnorm_lin_mean, params$dnorm_lin_sigma, FALSE),
  +             0)),
  +         tolerance = 1e-7), "nll matches both (and has been included only once)")
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         param_template <- attr(model_cpp, "parameter_template")
  +         param_template$value <- params[param_template$switch]
  +         # Reproduce model to include any unoptimised parameters
  +         model_tmb <- g3_tmb_adfun(model_cpp, param_template, compile_flags = c("-O0", "-g"))
  +         ok(ut_cmp_identical(names(model_tmb$env$last.par)[model_tmb$env$random], c(
  +             'dnorm_lin',
  +             'dnorm_log',
  +             'walk_step__1990__1',
  +             'walk_step__1991__1',
  +             'walk_step__1992__1',
  +             'walk_step__1993__1',
  +             'walk_step__1994__1',
  +             'walk_step__1990__2',
  +             'walk_step__1991__2',
  +             'walk_step__1992__2',
  +             'walk_step__1993__2',
  +             'walk_step__1994__2',
  +             'walk_step__1990__3',
  +             'walk_step__1991__3',
  +             'walk_step__1992__3',
  +             'walk_step__1993__3',
  +             'walk_step__1994__3',
  +             'walk_step__1990__4',
  +             'walk_step__1991__4',
  +             'walk_step__1992__4',
  +             'walk_step__1993__4',
  +             'walk_step__1994__4',
  +             'walk_year__1990',
  +             'walk_year__1991',
  +             'walk_year__1992',
  +             'walk_year__1993',
  +             'walk_year__1994',
  +             NULL)), "env$random: TMB got expected random variables")
  +         gadget3:::ut_tmb_r_compare(model_fn, model_tmb, param_template)
  +     } else {
  +         writeLines("# skip: not running TMB tests")
  +     }
  + })
  # g3l_random_dnorm
  ok - dnorm_log matches dnorm
  ok - dnorm_lin matches dnorm
  ok - nll matches both (and has been included only once)
  # skip: not running TMB tests
  > 
  > ok_group('g3l_random_walk', {
  +     params <- attr(model_fn, 'parameter_template')
  +     params['walk_year_enabled'] <- 1
  +     params[grepl('walk_year\\.199', names(params))] <- runif(5, 1, 10)
  +     params['walk_step_enabled'] <- 1
  +     params[grepl('walk_step\\.199', names(params))] <- runif(5 * 4, 1, 10)
  +     result <- model_fn(params)
  +     
  +     # Calculate the sum of a random walk along values
  +     sum_walk_dnorm <- function (vals, sigma, is_log) {
  +         vals <- vals[order(names(vals))]  # Sort by name, so 1991.1 is before 1991.2
  +         lead <- head(vals, -1)
  +         lag <- tail(vals, -1)
  +         sum(vapply(
  +             seq_along(lead),
  +             function (i) -dnorm(lead[[i]], lag[[i]], sigma, is_log),
  +             numeric(1)))
  +     }
  + 
  +     ok(ut_cmp_equal(
  +         as.vector(attr(result, "nll_random_walk_walk_year__dnorm")),
  +         sum_walk_dnorm(params[grepl('walk_year\\.199', names(params))],  params$walk_year_sigma, TRUE),
  +         tolerance = 1e-7), "nll_random_walk_walk_year__dnorm")
  + 
  +     ok(ut_cmp_equal(
  +         as.vector(attr(result, "nll_random_walk_walk_step__dnorm")),
  +         sum_walk_dnorm(params[grepl('walk_step\\.199', names(params))],  params$walk_step_sigma, TRUE),
  +         tolerance = 1e-7), "nll_random_walk_walk_step__dnorm")
  + 
  +     ok(ut_cmp_equal(
  +         as.vector(result),
  +         as.vector(sum(
  +             attr(result, "nll_random_walk_walk_year__dnorm"),
  +             attr(result, "nll_random_walk_walk_step__dnorm"),
  +             0)),
  +         tolerance = 1e-7), "nll matches both")
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         param_template <- attr(model_cpp, "parameter_template")
  +         param_template$value <- params[param_template$switch]
  +         # Reproduce model to include any unoptimised parameters
  +         model_tmb <- g3_tmb_adfun(model_cpp, param_template, compile_flags = c("-O0", "-g"))
  +         gadget3:::ut_tmb_r_compare(model_fn, model_tmb, param_template)
  +     } else {
  +         writeLines("# skip: not running TMB tests")
  +     }
  + })
  # g3l_random_walk
  ok - nll_random_walk_walk_year__dnorm
  ok - nll_random_walk_walk_step__dnorm
  ok - nll matches both
  # skip: not running TMB tests
  > 
  > if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +     # An end-to-end test, too complex to be a vignette example
  +     in_param <- g3_parameterized('par', by_year = TRUE, random = TRUE, value = 50)
  +     out_stock <- g3_stock('output', 1) |> g3s_time(year = 1990:2000)
  + 
  +     simple_code <- g3_to_tmb(list(
  +         g3a_time(1990, 2000),
  +         gadget3:::g3_step(g3_formula(
  +             quote( stock_iterate(out_stock, stock_ss(out_stock__val) <- force_type * in_param) ),
  +             out_stock = out_stock,
  +             # NB: We need to set an array<Type>
  +             force_type = as.array(1),
  +             out_stock__val = g3_stock_instance(out_stock, 0),
  +             in_param = in_param )),
  +         g3l_random_dnorm(
  +             'rdnorm_par',
  +             param_f = in_param,
  +             # These need to be Types, not (double), thus g3_formula()
  +             mean_f = g3_formula(cur_year * m, m = 0.001),
  +             sigma_f = g3_formula(s, s = 1) ),
  +         gadget3:::g3a_report_var(
  +             'out_stock__val',
  +             g3_stock_instance(out_stock, 0),
  +             stock = out_stock,
  +             out_prefix = NULL),
  +         NULL))
  +     obj.fn <- g3_tmb_adfun(simple_code)
  +     out <- suppressWarnings(optim(obj.fn$par, obj.fn$fn, obj.fn$gr, method = "BFGS", control = list(maxit = 10)))
  +     ok(ut_cmp_equal(
  +         as.vector(obj.fn$report()$output__val),
  +         c(1.99, 1.991, 1.992, 1.993, 1.994, 1.995, 1.996, 1.997, 1.998, 1.999, 2),
  +         filter = NULL), "output__val: Found mean for each year")
  + }
  > 
  > proc.time()
     user  system elapsed 
     0.95    0.10    1.07 
Running the tests in 'tests/test-run.R' failed.
Complete output:
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > cmp_code <- function(a, b) {
  +     if (rlang::is_formula(a)) a <- rlang::f_rhs(a)
  +     if (rlang::is_formula(b)) b <- rlang::f_rhs(b)
  +     attr(a, "srcref") <- NULL
  +     attr(a, "srcfile") <- NULL
  +     attr(a, "wholeSrcref") <- NULL
  +     attr(b, "srcref") <- NULL
  +     attr(b, "srcfile") <- NULL
  +     attr(b, "wholeSrcref") <- NULL
  +     ut_cmp_identical(a, b)
  + }
  > 
  > ok_group("action_reports", {
  +     ok(cmp_code(gadget3:::action_reports(list(
  +         ~{y <- 1},
  +         ~{y <- 1 ; x <- 2}
  +         ~{}), REPORT = '.'), quote({
  +         REPORT(x)
  +         REPORT(y)
  +     })), "Don't return duplicates, results are sorted")
  + 
  +     ok(cmp_code(gadget3:::action_reports(list(
  +         ~g3_with(x := 1, z := 2, {y <- 1 ; x <- 2}),
  +         ~{rr <- 1},
  +         ~{}), REPORT = '.'), quote({
  +         REPORT(rr)
  +         REPORT(y)
  +     })), "g3_with vars are ignored")
  + 
  +     ok(cmp_code(gadget3:::action_reports(list(
  +         ~{ p_p <- 1 ; p_q <- 1 ; p_r <- 1},
  +         ~{ q_p <- 1 ; q_q <- 1 ; q_r <- 1},
  +         ~{}), p_rep = '^p_', q_rep = '^q_', r_rep = 'r', z_rep = 'z'), quote({
  +         p_rep(p_p)
  +         p_rep(p_q)
  +         p_rep(p_r)
  +         q_rep(q_p)
  +         q_rep(q_q)
  +         q_rep(q_r)
  +         r_rep(p_r)
  +         r_rep(q_r)
  +     })), "Can generate multiple report functions with filters")
  + })
  # action_reports
  ok - Don't return duplicates, results are sorted
  ok - g3_with vars are ignored
  ok - Can generate multiple report functions with filters
  > 
  > proc.time()
     user  system elapsed 
     0.39    0.09    0.45 
Running the tests in 'tests/test-run_tmb-reporting_enabled.R' failed.
Complete output:
  > if (!interactive()) options(warn=2, error = function() { sink(stderr()) ; traceback(3) ; q(status = 1) })
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > actions <- list( g3_formula({
  +     nll <- g3_param('init_nll', value = 1)
  +     nll <- nll + (1000 * reporting_enabled)
  +     REPORT(nll)
  +     return(nll)
  + }, nll = 0.0) )
  > 
  > fn <- g3_to_r(actions)
  > ok(ut_cmp_equal(as.vector(fn(list(init_nll = 1))), 1001), "nll: reporting_enabled always 1 under R")
  ok - nll: reporting_enabled always 1 under R
  > 
  > if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +     obj.fn <- g3_tmb_adfun(g3_to_tmb(actions))
  +     ok(ut_cmp_equal(obj.fn$fn(), 1), "nll: reporting_enabled defaults to 0")
  +     ok(ut_cmp_equal(obj.fn$report()$nll, 1001), "nll: $report() has enabled reporting_enabled")
  +     ok(ut_cmp_equal(obj.fn$fn(), 1), "nll: reporting_enabled defaults to 0 afterwards (value reset)")
  + }
  > 
  > proc.time()
     user  system elapsed 
     0.28    0.17    0.43 
Running the tests in 'tests/test-run_tmb.R' failed.
Complete output:
  > library(magrittr)
  > library(unittest)
  > 
  > library(gadget3)
  > 
  > capture_warnings <- function(x, full_object = FALSE) {
  +     all_warnings <- list()
  +     rv <- withCallingHandlers(x, warning = function (w) {
  +         all_warnings <<- c(all_warnings, list(w))
  +         invokeRestart("muffleWarning")
  +     })
  +     if (!full_object) all_warnings <- vapply(all_warnings, function (w) w$message, character(1))
  +     return(list(rv = rv, warnings = all_warnings))
  + }
  > 
  > ok(ut_cmp_error({
  +     invalid_subset <- array(dim = c(2,2,2))
  +     g3_to_tmb(list(~{invalid_subset[,g3_idx(1),]}))
  + }, "invalid_subset"), "Complained when trying to subset in middle")
  ok - Complained when trying to subset in middle
  > ok(ut_cmp_error({
  +     invalid_subset <- array(dim = c(2,2,2))
  +     g3_to_tmb(list(~{invalid_subset[g3_idx(1),,] <- 0}))
  + }, "invalid_subset"), "Complained when trying to subset by row in an lvalue")
  ok - Complained when trying to subset by row in an lvalue
  > 
  > ok(ut_cmp_error({
  +     g3_to_tmb(list(~{ 2 + NA }))
  + }, "NA"), "No such thing as NA in C++")
  ok - No such thing as NA in C++
  > 
  > ok(grepl(
  +     "unknown_func(.*2.*)",
  +     paste(g3_to_tmb(list(~{
  +         unknown_func(2)
  +     })), collapse = "\n"),
  +     perl = TRUE), "Unknown functions that are valid C++ get included")
  ok - Unknown functions that are valid C++ get included
  > 
  > ok(ut_cmp_error({
  +     g3_to_tmb(list(~`0unknown0`(2)))
  + }, "0unknown0"), "An unknown function has to at least be a valid C++ function")
  ok - An unknown function has to at least be a valid C++ function
  > 
  > ok(ut_cmp_error({
  +     g3_to_tmb(list(~not.a.function(2)))
  + }, "not\\.a\\.function"), "An unknown function has to at least be a valid C++ function")
  ok - An unknown function has to at least be a valid C++ function
  > 
  > ok(ut_cmp_error({
  +     g3_tmb_adfun(g3_to_tmb(list(~{
  +         g3_param('randomandoptimise', random = TRUE, optimise = TRUE)
  +         g3_param('ro2', random = TRUE, optimise = TRUE)
  +     })))
  + }, "randomandoptimise,ro2"), "Specifying random and optimise isn't allowed")
  ok - Specifying random and optimise isn't allowed
  > 
  > ok(ut_cmp_error({
  +     g3_tmb_adfun(g3_to_tmb(list(~{ g3_param_table('randomandoptimise', expand.grid(cur_step = 2:3), random = TRUE, optimise = TRUE) })))
  + }, "randomandoptimise"), "Specifying random and optimise isn't allowed")
  ok - Specifying random and optimise isn't allowed
  > 
  > ok(ut_cmp_error({
  +     g3_to_tmb(list(~g3_param("camel", optimize = FALSE)))
  + }, "optimise"), "Optimise is spelt with an s in g3_param()")
  ok - Optimise is spelt with an s in g3_param()
  > 
  > ok_group("Exponentiate params")
  # Exponentiate params
  > params.in <- attr(g3_to_tmb(list( g3a_time(1990, 2000), g3_formula(
  +     quote(d),
  +     d = g3_parameterized('par.years', value = 0, by_year = TRUE, exponentiate = TRUE),
  +     x = NA) )), 'parameter_template')
  > ok(ut_cmp_identical(params.in[grep('^par', params.in$switch), 'switch'], c(
  +     paste0('par.years.', 1990:2000, '_exp'),
  +     NULL)), "exponentiate prefix ends up at the end of parameters")
  ok - exponentiate prefix ends up at the end of parameters
  > 
  > ok_group('g3_tmb_par', {
  +     param <- attr(g3_to_tmb(list(~{
  +         g3_param('param.b')
  +         g3_param_vector('param_vec')
  +         g3_param('aaparam')
  +         g3_param('randomparam', random = TRUE)
  +     })), 'parameter_template')
  +     param$value <- I(list(
  +         aaparam = 55,
  +         param.b = 66,
  +         randomparam = 2,
  +         param_vec = 6:10)[rownames(param)])
  + 
  +     ok(ut_cmp_identical(g3_tmb_par(param, include_random = FALSE), c(
  +         param__b = 66,
  +         param_vec1 = 6, param_vec2 = 7, param_vec3 = 8, param_vec4 = 9, param_vec5 = 10,
  +         aaparam = 55)), "g3_tmb_par: Flattened parameters in right order")
  + 
  +     param['param_vec', 'optimise'] <- FALSE
  +     ok(ut_cmp_identical(g3_tmb_par(param, include_random = FALSE), c(
  +         param__b = 66,
  +         aaparam = 55)), "g3_tmb_par: Turning off optimise removed values")
  + 
  +     ok(ut_cmp_identical(g3_tmb_par(param, include_random = TRUE), c(
  +         param__b = 66,
  +         aaparam = 55,
  +         randomparam = 2)), "g3_tmb_par: randomparam visible if include_random on")
  + })
  # g3_tmb_par
  ok - g3_tmb_par: Flattened parameters in right order
  ok - g3_tmb_par: Turning off optimise removed values
  ok - g3_tmb_par: randomparam visible if include_random on
  > 
  > ok_group('g3_tmb_lower', {
  +     param <- attr(g3_to_tmb(list(~{
  +         g3_param('param.b')
  +         g3_param_vector('param_vec')
  +         g3_param('aaparam')
  +         # NB: Never visible
  +         g3_param('randomparam', random = TRUE)
  +     })), 'parameter_template')
  +     param$value <- I(list(
  +         aaparam = 55,
  +         param.b = 66,
  +         randomparam = 2,
  +         param_vec = 6:10)[rownames(param)])
  +     param$lower <- c(
  +         aaparam = 500,
  +         param.b = 600,
  +         param_vec = 100)[rownames(param)]
  + 
  +     ok(ut_cmp_identical(g3_tmb_lower(param), c(
  +         param__b = 600,
  +         param_vec1 = 100, param_vec2 = 100, param_vec3 = 100, param_vec4 = 100, param_vec5 = 100,
  +         aaparam = 500)), "g3_tmb_lower: All lower bounds in right order")
  + 
  +     param['param_vec', 'lower'] <- 3
  +     ok(ut_cmp_identical(g3_tmb_lower(param), c(
  +         param__b = 600,
  +         param_vec1 = 3, param_vec2 = 3, param_vec3 = 3, param_vec4 = 3, param_vec5 = 3,
  +         aaparam = 500)), "g3_tmb_lower: Set all lower values of param_vec in one go")
  +     ok(ut_cmp_identical(
  +         names(g3_tmb_par(param, include_random = FALSE)),
  +         names(g3_tmb_lower(param))), "g3_tmb_lower: Structure matches par after setting param_vec")
  + 
  +     param['param.b', 'optimise'] <- FALSE
  +     ok(ut_cmp_identical(g3_tmb_lower(param), c(
  +         param_vec1 = 3, param_vec2 = 3, param_vec3 = 3, param_vec4 = 3, param_vec5 = 3,
  +         aaparam = 500)), "g3_tmb_lower: Cleared param.b by setting optimise = F")
  +     ok(ut_cmp_identical(
  +         names(g3_tmb_par(param, include_random = FALSE)),
  +         names(g3_tmb_lower(param))), "g3_tmb_lower: Structure matches par after setting param.b")
  + })
  # g3_tmb_lower
  ok - g3_tmb_lower: All lower bounds in right order
  ok - g3_tmb_lower: Set all lower values of param_vec in one go
  ok - g3_tmb_lower: Structure matches par after setting param_vec
  ok - g3_tmb_lower: Cleared param.b by setting optimise = F
  ok - g3_tmb_lower: Structure matches par after setting param.b
  > 
  > ok_group('g3_tmb_upper', {
  +     param <- attr(g3_to_tmb(list(~{
  +         g3_param('param.b')
  +         g3_param_vector('param_vec')
  +         g3_param('aaparam')
  +         # NB: Never visible
  +         g3_param('randomparam', random = TRUE)
  +     })), 'parameter_template')
  +     param$value <- I(list(
  +         aaparam = 55,
  +         param.b = 66,
  +         randomparam = 2,
  +         param_vec = 6:10)[rownames(param)])
  +     param$upper <- c(
  +         aaparam = 500,
  +         param.b = 600,
  +         param_vec = 100)[rownames(param)]
  + 
  +     ok(ut_cmp_identical(g3_tmb_upper(param), c(
  +         param__b = 600,
  +         param_vec1 = 100, param_vec2 = 100, param_vec3 = 100, param_vec4 = 100, param_vec5 = 100,
  +         aaparam = 500)), "g3_tmb_upper: All upper bounds in right order")
  + 
  +     param['param_vec', 'upper'] <- 3
  +     ok(ut_cmp_identical(g3_tmb_upper(param), c(
  +         param__b = 600,
  +         param_vec1 = 3, param_vec2 = 3, param_vec3 = 3, param_vec4 = 3, param_vec5 = 3,
  +         aaparam = 500)), "g3_tmb_upper: Set all lower values of param_vec in one go")
  +     ok(ut_cmp_identical(
  +         names(g3_tmb_par(param, include_random = FALSE)),
  +         names(g3_tmb_lower(param))), "g3_tmb_upper: Structure matches par after setting param_vec")
  + 
  +     param['param.b', 'optimise'] <- FALSE
  +     ok(ut_cmp_identical(g3_tmb_upper(param), c(
  +         param_vec1 = 3, param_vec2 = 3, param_vec3 = 3, param_vec4 = 3, param_vec5 = 3,
  +         aaparam = 500)), "g3_tmb_upper: Cleared param.b by setting optimise = F")
  +     ok(ut_cmp_identical(
  +         names(g3_tmb_par(param, include_random = FALSE)),
  +         names(g3_tmb_lower(param))), "g3_tmb_lower: Structure matches par after setting param.b")
  + })
  # g3_tmb_upper
  ok - g3_tmb_upper: All upper bounds in right order
  ok - g3_tmb_upper: Set all lower values of param_vec in one go
  ok - g3_tmb_upper: Structure matches par after setting param_vec
  ok - g3_tmb_upper: Cleared param.b by setting optimise = F
  ok - g3_tmb_lower: Structure matches par after setting param.b
  > 
  > ok_group('g3_tmb_parscale', {
  +     param <- attr(g3_to_tmb(list(~{
  +         g3_param('param.lu', lower = 4, upper = 8)
  +         g3_param('param.ps', parscale = 22)
  +         g3_param('param.lups', lower = 4, upper = 8, parscale = 44)
  +     })), 'parameter_template')
  +     ok(ut_cmp_identical(g3_tmb_parscale(param), c(
  +         param__lu = NA,
  +         param__ps = 22,
  +         param__lups = 44)), "We populate parscale")
  + })
  # g3_tmb_parscale
  ok - We populate parscale
  > 
  > ok_group('g3_tmb_relist', {
  +     param <- attr(g3_to_tmb(list(~{
  +         g3_param('param.b')
  +         g3_param_vector('param_vec')
  +         g3_param('unopt_param', optimise = FALSE)
  +         g3_param('randomparam', random = TRUE)
  +         g3_param('aaparam')
  +     })), 'parameter_template')
  +     param$value <- I(list(
  +         aaparam = 55,
  +         param.b = 66,
  +         unopt_param = 95,
  +         randomparam = 2,
  +         param_vec = 6:10)[rownames(param)])
  + 
  +     ok(ut_cmp_identical(
  +         g3_tmb_relist(param, c(
  +             param__b = 660,
  +             param_vec1 = 60, param_vec2 = 70, param_vec3 = 80, param_vec4 = 90, param_vec5 = 100,
  +             aaparam = 550)),
  +         list(
  +             "param.b" = 660,
  +             "param_vec" = c(60, 70, 80, 90, 100),
  +             "unopt_param" = 95,
  +             "randomparam" = 2,
  +             "aaparam" = 550)), "g3_tmb_relist: Put parameters back in right slots, used old unopt_param value")
  +     ok(ut_cmp_identical(
  +         g3_tmb_relist(param, c(
  +             param__b = 660,
  +             param_vec1 = 60, param_vec2 = 70, param_vec3 = 80, param_vec4 = 90, param_vec5 = 100,
  +             randomparam = 5,  # NB: randomparam included, so we update it
  +             aaparam = 550)),
  +         list(
  +             "param.b" = 660,
  +             "param_vec" = c(60, 70, 80, 90, 100),
  +             "unopt_param" = 95,
  +             "randomparam" = 5,
  +             "aaparam" = 550)), "g3_tmb_relist: Put parameters back in right slots, including random")
  + 
  +     param['param.b', 'optimise'] <- FALSE
  +     ok(ut_cmp_error(
  +         g3_tmb_relist(param, c(
  +             param__b = 660,
  +             param_vec1 = 60, param_vec2 = 70, param_vec3 = 80, param_vec4 = 90, param_vec5 = 100,
  +             randomparam = 6,  # NB: randomparam included, so we update it
  +             aaparam = 550)),
  +         "par"), "g3_tmb_relist: Still included param__b in par, now an error")
  +     ok(ut_cmp_identical(
  +         g3_tmb_relist(param, c(
  +             param_vec1 = 60, param_vec2 = 70, param_vec3 = 80, param_vec4 = 90, param_vec5 = 100,
  +             aaparam = 550)),
  +         list(
  +             "param.b" = 66,
  +             "param_vec" = c(60, 70, 80, 90, 100),
  +             "unopt_param" = 95,
  +             "randomparam" = 2,
  +             "aaparam" = 550)), "g3_tmb_relist: Works without param.b set, use initial table value")
  + })
  # g3_tmb_relist
  ok - g3_tmb_relist: Put parameters back in right slots, used old unopt_param value
  ok - g3_tmb_relist: Put parameters back in right slots, including random
  ok - g3_tmb_relist: Still included param__b in par, now an error
  ok - g3_tmb_relist: Works without param.b set, use initial table value
  > 
  > ok_group('g3_param', {
  +     param <- attr(g3_to_tmb(list(g3a_time(2000, 2004), ~{
  +         g3_param('a')
  +         g3_param('b', value = 4, optimise = FALSE, random = TRUE, lower = 5, upper = 10)
  +     })), 'parameter_template')
  +     ok(ut_cmp_identical(
  +         param[c('a', 'b'),],
  +         data.frame(
  +             row.names = c('a', 'b'),
  +             switch = c('a', 'b'),
  +             type = c("", ""),
  +             value = I(list(a = 0, b = 4)),
  +             optimise = c(TRUE, FALSE),
  +             random = c(FALSE, TRUE),
  +             lower = c(NA, 5),
  +             upper = c(NA, 10),
  +             parscale = as.numeric(c(NA, NA)),  # NB: Not derived yet, only when calling g3_tmb_parscale()
  +             stringsAsFactors = FALSE)), "Param table included custom values")
  + })
  # g3_param
  ok - Param table included custom values
  > 
  > ok_group('g3_param_table', {
  +     param <- attr(g3_to_tmb(list(g3a_time(2000, 2004, step_lengths = c(3,3,3,3)), ~{
  +         g3_param_table('pt', expand.grid(  # NB: We can use base R
  +             cur_year = seq(start_year, end_year),  # NB: We can use g3a_time's vars
  +             cur_step = 2:3))
  +         g3_param_table('pg', expand.grid(
  +             cur_year = start_year,
  +             cur_step = 1:2), value = 4, optimise = FALSE, random = TRUE, lower = 5, upper = 10)
  +     })), 'parameter_template')
  +     ok(ut_cmp_identical(
  +         param[c(paste('pt', 2000:2004, 2, sep = '.'), paste('pt', 2000:2004, 3, sep = '.'), 'pg.2000.1', 'pg.2000.2'),],
  +         data.frame(
  +             row.names = c(paste('pt', 2000:2004, 2, sep = '.'), paste('pt', 2000:2004, 3, sep = '.'), 'pg.2000.1', 'pg.2000.2'),
  +             switch = c(paste('pt', 2000:2004, 2, sep = '.'), paste('pt', 2000:2004, 3, sep = '.'), 'pg.2000.1', 'pg.2000.2'),
  +             type = c("", "", "", "", "", "", "", "", "", "", "", ""),
  +             value = I(list(
  +                 "pt.2000.2" = 0,
  +                 "pt.2001.2" = 0,
  +                 "pt.2002.2" = 0,
  +                 "pt.2003.2" = 0,
  +                 "pt.2004.2" = 0,
  +                 "pt.2000.3" = 0,
  +                 "pt.2001.3" = 0,
  +                 "pt.2002.3" = 0,
  +                 "pt.2003.3" = 0,
  +                 "pt.2004.3" = 0,
  +                 "pg.2000.1" = 4,
  +                 "pg.2000.2" = 4)),
  +             optimise = c(TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE),
  +             random = c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE),
  +             lower = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 5, 5),
  +             upper = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 10, 10),
  +             # NB: Not derived yet, only when calling g3_tmb_parscale()
  +             parscale = as.numeric(c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA)),
  +             stringsAsFactors = FALSE)), "Param table included custom values")
  +     ok(ut_cmp_identical(
  +         attr(g3_to_tmb(list(~{
  +             g3_param_table('moo', expand.grid(cur_year=1990:1994))
  +             g3_param('moo.1990')
  +             g3_param('oink.2')
  +         })), 'parameter_template')$switch,
  +         c("moo.1990", "moo.1991", "moo.1992", "moo.1993", "moo.1994", "oink.2")), "Refering to individual parameters doesn't generate duplicate table entries")
  + })
  # g3_param_table
  ok - Param table included custom values
  ok - Refering to individual parameters doesn't generate duplicate table entries
  > 
  > ok_group("g3_to_tmb: attr.actions", {
  +     actions <- list(
  +         list("001" = ~{ 1 + 1 }, "002" = ~{2 + 2}),
  +         "003" = ~{3 + 3})
  +     model_fn <- g3_to_tmb(actions)
  +     ok(ut_cmp_identical(attr(model_fn, 'actions'), actions), "actions returned as attribute uncollated")
  + })
  # g3_to_tmb: attr.actions
  ok - actions returned as attribute uncollated
  > 
  > ok_group("g3_to_tmb: Can use random parameters without resorting to include_random", local({
  +     # ./TMB/inst/examples/randomregression.R converted into gadget3
  +     actions <- local({
  +         set.seed(123)
  +         n <- 1
  +         ng <- 1
  +         f <- gl(ng, n/ng)
  +         t <- rnorm(n, mean=2, sd=5)
  +         a <- rnorm(ng, mean=3, sd=4)
  +         b <- rnorm(ng, mean=8, sd=7)
  +         x <- a[f] * t + b[f] + rnorm(n, mean=0, sd=1)
  +         set.seed(NULL)
  + 
  +         list(
  +             g3a_time(1990, 1991),
  +             g3l_random_dnorm("a",
  +                 ~g3_param('a', value=1, random=TRUE),
  +                 ~g3_param('mu.a', value=1),
  +                 ~g3_param('sigma.a', value=1), period="single"),
  +             g3l_random_dnorm("b",
  +                 ~g3_param('b', value=1, random=TRUE),
  +                 ~g3_param('mu.b', value=1),
  +                 ~g3_param('sigma.b', value=1), period="single"),
  +             g3l_random_dnorm("x",
  +                 ~x,
  +                 ~g3_param('a', value=1, random=TRUE) * t + g3_param('b', value=1, random=TRUE),
  +                 ~g3_param('sigma0', value=1), period="single" ))
  +     })
  +     model_fn <- g3_to_r(actions)
  + 
  +     if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +         model_cpp <- g3_to_tmb(actions)
  +         model_tmb <- g3_tmb_adfun(model_cpp, compile_flags = c("-O0", "-g"), inner.control = list(fnscale = -1))
  +         param_tbl <- attr(model_cpp, 'parameter_template')
  +         param_tbl[,'lower'] <- -2
  +         param_tbl[,'upper'] <- 3
  +         param_tbl[,'parscale'] <- 1
  + 
  +         ok(ut_cmp_identical(names(model_tmb$env$last.par)[model_tmb$env$random], c(
  +             "a",
  +             "b",
  +             NULL)), "env$random: TMB got the random parameters we expected")
  + 
  +         ok(ut_cmp_error({
  +             nlminb(g3_tmb_par(param_tbl), model_tmb$fn, model_tmb$gr)
  +         }, "\\$par"), "g3_tmb_par: Not allowed in nlminb() call")
  +         ok(ut_cmp_error({
  +             optim(g3_tmb_par(param_tbl), model_tmb$fn, model_tmb$gr)
  +         }, "\\$par"), "g3_tmb_par: Not allowed in optim() call")
  + 
  +         res <- suppressWarnings({
  +             nlminb(model_tmb$par, model_tmb$fn, model_tmb$gr,
  +                 upper = g3_tmb_upper(param_tbl),
  +                 lower = g3_tmb_lower(param_tbl),
  +                 control = list(
  +                     fnscale = -1,
  +                     parscale = g3_tmb_parscale(param_tbl)))
  +         })
  +         ok(res$convergence == 0, "Model ran successfully and converged")
  + 
  +         # The first won't have random parameters, the latter will. Both should work
  +         value_no_random <- g3_tmb_relist(param_tbl, res$par)
  +         value_inc_random <- g3_tmb_relist(param_tbl, model_tmb$env$last.par)
  +         ok(ut_cmp_equal(
  +             value_no_random[param_tbl[!param_tbl$random, 'switch']],
  +             value_inc_random[param_tbl[!param_tbl$random, 'switch']]), "Non-random parameters match")
  +         ok(ut_cmp_equal(
  +             I(value_no_random[param_tbl[param_tbl$random, 'switch']]),
  +             param_tbl$value[param_tbl[param_tbl$random, 'switch']]), "value_no_random: Random parameters as default")
  +         ok(!isTRUE(all.equal(
  +             I(value_inc_random[param_tbl[param_tbl$random, 'switch']]),
  +             param_tbl$value[param_tbl[param_tbl$random, 'switch']])), "value_random: Random parameters have been updated")
  +         param_tbl$value <- value_inc_random
  + 
  +         # NB: ut_tmb_r_compare will be using g3_tmb_par()
  +         gadget3:::ut_tmb_r_compare(model_fn, model_tmb, param_tbl)
  +     } else {
  +         writeLines("# skip: not compiling TMB model")
  +     }
  + }))
  # g3_to_tmb: Can use random parameters without resorting to include_random
  # skip: not compiling TMB model
  > 
  > ok_group("cpp_code", {
  +     ns <- function (s) gsub("\\s+", "", s)
  +     ok(ut_cmp_identical(
  +         ns(gadget3:::cpp_code(quote( 4 + 4 ))),
  +         ns("(double)(4) + (double)(4)")),
  +         "4 + 4: Defaulted to double")
  +     ok(ut_cmp_identical(
  +         ns(gadget3:::cpp_code(quote( (4 + 4) ))),
  +         ns("((double)(4) + (double)(4))")),
  +         "(4 + 4): Defaulted to double")
  +     ok(ut_cmp_identical(
  +         ns(gadget3:::cpp_code(quote( x[[4]] + 4 ))),
  +         ns("x(3) + (double)(4)")),
  +         "x[[4]] + 4: Subtracted one, assumed int")
  +     # NB: We rely on this in g3_param_table(ifmissing_param_table) below
  +     ok(ut_cmp_identical(
  +         ns(gadget3:::cpp_code(quote( x[[(-4 + 1 - 1) / (2*8)]] + 4 ))),
  +         ns("x( (-4 + 1 - 1) / (2*8) - 1 ) + (double)(4)")),
  +         "x[[(-4 + 1 - 1) / (2*8)]] + 4: Assumed int passses through +, -, *, /, ( ")
  + })
  # cpp_code
  ok - 4 + 4: Defaulted to double
  ok - (4 + 4): Defaulted to double
  ok - x[[4]] + 4: Subtracted one, assumed int
  ok - x[[(-4 + 1 - 1) / (2*8)]] + 4: Assumed int passses through +, -, *, /, ( 
  > 
  > 
  > ###############################################################################
  > actions <- list()
  > expecteds <- new.env(parent = emptyenv())
  > expected_warnings_r <- c()
  > expected_warnings_tmb <- c()
  > params <- list(rv=0)
  > 
  > # Check constants can pass through cleanly
  > constants_integer <- 999
  > constants_nan <- 999
  > actions <- c(actions, ~{
  +     comment('constants')
  +     constants_integer <- 5L ; REPORT(constants_integer)
  +     constants_nan <- NaN ; REPORT(constants_nan)
  + })
  > expecteds$constants_integer <- 5L
  > expecteds$constants_nan <- NaN
  > 
  > # Can assign a single value to 1x1 array
  > assign_to_1_1 <- array(dim = c(1,1))
  > actions <- c(actions, ~{
  +     comment('assign_to_1_1')
  +     assign_to_1_1[g3_idx(1)] <- 100.1
  +     REPORT(assign_to_1_1)
  + })
  > expecteds$assign_to_1_1 <- array(c(100.1), dim = c(1,1))
  > 
  > assign_to_2_1 <- array(dim = c(2,1))
  > data_to_2_1 <- c(100.1, 200.2)
  > actions <- c(actions, ~{
  +     comment('assign_to_2_1')
  +     assign_to_2_1[,g3_idx(1)] <- data_to_2_1
  +     REPORT(assign_to_2_1)
  + })
  > expecteds$assign_to_2_1 <- array(c(100.1, 200.2), dim = c(2,1))
  >     
  > assign_to_2_2 <- array(dim = c(2,2))
  > data_to_2_2 <- c(110.1, 220.2)
  > actions <- c(actions, ~{
  +     comment('assign_to_2_2')
  +     assign_to_2_2[,g3_idx(1)] <- data_to_2_1
  +     assign_to_2_2[,g3_idx(2)] <- data_to_2_2
  +     REPORT(assign_to_2_2)
  + })
  > expecteds$assign_to_2_2 <- array(c(100.1, 200.2, 110.1, 220.2), dim = c(2,2))
  > 
  > # Assign single value, horizontally
  > assign_to_2_2a <- array(dim = c(2,2))
  > actions <- c(actions, ~{
  +     comment('assign_to_2_2a')
  +     assign_to_2_2a[[g3_idx(1),g3_idx(2)]] <- 99
  +     assign_to_2_2a[[g3_idx(2),g3_idx(1)]] <- 88
  +     assign_to_2_2a[[g3_idx(2),g3_idx(2)]] <- 0
  +     assign_to_2_2a[[g3_idx(1),g3_idx(1)]] <- 0
  +     REPORT(assign_to_2_2a)
  + })
  > expecteds$assign_to_2_2a <- array(c(0, 88, 99, 0), dim = c(2,2))
  > 
  > # Assign zero and other scalars to column, arrays
  > assign_scalar <- array(dim = c(2,4))
  > params$assign_scalar_const <- runif(1, 100, 200)
  > actions <- c(actions, ~{
  +     comment('assign_scalar')
  +     assign_scalar[] <- 0  # TODO: TMB auto-setZeros, R doesn't
  +     assign_scalar[g3_idx(1),g3_idx(1)] <- 99  # NB: Overwritten
  +     assign_scalar[,g3_idx(1)] <- 0
  +     assign_scalar[,g3_idx(2)] <- 88
  +     assign_scalar[g3_idx(2),g3_idx(3)] <- 27
  +     assign_scalar[,g3_idx(4)] <- g3_param("assign_scalar_const")
  +     REPORT(assign_scalar)
  + })
  > expecteds$assign_scalar <- array(c(
  +     0, 0,
  +     88, 88,
  +     0, 27,
  +     params$assign_scalar_const, params$assign_scalar_const,
  +     NULL), dim = c(2,4))
  > 
  > # Can subset from left and right, using transpose
  > assign_subset <- array(
  +     rep(seq(100, 200, 100), each = 3 * 5) +
  +     rep(seq(10, 30, 10), each = 5, times = 2) +
  +     rep(seq(1, 5, 1), each = 1, times = 2),
  +     dim = c(5, 3, 2))
  > assign_right <- assign_subset[,2,2] ; assign_right[] <- 0
  > assign_leftright <- assign_subset[4,,2] ; assign_leftright[] <- 0
  > actions <- c(actions, ~{
  +     comment('assign_subset')
  +     assign_right <- assign_subset[,g3_idx(2),g3_idx(2)]
  +     REPORT(assign_right)
  +     assign_leftright <- assign_subset[g3_idx(4),,g3_idx(2)]
  +     REPORT(assign_leftright)
  + })
  > expecteds$assign_right <- assign_subset[,2,2]
  > expecteds$assign_leftright <- assign_subset[4,,2]
  > 
  > # Arrays with dynamic dimensions
  > dynamic_dim_array <- array(0, dim = c(2,1))
  > dynamic_dim_array_na <- array(NA, dim = c(2,1))
  > attr(dynamic_dim_array, 'dynamic_dim') <- list(2, quote(dynamic_dim_array_dim_2))
  > attr(dynamic_dim_array_na, 'dynamic_dim') <- list(2, quote(dynamic_dim_array_dim_2))
  > dynamic_dim_array_dim_2 <- 4L
  > dynamic_dim_array_dim_na_2 <- 4L
  > actions <- c(actions, ~{
  +     comment('assign_scalar')
  +     # NB: Under TMB this won't be NA, so set it to hide differences.
  +     dynamic_dim_array_na[] <- 5
  +     REPORT(dynamic_dim_array)
  +     REPORT(dynamic_dim_array_na)
  + })
  > expecteds$dynamic_dim_array <- array(0, dim = c(2, 4))
  > expecteds$dynamic_dim_array_na <- array(5, dim = c(2, 4))
  > 
  > # Data variable names are escaped
  > escaped.data.scalar <- 44
  > escaped.data.array <- c(1,2,3,4,5)
  > escaped_data_output <- 0.0
  > actions <- c(actions, ~{
  +     comment('escaped.data.array')
  +     escaped_data_output <- escaped.data.scalar + sum(escaped.data.array)
  +     REPORT(escaped_data_output)
  + })
  > # NB: In theory we could also report the escaped name, but we can't rename
  > # items in the produced report, so reports will differ TMB/R
  > expecteds$escaped_data_output <- escaped.data.scalar + sum(escaped.data.array)
  > 
  > # is.nan / is.finite
  > is_nan_nan_scalar_input <- NaN
  > is_nan_finite_scalar_input <- 4
  > is_nan_finite_array_input <- as.array(1:4)
  > is_nan_nan_array_input <- as.array(rep(NaN, 5))
  > is_nan_finite_vector_input <- 1:4
  > is_nan_nan_vector_input <- rep(NaN, 5)
  > is_nan_finite_single_array_input <- as.array(1)
  > is_nan_output <- 0L
  > is_finite_output <- 0L
  > actions <- c(actions, ~{
  +     comment('is.nan / is.finite')
  +     is_nan_output <- is_nan_output + (if (is.nan(is_nan_nan_scalar_input)) 1 else 0)
  +     is_nan_output <- is_nan_output + (if (is.nan(is_nan_finite_scalar_input)) 2 else 0)
  +     is_nan_output <- is_nan_output + (if (any(is.nan(is_nan_finite_array_input))) 4 else 0)
  +     is_nan_output <- is_nan_output + (if (any(is.nan(is_nan_nan_array_input))) 8 else 0)
  +     is_nan_output <- is_nan_output + (if (any(is.nan(is_nan_nan_vector_input))) 16 else 0)
  +     is_nan_output <- is_nan_output + (if (any(is.nan(is_nan_finite_single_array_input))) 32 else 0)
  +     REPORT(is_nan_output)
  +     is_finite_output <- is_finite_output + (if (is.finite(is_nan_nan_scalar_input)) 1 else 0)
  +     is_finite_output <- is_finite_output + (if (is.finite(is_nan_finite_scalar_input)) 2 else 0)
  +     is_finite_output <- is_finite_output + (if (any(is.finite(is_nan_finite_array_input))) 4 else 0)
  +     is_finite_output <- is_finite_output + (if (any(is.finite(is_nan_nan_array_input))) 8 else 0)
  +     is_finite_output <- is_finite_output + (if (any(is.finite(is_nan_nan_vector_input))) 16 else 0)
  +     is_finite_output <- is_finite_output + (if (any(is.finite(is_nan_finite_single_array_input))) 32 else 0)
  +     REPORT(is_finite_output)
  + })
  > expecteds$is_nan_output <- 1 + 8 + 16
  > expecteds$is_finite_output <- 2 + 4 + 32
  > 
  > # as.vector() --> .vec()
  > as_vector_array <- array(runif(20), dim=c(10, 2))
  > as_vector_result1 <- rep(NaN, 10)
  > as_vector_result2 <- rep(NaN, 10)
  > as_vector_mean <- 0.5
  > as_vector_sigma <- 1
  > actions <- c(actions, ~{
  +     comment('as_vector')
  +     as_vector_result1 <- pnorm(as.vector(as_vector_array[,g3_idx(1)]), as_vector_mean, as_vector_sigma)
  +     as_vector_result2 <- pnorm(as.vector(as_vector_array[,g3_idx(2)]), as_vector_mean, as_vector_sigma)
  +     REPORT(as_vector_result1)
  +     REPORT(as_vector_result2)
  + })
  > expecteds$as_vector_result1 <- pnorm(as_vector_array[,1], as_vector_mean, as_vector_sigma)
  > expecteds$as_vector_result2 <- pnorm(as_vector_array[,2], as_vector_mean, as_vector_sigma)
  > 
  > # mean() --> .mean()
  > mean_vector <- array(c(1, 2, 88, 99))
  > mean_vector_result <- 0
  > actions <- c(actions, ~{
  +     comment('mean_vector')
  +     mean_vector_result <- mean(mean_vector)
  +     REPORT(mean_vector_result)
  + })
  > expecteds$mean_vector_result <- mean(mean_vector)
  > 
  > # colsums
  > colsums_in <- array(1:6, dim = c(3,2))
  > colsums_result <- c(0L, 0L)
  > actions <- c(actions, ~{
  +     comment('colsums')
  +     colsums_result <- colSums(colsums_in)
  +     REPORT(colsums_result)
  + })
  > expecteds$colsums_result <- colSums(colsums_in)
  > 
  > # rowsums
  > rowsums_in <- array(c(1,2,3,4,5,6), dim = c(3,2))
  > rowsums_result <- c(0, 0, 0)
  > actions <- c(actions, ~{
  +     comment('rowsums')
  +     rowsums_result <- rowSums(rowsums_in)
  +     REPORT(rowsums_result)
  + })
  > expecteds$rowsums_result <- rowSums(rowsums_in)
  > 
  > # if statement without braces
  > if_no_brace_result <- 0.0
  > actions <- c(actions, ~{
  +     comment('if_without_braces')
  +     if (FALSE) if_no_brace_result <- 1 else if_no_brace_result <- 0.2
  +     REPORT(if_no_brace_result)
  + })
  > expecteds$if_no_brace_result <- 0.2
  > 
  > # if expression (not statement) turns into tertiary
  > tertiary_result_0 <- 3
  > tertiary_result_1 <- 6
  > tertiary_result_2 <- 6
  > ok(ut_cmp_error({
  +     g3_to_tmb(list(~{ tertiary_result_0 <- if (tertiary_result_0 == 3) 9  }))
  + }, "tertiary_result_0"), "Complained about missing else for tertiary")
  ok - Complained about missing else for tertiary
  > actions <- c(actions, ~{
  +     comment('tertiary')
  +     tertiary_result_0 <- if (tertiary_result_0 == 3) 9 else 4
  +     tertiary_result_1 <- if (tertiary_result_1 == 3) 9 else 4
  +     tertiary_result_2 <- 100 - if (tertiary_result_0 == -30) 20 else 40
  +     REPORT(tertiary_result_0)
  +     REPORT(tertiary_result_1)
  +     REPORT(tertiary_result_2)
  + })
  > expecteds$tertiary_result_0 <- 9
  > expecteds$tertiary_result_1 <- 4
  > expecteds$tertiary_result_2 <- 100 - 40  # NB: Operator precedence preserved
  > 
  > # g3_with()
  > g3_with_result <- 0L
  > # NB: We don't define g3_with_iterator, it's defined within the block
  > actions <- c(actions, ~{
  +     comment('g3_with')
  +     g3_with(
  +         g3_with_iterator := g3_idx(2L),  # NB: Tests we can use g3 functions in definition
  +         g3_with_other_exp := 1L + 2L + 3L,
  +         {
  +             g3_with_result <- g3_with_iterator - g3_idx(1)  # NB: Reverse g3_idx from definition
  +             REPORT(g3_with_result)
  +             REPORT(g3_with_other_exp)
  +         })
  + })
  > expecteds$g3_with_result <- 1L  # i.e. 2 - 1 in R or 1 - 0 in TMB
  > expecteds$g3_with_other_exp <- 1L + 2L + 3L
  > 
  > # min() & max()
  > min_result <- 0.0
  > max_result <- 0.0
  > actions <- c(actions, ~{
  +     comment('min/max')
  +     min_result <- min(4, 9)
  +     max_result <- max(sum(mean_vector), 2)  # NB: sum gets cast to Type
  +     REPORT(min_result)
  +     REPORT(max_result)
  + })
  > expecteds$min_result <- 4
  > expecteds$max_result <- sum(mean_vector)
  > 
  > # negate single value
  > negate_x <- 10
  > actions <- c(actions, ~{
  +     comment('negate')
  +     negate_x <- -negate_x
  +     REPORT(negate_x)
  + })
  > expecteds$negate_x <- -10
  > 
  > # Modulo assumes integer
  > modulo_x <- 10
  > modulo_y <- 11
  > actions <- c(actions, ~{
  +     comment('modulo')
  +     modulo_x <- as_integer(modulo_x) %% 2
  +     modulo_y <- as_integer(modulo_y) %% 2
  +     REPORT(modulo_x)
  +     REPORT(modulo_y)
  + })
  > expecteds$modulo_x <- 0
  > expecteds$modulo_y <- 1
  > 
  > # sum() & prod()
  > sumprod_input <- runif(10)
  > sumprod_sum <- 0
  > sumprod_prod <- 0
  > actions <- c(actions, ~{
  +     comment('sum/prod')
  +     sumprod_sum <- sum(sumprod_input)
  +     sumprod_prod <- prod(sumprod_input)
  +     REPORT(sumprod_sum)
  +     REPORT(sumprod_prod)
  + })
  > expecteds$sumprod_sum <- sum(sumprod_input)
  > expecteds$sumprod_prod <- prod(sumprod_input)
  > 
  > # g3_param_table()
  > param_table_out <- array(rep(0, 6))
  > actions <- c(actions, ~{
  +     for (pt_a in seq(1, 3, by = 1)) for (pt_b in seq(7, 8, by = 1)) {
  +         param_table_out[[((pt_a - 1L) * 2L) + (pt_b - 7L) + 1L]] <- g3_param_table('param_table', expand.grid(pt_a = 1:2, pt_b = c(8, 7)))
  +     }
  +     REPORT(param_table_out)
  + })
  > params[['param_table.1.8']] <- 18
  > params[['param_table.1.7']] <- 17
  > params[['param_table.2.8']] <- 28
  > params[['param_table.2.7']] <- 27
  > expecteds$param_table_out <- array(c(
  +     17,
  +     18,
  +     27,
  +     28,
  +     NaN,
  +     NaN,
  +     NULL))
  > expected_warnings_r <- c(expected_warnings_r,
  +     "No value found in g3_param_table param_table, ifmissing not specified",
  +     "No value found in g3_param_table param_table, ifmissing not specified",
  +     NULL)
  > expected_warnings_tmb <- c(expected_warnings_tmb,
  +     "No value found in g3_param_table param_table, ifmissing not specified",
  +     "No value found in g3_param_table param_table, ifmissing not specified",
  +     NULL)
  > 
  > # g3_param_table(ifmissing)
  > param_table_ifmissing_out <- array(c(1,2,3,4,5,6))
  > actions <- c(actions, ~{
  +     for (ifmissing in seq(1, 6, by = 1)) {
  +         param_table_ifmissing_out[[ifmissing]] <- g3_param_table(
  +             'param_table_ifmissing',
  +             expand.grid(ifmissing = 2:4), ifmissing = -1)
  +     }
  +     REPORT(param_table_ifmissing_out)
  + })
  > params[['param_table_ifmissing.2']] <- 27
  > params[['param_table_ifmissing.3']] <- 47
  > params[['param_table_ifmissing.4']] <- 22
  > expecteds$param_table_ifmissing_out <- array(c(-1, 27, 47, 22, -1, -1))
  > 
  > # g3_param_table(ifmissing_param)
  > param_table_ifmparam_out <- array(c(1,2,3,4,5,6))
  > actions <- c(actions, ~{
  +     for (ifmparam in seq(1, 6, by = 1)) {
  +         param_table_ifmparam_out[[ifmparam]] <- g3_param_table(
  +             'param_table_ifmparam',
  +             expand.grid(ifmparam = 2:4), ifmissing = g3_param("param_table_ifmparam.missing"))
  +     }
  +     REPORT(param_table_ifmparam_out)
  + })
  > params[['param_table_ifmparam.2']] <- floor(runif(1, 100, 200))
  > params[['param_table_ifmparam.3']] <- floor(runif(1, 100, 200))
  > params[['param_table_ifmparam.4']] <- floor(runif(1, 100, 200))
  > params[['param_table_ifmparam.missing']] <- floor(runif(1, 100, 200))
  > expecteds$param_table_ifmparam_out <- array(c(
  +     params[['param_table_ifmparam.missing']],
  +     params[['param_table_ifmparam.2']],
  +     params[['param_table_ifmparam.3']],
  +     params[['param_table_ifmparam.4']],
  +     params[['param_table_ifmparam.missing']],
  +     params[['param_table_ifmparam.missing']]))
  > 
  > # g3_param_table(ifmissing_param_table)
  > param_table_ifmpartab_out <- array(c(1,2,3,4,5,6,7,8,9))
  > actions <- c(actions, ~{
  +     for (ifmpartab in seq(1, 3, by = 1)) for (ifmpartab_m in seq(1, 3, by = 1)) {
  +         param_table_ifmpartab_out[[((ifmpartab - 1) * 3) + (ifmpartab_m - 1) + 1]] <- g3_param_table(
  +             'param_table_ifmpartab',
  +             expand.grid(ifmpartab = 2:3), ifmissing = g3_param_table(
  +                 "param_table_ifmpartab_m",
  +                 expand.grid(ifmpartab_m = 1:3)))
  +     }
  +     REPORT(param_table_ifmpartab_out)
  + })
  > params[['param_table_ifmpartab.2']] <- floor(runif(1, 100, 200))
  > params[['param_table_ifmpartab.3']] <- floor(runif(1, 100, 200))
  > params[['param_table_ifmpartab_m.1']] <- floor(runif(1, 100, 200))
  > params[['param_table_ifmpartab_m.2']] <- floor(runif(1, 100, 200))
  > params[['param_table_ifmpartab_m.3']] <- floor(runif(1, 100, 200))
  > expecteds$param_table_ifmpartab_out <- array(c(
  +     params[['param_table_ifmpartab_m.1']],
  +     params[['param_table_ifmpartab_m.2']],
  +     params[['param_table_ifmpartab_m.3']],
  + 
  +     params[['param_table_ifmpartab.2']],
  +     params[['param_table_ifmpartab.2']],
  +     params[['param_table_ifmpartab.2']],
  + 
  +     params[['param_table_ifmpartab.3']],
  +     params[['param_table_ifmpartab.3']],
  +     params[['param_table_ifmpartab.3']],
  +     NULL))
  > 
  > ###############################################################################
  > 
  > nll <- 0.0
  > actions <- c(actions, ~{
  +     comment('done')
  +     nll <- nll + g3_param('rv')
  +     return(nll)
  + })
  > 
  > # Compile model
  > model_fn <- g3_to_r(actions, trace = FALSE)
  > # model_fn <- edit(model_fn)
  > if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +     model_cpp <- g3_to_tmb(actions, trace = FALSE)
  +     # model_cpp <- edit(model_cpp)
  +     model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g"))
  + } else {
  +     writeLines("# skip: not compiling TMB model")
  + }
  # skip: not compiling TMB model
  > 
  > # Compare everything we've been told to compare
  > result <- capture_warnings(model_fn(params))
  > # str(attributes(result), vec.len = 10000)
  > for (n in ls(expecteds)) {
  +     ok(ut_cmp_equal(
  +         attr(result$rv, n),
  +         expecteds[[n]], tolerance = 1e-6), n)
  + }
  ok - as_vector_result1
  ok - as_vector_result2
  ok - assign_leftright
  ok - assign_right
  ok - assign_scalar
  ok - assign_to_1_1
  ok - assign_to_2_1
  ok - assign_to_2_2
  ok - assign_to_2_2a
  ok - colsums_result
  ok - constants_integer
  ok - constants_nan
  ok - dynamic_dim_array
  ok - dynamic_dim_array_na
  ok - escaped_data_output
  ok - g3_with_other_exp
  ok - g3_with_result
  ok - if_no_brace_result
  ok - is_finite_output
  ok - is_nan_output
  ok - max_result
  ok - mean_vector_result
  ok - min_result
  ok - modulo_x
  ok - modulo_y
  ok - negate_x
  ok - param_table_ifmissing_out
  ok - param_table_ifmparam_out
  ok - param_table_ifmpartab_out
  ok - param_table_out
  ok - rowsums_result
  ok - sumprod_prod
  ok - sumprod_sum
  ok - tertiary_result_0
  ok - tertiary_result_1
  ok - tertiary_result_2
  > ok(ut_cmp_identical(result$warnings, expected_warnings_r), "Warnings from R as expected")
  ok - Warnings from R as expected
  > if (nzchar(Sys.getenv('G3_TEST_TMB'))) {
  +     param_template <- attr(model_cpp, "parameter_template")
  +     param_template$value <- params[param_template$switch]
  +     generated_warnings <- capture_warnings(gadget3:::ut_tmb_r_compare(model_fn, model_tmb, param_template))$warnings
  +     ok(ut_cmp_identical(generated_warnings, c(expected_warnings_r, expected_warnings_tmb)), "Warnings from R+TMB as expected")
  + }
  > 
  > proc.time()
     user  system elapsed 
     1.70    0.17    1.85