## install.packages("devtools")
## devtools::install_github("r-lib/devtools")
<- "http://owos.gm.fh-koeln.de:8055/bartz/spot.git"
url ::install_git(url = url) devtools
2.2.4
.library("SPOT")
packageVersion("SPOT")
#> [1] '2.2.10'
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:
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.
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
The figure sizes have been customised so that you can easily put two images side-by-side.
plot(1:10)
plot(10:1)
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.
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)
library(sensitivity)
<- morris(model = morris.fun, factors = 20, r = 4,
x design = list(type = "oat", levels = 5, grid.jump = 3))
print(x)
plot(x)
library(rgl)
plot3d.morris(x) # (requires the package 'rgl')
<- function(X){
morris.fun_matrix <- morris.fun(X) cbind(res_vector, 2 * res_vector)
res_vector
}<- morris(model = morris.fun_matrix, factors = 20, r = 4,design = list(type = "oat", levels = 5, grid.jump = 3))
x plot(x, y_col = 2)
title(main = "y_col = 2")
# Also only for demonstration purposes: a model function returning a # three-dimensional array
<- function(X){
morris.fun_array <- morris.fun(X)
res_vector <- cbind(res_vector, 2 * res_vector) array(data = c(res_matrix, 5 * res_matrix),
res_matrix dim = c(length(res_vector), 2, 2))
}<- morris(model = morris.fun_array, factors = 20, r = 4,
x design = list(type = "simplex", scale.factor = 1)) plot(x, y_col = 2, y_dim3 = 2)
title(main = "y_col = 2, y_dim3 = 2")
<- parameterSets(par.ranges=list(V1=c(1,1000),V2=c(1,4)), samples=c(10,10),method="grid")
X.grid plot(X.grid)
library(randtoolbox)
<-parameterSets(par.ranges=list(V1=c(1,1000),V2=c(1,4)),
X.sobolsamples=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)
<- 100
n <- data.frame(X1 = runif(n, 0.5, 1.5),
X X2 = runif(n, 1.5, 4.5),
X3 = runif(n, 4.5, 13.5))
# linear model : Y = X1^2 + X2 + X3
<- with(X, X1^2 + X2 +X3)
y # sensitivity analysis
<- pcc(X, y, nboot = 100)
x print(x)
plot(x)
library(ggplot2)
ggplot(x)
<- pcc(X, y, semi = TRUE, nboot = 100)
x print(x)
plot(x)
# a model with interactions
<- 50
p <- 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)
beta <- 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
gamma[<- function(x) { return(sum(x * beta) + (x %*% gamma %*% x))} f
library(babsim.hospital)
library(sensitivity)
library(SPOT)
<- getBounds()
bounds <- matrix(bounds$lower,1,)
lower <- matrix(bounds$upper,1,)
upper # 10 iterations of SB
<- 29
p = 29
k <- sb(p, interaction = FALSE)
sa for (i in 1 : k) {
<- ask(sa)
x <- list()
y 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
<- matrix(x[[i]],1,)
u <- getNatDesignFromCoded(u, a = lower, b=upper)
u <- as.numeric( funBaBSimHospital(u, nCores=20) )
y[[i]]
}tell(sa, y)
}print(sa)
plot(sa)
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)
<- 1000
n <- data.frame(matrix(runif(8 * n), nrow = n))
X1 <- data.frame(matrix(runif(8 * n), nrow = n))
X2 # sensitivity analysis
<- sobol(model = sobol.fun, X1 = X1, X2 = X2, order = 2, nboot = 100)
x print(x)
plot(x)
library(ggplot2)
ggplot(x)
Example of use of fast99 with “model = NULL”
library(sensitivity)
<- fast99(model = NULL, factors = 29, n = 100, q="qunif", q.arg = list(min = 0, max =1))
x <- getBounds()
bounds <- bounds$lower
lower <- bounds$upper
upper <- code2nat(matrix(x$X, lower, upper)
x1 <- funBaBSimHospital(x1)
y tell(x,y)
print(x)
plot(x)
rm(list=ls())
library(microbenchmark)
library(SPOT)
library(babsim.hospital)
set.seed(1)
# n = number of function evvaluations:
<- 3
n <- matrix(as.numeric(getParaSet(5374)[1,-1]),1,)
x <- getBounds()
bounds <- bounds$lower
lower <- bounds$upper
upper
<- microbenchmark(
resb 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)
rm(list=ls())
library(microbenchmark)
library(SPOT)
library(babsim.hospital)
set.seed(1)
<- matrix(as.numeric(getParaSet(5374)[1,-1]),1,)
x0 <- getBounds()
bounds <- bounds$lower
lower <- bounds$upper
upper
set.seed(1)
<- spot(x= x0, funBaBSimHospital, lower , upper, control=list(maxTime = 1, funEvals=100, plots=FALSE,
perf1 model = buildKriging, optimizer=optimNLOPTR), nCores =5)
set.seed(1)
<- spot(x= x0, funBaBSimHospital, lower , upper, control=list(maxTime = 1, funEvals=100, plots=FALSE,
perf2 model = buildGaussianProcess, optimizer=optimNLOPTR, directOptControl = list(funEvals=0)), nCores =5)
set.seed(1)
<- spot(x= x0, funBaBSimHospital, lower , upper, control=list(maxTime = 1, funEvals=100, plots=FALSE,
perf3 model = buildGaussianProcess, optimizer=optimNLOPTR,
directOptControl = list(funEvals=10)), nCores = 5)
rm(list=ls())
library(microbenchmark)
library(SPOT)
library(babsim.hospital)
set.seed(1)
<- sqrt(.Machine$double.eps)
eps <- getBounds()
bounds <- matrix(bounds$lower,1)
a <- matrix(bounds$upper,1)
b <- dim(a)[2]
d
= 20
d <- function (n, d, a, b) {
fried #X <- designLHD(lower = lower, upper = upper, control = list(size = n))
<- lhs::randomLHS(n, d)
X ##XX <- code2nat(x=X, a=a, b=b)
###Ytrue <- funBaBSimHospital(XX, totalRepeats = 5, nCores = 5)
<- funSphere(X[,-1])
Ytrue <- Ytrue
Y # Y <- Ytrue + rnorm(n, 0, 1)
return(data.frame(X, Y, Ytrue))
}
<- fried(n=25*d, d=d, a=a, b=b)
data =as.matrix(data[,1:d])
x=data$Y y
<- buildTreeModel(x,y)
fitTree plot(fitTree)
<- buildKrigingDACE(x,y)
fitKrigingDACE print(fitKrigingDACE$like)
<- 100*d
N <- 10*d
G <- q1 <- q2 <- matrix(NA, ncol=d, nrow=G)
m <- seq(0, 1, length=G)
grid <- matrix(NA, ncol=d, nrow=N) XX
<- getBounds()
bounds <- matrix(bounds$lower,1)
a <- matrix(bounds$upper,1)
b for(j in 1:d)
for(i in 1:G) {
{ <- grid[i]
XX[,j] -j] <- lhs::randomLHS(N, d-1)
XX[,## XX <- code2nat(XX, a, b)
##p <- laGP::predGPsep(gpi, XX, lite=TRUE, nonug=TRUE)
$target <- "s"
fitKrigingDACE<- predict(fitKrigingDACE, XX)
p <- mean(p$y)
m[i,j] ## 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)))
<- mean(qnorm(0.05, p$y, sqrt(p$s)))
q1[i,j] <- mean(qnorm(0.95, p$y, sqrt(p$s)))
q2[i,j]
} }
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::newGPsep(as.matrix(data[,1:29]), data$Y, d=0.1,g=var(data$Y)/10, dK=TRUE)
gpi <- laGP::mleGPsep(gpi, param="both", tmin=rep(eps, 2),
mle tmax=c(10, var(data$Y)))
<- 1000
N <- 30
G <- q1 <- q2 <- matrix(NA, ncol=29, nrow=G)
m <- seq(0, 1, length=G)
grid <- matrix(NA, ncol=29, nrow=N) XX
<- getBounds()
bounds <- matrix(bounds$lower,1)
a <- matrix(bounds$upper,1)
b for(j in 1:29)
for(i in 1:G) {
{ <- grid[i]
XX[,j] -j] <- lhs::randomLHS(N, 28)
XX[,## XXX <- code2nat(XX, a, b)
<- laGP::predGPsep(gpi, XX, lite=TRUE, nonug=TRUE)
p <- mean(p$mean)
m[i,j] <- mean(qnorm(0.05, p$mean, sqrt(p$s2)))
q1[i,j] <- mean(qnorm(0.95, p$mean, sqrt(p$s2)))
q2[i,j]
} }
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)
# n = problem dim
<- 30
n = -2
low = 2
up = runif(n, low, 0)
a = runif(n, 0, up)
b = a + runif(n)*(b-a)
x0 #plot(a, type = "l", ylim=c(up,low))
#lines(b)
#lines(x0)
= matrix( x0, nrow = 1)
x0
set.seed(1)
<- spot(x= x0, funSphere, a, b, control=list(maxTime = 0.25, funEvals=10*n, plots=TRUE,
perf1 model = buildKriging, optimizer=optimNLOPTR))
set.seed(1)
<- spot(x= x0, funSphere, a, b, control=list(maxTime = 0.25, funEvals=10*n, plots=TRUE,
perf2 model = buildGaussianProcess, optimizer=optimNLOPTR, directOptControl = list(funEvals=0)))
set.seed(1)
<- spot(x= x0, funSphere, a, b, control=list(maxTime = 0.25, funEvals=10*n, plots=TRUE,
perf3 model = buildGaussianProcess, optimizer=optimNLOPTR,
directOptControl = list(funEvals=10)))
rm(list=ls())
library(microbenchmark)
library(SPOT)
set.seed(1)
<- 30
n = -2
low = 2
up = runif(n, low, 0)
a = runif(n, 0, up)
b = a + runif(n)*(b-a)
x0 #plot(a, type = "l", ylim=c(up,low))
#lines(b)
#lines(x0)
= matrix( x0, nrow = 1)
x0
<- 10
reps <- 10*n
end <- n
ninit
<- matrix(NA, nrow = reps, ncol = end)
progSpot for(r in 1:reps){
set.seed(r)
<- a + runif(n)*(b-a)
x0 = matrix( x0, nrow = 1)
x0 <- spot(x= x0, funSphere, a, b, control=list(funEvals=end,
sol model = buildGaussianProcess,
optimizer=optimNLOPTR,
directOptControl = list(funEvals=0),
designControl = list(size = ninit)))
<- bov(sol$y, end)
progSpot[r, ]
}
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")
<- funSphere
f
<- function(x) {
fprime <- matrix( x, 1)
x <- as.vector(f(x))
ynew <<- c(y, ynew)
y return(ynew)
}
<- matrix(NA, nrow=reps, ncol=end)
progOptim for(r in 1:reps) {
<- c()
y <- a + runif(n)*(b-a)
x0 <- matrix( x0, 1, )
x0 <- optim(x0, fprime, lower=a, upper=b, method="L-BFGS-B")
os <- bov(y, end)
progOptim[r,]
}
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
<- function(region = 5374, nCores = 2){
getParallelBaseObjFun = 10/nCores ## cores are used in parallel, change repeats if desired
N_REPEATS <- function(index, x){
singleRepeat = babsim.hospital::rkidata
rkiwerte = babsim.hospital::icudata
icuwerte <- rkiwerte[rkiwerte$Refdatum <= as.Date("2020-12-09"),]
rkiwerte <- icuwerte[icuwerte$daten_stand <= as.Date("2020-12-09"),]
icuwerte <- 5374
region <- babsim.hospital:::getTrainTestObjFun(region = region,
fun 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){
<- mclapply(1:N_REPEATS, singleRepeat, x, mc.cores = nCores)
res <- as.numeric(unlist(res))
y median(y)
}
}## Call Example
<- getParallelBaseObjFun()
objFun objFun(as.numeric(babsim.hospital::getParaSet(5315)[1,-1]))
### Old Version
packageVersion("babsim.hospital")
<- getTrainTestObjFun(verbosity = 10000,
funHosp parallel=TRUE,
tryOnTestSet=FALSE,
TrainSimStartDate = Sys.Date() - 12 * 7)
<- function(x)
f matrix(apply(x, # matrix
{1, # margin (apply over rows)
funHosp),1) # number of columns
,
}
<- getBounds()$lower
lo <- getBounds()$upper
up
<- length(lo)
n <- 10
reps <- 3*n
end <- n+1
ninit
<- getStartParameter(region = 5374)
para
<- matrix(NA, nrow = reps, ncol = end)
progSpot for(r in 1:reps){
set.seed(r)
<- para[1,]
x0 = matrix( x0, nrow = 1)
x0 <- spot(x= x0, f, lo, up, control=list(funEvals=end,
sol model = buildGaussianProcess,
optimizer=optimNLOPTR,
directOptControl = list(funEvals= n),
designControl = list(size = ninit)))
<- bov(sol$y, end)
progSpot[r, ]
}
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
<- function(x) {
fprime <- matrix( x, 1)
x <- as.vector(f(x))
ynew <<- c(y, ynew)
y return(ynew)
}
<- matrix(NA, nrow=reps, ncol=end)
progOptim for(r in 1:reps) {
<- c()
y <- para[1,]
x0 <- matrix( x0, 1, )
x0 <- optim(x0, fprime, lower=lo, upper=up, method="L-BFGS-B", control = list(maxit = end))
os <- bov(y, end)
progOptim[r,]
}
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")
library("laGP")
library("MASS")
library("lhs")
library("akima")
library("tgp")
library("SPOT")
<- 200
N <- matrix( seq(from=-1, to = 1, length.out = N), ncol = 1)
x <- funSphere(x) + rnorm(N, 0, 0.1)
y ###################################################################################################
#' 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))
###################################################################################################
<- g <- NULL
d <-list(samp.size = 100,
conmodelControl = list(modelInitialized = FALSE))
names(control)] <- control
con[<-con
control
## Case 1: model is not initialized:
if (control$modelControl$modelInitialized == FALSE){
$x <- x
control$y <- y
control<- laGP::darg(NULL, x, samp.size = control$samp.size)
d <- laGP::garg(list(mle = TRUE), y)
g <- laGP::newGPsep(x, y, d = d$start,
fit g = g$start, dK = TRUE)
::jmleGPsep(fit,
laGPdrange = c(d$min, d$max),
grange = c(g$min, g$max),
dab = d$ab,
gab = g$ab)
$fit <- fit
control$d <- d
control$g <- g
control$pNames <- colnames(x)
control$yName <- "y"
controlclass(control) <- "spotGaussianProcessModel"
}
$modelControl$modelInitialized <- TRUE
control
<- matrix( c(-0.1, 0.1), ncol = 1)
xNew
$xNewActualSize <- nrow(xNew)
control<- rbind(x, xNew)
x <- funSphere(x) + rnorm(N+control$xNewActualSize, 0, 0.1)
y ## Case 2: model is already initialized:
<- nrow(x)
n <- (n - control$xNewActualSize +1):n
indices <- x[indices, , drop = FALSE]
xnew <- y[indices, ,drop = FALSE]
ynew ::updateGPsep(control$fit, xnew, ynew)
laGP::jmleGPsep(control$fit,
laGPdrange = c(control$d$min, control$d$max),
grange = c(control$g$min, control$g$max),
dab = control$d$ab,
gab = control$g$ab)
## prediction:
<- matrix( c(-0.1, 0.1), ncol = 1)
xNew predGPsep(control$fit, XX = xNew, lite = TRUE)
<- as.data.frame(xNew)
newdata predict(control$fit, xNew)
<-function(object, newdata, ...){
predict.spotGaussianProcessModel<- as.data.frame(newdata)
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)
}
<- matrix(seq(0, 2 * pi,length = 6), ncol = 1)
X str(X)
<- sin(X)
Z <- newGP(X, Z, 2, 1e-6, dK = TRUE)
gp str(gp)
mleGP(gp, tmax=20)
<- matrix(seq(-1, 2 * pi + 1, length = 499), ncol = ncol(X))
XX str(XX)
<- predGP(gp, XX)
p str(p)
library("mvtnorm")
<- 100
N <- rmvt(N, p$Sigma, p$df)
ZZ <- ZZ + t(matrix(rep(p$mean, N), ncol = N))
ZZ 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)}
<- seq(-2, 2, by = 0.02)
x str(x)
<- as.matrix(expand.grid(x, x))
X str(X)
<- nrow(X)
N <- function(x)
f2d
{<- function(z)
g return(exp( - (z - 1)^2) + exp( -0.8 * (z + 1)^2)
- 0.05 * sin(8 * (z + 0.1)))
-g(x[,1]) * g(x[,2])
}<- f2d(X)
Y str(Y)
<- matrix(c(-1.725, 1.725), nrow = 1)
Xref <- laGP(Xref, 6, 50, X, Y, d = 0.1, method="mspe")
p.mspe str(p.mspe)
<- laGP(Xref, 6, 50, X, Y, d = 0.1, method="alc")
p.alc str(p.alc)
<- rbind(X[p.mspe$Xi, ], X[p.alc$Xi, ])
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")
}
<- rbind(c(p.mspe$mean, p.mspe$s2, p.mspe$df),
p c(p.alc$mean, p.alc$s2, p.alc$df))
colnames(p) <- c("mean", "s2", "df")
rownames(p) <- c("mspe", "alc")
p
$mle
p.mspe$mle p.alc
c(p.mspe$time, p.alc$time)
<- seq(-1.97, 1.95, by = 0.04)
xx str(xx)
<- as.matrix(expand.grid(xx, xx))
XX str(XX)
<- f2d(XX)
YY str(YY)
<- as.numeric(Sys.getenv("OMP_NUM_THREADS"))
nth <- 10
nth if(is.na(nth)) nth <- 2
print(nth)
<- aGP(X, Y, XX, omp.threads = nth, verb = 0) P.alc
persp(xx, xx, -matrix(P.alc$mean, ncol = length(xx)), phi=45, theta=45,
main = "", xlab = "x1", ylab = "x2", zlab = "yhat(x)")
<- 0.51
med <- XX[, 2] == med
zs <- sqrt(P.alc$var[zs])
sv <- range(c(-P.alc$mean[zs] + 2 * sv, -P.alc$mean[zs] - 2 * sv))
r 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)
<- P.alc$mean - YY
diff 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")
<- data.frame(y = log(P.alc$mle$d), XX)
df <- loess(y ~ ., data = df, span = 0.01)
lo 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")
<- aGP(X, Y, XX, d = exp(lo$fitted), omp.threads = nth, verb = 0) P.alc2
<- data.frame(alc = sqrt(mean((P.alc$mean - YY)^2)),
rmse alc2 = sqrt(mean((P.alc2$mean - YY)^2)))
rmse
<- laGP(Xref, 6, 50, X, Y, d = 0.1, method = "alcray") p.alcray
plot(X[p.alc$Xi,], xlab = "x1", ylab = "x2", type = "n",
main="comparing local designs", xlim = range(Xi[ ,1]),
ylim = range(Xi[ ,2]))
text(X[p.alc$Xi,], labels = 1:length(p.alc$Xi), cex = 0.7, col = 2)
text(X[p.alcray$Xi,], labels=1:length(p.mspe$Xi), cex=0.7, col = 3)
points(Xref[1], Xref[2], pch = 19, col = 3)
legend("topright", c("alc", "alcray"), text.col = c(2,3), bty = "n")
$time p.alcray
<- rbind(p, c(p.alcray$mean, p.alcray$s2, p.alcray$df))
p rownames(p)[3] <- c("alcray")
p
<- aGP(X, Y, XX, method = "alcray", omp.threads = nth, verb = 0)
P.alcray <- data.frame(y = log(P.alcray$mle$d), XX)
dfray <- loess(y ~ ., data = dfray, span = 0.01)
loray <- aGP(X, Y, XX, method = "alcray", d = exp(loray$fitted),
P.alcray2 omp.threads = nth, verb = 0)
c(P.alcray$time, P.alcray2$time)
<- cbind(rmse,
rmse data.frame(alcray=sqrt(mean((P.alcray$mean - YY)^2)),
alcray2=sqrt(mean((P.alcray2$mean - YY)^2))))
rmse
<- 100000
N <- 1000
Npred <- 8
dim library("lhs")
<- 10
T <- rep(NA, T)
nas <- rmse <- data.frame(mspe = nas, mspe2 = nas,
times 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)
<- function(x){
borehole <- x[1] * (0.15 - 0.05) + 0.05
rw <- x[2] * (50000 - 100) + 100
r <- x[3] * (115600 - 63070) + 63070
Tu <- x[4] * (1110 - 990) + 990
Hu <- x[5] * (116 - 63.1) + 63.1
Tl <- x[6] * (820 - 700) + 700
Hl <- x[7] * (1680 - 1120) + 1120
L <- x[8] * (12045 - 9855) + 9855
Kw <- 2 * pi * Tu * (Hu - Hl)
m1 <- log(r / rw)
m2 <- 1 + 2 * L * Tu / (m2 * rw^2 * Kw) + Tu / Tl
m3 return(m1/m2/m3)
}
for(t in 1:T) {
<- randomLHS(N + Npred, dim)
x <- apply(x, 1, borehole)
y .0 <- y[-(1:N)]; y <- y[1:N]
ypred<- x[-(1:N),]; x <- x[1:N,]
xpred
formals(aGP)[c("omp.threads", "verb")] <- c(nth, 0)
formals(aGP)[c("X", "Z", "XX")] <- list(x, y, xpred)
<- aGP(d=list(mle = FALSE, start = 0.7))
out1$alc.nomle[t] <- sqrt(mean((out1$mean - ypred.0)^2))
rmse$alc.nomle[t] <- out1$time
times
<- aGP(d = list(max = 20))
out2 $alc[t] <- sqrt(mean((out2$mean - ypred.0)^2))
rmse$alc[t] <- out2$time
times
<- aGP(d = list(start = out2$mle$d, max = 20))
out3 $alc2[t] <- sqrt(mean((out3$mean - ypred.0)^2))
rmse$alc2[t] <- out3$time
times
<- aGP(d = list(max = 20), method="alcray")
out4 $alcray[t] <- sqrt(mean((out4$mean - ypred.0)^2))
rmse$alcray[t] <- out4$time
times
<- aGP(d = list(start = out4$mle$d, max = 20), method="alcray")
out5 $alcray2[t] <- sqrt(mean((out5$mean - ypred.0)^2))
rmse$alcray2[t] <- out5$time
times
<- aGP(d = list(max = 20), method="mspe")
out6$mspe[t] <- sqrt(mean((out6$mean - ypred.0)^2))
rmse$mspe[t] <- out6$time
times
<- aGP(d = list(start = out6$mle$d, max = 20), method="mspe")
out7 $mspe2[t] <- sqrt(mean((out7$mean - ypred.0)^2))
rmse$mspe2[t] <- out7$time
times
<- aGP(d = list(mle = FALSE, start = 0.7), method = "nn")
out8 $nn.nomle[t] <- sqrt(mean((out8$mean - ypred.0)^2))
rmse$nn.nomle[t] <- out8$time
times
<- aGP(end = 200, d = list(mle = FALSE), method = "nn")
out9 $big.nn.nomle[t] <- sqrt(mean((out9$mean - ypred.0)^2))
rmse$big.nn.nomle[t] <- out9$time
times
<- aGP(d = list(max = 20), method = "nn")
out10 $nn[t] <- sqrt(mean((out10$mean - ypred.0)^2))
rmse$nn[t] <- out10$time
times
<- aGP(end = 200, d = list(max = 20), method="nn")
out11 $big.nn[t] <- sqrt(mean((out11$mean - ypred.0)^2))
rmse$big.nn[t] <- out11$time
times
<- aGP(end = 200, d = list(max = 20), method="alcray")
out12 $big.alcray[t] <- sqrt(mean((out12$mean - ypred.0)^2))
rmse$big.alcray[t] <- out12$time
times
<- aGP(end = 200, d = list(start = out12$mle$d, max = 20),
out13 method="alcray")
$big.alcray2[t] <- sqrt(mean((out13$mean - ypred.0)^2))
rmse$big.alcray2[t] <- out13 $time
times }
<- apply(times, 2, mean, na.rm = TRUE)
timev <- apply(rmse, 2, mean)
rmsev <- cbind(timev, rmsev)
tab <- order(rmsev, decreasing = FALSE)
o <- rep(NA, length(rmsev))
tt for(i in 1:(length(o)-1)) {
<- t.test(rmse[ ,o[i]], rmse[ ,o[i+1]], alternative = "less",
tto paired = TRUE)
<- tto$p.value
tt[o[i]]
}<- cbind(tab, data.frame(tt))
tab tab[o, ]
<- matrix(NA, nrow = T, ncol = dim)
thats <- rep(NA, T)
its <- 1000
n
<- garg(list(mle = TRUE), y)
g2 <- darg(list(mle = TRUE, max = 100), x)
d2
for(t in 1:T) {
<- sample(1:N, n, replace = FALSE)
subs
<- newGPsep(x[subs, ], y[subs], rep(d2$start, dim), g = 1/1000,
gpsepi dK = TRUE)
<- mleGPsep(gpsepi, param = "d", tmin = d2$min, tmax = d2$max,
that ab = d2$ab, maxit = 200)
<- that$d
thats[t,] <- that$its
its[t]
deleteGPsep(gpsepi)
}
boxplot(thats, main = "distribution of thetas", xlab = "input",
ylab = "theta")
<- sqrt(apply(thats, 2, median))
scales <- x; xpreds <- xpred
xs for(j in 1:ncol(xs)) {
<- xs[,j] / scales[j]
xs[,j] <- xpreds[,j] / scales[j]
xpreds[,j] }
<- aGP(xs, y, xpreds, d=list(start=1, max=20), method="alcray") out14
sqrt(mean((out14$mean - ypred.0)^2))
library("MASS")
<- darg(NULL, mcycle[, 1, drop = FALSE])
d <- garg(list(mle = TRUE), mcycle[,2])
g <- newGP(mcycle[ , 1, drop=FALSE], mcycle[ ,2], d = d$start,
motogp 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)
<- matrix(seq(min(mcycle[ ,1]), max(mcycle[ ,1]), length = 100),
XX ncol = 1)
<- predGP(motogp, XX = XX, lite = TRUE)
motogp.p <- aGP(mcycle[ , 1, drop=FALSE], mcycle[,2], XX, end = 30,
motoagp d = d, g = g, verb = 0)
plot(mcycle, cex = 0.5, main = "motorcycle data")
lines(XX, motogp.p$mean, lwd = 2)
<- qnorm(0.05, mean = motogp.p$mean, sd = sqrt(motogp.p$s2))
q1 <- qnorm(0.95, mean = motogp.p$mean, sd = sqrt(motogp.p$s2))
q2 lines(XX, q1, lty = 2, lwd = 2)
lines(XX, q2, lty = 2, lwd = 2)
lines(XX, motoagp$mean, col = 2, lwd = 2)
<- qnorm(0.05, mean = motoagp$mean, sd = sqrt(motoagp$var))
q1 <- qnorm(0.95, mean = motoagp$mean, sd = sqrt(motoagp$var))
q2 lines(XX, q1, lty = 2, col = 2, lwd = 2)
lines(XX, q2, lty = 2, col = 2, lwd = 2)
<- matrix(rep(mcycle[ ,1], 10), ncol = 1)
X <- X + rnorm(nrow(X), sd = 1)
X <- rep(mcycle[ ,2], 10)
Z <- aGP(X, Z, XX, end = 30, d = d, g = g, verb = 0) motoagp2
plot(X, Z, main = "simulating a larger data setup", xlab = "times",
ylab = "accel")
lines(XX, motoagp2$mean, col = 2, lwd = 2)
<- qnorm(0.05, mean = motoagp2$mean, sd = sqrt(motoagp2$var))
q1 <- qnorm(0.95, mean = motoagp2$mean, sd = sqrt(motoagp2$var))
q2 lines(XX, q1, col = 2, lty = 2, lwd = 2)
lines(XX, q2, col = 2, lty = 2, lwd = 2)
** Calibration *** An illustrative example
<- function(x,u)
M
{<- as.matrix(x)
x <- as.matrix(u)
u <- (1 - exp(-1 / (2 * x[,2])))
out <- out * (1000 * u[,1] * x[,1]^3 + 1900 * x[ ,1]^2
out + 2092 * x[ ,1] + 60)
<- out / (100 * u[,2] * x[,1]^3 + 500 * x[ ,1]^2 + 4 * x[ ,1] + 20)
out return(out)
}
<- function(x)
bias
{<- as.matrix(x)
x <- 2 * (10 * x[ ,1]^2 + 4 * x[ ,2]^2) / (50 * x[ ,1] * x[ ,2] + 10)
out return(out)
}
library("tgp")
<- matrix(rep(0:1, 4), ncol = 2, byrow = 2)
rect <- 50
ny <- lhs(ny, rect[1:2,] )
X <- c(0.2, 0.1)
u <- M(X, matrix(u, nrow = 1))
Zu <- 0.5
sd <- 2
reps <- rep(Zu, reps) + rep(bias(X), reps) +
Y rnorm(reps * length(Zu), sd = sd)
<- 10000
nz <- lhs(nz, rect)
XU <- matrix(NA, nrow=10 * ny, ncol = 4)
XU2 for(i in 1:10) {
<- ((i - 1) * ny + 1):(ny * i)
I 1:2] <- X
XU2[I,
}3:4] <- lhs(10 * ny, rect[3:4, ])
XU2[ ,<- rbind(XU, XU2)
XU <- M(XU[ ,1:2], XU[ ,3:4]) Z
<- TRUE
bias.est <- rep("alc", 2)
methods <- d <- darg(NULL, XU)
da <- garg(list(mle = TRUE), Y) g
<- function(u, a = 2, b = 2, log = TRUE)
beta.prior
{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)))
}
<- 10*ncol(X)
initsize <- 0.1
imesh <- rect[1:2,]
irect 1] <- irect[,1] + imesh/2
irect[,2] <- irect[,2] - imesh/2
irect[,<- lhs(10 * initsize, irect)
uinit.cand <- dopt.gp(initsize, Xcand = lhs(10 * initsize, irect))$XX
uinit <- rep(NA, nrow(uinit))
llinit for(i in 1:nrow(uinit)) {
<- fcalib(uinit[i,], XU, Z, X, Y, da, d, g, beta.prior,
llinit[i] verb = 0)
methods, M, bias.est, nth, }
library("crs")
<- list("MAX_BB_EVAL" = 1000, "INITIAL_MESH_SIZE" = imesh,
opts "MIN_POLL_SIZE" = "r0.001", "DISPLAY_DEGREE" = 0)
<- 0
its <- order(llinit)
o <- 1
i <- NULL
out while(its < 10) {
<- snomadr(fcalib, 2, c(0,0), 0, x0 = uinit[o[i],],
outi 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 + outi$iterations
its if(is.null(out) || outi$objective < out$objective) out <- outi
<- i + 1;
i }
<- rbind(uinit, as.matrix(fcalib.save[ ,1:2]))
Xp <- c(-llinit, fcalib.save[ ,3])
Zp <- which(!is.finite(Zp))
wi if(length(wi) > 0) { Xp <- Xp[-wi, ]; Zp <- Zp[-wi]}
<- interp(Xp[ ,1], Xp[ ,2], Zp, duplicate = "mean") surf
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)
<- outi$solution
u.hat points(u.hat[1], u.hat[2], col = 4, pch = 18)
abline(v = u[1], lty = 2)
abline(h = u[2], lty = 2)
<- cbind(X, matrix(rep(u, ny), ncol = 2, byrow = TRUE))
Xu <- aGP.seq(XU, Z, Xu, da, methods, ncalib = 2, omp.threads = nth,
Mhat.u verb = 0)
<- discrep.est(X, Y, Mhat.u$mean, d, g, bias.est, FALSE)
cmle.u $ll <- cmle.u$ll + beta.prior(u) cmle.u
data.frame(u.hat = -outi$objective, u = cmle.u$ll)
<- 1000
nny <- lhs(nny, rect[1:2,])
XX <- M(XX, matrix(u, nrow = 1))
ZZu <- ZZu + bias(XX) YYtrue
<- cbind(XX, matrix(rep(u, nny), ncol = 2, byrow = TRUE))
XXu <- aGP.seq(XU, Z, XXu, da, methods, ncalib = 2,
Mhat.oos.u omp.threads = nth, verb = 0)
<- predGP(cmle.u$gp, XX)
YYm.pred.u <- YYm.pred.u$mean + Mhat.oos.u$mean
YY.pred.u <- sqrt(mean((YY.pred.u - YYtrue)^2))
rmse.u deleteGP(cmle.u$gp)
<- cbind(X, matrix(rep(u.hat, ny), ncol = 2, byrow = TRUE))
Xu <- aGP.seq(XU, Z, Xu, da, methods, ncalib = 2, omp.threads = nth,
Mhat verb = 0)
<- discrep.est(X, Y, Mhat$mean, d, g, bias.est, FALSE)
cmle $ll <- cmle$ll + beta.prior(u.hat) cmle
print(c(cmle$ll, -outi$objective))
<- cbind(XX, matrix(rep(u.hat, nny), ncol = 2, byrow = TRUE))
XXu <- aGP.seq(XU, Z, XXu, da, methods, ncalib = 2,
Mhat.oos omp.threads = nth, verb = 0)
<- predGP(cmle$gp, XX)
YYm.pred <- YYm.pred$mean + Mhat.oos$mean
YY.pred <- sqrt(mean((YY.pred - YYtrue)^2)) rmse
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., {} and {}) 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 doAlternatively, 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.
A footnote here.↩︎