tests/testthat/test-memApply.R

In memshare: Shared Memory Multithreading

# tests/testthat/test-memApply.R

test_that("memApply matches base apply for correlation with a vector", {
  skip_if_not_installed("parallel")  # Should be there, but just in case
  
  set.seed(1)
  n <- 40
  p <- 10
  X <- matrix(rnorm(n * p), nrow = n, ncol = p)
  y <- rnorm(n)
  
  ns <- paste0("memApply_", Sys.getpid(), "_", sample.int(1e6, 1))
  
  on.exit({
    # memApply should clean up its own pages when X/VARS are passed as objects,
    # but we call releaseVariables just in case the implementation changes.
    try(memshare::releaseVariables(ns, "X"), silent = TRUE)
    try(memshare::releaseVariables(ns, "y"), silent = TRUE)
  }, add = TRUE)
  
  f <- function(v, y) stats::cor(v, y)
  
  res_mem <- memshare::memApply(
    X = X,
    MARGIN = 2,
    FUN = f,
    NAMESPACE = ns,
    VARS = list(y = y),
    MAX.CORES = 1
  )
  
  # memApply returns a list; base apply returns a numeric vector
  res_mem_vec  <- as.numeric(unlist(res_mem))
  res_base_vec <- as.numeric(apply(X, 2, f, y = y))
  
  expect_equal(res_mem_vec, res_base_vec, tolerance = 1e-12)
})

test_that("memApply works when X is already registered by name", {
  ns <- paste0("byname_", Sys.getpid(), "_", sample.int(1e6, 1))
  X <- matrix(runif(30), 6, 5)
  
  on.exit({
    try(memshare::releaseViews(ns, "X"), silent = TRUE)
    try(memshare::releaseVariables(ns, "X"), silent = TRUE)
  }, add = TRUE)
  
  memshare::registerVariables(ns, list(X = X))
  
  # Now call memApply with X = "X"
  out <- memshare::memApply(
    X = "X",
    MARGIN = 2,
    FUN = function(v) mean(v),
    NAMESPACE = ns,
    MAX.CORES = 1
  )
  
  out_vec <- as.numeric(unlist(out))
  expect_equal(out_vec, colMeans(X))
})