tests/testthat/test_inmf.R

In RcppPlanc: Parallel Low-Rank Approximation with Nonnegativity Constraints

library(RcppPlanc)
library(testthat)
library(Matrix)
local_edition(3)
source("helper-nmf.R")
ctrl.h5ds <- H5Mat(
  filename = system.file(
    "extdata",
    "ctrl_dense.h5",
    package = "RcppPlanc",
    mustWork = TRUE
  ),
  dataPath = "scaleData"
)
stim.h5ds <- H5Mat(
  filename = system.file(
    "extdata",
    "stim_dense.h5",
    package = "RcppPlanc",
    mustWork = TRUE
  ),
  dataPath = "scaleData"
)
ctrl.h5sp <- H5SpMat(
  filename = system.file(
    "extdata",
    "ctrl_sparse.h5",
    package = "RcppPlanc",
    mustWork = TRUE
  ),
  valuePath = "scaleDataSparse/data",
  rowindPath = "scaleDataSparse/indices",
  colptrPath = "scaleDataSparse/indptr",
  nrow = nrow(ctrl.sparse),
  ncol = ncol(ctrl.sparse)
)
stim.h5sp <- H5SpMat(
  filename = system.file(
    "extdata",
    "stim_sparse.h5",
    package = "RcppPlanc",
    mustWork = TRUE
  ),
  valuePath = "scaleDataSparse/data",
  rowindPath = "scaleDataSparse/indices",
  colptrPath = "scaleDataSparse/indptr",
  nrow = nrow(stim.sparse),
  ncol = ncol(stim.sparse)
)
ctrl.dense <- as.matrix(ctrl.sparse)
stim.dense <- as.matrix(stim.sparse)
m <- nrow(ctrl.dense)
ni <- c(ncol(ctrl.dense), ncol(stim.dense))
k <- 20

test_that("inmf, w/o init", {
  skip_on_winbuilder()
  # Dense cases
  set.seed(1)
  res1 <- inmf(list(ctrl.dense, stim.dense), k = k, nCores = 2)
  expect_length(res1, 4)
  expect_length(res1$H, 2)
  expect_length(res1$V, 2)
  expect_true(all.equal(dim(res1$W), c(m, k)))
  expect_lte(res1$objErr, 3.8e4)

  # Error tests
  expect_error(
    inmf(list(ctrl.dense, stim.sparse)),
    "All datasets should be of the same class"
  )

  expect_error(inmf(list(ctrl.dense, ctrl.dense), k = 300), "k must be <= m")
  # Sparse cases
  set.seed(1)
  res2 <- inmf(list(ctrl.sparse, stim.sparse), k = k, nCores = 2)
  expect_true(all.equal(res1, res2))

  # dense h5 cases
  set.seed(1)
  res3 <- inmf(list(ctrl.h5ds, stim.h5ds), k = k)
  expect_true(all.equal(res1, res3))

  # sparse h5 cases
  set.seed(1)
  res4 <- inmf(objectList = list(ctrl.h5sp, stim.h5sp), k = k, nCores = 2)
  expect_true(all.equal(res1, res4, tolerance = 1e-6))
})

test_that("inmf, w/ init", {
  skip_on_winbuilder()
  set.seed(1)
  res0 <- inmf(list(ctrl.sparse, stim.sparse), k = k, nCores = 2)
  res1 <- inmf(
    list(ctrl.sparse, stim.sparse),
    k = k,
    Hinit = res0$H,
    Vinit = res0$V,
    Winit = res0$W,
    nCores = 2
  )
  res2 <- inmf(
    list(ctrl.dense, stim.dense),
    k = k,
    Hinit = res0$H,
    Vinit = res0$V,
    Winit = res0$W,
    ,
    nCores = 2
  )
  expect_true(all.equal(res1, res2))

  expect_error(
    inmf(
      list(ctrl.sparse, stim.sparse),
      k = k,
      Hinit = lapply(res0$H, t),
      Vinit = res0$V,
      Winit = res0$W
    ),
    "Each given H must be of size"
  )
  expect_error(
    inmf(
      list(ctrl.sparse, stim.sparse),
      k = k,
      Hinit = res0$H,
      Vinit = lapply(res0$V, t),
      Winit = res0$W
    ),
    "All given Vs must be of size"
  )
  expect_error(
    inmf(
      list(ctrl.sparse, stim.sparse),
      k = k,
      Hinit = res0$H,
      Vinit = res0$V,
      Winit = t(res0$W)
    ),
    "Given W must be of size"
  )
})

