Nothing
# CGGPfit is used in many other tests, so not as many here
context("testfit")
test_that("CGGPfit works with Laplace approx", {
d <- 3
SG <- CGGPcreate(d=d, batchsize=30, corr = "m52")
f <- function(x){x[1]+x[2]^2}
y <- apply(SG$design, 1, f)
# Check some fit input options
expect_error(CGGPfit(SG, Y=as.matrix(y)), NA)
expect_error(CGGPfit(SG, Ynew=as.matrix(y)), NA)
expect_error(CGGPfit(SG, Y=c(y, 1.2)))
# Set theta
expect_error(CGGPfit(SG, Y=y, set_thetaMAP_to = SG$thetaMAP+.1), NA)
# Give theta0
expect_error(CGGPfit(SG, Y=y, theta0 = SG$thetaMAP+.1), NA)
# Change correlation function
expect_error(SG <- CGGPfit(SG, Y=y, corr = "cauchysqt"), NA)
# Check that samples from Laplace are near max
if (F) {
stripchart(as.data.frame(t(SG$thetaPostSamples)))
stripchart(as.data.frame(t(SG$thetaMAP)), add=T, col=2, pch=19)
}
expect_true(all(abs(rowMeans(SG$thetaPostSamples)- SG$thetaMAP) < apply(SG$thetaPostSamples, 1, sd)))
# Check errors in neglogpost
expect_error(CGGP_internal_neglogpost(rep(.5,length(SG$thetaMAP)), SG, y, HandlingSuppData="notanoption"))
expect_error(CGGP_internal_neglogpost(rep(.5,length(SG$thetaMAP)), SG))
expect_error(CGGP_internal_gneglogpost(rep(.5,length(SG$thetaMAP)), SG, y, HandlingSuppData="notanoption"))
expect_error(CGGP_internal_gneglogpost(rep(.5,length(SG$thetaMAP)), SG))
expect_error(neglogpost <- CGGP_internal_gneglogpost(rep(.5,length(SG$thetaMAP)), SG, y), NA)
expect_is(neglogpost, "matrix")
expect_length(neglogpost, length(SG$thetaMAP))
expect_error(neglogpost2 <- CGGP_internal_gneglogpost(rep(.5,length(SG$thetaMAP)), SG, y, return_lik = T), NA)
expect_is(neglogpost2, "list")
expect_length(neglogpost2[[1]], 1)
expect_length(neglogpost2[[2]], length(SG$thetaMAP))
# Check neglogpost grad matches gneglogpost
theta <- SG$thetaMAP / 2 # Don't want values near -1 or +1
epsval <- 1e-4
thetagrad <- CGGP_internal_gneglogpost(theta, SG, SG$y)
for (i in 1:length(SG$thetaMAP)) {
eps <- rep(0, length(SG$thetaMAP))
eps[i] = eps[i] + epsval
numgrad <- (CGGP_internal_neglogpost(theta + eps, SG, SG$y) -
CGGP_internal_neglogpost(theta - eps, SG, SG$y)) / (2*epsval)
expect_equal(thetagrad[i], numgrad, tol=1e-4)
}
if (F) {
# expect_equal(
# c(CGGP_internal_gneglogpost(theta, SG, SG$y)),
# numDeriv::grad(CGGP_internal_neglogpost, theta, CGGP=SG, y=SG$y)
# )
}
# Works with supplementary data
nsup <- 30
xsup <- matrix(runif(nsup*3), nsup, 3)
ysup <- apply(xsup, 1, f)
SG <- CGGPappend(SG, 20)
ynew <- apply(SG$design_unevaluated, 1, f)
expect_error(SG <- CGGPfit(SG, Ynew=ynew, Xs=xsup, Ys=ysup), NA)
# Check neglogpost grad matches gneglogpost for all HandlingSuppData options
theta <- SG$thetaMAP / 2 # Don't want values near -1 or +1
epsval <- 1e-4
for (handling in c("Correct", "Only", "Ignore")) {
thetagrad <- CGGP_internal_gneglogpost(theta, SG, SG$y, Xs=xsup, ys=SG$ys, HandlingSuppData = handling)
numgrad <- rep(0, length(SG$thetaMAP))
for (i in 1:length(SG$thetaMAP)) {
eps <- rep(0, length(SG$thetaMAP))
eps[i] = eps[i] + epsval
# numgrad <- (CGGP_internal_neglogpost(theta + eps, SG, SG$y, Xs=xsup, ys=SG$ys, HandlingSuppData = handling) -
# CGGP_internal_neglogpost(theta - eps, SG, SG$y, Xs=xsup, ys=SG$ys, HandlingSuppData = handling)) / (2*epsval)
numgrad[i] <- (-CGGP_internal_neglogpost(theta + 2*eps, SG, SG$y, Xs=xsup, ys=SG$ys, HandlingSuppData = handling) +
8*CGGP_internal_neglogpost(theta + eps, SG, SG$y, Xs=xsup, ys=SG$ys, HandlingSuppData = handling) -
8*CGGP_internal_neglogpost(theta - eps, SG, SG$y, Xs=xsup, ys=SG$ys, HandlingSuppData = handling) +
CGGP_internal_neglogpost(theta - 2*eps, SG, SG$y, Xs=xsup, ys=SG$ys, HandlingSuppData = handling)) / (12*epsval)
#
# print(numgrad)
}
expect_equal(c(thetagrad), numgrad, tol=1e-2, info = handling)
}
if (F) {
# numDeriv::grad(function(th) {CGGP_internal_neglogpost(th, SG, SG$y, Xs=xsup, ys=SG$ys, HandlingSuppData = handling)}, theta)
}
})
test_that("CGGPfit works with Ynew - scalar output", {
SG <- CGGPcreate(d=3, batchsize=20)
f <- function(x){x[1]+x[2]^2}
y <- apply(SG$design, 1, f)
# Can't give in Y and Ynew
expect_error(SG <- CGGPfit(SG, Y=y, Ynew=y))
# Works with just Ynew
SG <- CGGPfit(SG, Ynew=y)
expect_true(all(!is.na(SG$thetaPostSamples)))
# After append, only give in Ynew
SG <- CGGPappend(SG, 50)
ynew <- apply(SG$design_unevaluated, 1, f)
# Again error if give in Y and Ynew
expect_error(CGGPfit(SG, Y=c(y, ynew), Ynew=ynew))
# Get error when Ynew is wrong size
expect_error(CGGPfit(SG, Ynew=ynew[1:(length(ynew)-1)]))
# Works fine
expect_is(SG <- CGGPfit(SG, Ynew = ynew), "CGGP")
})
test_that("CGGPfit works with Ynew - vector output", {
SG <- CGGPcreate(d=3, batchsize=20)
f1 <- function(x){x[1]+x[2]^2}
f2 <- function(x){x[2]^1.3+sin(2*pi*x[3])}
y1 <- apply(SG$design, 1, f1)
y2 <- apply(SG$design, 1, f2)
y <- cbind(y1, y2)
# Can't give in Y and Ynew
expect_error(SG <- CGGPfit(SG, Y=y, Ynew=y))
# Other errors when giving ynew and wrong number of rows
expect_error(CGGPfit(SG, Ynew=y[1:5,]))
expect_error(CGGPfit(SG, Ynew=y1[1:5]))
# Errors for bad theta0
expect_error(CGGPfit(SG, Y=y, theta0 = matrix(0, ncol=3, nrow=SG$numpara), separateoutputparameterdimensions = T))
expect_error(CGGPfit(SG, Y=y, theta0 = matrix(0, ncol=1, nrow=SG$numpara), separateoutputparameterdimensions = T))
# Works with just Ynew
SG <- CGGPfit(SG, Ynew=y)
# After append, only give in Ynew
SG <- CGGPappend(SG, 50)
ynew1 <- apply(SG$design_unevaluated, 1, f1)
ynew2 <- apply(SG$design_unevaluated, 1, f2)
ynew <- cbind(ynew1, ynew2)
# Again error if give in Y and Ynew
expect_error(CGGPfit(SG, Y=rbind(y, ynew), Ynew=ynew))
# Get error when Ynew is wrong size
expect_error(CGGPfit(SG, Ynew=ynew[1:(nrow(ynew)-1),]))
# Get error if you give in vector
expect_error(CGGPfit(SG, Ynew=ynew1))
# Works fine
expect_is(SG <- CGGPfit(SG, Ynew = ynew), "CGGP")
})
# test_that("postvarmatcalc", {
# # These don't work unless x1 and x2 have same length.
# # Maybe only makes sense when x1 == x2?
# x1 <- runif(5)
# x2 <- x1
# o1 <- CGGP_internal_postvarmatcalc(x1, x2,
# xo=c(.11), theta=c(.1,.2,.3),
# CorrMat=CGGP_internal_CorrMatCauchySQT,
# returndPVMC=F, returndiagonly=F)
# o2 <- CGGP_internal_postvarmatcalc(x1, x2,
# xo=c(.11), theta=c(.1,.2,.3),
# CorrMat=CGGP_internal_CorrMatCauchySQT,
# returndPVMC=F, returndiagonly=T)
# o3 <- CGGP_internal_postvarmatcalc(x1, x2,
# xo=c(.11), theta=c(.1,.2,.3),
# CorrMat=CGGP_internal_CorrMatCauchySQT,
# returndPVMC=T, returndiagonly=F)
# o4 <- CGGP_internal_postvarmatcalc(x1, x2,
# xo=c(.11), theta=c(.1,.2,.3),
# CorrMat=CGGP_internal_CorrMatCauchySQT,
# returndPVMC=T, returndiagonly=T)
# expect_equal(o1, o3$Sigma_mat)
# expect_equal(diag(o1), o2)
# expect_equal(o4$Sigma_mat, diag(o3$Sigma_mat))
# expect_equal(o4$dSigma_mat[,1], diag(o3$dSigma_mat[,1:5]))
# expect_equal(o4$dSigma_mat[,2], diag(o3$dSigma_mat[,6:10]))
# expect_equal(o4$dSigma_mat[,3], diag(o3$dSigma_mat[,11:15]))
# })
# test_that("", {
#
# })
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.