#--- tests for student distribution --------------------------------------------
## require(TMB)
## require(numDeriv)
## require(testthat)
## model <- "pt" # this one works
## model <- "test_student" # testing
## compile(paste0(model, ".cpp"), PKG_CXXFLAGS = "-std=gnu++11")
## dyn.load(dynlib(model))
#--- pt ------------------------------------------------------------------------
# TODO: change test so that it systematically checks all cases.
test_that("pt gives same value in R and TMB", {
ntest <- 100
sim_arg <- function(n) {
x <- sample(c(1, 10, 100), n, replace = TRUE) + rnorm(n)
sample(c(-1, 1), n, replace = TRUE) * x
}
for(ii in 1:ntest) {
n <- sample(c(1, 2, 10), 1)
pt_adf <- TMB::MakeADFun(data = list(model = "pt"),
parameters = list(q = rep(0, n), df = rep(1, n)),
silent = TRUE,
DLL = "LocalCop_TMBExports")
q <- sim_arg(n)
df <- abs(sim_arg(n))
p_tmb <- pt_adf$fn(c(q, df))
## suppressWarnings({
p_r <- sum(pt(q, df))
## })
expect_equal(p_r, p_tmb)
}
})
#--- qt ------------------------------------------------------------------------
test_that("qt gives same value in R and TMB", {
ntest <- 100
sim_arg <- function(n) {
x <- sample(c(1, 10, 100), n, replace = TRUE) + rnorm(n)
sample(c(-1, 1), n, replace = TRUE) * x
}
error <- function(x1, x2) {
abs(x1 - x2)/(.5 * abs(x1 + x2) + .1)
}
for(ii in 1:ntest) {
n <- sample(c(1, 2, 10), 1)
qt_adf <- TMB::MakeADFun(data = list(model = "qt"),
parameters = list(p = rep(.5, n), df = rep(1, n)),
silent = TRUE)
p <- runif(n)
df <- abs(sim_arg(n))
q_tmb <- qt_adf$fn(c(p, df))
## suppressWarnings({
q_r <- sum(qt(p, df))
## })
expect_equal(error(q_r, q_tmb) < 1e-10, TRUE)
}
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.