tests/testthat/test_data_manipulation.R

In satijalab/seurat: Tools for Single Cell Genomics

# Tests for functions in data_manipulation.cpp
# change in random number generation in R3.6, this ensures tests will pass under older and newer Rs
suppressWarnings(RNGversion(vstr = "3.5.3"))
set.seed(42)
library(Matrix)

# Tests for row merging
# --------------------------------------------------------------------------------
context("Row Merging")

m1 <- rsparsematrix(10, 10, 0.1)
m2 <- rsparsematrix(10, 10, 0.1)
m1.names <- paste0("row", sample(1:10, size = 10))
m2.names <- paste0("row", sample(1:20, size = 10))
all.names <- union(m1.names, m2.names)
rownames(m1) <- m1.names
rownames(m2) <- m2.names
m1 <- as(m1, "RsparseMatrix")
m2 <- as(m2, "RsparseMatrix")

test_that("Row merging done correctly", {
  m3 <- RowMergeMatrices(mat1 = m1, mat2 = m2, mat1_rownames = m1.names, mat2_rownames = m2.names,
                  all_rownames = all.names)
  expect_equal(m3[1, 14], -0.17)
  expect_equal(m3[3, 2], -1.4)
  expect_equal(m3[14, 18], -0.43)
  expect_equal(length(m3), 280)
})

#test_that("Row merging with a list done correctly", {
#  m3 <- RowMergeMatricesList(mat_list = list(m1, m2), mat_rownames = list(m1.names, m2.names), all_rownames = all.names)
#  expect_equal(m3[1, 14], -0.17)
#  expect_equal(m3[3, 2], -1.4)
#  expect_equal(m3[14, 18], -0.43)
#  expect_equal(length(m3), 280)
#})

# Tests for log normalization
# --------------------------------------------------------------------------------
context("Log Normalization")

mat <- as(matrix(1:16, ncol = 4, nrow = 4), "sparseMatrix")

test_that("Log Normalization returns expected values", {
  mat.norm.r <- log1p(sweep(mat, 2, Matrix::colSums(mat), FUN = "/") * 1e4)
  mat.norm <- LogNorm(mat, 1e4, display_progress = F)
  expect_equal(mat.norm[1, ], mat.norm.r[1, ])
  expect_equal(mat.norm[4, 4], mat.norm.r[4, 4])
})

# Tests for scaling data
# --------------------------------------------------------------------------------
context("Fast Scale Data Functions")

mat <- matrix(rnorm(n = 10*15), nrow = 10, ncol = 15)

# should be the equivalent of t(scale(t(mat)))
test_that("Fast implementation of row scaling returns expected values", {
  expect_equal(t(scale(t(mat)))[1:10, 1:15], FastRowScale(mat))
  expect_equal(t(scale(t(mat), center = FALSE))[1:10, 1:15],
               FastRowScale(mat, center = FALSE))
  expect_equal(t(scale(t(mat), scale = FALSE))[1:10, 1:15],
               FastRowScale(mat, scale = FALSE))
  expect_equal(t(scale(t(mat), scale = FALSE, center = F))[1:10, 1:15],
               FastRowScale(mat, scale = FALSE, center = F))
  mat.clipped <- FastRowScale(mat, scale_max = 0.2)
  expect_true(max(mat.clipped, na.rm = T) >= 0.2)
})

# should be the equivalent of scale(mat, TRUE, apply(mat, 2, sd))
test_that("Standardize returns expected values", {
  expect_equal(Standardize(mat, display_progress = FALSE), scale(mat, TRUE, apply(mat, 2, sd)),
               check.attributes = FALSE)
})

