tests/testthat/test-dice.R

library(dplyr)
data(hgsc)
ref.cl <- strsplit(rownames(hgsc), "_") %>%
  purrr::map_chr(2) %>%
  factor() %>%
  as.integer()

test_that("dice works with one algorithm, one consensus funs", {
  dice.obj <- dice(hgsc, nk = 4, algorithms = "hc", cons.funs = "kmodes")
  expect_length(dice.obj, 5)
  expect_equal(dim(dice.obj$clusters), c(nrow(hgsc), 1))
})

test_that("dice works with multiple algorithms, consensus funs, trimming, and
          reference class", {
  dice.obj <- dice(hgsc, nk = 4, reps = 5,
                   algorithms = c("hc", "diana"),
                   cons.funs = c("kmodes", "majority"),
                   trim = TRUE, n = 2, ref.cl = ref.cl)
  expect_length(dice.obj, 5)
  expect_is(dice.obj$clusters, "matrix")
})

test_that("single algorithm and single consensus return same results", {
  dice.obj <- dice(hgsc, nk = 4, reps = 5, algorithms = "km",
                   cons.funs = "CSPA", ref.cl = ref.cl)
  ind.obj <- dice.obj$indices$ei$`4`
  expect_equal(unname(unlist(ind.obj[1, -1])), unname(unlist(ind.obj[2, -1])))
})

test_that("indices slot returns NULL if evaluate specified as FALSE", {
  dice.obj <- dice(hgsc, nk = 4, reps = 3, algorithms = "hc",
                   cons.funs = "kmodes", ref.cl = ref.cl, evaluate = FALSE)
  expect_null(dice.obj$indices)
})

test_that("relabelling uses 1st col if more than 1 cons.funs and no ref.cl", {
  dice.obj <- dice(hgsc, nk = 4, reps = 3, algorithms = "hc",
                   cons.funs = c("kmodes", "majority"), evaluate = FALSE)
  expect_error(dice.obj, NA)
})

test_that("cluster size prepended when multiple k requested", {
  dice.obj <- dice(hgsc, nk = 3:4, reps = 3, algorithms = "hc",
                   cons.funs = "kmodes", k.method = "all", evaluate = FALSE)
  expect_true(all(grepl("k=", colnames(dice.obj$clusters))))
})

test_that("algorithm vs internal index heatmap works", {
  dice.obj <- dice(hgsc, nk = 4, reps = 3, algorithms = "hc",
                   cons.funs = "kmodes", ref.cl = ref.cl, evaluate = FALSE,
                   plot = TRUE)
  expect_error(dice.obj, NA)
})

Try the diceR package in your browser

Any scripts or data that you put into this service are public.

diceR documentation built on May 29, 2024, 8:54 a.m.