tests/testthat/tests_samplers.R

In polykde: Polyspherical Kernel Density Estimation

# Randomize testing
r <- 2 # sample(1:3, size = 1)
d <- rep(2, 2) # rpois(r, 2) + 1
h <- runif(r, 0.25, 0.50)
mu <- r_unif_polysph(n = 1, d = d)
X <- r_kern_polysph(n = 10, d = d, mu = mu, h = rep(0.2, r), kernel = 1)
n <- 300

test_that("r_unif_polysph", {

  ind <- cumsum(c(1, d + 1))
  for (j in seq_len(r)) {
    ind_j <- ind[j]:(ind[j + 1] - 1)
    pval <- sphunif::unif_test(data = r_unif_polysph(n = n, d = d)[, ind_j],
                               type = "Bingham")$p.value
    expect_gt(pval, 0.01)
  }

})

test_that("Check r_kern_polysph", {

  ind <- cumsum(c(1, d + 1))
  for (kernel in 1:2) {
    data <- r_kern_polysph(n = n, d = d, mu = mu, h = h, kernel = kernel)
    for (j in seq_len(r)) {
      ind_j <- ind[j]:(ind[j + 1] - 1)
      pval <- sphunif::unif_test(data = data[, ind_j],
                                 type = "Bingham")$p.value
      expect_lt(pval, 0.10)
    }
  }

})

test_that("Check r_kern_polysph by inverse weighted sampling", {

  h <- c(2, 2)
  for (kernel in 1:3) {

    data <- r_kern_polysph(n = n, d = d, mu = mu, h = h, kernel = kernel,
                           kernel_type = 1)
    dens <- kde_polysph(x = data, X = mu, d = d, h = h, kernel = kernel,
                        kernel_type = 1)
    inv_dens <- 1 / dens
    expect_equal(mean(inv_dens[is.finite(inv_dens)]) /
                   prod(rotasym::w_p(p = d + 1)), 1,
                 tolerance = 1e-1)

  }

})

test_that("Check r_kern_polysph by inverse weighted sampling", {

  h <- c(2, 2)
  for (kernel in 1:3) {

    data <- r_kern_polysph(n = n, d = d, mu = mu, h = h, kernel = kernel,
                           kernel_type = 2)
    dens <- kde_polysph(x = data, X = mu, d = d, h = h, kernel = kernel,
                        kernel_type = 2)
    inv_dens <- 1 / dens
    expect_equal(mean(inv_dens[is.finite(inv_dens)]) /
                   prod(rotasym::w_p(p = d + 1)), 1,
                 tolerance = 1e-1)

  }

})

test_that("Check coherency between kde_polysph(), c_kern(), and L()", {

  for (kernel in 1:3) {

    data <- r_kern_polysph(n = n, d = d, mu = mu, h = h, kernel = 1)
    dens1 <- kde_polysph(x = data, X = mu, d = d, h = h, kernel = kernel,
                         kernel_type = 1)
    dens2 <- prod(c_kern(h = h, d = d, kernel = kernel, kernel_type = 1)) *
      L((1 - data[, 1:3] %*% mu[1:3]) / h[1]^2, kernel = kernel) *
      L((1 - data[, 4:6] %*% mu[4:6]) / h[2]^2, kernel = kernel)
    expect_equal(dens1, dens2, tolerance = 1e-2)

    dens1 <- kde_polysph(x = data, X = mu, d = d, h = h, kernel = kernel,
                         kernel_type = 2)
    dens2 <- c_kern(h = h, d = d, kernel = kernel, kernel_type = 2) *
      L((1 - data[, 1:3] %*% mu[1:3]) / h[1]^2 +
          (1 - data[, 4:6] %*% mu[4:6]) / h[2]^2, kernel = kernel)
    expect_equal(dens1, dens2, tolerance = 1e-2)

  }

})