OPE {OPE}R Documentation

Outer product emulator

Description

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.

Usage

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)

Arguments

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

Details

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).

Value

initOPE Creates an object of class ‘OPE’. The other functions take such an object and either modify it, or do something with it.
resetOPE Strips the ensemble from the ‘OPE’ object, and returns the object.
adjustOPE Adds an ensemble to the ‘OPE’ object, and returns the object. Only one ensemble can be added. Multiple ensembles should be concatenated.
predictOPE 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.
sampleOPE 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.

Author(s)

Jonathan Rougier, j.c.rougier@bristol.ac.uk

References

J.C. Rougier, 2007, Efficient emulators for multivariate deterministic functions, unpublished, available at http://www.maths.bris.ac.uk/~mazjcr/OPemulator.pdf

See Also

rmvt for sampling from a multivariate Student-t.

Examples

#### 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')

[Package OPE version 0.7 Index]