# should be the equivalent of t(scale(t(mat)))
mat <- rsparsematrix(10, 15, 0.1)
test_that("Fast implementation of row scaling returns expected values", {
  expect_equal(t(scale(t(as.matrix(mat))))[1:10, 1:15], FastSparseRowScale(mat, display_progress = FALSE),
               check.attributes = FALSE)
  expect_equal(t(scale(t(as.matrix(mat)), center = FALSE))[1:10, 1:15],
               FastSparseRowScale(mat, center = FALSE, display_progress = FALSE),
               check.attributes = FALSE)
  expect_equal(t(scale(t(as.matrix(mat)), scale = FALSE))[1:10, 1:15],
               FastSparseRowScale(mat, scale = FALSE, display_progress = FALSE),
               check.attributes = FALSE)
  expect_equal(t(scale(t(as.matrix(mat)), scale = FALSE, center = F))[1:10, 1:15],
               FastSparseRowScale(mat, scale = FALSE, center = F, display_progress = FALSE),
               check.attributes = FALSE)
  mat.clipped <- FastSparseRowScale(mat, scale_max = 0.2, display_progress = F)
  expect_true(max(mat.clipped, na.rm = T) >= 0.2)
})

mat <- as.sparse(x = matrix(rnorm(100), nrow = 10, ncol = 10))

test_that("Row scaling with known stats works", {
  mat.rowmeans <- rowMeans(x = mat)
  mat.sd <- apply(X = mat, MARGIN = 1, FUN = sd)
  expect_equal(
    t(scale(t(as.matrix(mat)), center = mat.rowmeans, scale = mat.sd)),
    FastSparseRowScaleWithKnownStats(mat = mat, mu = mat.rowmeans, sigma = mat.sd, scale = TRUE, center = TRUE, scale_max = 10, display_progress = FALSE),
    check.attributes = FALSE
  )
  expect_equal(
    t(scale(t(as.matrix(mat)), center = FALSE, scale = mat.sd)),
    FastSparseRowScaleWithKnownStats(mat = mat, mu = mat.rowmeans, sigma = mat.sd, scale = TRUE, center = FALSE, scale_max = 10, display_progress = FALSE),
    check.attributes = FALSE
  )
  expect_equal(
    t(scale(t(as.matrix(mat)), center = mat.rowmeans, scale = FALSE)),
    FastSparseRowScaleWithKnownStats(mat = mat, mu = mat.rowmeans, sigma = mat.sd, scale = FALSE, center = TRUE, scale_max = 10, display_progress = FALSE),
    check.attributes = FALSE
  )
  mat.clipped <- FastSparseRowScaleWithKnownStats(mat = mat, mu = mat.rowmeans, sigma = mat.sd, scale = FALSE, center = TRUE, scale_max = 0.2, display_progress = FALSE)
  expect_true(max(mat.clipped, na.rm = T) >= 0.2)
})


# Tests for fast basic stats functions
# --------------------------------------------------------------------------------
context("Fast Basic Stats Functions")

set.seed(42)
mat <- replicate(10, rchisq(10, 4))
fcv <- FastCov(mat)
cv <- cov(mat)
test_that("Fast implementation of covariance returns expected values", {
  expect_equal(fcv[1,1], 9.451051142)
  expect_equal(fcv[10,10], 5.6650068)
  expect_equal(fcv, cv)
})

mat2 <- replicate(10, rchisq(10, 4))
fcv <- FastCovMats(mat1 = mat, mat2 = mat2)
cv <- cov(mat, mat2)
test_that("Fast implementation of covariance returns expected values for matrices", {
  expect_equal(fcv[1,1], 1.523417, tolerance = 1e-6)
  expect_equal(fcv[10,10], -0.6031694, tolerance = 1e-6)
  expect_equal(fcv, cv)
})


merged.mat <- FastRBind(mat, fcv)
test_that("Fast implementation of rbind returns expected values", {
  expect_equal(merged.mat, rbind(mat, fcv))
  expect_equal(mat[1,1], merged.mat[1,1])
  expect_equal(fcv[10,10], merged.mat[20,10])
})