test_that("onlineINMF, scenario 1", {
  skip_on_winbuilder()
  set.seed(1)
  res1 <- onlineINMF(
    list(ctrl.sparse, stim.sparse),
    k = k,
    minibatchSize = 50,
    nCores = 2
  )
  expect_length(res1, 6)
  expect_length(res1$H, 2)
  expect_length(res1$V, 2)
  expect_length(res1$A, 2)
  expect_length(res1$B, 2)
  expect_true(all.equal(dim(res1$W), c(m, k)))
  expect_lte(res1$objErr, 3.8e4)
  expect_error(
    onlineINMF(list(ctrl.sparse, stim.sparse), k = k),
    "Please set a smaller"
  )
  expect_error(
    onlineINMF(list(ctrl.sparse, stim.dense), k = k),
    "All datasets should be of the same class"
  )
  # TODO could be more error cases
  set.seed(1)
  res2 <- onlineINMF(
    list(ctrl.dense, stim.dense),
    k = k,
    minibatchSize = 50,
    nCores = 2
  )
  expect_true(all.equal(res1, res2))
  # dense h5 cases
  set.seed(1)
  res3 <- onlineINMF(
    list(ctrl.h5ds, stim.h5ds),
    k = k,
    minibatchSize = 50,
    nCores = 2
  )
  expect_true(all.equal(res1, res3))
  # sparse h5 cases
  set.seed(1)
  res4 <- onlineINMF(
    list(ctrl.h5sp, stim.h5sp),
    k = k,
    minibatchSize = 50,
    nCores = 2
  )
  expect_true(all.equal(res1, res4, tolerance = 1e-6))
})
set.seed(233)
new.data <- ctrl.sparse
new.data@x <- new.data@x + runif(length(new.data@x))
new.data.dense <- as.matrix(new.data)
new.h5sp <- as.H5SpMat(new.data, "temp_new_sparse.h5", overwrite = TRUE)
new.h5m <- as.H5Mat(new.data.dense, "temp_new_dense.h5", overwrite = TRUE)
set.seed(42)
res0 <- onlineINMF(list(ctrl.sparse, stim.sparse), k = k, minibatchSize = 50)
# TODO create temp h5 file for new.data
test_that("onlineINMF, scenario 2", {
  skip_on_winbuilder()
  set.seed(1)
  res1 <- onlineINMF(
    list(ctrl.sparse, stim.sparse),
    newDatasets = list(new.data),
    k = k,
    minibatchSize = 50,
    permuteChunkSize = 32,
    Hinit = res0$H,
    Vinit = res0$V,
    Winit = res0$W,
    Ainit = res0$A,
    Binit = res0$B,
    nCores = 2
  )
  set.seed(1)
  res2 <- onlineINMF(
    list(ctrl.dense, stim.dense),
    newDatasets = list(new.data.dense),
    k = k,
    minibatchSize = 50,
    permuteChunkSize = 32,
    Hinit = res0$H,
    Vinit = res0$V,
    Winit = res0$W,
    Ainit = res0$A,
    Binit = res0$B,
    nCores = 2
  )
  expect_true(all.equal(res1, res2))
  expect_error(
    onlineINMF(
      list(ctrl.dense, stim.dense),
      newDatasets = list(new.data),
      k = k,
      minibatchSize = 50,
      Hinit = res0$H,
      Vinit = res0$V,
      Winit = res0$W,
      Ainit = res0$A,
      Binit = res0$B
    ),
    "newDatasets should be of the same class as original datasets"
  )
  expect_error(
    onlineINMF(
      list(ctrl.sparse, stim.sparse),
      newDatasets = list(new.data),
      k = k,
      minibatchSize = 50,
      Hinit = res0$H,
      Vinit = lapply(res0$V, t),
      Winit = res0$W,
      Ainit = res0$A,
      Binit = res0$B
    ),
    "All given Vs must be of size 173 x 20"
  )
  expect_error(
    onlineINMF(
      list(ctrl.sparse, stim.sparse),
      newDatasets = list(new.data),
      k = k,
      minibatchSize = 50,
      Hinit = res0$H,
      Vinit = res0$V,
      Winit = t(res0$W),
      Ainit = res0$A,
      Binit = res0$B
    ),
    "Given W must be of size 173 x 20 but is 20 x 173"
  )
  expect_error(
    onlineINMF(
      list(ctrl.sparse, stim.sparse),
      newDatasets = list(new.data),
      k = k,
      minibatchSize = 50,
      Hinit = res0$H,
      Vinit = res0$V,
      Winit = res0$W,
      Ainit = res0$A,
      Binit = lapply(res0$B, t)
    ),
    "Given Bs must all be of size 173 x 20"
  )
  # A's are square, and nearly symmetric (but not exactly), don't have a smart check here yet
  expect_error(
    onlineINMF(
      list(ctrl.sparse, stim.sparse),
      newDatasets = list(new.data),
      k = k,
      minibatchSize = 50,
      Hinit = res0$H,
      Winit = res0$W,
      Ainit = res0$A,
      Binit = res0$B
    ),
    "Must provide 2 V matrices"
  )
  expect_error(
    onlineINMF(
      list(ctrl.sparse, stim.sparse),
      newDatasets = list(new.data),
      k = k,
      minibatchSize = 50,
      Hinit = res0$H,
      Vinit = res0$V,
      Winit = res0$W,
      Binit = res0$B
    ),
    "Must provide 2 A matrices"
  )
  expect_error(
    onlineINMF(
      list(ctrl.sparse, stim.sparse),
      newDatasets = list(new.data),
      k = k,
      minibatchSize = 50,
      Hinit = res0$H,
      Vinit = res0$V,
      Winit = res0$W,
      Ainit = res0$A
    ),
    "Must provide 2 B matrices"
  )
  set.seed(1)
  res3 <- onlineINMF(
    list(ctrl.h5sp, stim.h5sp),
    newDatasets = list(new.h5sp),
    k = k,
    minibatchSize = 50,
    permuteChunkSize = 32,
    Hinit = res0$H,
    Vinit = res0$V,
    Winit = res0$W,
    Ainit = res0$A,
    Binit = res0$B,
    nCores = 2
  )
  expect_true(all.equal(res1, res3))
  set.seed(1)
  res4 <- onlineINMF(
    list(ctrl.h5ds, stim.h5ds),
    newDatasets = list(new.h5m),
    k = k,
    minibatchSize = 50,
    Hinit = res0$H,
    Vinit = res0$V,
    Winit = res0$W,
    Ainit = res0$A,
    Binit = res0$B,
    nCores = 2
  )
  expect_true(all.equal(res1, res4))
})

