tests/testthat/test_bd.R

In Ball: Statistical Inference and Sure Independence Screening via Ball Statistics

library(testthat)
library(Ball)
context("bd and bd.test function")
skip_on_cran()

test_that("Error if computation result for ball divergence is wrong!", {
  target_value <- 2.4032
  names(target_value) <- "kbd.sum.constant"
  expect_equal(bd(1:15, size = c(5, 5, 5)), target_value)
  expect_equal(bd.test(1:15, size = c(5, 5, 5), num.permutations = 0), target_value)
})


# test abnormal is not necessary. 
# If there exist any abnormal values, .C function will return detailed error message
test_that("Error if input data contain abnormal values", {
  x1 <- rnorm(20)
  x2 <- rnorm(20)
  x1[1] <- NA
  expect_error(bd.test(x1, x2))
  x1[1] <- Inf
  expect_error(bd.test(x1, x2))
})


test_that("bd, bd.test function return unmatched ball divergence statistic", {
  dat <- lapply(rep(50, 3), function(i) {
    rnorm(i)
  })
  res1 <- bd(dat, kbd.type = "sum")
  res2 <- bd(dat, kbd.type = "max")
  res3 <- bd(dat, kbd.type = "maxsum")
  expect_equal(names(res1), "kbd.sum.constant")
  expect_equal(names(res2), "kbd.max.constant")
  expect_equal(names(res3), "kbd.maxsum.constant")
  
  res1 <- bd.test(dat, kbd.type = "sum")
  res2 <- bd.test(dat, kbd.type = "max")
  res3 <- bd.test(dat, kbd.type = "maxsum")
  expect_equal(names(res1[["statistic"]]), "kbd.sum.constant")
  expect_equal(names(res2[["statistic"]]), "kbd.max.constant")
  expect_equal(names(res3[["statistic"]]), "kbd.maxsum.constant")
  
  expect_equal(names(res1[["p.value"]]), "kbd.sum.constant.pvalue")
  expect_equal(names(res2[["p.value"]]), "kbd.max.constant.pvalue")
  expect_equal(names(res3[["p.value"]]), "kbd.maxsum.constant.pvalue")
})


test_that("Multi-thread computation via permutation for univariate K-sample problem", {
  set.seed(1)
  n1 <- 100
  n2 <- 100
  n3 <- 100
  x <- rnorm(n1)
  y <- rnorm(n2)
  z <- rnorm(n3)
  fit1 <- bd.test(list(x, y, z), num.permutations = 399, num.threads = 1, seed = 1)
  fit2 <- bd.test(list(x, y, z), num.permutations = 399, num.threads = 2, seed = 1)
  fit3 <- bd.test(list(x, y, z), num.permutations = 399, num.threads = 4, seed = 1)
  expect_equal(fit1[["complete.info"]][["statistic"]], fit2[["complete.info"]][["statistic"]])
  expect_equal(fit1[["complete.info"]][["statistic"]], fit3[["complete.info"]][["statistic"]])
  expect_equal(fit1[["complete.info"]][["p.value"]], fit2[["complete.info"]][["p.value"]])
  expect_equal(fit1[["complete.info"]][["p.value"]], fit3[["complete.info"]][["p.value"]])
})

test_that("Multi-thread computation via permutation for multivariate K-sample problem", {
  set.seed(1)
  X <- matrix(rnorm(100 * 10), ncol = 10)
  Y <- matrix(rnorm(100 * 10), ncol = 10)
  Z <- matrix(rnorm(100 * 10), ncol = 10)
  
  fit1 <- bd.test(list(X, Y, Z), num.permutations = 399, num.threads = 1)
  fit2 <- bd.test(list(X, Y, Z), num.permutations = 399, num.threads = 2)
  fit3 <- bd.test(list(X, Y, Z), num.permutations = 399, num.threads = 4)
  expect_equal(fit1[["complete.info"]][["statistic"]], fit2[["complete.info"]][["statistic"]])
  expect_equal(fit1[["complete.info"]][["statistic"]], fit3[["complete.info"]][["statistic"]])
  expect_equal(fit1[["complete.info"]][["p.value"]], fit2[["complete.info"]][["p.value"]])
  expect_equal(fit1[["complete.info"]][["p.value"]], fit3[["complete.info"]][["p.value"]])
})

test_that("Multi-thread computation via permutation for univariate two-sample problem", {
  n1 <- 200
  n2 <- 200
  x <- rnorm(n1)
  y <- rnorm(n2)
  fit1 <- bd.test(list(x, y), num.permutations = 399, num.threads = 1)
  fit2 <- bd.test(list(x, y), num.permutations = 399, num.threads = 2)
  fit3 <- bd.test(list(x, y), num.permutations = 399, num.threads = 4)
  expect_equal(fit1[["complete.info"]][["statistic"]], fit2[["complete.info"]][["statistic"]])
  expect_equal(fit1[["complete.info"]][["statistic"]], fit3[["complete.info"]][["statistic"]])
  expect_equal(fit1[["complete.info"]][["p.value"]], fit2[["complete.info"]][["p.value"]])
  expect_equal(fit1[["complete.info"]][["p.value"]], fit3[["complete.info"]][["p.value"]])
})

test_that("Multi-thread computation via permutation for multivariate two-sample problem", {
  set.seed(1)
  Y <- matrix(rnorm(100 * 10), ncol = 10)
  X <- matrix(rnorm(100 * 10), ncol = 10)
  fit1 <- bd.test(list(X, Y), num.permutations = 399, num.threads = 1)
  fit2 <- bd.test(list(X, Y), num.permutations = 399, num.threads = 2)
  fit3 <- bd.test(list(X, Y), num.permutations = 399, num.threads = 4)
  expect_equal(fit1[["complete.info"]][["statistic"]], fit2[["complete.info"]][["statistic"]])
  expect_equal(fit1[["complete.info"]][["statistic"]], fit3[["complete.info"]][["statistic"]])
  expect_equal(fit1[["complete.info"]][["p.value"]], fit2[["complete.info"]][["p.value"]])
  expect_equal(fit1[["complete.info"]][["p.value"]], fit3[["complete.info"]][["p.value"]])
})

test_that("output of formula interface is incorrect", {
  dat <- data.frame("x" = rnorm(100), "y" = as.factor(c(0, 1)))
  res1 <- bd.test(x ~ y, data = dat)
  expect_equal(strsplit(res1[["data.name"]], "\n")[[1]][1], "x by y")
})

test_that("Compare the outputs of formula interface and default interface (two-sample)", {
  dat <- data.frame("x" = rnorm(100), "y" = as.factor(c(0, 1)))
  res1 <- bd.test(x ~ y, data = dat)
  res2 <- bd.test(dat[["x"]][seq(1, 100, 2)], dat[["x"]][seq(2, 100, 2)])
  res1[["data.name"]] <- ""
  res2[["data.name"]] <- ""
  expect_equal(res1, res2)
})

test_that("Compare the outputs of formula interface and default interface (K-sample)", {
  res1 <- bd.test(Sepal.Width ~ Species, data = iris)
  iris_list <- split(iris[["Sepal.Width"]], iris[["Species"]])
  res2 <- bd.test(iris_list)
  res1[["data.name"]] <- ""
  res2[["data.name"]] <- ""
  expect_equal(res1, res2)
})