Skip to content

Commit 50049b5

Browse files
timoasttimoast
committed
Expand test coverage
1 parent 7fb9701 commit 50049b5

14 files changed

Lines changed: 4018 additions & 201 deletions

‎tests/testthat/test-differential-accessibility.R‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
test_that("FoldChange dispatches on ChromatinAssay5", {
2+
skip_if_not_installed("Seurat")
3+
cells.1 <- colnames(atac_small)[atac_small$cluster == 1]
4+
cells.2 <- colnames(atac_small)[atac_small$cluster == 2]
5+
res <- Seurat::FoldChange(
6+
object = atac_small[["peaks"]],
7+
cells.1 = cells.1, cells.2 = cells.2
8+
)
9+
expect_s3_class(res, "data.frame")
10+
expect_true("avg_log2FC" %in% colnames(res))
11+
expect_equal(nrow(res), nrow(atac_small[["peaks"]]))
12+
expect_equal(rownames(res), rownames(atac_small[["peaks"]]))
13+
expect_true(is.numeric(res$avg_log2FC))
14+
expect_false(any(is.nan(res$avg_log2FC)))
15+
})
16+
17+
test_that("FoldChange ChromatinAssay5 respects fc.name", {
18+
skip_if_not_installed("Seurat")
19+
cells.1 <- colnames(atac_small)[atac_small$cluster == 1]
20+
cells.2 <- colnames(atac_small)[atac_small$cluster == 2]
21+
res <- Seurat::FoldChange(
22+
object = atac_small[["peaks"]],
23+
cells.1 = cells.1,
24+
cells.2 = cells.2,
25+
fc.name = "my_fc"
26+
)
27+
expect_true("my_fc" %in% colnames(res))
28+
})
29+
30+
test_that("FoldChange ChromatinAssay5 supports custom mean function and base", {
31+
skip_if_not_installed("Seurat")
32+
cells.1 <- colnames(atac_small)[atac_small$cluster == 1]
33+
cells.2 <- colnames(atac_small)[atac_small$cluster == 2]
34+
res <- Seurat::FoldChange(
35+
object = atac_small[["peaks"]],
36+
cells.1 = cells.1,
37+
cells.2 = cells.2,
38+
mean.fxn = function(x) Matrix::rowMeans(x),
39+
base = exp(1)
40+
)
41+
expect_s3_class(res, "data.frame")
42+
expect_true("avg_logFC" %in% colnames(res))
43+
})

‎tests/testthat/test-dimreduc.R‎

Lines changed: 160 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,10 @@
1+
library(SeuratObject)
2+
library(Matrix)
3+
14
suppressWarnings(RNGversion(vstr = "3.5.3"))
25

