tests/test-stock_time.R

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

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")
})

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")
})

ok(ut_cmp_identical(
    g3s_time_convert(c("1999-01", "1999-02")),
    c(199901L, 199902L)), "Parsed year/step string")

ok(ut_cmp_identical(
    g3s_time_convert(c(1999, 1999)),
    c(199900L, 199900L)), "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")

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")
}

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)
    }
})

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)
    }
})

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)
    }
})