R Under development (unstable) (2025-04-18 r88159 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2025 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.

> if (!interactive()) options(warn=2, error = function() { sink(stderr()) ; traceback(3) ; q(status = 1) })
> library(unittest)
> 
> library(gadget3)
> 
> # ut_cmp_equal, but strip off dimensions first
> ut_cmp_vec <- function(a, b, ...) ut_cmp_equal(as.vector(a), as.vector(b), ...)
> 
> # Generate random array from dimnames input
> gen_arr <- function(...) {
+     dn <- list(...)
+ 
+     if ("time" %in% names(dn)) {
+         dn$time <- paste(
+             rep(dn$time[[1]], each = length(dn$time[[2]])),
+             sprintf("%02d", dn$time[[2]]),
+             sep = "-")
+     }
+     if ("age" %in% names(dn)) {
+         dn$age <- paste0("age", dn$age)
+     }
+     if ("length" %in% names(dn)) {
+         dn$length <- paste(
+             dn$length,
+             c(tail(dn$length, -1), "Inf"),
+             sep = ":" )
+     }
+     if ("predator_length" %in% names(dn)) {
+         dn$predator_length <- paste(
+             dn$predator_length,
+             c(tail(dn$predator_length, -1), "Inf"),
+             sep = ":" )
+     }
+ 
+     d <- vapply(dn, length, integer(1))
+     array(
+         floor(runif(prod(d), 1e5, 1e6)),
+         dim = d,
+         dimnames = dn)
+ }
> 
> ok_group("time_split") ########################################################
# time_split
> 
> ar <- gen_arr(
+     length = c(50, 60, 70),
+     age = 0:10,
+     time = list(2000:2004, 1:2) )
> ok(ut_cmp_vec(
+     g3_array_agg(ar, opt_time_split = TRUE)[,,step = "1", year = "2002"],
+     ar[,,time = "2002-01"],
+     end = NULL ), "opt_time_split returns same values [2002-01]")
ok - opt_time_split returns same values [2002-01]
> ok(ut_cmp_vec(
+     g3_array_agg(ar, opt_time_split = TRUE)[,,step = "2", year = "2004"],
+     ar[,,time = "2004-02"],
+     end = NULL ), "opt_time_split returns same values [2004-02]")
ok - opt_time_split returns same values [2004-02]
> 
> ar <- gen_arr(
+     time = list(2000:2004, 1:4),
+     age = 0:10 )
> ok(ut_cmp_equal(
+     g3_array_agg(ar, opt_time_split = TRUE)[step = "3", year = "2001",],
+     ar[time = "2001-03",],
+     end = NULL ), "opt_time_split returns same values, time at start [2001-03]")
ok - opt_time_split returns same values, time at start [2001-03]
> 
> ar <- gen_arr(
+     time = list(2000:2004, 1:4),
+     age = 0:10 )
> ok(ut_cmp_equal(
+     g3_array_agg(ar, opt_time_split = FALSE),
+     ar,
+     end = NULL ), "Can turn opt_time_split off")
ok - Can turn opt_time_split off
> ok(ut_cmp_equal(
+     names(g3_array_agg(ar, c("year"))),
+     as.character(2000:2004),
+     end = NULL ), "Aggregated by year when asked")
ok - Aggregated by year when asked
> ok(ut_cmp_equal(
+     names(g3_array_agg(ar, c("time"))),
+     paste0(rep(2000:2004, each = 4), c("-01", "-02", "-03", "-04")),
+     end = NULL ), "...or by time")
ok - ...or by time
> 
> ar <- gen_arr(
+     length = c(50, 60, 70),
+     age = 0:10,
+     time = list(2000:2004, 1:2) )
> ok(ut_cmp_vec(
+     g3_array_agg(ar, c("length"), year = 2004),
+     apply(ar[,,time = c("2004-01", "2004-02")], 'length', sum),
+     end = NULL ), "time_split turns on when filtering by year")
ok - time_split turns on when filtering by year
> ok(ut_cmp_vec(
+     g3_array_agg(ar, c("length"), time = c("2001-01", "2002-02")),
+     apply(ar[,,time = c("2001-01", "2002-02")], 'length', sum),
+     end = NULL ), "time_split turns off when filtering by time")
ok - time_split turns off when filtering by time
> 
> ok_group("filtering") #########################################################
# filtering
> 
> ar <- gen_arr(
+     length = c(50, 60, 70),
+     age = 0:10,
+     time = list(2000:2004, 1:2) )
> ok(ut_cmp_vec(
+     # TODO: Having to set margins manually, since otherwise we assume time
+     g3_array_agg(ar, age = 4, year = 2001:2002, step = 2),
+     ar[,age = "age4",time = paste0(2001:2002, "-02")],
+     end = NULL ), "Can use numeric age/year/step, get converted")
ok - Can use numeric age/year/step, get converted
> 
> ok_group("grouping") ##########################################################
# grouping
> 
> ar <- gen_arr(
+     length = c(50, 60, 70),
+     age = 0:10,
+     time = list(2000:2004, 1:2) )
> ok(ut_cmp_vec(
+     g3_array_agg(ar, margins = c("year", "length"), year = 2002:2003),
+     c(
+         apply(ar[,,time = c("2002-01", "2002-02")], "length", sum),
+         apply(ar[,,time = c("2003-01", "2003-02")], "length", sum),
+         NULL ),
+     end = NULL ), "Can filter/aggregate year at the same time")
ok - Can filter/aggregate year at the same time
> 
> ok_group("length") ############################################################
# length
> 
> ar <- gen_arr(
+     length = c(50, 60, 70),
+     age = 0:10 )
> ok(ut_cmp_identical(
+     dimnames(g3_array_agg(ar, opt_length_midlen = TRUE)),
+     list(
+         length = c("55", "65", "75"),
+         age = paste0("age", 0:10) )), "Turning on opt_length_midlen converted dimnames to midlength")
ok - Turning on opt_length_midlen converted dimnames to midlength
> 
> ar <- gen_arr(
+     length = seq(10, 100, 10) )
> ok(ut_cmp_vec(
+     g3_array_agg(ar, length = c(50, 75, 200)),
+     ar[length = c("50:60", "70:80", "100:Inf"), drop = F],
+     end = NULL), "Can select lengthgroups by using any value within the grouping")
ok - Can select lengthgroups by using any value within the grouping
> 
> ar <- gen_arr(
+     length = c(50, 60, 70),
+     age = 0:10 )
> ok(ut_cmp_vec(
+     g3_array_agg(ar, length = 65, opt_length_midlen = TRUE),
+     ar[length = "60:70",],
+     end = NULL), "opt_length_midlen doesn't prevent being able to select by single integers")
ok - opt_length_midlen doesn't prevent being able to select by single integers
> 
> ar <- gen_arr( length = c(0) )
> ok(ut_cmp_identical(
+     dimnames(g3_array_agg(ar, opt_length_midlen = TRUE)),
+     list(
+         length = NA_character_ )), "opt_length_midlen turns 0:Inf to NA")
ok - opt_length_midlen turns 0:Inf to NA
> 
> ar <- gen_arr( predator_length = c(0) )
> ok(ut_cmp_identical(
+     dimnames(g3_array_agg(ar, opt_length_midlen = TRUE)),
+     list(
+         predator_length = NA_character_ )), "opt_length_midlen turns predator_length 0:Inf to NA")
ok - opt_length_midlen turns predator_length 0:Inf to NA
> 
> ar1 <- gen_arr(
+     age = 5:15,
+     time = list(2000:2004, 1:2) )
> ar2 <- gen_arr(
+     age = 10:20,
+     time = list(2000:2004, 1:2) )
> ok(ut_cmp_equal(
+     g3_array_combine(list(ar1, ar2)),
+     g3_array_combine(list(ar2, ar1)) ), "g3_array_combine: Order irrelevant")
ok - g3_array_combine: Order irrelevant
> for (t in seq_along(dimnames(ar1)$time)) ok(ut_cmp_equal(g3_array_combine(list(ar1, ar2))[,t], c(
+     age5 = ar1["age5", t] + 0,
+     age6 = ar1["age6", t] + 0,
+     age7 = ar1["age7", t] + 0,
+     age8 = ar1["age8", t] + 0,
+     age9 = ar1["age9", t] + 0,
+     age10 = ar1["age10", t] + ar2["age10", t],
+     age11 = ar1["age11", t] + ar2["age11", t],
+     age12 = ar1["age12", t] + ar2["age12", t],
+     age13 = ar1["age13", t] + ar2["age13", t],
+     age14 = ar1["age14", t] + ar2["age14", t],
+     age15 = ar1["age15", t] + ar2["age15", t],
+     age16 = 0 + ar2["age16", t],
+     age17 = 0 + ar2["age17", t],
+     age18 = 0 + ar2["age18", t],
+     age19 = 0 + ar2["age19", t],
+     age20 = 0 + ar2["age20", t] )), paste0("g3_array_combine: time ", t, " combined as expected"))
ok - g3_array_combine: time 1 combined as expected
ok - g3_array_combine: time 2 combined as expected
ok - g3_array_combine: time 3 combined as expected
ok - g3_array_combine: time 4 combined as expected
ok - g3_array_combine: time 5 combined as expected
ok - g3_array_combine: time 6 combined as expected
ok - g3_array_combine: time 7 combined as expected
ok - g3_array_combine: time 8 combined as expected
ok - g3_array_combine: time 9 combined as expected
ok - g3_array_combine: time 10 combined as expected
> 
> wtm <- function(ar, meas, ...) {
+     x <- g3_array_agg(ar, meas, ..., opt_length_midlen = TRUE)
+     x <- rep(as.numeric(names(x)), x)  # Unfold into a list of counts
+     mean(x)
+ }
> wtsd <- function(ar, meas, ...) {
+     x <- g3_array_agg(ar, meas, ..., opt_length_midlen = TRUE)
+     x <- rep(as.numeric(names(x)), x)  # Unfold into a list of counts
+     sd(x)
+ }
> ar <- gen_arr(
+     length = c(50, 60, 70),
+     age = 1:10,
+     area = 1:3 )
> for (i in 1:10) ok(ut_cmp_equal(
+     as.vector(g3_array_agg(ar, c("age"), agg = "length_mean")[i]),
+     as.vector(wtm(ar, "length", age = i))), paste0("length_mean: age ", i))
ok - length_mean: age 1
ok - length_mean: age 2
ok - length_mean: age 3
ok - length_mean: age 4
ok - length_mean: age 5
ok - length_mean: age 6
ok - length_mean: age 7
ok - length_mean: age 8
ok - length_mean: age 9
ok - length_mean: age 10
> for (i in 1:10) for (j in 1:3) ok(ut_cmp_equal(
+     as.vector(g3_array_agg(ar, c("age", "area"), agg = "length_mean")[age = i, area = j]),
+     as.vector(wtm(ar, "length", age = i, area = j))), paste0("length_mean: age ", i, ", area ", j))
ok - length_mean: age 1, area 1
ok - length_mean: age 1, area 2
ok - length_mean: age 1, area 3
ok - length_mean: age 2, area 1
ok - length_mean: age 2, area 2
ok - length_mean: age 2, area 3
ok - length_mean: age 3, area 1
ok - length_mean: age 3, area 2
ok - length_mean: age 3, area 3
ok - length_mean: age 4, area 1
ok - length_mean: age 4, area 2
ok - length_mean: age 4, area 3
ok - length_mean: age 5, area 1
ok - length_mean: age 5, area 2
ok - length_mean: age 5, area 3
ok - length_mean: age 6, area 1
ok - length_mean: age 6, area 2
ok - length_mean: age 6, area 3
ok - length_mean: age 7, area 1
ok - length_mean: age 7, area 2
ok - length_mean: age 7, area 3
ok - length_mean: age 8, area 1
ok - length_mean: age 8, area 2
ok - length_mean: age 8, area 3
ok - length_mean: age 9, area 1
ok - length_mean: age 9, area 2
ok - length_mean: age 9, area 3
ok - length_mean: age 10, area 1
ok - length_mean: age 10, area 2
ok - length_mean: age 10, area 3
> for (i in 1:10) ok(ut_cmp_equal(
+     as.vector(g3_array_agg(ar, c("age"), agg = "length_sd")[i]),
+     as.vector(wtsd(ar, "length", age = i))), paste0("length_sd: age ", i))
ok - length_sd: age 1
ok - length_sd: age 2
ok - length_sd: age 3
ok - length_sd: age 4
ok - length_sd: age 5
ok - length_sd: age 6
ok - length_sd: age 7
ok - length_sd: age 8
ok - length_sd: age 9
ok - length_sd: age 10
> for (i in 1:10) for (j in 1:3) ok(ut_cmp_equal(
+     as.vector(g3_array_agg(ar, c("age", "area"), agg = "length_sd")[age = i, area = j]),
+     as.vector(wtsd(ar, "length", age = i, area = j))), paste0("length_sd: age ", i, ", area ", j))
ok - length_sd: age 1, area 1
ok - length_sd: age 1, area 2
ok - length_sd: age 1, area 3
ok - length_sd: age 2, area 1
ok - length_sd: age 2, area 2
ok - length_sd: age 2, area 3
ok - length_sd: age 3, area 1
ok - length_sd: age 3, area 2
ok - length_sd: age 3, area 3
ok - length_sd: age 4, area 1
ok - length_sd: age 4, area 2
ok - length_sd: age 4, area 3
ok - length_sd: age 5, area 1
ok - length_sd: age 5, area 2
ok - length_sd: age 5, area 3
ok - length_sd: age 6, area 1
ok - length_sd: age 6, area 2
ok - length_sd: age 6, area 3
ok - length_sd: age 7, area 1
ok - length_sd: age 7, area 2
ok - length_sd: age 7, area 3
ok - length_sd: age 8, area 1
ok - length_sd: age 8, area 2
ok - length_sd: age 8, area 3
ok - length_sd: age 9, area 1
ok - length_sd: age 9, area 2
ok - length_sd: age 9, area 3
ok - length_sd: age 10, area 1
ok - length_sd: age 10, area 2
ok - length_sd: age 10, area 3
> 
> ar <- gen_arr(
+     length = c(50, 60, 70),
+     predator_length = c(100, 200),
+     area = 1:3 )
> for (i in 1:3) ok(ut_cmp_equal(
+     as.vector( g3_array_agg(ar, c("area"), agg ="predator_length_mean")[i] ),
+     as.vector( wtm(ar, "predator_length", area = i) )), paste0("predator_length_mean: area ", i))
ok - predator_length_mean: area 1
ok - predator_length_mean: area 2
ok - predator_length_mean: area 3
> 
> proc.time()
   user  system elapsed 
   2.14    1.18    3.31 
1..109
# Looks like you passed all 109 tests.