tests/testthat/test-gp.R

#context("GP functions")

# We check the functions pgp, qgp and rgp.

# Set a tolerance for the comparison of the simulated values
my_tol <- 1e-5

# 1. Check that calling qgp with probabilities p and then calling pgp with
#    the results gets us back to the initial probabilities.

pqgp_test_fn <- function(x, p) {
  loc <- x[1]
  scale <- x[2]
  shape <- x[3]
  qs <- qgp(p = p, loc = loc, scale = scale, shape = shape)
  ps <- pgp(qs, loc = loc, scale = scale, shape = shape)
  return(list(p = p, ps = ps))
}

test_function <- function(x, test_string) {
  testthat::test_that(test_string, {
    testthat::expect_equal(x$p, x$ps, tolerance = my_tol)
  })
}

ep <- 1e-10
loc_check <- 0
scale_check <- 2
shape_check <- c(-1, -0.5, -0.1, -ep, 0, ep, 0.1, 0.5, 1)
par_vals <- cbind(loc_check, scale_check, shape_check)
p_vals <- c(0.01, 0.1, 0.5, 0.9, 0.99)
for (i in 1:nrow(par_vals)) {
  test_string <- paste("GP shape = ", par_vals[i, 3])
  x <- pqgp_test_fn(x = par_vals[i, ], p = p_vals)
  test_function(x, test_string)
}

# 2. Check that calling rgp and then pgp with the results gets us back to
#    the random U(0,1) variates simulated by stats::runif.

seed <- 28082017

rqgp_test_fn <- function(x) {
  loc <- x[, 1]
  scale <- x[, 2]
  shape <- x[, 3]
  n <- length(loc)
  set.seed(seed)
  qs <- rgp(n = n, loc = loc, scale = scale, shape = shape)
  set.seed(seed)
  us <- stats::runif(length(loc))
  ps <- pgp(qs, loc = loc, scale = scale, shape = shape)
  return(list(us = us, ps = ps))
}

test_function <- function(x, test_string) {
  testthat::test_that(test_string, {
    testthat::expect_equal(x$us, x$ps, tolerance = my_tol)
  })
}

ep <- 1e-10
loc_check <- 0
scale_check <- 2
shape_check <- c(-1, -0.5, -0.1, -ep, 0, ep, 0.1, 0.5, 1)
par_vals <- cbind(loc_check, scale_check, shape_check)
test_string <- "rgp and pgp"
x <- rqgp_test_fn(x = par_vals)
test_function(x, test_string)

Try the revdbayes package in your browser

Any scripts or data that you put into this service are public.

revdbayes documentation built on Sept. 10, 2023, 1:07 a.m.