test_that("onlineINMF, scenario 3", {
  skip_on_winbuilder()
  expect_no_error(onlineINMF(
    list(ctrl.sparse, stim.sparse),
    newDatasets = list(new.data),
    project = TRUE,
    k = k,
    minibatchSize = 50,
    Winit = res0$W,
    nCores = 2
  ))
})

p1 <- ctrl.sparse[1:10, ]
p2 <- stim.sparse[11:30, ]
p1.dense <- as.matrix(p1)
p2.dense <- as.matrix(p2)
test_that("uinmf", {
  skip_on_winbuilder()
  set.seed(1)
  res1 <- uinmf(list(ctrl.sparse, stim.sparse), list(p1, p2), nCores = 2)
  expect_length(res1, 5)
  expect_length(res1$H, 2)
  expect_length(res1$V, 2)
  expect_length(res1$U, 2)
  expect_true(all.equal(dim(res1$W), c(173, 20)))
  expect_true(all.equal(dim(res1$U[[1]]), c(10, 20)))
  expect_true(all.equal(dim(res1$U[[2]]), c(20, 20)))
  expect_lte(res1$objErr, 4.5e4)
  set.seed(1)
  res2 <- uinmf(
    list(ctrl.dense, stim.dense),
    list(p1.dense, p2.dense),
    nCores = 2
  )
  expect_true(all.equal(res1, res2))
  expect_error(
    uinmf(list(ctrl.sparse, stim.sparse), list(p1, p2), lambda = 1:3),
    "Must specify 1 lambda for all or each."
  )
  expect_error(
    uinmf(list(ctrl.sparse, stim.sparse), list(p1)),
    "Number of matrix in unshared feature list does not match"
  )
  expect_error(
    uinmf(list(ctrl.sparse, stim.sparse), list(p1.dense, p2.dense)),
    "Data of unshared feature should be of the same class as"
  )
  expect_error(
    uinmf(list(ctrl.sparse, stim.sparse), list(p1, p2[, 1:100])),
    "Number of columns in each matrix from"
  )
  set.seed(1)
  res3 <- uinmf(
    list(a = ctrl.sparse, b = stim.sparse),
    list(a = p1),
    nCores = 2
  )
  set.seed(1)
  res4 <- uinmf(
    list(a = ctrl.dense, b = stim.dense),
    list(a = p1.dense),
    nCores = 2
  )
  expect_true(all.equal(res3, res4))
  expect_equal(length(res4$U), 1)
})

