context("Test reduce.R")
mat <- matrix(1:8, nrow=2, ncol=4)
mri <- BrcFmri(data2d = mat, id = "01",
parcellation = BrcParcellation(c(2,2,2), c(0,0,1,1,2,2,3,4)))
mat2 <- matrix(1:4, nrow=1, ncol=4)
mri2 <- BrcFmri(data2d = mat2, id = "02",
parcellation = BrcParcellation(c(2,2,2), c(0,0,1,1,2,2,3,4)))
parcellation <- BrcParcellation(c(2,2,2), c(0,0,1,1,1,1,2,2))
## test reduce_mean()
test_that("it computes the correct mean", {
mat <- matrix(rnorm(200), ncol = 20, nrow = 10)
mat <- t(scale(mat))
res <- reduce_mean(mat)
expect_true(sum(abs(res)) < 1e-5)
expect_true(length(res) == 20)
})
test_that("it errors when passed in nothing", {
expect_error(reduce_mean(NULL))
expect_error(reduce_mean(NA))
expect_error(reduce_mean())
})
test_that("it can handle matrix with no columns", {
mat <- matrix(0, 10, 10)
res <- reduce_mean(mat[,numeric(0)])
expect_true(length(res) == 10)
expect_true(all(res == 0))
})
## test reduce_pca()
test_that("it computes the right pca", {
set.seed(10)
x = rnorm(100); x <- scale(x)
y = x
mat <- cbind(x,y)
res <- reduce_pca(mat)
expect_true(sum(res) < 1e-5)
expect_true(length(res) == 100)
expect_true(all(order(x) == order(res)) |
all(order(x) == rev(order(res))))
})
test_that("it errors when passed in nothing", {
expect_error(reduce_pca(NULL))
expect_error(reduce_pca(NA))
expect_error(reduce_pca())
})
test_that("it can handle matrix with no columns", {
mat <- matrix(0, 10, 10)
res <- reduce_pca(mat[,numeric(0)])
expect_true(length(res) == 10)
expect_true(all(res == 0))
})
###########
## test .isValid_reduction()
test_that("it errors when x is not an BrcFmri",{
expect_error(.isValid_reduction(mri$parcellation, mri$parcellation))
})
test_that("it errors when y is not a parcellation", {
expect_error(.isValid_reduction(mri, mri))
})
test_that("it errors when fmri and parcellation don't match in dimension", {
mat.big <- matrix(5, nrow = 2, ncol = 27)
mri.big <- BrcFmri(data2d = mat.big, id = "03",
parcellation = BrcParcellation(c(3,3,3), 1:27))
expect_error(.isValid_reduction(mri, mri.big$parcellation))
})
test_that("works as normal", {
expect_true(.isValid_reduction(mri, mri$parcellation))
expect_true(.isValid_reduction(mri, parcellation))
})
test_that("errors if mri is not valid", {
mri.fake <- mri
mri.fake$data2d <- mri.fake$data2d[,1:3]
expect_error(.isValid_reduction(mri.fake, parcellation))
})
test_that("errors if parcellation is not valid", {
parcellation.fake <- parcellation
parcellation.fake$dim3d <- c(3,2,2)
expect_error(.isValid_reduction(mri, parcellation.fake))
})
########################
## test .reduceFmritoParcellation()
test_that("it returns a matrix", {
expect_true(is.matrix(.reduceFmritoParcellation(mri, parcellation,
reduce_mean)))
})
test_that("it returns a matrix even when the parcellation is one partition", {
parcellation2 <- BrcParcellation(c(2,2,2), rep(1,8))
expect_true(is.matrix(.reduceFmritoParcellation(mri, parcellation2,
reduce_mean)))
})
test_that("it turns a vector of 0's when there is no overlap", {
parcellation2 <- BrcParcellation(c(2,2,2), c(1,1,0,0,0,0,0,0))
res <- .reduceFmritoParcellation(mri, parcellation2, reduce_mean)
expect_true(is.matrix(res))
expect_true(length(res) == 2)
expect_true(all(res == 0))
})
test_that("it returns a matrix for 1-time series fmri, 2 partitions", {
parcellation2 <- BrcParcellation(c(2,2,2), c(rep(1,4), rep(2,4)))
expect_true(is.matrix(.reduceFmritoParcellation(mri2, parcellation2,
reduce_mean)))
})
test_that("it returns a matrix for 1-time series fmri, 1 partition", {
parcellation2 <- BrcParcellation(c(2,2,2), rep(1,8))
expect_true(is.matrix(.reduceFmritoParcellation(mri2, parcellation2,
reduce_mean)))
})
test_that("it returns a matrix for 1-time series, no overlap", {
parcellation2 <- BrcParcellation(c(2,2,2), c(1,1,0,0,0,0,0,0))
res <- .reduceFmritoParcellation(mri2, parcellation2, reduce_mean)
expect_true(is.matrix(res))
expect_true(length(res) == 1)
expect_true(all(res == 0))
})
test_that("it returns a column of all 0's if no overlap", {
parcellation2 <- BrcParcellation(c(2,2,2), c(1,2,0,0,3,3,3,3))
res <- .reduceFmritoParcellation(mri, parcellation2, reduce_mean)
expect_true(all(res[,1:2] == 0))
})
test_that("it does not apply func to empty voxels", {
parcellation2 <- BrcParcellation(c(2,2,2), c(1,2,0,0,2,2,2,2))
res <- .reduceFmritoParcellation(mri, parcellation2, reduce_mean)
expect_true(all(res[,2] == c(mean(c(3,3,5,7)), mean(c(4,4,6,8)))))
})
test_that("it errors when passed a bad function", {
parcellation2 <- BrcParcellation(c(2,2,2), c(1,1,0,0,0,0,0,0))
expect_error(.reduceFmritoParcellation(mri, parcellation2, mean))
})
########################
## test reduce()
test_that("it returns a valid BrcFmri", {
res <- reduce(mri, parcellation)
expect_true(isValid(res))
})
test_that("it gets the same thing when reduce onto itself", {
res <- reduce(mri, mri$parcellation)
expect_true(all(mri$data2d == res$data2d))
expect_true(mri$id == res$id)
expect_true(all(mri$parcellation$partition == res$parcellation$partition))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.