6+
# LSI / RunTFIDF reference values ---------------------------------------------
7+
38
test_that("LSI works", {
49
set.seed(seed = 1)
510
mat <- matrix(data = rbinom(n = 25, size = 5, prob = 0.2), nrow = 5)
@@ -23,10 +28,7 @@ test_that("LSI works", {
2328
expected = c(0.000000, 5.516015, 0.000000, 4.943317, 6.103178),
2429
tolerance = 1 / 1000
2530
)
26-
expect_equal(
27-
object = method4[1, ],
28-
expected = c(0, 2, 0, 1, 2)
29-
)
31+
expect_equal(object = method4[1, ], expected = c(0, 2, 0, 1, 2))
3032

3133
lsi <- suppressWarnings(RunSVD(object = mat))
3234
embeddings <- SeuratObject::Embeddings(object = lsi)
@@ -44,9 +46,162 @@ test_that("LSI works", {
4446
)
4547
})
4648

49+
# Jaccard ----------------------------------------------------------------------
50+
4751
test_that("Jaccard works", {
4852
set.seed(1)
49-
mat <- matrix(data = sample(x = c(0, 1), size = 25, replace = TRUE), nrow = 5)
53+
mat <- matrix(
54+
data = sample(x = c(0, 1), size = 25, replace = TRUE),
55+
nrow = 5
56+
)
5057
jm <- Jaccard(x = mat, y = mat)
5158
expect_equal(object = jm[1, ], expected = c(1, 1 / 3, 2 / 5, 1 / 3, 0))
5259
})
60+
61+
test_that("Jaccard computes a matrix between two matrices", {
62+
set.seed(1)
63+
X <- matrix(sample(c(0, 1), 100, replace = TRUE), 10, 10)
64+
Y <- matrix(sample(c(0, 1), 100, replace = TRUE), 10, 10)
65+
res <- Jaccard(X, Y)
66+
expect_equal(dim(res), c(10, 10))
67+
})
68+
69+
test_that("Jaccard warns on values > 1", {
70+
X <- matrix(sample(0:3, 100, replace = TRUE), 10, 10)
71+
Y <- matrix(sample(0:3, 100, replace = TRUE), 10, 10)
72+
expect_warning(Jaccard(X, Y), regexp = "binarize")
73+
})
74+
75+
# RunSVD -----------------------------------------------------------------------
76+
77+
test_that("RunSVD on matrix returns DimReduc", {
78+
set.seed(1)
79+
m <- matrix(rnorm(500), nrow = 50, ncol = 10)
80+
res <- RunSVD(m, n = 5, verbose = FALSE)
81+
expect_s4_class(res, "DimReduc")
82+
83+
embeddings <- Embeddings(object = res)
84+
# one row per column (cell) of the input, one column per requested component
85+
expect_equal(object = dim(embeddings), expected = c(10, 5))
86+
expect_equal(object = Key(object = res), expected = "LSI_")
87+
expect_equal(
88+
object = colnames(embeddings),
89+
expected = paste0("LSI_", 1:5)
90+
)
91+
# default scale.embeddings = TRUE => each component has mean 0, SD 1
92+
expect_equal(
93+
object = unname(apply(X = embeddings, MARGIN = 2, FUN = mean)),
94+
expected = rep(0, 5),
95+
tolerance = 1 / 1000
96+
)
97+
expect_equal(
98+
object = unname(apply(X = embeddings, MARGIN = 2, FUN = sd)),
99+
expected = rep(1, 5),
100+
tolerance = 1 / 1000
101+
)
102+
expect_equal(
103+
object = as.vector(embeddings[1, ]),
104+
expected = c(-1.2330585, 0.2963341, -0.0124394, -0.9656036, 0.5545593),
105+
tolerance = 1 / 1000
106+
)
107+
})
108+
109+
test_that("RunSVD with pca = TRUE works", {
110+
set.seed(1)
111+
m <- matrix(rnorm(500), nrow = 50, ncol = 10)
112+
res <- RunSVD(m, n = 5, pca = TRUE, verbose = FALSE)
113+
expect_s4_class(res, "DimReduc")
114+
115+
# pca = TRUE uses the PCA_ key (not LSI_)
116+
expect_equal(object = Key(object = res), expected = "PCA_")
117+
118+
emb.pca <- Embeddings(object = res)
119+
expect_equal(object = dim(emb.pca), expected = c(10, 5))
120+
expect_equal(
121+
object = colnames(emb.pca),
122+
expected = paste0("PCA_", 1:5)
123+
)
124+
125+
# The pca branch weights embeddings by eigenvalues and does NOT scale them
126+
# to unit variance, so the result must differ from pca = FALSE. If pca were
127+
# ignored these embeddings would equal the scaled (unit-variance) LSI result.
128+
set.seed(1)
129+
m2 <- matrix(rnorm(500), nrow = 50, ncol = 10)
130+
res.lsi <- RunSVD(m2, n = 5, pca = FALSE, verbose = FALSE)
131+
emb.lsi <- Embeddings(object = res.lsi)
132+
133+
expect_false(
134+
isTRUE(all.equal(
135+
target = unname(emb.pca),
136+
current = unname(emb.lsi),
137+
tolerance = 1 / 1000
138+
))
139+
)
140+
# unscaled, eigenvalue-weighted: component SDs are not all 1
141+
expect_false(
142+
isTRUE(all.equal(
143+
target = unname(apply(X = emb.pca, MARGIN = 2, FUN = sd)),
144+
current = rep(1, 5),
145+
tolerance = 1 / 1000
146+
))
147+
)
148+
expect_equal(
149+
object = as.vector(emb.pca[1, ]),
150+
expected = c(-1.2143982, 0.4486555, -0.2778468, -0.3807493, -0.6286513),
151+
tolerance = 1 / 1000
152+
)
153+
})
154+
155+
test_that("RunSVD with scale.max clipping works", {
156+
set.seed(1)
157+
m <- matrix(rnorm(500), nrow = 50, ncol = 10)
158+
159+
# without clipping the embeddings exceed 0.5 in magnitude, so a scale.max
160+
# of 0.5 must actually clip them
161+
res.unclipped <- RunSVD(m, n = 5, verbose = FALSE)
162+
expect_gt(max(abs(Embeddings(object = res.unclipped))), 0.5)
163+
164+
res <- RunSVD(m, n = 5, scale.max = 0.5, verbose = FALSE)
165+
expect_s4_class(res, "DimReduc")
166+
167+
embeddings <- Embeddings(object = res)
168+
expect_equal(object = dim(embeddings), expected = c(10, 5))
169+
# clipping bound is respected
170+
expect_lte(max(abs(embeddings)), 0.5)
171+
# and clipping actually bit (some values were pushed to the bound)
172+
expect_equal(object = max(abs(embeddings)), expected = 0.5)
173+
})
174+
175+
test_that("RunSVD on Seurat returns updated Seurat", {
176+
obj <- atac_small
177+
VariableFeatures(obj) <- rownames(obj[["peaks"]])
178+
res <- RunSVD(obj, n = 5, verbose = FALSE)
179+
expect_s4_class(res, "Seurat")
180+
expect_true("lsi" %in% names(res@reductions))
181+
182+
embeddings <- Embeddings(object = res, reduction = "lsi")
183+
# one row per cell, one column per requested component
184+
expect_equal(object = dim(embeddings), expected = c(ncol(obj), 5))
185+
expect_equal(object = Key(object = res[["lsi"]]), expected = "LSI_")
186+
expect_equal(
187+
object = as.vector(embeddings[1, ]),
188+
expected = c(-0.9426501, 1.0001435, 0.7316286, 0.4466094, 0.1253871),
189+
tolerance = 1 / 1000
190+
)
191+
})
192+
193+
test_that("RunSVD on assay returns DimReduc", {
194+
a <- atac_small[["peaks"]]
195+
VariableFeatures(a) <- rownames(a)
196+
res <- RunSVD(a, n = 5, verbose = FALSE)
197+
expect_s4_class(res, "DimReduc")
198+
199+
embeddings <- Embeddings(object = res)
200+
expect_equal(object = dim(embeddings), expected = c(ncol(a), 5))
201+
expect_equal(object = Key(object = res), expected = "LSI_")
202+
expect_equal(
203+
object = as.vector(embeddings[1, ]),
204+
expected = c(-0.9426501, 1.0001435, 0.7316286, 0.4466094, 0.1253871),
205+
tolerance = 1 / 1000
206+
)
207+
})

0 commit comments

Comments
 (0)