tests/testthat/test-discrete-custom-TS-signatures.R

In MDgof: Various Methods for the Goodness-of-Fit Problem in D>1 Dimensions

test_that("discrete custom TS accepts a matrix alone or matrix plus TSextra", {
  grid <- expand.grid(x=0:1, y=0:1)
  d <- cbind(x=grid$x, y=grid$y, counts=c(10, 12, 8, 11))

  pnull <- function(z) {
    if(!is.matrix(z)) z <- rbind(z)
    apply(z, 1, function(v) pbinom(v[1], 1, 0.5) * pbinom(v[2], 1, 0.5))
  }
  rnull <- function() d

  TS1 <- function(x) c(Custom=sum(x[, 3]))
  z1 <- gof_test(d, pnull, rnull, TS=TS1, B=0)
  expect_s3_class(z1, "MDgof_test")
  expect_equal(unname(z1$statistics["Custom"]), sum(d[, 3]))

  TS2 <- function(x, TSextra) c(Custom=sum(x[, 3]) * TSextra$scale)
  z2 <- gof_test(d, pnull, rnull, TS=TS2, TSextra=list(scale=2), B=0)
  expect_equal(unname(z2$statistics["Custom"]), 2 * sum(d[, 3]))
})

test_that("discrete custom TS simple signatures work in power", {
  grid <- expand.grid(x=0:1, y=0:1)
  make_data <- function(k=0)
    cbind(x=grid$x, y=grid$y, counts=c(10+k, 12, 8, 11))

  pnull <- function(z) {
    if(!is.matrix(z)) z <- rbind(z)
    apply(z, 1, function(v) pbinom(v[1], 1, 0.5) * pbinom(v[2], 1, 0.5))
  }
  rnull <- function() make_data(0)
  ralt <- function(k) make_data(k)

  TS1 <- function(x) c(Custom=sum(x[, 3]^2))
  p1 <- gof_power(pnull, rnull, ralt, 0, TS=TS1, B=2, maxProcessor=1)
  expect_true(is.numeric(p1) || is.matrix(p1))

  TS2 <- function(x, TSextra) c(Custom=sum(x[, 3]^2) * TSextra$scale)
  p2 <- gof_power(pnull, rnull, ralt, 0, TS=TS2, TSextra=list(scale=2),
                  B=2, maxProcessor=1)
  expect_true(is.numeric(p2) || is.matrix(p2))
})