Title:	Methods for Visualization of Computer Experiments Design and Surrogate
Version:	3.1-3
Date:	2025-06-13
Maintainer:	Yann Richet <yann.richet@irsn.fr>
Description:	View 2D/3D sections, contour plots, mesh of excursion sets for computer experiments designs, surrogates or test functions.
Depends:	methods, utils, stats, grDevices, graphics
Imports:	DiceDesign, R.cache, geometry, scatterplot3d, parallel, foreach
Suggests:	rlibkriging, DiceKriging, DiceEval, rgl, arrangements
License:	GPL-3
URL:	https://github.com/IRSN/DiceView
Repository:	CRAN
RoxygenNote:	7.3.1
Encoding:	UTF-8
NeedsCompilation:	no
Packaged:	2025-06-13 15:39:31 UTC; richet
Author:	Yann Richet [aut, cre], Yves Deville [aut], Clement Chevalier [ctb]
Date/Publication:	2025-06-13 16:10:02 UTC

Apply Functions Over Array Margins, using custom vectorization (possibly using parallel)

Description

Emulate parallel apply on a function, from mclapply. Returns a vector or array or list of values obtained by applying a function to margins of an array or matrix.

Usage

Apply.function(
  FUN,
  X,
  MARGIN = 1,
  .combine = c,
  .lapply = parallel::mclapply,
  ...
)

Arguments

Value

array of values taken by FUN on each row/column of X

Examples

X = matrix(runif(10),ncol=2);
  rowSums(X) == apply(X,1,sum)
  apply(X,1,sum) == Apply.function(sum,X)

X = matrix(runif(10),ncol=1)
  rowSums(X) == apply(X,1,sum)
  apply(X,1,sum) == Apply.function(sum,X)

X = matrix(runif(10),ncol=2)
f = function(X) X[1]/X[2]
apply(X,1,f) == Apply.function(f,X)

eval function and cast result to a list of y, y_low, y_up (possibly NA)

Description

eval function and cast result to a list of y, y_low, y_up (possibly NA)

Usage

EvalInterval.function(fun, X, vectorized = FALSE, dim = ncol(X))

Arguments

Value

list of y, y_low, y_up

Memoize a function

Description

Before each call of a function, check that the cache holds the results and returns it if available. Otherwise, compute f and cache the result for next evluations.

Usage

Memoize.function(fun, suffix = ".RcacheDiceView")

Arguments

Value

a function with same behavior than argument one, but using cache.

Examples

f=function(n) rnorm(n);
F=Memoize.function(f);
F(5); F(6); F(5)

Vectorize a multidimensional Function

Description

Vectorize a d-dimensional (input) function, in the same way that base::Vectorize for 1-dimensional functions.

Usage

Vectorize.function(
  fun,
  dim,
  .combine = rbind,
  .lapply = parallel::mclapply,
  ...
)

Arguments

Value

a vectorized function (to be called on matrix argument, on each row)

Examples

f = function(x)x[1]+1; f(1:10); F = Vectorize.function(f,1);
F(1:10); #F = Vectorize(f); F(1:10);

f2 = function(x)x[1]+x[2]; f2(1:10); F2 = Vectorize.function(f2,2);
F2(cbind(1:10,11:20));

f3 = function(x)list(mean=x[1]+x[2],se=x[1]*x[2]); f3(1:10); F3 = Vectorize.function(f3,2);
F3(cbind(1:10,11:20));

Checks if some points belong to a given mesh

Description

Checks if some points belong to a given mesh

Usage

are_in.mesh(X, mesh)

Arguments

Examples

X = matrix(runif(100),ncol=2);
inside = are_in.mesh(X,mesh=geometry::delaunayn(matrix(c(0,0,1,1,0,0),ncol=2),output.options =TRUE))
print(inside)
plot(X,col=rgb(1-inside,0,0+inside))

This is a simple copy of the Branin-Hoo 2-dimensional test function, as provided in DiceKriging package. The Branin-Hoo function is defined here over [0,1] x [0,1], instead of [-5,0] x [10,15] as usual. It has 3 global minima : x1 = c(0.9616520, 0.15); x2 = c(0.1238946, 0.8166644); x3 = c(0.5427730, 0.15)

Description

This is a simple copy of the Branin-Hoo 2-dimensional test function, as provided in DiceKriging package. The Branin-Hoo function is defined here over [0,1] x [0,1], instead of [-5,0] x [10,15] as usual. It has 3 global minima : x1 = c(0.9616520, 0.15); x2 = c(0.1238946, 0.8166644); x3 = c(0.5427730, 0.15)

Usage

branin(x)

Arguments

Value

A real number equal to the Branin-Hoo function values at x

Generalize expand.grid() for multi-columns data. Build all combinations of lines from X1 and X2. Each line may hold multiple columns.

Description

Generalize expand.grid() for multi-columns data. Build all combinations of lines from X1 and X2. Each line may hold multiple columns.

Usage

combn.design(X1, X2)

Arguments

Plot a contour view of a prediction model or function, including design points if available.

Description

Plot a contour view of a prediction model or function, including design points if available.

Usage

## S3 method for class ''function''
contourview(
  fun,
  vectorized = FALSE,
  center = NULL,
  lty_center = 2,
  col_center = "black",
  axis = NULL,
  npoints = 21,
  levels = 10,
  lty_levels = 3,
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels - 1) else if
    (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels - 1) else
    col.levels("blue", levels - 1),
  col = NULL,
  col_fading_interval = 0.5,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = if (!add) matrix(c(0, 1), 2, 2) else NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'matrix'
