Nothing
#context("GEV functions")
# We check the functions pgev, qgev and rgev.
# Set a tolerance for the comparison of the simulated values
my_tol <- 1e-5
# 1. Check that calling qgev with probabilities p and then calling pgev with
# the results gets us back to the initial probabilities.
pqgev_test_fn <- function(x, p) {
loc <- x[1]
scale <- x[2]
shape <- x[3]
qs <- qgev(p = p, loc = loc, scale = scale, shape = shape)
ps <- pgev(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("gev shape = ", par_vals[i, 3])
x <- pqgev_test_fn(x = par_vals[i, ], p = p_vals)
test_function(x, test_string)
}
# 2. Check that calling rgev and then pgev with the results gets us back to
# the random U(0,1) variates simulated by stats::runif.
seed <- 28082017
rqgev_test_fn <- function(x) {
loc <- x[, 1]
scale <- x[, 2]
shape <- x[, 3]
n <- length(loc)
set.seed(seed)
qs <- rgev(n = n, loc = loc, scale = scale, shape = shape)
set.seed(seed)
us <- stats::runif(length(loc))
ps <- pgev(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 <- "rgev and pgev"
x <- rqgev_test_fn(x = par_vals)
test_function(x, test_string)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.