tests/testthat/test_CdfsPdfs.R

In TauStar: Efficient Computation and Testing of the Bergsma-Dassios Sign Covariance

library(TauStar)
context("Testing the CDFs and PDFs.")

simulateDensityAndTailProbs <- function(rDist, n, x = seq(-1.1, 4, length = 20)) {
  vals <- rDist(n)
  lowerTailProbs <- numeric(length(x))
  for (i in 1:length(x)) {
    lowerTailProbs[i] <- mean(vals <= x[i])
  }
  return(list(
    density = density(vals, from = -1.1, to = 4),
    lowerTailProbs = lowerTailProbs,
    x = x
  ))
}

read.matrix <- function(file) {
  return(read.table(file, sep = ",", as.is = TRUE))
}

# Need to supress some warnings during these tests
suppressWarnings({
  test_that("pHoeffInd function returns correct values", {
    # Comparing against the values given by the BKR paper
    bkrToHoeff <- function(x) {
      return(as.numeric(pHoeffInd(72 / pi^4 * x - 1, 10^-6)))
    }

    expect_equal(.00000, bkrToHoeff(.3), tolerance = 10^-5)
    expect_true(abs(.04867 - bkrToHoeff(.6)) < 10^-5)
    expect_equal(.29652, bkrToHoeff(.9), tolerance = 10^-5)
    expect_equal(.54354, bkrToHoeff(1.2), tolerance = 10^-5)
    expect_equal(.70763, bkrToHoeff(1.5), tolerance = 10^-5)
    expect_equal(.80922, bkrToHoeff(1.8), tolerance = 10^-5)
    expect_equal(.86406, bkrToHoeff(2.05), tolerance = 10^-5)
    expect_equal(.98546, bkrToHoeff(3.9), tolerance = 10^-5)
    expect_equal(.98965, bkrToHoeff(4.2), tolerance = 10^-5)
    expect_equal(.99261, bkrToHoeff(4.5), tolerance = 10^-5)
    expect_equal(.99471, bkrToHoeff(4.8), tolerance = 10^-5)
    expect_equal(.99994, bkrToHoeff(9), tolerance = 10^-5)

    expect_equal(.95, bkrToHoeff(2.844), tolerance = 10^-4)
    expect_equal(.99, bkrToHoeff(4.230), tolerance = 10^-5)
    expect_equal(.995, bkrToHoeff(4.851), tolerance = 10^-5)

    # Just some sanity checks
    expect_true(abs(pHoeffInd(-2) - 0) < 10^-5)
    expect_true(abs(pHoeffInd(10) - 1) < 10^-6)
  })

  test_that("dHoeffInd function returns correct values", {
    # Comparing against the values given by the BKR paper
    empDens <- read.matrix("contDensityData.csv")
    set.seed(2341)
    inds <- sample(nrow(empDens), 5)
    for (i in 1:length(inds)) {
      expect_true(abs(empDens[inds[i], 2] -
        dHoeffInd(empDens[inds[i], 1], 1 / 2 * 10^-3)) < 5 * 10^-3)
    }
  })

  test_that("pDisHoeffInd function returns correct values", {
    # Bernoulli case
    p <- 2 / 3
    q <- 1 / 4
    coef <- 4 * p * q * (1 - p) * (1 - q)
    for (x in seq(-.2, 4, length = 10)) {
      expect_equal(as.numeric(pDisHoeffInd(x, c(p, 1 - p), c(q, 1 - q), 10^-4)),
        pchisq(x / coef + 1, 1),
        tolerance = 10^-3
      )
    }
    lowerTailProbsMat <- read.matrix("disLowerTailProbs.csv")
    p <- c(0.19556498, 0.2431002, 0.10629372, 0.21154617, 0.03182509, 0.21166985)
    q <- c(0.34460139, 0.29669263, 0.11664926, 0.24205672)
    for (i in 1:nrow(lowerTailProbsMat)) {
      expect_true(abs(lowerTailProbsMat[i, 2] -
        pDisHoeffInd(lowerTailProbsMat[i, 1], p, q)) < 10^-4)
    }
  })

  test_that("dDisHoeffInd function returns correct values", {
    # Bernoulli case
    p <- 2 / 3
    q <- 1 / 4
    coef <- 4 * p * q * (1 - p) * (1 - q)
    for (x in seq(-.2, 4, length = 10)) {
      expect_true(abs(as.numeric(dDisHoeffInd(x, c(p, 1 - p), c(q, 1 - q))) -
        1 / coef * dchisq(x / coef + 1, 1)) < 5 * 10^-3)
    }

    empDens <- read.matrix("disDensityData.csv")
    p <- c(0.19556498, 0.2431002, 0.10629372, 0.21154617, 0.03182509, 0.21166985)
    q <- c(0.34460139, 0.29669263, 0.11664926, 0.24205672)
    set.seed(23784)
    inds <- sample(nrow(empDens), 5)
    for (i in 1:length(inds)) {
      expect_true(abs(empDens[inds[i], 2] -
        dDisHoeffInd(empDens[inds[i], 1], p, q)) < 5 * 10^-3)
    }
  })

  test_that("pMixHoeffInd function returns correct values", {
    lowerTailProbsMat <- read.matrix("mixLowerTailProbs.csv")
    p <- c(0.19556498, 0.2431002, 0.10629372, 0.21154617, 0.03182509, 0.21166985)
    set.seed(29923)
    for (i in 1:nrow(lowerTailProbsMat)) {
      expect_true(abs(lowerTailProbsMat[i, 2] -
        pMixHoeffInd(lowerTailProbsMat[i, 1], p)) < 10^-3)
    }
  })

  test_that("dMixHoeffInd function returns correct values", {
    empDens <- read.matrix("mixDensityData.csv")
    p <- c(0.19556498, 0.2431002, 0.10629372, 0.21154617, 0.03182509, 0.21166985)
    set.seed(434)
    inds <- sample(nrow(empDens), 5)
    for (i in 1:length(inds)) {
      expect_true(abs(empDens[inds[i], 2] -
        dMixHoeffInd(empDens[inds[i], 1], p)) < 10^-2)
    }
  })
})