test-use-cases.R

                   dim = c(d = 4, a = 10, c = 3)),
         b = array(sapply(c(10, 20, 30), function(x) {
                     1:10 + x
                   }),
                   dim = c(a = 10, c = 3)),
         c = array(sapply(c(10, 20, 30), function(x) {
                     sapply(1:10, function(y) {
                       rep(rep(y, 4) + x - 1, 30)
                     })
                   }),
                   dim = c(b = 4, e = 5, f = 6, a = 10, c = 3)))
  )
###second in first dim as target
  # unnamed input dim
  # unnamed output
  # unnamed output dim
  f <- function(x, y) {
    list(array(rev(y)),
         mean(x) + mean(y),
         array(rep(x + y - 1, 30), dim = c(3, 5, 6)))
  }
  expect_equal(
    Apply(list(array(1:10, dim = c(10, 4)), 
               array(1:3 * 10, dim = c(3))),
          list(NULL, 1), f),
    list(output1 = array(rep(sapply(1:10, 
                               function(x) {
                                 c(30, 20, 10)
                               }), 4),
                         dim = c(3, 10, 4)),
         output2 = array(rep(sapply(1:10, 
                               function(x) {
                                 20 + x
                               }), 4),
                         dim = c(10, 4)),
         output3 = array(rep(sapply(1:10, 
                               function(x) {
                                 rep(c(10, 20, 30) + x - 1, 30)
                               }), 4),
                         dim = c(3, 5, 6, 10, 4)))
  )
  # named input dim
  # named output
  # named output dim
  f <- function(x, y) {
    list(a = array(rev(y), dim = c(d = 3)),
         b = mean(x) + mean(y),
         c = array(rep(x + y - 1, 30), dim = c(c = 3, e = 5, f = 6)))
  }
  expect_equal(
    Apply(list(array(1:10, dim = c(a = 10, b = 4)), 
               array(1:3 * 10, dim = c(c = 3))),
          list(NULL, 'c'), f),
    list(a = array(rep(sapply(1:10, 
                         function(x) {
                           c(30, 20, 10)
                         }), 4),
                   dim = c(d = 3, a = 10, b = 4)),
         b = array(rep(sapply(1:10, 
                         function(x) {
                           20 + x
                         }), 4),
                   dim = c(a = 10, b = 4)),
         c = array(rep(sapply(1:10, 
                         function(x) {
                           rep(c(10, 20, 30) + x - 1, 30)
                         }), 4),
                   dim = c(c = 3, e = 5, f = 6, a = 10, b = 4)))
  )
##one shared margin. the remaining dim in first in is the target
  # named input dim
  # named output
  # named output dim
  f <- function(x, y) {
    list(a = array(x[1]:(x[1] + length(x) - 1), dim = c(d = 4)),
         b = mean(x) + mean(y),
         c = array(rep(x + y - 1, 30), dim = c(b = 4, e = 5, f = 6)))
  }
  expect_equal(
    Apply(list(array(1:3, dim = c(a = 3, b = 4)), 
               array(1:3 * 10, dim = c(a = 3))),
          list('b', NULL), f),
    list(a = array(sapply(c(10, 20, 30), function(x) {
                     sapply(1:4, function(y) {
                       y[1]:(y[1] + 3)
                     })
                   }), 
                   dim = c(d = 4, a = 3)),
         b = array(sapply(c(1:3), function(x) {
                     x + x * 10
                   }),
                   dim = c(a = 3)),
         c = array(sapply(c(1:3), function(x) {
                     rep(x * 10 + rep(x, 4) - 1, 30)
                   }),
                   dim = c(b = 4, e = 5, f = 6, a = 3)))
  )

#one target dim from each in
##no shared target
##shared target

#two target dims first in, no target dim second in

#all target dims
##no shared target
  # unnamed input dim
  # unnamed output
  # unnamed output dim
  f <- function(x, y) {
    list(array(rowMeans(x)),
         mean(x) + mean(y),
         array(sapply(y, function(z) z + x - 1), dim = c(10, 4, 3)))
  }
  expect_equal(
    Apply(list(array(1:10, dim = c(10, 4)), 
               array(1:3 * 10, dim = c(3))),
          list(c(1, 2), 1), f),
    list(output1 = array(1:10),
         output2 = 25.5,
         output3 = array(sapply(c(10, 20, 30), 
                           function(x) {
                             rep(1:10, 4) + x - 1
                           }),
                         dim = c(10, 4, 3)))
  )
  # named input dim
  # named output
  # named output dim
  f <- function(x, y) {
    list(a = array(rowMeans(x), c(a = 10)),
         b = mean(x) + mean(y),
         c = array(sapply(y, function(z) z + x - 1), 
                   dim = c(a = 10, b = 4, c = 3)))
  }
  expect_equal(
    Apply(list(array(1:10, dim = c(a = 10, b = 4)), 
               array(1:3 * 10, dim = c(c = 3))),
          list(c('a', 'b'), 'c'), f),
    list(a = array(1:10, dim = c(a = 10)),
         b = 25.5,
         c = array(sapply(c(10, 20, 30), 
                     function(x) {
                       rep(1:10, 4) + x - 1
                     }),
                   dim = c(a = 10, b = 4, c = 3)))
  )
