SPOT Kriging Vignette

Thomas Bartz-Beielstein

2021-01-24

Setup

## install.packages("devtools")
## devtools::install_github("r-lib/devtools")
url <- "http://owos.gm.fh-koeln.de:8055/bartz/spot.git"
devtools::install_git(url = url)
library("SPOT")
packageVersion("SPOT")
#> [1] '2.2.4'

Vignettes are long form documentation commonly included in packages. Because they are part of the distribution of the package, they need to be as compact as possible. The html_vignette output type provides a custom style sheet (and tweaks some options) to ensure that the resulting html is as small as possible. The html_vignette format:

Vignette Info

Note the various macros within the vignette section of the metadata block above. These are required in order to instruct R how to build the vignette. Note that you should change the title field and the \VignetteIndexEntry to match the title of your vignette.

Styles

The html_vignette template includes a basic CSS theme. To override this theme you can specify your own CSS in the document metadata as follows:

output: 
  rmarkdown::html_vignette:
    css: mystyles.css

Figures

The figure sizes have been customised so that you can easily put two images side-by-side.

plot(1:10)
plot(10:1)

PlotPlot

You can enable figure captions by fig_caption: yes in YAML:

output:
  rmarkdown::html_vignette:
    fig_caption: yes

Then you can use the chunk option fig.cap = "Your figure caption." in knitr.

More Examples

You can write math expressions, e.g. \(Y = X\beta + \epsilon\), footnotes1, and tables, e.g. using knitr::kable().

mpg cyl disp hp drat wt qsec vs am gear carb
Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4
Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4
Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1
Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1
Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2
Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1
Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4
Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2
Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2
Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4

Also a quote using >:

“He who gives up [code] safety for [code] speed deserves neither.” (via)

Sensitivity

library(sensitivity)
x <- morris(model = morris.fun, factors = 20, r = 4,
design = list(type = "oat", levels = 5, grid.jump = 3))
    print(x)
    plot(x)
library(rgl)
plot3d.morris(x) # (requires the package 'rgl')

morris.fun_matrix <- function(X){ 
  res_vector <- morris.fun(X) cbind(res_vector, 2 * res_vector)
}
x <- morris(model = morris.fun_matrix, factors = 20, r = 4,design = list(type = "oat", levels = 5, grid.jump = 3)) 
plot(x, y_col = 2)
title(main = "y_col = 2")
# Also only for demonstration purposes: a model function returning a # three-dimensional array
morris.fun_array <- function(X){
res_vector <- morris.fun(X)
res_matrix <- cbind(res_vector, 2 * res_vector) array(data = c(res_matrix, 5 * res_matrix),
dim = c(length(res_vector), 2, 2))
}
x <- morris(model = morris.fun_array, factors = 20, r = 4,
design = list(type = "simplex", scale.factor = 1)) plot(x, y_col = 2, y_dim3 = 2)
title(main = "y_col = 2, y_dim3 = 2")
X.grid <- parameterSets(par.ranges=list(V1=c(1,1000),V2=c(1,4)), samples=c(10,10),method="grid")
plot(X.grid)
library(randtoolbox) 
X.sobol<-parameterSets(par.ranges=list(V1=c(1,1000),V2=c(1,4)),
                               samples=100,method="sobol")
plot(X.sobol)
# a 100-sample with X1 ~ U(0.5, 1.5)
# X2 ~ U(1.5, 4.5)
# X3 ~ U(4.5, 13.5) 
library(boot)
n <- 100
X <- data.frame(X1 = runif(n, 0.5, 1.5),
                X2 = runif(n, 1.5, 4.5), 
                X3 = runif(n, 4.5, 13.5))
    # linear model : Y = X1^2 + X2 + X3
y <- with(X, X1^2 + X2 +X3)
# sensitivity analysis 
x <- pcc(X, y, nboot = 100)
print(x)
plot(x)
library(ggplot2)
ggplot(x)

x <- pcc(X, y, semi = TRUE, nboot = 100) 
print(x)
plot(x)

sequential bifurcations

# a model with interactions
p <- 50
beta <- numeric(length = p)
beta[1:5] <- runif(n = 5, min = 10, max = 50) 
beta[6:p] <- runif(n = p - 5, min = 0, max = 0.3) 
beta <- sample(beta)
gamma <- matrix(data = runif(n = p^2, min = 0, max = 0.1), nrow = p, ncol = p) 
gamma[lower.tri(gamma, diag = TRUE)] <- 0
gamma[1,2] <- 5
gamma[5,9] <- 12
f <- function(x) { return(sum(x * beta) + (x %*% gamma %*% x))}
library(babsim.hospital)
library(sensitivity)
library(SPOT)
bounds <- getBounds()
lower <- matrix(bounds$lower,1,)
upper <- matrix(bounds$upper,1,)
# 10 iterations of SB
p <- 29
k = 29
sa <- sb(p, interaction = FALSE) 
for (i in 1 : k) {
  x <- ask(sa)
  y <- list()
for (i in names(x)) {
  print(x[[i]])
  ## f muss eine Funktion sein, die für -1 den unteren Wert und für +1 den oberen
  ## Wert 
  u <- matrix(x[[i]],1,)
  u <- getNatDesignFromCoded(u, a = lower, b=upper)
  y[[i]] <- as.numeric( funBaBSimHospital(u, nCores=20) )
  }
tell(sa, y) 
}
print(sa)
plot(sa)

Sobol Indices

library(sensitivity)
# Test case : the non-monotonic Sobol g-function
# The method of sobol requires 2 samples
# (there are 8 factors, all following the uniform distribution on [0,1]) library(boot)
n <- 1000
X1 <- data.frame(matrix(runif(8 * n), nrow = n))
X2 <- data.frame(matrix(runif(8 * n), nrow = n))
# sensitivity analysis
x <- sobol(model = sobol.fun, X1 = X1, X2 = X2, order = 2, nboot = 100) 
print(x)
plot(x)
    library(ggplot2)
    ggplot(x)

Example of use of fast99 with “model = NULL”

