R Under development (unstable) (2024-07-02 r86866 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(magrittr)
> library(unittest)
> 
> library(gadget3)
> 
> stock_young <- g3_stock('stock_young', c(10)) %>% g3s_age(1, 3)
> stock_old <- g3_stock('stock_old', c(10)) %>% g3s_age(4, 6)
> stock_inbetween <- g3_stock('stock_inbetween', c(10)) %>% g3s_age(2, 5)
> stock_aggregated <- g3_stock('stock_aggregated', c(10)) %>% g3s_agegroup(list(1:2, 5:6))  # NB: Gap in range
> stock_inbetween_old_aggregated <- g3_stock('stock_inbetween_old_aggregated', c(10)) %>% g3s_agegroup(list(1:2, 5:6))  # NB: Gap in range
> 
> stock_sum_young_inbetween <- 0.0
> stock_sum_inbetween_old <- 0.0
> stock_sum_young_old <- 0.0
> stock_interact_young_old <- 0.0
> stock_interact_young_old_vars <- 0.0
> nll <- 0.0
> actions <- list(
+     g3a_initialconditions(stock_young, ~age * 100 + stock_young__minlen, ~0),
+     g3a_initialconditions(stock_old, ~age * 1000 + stock_old__minlen, ~0),
+     g3a_initialconditions(stock_inbetween, ~age * 10000 + stock_inbetween__minlen, ~0),
+     g3a_initialconditions(stock_aggregated, ~age * 1000000 + stock_inbetween__minlen, ~0),
+     g3a_initialconditions(stock_inbetween_old_aggregated, ~0 * stock_inbetween__minlen, ~0),
+     list(
+         '5' = gadget3:::g3_step(~{
+             comment("stock_sum_young_inbetween")
+             stock_iterate(stock_young, stock_intersect(stock_inbetween, {
+                 stock_sum_young_inbetween <- stock_sum_young_inbetween + sum(stock_ss(stock_young__num)) + sum(stock_ss(stock_inbetween__num))
+             }))
+             REPORT(stock_sum_young_inbetween)
+ 
+             comment("stock_sum_inbetween_old")
+             stock_iterate(stock_inbetween, stock_intersect(stock_old, {
+                 stock_sum_inbetween_old <- stock_sum_inbetween_old + sum(stock_ss(stock_inbetween__num)) + sum(stock_ss(stock_old__num))
+             }))
+             REPORT(stock_sum_inbetween_old)
+ 
+             comment("stock_sum_young_old")
+             stock_iterate(stock_young, stock_intersect(stock_old, {
+                 stock_sum_young_old <- stock_sum_young_old + sum(stock_ss(stock_young__num)) + sum(stock_ss(stock_old__num))
+             }))
+             REPORT(stock_sum_young_old)
+ 
+             comment("stock_interact_young_old")
+             stock_iterate(stock_young, stock_interact(stock_old, {
+                 stock_interact_young_old <- stock_interact_young_old + sum(stock_ss(stock_young__num)) + sum(stock_ss(stock_old__num))
+                 stock_interact_young_old_vars <- stock_interact_young_old_vars + age * 100000 + sub_age
+             }, prefix = 'sub'))
+             REPORT(stock_interact_young_old)
+             REPORT(stock_interact_young_old_vars)
+ 
+             comment("stock_inbetween_old_aggregated__num")
+             stock_iterate(stock_inbetween, stock_intersect(stock_inbetween_old_aggregated, {
+                 stock_ss(stock_inbetween_old_aggregated__num) <-
+                     stock_ss(stock_inbetween_old_aggregated__num) + stock_ss(stock_inbetween__num)
+             }))
+             stock_iterate(stock_old, stock_intersect(stock_inbetween_old_aggregated, {
+                 stock_ss(stock_inbetween_old_aggregated__num) <-
+                     stock_ss(stock_inbetween_old_aggregated__num) + stock_ss(stock_old__num)
+             }))
+             REPORT(stock_inbetween_old_aggregated__num)
+         }),
+         '999' = ~{
+             REPORT(stock_young__num)
+             REPORT(stock_old__num)
+             REPORT(stock_inbetween__num)
+             REPORT(stock_aggregated__num)
+             nll <- nll + g3_param('x', value = 1.0)
+             return(nll)
+         }))
> model_fn <- g3_to_r(actions)
> # model_fn <- edit(model_fn)
> params <- attr(model_fn, 'parameter_template')
> result <- model_fn(params)
> r <- attributes(result)
> 
> # We iterated over the stock and populated using the area variable
> ok(ut_cmp_identical(
+     r$stock_young__num,
+     array(
+         c(110, 210, 310),
+         dim = c(length = 1, age = 3),
+         dimnames = list(length = "10:Inf", age = c("age1","age2","age3")))), "stock_young__num populated")
ok - stock_young__num populated
> ok(ut_cmp_identical(
+     r$stock_old__num,
+     array(
+         c(4010, 5010, 6010),
+         dim = c(length = 1, age = 3),
+         dimnames = list(length = "10:Inf", age = c("age4","age5","age6")))), "stock_old__num populated")
ok - stock_old__num populated
> ok(ut_cmp_identical(
+     r$stock_inbetween__num,
+     array(
+         c(20010, 30010, 40010, 50010),
+         dim = c(length = 1, age = 4),
+         dimnames = list(length = "10:Inf", age = c("age2","age3","age4","age5")))), "stock_inbetween__num populated")
ok - stock_inbetween__num populated
> ok(ut_cmp_identical(
+     r$stock_aggregated__num,
+     array(
+         c(1000010, 5000010),
+         dim = c(length = 1, age = 2),
+         dimnames = list(length = "10:Inf", age = c("1:2","5:6")))), "stock_aggregated__num populated")
ok - stock_aggregated__num populated
> 
> ok(ut_cmp_identical(
+     r$stock_inbetween_old_aggregated__num,
+     array(
+         c(20010, 50010 + 5010 + 6010),
+         dim = c(length = 1, age = 2),
+         dimnames = list(length = "10:Inf", age = c("1:2","5:6")))), "stock_inbetween_old_aggregated__num populated")
ok - stock_inbetween_old_aggregated__num populated
> 
> # Intersection works with any combination of single-area stock and multi-area stock
> ok(ut_cmp_identical(
+     r$stock_sum_young_inbetween,
+     210 + 310 + 20010 + 30010), "stock_sum_young_inbetween: Ages 2+3")
ok - stock_sum_young_inbetween: Ages 2+3
> ok(ut_cmp_identical(
+     r$stock_sum_inbetween_old,
+     4010 + 5010 + 40010 + 50010), "stock_sum_inbetween_old: Ages 4+5")
ok - stock_sum_inbetween_old: Ages 4+5
> ok(ut_cmp_identical(
+     r$stock_sum_young_old,
+     0), "stock_sum_young_old: No intersection")
ok - stock_sum_young_old: No intersection
> 
> # Interact results in a combinatorial explosion
> ok(ut_cmp_identical(
+     r$stock_interact_young_old,
+     sum(expand.grid(r$stock_young__num, r$stock_old__num))), "stock_interact_young_old: Combinatorial explosion of 2 stocks")
ok - stock_interact_young_old: Combinatorial explosion of 2 stocks
> ok(ut_cmp_identical(
+     r$stock_interact_young_old_vars,
+     sum(1:3) * length(4:6) * 100000 + sum(4:6) * length(1:3)), "stock_interact_young_old_vars: Sum of each age combination")
ok - stock_interact_young_old_vars: Sum of each age combination
> 
> 
> 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"))
+     model_tmb_report <- model_tmb$report()
+ 
+     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("g3s_age is idempotent", {
+     ok(ut_cmp_identical(
+         g3_stock_instance(g3_stock("x", c(1,10)) %>% g3s_age(1, 10) %>% g3s_livesonareas(1)),
+         g3_stock_instance(g3_stock("x", c(1,10)) %>% g3s_age(2, 5) %>% g3s_livesonareas(1) %>% g3s_age(1, 10))), "Replacing age results in identical instance")
+ })
# g3s_age is idempotent
ok - Replacing age results in identical instance
> 
> proc.time()
   user  system elapsed 
   0.51    0.09    0.59 
# Looks like you passed all 11 tests.