tests/testthat/test-hcsvd.R

In bdsvd: Block Structure Detection Using Singular Vectors

require(mvtnorm)
set.seed(1)
Rho <- hcsvd.cor.sim(p = 40, b = 5, design = "a")
X <- scale(rmvnorm(500, mean = rep(0, 40), sigma = Rho, checkSymmetry = FALSE))
R <- cor(X)

cluster.5  <- rep(1:5,  each = 8)
cluster.10 <- rep(1:10, times = ifelse(1:10 %in% seq(1, 10, 2), 6, 2))
cluster.15 <- rep(1:15, times = ifelse(1:15 %in% seq(1, 15, 3), 4, 2))
cluster.20 <- rep(1:20, each = 2)

hcsvd.obj <- hcsvd(R, q = "Kaiser", linkage = "single")
hc <- hcsvd.obj$hclust

test_that("hcsvd cluster detection works for single linkage and design (a)",{
  expect_equal(as.vector(cutree(hc, k =  5)), cluster.5)
  expect_equal(as.vector(cutree(hc, k = 10)), cluster.10)
  expect_equal(as.vector(cutree(hc, k = 15)), cluster.15)
  expect_equal(as.vector(cutree(hc, k = 20)), cluster.20)
})

hcsvd.obj <- hcsvd(R, q = "Kaiser", linkage = "average")
hc <- hcsvd.obj$hclust

test_that("hcsvd cluster detection works for average linkage and design (a)",{
  expect_equal(as.vector(cutree(hc, k =  5)), cluster.5)
  expect_equal(as.vector(cutree(hc, k = 10)), cluster.10)
  expect_equal(as.vector(cutree(hc, k = 15)), cluster.15)
  expect_equal(as.vector(cutree(hc, k = 20)), cluster.20)
})




set.seed(1)
Rho <- hcsvd.cor.sim(p = 60, b = 20, design = "b")
X <- scale(rmvnorm(500, mean = rep(0, 60), sigma = Rho, checkSymmetry = FALSE))
R <- cor(X)

cluster.20 <- rep(1:20, each = (3))
cluster.40 <- rep(1:40, times = ifelse(1:40 %in% seq(1, 39, 2), 2, 1))

hcsvd.obj <- hcsvd(R, q = "Kaiser", linkage = "single")
hc <- hcsvd.obj$hclust

test_that("hcsvd cluster detection works for single linkage and design (b)",{
  expect_equal(as.vector(cutree(hc, k = 20)), cluster.20)
  expect_equal(as.vector(cutree(hc, k = 40)), cluster.40)
})

hcsvd.obj <- hcsvd(R, q = "Kaiser", linkage = "average")
hc <- hcsvd.obj$hclust

test_that("hcsvd cluster detection works for average linkage and design (b)",{
  expect_equal(as.vector(cutree(hc, k = 20)), cluster.20)
  expect_equal(as.vector(cutree(hc, k = 40)), cluster.40)
})