test_that("auxiliary", {
  skip_on_winbuilder()
  expect_error(
    H5Mat("thisFilenameShouldNotExist", "something"),
    "File not found"
  )
  expect_error(
    as.H5Mat(ctrl.dense, "temp_new_dense.h5", overwrite = FALSE),
    "File already exists at the given path"
  )

  # Test if `as.H5Mat.dgCMatrix` S3 method convert sparse to h5 dense correctly
  ctrl.h5ds_2 <- as.H5Mat(
    ctrl.sparse,
    "temp_ctrl_dense.h5",
    overwrite = TRUE,
    chunk_size = c(173, 300)
  )
  set.seed(1)
  res1 <- onlineINMF(
    list(ctrl.sparse, stim.sparse),
    k = k,
    minibatchSize = 50,
    permuteChunkSize = 300
  )
  set.seed(1)
  res2 <- onlineINMF(list(ctrl.h5ds_2, stim.h5ds), k = k, minibatchSize = 50)
  expect_true(all.equal(res1, res2))

  expect_no_error(print.H5Mat(ctrl.h5ds))

  expect_error(
    H5SpMat("thisFilenameShouldNotExist", "something", "a", "b", 1, 2),
    "File not found"
  )
  expect_error(
    as.H5SpMat(ctrl.dense, "temp_new_sparse.h5", overwrite = FALSE),
    "File already exists at the given path"
  )

  # Test if `as.H5SpMat.matrix` S3 method convert dense to h5 sparse correctly
  ctrl.h5sp_2 <- as.H5SpMat(ctrl.dense, filename = "temp_ctrl_sparse.h5")
  set.seed(1)
  res1 <- onlineINMF(list(ctrl.sparse, stim.sparse), k = k, minibatchSize = 50)
  set.seed(1)
  res2 <- onlineINMF(list(ctrl.h5sp_2, stim.h5sp), k = k, minibatchSize = 50)
  expect_true(all.equal(res1, res2, tolerance = 1e-6))

  expect_no_error(print.H5SpMat(ctrl.h5sp))
})

unlink("temp_ctrl_dense.h5")
unlink("temp_ctrl_sparse.h5")
unlink("temp_new_sparse.h5")
unlink("temp_new_dense.h5")