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)
> 
> params <- list()
> actions <- list()
> expecteds <- new.env(parent = emptyenv())
> 
> # matrix_vec
> matrix_vec_tf <- matrix(c(0,1,0,1,0,0,0,0,1), nrow = 3)
> matrix_vec_vec <- c(10, 100, 1000)
> matrix_vec_out <- rep(0, 5)
> actions <- c(actions, ~{
+     comment('matrix_vec')
+     matrix_vec_out <- g3_matrix_vec(matrix_vec_tf, matrix_vec_vec)
+     REPORT(matrix_vec_out)
+ })
> expecteds$matrix_vec_out <- c(100, 10, 1000)
> 
> # logspace_add()
> logspace_add_1 <- 0.0
> logspace_add_0 <- 0.0
> logspace_inp_1 <- 1.0
> logspace_inp_0 <- 0.0
> actions <- c(actions, ~{
+     comment('logspace_add')
+     # NB: We have to cast "0" to a Type for the below to work, but this happens automatically
+     logspace_add_1 <- logspace_add(logspace_inp_1, 0)
+     logspace_add_0 <- logspace_add(logspace_inp_0, logspace_inp_0)
+     REPORT(logspace_add_1)
+     REPORT(logspace_add_0)
+ })
> expecteds$logspace_add_1 <- 1.313262
> expecteds$logspace_add_0 <- 0.6931472
> 
> # logspace_add_vec()
> logspace_add_vec_inp <- c(0,0.1,0.2,0.3)
> logspace_add_vec_0 <- c(0,0,0,0)
> logspace_add_vec_1 <- c(0,0,0,0)
> actions <- c(actions, ~{
+     comment('logspace_add_vec')
+     logspace_add_vec_0 <- logspace_add_vec(logspace_add_vec_inp, 0)
+     logspace_add_vec_1 <- logspace_add_vec(logspace_add_vec_inp, 1)
+     REPORT(logspace_add_vec_0)
+     REPORT(logspace_add_vec_1)
+ })
> expecteds$logspace_add_vec_0 <- c(0.6931472, 0.7443967, 0.7981389, 0.8543552)
> expecteds$logspace_add_vec_1 <- c(1.313262, 1.341154, 1.371101, 1.403186)
> 
> # ratio_add_vec()
> ratio_add_vec_inp_orig_vec <- runif(10) * 100
> ratio_add_vec_inp_orig_amount <- floor(runif(10) * 10)
> ratio_add_vec_inp_new_vec <- runif(10) * 100
> ratio_add_vec_inp_new_amount <- floor(runif(10) * 10)
> ratio_add_vec_output <- rep(0, 10)
> actions <- c(actions, ~{
+     comment('ratio_add_vec')
+     ratio_add_vec_output <- ratio_add_vec(
+         ratio_add_vec_inp_orig_vec, ratio_add_vec_inp_orig_amount,
+         ratio_add_vec_inp_new_vec, ratio_add_vec_inp_new_amount)
+     REPORT(ratio_add_vec_output)
+ })
> ratio_add_vec_total <- ratio_add_vec_inp_orig_amount + ratio_add_vec_inp_new_amount
> expecteds$ratio_add_vec_output <- ratio_add_vec_inp_orig_vec * (ratio_add_vec_inp_orig_amount / g3_env$avoid_zero_vec(ratio_add_vec_total)) +
+     ratio_add_vec_inp_new_vec * (ratio_add_vec_inp_new_amount / g3_env$avoid_zero_vec(ratio_add_vec_total))
> 
> ###############################################################################
> 
> nll <- 0.0
> actions <- c(actions, ~{
+     comment('done')
+     nll <- nll + g3_param('rv')
+     return(nll)
+ })
> params <- list(rv=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, 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 <- model_fn(params)
> # str(attributes(result), vec.len = 10000)
> for (n in ls(expecteds)) {
+     ok(ut_cmp_equal(
+         attr(result, n),
+         expecteds[[n]], tolerance = 1e-6), n)
+ }
ok - logspace_add_0
ok - logspace_add_1
ok - logspace_add_vec_0
ok - logspace_add_vec_1
ok - matrix_vec_out
ok - ratio_add_vec_output
> 
> 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)
+ }
> 
> proc.time()
   user  system elapsed 
   0.34    0.07    0.40 
# Looks like you passed all 6 tests.