contourview(
  X,
  y,
  center = NULL,
  lty_center = 2,
  col_center = "black",
  axis = NULL,
  col_points = if (!is.null(col)) col else "red",
  col = NULL,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = if (!add) matrix(c(0, 1), 2, 2) else NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'character'
contourview(eval_str, axis = NULL, mfrow = NULL, ...)

## S3 method for class 'km'
contourview(
  km_model,
  type = "UK",
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(km_model@y, 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels) else if
    (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels - 1) else
    col.levels("blue", levels),
  col = NULL,
  conf_level = 0.5,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'Kriging'
contourview(
  Kriging_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(Kriging_model$y(), 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels) else if
    (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels - 1) else
    col.levels("blue", levels),
  col = NULL,
  conf_level = 0.5,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'NuggetKriging'
contourview(
  NuggetKriging_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(NuggetKriging_model$y(), 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels) else if
    (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels - 1) else
    col.levels("blue", levels),
  col = NULL,
  conf_level = 0.5,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'NoiseKriging'
contourview(
  NoiseKriging_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(NoiseKriging_model$y(), 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels) else if
    (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels - 1) else
    col.levels("blue", levels),
  col = NULL,
  conf_level = 0.5,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'glm'
contourview(
  glm_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(glm_model$fitted.values, 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels) else if
    (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels - 1) else
    col.levels("blue", levels),
  col = NULL,
  conf_level = 0.5,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'list'
contourview(
  modelFit_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(modelFit_model$data$Y, 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels) else if
    (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels - 1) else
    col.levels("blue", levels),
  col = NULL,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

contourview(...)

Arguments

Details

If available, experimental points are plotted with fading colors. Points that fall in the specified section (if any) have the color specified col_points while points far away from the center have shaded versions of the same color. The amount of fading is determined using the Euclidean distance between the plotted point and center.

Author(s)

Yann Richet, IRSN

See Also

sectionview.function for a section plot, and sectionview3d.function for a 2D section plot.

sectionview.matrix for a section plot, and sectionview3d.matrix for a 2D section plot.

contourview.matrix for a section plot.

sectionview.km for a section plot, and sectionview3d.km for a 2D section plot.

sectionview.Kriging for a section plot, and sectionview3d.Kriging for a 2D section plot.

sectionview.NuggetKriging for a section plot, and sectionview3d.NuggetKriging for a 2D section plot.

sectionview.NoiseKriging for a section plot, and sectionview3d.NoiseKriging for a 2D section plot.

sectionview.glm for a section plot, and sectionview3d.glm for a 2D section plot.

sectionview.glm for a section plot, and sectionview3d.glm for a 2D section plot.

Examples

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2 + rnorm(15)
model <- lm(y ~ x1 + x2)

contourview(function(x) sum(x),
                     Xlim=cbind(range(x1),range(x2)), col='black')
points(x1,x2)

contourview(function(x) {
                      x = as.data.frame(x)
                      colnames(x) <- all.vars(model$call)[-1]
                      predict.lm(model, newdata=x, se.fit=FALSE)
                    }, vectorized=TRUE, add=TRUE)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

contourview(X, y)

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2^2 + rnorm(15)
model <- glm(y ~ x1 + I(x2^2))

contourview(model)

contourview("abline(h=0.25,col='red')")
if (requireNamespace("DiceKriging")) { library(DiceKriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- km(design = X, response = y, covtype="matern3_2")

contourview(model)

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- Kriging(X = X, y = y, kernel="matern3_2")

contourview(model)

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin) + 5*rnorm(15)

model <- NuggetKriging(X = X, y = y, kernel="matern3_2")

contourview(model)

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin) + 5*rnorm(15)

model <- NoiseKriging(X = X, y = y, kernel="matern3_2", noise=rep(5^2,15))

contourview(model)

}

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2^2 + rnorm(15)
model <- glm(y ~ x1 + I(x2^2))

contourview(model)

if (requireNamespace("DiceEval")) { library(DiceEval)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- modelFit(X, y, type = "StepLinear")

contourview(model)

}

## A 2D example - Branin-Hoo function
contourview(branin, levels=30, col='black')

## Not run: 
## a 16-points factorial design, and the corresponding response
d <- 2; n <- 16
design.fact <- expand.grid(seq(0, 1, length = 4), seq(0, 1, length = 4))
design.fact <- data.frame(design.fact); names(design.fact) <- c("x1", "x2")
y <- branin(design.fact); names(y) <- "y"

if (requireNamespace("DiceKriging")) { library(DiceKriging)
## model: km
model <- DiceKriging::km(design = design.fact, response = y)
contourview(model, levels=30)
contourview(branin, levels=30, col='red', add=TRUE)
}

if (requireNamespace("rlibkriging")) { library(rlibkriging)
## model: Kriging
model <- Kriging(X = as.matrix(design.fact), y = as.matrix(y), kernel="matern3_2")
contourview(model, levels=30)
contourview(branin, levels=30, col='red', add=TRUE)
}

## model: glm
model <- glm(y ~ 1+ x1 + x2 + I(x1^2) + I(x2^2) + x1*x2, data=cbind(y,design.fact))
contourview(model, levels=30)
contourview(branin, levels=30, col='red', add=TRUE)

if (requireNamespace("DiceEval")) { library(DiceEval)
## model: StepLinear
model <- modelFit(design.fact, y, type = "StepLinear")
contourview(model, levels=30)
contourview(branin, levels=30, col='red', add=TRUE)
}

## End(Not run)

Create a Data Frame from all combinations of factor variables

Description

Generalization of base::expand.grid to more than 2 variables.

Usage

expand.grids(d = length(list(...)), ...)

Arguments

Value

data frame of all possible combinations of variables values

Examples

expand.grids(d=1)
expand.grids(d=1,seq(f=0,t=1,l=11))
expand.grids(d=2)
expand.grids(d=2,seq(f=0,t=1,l=11))
expand.grids(d=2,seq(f=0,t=1,l=11),seq(0,1,l=3))
expand.grids(d=3,seq(f=0,t=1,l=5))
expand.grids(d=NULL,seq(f=0,t=1,l=5),seq(f=0,t=1,l=5),seq(f=0,t=1,l=5))
expand.grids(seq(f=0,t=1,l=5),seq(f=0,t=1,l=5),seq(f=0,t=1,l=5))
expand.grids(d=4,seq(f=0,t=1,l=5))

Plot a contour view of a prediction model or function, including design points if available.

Description

Plot a contour view of a prediction model or function, including design points if available.

Usage

## S3 method for class ''function''
filledcontourview(
  fun,
  vectorized = FALSE,
  center = NULL,
  lty_center = 2,
  col_center = "black",
  axis = NULL,
  npoints = 21,
  levels = 10,
  lty_levels = 0,
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels, fill = TRUE)
    else if (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels, fill =
    TRUE) else col.levels("blue", levels, fill = TRUE),
  col = NULL,
  col_interval = "white",
  col_fading_interval = 0.5,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = if (!add) matrix(c(0, 1), 2, 2) else NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  add_fading = 0.5,
  ...
)

## S3 method for class 'km'
filledcontourview(
  km_model,
  type = "UK",
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(c(km_model@y + 2 * sqrt(km_model@covariance@sd2), km_model@y - 2 *
    sqrt(km_model@covariance@sd2)), 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels, fill = TRUE)
    else if (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels, fill =
    TRUE) else col.levels("blue", levels, fill = TRUE),
  col = NULL,
  conf_level = 0.5,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'Kriging'
filledcontourview(
  Kriging_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(Kriging_model$y(), 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels, fill = TRUE)
    else if (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels, fill =
    TRUE) else col.levels("blue", levels, fill = TRUE),
  col = NULL,
  conf_level = 0.5,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'NuggetKriging'
filledcontourview(
  NuggetKriging_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(NuggetKriging_model$y(), 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels, fill = TRUE)
    else if (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels, fill =
    TRUE) else col.levels("blue", levels, fill = TRUE),
  col = NULL,
  conf_level = 0.5,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'NoiseKriging'
filledcontourview(
  NoiseKriging_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(NoiseKriging_model$y(), 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels, fill = TRUE)
    else if (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels, fill =
    TRUE) else col.levels("blue", levels, fill = TRUE),
  col = NULL,
  conf_level = 0.5,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'glm'
filledcontourview(
  glm_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(glm_model$fitted.values, 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels, fill = TRUE)
    else if (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels, fill =
    TRUE) else col.levels("blue", levels, fill = TRUE),
  col = NULL,
  conf_level = 0.5,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'list'
filledcontourview(
  modelFit_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  levels = pretty(modelFit_model$data$Y, 10),
  col_points = if (!is.null(col) & length(col) == 1) col else "red",
  col_levels = if (!is.null(col) & length(col) == 1) col.levels(col, levels, fill = TRUE)
    else if (!is.null(col) & length(col) == 2) cols.levels(col[1], col[2], levels, fill =
    TRUE) else col.levels("blue", levels, fill = TRUE),
  col = NULL,
  bg_fading = 1,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

filledcontourview(...)

Arguments

Details

If available, experimental points are plotted with fading colors. Points that fall in the specified section (if any) have the color specified col_points while points far away from the center have shaded versions of the same color. The amount of fading is determined using the Euclidean distance between the plotted point and center.

Author(s)

Yann Richet, IRSN

See Also

sectionview.function for a section plot, and sectionview3d.function for a 2D section plot.

sectionview.km for a section plot, and sectionview3d.km for a 2D section plot.

sectionview.Kriging for a section plot, and sectionview3d.Kriging for a 2D section plot.

sectionview.NuggetKriging for a section plot, and sectionview3d.NuggetKriging for a 2D section plot.

sectionview.NoiseKriging for a section plot, and sectionview3d.NoiseKriging for a 2D section plot.

sectionview.glm for a section plot, and sectionview3d.glm for a 2D section plot.

sectionview.glm for a section plot, and sectionview3d.glm for a 2D section plot.

Examples

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2 + rnorm(15)
model <- lm(y ~ x1 + x2)

filledcontourview(function(x) sum(x),
                     Xlim=cbind(range(x1),range(x2)), col='black')
points(x1,x2)

filledcontourview(function(x) {
                      x = as.data.frame(x)
                      colnames(x) <- all.vars(model$call)[-1]
                      predict.lm(model, newdata=x, se.fit=FALSE)
                    }, vectorized=TRUE, dim=2,
                  Xlim=cbind(range(x1),range(x2)), add=TRUE)

if (requireNamespace("DiceKriging")) { library(DiceKriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- km(design = X, response = y, covtype="matern3_2")

filledcontourview(model)

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- Kriging(X = X, y = y, kernel="matern3_2")

filledcontourview(model)

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin) + 5*rnorm(15)

model <- NuggetKriging(X = X, y = y, kernel="matern3_2")

filledcontourview(model)

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin) + 5*rnorm(15)

model <- NoiseKriging(X = X, y = y, kernel="matern3_2", noise=rep(5^2,15))

filledcontourview(model)

}

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2^2 + rnorm(15)
model <- glm(y ~ x1 + I(x2^2))

filledcontourview(model)

if (requireNamespace("DiceEval")) { library(DiceEval)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- modelFit(X, y, type = "StepLinear")

filledcontourview(model)

}

## A 2D example - Branin-Hoo function
filledcontourview(branin, levels=30, col='black')

## Not run: 
## a 16-points factorial design, and the corresponding response
d <- 2; n <- 16
design.fact <- expand.grid(seq(0, 1, length = 4), seq(0, 1, length = 4))
design.fact <- data.frame(design.fact); names(design.fact) <- c("x1", "x2")
y <- branin(design.fact); names(y) <- "y"

if (requireNamespace("DiceKriging")) { library(DiceKriging)
## model: km
model <- DiceKriging::km(design = design.fact, response = y)
filledcontourview(model, levels=30)
filledcontourview(branin, levels=30, col='red', add=TRUE)
}

if (requireNamespace("rlibkriging")) { library(rlibkriging)
## model: Kriging
model <- Kriging(X = as.matrix(design.fact), y = as.matrix(y), kernel="matern3_2")
filledcontourview(model, levels=30)
filledcontourview(branin, levels=30, col='red', add=TRUE)
}

## model: glm
model <- glm(y ~ 1+ x1 + x2 + I(x1^2) + I(x2^2) + x1*x2, data=cbind(y,design.fact))
filledcontourview(model, levels=30)
filledcontourview(branin, levels=30, col='red', add=TRUE)

if (requireNamespace("DiceEval")) { library(DiceEval)
## model: StepLinear
model <- modelFit(design.fact, y, type = "StepLinear")
filledcontourview(model, levels=30)
filledcontourview(branin, levels=30, col='red', add=TRUE)
}

## End(Not run)

Checks if a mesh is valid

Description

Checks if a mesh is valid

Usage

is.mesh(x)

Arguments

Value

TRUE if mesh is valid

Checks if some point belongs to a given mesh

Description

Checks if some point belongs to a given mesh

Usage

is_in.mesh(x, mesh)

Arguments

Examples

is_in.mesh(-0.5,mesh=geometry::delaunayn(matrix(c(0,1),ncol=1),output.options =TRUE))
is_in.mesh(0.5,mesh=geometry::delaunayn(matrix(c(0,1),ncol=1),output.options =TRUE))

x =matrix(-.5,ncol=2,nrow=1)
is_in.mesh(x,mesh=geometry::delaunayn(matrix(c(0,0,1,1,0,0),ncol=2),output.options =TRUE))

x =matrix(.5,ncol=2,nrow=1)
is_in.mesh(x,mesh=geometry::delaunayn(matrix(c(0,0,1,1,0,0),ncol=2),output.options =TRUE))

Test if points are in a hull

Description

Test if points are in a hull

Usage

is_in.p(x, p, h = NULL)

Arguments

Examples

is_in.p(x=-0.5,p=matrix(c(0,1),ncol=1))
is_in.p(x=0.5,p=matrix(c(0,1),ncol=1))
is_in.p(x=matrix(-.5,ncol=2,nrow=1),p=matrix(c(0,0,1,1,0,0),ncol=2))
is_in.p(x=matrix(.25,ncol=2,nrow=1),p=matrix(c(0,0,1,1,0,0),ncol=2))
is_in.p(x=matrix(-.5,ncol=3,nrow=1),p=matrix(c(0,0,0,1,0,0,0,1,0,0,0,1),ncol=3,byrow = TRUE))
is_in.p(x=matrix(.25,ncol=3,nrow=1),p=matrix(c(0,0,0,1,0,0,0,1,0,0,0,1),ncol=3,byrow = TRUE))

Builds a mesh from a design aor set of points

Description

Builds a mesh from a design aor set of points

Usage

mesh(intervals, mesh.type = "seq", mesh.sizes = 11)

Arguments

Value

delaunay mesh (list(p,tri,...) from geometry)

Examples

mesh = mesh(intervals=matrix(c(0,1,0,1),ncol=2),mesh.type="unif",mesh.sizes=10)
plot2d_mesh(mesh)

Search excursion set of nD function, sampled by a mesh

Description

Search excursion set of nD function, sampled by a mesh

Usage

mesh_exsets(
  f,
  vectorized = FALSE,
  threshold,
  sign,
  intervals,
  mesh.type = "seq",
  mesh.sizes = 11,
  maxerror_f = 1e-09,
  tol = .Machine$double.eps^0.25,
  ex_filter.tri = all,
  num_workers = maxWorkers(),
  ...
)

Arguments

Examples

# mesh_exsets(function(x) x, threshold=.51, sign=1, intervals=rbind(0,1),
#   maxerror_f=1E-2,tol=1E-2, num_workers=1) # for faster testing
# mesh_exsets(function(x) x, threshold=.50000001, sign=1, intervals=rbind(0,1),
#   maxerror_f=1E-2,tol=1E-2, num_workers=1) # for faster testing
# mesh_exsets(function(x) sum(x), threshold=.51,sign=1, intervals=cbind(rbind(0,1),rbind(0,1)),
#   maxerror_f=1E-2,tol=1E-2, num_workers=1) # for faster testing
# mesh_exsets(sin,threshold=0,sign="sup",interval=c(pi/2,5*pi/2),
#   maxerror_f=1E-2,tol=1E-2, num_workers=1) # for faster testing

if (identical(Sys.getenv("NOT_CRAN"), "true")) { # too long for CRAN on Windows

  e = mesh_exsets(function(x) (0.25+x[1])^2+(0.5+x[2])^2 ,
                threshold =0.25,sign=-1, intervals=matrix(c(-1,1,-1,1),nrow=2),
                maxerror_f=1E-2,tol=1E-2, # for faster testing
                num_workers=1)

  plot(e$p,xlim=c(-1,1),ylim=c(-1,1));
  apply(e$tri,1,function(tri) polygon(e$p[tri,],col=rgb(.4,.4,.4,.4)))
  apply(e$frontiers,1,function(front) lines(e$p[front,],col='red'))

  if (requireNamespace("rgl")) {
    e = mesh_exsets(function(x) (0.5+x[1])^2+(-0.5+x[2])^2+(0.+x[3])^2,
                  threshold = .25,sign=-1, mesh.type="unif",
                  intervals=matrix(c(-1,1,-1,1,-1,1),nrow=2),
                  maxerror_f=1E-2,tol=1E-2, # for faster testing
                  num_workers=1)

    rgl::plot3d(e$p,xlim=c(-1,1),ylim=c(-1,1),zlim=c(-1,1));
    apply(e$tri,1,function(tri)rgl::lines3d(e$p[tri,]))
  }
}

Mesh level set of function

Description

Mesh level set of function

Usage

mesh_level(f, vectorized = FALSE, level = 0, intervals, mesh, ...)

Arguments

Minimal distance between one point to many points

Description

Minimal distance between one point to many points

Usage

min_dist(x, X, norm = rep(1, ncol(X)))

Arguments

Value

minimal distance

Examples

min_dist(runif(3),matrix(runif(30),ncol=3))

Compute distance between a point and a mesh

Description

Compute distance between a point and a mesh

Usage

min_dist.mesh(p, mesh, norm = rep(1, ncol(mesh$p)))

Arguments

Value

distance between x and mesh

Examples

 x = matrix(0,ncol=2)
 m = list(p = matrix(c(0,1,1,0,1,1),ncol=2,byrow=TRUE), tri = matrix(c(1,2,3),nrow=1))
 plot2d_mesh(m)
 points(x)
 min = min_dist.mesh(x,m)
 lines(rbind(x,attr(min,"proj")),col='red')

 m = mesh_exsets(function(x) (0.25+x[1])^2+(0.5+x[2]/2)^2, vec=FALSE,
                 1 ,1, intervals=rbind(cbind(0,0),cbind(1,1)), num_workers=1)
 plot2d_mesh(m)
 x = matrix(c(0.25,0.25),ncol=2)
 points(x)
 min = min_dist.mesh(x,m)
 lines(rbind(x,attr(min,"proj")),col='red')

Title optim wrapper for early stopping criterion

Description

Title optim wrapper for early stopping criterion

Usage

optim.stop(
  par,
  fn,
  gr = NULL,
  fn.stop = NA,
  fn.NaN = NaN,
  control = list(),
  ...
)

Arguments

Value

list with best solution and all solutions

Author(s)

Yann Richet, IRSN

Examples

fn = function(x) x^6
o = optim( par=15, fn,lower=-20,upper=20,method='L-BFGS-B')
o.s = optim.stop( par=15, fn,lower=-20,upper=20,method='L-BFGS-B',fn.stop=0.1)
#check o.s$value == 0.1 && o.s$counts < o$counts

Title Multi-local optimization wrapper for optim, using (possibly parallel) multistart.

Description

Title Multi-local optimization wrapper for optim, using (possibly parallel) multistart.

Usage

optims(
  pars,
  fn,
  fn.NaN = NaN,
  fn.stop = NA,
  .apply = "mclapply",
  pars.eps = 1e-05,
  control = list(),
  ...
)

Arguments

Value

list with best solution and all solutions

Author(s)

Yann Richet, IRSN

Examples

fn = function(x) ifelse(x==0,1,sin(x)/x)
# plot(fn, xlim=c(-20,20))
optim( par=5,                     fn,lower=-20,upper=20,method='L-BFGS-B')
optims(pars=t(t(seq(-20,20,,20))),fn,lower=-20,upper=20,method='L-BFGS-B')

# Branin function (3 local minimas)
f = function (x) {
  x1 <- x[1] * 15 - 5
  x2 <- x[2] * 15
  (x2 - 5/(4 * pi^2) * (x1^2) + 5/pi * x1 - 6)^2 + 10 * (1 - 1/(8 * pi)) * cos(x1) + 10
}
# expect to find 3 local minimas
optims(pars=matrix(runif(100),ncol=2),f,method="L-BFGS-B",lower=c(0,0),upper=c(1,1))

Plot a two dimensional mesh

Description

Plot a two dimensional mesh

Usage

plot2d_mesh(
  mesh,
  color.nodes = "black",
  color.mesh = "darkgray",
  alpha = 0.4,
  ...
)

Arguments

Examples

plot2d_mesh(mesh_exsets(f = function(x) sin(pi*x[1])*sin(pi*x[2]),
                        threshold=0,sign=1, mesh.type="unif",mesh.size=11,
                        intervals = matrix(c(1/2,5/2,1/2,5/2),nrow=2),
                        num_workers=1))

Plot a three dimensional mesh

Description

Plot a three dimensional mesh

Usage

plot3d_mesh(
  mesh,
  engine3d = NULL,
  color.nodes = "black",
  color.mesh = "darkgray",
  alpha = 0.4,
  ...
)

Arguments

Examples

if (identical(Sys.getenv("NOT_CRAN"), "true")) { # too long for CRAN on Windows

  plot3d_mesh(mesh_exsets(function(x) (0.5+x[1])^2+(-0.5+x[2])^2+(0.+x[3])^2,
                          threshold = .25,sign=-1, mesh.type="unif",
                          maxerror_f=1E-2,tol=1E-2, # faster display
                          intervals=matrix(c(-1,1,-1,1,-1,1),nrow=2),
                          num_workers=1),
                          engine3d='scatterplot3d')

  if (requireNamespace("rgl")) {
    plot3d_mesh(mesh_exsets(function(x) (0.5+x[1])^2+(-0.5+x[2])^2+(0.+x[3])^2,
                            threshold = .25,sign=-1, mesh.type="unif",
                            maxerror_f=1E-2,tol=1E-2, # faster display
                            intervals=matrix(c(-1,1,-1,1,-1,1),nrow=2),
                            num_workers=1),engine3d='rgl')
  }
}

Plot a one dimensional mesh

Description

Plot a one dimensional mesh

Usage

plot_mesh(
  mesh,
  y = 0,
  color.nodes = "black",
  color.mesh = "darkgray",
  alpha = 0.4,
  ...
)

Arguments

Examples

plot_mesh(mesh_exsets(function(x) x, threshold=.51, sign=1,
intervals=rbind(0,1), num_workers=1))
plot_mesh(mesh_exsets(function(x) (x-.5)^2, threshold=.1, sign=-1,
intervals=rbind(0,1), num_workers=1))

Extract points of mesh which belong to the mesh triangulation (may not contain all points)

Description

Extract points of mesh which belong to the mesh triangulation (may not contain all points)

Usage

points_in.mesh(mesh)

Arguments

Value

points coordinates inside the mesh triangulation

Extract points of mesh which do not belong to the mesh triangulation (may not contain all points)

Description

Extract points of mesh which do not belong to the mesh triangulation (may not contain all points)

Usage

points_out.mesh(mesh)

Arguments

Value

points coordinates outside the mesh triangulation

One Dimensional Root (Zero) Finding

Description

Search one root with given precision (on y). Iterate over uniroot as long as necessary.

Usage

root(
  f,
  lower,
  upper,
  maxerror_f = 1e-07,
  f_lower = f(lower, ...),
  f_upper = f(upper, ...),
  tol = .Machine$double.eps^0.25,
  convexity = FALSE,
  rec = 0,
  max.rec = NA,
  ...
)

Arguments

Author(s)

Yann Richet, IRSN

Examples

f=function(x) {cat("f");1-exp(x)}; f(root(f,lower=-1,upper=2))
f=function(x) {cat("f");exp(x)-1}; f(root(f,lower=-1,upper=2))

.f = function(x) 1-exp(1*x)
f=function(x) {cat("f");y=.f(x);points(x,y,pch=20,col=rgb(0,0,0,.2));y}
plot(.f,xlim=c(-1,2)); f(root(f,lower=-1,upper=2))

.f = function(x) exp(10*x)-1
f=function(x) {cat("f");y=.f(x);points(x,y,pch=20);y}
plot(.f,xlim=c(-1,2)); f(root(f,lower=-1,upper=2))

.f = function(x) exp(100*x)-1
f=function(x) {cat("f");y=.f(x);points(x,y,pch=20);y}
plot(.f,xlim=c(-1,2)); f(root(f,lower=-1,upper=2))

f=function(x) {cat("f");exp(100*x)-1}; f(root(f,lower=-1,upper=2))

## Not run: 

  # Quite hard functions to find roots

  ## Increasing function
  ## convex
  n.f=0
  .f = function(x) exp(10*x)-1
  f=function(x) {n.f<<-n.f+1;y=.f(x);points(x,y,pch=20);y}
  plot(.f,xlim=c(-.1,.2)); f(root(f,lower=-1,upper=2))
  print(n.f)
  ## non-convex
  n.f=0
  .f = function(x) 1-exp(-10*x)
  f=function(x) {n.f<<-n.f+1;y=.f(x);points(x,y,pch=20);y}
  plot(.f,xlim=c(-.1,.2)); f(root(f,lower=-1,upper=2))
  print(n.f)

  # ## Decreasing function
  # ## non-convex
  n.f=0
  .f = function(x) 1-exp(10*x)
  f=function(x) {n.f<<-n.f+1;y=.f(x);points(x,y,pch=20,col=rgb(0,0,0,.2));y}
  plot(.f,xlim=c(-.1,.2)); f(root(f,lower=-1,upper=2))
  print(n.f)
  # ## convex
  n.f=0
  .f = function(x) exp(-10*x)-1
  f=function(x) {n.f<<-n.f+1;y=.f(x);points(x,y,pch=20,col=rgb(0,0,0,.2));y}
  plot(.f,xlim=c(-.1,.2)); f(root(f,lower=-1,upper=2))
  print(n.f)

## End(Not run)

One Dimensional Multiple Roots (Zero) Finding

Description

Search multiple roots of 1D function, sampled/splitted by a (1D) mesh

Usage

roots(
  f,
  vectorized = FALSE,
  interval,
  maxerror_f = 1e-07,
  split = "seq",
  split.size = 11,
  tol = .Machine$double.eps^0.25,
  .lapply = parallel::mclapply,
  ...
)

Arguments

Value

array of x, so f(x)=target

Examples

roots(sin,interval=c(pi/2,5*pi/2))
roots(sin,interval=c(pi/2,1.5*pi/2))

f=function(x)exp(x)-1;
f(roots(f,interval=c(-1,2)))

f=function(x)exp(1000*x)-1;
f(roots(f,interval=c(-1,2)))

Multi Dimensional Multiple Roots (Zero) Finding, sampled by a mesh

Description

Multi Dimensional Multiple Roots (Zero) Finding, sampled by a mesh

Usage

roots_mesh(
  f,
  vectorized = FALSE,
  intervals,
  mesh.type = "seq",
  mesh.sizes = 11,
  maxerror_f = 1e-07,
  tol = .Machine$double.eps^0.25,
  num_workers = maxWorkers(),
  ...
)

Arguments

Value

matrix of x, so f(x)=0

Examples

roots_mesh(function(x) x-.51, intervals=rbind(0,1),
  num_workers=1)
roots_mesh(function(x) sum(x)-.51, intervals=cbind(rbind(0,1),rbind(0,1)),
  num_workers=1)
roots_mesh(sin,intervals=c(pi/2,5*pi/2),
  num_workers=1)
roots_mesh(f = function(x) sin(pi*x[1])*sin(pi*x[2]),
           intervals = matrix(c(1/2,5/2,1/2,5/2),nrow=2),
           num_workers=1)

r = roots_mesh(f = function(x) (0.25+x[1])^2+(0.5+x[2])^2 - .25,
intervals=matrix(c(-1,1,-1,1),nrow=2), mesh.size=5,
  num_workers=1)
plot(r,xlim=c(-1,1),ylim=c(-1,1))

r = roots_mesh(function(x) (0.5+x[1])^2+(-0.5+x[2])^2+(0.+x[3])^2 - .5,
               mesh.sizes = 11,
               intervals=matrix(c(-1,1,-1,1,-1,1),nrow=2),
               num_workers=1)
scatterplot3d::scatterplot3d(r,xlim=c(-1,1),ylim=c(-1,1),zlim=c(-1,1))

roots_mesh(function(x)exp(x)-1,intervals=c(-1,2),
           num_workers=1)
roots_mesh(function(x)exp(1000*x)-1,intervals=c(-1,2),
           num_workers=1)

Plot a section view of a prediction model or function, including design points if available.

Description

Plot a section view of a prediction model or function, including design points if available.

Usage

## S3 method for class ''function''
sectionview(
  fun,
  vectorized = FALSE,
  center = NULL,
  lty_center = 2,
  col_center = "black",
  axis = NULL,
  npoints = 101,
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  col_fading_interval = 0.5,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = if (!add) c(0, 1) else NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'matrix'
sectionview(
  X,
  y,
  center = NULL,
  lty_center = 2,
  col_center = "black",
  axis = NULL,
  col_points = if (!is.null(col)) col else "red",
  col = NULL,
  col_fading_interval = 0.5,
  bg_fading = 5,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = if (!add) c(0, 1) else NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'character'
sectionview(eval_str, axis = NULL, mfrow = NULL, ...)

## S3 method for class 'km'
sectionview(
  km_model,
  type = "UK",
  center = NULL,
  axis = NULL,
  npoints = 101,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  conf_level = 0.95,
  conf_fading = 0.5,
  bg_fading = 5,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'Kriging'
sectionview(
  Kriging_model,
  center = NULL,
  axis = NULL,
  npoints = 101,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  conf_level = 0.95,
  conf_fading = 0.5,
  bg_fading = 5,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'NuggetKriging'
sectionview(
  NuggetKriging_model,
  center = NULL,
  axis = NULL,
  npoints = 101,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  conf_level = 0.95,
  conf_fading = 0.5,
  bg_fading = 5,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'NoiseKriging'
sectionview(
  NoiseKriging_model,
  center = NULL,
  axis = NULL,
  npoints = 101,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  conf_level = 0.95,
  conf_fading = 0.5,
  bg_fading = 5,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'glm'
sectionview(
  glm_model,
  center = NULL,
  axis = NULL,
  npoints = 101,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  conf_level = 0.95,
  conf_fading = 0.5,
  bg_fading = 5,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

## S3 method for class 'list'
sectionview(
  modelFit_model,
  center = NULL,
  axis = NULL,
  npoints = 101,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  bg_fading = 5,
  mfrow = NULL,
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  ...
)

sectionview(...)

Arguments

Details

If available, experimental points are plotted with fading colors. Points that fall in the specified section (if any) have the color specified col_points while points far away from the center have shaded versions of the same color. The amount of fading is determined using the Euclidean distance between the plotted point and center.

Author(s)

Yann Richet, IRSN

See Also

sectionview.function for a section plot, and sectionview3d.function for a 2D section plot.

sectionview.matrix for a section plot, and sectionview3d.matrix for a 2D section plot.

sectionview.matrix for a section plot, and sectionview3d.matrix for a 2D section plot.

sectionview.km for a section plot, and sectionview3d.km for a 2D section plot.

sectionview.Kriging for a section plot, and sectionview3d.Kriging for a 2D section plot.

sectionview.NuggetKriging for a section plot, and sectionview3d.NuggetKriging for a 2D section plot.

sectionview.NoiseKriging for a section plot, and sectionview3d.NoiseKriging for a 2D section plot.

sectionview.glm for a section plot, and sectionview3d.glm for a 2D section plot.

sectionview.glm for a section plot, and sectionview3d.glm for a 2D section plot.

Examples

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2 + rnorm(15)
model <- lm(y ~ x1 + x2)

sectionview(function(x) sum(x),
                     center=c(0,0), Xlim=cbind(range(x1),range(x2)), col='black')

sectionview(function(x) {
                      x = as.data.frame(x)
                      colnames(x) <- all.vars(model$call)[-1]
                      p = predict.lm(model, newdata=x, se.fit=TRUE)
                      cbind(p$fit-1.96 * p$se.fit, p$fit+1.96 * p$se.fit)
                    }, vectorized=TRUE, add=TRUE)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

sectionview(X,y, center=c(.5,.5))

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2^2 + rnorm(15)
model <- glm(y ~ x1 + I(x2^2))

sectionview(model, center=c(.5,.5))

sectionview("abline(h=5)")
if (requireNamespace("DiceKriging")) { library(DiceKriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- km(design = X, response = y, covtype="matern3_2")

sectionview(model, center=c(.5,.5))

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- Kriging(X = X, y = y, kernel="matern3_2")

sectionview(model, center=c(.5,.5))

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin) + 5*rnorm(15)

model <- NuggetKriging(X = X, y = y, kernel="matern3_2")

sectionview(model, center=c(.5,.5))

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin) + 5*rnorm(15)

model <- NoiseKriging(X = X, y = y, kernel="matern3_2", noise=rep(5^2,15))

sectionview(model, center=c(.5,.5))

}

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2^2 + rnorm(15)
model <- glm(y ~ x1 + I(x2^2))

sectionview(model, center=c(.5,.5))

if (requireNamespace("DiceEval")) { library(DiceEval)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- modelFit(X, y, type = "StepLinear")

sectionview(model, center=c(.5,.5))

}

## A 2D example - Branin-Hoo function
sectionview(branin, center= c(.5,.5), col='black')

## Not run: 
## a 16-points factorial design, and the corresponding response
d <- 2; n <- 16
design.fact <- expand.grid(seq(0, 1, length = 4), seq(0, 1, length = 4))
design.fact <- data.frame(design.fact); names(design.fact) <- c("x1", "x2")
y <- branin(design.fact); names(y) <- "y"

if (requireNamespace("DiceKriging")) { library(DiceKriging)
## model: km
model <- DiceKriging::km(design = design.fact, response = y)
sectionview(model, center= c(.5,.5))
sectionview(branin, center= c(.5,.5), col='red', add=TRUE)
}

if (requireNamespace("rlibkriging")) { library(rlibkriging)
## model: Kriging
model <- Kriging(X = as.matrix(design.fact), y = as.matrix(y), kernel="matern3_2")
sectionview(model, center= c(.5,.5))
sectionview(branin, center= c(.5,.5), col='red', add=TRUE)
}

## model: glm
model <- glm(y ~ 1+ x1 + x2 + I(x1^2) + I(x2^2) + x1*x2, data=cbind(y,design.fact))
sectionview(model, center= c(.5,.5))
sectionview(branin, center= c(.5,.5), col='red', add=TRUE)

if (requireNamespace("DiceEval")) { library(DiceEval)
## model: StepLinear
model <- modelFit(design.fact, y, type = "StepLinear")
sectionview(model, center= c(.5,.5))
sectionview(branin, center= c(.5,.5), col='red', add=TRUE)
}

## End(Not run)

Plot a contour view of a prediction model or function, including design points if available.

Description

Plot a contour view of a prediction model or function, including design points if available.

Usage

## S3 method for class ''function''
sectionview3d(
  fun,
  vectorized = FALSE,
  center = NULL,
  axis = NULL,
  npoints = 21,
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  col_fading_interval = 0.5,
  mfrow = c(1, 1),
  Xlab = NULL,
  ylab = NULL,
  Xlim = if (!add) matrix(c(0, 1), 2, 2) else NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  engine3d = NULL,
  ...
)

## S3 method for class 'matrix'
sectionview3d(
  X,
  y,
  center = NULL,
  axis = NULL,
  col_points = if (!is.null(col)) col else "red",
  col = NULL,
  col_fading_interval = 0.5,
  bg_fading = 1,
  mfrow = c(1, 1),
  Xlab = NULL,
  ylab = NULL,
  Xlim = if (!add) matrix(c(0, 1), 2, 2) else NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  engine3d = NULL,
  ...
)

## S3 method for class 'character'
sectionview3d(eval_str, axis = NULL, mfrow = c(1, 1), ...)

## S3 method for class 'km'
sectionview3d(
  km_model,
  type = "UK",
  center = NULL,
  axis = NULL,
  npoints = 21,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  conf_level = 0.95,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = c(1, 1),
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  engine3d = NULL,
  ...
)

## S3 method for class 'Kriging'
sectionview3d(
  Kriging_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  conf_level = 0.95,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = c(1, 1),
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  engine3d = NULL,
  ...
)

## S3 method for class 'NuggetKriging'
sectionview3d(
  NuggetKriging_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  conf_level = 0.95,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = c(1, 1),
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  engine3d = NULL,
  ...
)

## S3 method for class 'NoiseKriging'
sectionview3d(
  NoiseKriging_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  conf_level = 0.95,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = c(1, 1),
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  engine3d = NULL,
  ...
)

## S3 method for class 'glm'
sectionview3d(
  glm_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  conf_level = 0.95,
  conf_fading = 0.5,
  bg_fading = 1,
  mfrow = c(1, 1),
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  engine3d = NULL,
  ...
)

## S3 method for class 'list'
sectionview3d(
  modelFit_model,
  center = NULL,
  axis = NULL,
  npoints = 21,
  col_points = if (!is.null(col)) col else "red",
  col_fun = if (!is.null(col)) col else "blue",
  col = NULL,
  bg_fading = 1,
  mfrow = c(1, 1),
  Xlab = NULL,
  ylab = NULL,
  Xlim = NULL,
  ylim = NULL,
  title = NULL,
  title_sep = " | ",
  add = FALSE,
  engine3d = NULL,
  ...
)

sectionview3d(...)

Arguments

Details

If available, experimental points are plotted with fading colors. Points that fall in the specified section (if any) have the color specified col_points while points far away from the center have shaded versions of the same color. The amount of fading is determined using the Euclidean distance between the plotted point and center.

Author(s)

Yann Richet, IRSN

See Also

sectionview.function for a section plot, and sectionview3d.function for a 2D section plot.

sectionview.matrix for a section plot, and sectionview3d.matrix for a 2D section plot.

sectionview3d.matrix for a section plot.

sectionview.km for a section plot, and sectionview3d.km for a 2D section plot.

sectionview.Kriging for a section plot, and sectionview3d.Kriging for a 2D section plot.

sectionview.NuggetKriging for a section plot, and sectionview3d.NuggetKriging for a 2D section plot.

sectionview.NoiseKriging for a section plot, and sectionview3d.NoiseKriging for a 2D section plot.

sectionview.glm for a section plot, and sectionview3d.glm for a 2D section plot.

sectionview.glm for a section plot, and sectionview3d.glm for a 2D section plot.

Examples

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2 + rnorm(15)
model <- lm(y ~ x1 + x2)

sectionview3d(function(x) sum(x),
                       Xlim=cbind(range(x1),range(x2)), col='black')
DiceView:::.plot3d(x1, x2, y)

sectionview3d(function(x) {
                      x = as.data.frame(x)
                      colnames(x) <- all.vars(model$call)[-1]
                      p = predict.lm(model, newdata=x, se.fit=TRUE)
                      list(mean=p$fit, se=p$se.fit)
                    }, vectorized=TRUE,
              add=TRUE)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

sectionview3d(X, y)

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2^2 + rnorm(15)
model <- glm(y ~ x1 + I(x2^2))

sectionview3d(model)

sectionview3d("abline(h=0.25,col='red')")
if (requireNamespace("DiceKriging")) { library(DiceKriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- km(design = X, response = y, covtype="matern3_2")

sectionview3d(model)

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- Kriging(X = X, y = y, kernel="matern3_2")

sectionview3d(model)

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin) + 5*rnorm(15)

model <- NuggetKriging(X = X, y = y, kernel="matern3_2")

sectionview3d(model)

}

if (requireNamespace("rlibkriging")) { library(rlibkriging)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin) + 5*rnorm(15)

model <- NoiseKriging(X = X, y = y, kernel="matern3_2", noise=rep(5^2,15))

sectionview3d(model)

}

x1 <- rnorm(15)
x2 <- rnorm(15)

y <- x1 + x2^2 + rnorm(15)
model <- glm(y ~ x1 + I(x2^2))

sectionview3d(model)

if (requireNamespace("DiceEval")) { library(DiceEval)

X = matrix(runif(15*2),ncol=2)
y = apply(X,1,branin)

model <- modelFit(X, y, type = "StepLinear")

sectionview3d(model)

}

## A 2D example - Branin-Hoo function
sectionview3d(branin, col='black')

## Not run: 
## a 16-points factorial design, and the corresponding response
d <- 2; n <- 16
design.fact <- expand.grid(seq(0, 1, length = 4), seq(0, 1, length = 4))
design.fact <- data.frame(design.fact); names(design.fact) <- c("x1", "x2")
y <- branin(design.fact); names(y) <- "y"

if (requireNamespace("DiceKriging")) { library(DiceKriging)
## model: km
model <- DiceKriging::km(design = design.fact, response = y)
sectionview3d(model)
sectionview3d(branin, col='red', add=TRUE)
}

if (requireNamespace("rlibkriging")) { library(rlibkriging)
## model: Kriging
model <- Kriging(X = as.matrix(design.fact), y = as.matrix(y), kernel="matern3_2")
sectionview3d(model)
sectionview3d(branin, col='red', add=TRUE)
}

## model: glm
model <- glm(y ~ 1+ x1 + x2 + I(x1^2) + I(x2^2) + x1*x2, data=cbind(y,design.fact))
sectionview3d(model)
sectionview3d(branin, col='red', add=TRUE)

if (requireNamespace("DiceEval")) { library(DiceEval)
## model: StepLinear
model <- modelFit(design.fact, y, type = "StepLinear")
sectionview3d(model)
sectionview3d(branin, col='red', add=TRUE)
}

## End(Not run)