tests/testthat/test-test-cpit.R

In tnagler/vinereg: D-Vine Quantile Regression

context("cpit()")

# simulate data
set.seed(3)
x <- matrix(rnorm(30), 10, 3)
y <- x %*% c(1, -1, 2)
dat <- data.frame(y = y, x = x, z = as.factor(rbinom(10, 3, 0.5)))
fit <- vinereg(y ~ ., family = "gauss", dat)

test_that("catches missing variables", {
  expect_error(cpit(fit, dat[1:2]))
})

test_that("catches incorrect type", {
  dat[2] <- ordered(1:10)
  expect_error(cpit(fit, dat))
})

test_that("catches incorrect levels", {
  levels(dat[[5]]) <- 1:50
  expect_error(cpit(fit, dat))
})

test_that("works in bivariate case", {
  fit <- vinereg(y ~ ., dat[1:2])
  expect_silent(cpit(fit, dat[1:2]))
})

test_that("works with continuous response", {
  expect_gt(ks.test(cpit(fit, dat), "punif")$p, 0.01)
})

test_that("works with discrete response", {
  dat$y <- as.ordered(dat$y)
  fit <- vinereg(y ~ ., dat, fam = "tll")
  expect_silent(cpit(fit, dat))
})

test_that("works on uscale", {
  dat[] <- runif(nrow(dat) * ncol(dat))
  fit <- vinereg(y ~ ., dat, uscale = TRUE)
  p <- cpit(fit, dat)
  expect_true(all(p >= 0 & p <= 1))
})


context("cll()")

# simulate data
set.seed(3)
x <- matrix(rnorm(30), 10, 3)
y <- x %*% c(1, -1, 2)
dat <- data.frame(y = y, x = x, z = as.factor(rbinom(10, 3, 0.5)))
fit <- vinereg(y ~ ., family = "gauss", dat)

test_that("catches missing variables", {
  expect_error(cll(fit, dat[1:2]))
})

test_that("catches incorrect type", {
  dat[2] <- ordered(1:10)
  expect_error(cll(fit, dat))
})

test_that("catches incorrect levels", {
  levels(dat[[5]]) <- 1:50
  expect_error(cll(fit, dat))
})

test_that("works in bivariate case", {
  fit <- vinereg(y ~ ., dat[1:2])
  expect_equal(cll(fit, dat[1:2]), fit$stats$cll)
})

test_that("works with continuous response", {
  expect_equal(cll(fit, dat), fit$stats$cll, 0.1)
})

test_that("works with discrete response", {
  dat$y <- as.ordered(round(dat$y))
  fit <- vinereg(y ~ ., dat, fam = "gauss")
  expect_equal(cll(fit, dat), fit$stats$cll, 5) # very lenient for now
})

test_that("works on uscale", {
  dat[] <- runif(nrow(dat) * ncol(dat))
  fit <- vinereg(y ~ ., dat, uscale = TRUE)
  expect_equal(cll(fit, dat), fit$stats$cll)
})