tests/testthat/test-partitions.R

In skgallagher/TBornotTB: Analyze Tuberculosis Patients in Maryland

test_that("generate_parts", {
  n <- 1
  out <- generate_parts(n)
  expect_equal(class(out), "list")
  expect_equal(as.numeric(out[[1]]), 1)
  expect_equal(colSums(out[[1]]), n)
  expect_equal(nrow(out[[1]]), 1)
  expect_equal(class(out[[1]]), "matrix")

  ###
  n <- 10
  out <- generate_parts(n)
  expect_equal(class(out), "list")
  expect_equal(length(out), n)
  for(ii in 1:n){
    expect_equal(unique(colSums(out[[ii]])), n)
    expect_equal(nrow(out[[ii]]), ii)
    expect_equal(class(out[[ii]]), "matrix")
  }

  n <- 5
  out <- generate_parts(n)
  expect_equal(ncol(out[[3]]), 6)

  n <- 8
  out <- generate_parts(n)
  expect_equal(ncol(out[[3]]), 21)
  expect_equal(ncol(out[[4]]), 35)


  n <- 5
  out <- generate_parts(n, verbose = FALSE)
  wts <- sapply(out, ncol)
  prob <- wts / sum(wts)
  mu <- sum(1:n * prob)
  sd <- sum((1:n)^2 * prob) - mu^2
  plot(1:n, prob, xlab = "Number of Generations",
       ylab = "Prob", main = paste(n, "people"))
  x <- seq(1, n, by =.05)
  y <- dnorm(x, mean = mu, sd = sqrt(sd))
  lines(x,y)
  legend("topright", lty = 1, legend = paste0("N(", mu, ",", sd, ")"))
})


test_that("generate_part_list", {
  n <- 5
  out <- generate_part_list(n, verbose = FALSE)
  expect_equal(length(out), n)
  expect_equal(length(out[[3]]), 3)

  ## Generate list of 25
 # part_list_25 <- generate_part_list(25, verbose = TRUE)
 # sl <- object.size(part_list_25)
 # print(sl, units = "auto")


})


test_that("get_weight_list", {
  n <- 5
  part_list <- generate_part_list(n, verbose = FALSE)

  out <- get_weight_list(part_list)
  expect_equal(length(out), n)
  expect_equal(sapply(out, function(ll) length(ll)), 1:n)


})


test_that("testing rcppAlgos compatibility", {

  n <- 15
  m <- 8
  parts <- partitions::restrictedparts(n = n, m = m,
                                       include.zero = FALSE)
  parts1 <- matrix(unlist(apply(parts, 2, unique_perm)),
                            nrow = m)
  parts2 <-   t(do.call('rbind',
                        plyr::alply(.data = parts, .margins = 2,
                                             .fun = function(v){
   RcppAlgos::permuteGeneral(v = sort(unique(v)), m = m, freqs = table(v))
  })))

  expect_equal(dim(parts1), dim(parts2))


})