tests/testthat/test-bind.R

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

test_that("bind (FileArray)", {
    
    
    x <- array(rnorm(120), 2:5)
    y <- filearray_create(tempfile(), dimension = c(2,3,4,10), partition_size = 3L)
    z <- filearray_create(tempfile(), dimension = c(2,3,4,10), partition_size = 3L)
    
    options("filearray.quiet" = FALSE)
    on.exit({
        options("filearray.quiet" = FALSE)
        y$delete(force = TRUE)
        z$delete(force = TRUE)
    }, add = TRUE)
    lapply(1:10, function(ii){
        if(ii %% 2 == 0){
            y[,,,ii] <- x[,,,ii / 2]
            z[,,,ii] <- x[,,,ii / 2]
        }
    })
    
    testthat::expect_warning({
        w <- filearray_bind(y, z, symlink = FALSE)
        w$delete()
    }, regexp = "^One or more arrays have last margin size.+")
    
    
    
    options("filearray.quiet" = TRUE)
    y$expand(n = 12)
    z$expand(n = 12)
    w <- filearray_bind(y, z, symlink = TRUE)
    l <- filearray_load(w$.filebase, mode = "readonly")
    
    on.exit({
        w$.mode <- "readwrite"
        w$delete()
        l$.mode <- "readwrite"
        l$delete()
    }, add = TRUE)
    
    expect_null({
        filearray_checkload(filebase = w$.filebase, symlink_ok = TRUE)
        filearray_checkload(filebase = w$.filebase, partition = 3)
        NULL
    })
    
    if(w$.header$filearray_bind$symlink){
        expect_error({
            filearray_checkload(filebase = w$.filebase, symlink_ok = FALSE)
        })
    }
    
    expect_identical(w[], l[])
    expect_identical(w[,,,seq(2,10,2)], x)
    expect_identical(w[,,,seq(2,10,2) + 12], x)
    expect_identical(l[,,,seq(2,10,2)], x)
    expect_identical(l[,,,seq(2,10,2) + 12], x)
    
    expect_identical(l[,,,seq(2,10,2) + c(0, 12, 12, 0, NA)], x[,,,c(1:4, NA)])
    
    expect_equal(
        l$collapse(keep = c(2, 3), method = "sum", na.rm = TRUE),
        apply(x, c(2,3), sum) * 2
    )
    
    # Check if cached bind works
    l <- filearray_bind(y, z, filebase = w$.filebase, symlink = w$.header$filearray_bind$symlink, overwrite = TRUE, cache_ok = TRUE)
    
    expect_true(attr(l, "cached_bind"))
    
})


test_that("bind (FileArrayProxy)", {
    
    
    y <- filearray_create(tempfile(), dimension = c(2,3,4,10), partition_size = 3L, type = "integer")
    z <- filearray_create(tempfile(), dimension = c(2,3,4,10), partition_size = 3L, type = "double")
    
    options("filearray.quiet" = FALSE)
    on.exit({
        options("filearray.quiet" = FALSE)
        y$delete(force = TRUE)
        z$delete(force = TRUE)
    }, add = TRUE)
    
    y[] <- rep(0L, 240)
    z[] <- rep(0L, 240)
    x <- array(rnorm(240), c(2,3,4,10))
    
    y <- y + x
    z <- z + x
    
    testthat::expect_error(y$expand(n = 12))
    
    options("filearray.quiet" = TRUE)
    w <- filearray_bind(y, z, symlink = TRUE)
    l <- filearray_load(w$.filebase, mode = "readonly")
    
    on.exit({
        w$.mode <- "readwrite"
        w$delete()
        l$.mode <- "readwrite"
        l$delete()
    }, add = TRUE)
    
    expect_null({
        filearray_checkload(filebase = w$.filebase, symlink_ok = TRUE)
        filearray_checkload(filebase = w$.filebase, partition = 3)
        NULL
    })
    
    if(w$.header$filearray_bind$symlink){
        expect_error({
            filearray_checkload(filebase = w$.filebase, symlink_ok = FALSE)
        })
    }
    
    expect_identical(w[], l[])
    expect_identical(w[,,,1:10, dimnames = NULL], x)
    expect_identical(w[,,,1:10 + 12, dimnames = NULL], x)
    expect_identical(l[,,,1:10, dimnames = NULL], x)
    expect_identical(l[,,,1:10 + 12, dimnames = NULL], x)
    
    expect_identical(l[,,,seq(2,10,2) + c(0, 12, 12, 0, NA), dimnames = NULL], x[,,,c(1:4*2, NA)])
    
    expect_equal(
        l$collapse(keep = c(2, 3), method = "sum", na.rm = TRUE),
        apply(x, c(2,3), sum) * 2
    )
    
    expect_equal(
        y$collapse(keep = c(2, 3), method = "sum", na.rm = TRUE),
        apply(x, c(2,3), sum)
    )
    expect_equal(
        z$collapse(keep = c(2, 3), method = "sum", na.rm = TRUE),
        apply(x, c(2,3), sum)
    )
    
    
    # Check if cached bind works
    # l <- filearray_bind(y, z, filebase = w$.filebase, symlink = w$.header$filearray_bind$symlink, overwrite = TRUE, cache_ok = TRUE)
    # 
    # expect_true(attr(l, "cached_bind"))
    
})