Nothing
##' Modification of an R function to be used as with methods \code{predict} and \code{update} (similar to a \code{\link[DiceKriging]{km}} object).
##' It creates an S4 object which contains the values corresponding to evaluations of other costly observations.
##' It is useful when an objective can be evaluated fast.
##' @title Fastfun function
##' @param fn the evaluator function, found by a call to \code{\link[base]{match.fun}},
##' @param design a data frame representing the design of experiments.
##' The ith row contains the values of the d input variables corresponding to the ith evaluation.
##' @param response optional vector (or 1-column matrix or data frame) containing the values of the 1-dimensional output given by the objective function at the design points.
##' @import methods
##' @export
##' @examples
##' @return An object of class \code{\link[DiceOptim]{fastfun-class}}.
`fastfun` <-
function(fn, design, response = NULL) {
model <- new("fastfun")
data <- data.frame(design)
X <- as.matrix(data)
fn <- match.fun(fn)
if(is.null(response)){
response <- apply(design, 1, fn)
}
y <- matrix(response, ncol=1)
model@X <- X
model@y <- y
model@d <- ncol(X)
model@n <- nrow(X)
model@fun <- fn
return(model)
}
## ----------------
## CLASS definition
## ----------------
## fastfun Class
##' Class for fast to compute objective.
##' @slot d spatial dimension,
##' @slot n observations number,
##' @slot X the design of experiments, size \code{n x d},
##' @slot y the observations, size \code{n x 1},
##' @slot fun the evaluator function.
##' @section Objects from the Class : To create a \code{fastfun} object, use \code{\link[DiceOptim]{fastfun}}. See also this function for more details and examples.
##' @export
setClass("fastfun",
representation(
d = "integer", ## spatial dimension
n = "integer", ## observations number
## data
X = "matrix", ## the design of experiments, size nxd
y = "matrix", ## the observations, size nx1
fun = "function" ## the evaluator
)
)
# if(!isGeneric("show")) {
# setGeneric(name = "show",
# def = function(object) standardGeneric("show")
# )
# }
#
# setMethod("show", "fastfun",
# function(object){
# show.fastfun(object)
# }
# )
##*****************************************************************************
## P R E D I C T METHOD
##*****************************************************************************
predict.fastfun <- function(object, newdata, cov.compute = TRUE, light.return = FALSE, ...) {
res <- list(trend = NULL, mean = apply(newdata, 1, object@fun), sd = rep(0, nrow(newdata)))
if(!light.return & cov.compute){
res$cov <- matrix(0, nrow(newdata), nrow(newdata))
}
res$trend <- res$mean
res$lower95 <- res$mean
res$upper95 <- res$mean
return(res)
}
if(!isGeneric("predict")) {
setGeneric(name = "predict",
def = function(object, ...) standardGeneric("predict")
)
}
##' @describeIn fastfun Predict(by evaluating \code{fun}) the result at a new observation.
##' @param newdata Matrix of the new location for the design
setMethod("predict", "fastfun",
function(object, newdata, ...) {
predict.fastfun(object = object, newdata = newdata, ...)
}
)
##****************************************************************************
## update METHOD
##****************************************************************************
update.fastfun <- function(object, newX, newy, ...){
object@X <- rbind(object@X, matrix(newX, ncol=ncol(object@X), byrow=TRUE))
object@y <- rbind(object@y, matrix(newy, ncol=1, byrow=TRUE))
object@n <- as.integer(object@n + 1)
return(object)
}
if(!isGeneric("update")) {
setGeneric(name = "update",
def = function(object, ...) standardGeneric("update")
)
}
##' @param object \code{\link[DiceOptim]{fastfun}} object
##' @param newX Matrix of the new location for the design
##' @param newy Matrix of the responses at \code{newX}
##' @param ... further arguments (not used)
##' @describeIn fastfun Update the \code{X} and \code{y} slots with a new design and observation.
##' @keywords internal
setMethod("update", "fastfun",
function(object, newX, newy, ...) {
update.fastfun(object = object, newX = newX, newy = newy, ...)
}
)
##****************************************************************************
## simulate METHOD
##****************************************************************************
simulate.fastfun <- function(object, nsim=1, seed=NULL, newdata=NULL,
cond=FALSE, nugget.sim=0, checkNames=TRUE, ...){
if(is.null(newdata)){
simulation <- as.vector(object@y)
}else{
simulation <- as.vector(apply(newdata, 1, object@fun))
}
return(matrix(simulation, nrow = nsim, ncol = length(simulation), byrow = T))
}
if(!isGeneric("simulate")) {
setGeneric(name = "simulate",
def = function(object, ...) standardGeneric("simulate")
)
}
##' @param object \code{\link[DiceOptim]{fastfun}} object
##' @param nsim an optional number specifying the number of response vectors to simulate. Default is 1.
##' @param seed usual seed argument of method simulate. Not used.
##' @param newdata an optional vector, matrix or data frame containing the points where to perform predictions.
##' Default is \code{NULL}: simulation is performed at design points specified in \code{object}.
##' @param cond an optional boolean indicating the type of simulations. Not used.
##' @param nugget.sim an optional number corresponding to a numerical nugget effect. Not used.
##' @param checkNames an optional boolean. Not used.
##' @param ... further arguments (not used)
##' @describeIn fastfun Simulate responses values (for compatibility with methods using \code{DiceKriging simulate})
##' @keywords internal
setMethod("simulate", "fastfun",
function(object, nsim, seed, newdata, cond, nugget.sim, checkNames, ...) {
simulate.fastfun(object = object, nsim = nsim, seed = seed, newdata = newdata,
cond = cond, nugget.sim = nugget.sim, checkNames = checkNames, ...)
}
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.