| OPE {OPE} | R Documentation |
Initialise and fit an outer-product emlator to the multivariate evaluations of a computer model (referred to below as a ‘simulator’). Make predictions and sample from them.
initOPE(gr, kappar, Gs, Ws, NIG)
resetOPE(OPE)
adjustOPE(OPE, R, Y)
predictOPE(OPE, Rp, type = c('Student-t', 'EV'), drop = TRUE)
sampleOPE(OPE, Rp, N, drop = TRUE)
gr |
Function to compute regressors for runs |
kappar |
Function to compute residual variance for runs |
Gs |
Regression matrix for the simulator outputs |
Ws |
Variance matrix for the outputs |
NIG |
List of Normal Inverse Gamma parameters for [beta, tau]; with
names m, V, a, and d |
OPE |
Object with class ‘OPE’ |
R,Rp |
Object containing the input values for the runs (see, Details, below) |
Y |
Matrix of outputs |
type |
Type of output returned from predictOPE |
drop |
Simplify outputs when only one run? |
N |
Number of random samples in sampleOPE |
For flexibility, the format of R and Rp is unrestricted.
The crucial thing is that functional calls such as gr(R),
kappar(R), and kappar(R, Rp) all result in matrices of
the appropriate size. So, for example, R might be a vector, a
matrix, or a dataframe, as long as gr and kappar are
written accordingly.
When predicting, the full distribution over all runs in Rp is
returned. Often the inter-run covariances are not required, ie the
predictions are required marginally, one run at a time. In this case
the user should call predictOPE one run at a time. Note that
this cannot be automated within predictOPE because it would
require some knowledge of the format of Rp.
Names: The primary source of output names are the column
names of Y, passed into adjustOPE. Where this has not
been called (eg where predictOPE is called after
initOPE), or where NULL, output names are taken from the
row names of Gs. Run names are taken from the row names of
gr(Rp).
|
Creates an object of class ‘OPE’. The other functions take such an object and either modify it, or do something with it. |
|
Strips the ensemble from the ‘OPE’ object, and returns the object. |
|
Adds an ensemble to the ‘OPE’ object, and returns the object. Only one ensemble can be added. Multiple ensembles should be concatenated. |
|
Predicts the simulator response at a given set of
runs. If type = "Student-t" the prediction takes the form of a
list with three components: mu, the mean matrix; Sigma
the scale array; df, a scalar degrees of freedom. These are
parameters of a multivariate Student-t distribution. If type =
"EV" the list summarises this information in terms of: mu, the
mean matrix; Sigma, the variance array.
Note that these outputs have their natural shape. The mean matrix is np by q, where np is the number of rows of Rp and q is the number of columns of Y. The
variance array is four-dimensional. The exception is when np = 1 and drop = TRUE, in which case the mean is a vector
along the outputs, and the variance is a matrix. |
|
Samples the predictions of the simulator. The
resulting matrix is N by np by q. When
np = 1 and drop = TRUE, the second extent is
dropped. |
Jonathan Rougier, j.c.rougier@bristol.ac.uk
J.C. Rougier, 2007, Efficient emulators for multivariate deterministic functions, unpublished, available at http://www.maths.bris.ac.uk/~mazjcr/OPemulator.pdf
rmvt for sampling from a multivariate Student-t.
#### A simple example where x in [0, 1] and theta in [0, 2pi]. This
#### example has gr() a periodic function of theta, just for fun.
## here's the true function, and we'll generate some data
g <- function(x, theta) {
outer(x, theta, function(x, t) exp(-x) * sin(t - pi * x))
}
x <- c(0.1, 0.5, 0.7)
theta <- c(0, 1, 2, 3.5, 5) # uneven spacing more interesting
Y <- g(x, theta)
## little picture
matplot(theta, t(Y), xlim = c(0, 2 * pi), ylim = c(-1, 1),
type = 'p', pch = 1:3, bty = 'n',
xlab = "Theta in [0, 2pi]", ylab = "g(x, theta)",
main = "True function and evaluations")
tfull <- seq(from = 0, to = 2*pi, len = 101)
matplot(tfull, t(g(x, tfull)), type = "l", lty = 2, add = TRUE)
legend('topright', legend = paste('x =', x),
col = 1:3, lty = 2, pch = 1:3, bty = 'n')
## Set up the regressors and variance functions: polynomials for the
## runs regressors (should be Legendre polynomials really, shifted
## onto [0, 1]); Fourier terms for outputs regressors; power
## exponential for the runs variance function; circular correlation
## for the outputs variance matrix (note that pi cannot be too small
## or this variance is singular)
## put rownames in gr and on Gs, just for clarity
gr <- function(x) {
robj <- cbind(1, 2*x - 1, x^2)
rownames(robj) <- paste('x', seq(along = x), sep = '')
robj
}
kappar <- function(x, xp = x, range = 0.5)
exp(-abs(outer(x, xp, '-') / range)^(3/2))
Gs <- cbind(1, sin(theta), cos(theta), sin(2 * theta), cos(2 * theta))
rownames(Gs) <- paste('th', seq(along = theta), sep = '')
circular <- function(ang1, ang2 = ang1, range = pi / 1.1)
{
smallestAngle <- function(a, b) {
dd <- outer(a, b, '-')
pmin(abs(dd), abs(2*pi + dd), abs(dd - 2*pi))
}
angles <- smallestAngle(ang1, ang2)
ifelse(angles < range, 1 - angles / range, 0)
}
Ws <- circular(theta)
## Set up a minimal prior for the NIG (in general, thought is required
## here!)
local({
vr <- length(gr(0))
vs <- ncol(Gs)
m <- rep(0, vr * vs)
V <- diag(1^2, vr * vs)
a <- 1
d <- 1^2
NIG <<- list(m = m, V = V, a = a, d = d)
})
## Now we're ready to initialise our OPE
myOPE <- initOPE(gr = gr, kappar = kappar, Gs = Gs, Ws = Ws, NIG = NIG)
xnew <- 0.4
pp0 <- predictOPE(myOPE, Rp = xnew) # prior prediction
## Adjust with the evaluations
myOPE <- adjustOPE(myOPE, R = x, Y = Y)
## Sanity check: predict the points we already have
pp1 <- predictOPE(myOPE, R = x)
stopifnot(
all.equal.numeric(pp1$mu, Y, check.attributes = FALSE),
all.equal.numeric(pp1$Sigma, array(0, dim(pp1$Sigma)))
) # phew!
## Make a prediction at some new x values, and add to the plot as
## error bars
pp2 <- predictOPE(myOPE, Rp = xnew)
pp2$mu <- c(pp2$mu) # reshape for convenience
dim(pp2$Sigma) <- rep(length(pp2$mu), 2) #
mu <- pp2$mu
sig <- sqrt(diag(pp2$Sigma))
arrows(theta, mu + sig * qt(0.025, df = pp2$df),
theta, mu + sig * qt(0.975, df = pp2$df),
code = 3, angle = 90, length = 0.1, col = 'blue')
lines(tfull, g(xnew, tfull), col = 'blue')
## Add on some sampled values, interpolated using splines
rsam <- sampleOPE(myOPE, Rp = xnew, N = 10)
if (require(splines)) {
for (i in 1:nrow(rsam)) {
pispl <- periodicSpline(theta, rsam[i, ], period = 2*pi)
lines(predict(pispl, tfull), col = 'darkgrey')
}
legend('topleft', legend = c(paste('x =', xnew, '(predicted)'), 'sampled'),
col = c('blue', 'darkgrey'), lty = 1, pch = NA, bty = 'n')
}
## A more complicated prediction
xnew <- c(xnew, 0.8)
pp3 <- predictOPE(myOPE, Rp = xnew, type = 'EV')