tests/testthat/test-FBM-accessors.R

In bigstatsr: Statistical Tools for Filebacked Big Matrices

################################################################################

context("FBM_ACCESSORS")

set.seed(SEED)

################################################################################

test_extract <- function(call) {
  call <- deparse(substitute(call))
  eval(parse(text = sprintf("expect_equal(%s, %s)",
                            sub("^mat", "X", call),
                            sub("^mat", "x", call))), parent.frame())
}

test_replace <- function(call) {

  call <- deparse(substitute(call))

  assign <- sprintf("%s <- %s",
                    sub("^mat", "X", call),
                    sub("^mat", "x", call))
  eval(parse(text = assign), parent.frame())
  eval(parse(text = "expect_equal(X[], x)"), parent.frame())

  assign <- sprintf("%s <- as.vector(%s)",
                    sub("^mat", "X", call),
                    sub("^mat", "x", call))
  eval(parse(text = assign), parent.frame())
  eval(parse(text = "expect_equal(X[], x)"), parent.frame())
}

x0 <- matrix(rnorm(256, mean = 100, sd = 10), 16)

################################################################################

for (t in c(TEST.TYPES, "FBM.code256")) {

  if (t == "FBM.code256") {
    X <- big_copy(x0, type = "raw")
    X[] <- as.raw(0:255)
    X <- add_code256(X, code = as.vector(x0))
    expect_s4_class(X, "FBM")
    expect_s4_class(X, "FBM.code256")

    x <- x0

    TEST.ACCS <- c(test_extract)
  } else {
    X <- big_copy(x0, type = t)
    expect_s4_class(X, "FBM")

    x <- X[]

    TEST.ACCS <- c(test_extract, test_replace)
  }

  test_that("same dimensions", {
    expect_equal(nrow(X),   nrow(x))
    expect_equal(ncol(X),   ncol(x))
    expect_equal(dim(X),    dim(x))
    expect_equal(length(X), length(x))
    expect_equal(diag(X),   diag(x))
  })

  test_that("same accessing", {

    for (test_acc in TEST.ACCS) {

      test_acc(mat[])
      test_acc(mat[1])
      test_acc(mat[1:5])
      test_acc(mat[, , drop = FALSE])
      test_acc(mat[, , drop = TRUE])
      test_acc(mat[1, ])
      test_acc(mat[1, , drop = FALSE])
      test_acc(mat[1, , drop = TRUE])
      test_acc(mat[cbind(1:5, 1:5)])

      for (ind in list(1:5, -(1:5), c(TRUE, FALSE, TRUE))) {

        test_acc(mat[ind, ])
        test_acc(mat[ind, , drop = FALSE])
        test_acc(mat[ind, , drop = TRUE])
        test_acc(mat[, 1])
        test_acc(mat[, 1, drop = FALSE])
        test_acc(mat[, 1, drop = TRUE])
        test_acc(mat[1, 1])
        test_acc(mat[1, 1, drop = FALSE])
        test_acc(mat[1, 1, drop = TRUE])
        test_acc(mat[ind, 1])
        test_acc(mat[ind, 1, drop = FALSE])
        test_acc(mat[ind, 1, drop = TRUE])
        test_acc(mat[, ind])
        test_acc(mat[, ind, drop = FALSE])
        test_acc(mat[, ind, drop = TRUE])
        test_acc(mat[1, ind])
        test_acc(mat[1, ind, drop = FALSE])
        test_acc(mat[1, ind, drop = TRUE])
        test_acc(mat[ind, ind])
        test_acc(mat[ind, ind, drop = FALSE])
        test_acc(mat[ind, ind, drop = TRUE])
      }

    }
  })
}

################################################################################