library(sensitivity)
x <- fast99(model = NULL, factors = 29, n = 100, q="qunif",  q.arg = list(min = 0, max =1))
bounds <- getBounds()
lower <- bounds$lower
upper <- bounds$upper
x1 <- code2nat(matrix(x$X, lower, upper)
y <- funBaBSimHospital(x1)
tell(x,y)
print(x)
plot(x)

BABSimHospital

rm(list=ls())
library(microbenchmark)
library(SPOT)
library(babsim.hospital)
set.seed(1)

Compare Run Time

# n = number of function evvaluations:
n <- 3
x <- matrix(as.numeric(getParaSet(5374)[1,-1]),1,)
bounds <- getBounds()
lower <- bounds$lower
upper <- bounds$upper

resb <- microbenchmark( 
  spot(x, funBaBSimHospital, lower , upper, control=list(funEvals=10*n)), 
  spot(x, funBaBSimHospital, lower , upper, control=list(funEvals=10*n, model = buildGaussianProcess)),
  times = 2)
print(resb)
boxplot(resb)

BaBSimHospital Function

rm(list=ls())
library(microbenchmark)
library(SPOT)
library(babsim.hospital)
set.seed(1)
x0 <- matrix(as.numeric(getParaSet(5374)[1,-1]),1,)
bounds <- getBounds()
lower <- bounds$lower
upper <- bounds$upper

set.seed(1)
perf1 <- spot(x= x0, funBaBSimHospital, lower , upper, control=list(maxTime = 1, funEvals=100, plots=FALSE,
                                                   model = buildKriging, optimizer=optimNLOPTR), nCores =5)
set.seed(1)
perf2 <- spot(x= x0, funBaBSimHospital, lower , upper, control=list(maxTime = 1, funEvals=100, plots=FALSE,
              model = buildGaussianProcess, optimizer=optimNLOPTR, directOptControl = list(funEvals=0)), nCores =5)

set.seed(1)
perf3 <- spot(x= x0, funBaBSimHospital, lower , upper, control=list(maxTime = 1, funEvals=100, plots=FALSE,
                                                   model = buildGaussianProcess, optimizer=optimNLOPTR, 
                                                   directOptControl = list(funEvals=10)), nCores = 5)

Sensitivity Analysis

rm(list=ls())
library(microbenchmark)
library(SPOT)
library(babsim.hospital)
set.seed(1)
eps <- sqrt(.Machine$double.eps)
bounds <- getBounds()
a <- matrix(bounds$lower,1)
b <- matrix(bounds$upper,1)
d <- dim(a)[2]

d = 20
fried <- function (n, d, a, b) {
 #X <- designLHD(lower = lower, upper = upper, control = list(size = n))
  X <- lhs::randomLHS(n, d)
  ##XX <- code2nat(x=X, a=a, b=b)
  ###Ytrue <- funBaBSimHospital(XX, totalRepeats = 5, nCores = 5)
  Ytrue <- funSphere(X[,-1])
  Y <- Ytrue
# Y <- Ytrue + rnorm(n, 0, 1)
return(data.frame(X, Y, Ytrue))
}
data <- fried(n=25*d, d=d, a=a, b=b)
x=as.matrix(data[,1:d])
y=data$Y
fitTree <- buildTreeModel(x,y)
plot(fitTree)
fitKrigingDACE <- buildKrigingDACE(x,y)
print(fitKrigingDACE$like)
N <- 100*d
G <- 10*d
m <- q1 <- q2 <- matrix(NA, ncol=d, nrow=G) 
grid <- seq(0, 1, length=G)
XX <- matrix(NA, ncol=d, nrow=N)
bounds <- getBounds()
a <- matrix(bounds$lower,1)
b <- matrix(bounds$upper,1)
for(j in 1:d) 
  { for(i in 1:G) {
  XX[,j] <- grid[i]
  XX[,-j] <- lhs::randomLHS(N, d-1)
  ## XX <- code2nat(XX, a, b)
  ##p <- laGP::predGPsep(gpi, XX, lite=TRUE, nonug=TRUE) 
  fitKrigingDACE$target <- "s"
  p <- predict(fitKrigingDACE, XX)
  m[i,j] <- mean(p$y)
  ## m[i,j] <- mean(p$mean)
  ## q1[i,j] <- mean(qnorm(0.05, p$mean, sqrt(p$s2))) 
  ## q2[i,j] <- mean(qnorm(0.95, p$mean, sqrt(p$s2)))
  q1[i,j] <- mean(qnorm(0.05, p$y, sqrt(p$s))) 
  q2[i,j] <- mean(qnorm(0.95, p$y, sqrt(p$s)))
  
  } 
  }
plot(0, xlab="grid", ylab="main effect", xlim=c(0,1), 
     ylim=range(c(q1,q2)), type="n")
for(j in 1:d) lines(grid, m[,j], col=j, lwd=2)
legend("bottomright", paste0("x", 1:d), fill=1:d, horiz=TRUE, cex=0.75)

laGP

gpi <- laGP::newGPsep(as.matrix(data[,1:29]), data$Y, d=0.1,g=var(data$Y)/10, dK=TRUE)
mle <- laGP::mleGPsep(gpi, param="both", tmin=rep(eps, 2),
tmax=c(10, var(data$Y)))
N <- 1000
G <- 30
m <- q1 <- q2 <- matrix(NA, ncol=29, nrow=G) 
grid <- seq(0, 1, length=G)
XX <- matrix(NA, ncol=29, nrow=N)
bounds <- getBounds()
a <- matrix(bounds$lower,1)
b <- matrix(bounds$upper,1)
for(j in 1:29) 
  { for(i in 1:G) {
  XX[,j] <- grid[i]
  XX[,-j] <- lhs::randomLHS(N, 28)
  ## XXX <- code2nat(XX, a, b)
  p <- laGP::predGPsep(gpi, XX, lite=TRUE, nonug=TRUE) 
  m[i,j] <- mean(p$mean)
  q1[i,j] <- mean(qnorm(0.05, p$mean, sqrt(p$s2))) 
  q2[i,j] <- mean(qnorm(0.95, p$mean, sqrt(p$s2)))
  } 
  }
plot(0, xlab="grid", ylab="main effect", xlim=c(0,1), 
     ylim=range(c(q1,q2)), type="n")
for(j in 1:29) lines(grid, m[,j], col=j, lwd=2)
legend("bottomright", paste0("x", 1:29), fill=1:29, horiz=TRUE, cex=0.75)

Sphere Function

# n = problem dim
n <- 30
low = -2
up = 2
a = runif(n, low, 0)
b = runif(n, 0, up)
x0 = a + runif(n)*(b-a)
#plot(a, type = "l", ylim=c(up,low))
#lines(b)
#lines(x0)
x0 = matrix( x0, nrow = 1)

set.seed(1)
perf1 <- spot(x= x0, funSphere, a, b, control=list(maxTime = 0.25, funEvals=10*n, plots=TRUE,
                                                   model = buildKriging, optimizer=optimNLOPTR))
set.seed(1)
perf2 <- spot(x= x0, funSphere, a, b, control=list(maxTime = 0.25, funEvals=10*n, plots=TRUE,
              model = buildGaussianProcess, optimizer=optimNLOPTR, directOptControl = list(funEvals=0)))

set.seed(1)
perf3 <- spot(x= x0, funSphere, a, b, control=list(maxTime = 0.25, funEvals=10*n, plots=TRUE,
                                                   model = buildGaussianProcess, optimizer=optimNLOPTR, 
                                                   directOptControl = list(funEvals=10)))

Quality Results: Plot Repeats (Sphere Function)

rm(list=ls())
library(microbenchmark)
library(SPOT)
set.seed(1)
n <- 30
low = -2
up = 2
a = runif(n, low, 0)
b = runif(n, 0, up)
x0 = a + runif(n)*(b-a)
#plot(a, type = "l", ylim=c(up,low))
#lines(b)
#lines(x0)
x0 = matrix( x0, nrow = 1)

reps <- 10
end <- 10*n
ninit <- n

progSpot <- matrix(NA, nrow = reps, ncol = end)
for(r in 1:reps){
  set.seed(r)
  x0 <- a + runif(n)*(b-a)
  x0 = matrix( x0, nrow = 1)
  sol <- spot(x= x0, funSphere, a, b, control=list(funEvals=end,
                                                   model = buildGaussianProcess,
                                                   optimizer=optimNLOPTR, 
                                                   directOptControl = list(funEvals=0),
                                                   designControl = list(size = ninit)))
  progSpot[r, ] <- bov(sol$y, end)
  
}

matplot(t(progSpot), type="l", col="gray", lty=1,
        xlab="n: blackbox evaluations", ylab="best objective value")
abline(v=ninit, lty=2)
legend("topright", "seed LHS", lty=2, bty="n")

f <- funSphere


fprime <- function(x) {
  x <- matrix( x, 1)
  ynew <- as.vector(f(x))
  y <<- c(y, ynew) 
  return(ynew)
}

progOptim <- matrix(NA, nrow=reps, ncol=end) 
for(r in 1:reps) {
  y <- c()
  x0 <- a + runif(n)*(b-a)
  x0 <- matrix( x0, 1, )
  os <- optim(x0, fprime, lower=a, upper=b, method="L-BFGS-B") 
  progOptim[r,] <- bov(y, end)
}

matplot(t(progOptim), type="l", col="red", lty=1,
        xlab="n: blackbox evaluations", ylab="best objective value")
matlines(t(progSpot), type="l", col="gray", lty=1)
legend("topright", c("Spot", "optim"), col=c("gray", "red"), lty=1, bty="n")
### babsim.hospital
rm(list=ls())
library(microbenchmark)
library(SPOT)
library(babsim.hospital)
library(nloptr)
library(parallel)

### New Babsim
getParallelBaseObjFun <- function(region = 5374, nCores = 2){
  N_REPEATS = 10/nCores ## cores are used in parallel, change repeats if desired
  singleRepeat <- function(index, x){
    rkiwerte = babsim.hospital::rkidata
    icuwerte = babsim.hospital::icudata
    rkiwerte <- rkiwerte[rkiwerte$Refdatum <= as.Date("2020-12-09"),]
    icuwerte <- icuwerte[icuwerte$daten_stand <= as.Date("2020-12-09"),]
    region <- 5374
    fun <- babsim.hospital:::getTrainTestObjFun(region = region,
                                                rkiwerte = rkiwerte,
                                                icuwerte = icuwerte,
                                                TrainSimStartDate = as.Date("2020-12-09") - 10*7, 
                                                TrainFieldStartDate = as.Date("2020-12-09") - 6*7,
                                                tryOnTestSet = FALSE)
    fun(x)
  }
  function(x){
    res <- mclapply(1:N_REPEATS, singleRepeat, x, mc.cores = nCores)
    y <- as.numeric(unlist(res))
    median(y)
  }
}
## Call Example
objFun <- getParallelBaseObjFun()
objFun(as.numeric(babsim.hospital::getParaSet(5315)[1,-1]))



### Old Version
packageVersion("babsim.hospital")
funHosp <- getTrainTestObjFun(verbosity = 10000,
                          parallel=TRUE,
                          tryOnTestSet=FALSE,
                          TrainSimStartDate = Sys.Date() - 12 * 7)
f <- function(x)
{matrix(apply(x, # matrix
              1, # margin (apply over rows) 
              funHosp),
        ,1) # number of columns
}

lo <- getBounds()$lower
up <- getBounds()$upper

n <- length(lo)
reps <- 10
end <- 3*n
ninit <- n+1

para <- getStartParameter(region = 5374)

progSpot <- matrix(NA, nrow = reps, ncol = end)
for(r in 1:reps){
  set.seed(r)
  x0 <- para[1,]
  x0 = matrix( x0, nrow = 1)
  sol <- spot(x= x0, f, lo, up, control=list(funEvals=end,
                                                   model = buildGaussianProcess,
                                                   optimizer=optimNLOPTR, 
                                                   directOptControl = list(funEvals= n),
                                                   designControl = list(size = ninit)))
  progSpot[r, ] <- bov(sol$y, end)
  
}

matplot(t(progSpot), type="l", col="gray", lty=1,
        xlab="n: blackbox evaluations", ylab="best objective value")
abline(v=ninit, lty=2)
legend("topright", "seed LHS", lty=2, bty="n")

## f <- funSphere

fprime <- function(x) {
  x <- matrix( x, 1)
  ynew <- as.vector(f(x))
  y <<- c(y, ynew) 
  return(ynew)
}

progOptim <- matrix(NA, nrow=reps, ncol=end) 
for(r in 1:reps) {
  y <- c()
  x0 <- para[1,]
  x0 <- matrix( x0, 1, )
  os <- optim(x0, fprime, lower=lo, upper=up, method="L-BFGS-B",  control = list(maxit = end)) 
  progOptim[r,] <- bov(y, end)
}


matplot(t(progOptim), type="l", col="red", lty=1,
        xlab="n: blackbox evaluations", ylab="best objective value")
matlines(t(progSpot), type="l", col="gray", lty=1)
legend("topright", c("Spot", "optim"), col=c("gray", "red"), lty=1, bty="n")

laGP

library("laGP")
library("MASS")
library("lhs")
library("akima")
library("tgp")
library("SPOT")
N <- 200
x <- matrix( seq(from=-1, to = 1, length.out = N), ncol = 1)
y <- funSphere(x)  + rnorm(N, 0, 0.1)
###################################################################################################
#' fit <- buildGaussianProcess(x,y)
#' ## Print model parameters
#' print(fit)
#' ## Predict at new location
#' xNew <- matrix( c(-0.1, 0.1), ncol = 1)
#' predict(fit, xNew)
#' ## True value at location
#' t(funSphere(xNew))
###################################################################################################
d <- g <- NULL
con<-list(samp.size = 100,
          modelControl = list(modelInitialized = FALSE))
  con[names(control)] <- control
  control<-con
    
  ## Case 1: model is not initialized:
  if (control$modelControl$modelInitialized == FALSE){
  control$x <- x
    control$y <- y
    d <- laGP::darg(NULL, x, samp.size = control$samp.size)
    g <- laGP::garg(list(mle = TRUE), y)
    fit <- laGP::newGPsep(x, y, d = d$start, 
                     g = g$start, dK = TRUE)
    laGP::jmleGPsep(fit, 
                  drange = c(d$min, d$max), 
                  grange = c(g$min, g$max), 
                  dab = d$ab, 
                  gab = g$ab)
    control$fit <- fit  
    control$d <- d
    control$g <- g
    control$pNames <- colnames(x)
    control$yName <- "y"
    class(control) <- "spotGaussianProcessModel"
  } 
  
  control$modelControl$modelInitialized <- TRUE
  
  xNew <- matrix( c(-0.1, 0.1), ncol = 1)
  
  control$xNewActualSize <- nrow(xNew)
  x <- rbind(x, xNew)
  y <- funSphere(x)  + rnorm(N+control$xNewActualSize, 0, 0.1)
    ## Case 2: model is already initialized:
      n <- nrow(x)
      indices <- (n - control$xNewActualSize +1):n
      xnew <- x[indices, , drop = FALSE]
      ynew <- y[indices, ,drop = FALSE]
      laGP::updateGPsep(control$fit, xnew, ynew)
      laGP::jmleGPsep(control$fit, 
                      drange = c(control$d$min, control$d$max), 
                      grange = c(control$g$min, control$g$max), 
                      dab = control$d$ab, 
                      gab = control$g$ab)
## prediction:

xNew <- matrix( c(-0.1, 0.1), ncol = 1)
predGPsep(control$fit, XX = xNew, lite = TRUE)

newdata <- as.data.frame(xNew)
predict(control$fit, xNew)      
      
predict.spotGaussianProcessModel<-function(object, newdata, ...){
    newdata <- as.data.frame(newdata)
  if(!all(colnames(newdata) %in% object$pNames))
    colnames(newdata) <- object$pNames
  
  predGPsep(object, XX = newdata, lite = TRUE)
  
  # seqVec <- Vectorize(seq.default, vectorize.args = c("from", "to"))
  # XX <- matrix( seqVec(from = xmin, to = xmax, length.out = n), ncol = dim(x)[2])
  # res <- laGP::aGP(object$x, 
  #            object$y, 
  #            newdata,
  #            end = 10,
  #            d = object$d, 
  #            g = object$g, 
  #            verb = 0)
  # plot(df$y ~ df[,2] , cex = 0.5, main = "branin data")
  # lines(XX[,1], motogp.p$mean, lwd = 2)
  # q1 <- qnorm(0.05, mean = motogp.p$mean, sd = sqrt(motogp.p$s2))
  # q2 <- qnorm(0.95, mean = motogp.p$mean, sd = sqrt(motogp.p$s2))
  # lines(XX[,1], q1, lty = 2, lwd = 2)
  # lines(XX[,1], q2, lty = 2, lwd = 2)
  # lines(XX[,1], motoagp$mean, col = 2, lwd = 2)
  # q1 <- qnorm(0.05, mean = motoagp$mean, sd = sqrt(motoagp$var))
  # q2 <- qnorm(0.95, mean = motoagp$mean, sd = sqrt(motoagp$var))
  # lines(XX[,1], q1, lty = 2, col = 2, lwd = 2)
  # lines(XX[,1], q2, lty = 2, col = 2, lwd = 2)
  list(y = res$mean)
}

            
      
X <- matrix(seq(0, 2 * pi,length = 6), ncol = 1)
str(X)
Z <- sin(X)
gp <- newGP(X, Z, 2, 1e-6, dK = TRUE)
str(gp)
mleGP(gp, tmax=20)
XX <- matrix(seq(-1, 2 * pi + 1, length = 499), ncol = ncol(X))
str(XX)
p <- predGP(gp, XX)
str(p)
library("mvtnorm")
N <- 100
ZZ <- rmvt(N, p$Sigma, p$df)
ZZ <- ZZ + t(matrix(rep(p$mean, N), ncol = N))
str(ZZ)
{matplot(XX, t(ZZ), col = "gray", lwd = 0.5, lty = 1, type = "l",
    bty = "n", main = "simple sinusoidal example", xlab = "x", 
    ylab = "Y(x) | thetahat")
points(X, Z, pch = 19)}
x <- seq(-2, 2, by = 0.02)
str(x)
X <- as.matrix(expand.grid(x, x))
str(X)
N <- nrow(X)
f2d <- function(x)
  {
    g <- function(z)
      return(exp( - (z - 1)^2) + exp( -0.8 * (z + 1)^2) 
        - 0.05 * sin(8 * (z + 0.1)))
    -g(x[,1]) * g(x[,2])
  }
Y <- f2d(X)
str(Y)
Xref <- matrix(c(-1.725, 1.725), nrow = 1)
p.mspe <- laGP(Xref, 6, 50, X, Y, d = 0.1, method="mspe")
str(p.mspe)
p.alc <- laGP(Xref, 6, 50, X, Y, d = 0.1, method="alc")
str(p.alc)
Xi <- rbind(X[p.mspe$Xi, ], X[p.alc$Xi, ])
{
plot(X[p.mspe$Xi, ], xlab = "x1", ylab = "x2", type = "n", 
  main = "comparing local designs", xlim = range(Xi[ ,1]), 
  ylim = range(Xi[ ,2]))
text(X[p.mspe$Xi, ], labels = 1:length(p.mspe$Xi), cex = 0.7)
text(X[p.alc$Xi, ], labels = 1:length(p.alc$Xi), cex = 0.7, col = 2)
points(Xref[1], Xref[2], pch=19, col=3)
legend("topright", c("mspe", "alc"), text.col = c(1, 2), bty="n")
}
p <- rbind(c(p.mspe$mean, p.mspe$s2, p.mspe$df),
  c(p.alc$mean, p.alc$s2, p.alc$df))
colnames(p) <- c("mean", "s2", "df")
rownames(p) <- c("mspe", "alc")
p
p.mspe$mle
p.alc$mle
c(p.mspe$time, p.alc$time)
xx <- seq(-1.97, 1.95, by = 0.04)
str(xx)
XX <- as.matrix(expand.grid(xx, xx))
str(XX)
YY <- f2d(XX)
str(YY)
nth <- as.numeric(Sys.getenv("OMP_NUM_THREADS"))
nth <- 10
if(is.na(nth)) nth <- 2
print(nth)
P.alc <- aGP(X, Y, XX, omp.threads = nth, verb = 0)
persp(xx, xx, -matrix(P.alc$mean, ncol = length(xx)), phi=45, theta=45,
      main = "", xlab = "x1", ylab = "x2", zlab = "yhat(x)")
med <- 0.51
zs <- XX[, 2] == med
sv <- sqrt(P.alc$var[zs])
r <- range(c(-P.alc$mean[zs] + 2 * sv, -P.alc$mean[zs] - 2 * sv))
plot(XX[zs,1], -P.alc$mean[zs], type="l", lwd = 2, ylim = r, xlab = "x1",
     ylab = "predicted & true response", bty = "n",
     main = "slice through surface")
lines(XX[zs, 1], -P.alc$mean[zs] + 2 * sv, col = 2, lty = 2, lwd = 2)
lines(XX[zs, 1], -P.alc$mean[zs] - 2 * sv, col = 2, lty = 2, lwd = 2)
lines(XX[zs, 1], YY[zs], col = 3, lwd = 2, lty = 3)
diff <- P.alc$mean - YY
plot(XX[zs,1], diff[zs], type = "l", lwd = 2, 
     main = "systematic bias in prediction", 
     xlab = "x1", ylab = "y(x) - yhat(x)", bty = "n")
plot(XX[zs,1], P.alc$mle$d[zs], type = "l", lwd=2, 
     main = "spatially varying lengthscale", 
     xlab = "x1", ylab = "thetahat(x)", bty = "n")
df <- data.frame(y = log(P.alc$mle$d), XX)
lo <- loess(y ~ ., data = df, span = 0.01)
lines(XX[zs,1], exp(lo$fitted)[zs], col=2, lty=2, lwd=2)
legend("topright", "loess smoothed", col=2, lty=2, lwd=2, bty="n")
P.alc2 <- aGP(X, Y, XX, d = exp(lo$fitted), omp.threads = nth, verb = 0)
rmse <- data.frame(alc = sqrt(mean((P.alc$mean - YY)^2)), 
  alc2 = sqrt(mean((P.alc2$mean - YY)^2)))
rmse

Examples

Borehole data

N <- 100000
Npred <- 1000
dim <- 8
library("lhs")
T <- 10
nas <- rep(NA, T)
times <- rmse <- data.frame(mspe = nas, mspe2 = nas, 
  alc.nomle = nas, alc = nas, alc2 = nas,
  nn.nomle = nas, nn=nas, big.nn.nomle = nas, big.nn = nas,
  big.alcray = nas, big.alcray2 = nas)
borehole <- function(x){
  rw <- x[1] * (0.15 - 0.05) + 0.05
  r <-  x[2] * (50000 - 100) + 100
  Tu <- x[3] * (115600 - 63070) + 63070
  Hu <- x[4] * (1110 - 990) + 990
  Tl <- x[5] * (116 - 63.1) + 63.1
  Hl <- x[6] * (820 - 700) + 700
  L <-  x[7] * (1680 - 1120) + 1120
  Kw <- x[8] * (12045 - 9855) + 9855
  m1 <- 2 * pi * Tu * (Hu - Hl)
  m2 <- log(r / rw)
  m3 <- 1 + 2 * L * Tu / (m2 * rw^2 * Kw) + Tu / Tl
  return(m1/m2/m3)
}
for(t in 1:T) {
  x <- randomLHS(N + Npred, dim)
  y <- apply(x, 1, borehole)
  ypred.0 <- y[-(1:N)]; y <- y[1:N]
  xpred <- x[-(1:N),]; x <- x[1:N,]

  formals(aGP)[c("omp.threads", "verb")] <- c(nth, 0)
  formals(aGP)[c("X", "Z", "XX")] <- list(x, y, xpred)

  out1<- aGP(d=list(mle = FALSE, start = 0.7))
  rmse$alc.nomle[t] <- sqrt(mean((out1$mean - ypred.0)^2))
  times$alc.nomle[t] <- out1$time
  
  out2 <- aGP(d = list(max = 20))
  rmse$alc[t] <- sqrt(mean((out2$mean - ypred.0)^2))
  times$alc[t] <- out2$time
  
  out3 <- aGP(d = list(start = out2$mle$d, max = 20))
  rmse$alc2[t] <- sqrt(mean((out3$mean - ypred.0)^2))
  times$alc2[t] <- out3$time

  out4 <- aGP(d = list(max = 20), method="alcray")
  rmse$alcray[t] <- sqrt(mean((out4$mean - ypred.0)^2))
  times$alcray[t] <- out4$time
  
  out5 <- aGP(d = list(start = out4$mle$d, max = 20), method="alcray")
  rmse$alcray2[t] <- sqrt(mean((out5$mean - ypred.0)^2))
  times$alcray2[t] <- out5$time

  out6<- aGP(d = list(max = 20), method="mspe")
  rmse$mspe[t] <- sqrt(mean((out6$mean - ypred.0)^2))
  times$mspe[t] <- out6$time
  
  out7 <- aGP(d = list(start = out6$mle$d, max = 20), method="mspe")
  rmse$mspe2[t] <- sqrt(mean((out7$mean - ypred.0)^2))
  times$mspe2[t] <- out7$time

  out8 <- aGP(d = list(mle = FALSE, start = 0.7), method = "nn")
  rmse$nn.nomle[t] <- sqrt(mean((out8$mean - ypred.0)^2))
  times$nn.nomle[t] <- out8$time

  out9 <- aGP(end = 200, d = list(mle = FALSE), method = "nn")
  rmse$big.nn.nomle[t] <- sqrt(mean((out9$mean - ypred.0)^2))
  times$big.nn.nomle[t] <- out9$time

  out10 <- aGP(d = list(max = 20), method = "nn")
  rmse$nn[t] <- sqrt(mean((out10$mean - ypred.0)^2))
  times$nn[t] <- out10$time

  out11 <- aGP(end = 200, d = list(max = 20), method="nn")
  rmse$big.nn[t] <- sqrt(mean((out11$mean - ypred.0)^2))
  times$big.nn[t] <- out11$time

  out12 <- aGP(end = 200, d = list(max = 20), method="alcray")
  rmse$big.alcray[t] <- sqrt(mean((out12$mean - ypred.0)^2))
  times$big.alcray[t] <- out12$time
  
  out13 <- aGP(end = 200, d = list(start = out12$mle$d, max = 20), 
    method="alcray")
  rmse$big.alcray2[t] <- sqrt(mean((out13$mean - ypred.0)^2))
  times$big.alcray2[t] <- out13 $time
}
timev <- apply(times, 2, mean, na.rm = TRUE)
rmsev <- apply(rmse, 2, mean)
tab <- cbind(timev, rmsev)
o <- order(rmsev, decreasing = FALSE)
tt <- rep(NA, length(rmsev))
for(i in 1:(length(o)-1)) {
  tto <- t.test(rmse[ ,o[i]], rmse[ ,o[i+1]], alternative = "less", 
    paired = TRUE)
  tt[o[i]] <- tto$p.value
}
tab <- cbind(tab, data.frame(tt))
tab[o, ]

Challenging global/local isotropy

thats <- matrix(NA, nrow = T, ncol = dim)
its <- rep(NA, T)
n <- 1000

g2 <- garg(list(mle = TRUE), y)
d2 <- darg(list(mle = TRUE, max = 100), x)

for(t in 1:T) {
  
  subs <- sample(1:N, n, replace = FALSE)

  gpsepi <- newGPsep(x[subs, ], y[subs], rep(d2$start, dim), g = 1/1000, 
    dK = TRUE)
  that <- mleGPsep(gpsepi, param = "d", tmin = d2$min, tmax = d2$max, 
    ab = d2$ab, maxit = 200)
  thats[t,] <- that$d
  its[t] <- that$its

  deleteGPsep(gpsepi)
}
boxplot(thats, main = "distribution of thetas", xlab = "input", 
  ylab = "theta")
scales <- sqrt(apply(thats, 2, median))
xs <- x; xpreds <- xpred
for(j in 1:ncol(xs)) {
  xs[,j] <- xs[,j] / scales[j]
  xpreds[,j] <- xpreds[,j] / scales[j]
}
out14 <- aGP(xs, y, xpreds, d=list(start=1, max=20), method="alcray")
sqrt(mean((out14$mean - ypred.0)^2))

Motorcycle data

library("MASS")
d <- darg(NULL, mcycle[, 1, drop = FALSE])
g <- garg(list(mle = TRUE), mcycle[,2])
motogp <- newGP(mcycle[ , 1, drop=FALSE], mcycle[ ,2], d = d$start, 
  g = g$start, dK = TRUE)
jmleGP(motogp, drange = c(d$min, d$max), grange = c(d$min, d$max), 
  dab = d$ab, gab = g$ab)
XX <- matrix(seq(min(mcycle[ ,1]), max(mcycle[ ,1]), length = 100), 
  ncol = 1)
motogp.p <- predGP(motogp, XX = XX, lite = TRUE)
motoagp <- aGP(mcycle[ , 1, drop=FALSE], mcycle[,2], XX, end = 30, 
  d = d, g = g, verb = 0)
plot(mcycle, cex = 0.5, main = "motorcycle data")
lines(XX, motogp.p$mean, lwd = 2)
q1 <- qnorm(0.05, mean = motogp.p$mean, sd = sqrt(motogp.p$s2))
q2 <- qnorm(0.95, mean = motogp.p$mean, sd = sqrt(motogp.p$s2))
lines(XX, q1, lty = 2, lwd = 2)
lines(XX, q2, lty = 2, lwd = 2)
lines(XX, motoagp$mean, col = 2, lwd = 2)
q1 <- qnorm(0.05, mean = motoagp$mean, sd = sqrt(motoagp$var))
q2 <- qnorm(0.95, mean = motoagp$mean, sd = sqrt(motoagp$var))
lines(XX, q1, lty = 2, col = 2, lwd = 2)
lines(XX, q2, lty = 2, col = 2, lwd = 2)
X <- matrix(rep(mcycle[ ,1], 10), ncol = 1)
X <- X + rnorm(nrow(X), sd = 1)
Z <- rep(mcycle[ ,2], 10)
motoagp2 <- aGP(X, Z, XX, end = 30, d = d, g = g, verb = 0)
plot(X, Z, main = "simulating a larger data setup", xlab = "times", 
  ylab = "accel")
lines(XX, motoagp2$mean, col = 2, lwd = 2)
q1 <- qnorm(0.05, mean = motoagp2$mean, sd = sqrt(motoagp2$var))
q2 <- qnorm(0.95, mean = motoagp2$mean, sd = sqrt(motoagp2$var))
lines(XX, q1, col = 2, lty = 2, lwd = 2)
lines(XX, q2, col = 2, lty = 2, lwd = 2)

** Calibration *** An illustrative example

M <- function(x,u) 
  {
    x <- as.matrix(x)
    u <- as.matrix(u)
    out <- (1 - exp(-1 / (2 * x[,2]))) 
    out <- out * (1000 * u[,1] * x[,1]^3 + 1900 * x[ ,1]^2 
      + 2092 * x[ ,1] + 60) 
    out <- out / (100 * u[,2] * x[,1]^3 + 500 * x[ ,1]^2 + 4 * x[ ,1] + 20)  
    return(out)
  }
bias <- function(x) 
  {
    x <- as.matrix(x)   
    out <- 2 * (10 * x[ ,1]^2 + 4 * x[ ,2]^2) / (50 * x[ ,1] * x[ ,2] + 10)
    return(out)
  }
library("tgp")
rect <- matrix(rep(0:1, 4), ncol = 2, byrow = 2)
ny <- 50
X <- lhs(ny, rect[1:2,] )
u <- c(0.2, 0.1)
Zu <- M(X, matrix(u, nrow = 1)) 
sd <- 0.5
reps <- 2
Y <- rep(Zu, reps) + rep(bias(X), reps) + 
  rnorm(reps * length(Zu), sd = sd) 
nz <- 10000
XU <- lhs(nz, rect)
XU2 <- matrix(NA, nrow=10 * ny, ncol = 4)
for(i in 1:10) {
  I <- ((i - 1) * ny + 1):(ny * i)
  XU2[I, 1:2] <- X
}
XU2[ ,3:4] <- lhs(10 * ny, rect[3:4, ])
XU <- rbind(XU, XU2)
Z <- M(XU[ ,1:2], XU[ ,3:4])
bias.est <- TRUE
methods <- rep("alc", 2)
da <- d <- darg(NULL, XU)
g <- garg(list(mle = TRUE), Y) 
beta.prior <- function(u, a = 2, b = 2, log = TRUE)
{
  if(length(a) == 1) a <- rep(a, length(u))
  else if(length(a) != length(u)) stop("length(a) must be 1 or length(u)")
  if(length(b) == 1) b <- rep(b, length(u))
  else if(length(b) != length(u)) stop("length(b) must be 1 or length(u)")
  if(log) return(sum(dbeta(u, a, b, log=TRUE)))
  else return(prod(dbeta(u, a, b, log=FALSE)))
}
initsize <- 10*ncol(X)
imesh <- 0.1
irect <- rect[1:2,]
irect[,1] <- irect[,1] + imesh/2
irect[,2] <- irect[,2] - imesh/2
uinit.cand <- lhs(10 * initsize, irect) 
uinit <- dopt.gp(initsize, Xcand = lhs(10 * initsize, irect))$XX
llinit <- rep(NA, nrow(uinit))
for(i in 1:nrow(uinit)) {
  llinit[i] <- fcalib(uinit[i,], XU, Z, X, Y, da, d, g, beta.prior, 
                  methods, M, bias.est, nth, verb = 0)
}
library("crs")
opts <- list("MAX_BB_EVAL" = 1000, "INITIAL_MESH_SIZE" = imesh, 
  "MIN_POLL_SIZE" = "r0.001", "DISPLAY_DEGREE" = 0)
its <- 0
o <- order(llinit)
i <- 1
out <- NULL
while(its < 10) {
  outi <- snomadr(fcalib, 2, c(0,0), 0, x0 = uinit[o[i],],
            lb = c(0,0), ub = c(1,1), opts = opts, XU = XU, 
            Z = Z, X = X, Y = Y, da = da, d = d, g = g, 
            methods = methods, M = M, bias = bias.est, 
            omp.threads = nth, uprior = beta.prior, 
            save.global = .GlobalEnv, verb = 0)
  its <- its + outi$iterations
  if(is.null(out) || outi$objective < out$objective) out <- outi
  i <- i + 1;
}
Xp <- rbind(uinit, as.matrix(fcalib.save[ ,1:2]))
Zp <- c(-llinit, fcalib.save[ ,3])
wi <- which(!is.finite(Zp))
if(length(wi) > 0) { Xp <- Xp[-wi, ]; Zp <- Zp[-wi]}
surf <- interp(Xp[ ,1], Xp[ ,2], Zp, duplicate = "mean")
image(surf, xlab = "u1", ylab = "u2", main = "posterior surface",
  col = heat.colors(128), xlim = c(0,1), ylim = c(0,1))
points(uinit)
points(fcalib.save[,1:2], col = 3, pch = 18)
u.hat <- outi$solution
points(u.hat[1], u.hat[2], col = 4, pch = 18)
abline(v = u[1], lty = 2)
abline(h = u[2], lty = 2)
Xu <- cbind(X, matrix(rep(u, ny), ncol = 2, byrow = TRUE))
Mhat.u <- aGP.seq(XU, Z, Xu, da, methods, ncalib = 2, omp.threads = nth, 
  verb = 0)
cmle.u <- discrep.est(X, Y, Mhat.u$mean, d, g, bias.est, FALSE)
cmle.u$ll <- cmle.u$ll + beta.prior(u)
data.frame(u.hat = -outi$objective, u = cmle.u$ll)
nny <- 1000  
XX <- lhs(nny, rect[1:2,])
ZZu <- M(XX, matrix(u, nrow = 1)) 
YYtrue <- ZZu + bias(XX) 
XXu <- cbind(XX, matrix(rep(u, nny), ncol = 2, byrow = TRUE))
Mhat.oos.u <- aGP.seq(XU, Z, XXu, da, methods, ncalib = 2, 
  omp.threads = nth, verb = 0)
YYm.pred.u <- predGP(cmle.u$gp, XX)
YY.pred.u <- YYm.pred.u$mean + Mhat.oos.u$mean
rmse.u <- sqrt(mean((YY.pred.u - YYtrue)^2))
deleteGP(cmle.u$gp)
Xu <- cbind(X, matrix(rep(u.hat, ny), ncol = 2, byrow = TRUE))
Mhat <- aGP.seq(XU, Z, Xu, da, methods, ncalib = 2, omp.threads = nth, 
  verb = 0)
cmle <- discrep.est(X, Y, Mhat$mean, d, g, bias.est, FALSE)
cmle$ll <- cmle$ll + beta.prior(u.hat)
print(c(cmle$ll, -outi$objective))
XXu <- cbind(XX, matrix(rep(u.hat, nny), ncol = 2, byrow = TRUE))
Mhat.oos <- aGP.seq(XU, Z, XXu, da, methods, ncalib = 2, 
  omp.threads = nth, verb = 0)
YYm.pred <- predGP(cmle$gp, XX)
YY.pred <- YYm.pred$mean + Mhat.oos$mean
rmse <- sqrt(mean((YY.pred - YYtrue)^2))
data.frame(u.hat = rmse, u = rmse.u)

** Ongoing development and extensions

The package is under active development, and the corpus of code was developed with ease of extension in mind. The calibration application from Section is a perfect example: simple functions tap into local GP emulators and full GP discrepancies alike, and are paired with existing direct optimizing subroutines from other packages for a powerful solution to large scale calibration problems that are becoming commonplace in the recent literature. As mentioned in Section , the implementation of separable modeling for local analysis is under active development and testing. Many of the associated subroutines (e.g., {laGPsep} and {aGPsep}) are available for use in the latest version of the package.

The library comprises roughly fifty functions, although barely a fraction of those are elevated to the user’s namespace for use in a typical session. Many of the inaccesible/undocumented functions have a purpose which, at this time, seem less directly useful outside their calling environment, but may eventually be promoted. Many higher level functions, like and which access subroutines, have a development-analog ( and ) implementing similar (usually with identical output, our a superset of output) subroutines entirely in . These were used as stepping stones in the development of the versions; however they remain relevant as a window into the inner-workings of the package and as a skeleton for curious users’ ambitions for new extensions. The local approximate GP methodology is, in a nutshell, just a judicious combination of established subroutines from the recent spatial statistics and computer experiments literature. We hope that exposing those combinations in well-organized code will spur others to take a similar tack in developing their own solutions in novel contexts.

One example involves deploying basic package functionality—only utilizing full (non local) GP subroutines—for solving blackbox optimization problems under constraints. showed how the augmented Lagrangian (AL), an apparatus popular for solving similar constrained optimization problems in the recent literature , could be combined with the method of expected improvement to solve a particular type of optimization where the objective was known (and in particular was linear), but where the constraints required (potentially expensive) simulation. Searching for an optimal valid setting of the inputs to the blackbox function could be substantially complicated by a difficult-to-map constraint satisfaction boundary. The package includes a demo [see ] showcasing a variation on one of the examples from . The problem therein involves modeling an objective and two constraints with GP predictors, together with an EI calculation on an AL predictive composite. The demo shows how the new, statistical, AL method outperforms the non-statistical analog.

Most of the work for this article was completed while the author was in the Booth School of Business at The University of Chicago. The author is grateful for partial support from National Science Foundation grant DMS-1521702.

In the bulk of this document, and in the core package routines (e.g., , and ) the treatment and default generation of initial values, regularization (priors), and bounding boxes, is largely hidden from the user. Some exceptions include places where it is desirable to have each instance of a repeated call, e.g., in a Monte Carlo experiment, share identical inferential conditions across subtly varying (randomly generated) data sets. In those cases, and generate values that control and limit the behaviors of the estimating algorithms for the lengthscale (\(\theta\)/) and nugget (\(\eta\)/), respectively. Although the package allows inference to proceed without regularization (true MLEs), and arbitrary starting values to be provided, generating sensible ones automatically is a key component in guaranteeing stable behavior out-of-the-box. In settings where potentially thousands of such calculations occur in parallel and without opportunity for individual scrutiny or intervention, such as via [Section ], sensible defaults are essential.

The two methods and , which are invoked by and unless overrides are provided, leverage crude input summary statistics. For example, calculates squared distances between elements of the design matrix to determine appropriate regularization. A bounding box for is derived from the min and max distances, and a diffuse Gamma prior prescribed with and set so that the maximum squared distance lies at the position of the 95% quantile. Together these define the regularization of MLE estimates for , or equivalently depict (a search for) the maximum {} (MAP) value. We prefer the term MLE as the purpose of the prior is to guard against pathologies, rather than to interject information. The starting -value is chosen the 10% quantile of the calculated distances.

The function makes similar calculations on the sum of squared residuals in from , an exception being that by default the minimum nugget value is taken to be . When invoked by a higher level routine such as or , the output values of and can be overridden via the and arguments by specifying list elements of the same names as the output values they are overriding. The outputs can also be fed to other, lower level routines such as .

Here we provide hints for enabling the parallelization hooks, via for multi-core machines and for graphics cards. The package also includes some wrapper functions, like , which allow a large predictive set to be divvied up amongst multiple nodes in a cluster established via the or packages.

Several routines in the package include support for parallelization on multi-core machines. The most important one is , allowing large prediction problems to be divvied up and distributed across multiple threads to be run in parallel. The speedups are roughly linear as long as the numbers of threads is less than or equal to the number of cores. This is controlled through the argument.

If is compiled with support enabled—which at the time of writing is standard in most builds—then no special action is needed in order to extend that functionality to . It will just work. One way to check if this is the case on your machine is to provide an argument, say to , that is bigger than one. If support is not enabled then you will get a warning. If you are working within a well-managed supercomputing facility, with a custom compilation, it is likely that has been properly compiled with support. If not, perhaps it is worth requesting that it be re-compiled as there are many benefits to doing so, beyond those that extend to the package. For example, many linear algebra intensive packages, of which is one, benefit from linking to MKL libraries from Intel, in addition to . Note, however, that some customized libraries (e.g., ) are not compatible with because they are not (at the time of writing) thread safe.

At the time of writing, some incompatibilities between multi-threaded BLAS (e.g., Intel MKL) and OpenMP (e.g., non-Intel, like with GCC) are still in the process of being resolved. In some builds and instantiations can create nested threads of different types (Intel for linear algebra, and GCC for parallel local design). Problematic behavior has been observed when using with GCC OpenMP and MKL multi-threaded linear algebra. Generally speaking, since uses threads to divvy up local design tasks, a threaded linear algebra subroutine library is not recommended in combination with these routines.

In the case where you are using a standard binary, it is still possible to compile from source with features assuming your compiler (e.g., GCC) supports them. This is a worthwhile step if you are working on a multi-core machine, which is rapidly becoming the standard setup. For those with experience compiling packages from source, the procedure is straightforward and does not require installing a bespoke version of . Obtain the package source (e.g., from CRAN) and, before compiling, open up the package and make two small edits to laGP/src/Makevars. These instructions assume a GCC compiler. For other compilers, please consult documentation for appropriate flags.

The laGP/src/Makevars file contains commented out lines which implement these changes. Once made, simply install the package as usual, either doing ``R CMD INSTALL’’ on the modified directory, or after re-tarring it up. Note that for Apple machines as of Xcode v5, with OSX Mavericks, the compiler provided by Apple does not include OpenMP support. We suggest downloading GCC v9 or later, for example from , and following the instructions therein.

If hyperthreading is enabled, then a good default for is two-times the number of cores. Choosing an value which is greater than the max allowed by the configuration on your machine leads to a notice being printed indicating that the max-value will be used instead.

The package supports graphics card acceleration of a key subroutine: searching for the next local design sight \(x_{j+1}\) over a potentially vast number of candidates \(X_N \setminus X_n(x)\)—Step 2(b) in Figure . Custom complication is required to enable this feature, the details of which are described here, and also requires a properly configured Nvidia Graphics card, drivers, and compilation programs (e.g., the Nvidia compiler ). Compiling and linking to libraries can be highly architecture and operating system specific, therefore the very basic instructions here may not work widely. They have been tested on a variety of Unix-alikes including Intel-based Ubuntu Linux and OSX systems.

First compile the file into an object using the Nvidia complier. E.g., after untarring the package change into and do

Alternatively, you can use/edit the ``’’ definition in the provided.

Then, make the following changes to , possibly augmenting changes made above to accommodate support. (i.e., using multiple CPU threads) brings out the best in our GPU implementation.

The file contains commented out lines which implement these changes. Once made, simply install the package as usual. Alternatively, use via the definitions in the to compile a standalone shared object.

The four functions in the package with GPU support are , , , and . The first two have a simple switch which allows a single search (Step 2(b)) to be off-loaded to a single GPU. Both also support off-loading the same calculations to multiple cores in a CPU, via if enabled. The latter variations control the GPU interface via two arguments: and . The former specifies how many GPUs you wish to use, and indicating more than you actually have will trip an error. The latter, which defaults to , specifies how many CPU threads should be used to queue GPU jobs. Having is an inefficient use of resources, whereas , up to will give modest speedups. Having multiple threads queue onto the same GPU reduces the amount of time the GPU is idle. support must be included in the package to have more than one GPU thread.

By default, is set to zero when since divvying the work amongst GPU and CPU threads can present load balancing challenges. However, if you get the load balancing right you can observe substantial speedups. saw up to 50% speedups, and recommend a scheme for allocating with a setting of that allocates about 90% of the work to GPUs () and 10% to the ten threads. As with , maxes out at the maximum number of threads indicated by your configuration. Moreover, must not exceed that value. When that happens both are first thresholded independently, then may be further reduced to stay within the limit.


  1. A footnote here.↩︎