tests/testthat/test-map.R

In filearray: File-Backed Array for Out-of-Memory Computation

library(testthat)


test_that("map with proxy", {
    
    set.seed(10)
    
    # A large array example
    x1 <- filearray_create(temp_path(check = TRUE), dimension = c(28, 100, 3, 4), initialize = FALSE, partition_size = 3L)
    x1[] <- rnorm(33600)
    x2 <- x1 + 1
    x3 <- x1 + x2
    x4 <- as_filearray(matrix(1:12, nrow = 4))
    
    x <- list(x1, x2, x3, x4)
    # check common input size
    
    bc <- 12
    re <- fmap2(x, function(input) {
        testthat::expect_length(input, 4)
        testthat::expect_length(input[[1]], length(x1) / bc)
        testthat::expect_length(input[[2]], length(x2) / bc)
        testthat::expect_length(input[[3]], length(x3) / bc)
        testthat::expect_length(input[[4]], length(x4) / bc)
        testthat::expect_equal(input[[1]] + 1, input[[2]])
        testthat::expect_equal(input[[3]], input[[2]] + input[[1]])
        
        sum(input[[4]]) + sum(input[[3]] - input[[2]] - input[[1]])
    }, .buffer_count = bc)
    expect_equal(re, colSums(matrix(x4[], ncol = bc)))
    
    
    bc <- 4
    re <- fmap2(x, function(input) {
        testthat::expect_length(input, 4)
        testthat::expect_length(input[[1]], length(x1) / bc)
        testthat::expect_length(input[[2]], length(x2) / bc)
        testthat::expect_length(input[[3]], length(x3) / bc)
        testthat::expect_length(input[[4]], length(x4) / bc)
        testthat::expect_equal(input[[1]] + 1, input[[2]])
        testthat::expect_equal(input[[3]], input[[2]] + input[[1]])
        
        sum(input[[4]]) + sum(input[[3]] - input[[2]] - input[[1]])
    }, .buffer_count = bc)
    expect_equal(re, colSums(matrix(x4[], ncol = bc)))
    
    bc <- 1
    re <- fmap2(x, function(input) {
        testthat::expect_length(input, 4)
        testthat::expect_length(input[[1]], length(x1) / bc)
        testthat::expect_length(input[[2]], length(x2) / bc)
        testthat::expect_length(input[[3]], length(x3) / bc)
        testthat::expect_length(input[[4]], length(x4) / bc)
        testthat::expect_equal(input[[1]] + 1, input[[2]])
        testthat::expect_equal(input[[3]], input[[2]] + input[[1]])
        
        sum(input[[4]]) + sum(input[[3]] - input[[2]] - input[[1]])
    }, .buffer_count = bc)
    expect_equal(re, colSums(matrix(x4[], ncol = bc)))    
    
    
    # check fmap
    bc <- 12
    
    y <- filearray_create(temp_path(), dimension = c(12,1))
    fmap(x, function(input) {
        testthat::expect_length(input, 4)
        testthat::expect_length(input[[1]], length(x1) / bc)
        testthat::expect_length(input[[2]], length(x2) / bc)
        testthat::expect_length(input[[3]], length(x3) / bc)
        testthat::expect_length(input[[4]], length(x4) / bc)
        testthat::expect_equal(input[[1]] + 1, input[[2]])
        testthat::expect_equal(input[[3]], input[[2]] + input[[1]])
        
        input[[4]] + sum(input[[3]] - input[[2]] - input[[1]])
    }, .buffer_count = bc, .y = y)
    expect_equal(as.vector(y[]), as.vector(x4[]))
    
    clear_cache()
})


test_that("map filearrays", {
    
    # A large array example
    x <- filearray_create(temp_path(check = TRUE), dimension = c(28, 100, 301, 4), initialize = FALSE, partition_size = 3L)
    dnames <- list(
        Trial = sample(c("A", "B"), 28, replace = TRUE),
        Marker = 1:100,
        Time = seq(-1,2,0.01),
        Location = 1:4
    )
    dimnames(x) <- dnames
    
    expect_equal(dimnames(x), dnames)
    
    y <- array(rnorm(length(x)), dim(x))
    x[] <- y
    
    output <- filearray_create(temp_path(check = TRUE), dimension = dim(x), initialize = FALSE, partition_size = 4L)
    
    f <- function(input){
        # get locational data
        if(is.list(input)){
            location_data <- input[[1]]
        } else {
            location_data <- input
        }
        
        dim(location_data) <- c(28, 100, 301)
        
        # collapse over first 50 time points for
        # each trial, and marker
        baseline <- apply(location_data[,,1:50], c(1,2), mean)
        
        # calibrate
        calibrated <- sweep(location_data, c(1,2), baseline,
                            FUN = function(data, bl){
                                (data / bl - 1) * 100
                            })
        return(calibrated)
    }
    
    fmap(x, f, .y = output, .buffer_count = 4)
    
    b <- apply(y, 4, f)
    dim(b) <- dim(y)
    
    expect_equal(output[], b)
    
    d <- fmap2(x, f, .buffer_count = 4, .simplify = TRUE)
    expect_equal(d, b)
    
    x$delete()
    output$delete()
    clear_cache()
})