R Under development (unstable) (2024-03-18 r86148 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) > > ok_group("g3s_time: Times produced in order", { + inst <- g3_stock('terry', c(1)) %>% g3s_time( + year = 2002:2004, + step = 1:2) + ok(ut_cmp_identical( + inst$dimnames$time, + c("2002-01", "2002-02", "2003-01", "2003-02", "2004-01", "2004-02")), "dimnames$time ordered year then step") + ok(ut_cmp_identical( + rlang:::f_rhs( g3_stock_def(inst, 'max_time_idx') ), + quote( g3_idx(6L) )), "stock__max_time_idx: Length of array") + }) # g3s_time: Times produced in order ok - dimnames$time ordered year then step ok - stock__max_time_idx: Length of array > > ok_group("g3s_time_convert: correct conversions", { + inst <- c(g3s_time_convert(2000, NULL), g3s_time_convert(2000, 1), g3s_time_convert(2000, 12), + g3s_time_convert(200, NULL), g3s_time_convert(200, 1), g3s_time_convert(200, 12), + g3s_time_convert(20, NULL), g3s_time_convert(20, 1), g3s_time_convert(20, 12), + g3s_time_convert(2, NULL), g3s_time_convert(2, 1), g3s_time_convert(2, 12)) + ok(ut_cmp_identical(inst, as.integer(c(200000,200001,200012, + 20000,20001,20012, + 2000,2001,2012, + 200,201,212))), "Pseudoyear and year conversions correct") + }) # g3s_time_convert: correct conversions ok - Pseudoyear and year conversions correct > > ok(ut_cmp_identical( + g3s_time_convert(c("1999-01", "1999-02")), + c(199901L, 199902L)), "Parsed year/step string") ok - Parsed year/step string > > ok(ut_cmp_identical( + g3s_time_convert(c(1999, 1999)), + c(199900L, 199900L)), "Step ignored if NULL") ok - Step ignored if NULL > ok(ut_cmp_identical( + g3s_time_convert(c(1999, 1999), c('all', 'all')), + c(199900L, 199900L)), "Treated MFDB 'all' as NULL") ok - Treated MFDB 'all' as NULL > > stock_timeyear <- g3_stock('stock_timeyear', 1) %>% g3s_time(year = c(2002, 2004)) > stock_timeyear__num <- g3_stock_instance(stock_timeyear, 0) > stock_timestep <- g3_stock('stock_timestep', 1) %>% g3s_time(times = c( g3s_time_convert(c(2000, 2003),c(1,2)) )) > stock_timestep__num <- g3_stock_instance(stock_timestep, 0) > # NB: There isn't 12 steps to use, but still changes mode > stock_timebigstep <- g3_stock('stock_timebigstep', 1) %>% g3s_time(times = c( g3s_time_convert(c(2001, 2003),c(1,12)) )) > stock_timebigstep__num <- g3_stock_instance(stock_timebigstep, 0) > > stock_modeltime <- g3_stock('stock_modeltime', 1) %>% gadget3:::g3s_modeltime() > stock_modeltime__num <- g3_stock_instance(stock_modeltime, 0) > stock_modelyear <- g3_stock('stock_modelyear', 1) %>% gadget3:::g3s_modeltime(by_year = TRUE) > stock_modelyear__num <- g3_stock_instance(stock_modelyear, 0) > stock_modeltime_iterator <- 100 > > actions <- list( + g3a_time( + 2000, 2004, + step_lengths = c(6,6), + final_year_steps = ~g3_param('final_year_steps', value = 2), + project_years = ~g3_param('projectyears', value = 0)), + list( + "500:stock_time" = gadget3:::g3_step(~{ + stock_iterate(stock_timeyear, stock_ss(stock_timeyear__num) <- stock_ss(stock_timeyear__num) + stock_modeltime_iterator) + stock_iterate(stock_timestep, stock_ss(stock_timestep__num) <- stock_ss(stock_timestep__num) + stock_modeltime_iterator) + stock_iterate(stock_timebigstep, stock_ss(stock_timebigstep__num) <- stock_ss(stock_timebigstep__num) + stock_modeltime_iterator) + }), + "500:stock_modeltime" = gadget3:::g3_step(~{ + stock_iterate(stock_modeltime, stock_ss(stock_modeltime__num) <- stock_ss(stock_modeltime__num) + stock_modeltime_iterator) + stock_iterate(stock_modelyear, stock_ss(stock_modelyear__num) <- stock_ss(stock_modelyear__num) + stock_modeltime_iterator) + }), + "999" = ~{ + stock_modeltime_iterator <- stock_modeltime_iterator + 1 + nll <- g3_param('nll', value = 1) + REPORT(stock_timeyear__num) + REPORT(stock_timestep__num) + REPORT(stock_timebigstep__num) + REPORT(stock_modeltime__num) + REPORT(stock_modelyear__num) + REPORT(stock_modeltime__num) + })) > > # 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("g3s_modeltime", { + params <- attr(model_fn, 'parameter_template') + result <- model_fn(params) + r <- attributes(result) + # str(as.list(r), vec.len = 10000) + + ok(ut_cmp_identical( + r$stock_timeyear__num, + structure( + c(104 + 105, 108 + 109), + .Dim = structure(1:2, .Names = c("length", "time")), + .Dimnames = list(length = "1:Inf", time = c("2002", "2004")))), "stock_timeyear__num: 2002, 2004") + ok(ut_cmp_identical( + r$stock_timestep__num, + structure( + c(100, 107), + .Dim = structure(1:2, .Names = c("length", "time")), + .Dimnames = list(length = "1:Inf", time = c("2000-01", "2003-02")))), "stock_timestep__num: 2000-01, 2003-02") + ok(ut_cmp_identical( + r$stock_timebigstep__num, + structure( + c(102, 0), + .Dim = structure(1:2, .Names = c("length", "time")), + .Dimnames = list(length = "1:Inf", time = c("2001-01", "2003-12")))), "stock_timebigstep__num: 2001-01") + ok(ut_cmp_identical( + r$stock_modeltime__num, + structure( + c(100, 101, 102, 103, 104, 105, 106, 107, 108, 109), + .Dim = c(length = 1L, time = 10L), + .Dimnames = list( + length = "1:Inf", + time = c("2000-01", "2000-02", "2001-01", "2001-02", "2002-01", "2002-02", "2003-01", + "2003-02", "2004-01", "2004-02")))), "stock_modeltime__num: One of each iterator") + + ok(ut_cmp_identical( + r$stock_modelyear__num, + structure( + c(201, 205, 209, 213, 217), + .Dim = c(length = 1L, year = 5L), + .Dimnames = list(length = "1:Inf", year = c("2000", "2001", "2002", "2003", "2004")))), "stock_modelyear__num: Aggregated by year") + + if (nzchar(Sys.getenv('G3_TEST_TMB'))) { + model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g")) + gadget3:::ut_tmb_r_compare(model_fn, model_tmb, params, model_cpp = model_cpp) + } + }) # g3s_modeltime ok - stock_timeyear__num: 2002, 2004 ok - stock_timestep__num: 2000-01, 2003-02 ok - stock_timebigstep__num: 2001-01 ok - stock_modeltime__num: One of each iterator ok - stock_modelyear__num: Aggregated by year > > ok_group("g3s_modeltime:project", { + params <- attr(model_fn, 'parameter_template') + params$projectyears <- 2 + params$nll <- 1.0 + + result <- model_fn(params) + r <- attributes(result) + # str(as.list(r), vec.len = 10000) + + ok(ut_cmp_identical( + r$stock_modeltime__num, + structure( + c(100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113), + .Dim = c(length = 1L, time = 14L), + .Dimnames = list( + length = "1:Inf", + time = c("2000-01", "2000-02", "2001-01", "2001-02", "2002-01", "2002-02", "2003-01", + "2003-02", "2004-01", "2004-02", "2005-01", "2005-02", "2006-01", "2006-02")))), "stock_modeltime__num: One of each iterator") + + ok(ut_cmp_identical( + r$stock_modelyear__num, + structure( + c(201, 205, 209, 213, 217, 221, 225), + .Dim = c(length = 1L, year = 7L), + .Dimnames = list(length = "1:Inf", year = c("2000", "2001", "2002", "2003", "2004", "2005", "2006")))), "stock_modelyear__num: Aggregated by year") + + if (nzchar(Sys.getenv('G3_TEST_TMB'))) { + model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g")) + gadget3:::ut_tmb_r_compare(model_fn, model_tmb, params, model_cpp = model_cpp) + } + }) # g3s_modeltime:project ok - stock_modeltime__num: One of each iterator ok - stock_modelyear__num: Aggregated by year > > ok_group("g3s_modeltime:final_year_steps", { + params <- attr(model_fn, 'parameter_template') + params$final_year_steps <- 1 + + result <- model_fn(params) + r <- attributes(result) + # str(as.list(r), vec.len = 10000) + + ok(ut_cmp_identical( + r$stock_timeyear__num, + structure( + c(104 + 105, 108), + .Dim = structure(1:2, .Names = c("length", "time")), + .Dimnames = list(length = "1:Inf", time = c("2002", "2004")))), "stock_timeyear__num: 2002, 2004-01") + ok(ut_cmp_identical( + r$stock_timestep__num, + structure( + c(100, 107), + .Dim = structure(1:2, .Names = c("length", "time")), + .Dimnames = list(length = "1:Inf", time = c("2000-01", "2003-02")))), "stock_timestep__num: 2000-01, 2003-02") + ok(ut_cmp_identical( + r$stock_timebigstep__num, + structure( + c(102, 0), + .Dim = structure(1:2, .Names = c("length", "time")), + .Dimnames = list(length = "1:Inf", time = c("2001-01", "2003-12")))), "stock_timebigstep__num: 2001-01") + ok(ut_cmp_identical( + r$stock_modeltime__num, + structure( + c(100, 101, 102, 103, 104, 105, 106, 107, 108), + .Dim = c(length = 1L, time = 9L), + .Dimnames = list( + length = "1:Inf", + time = c("2000-01", "2000-02", "2001-01", "2001-02", "2002-01", "2002-02", "2003-01", + "2003-02", "2004-01")))), "stock_modeltime__num: One of each iterator, 2004 a short year") + + ok(ut_cmp_identical( + r$stock_modelyear__num, + structure( + c(201, 205, 209, 213, 108), + .Dim = c(length = 1L, year = 5L), + .Dimnames = list(length = "1:Inf", year = c("2000", "2001", "2002", "2003", "2004")))), "stock_modelyear__num: Aggregated by year (2004 short)") + + if (nzchar(Sys.getenv('G3_TEST_TMB'))) { + model_tmb <- g3_tmb_adfun(model_cpp, params, compile_flags = c("-O0", "-g")) + gadget3:::ut_tmb_r_compare(model_fn, model_tmb, params, model_cpp = model_cpp) + } + }) # g3s_modeltime:final_year_steps ok - stock_timeyear__num: 2002, 2004-01 ok - stock_timestep__num: 2000-01, 2003-02 ok - stock_timebigstep__num: 2001-01 ok - stock_modeltime__num: One of each iterator, 2004 a short year ok - stock_modelyear__num: Aggregated by year (2004 short) > > proc.time() user system elapsed 0.50 0.01 0.50 # Looks like you passed all 18 tests.