tests/testthat/testoutputparamdim.R

In CollinErickson/CGGP: Composite Grid Gaussian Processes

context("testoutputparamdim")

sel.methods_totest <- c("UCB", "TS", "MAP")
# sel.methods_totest <- c("MAP") # Much faster

# -----------------------------------------------
# Test different output parameter dimensions
# -----------------------------------------------

# Use 3 dim output. 3rd func is LinComb of first two, so PCA should have 2 dim
f1 <- function(x){x[1]+x[2]^2 + cos(x[3]^2*2*pi*4) - 3.3}
f2 <- function(x){x[1]^1.3+.4*sin(6*x[2])+10}
f3 <- function(x) {f1(x) + .3*f2(x)}
f4 <- function(x) {-1.1*f1(x) + .8*f2(x)}
f5 <- function(x) {.2*f1(x)}
f <- function(x) {
  if (is.matrix(x)) {return(t(apply(x, 1, f)))}
  c(f1(x), f2(x), f3(x), f4(x), f5(x))#, rep(f5(x),20))
}
d <- 3
outd <- 5
outd_pca <- 2

nsup <- 20
xsup <- matrix(runif(nsup*d), nsup, d)
ysup <- f(xsup)
eps.sup <- 1e-2 # Use difference accuracy for supp data preds


ntest <- 20
xtest <- matrix(runif(ntest*d), ntest, d)
ytest <- f(xtest)
eps.test <- 1e-2 # Use difference accuracy for testp data preds


test_that("2. MV output, NO PCA, 1opd", {
  
  
  # First check MV with PCA
  SG <- CGGPcreate(d=d, batchsize=30)
  expect_is(SG, "CGGP")
  y <- f(SG$design)
  expect_error(SG <- CGGPfit(SG, Y=y), NA) # No error
  expect_length(SG$thetaMAP, d*SG$numpara)
  expect_true(!is.matrix(SG$thetaMAP))
  expect_true(ncol(SG$Y) == outd)
  expect_true(ncol(SG$y) == outd)
  yMVpred <- CGGPpred(SG, SG$design)$mean
  expect_equal(yMVpred, y, 1e-4)
  expect_equal(dim(yMVpred), c(nrow(SG$design), outd))
  
  # Check that append works without error, don't save it
  for (sel.method in sel.methods_totest) {
    expect_error(CGGPappend(SG, 30, sel.method), NA)
  }
  
  # Add supplemental data
  expect_error(SG <- CGGPfit(SG, Y=y, Xs=xsup, Ys=ysup), NA) # No error
  ysuppred <- CGGPpred(SG, xsup)$me
  expect_equal(ysuppred, ysup, eps.sup)
  
  # Check that append works with grid+supp data
  for (sel.method in sel.methods_totest) {
    expect_error(CGGPappend(SG, 30, sel.method), NA)
  }
})


test_that("4. MV output, NO PCA, separate opd", {
  
  
  # First check MV with PCA
  SG <- CGGPcreate(d=3, batchsize=30)
  expect_is(SG, "CGGP")
  y <- f(SG$design)
  
  # Fit a model to only each individual output, will compare thetaMAP later
  seed <- sample(1:10000, 1)
  set.seed(seed)
  SG1 <- CGGPfit(SG, Y=y[,1])
  SG2 <- CGGPfit(SG, Y=y[,2])
  SG3 <- CGGPfit(SG, Y=y[,3])
  SG4 <- CGGPfit(SG, Y=y[,4])
  SG5 <- CGGPfit(SG, Y=y[,5])
  
  # Now fit all
  set.seed(seed)
  expect_error(SG <- CGGPfit(SG, Y=y, separateoutputparameterdimensions = T), NA) # No error
  expect_length(SG$thetaMAP, d*SG$numpara*outd)
  expect_true(is.matrix(SG$thetaMAP))
  expect_true(ncol(SG$thetaMAP) == outd)
  expect_true(ncol(SG$Y) == outd)
  expect_true(ncol(SG$y) == outd)
  
  # Check that thetaMAP for each dimension matches when model is only fit to that dimension.
  expect_equal(SG$thetaMAP[,1], SG1$thetaMAP)
  expect_equal(SG$thetaMAP[,2], SG2$thetaMAP)
  expect_equal(SG$thetaMAP[,3], SG3$thetaMAP)
  expect_equal(SG$thetaMAP[,4], SG4$thetaMAP)
  expect_equal(SG$thetaMAP[,5], SG5$thetaMAP)
  # Check that predictions on these match
  expect_equal(c(CGGPpred(SG, xtest)$me[,1]), c(CGGPpred(SG1, xtest)$me))
  expect_equal(c(CGGPpred(SG, xtest)$me[,2]), c(CGGPpred(SG2, xtest)$me))
  expect_equal(c(CGGPpred(SG, xtest)$me[,3]), c(CGGPpred(SG3, xtest)$me))
  expect_equal(c(CGGPpred(SG, xtest)$me[,4]), c(CGGPpred(SG4, xtest)$me))
  expect_equal(c(CGGPpred(SG, xtest)$me[,5]), c(CGGPpred(SG5, xtest)$me))
  
  # Now check predictions
  yMVpred <- CGGPpred(SG$design, CGGP=SG)$mean
  expect_equal(yMVpred, y, 1e-4)
  expect_equal(dim(yMVpred), c(nrow(SG$design), outd))
  
  # Check that append works without error, don't save it
  for (sel.method in sel.methods_totest) {
    expect_error(CGGPappend(SG, 30, sel.method), NA)
  }
  
  # Add supplemental data
  expect_error(SG <- CGGPfit(SG, Y=y, Xs=xsup, Ys=ysup), NA) # No error
  ysuppred <- CGGPpred(SG, xsup)$me
  expect_equal(ysuppred, ysup, eps.sup)
  
  # Check that append works with grid+supp data
  for (sel.method in sel.methods_totest) {
    expect_error(CGGPappend(SG, 30, sel.method), NA)
  }
})