mat <- as.sparse(mat)
test_that("Fast implementation of ExpMean returns expected values",{
  expect_equal(ExpMean(mat[1,]), FastExpMean(mat, display_progress = F)[1])
  expect_equal(ExpMean(mat[5,]), FastExpMean(mat, display_progress = F)[5])
  expect_equal(ExpMean(mat[10,]), FastExpMean(mat, display_progress = F)[10])
  expect_equal(length(FastExpMean(mat, display_progress = F)), nrow(mat))
  expect_error(FastExpMean(mat[1, ], display_progress = F))
  expect_equal(FastExpMean(mat[1, ,drop = F], display_progress = F), ExpMean(mat[1,]))
  expect_equal(FastExpMean(mat, display_progress = F)[1], 6.493418, tolerance = 1e-6)
  expect_equal(FastExpMean(mat, display_progress = F)[5], 6.255206, tolerance = 1e-6)
  expect_equal(FastExpMean(mat, display_progress = F)[10], 7.84965, tolerance = 1e-6)
})
test_that("Fast implementation of LogVMR returns expected values", {
  expect_equal(LogVMR(mat[1,]), FastLogVMR(mat, display_progress = F)[1])
  expect_equal(LogVMR(mat[5,]), FastLogVMR(mat, display_progress = F)[5])
  expect_equal(LogVMR(mat[10,]), FastLogVMR(mat, display_progress = F)[10])
  expect_equal(length(FastExpMean(mat, display_progress = F)), nrow(mat))
  expect_error(FastLogVMR(mat[1, ], display_progress = F))
  expect_equal(FastLogVMR(mat[1, ,drop = F], display_progress = F), LogVMR(mat[1,]))
  expect_equal(FastLogVMR(mat, display_progress = F)[1], 7.615384, tolerance = 1e-6)
  expect_equal(FastLogVMR(mat, display_progress = F)[5], 7.546768, tolerance = 1e-6)
  expect_equal(FastLogVMR(mat, display_progress = F)[10], 10.11755, tolerance = 1e-6)
})

test_that("Row variance calculations for sparse matrices work", {
  expect_equal(apply(X = mat, MARGIN = 1, FUN = var), SparseRowVar(mat = mat, display_progress = FALSE), tolerance = 1e-6)
  expect_equal(apply(X = mat2, MARGIN = 1, FUN = var), SparseRowVar(mat = as.sparse(x = mat2), display_progress = FALSE), tolerance = 1e-6)
})

# Tests for data structure manipulations
# --------------------------------------------------------------------------------
context("Data structure manipulations")

mat <- rsparsematrix(nrow = 10, ncol = 100, density = 0.1)
mat2 <- rsparsematrix(nrow = 10, ncol = 10, density = 0.1)
cols.to.replace1 <- 1:10
cols.to.replace2 <- 10:1
cols.to.replace3 <- 91:100
cols.to.replace4 <- c(10, 15, 33, 2, 6, 99, 55, 30, 25, 42)

ReplaceCols <- function(mat, cols, replace){
  mat[, cols] <- replace
  return(mat)
}

test_that("Replacing columns works", {
  expect_equal(ReplaceColsC(mat = mat, col_idx = cols.to.replace1 - 1, replacement = mat2),
               ReplaceCols(mat = mat, cols = cols.to.replace1, replace = mat2))
  expect_equal(ReplaceColsC(mat = mat, col_idx = cols.to.replace2 - 1, replacement = mat2),
               ReplaceCols(mat = mat, cols = cols.to.replace2, replace = mat2))
  expect_equal(ReplaceColsC(mat = mat, col_idx = cols.to.replace3 - 1, replacement = mat2),
               ReplaceCols(mat = mat, cols = cols.to.replace3, replace = mat2))
  expect_equal(ReplaceColsC(mat = mat, col_idx = cols.to.replace4 - 1, replacement = mat2),
               ReplaceCols(mat = mat, cols = cols.to.replace4, replace = mat2))
})

test_that("Cpp implementation of row variance is correct", {
  expect_equal(apply(X = mat, MARGIN = 1, FUN = var), RowVar(as.matrix(mat)))
  expect_equal(apply(X = merged.mat, MARGIN = 1, FUN = var), RowVar(as.matrix(merged.mat)))
})