##shared target
  # named input dim
  # named output
  # named output dim
  f <- function(x, y) {
    list(a = array(rowMeans(x), c(a = 10)),
         b = mean(x) + mean(y),
         c = array(rep(t(apply(x, 1, function(z) z * y)), 3),
                   dim = c(a = 10, b = 4, c = 3)))
  }
  expect_equal(
    Apply(list(array(1:10, dim = c(a = 10, b = 4)), 
               array(1:4 * 10, dim = c(b = 4))),
          list(c('a', 'b'), 'b'), f),
    list(a = array(1:10, dim = c(a = 10)),
         b = 30.5,
         c = array(rep(sapply(c(10, 20, 30, 40), 
                         function(x) {
                           1:10 * x
                         }), 
                       3),
                   dim = c(a = 10, b = 4, c = 3)))
  )
})

##test_that("in1: 2 dim; in2: 3 dim; targ. dims: 0-2, 0-3; out1: 2 dim", {
### shared first target dim
### shared second target dim
### shared two target dims (first two in second in)
### shared two target dims (last two in second in)
### shared two target dims (extreme two in second in)
### not shared target dims
##})
#
#test_that("in1: 2 dim; in2: 3 dim; targ. dims: 0-2, 0-3; out1: 1 dim; out2: 1 val; out3: 3 dim", {
## shared first target dim
## shared second target dim
## shared two target dims (first two in second in)
## shared two target dims (last two in second in)
## shared two target dims (extreme two in second in)
## not shared target dims
#})
#
#test_that("in1: 2 dim; in2: 3 dim; in3: 1 dim; targ. dims: 0-2, 0-3, 0-1; out1: 2 dim", {
## shared first target dim
## shared second target dim
## shared two target dims (first two in second in)
## shared two target dims (last two in second in)
## shared two target dims (extreme two in second in)
## not shared target dims
#})

# Real cases
test_that("real use case - standardization", {
  standardization <- function(x, mean, deviation){
    (x - mean) / deviation
  }

  x <- array(1:(2*3*4), dim = c(mod = 2, lon = 3, lat = 4))
  y <- array(1:12, dim = c(lon = 3, lat = 4))
  z <- array(1:12, dim = c(lon = 3, lat = 4))

  expected_result <- array(c(0:11 / z, rep(1, 3 * 4)), dim = c(3, 4, mod = 2))

  expect_equal(
    Apply(data = list(x,y,z), 
          target_dims = list(c('lon', 'lat'),
                             c('lon', 'lat'),
                             c('lon', 'lat')), 
          fun = standardization)$output1,
    expected_result
  )

  names(dim(expected_result)) <- c('lon', 'lat', 'mod')

  expect_equal(
    Apply(data = list(x,y,z), 
          margins = list('mod', NULL, NULL), 
          fun = standardization,
          output_dims = c('lon', 'lat')
         )$output1,
    expected_result
  )

  expect_equal(
    Apply(data = list(x,y,z), 
          margins = list(c('mod', 'lat'), 'lat', 'lat'), 
          fun = standardization,
          output_dims = c('lon')
         )$output1,
    multiApply:::.aperm2(expected_result, c(1, 3, 2))
  )

  x <- multiApply:::.aperm2(x, c(3, 2, 1))

  expect_equal(
    Apply(data = list(x,y,z), 
          target_dims = list(c('lon', 'lat'),
                             c('lon', 'lat'),
                             c('lon', 'lat')), 
          fun = standardization,
          output_dims = c('lon', 'lat')
         )$output1,
    expected_result
  )

})

# Test .aperm2
test_that(".aperm2", {
  data <- seq(as.POSIXct('1990-11-01'), 
              length.out = 6,
              by = as.difftime(1, units = 'days'))
  dim(data) <- c(3, 2)
  expect_equal(
    class(multiApply:::.aperm2(data, c(2, 1))),
    c('POSIXct', 'POSIXt')
  )
})

# TODOS:
# TESTS FOR MARGINS
# TESTS FOR DISORDERED TARGET_DIMS
# TESTS FOR FUN WITH TARGET_DIMS AND OUTPUT_DIMS ATTACHED
# TESTS FOR FUNCTIONS RECEIVING ADDITIONAL PARAMETERS
# TESTS FOR SPLIT FACTOR
# TESTS FOR NCORES
# TESTS OF WALLCLOCK TIME
# TESTS OF MEMORY FOOTPRINT