tests/testthat/test-consensus_combine.R

In diceR: Diverse Cluster Ensemble in R

skip_if_not_installed("apcluster")

set.seed(911)
x <- matrix(rnorm(300), nrow = 100)
CC1 <- consensus_cluster(x, nk = 2:4, reps = 5, algorithms = "ap",
                         progress = FALSE)
CC2 <- consensus_cluster(x, nk = 2:4, reps = 5, algorithms = "gmm",
                         progress = FALSE)
CC3 <- consensus_cluster(x, nk = 2:4, reps = 5, algorithms = "hc",
                         progress = FALSE)
ref.cl <- sample(1:4, 100, replace = TRUE)

test_that("combining results has expected lengths", {
  y1 <- consensus_combine(CC1, CC2, element = "matrix")
  y2 <- consensus_combine(CC1, CC2, element = "class")
  expect_length(unlist(y1, recursive = FALSE),
                prod(dim(CC1)[3:4]) + prod(dim(CC2)[3:4]))
  expect_equal(ncol(data.frame(y2)), prod(dim(CC1)[3:4]) + prod(dim(CC2)[3:4]))
})

test_that("evaluation works with reference class and can plot", {
  cons.cl <- matrix(sample(1:4, 400, replace = TRUE), ncol = 4,
                    dimnames = list(NULL, LETTERS[1:4]))
  expect_length(consensus_evaluate(x, CC1, CC2, cons.cl = cons.cl,
                                   ref.cl = ref.cl, plot = TRUE),
                5)
})

test_that("there are different ways to choose k", {
  expect_error(consensus_evaluate(x, CC1, CC2, k.method = "all"), NA)
  expect_error(consensus_evaluate(x, CC1, CC2, k.method = 3), NA)
  expect_error(consensus_evaluate(x, CC1, CC2, k.method = 2:3))
})

test_that("compactness measure works with singleton clusters", {
  ref.cl <- c(sample(1:3, 99, replace = TRUE), 4)
  expect_error(compactness(x, ref.cl), NA)
})

test_that("trimming (potentially) removes algorithms", {
  CC.trimmed <- consensus_evaluate(x, CC1, CC2, ref.cl = ref.cl, n = 1,
                                   trim = TRUE)$trim.obj$E.new
  expect_lte(dim(CC.trimmed[[1]])[3],
             dim(abind::abind(list(CC1, CC2), along = 3))[3])
})

test_that("reweighing (potentially) replicates each slice of algorithm", {
  CC.trimmed1 <- consensus_evaluate(x, CC1, CC2, ref.cl = ref.cl,
                                    trim = TRUE, reweigh = TRUE,
                                    k.method = "all")
  CC.trimmed2 <- consensus_evaluate(x, CC1, CC2, CC3, ref.cl = ref.cl,
                                    trim = TRUE, reweigh = TRUE, n = 2)
  expect_error(CC.trimmed1, NA)
  expect_error(CC.trimmed2, NA)
})