├── DESCRIPTION ├── MD5 ├── NAMESPACE ├── NEWS ├── R ├── EPtest.R ├── PLI.R ├── PLIquantile.r ├── PLIquantile_multivar.r ├── PLIsuperquantile.r ├── PLIsuperquantile_multivar.r ├── PoincareChaosSqCoef.R ├── PoincareConstant.R ├── PoincareOptimal.R ├── RcppExports.R ├── addelman_kempthorne.R ├── base.R ├── bootstats.R ├── correlRatio.R ├── delsa.R ├── discrepancyCriteria_cplus.R ├── fast99.R ├── johnson.R ├── johnsonshap.R ├── lmg.R ├── maximin_cplus.R ├── morris.R ├── morrisMultOut.R ├── morris_oat.R ├── morris_sfd.R ├── nodeggplot.R ├── nodeplot.R ├── parameterSets.R ├── pcc.R ├── pme.R ├── pmvd.R ├── qosa.R ├── sb.R ├── sensiFdiv.R ├── sensiHSIC.R ├── shapleyBlockEstimation.R ├── shapleyLinearGaussian.R ├── shapleyPermEx.R ├── shapleyPermRand.R ├── shapleySubsetMc.R ├── shapleysobol_knn.R ├── simplex.R ├── sobol.R ├── sobol2002.R ├── sobol2007.R ├── sobolEff.R ├── sobolGP.R ├── sobolMultOut.R ├── sobolSalt.R ├── sobolSmthSpl.R ├── sobolTIIlo.R ├── sobolTIIpf.R ├── soboljansen.R ├── sobolmara.R ├── sobolmartinez.R ├── sobolowen.R ├── sobolrank.R ├── sobolrec.R ├── sobolrep.R ├── sobolroa_subroutines.R ├── sobolroalhs.R ├── sobolroauc.R ├── sobolshap_knn.R ├── soboltouati.R ├── squaredIntEstim.R ├── src.R ├── support.R ├── sysdata.rda ├── template_replace.R ├── testHSIC.R ├── testmodels.R └── weightTSA.R ├── inst └── COPYRIGHT ├── man ├── EPtest.Rd ├── PLI.Rd ├── PLIquantile.Rd ├── PLIquantile_multivar.Rd ├── PLIsuperquantile.Rd ├── PLIsuperquantile_multivar.Rd ├── PoincareChaosSqCoef.Rd ├── PoincareConstant.Rd ├── PoincareOptimal.Rd ├── addelman_const.Rd ├── correlRatio.Rd ├── decoupling.Rd ├── delsa.Rd ├── discrepancyCriteria_cplus.Rd ├── fast99.Rd ├── johnson.Rd ├── johnsonshap.Rd ├── lmg.Rd ├── maximin_cplus.Rd ├── morris.Rd ├── morrisMultOut.Rd ├── parameterSets.Rd ├── pcc.Rd ├── plot.support.Rd ├── pme.Rd ├── pmvd.Rd ├── qosa.Rd ├── sb.Rd ├── sensiFdiv.Rd ├── sensiHSIC.Rd ├── sensitivity-package.Rd ├── shapleyBlockEstimation.Rd ├── shapleyLinearGaussian.Rd ├── shapleyPermEx.Rd ├── shapleyPermRand.Rd ├── shapleySubsetMc.Rd ├── shapleysobol_knn.Rd ├── sobol.Rd ├── sobol2002.Rd ├── sobol2007.Rd ├── sobolEff.Rd ├── sobolGP.Rd ├── sobolMultOut.Rd ├── sobolSalt.Rd ├── sobolSmthSpl.Rd ├── sobolTIIlo.Rd ├── sobolTIIpf.Rd ├── soboljansen.Rd ├── sobolmara.Rd ├── sobolmartinez.Rd ├── sobolowen.Rd ├── sobolrank.Rd ├── sobolrec.Rd ├── sobolrep.Rd ├── sobolroalhs.Rd ├── sobolroauc.Rd ├── sobolshap_knn.Rd ├── soboltouati.Rd ├── squaredIntEstim.Rd ├── src.Rd ├── support.Rd ├── template_replace.Rd ├── testHSIC.Rd ├── testmodels.Rd ├── truncateddistrib.Rd └── weightTSA.Rd └── src ├── DisC2_criteria.cpp ├── DisL2_criteria.cpp ├── DisL2star_criteria.cpp ├── DisM2_criteria.cpp ├── DisS2_criteria.cpp ├── DisW2_criteria.cpp ├── LG_Rowsort.cpp ├── LG_estimator.cpp ├── LG_estimatornew.cpp ├── RcppExports.cpp ├── compar_array.cpp ├── maximin_cplus.cpp └── nested.cpp /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: sensitivity 2 | Version: 1.30.1 3 | Title: Global Sensitivity Analysis of Model Outputs and Importance 4 | Measures 5 | Authors@R: c(person(given = "Bertrand", family = "Iooss", role = c("aut", "cre"), email = "biooss@yahoo.fr"), 6 | person(given = c("Sebastien"), family = "Da Veiga", role = "aut"), 7 | person(given = "Alexandre", family = "Janon", role = "aut"), 8 | person(given = "Gilles", family = "Pujol", role = "aut")) 9 | Maintainer: Bertrand Iooss 10 | Depends: R (>= 3.0.0) 11 | Imports: boot, numbers, methods, ggplot2, Rcpp, foreach, dtwclust 12 | LinkingTo: Rcpp, RcppArmadillo 13 | Suggests: condMVNorm, DiceDesign, DiceKriging, doParallel, evd, 14 | ggExtra, grid, gplots, gtools, igraph, IncDTW, ks, lattice, 15 | MASS, mc2d, mvtnorm, parallel, plotrix, pracma, proxy, 16 | randtoolbox, RANN, reshape2, rgl, stringr, triangle, TSP, 17 | viridisLite, whitening 18 | Description: A collection of functions for sensitivity analysis of model outputs (factor screening, global sensitivity analysis and robustness analysis), for variable importance measures of data, as well as for interpretability of machine learning models. Most of the functions have to be applied on scalar output, but several functions support multi-dimensional outputs. 19 | License: GPL-2 20 | NeedsCompilation: yes 21 | Repository: CRAN 22 | Packaged: 2024-08-28 10:45:33 UTC; Bertrand 23 | Author: Bertrand Iooss [aut, cre], 24 | Sebastien Da Veiga [aut], 25 | Alexandre Janon [aut], 26 | Gilles Pujol [aut] 27 | Date/Publication: 2024-08-28 13:40:13 UTC 28 | -------------------------------------------------------------------------------- /R/PoincareChaosSqCoef.R: -------------------------------------------------------------------------------- 1 | # compute squaredCoef i generalized chaos 2 | # = < y, e_{1, l1}...e_{d, ld}>^2 3 | # = [1/lambda_{i,li} < dy/dxi, e_{1,l1}... e'_{i,li} ... e_{d,ld}>]^2 4 | # 5 | # Authors: Olivier Roustant and Bertrand Iooss (2019) 6 | # 7 | # Reference: 8 | # O. Roustant, F. Gamboa and B. Iooss, Parseval inequalities and lower bounds 9 | # for variance-based sensitivity indices, Preprint, ARXIV: 1906.09883 10 | 11 | PoincareChaosSqCoef <- function(PoincareEigen, multiIndex, 12 | design, output, outputGrad = NULL, 13 | inputIndex = 1, der = FALSE, 14 | method = "unbiased"){ 15 | # PoincareEigen: output list from PoincareOptimal 16 | # multiIndex: vector of indices (l1, ..., ld) 17 | # design: design of experiments (matrix of size n x d) 18 | # output: vector of length n (y1, ..., yn) of observations at design = (x1, ..., xn) 19 | # outputGrad: matrix n x d whose columns contain the partial derivatives at X 20 | # inputIndex: index of the input variable (between 1 and d) 21 | # der: should we use the formula with derivatives to compute the square coefficient ? 22 | d <- length(PoincareEigen) 23 | multiIndex <- as.integer(multiIndex) 24 | if (length(multiIndex) != d) stop("The length of multiindex must be equal to the number of input variables") 25 | nonZeroSet <- which(multiIndex != 0) 26 | 27 | if (multiIndex[inputIndex] == 0 & der) stop("Division by zero. Change multiIndex[inputIndex] or der values") 28 | 29 | chaos <- 1 30 | if (!der){ 31 | for (i in nonZeroSet){ 32 | basis <- approxfun(x = PoincareEigen[[i]]$knots, 33 | y = PoincareEigen[[i]]$vectors[, multiIndex[i] + 1]) 34 | chaos <- chaos * basis(design[, i]) 35 | } 36 | res <- output * chaos 37 | } else { 38 | if (multiIndex[inputIndex] == 0) { 39 | res <- 0 # the derivative of the constant (one) eigenvalue is zero 40 | } else { 41 | for (i in setdiff(nonZeroSet, inputIndex)){ 42 | basis <- approxfun(x = PoincareEigen[[i]]$knots, 43 | y = PoincareEigen[[i]]$vectors[, multiIndex[i] + 1]) 44 | chaos <- chaos * basis(design[, i]) 45 | } 46 | i <- inputIndex 47 | basis <- approxfun(x = PoincareEigen[[i]]$knots, 48 | y = PoincareEigen[[i]]$der[, multiIndex[i] + 1]) 49 | chaos <- chaos * basis(design[, i]) / PoincareEigen[[i]]$values[multiIndex[i] + 1] 50 | res <- outputGrad[, i] * chaos 51 | } 52 | } 53 | 54 | c2 <- squaredIntEstim(res, method = method) 55 | return(c2) 56 | } 57 | -------------------------------------------------------------------------------- /R/PoincareConstant.R: -------------------------------------------------------------------------------- 1 | # Poincare Constant computation for Derivative-based Global Sensitivity Measures (DGSM) 2 | # using log-concave case formula, double exponential transport or logistic transport 3 | # 4 | # Authors: Jana Fruth (2014), Bertrand Iooss and Olivier Roustant (2016) 5 | # 6 | # References: 7 | # 8 | # O. Roustant, J. Fruth, B. Iooss and S. Kuhnt, 9 | # Crossed-derivative-based sensitivity measures for interaction screening, 10 | # Mathematics and Computers in Simulation, 105:105-118, 2014 11 | # 12 | #O. Roustant, F. Barthe and B. Iooss, 13 | #Poincare inequalities on intervals - application to sensitivity analysis, 14 | #Electronic Journal of Statistics, Vol. 11, No. 2, 3081-3119, 2017 15 | 16 | PoincareConstant <- function(dfct=dnorm, qfct=qnorm, pfct=pnorm, 17 | logconcave=FALSE, transport="logistic", optimize.interval=c(-100, 100), 18 | truncated=FALSE, min=0, max=1, ...){ 19 | 20 | if (logconcave == TRUE){ 21 | if (transport == "logistic") warning("Double-exponential transport has been used here instead of the logistic one, since the analytical formula based on the log-concave law cases is a subcase of the double-exponential transport.") 22 | 23 | if (truncated == FALSE) res <- 1/dfct(qfct(0.5,...),...)^2 24 | if (truncated == TRUE){ 25 | res <- (pfct(max,...)- pfct(min,...))^2 / 26 | (dfct(qfct((pfct(min,...)+pfct(max,...))/2,...),...))^2 27 | } 28 | } 29 | if (logconcave == FALSE){ 30 | if (transport == "double_exp"){ 31 | fct <- function(x){ 32 | if (truncated == FALSE){ 33 | cdf.at.x <- pfct(x, ...) 34 | density.at.x <- dfct(x, ...) 35 | } 36 | if (truncated == TRUE){ 37 | cdf.at.x <- pfct(x, min=min, max=max, ...) 38 | density.at.x <- dfct(x, min=min, max=max, ...) 39 | } 40 | apply(cbind(cdf.at.x, 1-cdf.at.x),1,min)/(density.at.x) 41 | } 42 | } 43 | if (transport == "logistic"){ 44 | fct <- function(x){ 45 | if (truncated == FALSE){ 46 | cdf.at.x <- pfct(x, ...) 47 | density.at.x <- dfct(x, ...) 48 | } 49 | if (truncated == TRUE){ 50 | cdf.at.x <- pfct(x, min=min, max=max, ...) 51 | density.at.x <- dfct(x, min=min, max=max, ...) 52 | } 53 | (cdf.at.x) * (1-cdf.at.x)/(density.at.x) 54 | } 55 | } 56 | 57 | c1 <- optimize(f=fct, interval=optimize.interval, maximum=TRUE)$objective 58 | res <- 4*c1^2 59 | } 60 | print(res) 61 | } 62 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | DisC2_Crossprod <- function(X, d) { 5 | .Call(`_sensitivity_DisC2_Crossprod`, X, d) 6 | } 7 | 8 | DisC2_Rowprod <- function(x, d) { 9 | .Call(`_sensitivity_DisC2_Rowprod`, x, d) 10 | } 11 | 12 | DisL2_Crossprod <- function(X, d) { 13 | .Call(`_sensitivity_DisL2_Crossprod`, X, d) 14 | } 15 | 16 | DisL2_Rowprod <- function(x, d) { 17 | .Call(`_sensitivity_DisL2_Rowprod`, x, d) 18 | } 19 | 20 | DisL2star_Crossprod <- function(X, d) { 21 | .Call(`_sensitivity_DisL2star_Crossprod`, X, d) 22 | } 23 | 24 | DisM2_Crossprod <- function(X, d) { 25 | .Call(`_sensitivity_DisM2_Crossprod`, X, d) 26 | } 27 | 28 | DisM2_Rowprod <- function(x, d) { 29 | .Call(`_sensitivity_DisM2_Rowprod`, x, d) 30 | } 31 | 32 | DisS2_Crossprod <- function(X, d) { 33 | .Call(`_sensitivity_DisS2_Crossprod`, X, d) 34 | } 35 | 36 | DisS2_Rowprod <- function(x, d) { 37 | .Call(`_sensitivity_DisS2_Rowprod`, x, d) 38 | } 39 | 40 | DisW2_Crossprod <- function(X, d) { 41 | .Call(`_sensitivity_DisW2_Crossprod`, X, d) 42 | } 43 | 44 | cpp_get_indices <- function(data, RP, I, bootsample, d) { 45 | .Call(`_sensitivity_cpp_get_indices`, data, RP, I, bootsample, d) 46 | } 47 | 48 | cpp_get_total_indices <- function(data, bootsample) { 49 | .Call(`_sensitivity_cpp_get_total_indices`, data, bootsample) 50 | } 51 | 52 | Compar_array <- function(X, Y) { 53 | .Call(`_sensitivity_Compar_array`, X, Y) 54 | } 55 | 56 | maximin_cpp <- function(X) { 57 | .Call(`_sensitivity_maximin_cpp`, X) 58 | } 59 | 60 | nested_permu_cplus <- function(layers) { 61 | .Call(`_sensitivity_nested_permu_cplus`, layers) 62 | } 63 | 64 | nested_lhs_cplus <- function(d, layers) { 65 | .Call(`_sensitivity_nested_lhs_cplus`, d, layers) 66 | } 67 | 68 | -------------------------------------------------------------------------------- /R/addelman_kempthorne.R: -------------------------------------------------------------------------------- 1 | # Addelman and Kempthorne construction of orthogonal arrays 2 | # Heydayat et al. (1999), Orthogonal Arrays : Theory and Applications, p.127-128 3 | 4 | # function testing if a matrix is a difference scheme 5 | is_diff_scheme <- function(M,sub_table,q){ 6 | M <- M[,-1] 7 | d <- ncol(M) 8 | test <- TRUE 9 | i <- 1 10 | j <- 1 11 | l <- 1 12 | while (test & (l < (d*(d-1)/2))) { 13 | i <- i+(j==d) 14 | j <- ((j==d)*i + (j10^(-1) 32 | if(test){ 33 | break 34 | } 35 | } 36 | return(test) 37 | } 38 | 39 | # function returning multiplication and addition tables of GF(q) 40 | field_tables <- function(q){ 41 | prime_fact <- primeFactors(q) 42 | if(length(prime_fact)==1){ 43 | gf_mul <- (matrix(0:(q-1),ncol=1)%*%(0:(q-1)))%%q 44 | gf_add <- t(t(replicate(q,0:(q-1)))+0:(q-1))%%q 45 | } else { 46 | gf_mul <- get(paste("gf",q,"_mul",sep="")) 47 | gf_add <- get(paste("gf",q,"_add",sep="")) 48 | } 49 | return(list(mul=gf_mul,add=gf_add)) 50 | } 51 | 52 | # function returning the list of coefficients for the Addelman and Kempthorne construction 53 | field_coeffs <- function(q){ 54 | prime_fact <- primeFactors(q) 55 | if(length(prime_fact)==1){ 56 | gf_mul <- field_tables(q)$mul 57 | gf_vu <- primroot(q) 58 | gf_beta <- which(gf_mul[3,]==1)-1 59 | gf_gamma <- ((gf_vu-1)*(which(gf_mul[(2*gf_vu)%%q+1,]==1)-1))%%q 60 | gf_delta <- (gf_vu*gf_beta)%%q 61 | gf_epsilon <- ((gf_vu-1)*gf_beta)%%q 62 | gf_coeff_prime <- c(gf_vu,gf_beta,gf_gamma,gf_delta,gf_epsilon) 63 | } else { 64 | gf_coeff_prime <- get(paste("gf",q,"_coeff_prime",sep=""))[1,] 65 | } 66 | return(gf_coeff_prime) 67 | } 68 | 69 | # Addelman and Kempthorne construction 70 | addelman_const <- function(dimension, levels, choice="U"){ 71 | 72 | d <- dimension 73 | q <- levels 74 | 75 | if(d>q){ 76 | stop("The number of columns of the orthogonal array must be lower or equal to 77 | its number of levels.") 78 | } 79 | 80 | coeff <- field_coeffs(q) 81 | tables <- field_tables(q) 82 | gf_mul <- tables$mul 83 | gf_add <- tables$add 84 | if(choice=="U"){ 85 | diff_scheme <- gf_mul 86 | } 87 | if(choice=="V"){ 88 | diff_scheme <- matrix(gf_add[cbind(c(gf_mul),rep(gf_mul[coeff[2]+1,diag(gf_mul)+1],each=q))+1],nrow=q) 89 | } 90 | if(choice=="W"){ 91 | diff_scheme <- matrix(gf_add[cbind(c(gf_mul),rep(gf_mul[coeff[3]+1,diag(gf_mul)+1],q))+1],nrow=q) 92 | } 93 | if(choice=="X"){ 94 | X_bis <- matrix(gf_add[cbind(gf_mul[coeff[1]+1,gf_mul+1],rep(gf_mul[coeff[4]+1,diag(gf_mul)+1],each=q))+1],nrow=q) 95 | diff_scheme <- matrix(gf_add[cbind(c(X_bis),rep(gf_mul[coeff[5]+1,diag(gf_mul)+1],q))+1],nrow=q) 96 | } 97 | OA <- matrix(c(gf_add[t(diff_scheme[,sample(q,d)]+1),]),byrow=TRUE,ncol=d)+1 98 | return(OA) 99 | } 100 | -------------------------------------------------------------------------------- /R/bootstats.R: -------------------------------------------------------------------------------- 1 | 2 | # Bootstrap statistics (overlay for the boot package) 3 | # Gilles Pujol 2006 4 | 5 | 6 | # bootstats(b, conf = 0.95, type = "norm") 7 | # b : object of class 'boot' 8 | # confidence : confidence level for bootstrap bias-corrected confidence 9 | # intervals 10 | # type : type of confidence interval, "norm" or "basic" 11 | # 12 | # returns : a data.frame of bootstrap statistics 13 | 14 | bootstats <- function(b, conf = 0.95, type = "norm") { 15 | p <- length(b$t0) 16 | lab <- c("original", "bias", "std. error", "min. c.i.", "max. c.i.") 17 | out <- as.data.frame(matrix(nrow = p, ncol = length(lab), 18 | dimnames = list(NULL, lab))) 19 | 20 | for (i in 1 : p) { 21 | 22 | # original estimation, bias, standard deviation 23 | 24 | out[i, "original"] <- b$t0[i] 25 | out[i, "bias"] <- mean(b$t[, i]) - b$t0[i] 26 | out[i, "std. error"] <- sd(b$t[, i]) 27 | 28 | # confidence interval 29 | 30 | if (type == "norm") { 31 | ci <- boot.ci(b, index = i, type = "norm", conf = conf) 32 | if (!is.null(ci)) { 33 | out[i, "min. c.i."] <- ci$norm[2] 34 | out[i, "max. c.i."] <- ci$norm[3] 35 | } 36 | } else if (type == "basic") { 37 | ci <- boot.ci(b, index = i, type = "basic", conf = conf) 38 | if (!is.null(ci)) { 39 | out[i, "min. c.i."] <- ci$basic[4] 40 | out[i, "max. c.i."] <- ci$basic[5] 41 | } 42 | } else if (type == "bias corrected") { 43 | z0_hat <- qnorm(sum(b$t[,i]<=b$t0[i])/b$R) 44 | modif_quantiles <- pnorm(2*z0_hat+qnorm(c((1-conf)/2,1-(1-conf)/2))) 45 | out[i, "min. c.i."] <- quantile(b$t[,i],probs = modif_quantiles[1]) 46 | out[i, "max. c.i."] <- quantile(b$t[,i],probs = modif_quantiles[2]) 47 | } 48 | } 49 | 50 | return(out) 51 | } 52 | -------------------------------------------------------------------------------- /R/correlRatio.R: -------------------------------------------------------------------------------- 1 | # Correlation ratio between a quantitative variable and a qualitative one 2 | # 3 | # Bertrand Iooss 2022 (inspired from fct corRatio() of the DiscriMiner package) 4 | 5 | 6 | correlRatio <- function(X, y) 7 | { 8 | # Correlation ratio 9 | # X: sample of a quantitative variable 10 | # y: sample of factor variables 11 | 12 | if (!is.numeric(X)) 13 | stop("\n'X' must be a numeric vector") 14 | if (!is.factor(y)) y = as.factor(y) 15 | if (nlevels(y) == 1) 16 | stop("\n'y' has only one category") 17 | # correlation ratio 18 | regr <- lm(X ~ y) 19 | res <- summary(regr)$r.squared 20 | res 21 | } -------------------------------------------------------------------------------- /R/discrepancyCriteria_cplus.R: -------------------------------------------------------------------------------- 1 | discrepancyCriteria_cplus <- function(design, type = "all") { 2 | 3 | X <- as.matrix(design) 4 | dimension <- dim(X)[2] 5 | n <- dim(X)[1] 6 | if (n < dimension) { 7 | stop("Warning : the number of points is lower than the dimension.") 8 | } 9 | if (min(X) < 0 || max(X) > 1) { 10 | warning("The design is rescaling into the unit cube [0,1]^d.") 11 | M <- apply(X, 2, max) 12 | m <- apply(X, 2, min) 13 | for (j in 1:dim(X)[2]) { 14 | X[, j] <- (X[, j] - m[j])/(M[j] - m[j]) 15 | } 16 | } 17 | R <- list() 18 | DisC2 <- FALSE 19 | DisL2 <- FALSE 20 | DisL2star <- FALSE 21 | DisM2 <- FALSE 22 | DisS2 <- FALSE 23 | DisW2 <- FALSE 24 | if (length(type) == 1 && type == "all") { 25 | type <- c("C2", "L2", "L2star", "M2", "S2", "W2") 26 | } 27 | for (i in 1:length(type)) { 28 | type_ <- type[i] 29 | switch(type_, C2 = { 30 | DisC2 <- TRUE 31 | }, L2 = { 32 | DisL2 <- TRUE 33 | }, L2star = { 34 | DisL2star <- TRUE 35 | }, M2 = { 36 | DisM2 <- TRUE 37 | }, S2 = { 38 | DisS2 <- TRUE 39 | }, W2 = { 40 | DisW2 <- TRUE 41 | }) 42 | } 43 | if (DisC2 == TRUE) { 44 | 45 | P <- 1 + 0.5 * abs(X - 0.5) - 0.5 * (abs(X - 0.5)^2) 46 | s1 <- DisC2_Rowprod(t(P),dimension) 47 | s2 <- DisC2_Crossprod(c(t(X)),dimension) 48 | R <- c(R, DisC2 = sqrt(((13/12)^dimension) - ((2/n) * s1) + ((1/n^2) * s2))) 49 | } 50 | 51 | if (DisL2 == TRUE) { 52 | 53 | P <- X*(1-X) 54 | s1 <- DisL2_Rowprod(t(P),dimension) 55 | s2 <- DisL2_Crossprod(c(t(X)),dimension) 56 | R <- c(R, DisL2 = sqrt(12^(-dimension) - (((2^(1 - dimension))/n) * s1) + ((1/n^2) * s2))) 57 | } 58 | 59 | if (DisL2star == TRUE) { 60 | 61 | dL2 <- DisL2star_Crossprod(t(X),dimension) 62 | R <- c(R, DisL2star = sqrt(3^(-dimension) + dL2)) 63 | } 64 | 65 | if (DisM2 == TRUE) { 66 | 67 | P <- 3-X^2 68 | s1 <- DisM2_Rowprod(t(P),dimension) 69 | s2 <- DisM2_Crossprod(c(t(X)),dimension) 70 | R <- c(R, DisM2 = sqrt(((4/3)^dimension) - (((2^(1 - dimension))/n) * s1) + ((1/n^2) * s2))) 71 | 72 | } 73 | 74 | if (DisS2 == TRUE) { 75 | 76 | P <- 1+2*X-2*X^2 77 | s1 <- DisS2_Rowprod(t(P),dimension) 78 | s2 <- DisS2_Crossprod(c(t(X)),dimension) 79 | R <- c(R, DisS2 = sqrt(((4/3)^dimension) - ((2/n) * s1) + ((2^dimension/n^2) * s2))) 80 | } 81 | 82 | if (DisW2 == TRUE) { 83 | 84 | s1 <- DisW2_Crossprod(t(X),dimension) 85 | R <- c(R, DisW2 = sqrt(-(4/3)^dimension + (1/n^2) * s1)) 86 | } 87 | 88 | return(R) 89 | } -------------------------------------------------------------------------------- /R/fast99.R: -------------------------------------------------------------------------------- 1 | # Extended FAST (Saltelli 1999) 2 | # 3 | # Gilles Pujol 2006 4 | 5 | 6 | fast99 <- function(model = NULL, factors, n, M = 4, omega = NULL, 7 | q = NULL, q.arg = NULL, ...) { 8 | 9 | # factors numbers and names 10 | 11 | if (is.character(factors)) { 12 | X.labels <- factors 13 | p <- length(X.labels) 14 | } else { 15 | p <- factors 16 | X.labels <- paste("X", 1 : p, sep = "") 17 | } 18 | 19 | # quantiles 20 | 21 | if (is.null(q)) { 22 | q <- rep("qunif", p) 23 | } else if (length(q) == 1) { 24 | q <- rep(q, p) 25 | } 26 | if (is.null(q.arg)) { 27 | q.arg <- rep(list(), p) 28 | } else if (FALSE %in% sapply(q.arg, is.list)) { # q.arg isn't a list of lists 29 | q.arg <- rep(list(q.arg), p) 30 | } 31 | 32 | # set of frequencies 33 | 34 | if (is.null(omega)) { 35 | omega <- numeric(p) 36 | omega[1] <- floor((n - 1) / (2 * M)) 37 | m <- floor(omega[1] / (2 * M)) 38 | if (m >= p - 1) { 39 | omega[-1] <- floor(seq(from = 1, to = m, length.out = p - 1)) 40 | } else { 41 | omega[-1] <- (0 : (p - 2)) %% m + 1 42 | } 43 | } 44 | 45 | # discretization of the s-space 46 | 47 | s <- 2 * pi / n * (0 : (n - 1)) 48 | 49 | # transformation to get points in the x-space 50 | 51 | X <- as.data.frame(matrix(nrow = n * p, ncol = p)) 52 | colnames(X) <- X.labels 53 | omega2 <- numeric(p) 54 | for (i in 1 : p) { 55 | omega2[i] <- omega[1] 56 | omega2[-i] <- omega[-1] 57 | l <- seq((i - 1) * n + 1, i * n) 58 | for (j in 1 : p) { 59 | g <- 0.5 + 1 / pi * asin(sin(omega2[j] * s)) 60 | X[l, j] <- do.call(q[j], c(list(p = g), q.arg[[j]])) 61 | } 62 | } 63 | 64 | # object of class "fast99" 65 | 66 | x <- list(model = model, M = M, s = s, omega = omega, X = X, 67 | call = match.call()) 68 | class(x) <- "fast99" 69 | 70 | if (!is.null(x$model)) { 71 | response(x, ...) 72 | tell(x) 73 | } 74 | 75 | return(x) 76 | } 77 | 78 | 79 | tell.fast99 <- function(x, y = NULL, ...) { 80 | id <- deparse(substitute(x)) 81 | 82 | if (! is.null(y)) { 83 | x$y <- y 84 | } else if (is.null(x$y)) { 85 | stop("y not found") 86 | } 87 | 88 | p <- ncol(x$X) 89 | n <- length(x$s) 90 | 91 | V <- numeric(p) 92 | D1 <- numeric(p) 93 | Dt <- numeric(p) 94 | 95 | for (i in 1 : p) { 96 | l <- seq((i - 1) * n + 1, i * n) 97 | f <- fft(x$y[l], inverse = FALSE) 98 | Sp <- ( Mod(f[2 : (n / 2)]) / n )^2 99 | V[i] <- 2 * sum(Sp) 100 | D1[i] <- 2 * sum(Sp[(1 : x$M) * x$omega[1]]) 101 | Dt[i] <- 2 * sum(Sp[1 : (x$omega[1] / 2)]) 102 | } 103 | 104 | x$V <- V 105 | x$D1 <- D1 106 | x$Dt <- Dt 107 | assign(id, x, parent.frame()) 108 | } 109 | 110 | 111 | print.fast99 <- function(x, ...) { 112 | cat("\nCall:\n", deparse(x$call), "\n", sep = "") 113 | if (! is.null(x$y)) { 114 | cat("\nModel runs:", length(x$y), "\n") 115 | S <- cbind(x$D1 / x$V, 1 - x$Dt / x$V) 116 | colnames(S) <- c("first order", "total order") 117 | rownames(S) <- colnames(x$X) 118 | cat("\nEstimations of the indices:\n") 119 | print(S) 120 | } else { 121 | cat("(empty)\n") 122 | } 123 | } 124 | 125 | 126 | plot.fast99 <- function(x, ylim = c(0, 1), ...) { 127 | if (! is.null(x$y)) { 128 | S <- rbind(x$D1 / x$V, 1 - x$Dt / x$V - x$D1 / x$V) 129 | colnames(S) <- colnames(x$X) 130 | bar.col <- c("white","grey") 131 | barplot(S, ylim = ylim, col = bar.col) 132 | legend("topright", c("main effect", "interactions"), fill = bar.col) 133 | } 134 | } 135 | -------------------------------------------------------------------------------- /R/johnson.R: -------------------------------------------------------------------------------- 1 | # Johnson indices 2 | # 3 | # Bertrand Iooss and Laura Clouvel 2023 4 | 5 | estim.johnson <- function(data, logistic, i = 1:nrow(data)){ 6 | d <- data[i, ] 7 | 8 | if (!logistic){ 9 | 10 | # Computation of the weight matrix 11 | cor_matrix <- cor(d, use = "pairwise.complete.obs") 12 | corXX <- cor_matrix[2:ncol(d), 2:ncol(d)] # Correlations between inputs 13 | corXX.eigen <- eigen(corXX) # Eigenvalues and eigenvectors 14 | W <- corXX.eigen$vec %*% sqrt(diag(corXX.eigen$val)) %*% t(corXX.eigen$vec) 15 | 16 | # Computation of indices (alpha) between output and orthogonal variables 17 | corXY <- cor_matrix[2:ncol(d), 1] # Correlations between output and inputs 18 | alpha <- solve(W) %*% corXY # Solve numeric matrix containing coefficients of equation (Ax=B) 19 | 20 | ### With the orthogonalized inputs Z 21 | # PDQ <- svd(data[,2:ncol(d)]) 22 | # P <- PDQ$u 23 | # Q <- PDQ$v 24 | # Z <- P %*% t(Q) 25 | # alpha <- src(Z,d$Y)$SRC$original 26 | 27 | W^2 %*% alpha ^ 2 28 | 29 | } else{ 30 | # Tranformation of datas by logistic regression 31 | xs <- rapply(d[, 2:ncol(d)],scale,c("numeric"),how="replace") 32 | xs <- data.frame(xs) 33 | m <- glm(y~., data=data.frame(y = d[,1], xs), family="binomial", maxit=100) 34 | R0 <-1-m$deviance/m$null.deviance 35 | gp_estimated <- data.frame(m$linear.predictors) 36 | gp_scale <- rapply(gp_estimated,scale,c("numeric"),how="replace") 37 | dlogit <- data.frame(Y = gp_scale, xs) 38 | 39 | # Computation of the weight matrix 40 | cor_matrix <- cor(dlogit, use = "pairwise.complete.obs") 41 | corXX <- cor_matrix[2:ncol(dlogit), 2:ncol(dlogit)] # Correlations between inputs 42 | corXX.eigen <- eigen(corXX) # Eigenvalues and eigenvectors 43 | W <- corXX.eigen$vec %*% sqrt(diag(corXX.eigen$val)) %*% t(corXX.eigen$vec) 44 | 45 | # Computation of indices (alpha) between output and orthogonal variables 46 | corXY <- cor_matrix[2:ncol(dlogit), 1] # Correlations between output and inputs 47 | alpha <- solve(W) %*% corXY # Solve numeric matrix containing coefficients of equation (Ax=B) 48 | 49 | W^2 %*% alpha ^ 2 * R0 50 | } 51 | } 52 | 53 | 54 | johnson <- function(X, y, rank = FALSE, logistic = FALSE, nboot = 0, conf = 0.95) { 55 | data <- data.frame(Y = y, X) 56 | 57 | if (logistic) rank <- FALSE # Impossible to perform logistic regression with a rank transformation 58 | 59 | if (rank) { 60 | for (i in 1:ncol(data)) { 61 | data[,i] <- rank(data[,i]) 62 | } 63 | } 64 | 65 | if (nboot == 0) { 66 | johnson <- data.frame(original = estim.johnson(data, logistic )) 67 | rownames(johnson) <- colnames(X) 68 | } else { 69 | boot.johnson <- boot(data, estim.johnson, logistic = logistic, R = nboot) 70 | johnson <- bootstats(boot.johnson, conf, "basic") 71 | rownames(johnson) <- colnames(X) 72 | } 73 | 74 | out <- list(X = X, y = y, rank = rank, nboot = nboot, conf = conf, 75 | call = match.call()) 76 | class(out) <- "johnson" 77 | out$johnson <- johnson 78 | 79 | return(out) 80 | } 81 | 82 | 83 | print.johnson <- function(x, ...) { 84 | cat("\nCall:\n", deparse(x$call), "\n", sep = "") 85 | cat("\nJohnson indices:\n") 86 | print(x$johnson) 87 | } 88 | 89 | 90 | plot.johnson<- function(x, ylim = c(0,1), ...) { 91 | nodeplot(x$johnson, ylim = ylim, main = "Johnson indices") 92 | } 93 | 94 | ggplot.johnson <- function(data, mapping = aes(), ylim = c(0,1), ..., environment = parent.frame()) { 95 | x <- data 96 | nodeggplot(listx = list(x$johnson), xname = "Johnson indices", ylim = ylim, title = "Johnson indices") 97 | } 98 | -------------------------------------------------------------------------------- /R/johnsonshap.R: -------------------------------------------------------------------------------- 1 | # Johnson-Shapley indices 2 | # 3 | # Bertrand Iooss 2024 4 | 5 | johnsonshap <- function(model = NULL, X1, N, nboot = 0, conf = 0.95) { 6 | d <- dim(X1)[[2]] 7 | 8 | # Computation of indices (alpha) between output and orthogonal variables 9 | # With the orthogonalized inputs Z 10 | PDQ <- svd(X1) 11 | P <- PDQ$u # left singular vectors 12 | Q <- PDQ$v # right singular vectors 13 | Z <- P %*% t(Q) 14 | 15 | # Computation of the weight matrix 16 | D <- PDQ$d # singular values 17 | W <- Q %*% diag(D) %*% t(Q) 18 | W2sum <- sqrt(colSums(W^2)) 19 | Wstar <- t(t(W) / W2sum) 20 | 21 | # computing Sobol' indices of Z (by transformation of Z to X) 22 | sobrepZ <- sensitivity::sobolrep(model=NULL, factors=d, N=N, nboot = nboot) 23 | for (i in 1:d) sobrepZ$X[,i] <- quantile(ecdf(Z[,i]), sobrepZ$X[,i]) 24 | sobrepX <- sobrepZ$X %*% W 25 | colnames(sobrepX) <- colnames(sobrepZ$X) 26 | X <- sobrepX 27 | 28 | x <- list(model = model, X1 = X1, N = N, nboot = nboot, conf = conf, 29 | X = X, sobrepZ = sobrepZ, Wstar = Wstar, call = match.call()) 30 | class(x) <- "johnsonshap" 31 | 32 | #calcul of the response for explicit model 33 | if (! is.null(x$model)){ 34 | response(x) 35 | tell(x, x$y) 36 | } 37 | return(x) 38 | } 39 | 40 | tell.johnsonshap <- function(x, y = NULL, ...){ 41 | 42 | id <- deparse(substitute(x)) 43 | if (! is.null(y)) { 44 | x$y <- y 45 | } 46 | else if (is.null(x$y)) { 47 | stop("y not found") 48 | } 49 | 50 | sob <- x$sobrepZ 51 | sensitivity::tell(sob, x$y) 52 | 53 | # Shapley effects(= 1st order + sum of 2nd order / 2) 54 | d <- dim(x$X1)[[2]] 55 | a <- gtools::combinations(d,2,1:d) # look for 2nd order indices 56 | 57 | if (x$nboot == 0) { 58 | alpha <- sob$S$original # 1er ordre 59 | for (i in 1:d){ 60 | nr <- which(a == i)%%nrow(a) 61 | nr[nr==0] <- nrow(a) 62 | alpha[i] <- alpha[i] + sum(sob$S2$original[nr]) / 2 63 | } 64 | alpha <- matrix(alpha) 65 | estim <- x$Wstar^2 %*% alpha 66 | 67 | johnsonshap <- data.frame(original = estim, row.names = colnames(x$X1)) 68 | } else { 69 | estim <- matrix(0, nrow = d, ncol = 5) 70 | for (k in c(1,4,5)){ 71 | alpha <- sob$S[,k] # 1st order 72 | for (i in 1:d){ 73 | nr <- which(a == i)%%nrow(a) 74 | nr[nr==0] <- nrow(a) 75 | alpha[i] <- alpha[i] + sum(sob$S2$original[nr]) / 2 76 | } 77 | alpha <- matrix(alpha) 78 | estim[,k] <- x$Wstar^2 %*% alpha 79 | } 80 | johnsonshap <- data.frame(estim, row.names = colnames(x$X1)) 81 | colnames(johnsonshap) <- c("original", "bias", "std. error", "min. c.i.", "max. c.i.") 82 | } 83 | 84 | x$sobrepZ <- sob 85 | x$johnsonshap <- johnsonshap 86 | 87 | assign(id, x, parent.frame()) 88 | } 89 | 90 | 91 | print.johnsonshap <- function(x, ...) { 92 | cat("\nCall:\n", deparse(x$call), "\n", sep = "") 93 | cat("\nJohnson-Shapley indices:\n") 94 | print(x$johnsonshap) 95 | } 96 | 97 | 98 | plot.johnsonshap <- function(x, ylim = c(0,1), ...) { 99 | nodeplot(x$johnsonshap, ylim = ylim, main = "Johnson-Shapley indices") 100 | } 101 | 102 | ggplot.johnsonshap <- function(data, mapping = aes(), ylim = c(0,1), ..., environment = parent.frame()) { 103 | x <- data 104 | nodeggplot(listx = list(x$johnsonshap), xname = "Johnson-Shapley indices", ylim = ylim, title = "Johnson-Shapley indices") 105 | } 106 | -------------------------------------------------------------------------------- /R/maximin_cplus.R: -------------------------------------------------------------------------------- 1 | maximin_cplus <- function(design){ 2 | 3 | X <- as.matrix(design) 4 | n <- dim(X)[1] 5 | # To check the experimental region 6 | if ( min(X)<0 || max(X)>1 ){ 7 | warning("The design is rescaling into the unit cube [0,1]^d.") 8 | M <- apply(X,2,max) 9 | m <- apply(X,2,min) 10 | for (j in 1:dim(X)[2]){ 11 | X[,j] <- (X[,j]-m[j])/(M[j]-m[j]) 12 | } 13 | } 14 | 15 | val <- maximin_cpp(X) 16 | return(val) 17 | } 18 | -------------------------------------------------------------------------------- /R/morrisMultOut.R: -------------------------------------------------------------------------------- 1 | 2 | morrisMultOut <- function (model = NULL, factors, r = 50, design = list(type = "oat", levels = 5, grid.jump = 3), binf = 0, bsup = 1, scale = TRUE, ...) { 3 | M = morris(model = NULL, factors = factors, r = r, design = design, binf = binf, bsup = bsup, scale = scale, ...) 4 | if (!is.null(model)) { 5 | Y = model(M$X) 6 | M = .morrisMultOut(Y, M) 7 | } 8 | class(M) = c('morrisMultOut', 'morris') 9 | return(M) 10 | } 11 | 12 | .morrisMultOut <- function (Y, M, ...) { 13 | # class(M) = 'morris' #delete 14 | SVD = svd(Y) 15 | W = SVD$d**2 / sum(SVD$d**2) 16 | ee = 0 17 | for (i in 1:ncol(SVD$v)) { 18 | tell.morris(M, SVD$v[,i]) 19 | ee = ee + M$ee**2 * W[i] 20 | } 21 | M$ee = sqrt(ee) 22 | # class(M) = c('morrisMultOut', 'morris') 23 | return(M) 24 | } 25 | 26 | tell.morrisMultOut <- function(x, y = NULL, ...) { 27 | id <- deparse(substitute(x)) 28 | ANS = .morrisMultOut(y, x) 29 | assign(id, ANS, parent.frame()) 30 | } 31 | 32 | 33 | -------------------------------------------------------------------------------- /R/morris_oat.R: -------------------------------------------------------------------------------- 1 | # Morris' OAT sub-routines. (See main file morris.R) 2 | # 3 | # Gilles Pujol 2006 4 | # Modified by Frank Weber (2016): support model functions 5 | # returning a matrix or a 3-dimensional array. 6 | 7 | random.oat <- function(p, r, binf = rep(0, p), bsup = rep(0, p), nl, design.step) { 8 | # orientation matrix B 9 | B <- matrix(-1, nrow = p + 1, ncol = p) 10 | B[lower.tri(B)] <- 1 11 | # grid step 12 | delta <- design.step / (nl - 1) 13 | X <- matrix(nrow = r * (p + 1), ncol = p) 14 | for (j in 1 : r) { 15 | # directions matrix D 16 | D <- diag(sample(c(-1, 1), size = p, replace = TRUE), nrow = p) 17 | # permutation matrix P 18 | perm <- sample(p) 19 | P <- matrix(0, nrow = p, ncol = p) 20 | for (i in 1 : p) { 21 | P[i, perm[i]] <- 1 22 | } 23 | # starting point 24 | x.base <- matrix(nrow = p + 1, ncol = p) 25 | for (i in 1 : p) { 26 | x.base[,i] <- ((sample(nl[i] - design.step[i], size = 1) - 1) / (nl[i] - 1)) 27 | } 28 | X[ind.rep(j,p),] <- 0.5 * (B %*% P %*% D + 1) %*% 29 | diag(delta, nrow = p) + x.base 30 | } 31 | for (i in 1 : p) { 32 | X[,i] <- X[,i] * (bsup[i] - binf[i]) + binf[i] 33 | } 34 | return(X) 35 | } 36 | 37 | ee.oat <- function(X, y) { 38 | # compute the elementary effects for a OAT design 39 | p <- ncol(X) 40 | r <- nrow(X) / (p + 1) 41 | 42 | # if(is(y,"numeric")){ 43 | if(inherits(y, "numeric")){ 44 | one_i_vector <- function(i){ 45 | j <- ind.rep(i, p) 46 | j1 <- j[1 : p] 47 | j2 <- j[2 : (p + 1)] 48 | # return((y[j2] - y[j1]) / rowSums(X[j2,] - X[j1,])) 49 | return(solve(X[j2,] - X[j1,], y[j2] - y[j1])) 50 | } 51 | ee <- vapply(1:r, one_i_vector, FUN.VALUE = numeric(p)) 52 | ee <- t(ee) 53 | # "ee" is now a (r times p)-matrix. 54 | # } else if(is(y,"matrix")){ 55 | } else if(inherits(y, "matrix")){ 56 | one_i_matrix <- function(i){ 57 | j <- ind.rep(i, p) 58 | j1 <- j[1 : p] 59 | j2 <- j[2 : (p + 1)] 60 | return(solve(X[j2,] - X[j1,], 61 | y[j2, , drop = FALSE] - y[j1, , drop = FALSE])) 62 | } 63 | ee <- vapply(1:r, one_i_matrix, 64 | FUN.VALUE = matrix(0, nrow = p, ncol = dim(y)[2])) 65 | # Special case handling for p == 1 and ncol(y) == 1 (in this case, "ee" is 66 | # a vector of length "r"): 67 | if(p == 1 && dim(y)[2] == 1){ 68 | ee <- array(ee, dim = c(r, 1, 1)) 69 | } 70 | # Transpose "ee" (an array of dimensions c(p, ncol(y), r)) to an array of 71 | # dimensions c(r, p, ncol(y)) (for better consistency with the standard 72 | # case that "class(y) == "numeric""): 73 | ee <- aperm(ee, perm = c(3, 1, 2)) 74 | # } else if(is(y,"array")){ 75 | } else if(inherits(y, "array")){ 76 | one_i_array <- function(i){ 77 | j <- ind.rep(i, p) 78 | j1 <- j[1 : p] 79 | j2 <- j[2 : (p + 1)] 80 | ee_per_3rd_dim <- sapply(1:(dim(y)[3]), function(idx_3rd_dim){ 81 | y_j2_matrix <- y[j2, , idx_3rd_dim] 82 | y_j1_matrix <- y[j1, , idx_3rd_dim] 83 | # Here, the result of "solve(...)" is a (p times dim(y)[2])-matrix or 84 | # a vector of length dim(y)[2] (if p == 1): 85 | solve(X[j2,] - X[j1,], y_j2_matrix - y_j1_matrix) 86 | }, simplify = "array") 87 | if(dim(y)[2] == 1){ 88 | # Correction needed if dim(y)[2] == 1, so "y_j2_matrix" and 89 | # "y_j1_matrix" have been dropped to matrices (or even vectors, if also 90 | # p == 1): 91 | ee_per_3rd_dim <- array(ee_per_3rd_dim, 92 | dim = c(p, dim(y)[2], dim(y)[3])) 93 | } else if(p == 1){ 94 | # Correction needed if p == 1 (and dim(y)[2] > 1), so "y_j2_matrix" and 95 | # "y_j1_matrix" have been dropped to matrices: 96 | ee_per_3rd_dim <- array(ee_per_3rd_dim, 97 | dim = c(1, dim(y)[2], dim(y)[3])) 98 | } 99 | # "ee_per_3rd_dim" is now an array of dimensions 100 | # c(p, dim(y)[2], dim(y)[3]). Assign the corresponding names for the 101 | # third dimension: 102 | if(is.null(dimnames(ee_per_3rd_dim))){ 103 | dimnames(ee_per_3rd_dim) <- dimnames(y) 104 | } else{ 105 | dimnames(ee_per_3rd_dim)[[3]] <- dimnames(y)[[3]] 106 | } 107 | return(ee_per_3rd_dim) 108 | } 109 | ee <- sapply(1:r, one_i_array, simplify = "array") 110 | # Special case handling if "ee" has been dropped to a vector: 111 | # if(is(ee,"numeric")){ 112 | if (inherits(ee, "numeric")){ 113 | ee <- array(ee, dim = c(p, dim(y)[2], dim(y)[3], r)) 114 | dimnames(ee) <- list(NULL, dimnames(y)[[2]], dimnames(y)[[3]], NULL) 115 | } 116 | # "ee" is an array of dimensions c(p, dim(y)[2], dim(y)[3], r), so it is 117 | # transposed to an array of dimensions c(r, p, dim(y)[2], dim(y)[3]): 118 | ee <- aperm(ee, perm = c(4, 1, 2, 3)) 119 | } 120 | return(ee) 121 | } 122 | -------------------------------------------------------------------------------- /R/morris_sfd.R: -------------------------------------------------------------------------------- 1 | # Space-filling optimization of a Morris design, either OAT or 2 | # simplex-based. (See main file morris.R) 3 | # 4 | # Gilles Pujol 2007 5 | # Roelof Oomen 2016 (integration of pracma::distmat fct) 6 | 7 | 8 | hausdorff.distance <- function(x, set1, set2) { 9 | # Hausdorff distance function 10 | # x: matrix of points. 11 | # set1: indices of points (in x) of the first group. 12 | # set2: indices of points (in x) of the second group. 13 | # returns: the Haussdorf distance between the two sets of points. 14 | n1 <- length(set1) 15 | n2 <- length(set2) 16 | d <- matrix(nrow = n1, ncol = n2) 17 | for (i1 in 1 : n1) { 18 | for (i2 in 1 : n2) { 19 | d[i1,i2] <- sqrt(sum((x[set1[i1],] - x[set2[i2],])^2)) 20 | } 21 | } 22 | return(max(mean(apply(d, 1, min)), mean(apply(d, 2, min)))) 23 | } 24 | 25 | 26 | hausdorff.distance2 <- function(x, set1, set2) { 27 | # Hausdorff distance function 28 | # using Euclidian distance function from package pracma 29 | # x: matrix of points. 30 | # set1: indices of points (in x) of the first group. 31 | # set2: indices of points (in x) of the second group. 32 | # returns: the Haussdorf distance between the two sets of points. 33 | d <- pracma::distmat(x[set1,], x[set2,]) 34 | return(max(mean(apply(d, 1, min)), mean(apply(d, 2, min)))) 35 | } 36 | 37 | 38 | kennard.stone <- function(dist.matrix, n) { 39 | # Kennard & Stone algorithm (1969). 40 | # dist.matrix: distance matrix (N * N) (cf help(dist)). 41 | # n: number of points to keep (n < N). 42 | # returns: the indices of the n chosen points. 43 | out <- numeric(n) 44 | out[1] <- 1 45 | for (i in 2 : n) { 46 | tmp <- dist.matrix[out, -out, drop = FALSE] 47 | # Remark: drop = FALSE since 'out' is of length 1 at the first 48 | # iteration, cf help(Extract) for the meaning of 'drop' 49 | out[i] <- (1 : nrow(dist.matrix))[-out][which.max(apply(tmp, 2, min))] 50 | } 51 | return(out) 52 | } 53 | 54 | 55 | morris.maximin <- function(x, r) { 56 | # Select r repetitions (out of the R ones of the "morris" design x) 57 | # that are "space-filling". 58 | # returns: the indices (in 1:R) of the r selected repetitions. 59 | p <- ncol(x) 60 | R <- nrow(x) / (p + 1) 61 | d <- matrix(0, nrow = R, ncol = R) 62 | if (requireNamespace("pracma", quietly = TRUE)) { 63 | for (i in 1 : (R - 1)) { 64 | for (j in (i + 1) : R) { 65 | d[i,j] <- d[j,i] <- hausdorff.distance2(x, ind.rep(i, p), ind.rep(j, p)) 66 | } 67 | } 68 | } else { 69 | for (i in 1 : (R - 1)) { 70 | for (j in (i + 1) : R) { 71 | d[i,j] <- d[j,i] <- hausdorff.distance(x, ind.rep(i, p), ind.rep(j, p)) 72 | } 73 | } 74 | } 75 | kennard.stone(d, r) 76 | } 77 | -------------------------------------------------------------------------------- /R/nodeplot.R: -------------------------------------------------------------------------------- 1 | 2 | # Nodeplot: anti-boxplot 3 | # Gilles Pujol 2006 4 | # Modified by Frank Weber (2016): support model functions 5 | # returning a matrix or a 3-dimensional array. 6 | 7 | nodeplot <- function(x, xlim = NULL, ylim = NULL, labels = TRUE, 8 | col = par("col"), pch = 21, bg = "white", 9 | add = FALSE, at = NULL, y_col = NULL, y_dim3 = NULL, ...) { 10 | n <- nrow(x) 11 | if (is.null(xlim)) { 12 | xlim <- c(1, n) 13 | } 14 | if (is.null(ylim)) { 15 | ylim <- c(min(x), max(x)) 16 | } 17 | if (is.null(at)) { 18 | at <- 1 : n 19 | } 20 | if (add) { 21 | par(new = TRUE) 22 | } 23 | 24 | # axes 25 | 26 | plot(0, xlim = xlim, ylim = ylim, axes = FALSE, 27 | xlab = "", ylab = "", type = "n", ...) 28 | # if (class(labels) == "logical") { 29 | if (inherits(labels, "logical")){ 30 | if (labels) { 31 | axis(side = 1, at = at, labels = rownames(x)) 32 | } else { 33 | axis(side = 1, at = at, labels = FALSE, tick = FALSE) 34 | } 35 | # } else if (class(labels) == "character") { 36 | } else if (inherits(labels, "character")){ 37 | axis(side = 1, at = at, labels = labels) 38 | } 39 | axis(side = 2) 40 | box() 41 | 42 | # bias 43 | 44 | if ("bias" %in% dimnames(x)[[2]]) { 45 | if(is.null(y_col) && is.null(y_dim3)){ 46 | xx <- x[["original"]] - x[["bias"]] 47 | } else if(!is.null(y_col) && is.null(y_dim3)){ 48 | xx <- x[, "original", y_col] - x[, "bias", y_col] 49 | } else if(!is.null(y_col) && !is.null(y_dim3)){ 50 | xx <- x[, "original", y_col, y_dim3] - x[, "bias", y_col, y_dim3] 51 | } 52 | } else { 53 | if(is.null(y_col) && is.null(y_dim3)){ 54 | xx <- x[["original"]] 55 | } else if(!is.null(y_col) && is.null(y_dim3)){ 56 | xx <- x[, y_col] 57 | } else if(!is.null(y_col) && !is.null(y_dim3)){ 58 | xx <- x[, y_col, y_dim3] 59 | } 60 | } 61 | 62 | # confidence intervals 63 | 64 | if (("min. c.i." %in% dimnames(x)[[2]]) & "max. c.i." %in% dimnames(x)[[2]]) { 65 | if(is.null(y_col) && is.null(y_dim3)){ 66 | min_ci <- x[["min. c.i."]] 67 | max_ci <- x[["max. c.i."]] 68 | } else if(!is.null(y_col) && is.null(y_dim3)){ 69 | min_ci <- x[, "min. c.i.", y_col] 70 | max_ci <- x[, "max. c.i.", y_col] 71 | } else if(!is.null(y_col) && !is.null(y_dim3)){ 72 | min_ci <- x[, "min. c.i.", y_col, y_dim3] 73 | max_ci <- x[, "max. c.i.", y_col, y_dim3] 74 | } 75 | for (i in 1 : n) { 76 | lines(c(at[i], at[i]), c(min_ci[i], max_ci[i]), 77 | col = col) 78 | } 79 | } 80 | 81 | # points 82 | 83 | points(at, xx, col = col, pch = pch, bg = bg) 84 | } 85 | -------------------------------------------------------------------------------- /R/parameterSets.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Copyright (c) Joseph Guillaume 3 | ## 4 | ## Based on design of parameterSets function by Felix Andrews in hydromad package 5 | ## hydromad.catchment.org 6 | ## 7 | 8 | parameterSets<-function(par.ranges,samples,method=c("sobol","innergrid","grid")){ 9 | method=match.arg(method) 10 | if(is.null(names(par.ranges))) names(par.ranges)=make.names(par.ranges) 11 | 12 | switch(method, 13 | "sobol"={ 14 | ## Sample a sobol sequence 15 | if (!requireNamespace("randtoolbox", quietly = TRUE)){ 16 | stop('The package randtoolbox is missing, but is required to create 17 | a sample with method="sobol"') 18 | } 19 | if (requireNamespace("randtoolbox", quietly = TRUE)){ 20 | pts <- randtoolbox::sobol(samples,length(par.ranges)) 21 | } 22 | ## Scale 23 | for(i in 1:length(par.ranges)) 24 | pts[,i]<-pts[,i]*(diff(par.ranges[[i]]))+par.ranges[[i]][1] 25 | return(pts) 26 | }, 27 | "innergrid"={ 28 | if(length(samples)==1) samples<-rep(samples,length(par.ranges)) 29 | offsets=sapply(par.ranges,diff)/samples/2 30 | points=lapply(1:length(par.ranges), 31 | function(i) seq(par.ranges[[i]][1]+offsets[i], 32 | par.ranges[[i]][2]-offsets[i], 33 | length.out=samples[[i]])) 34 | names(points)<-names(par.ranges) 35 | return(as.matrix(do.call(expand.grid,points))) 36 | }, 37 | "grid"={ 38 | if(length(samples)==1) samples<-rep(samples,length(par.ranges)) 39 | points=lapply(1:length(par.ranges), 40 | function(i) seq(par.ranges[[i]][1], 41 | par.ranges[[i]][2], 42 | length.out=samples[[i]])) 43 | names(points)<-names(par.ranges) 44 | return(as.matrix(do.call(expand.grid,points))) 45 | } 46 | ) 47 | 48 | } -------------------------------------------------------------------------------- /R/pcc.R: -------------------------------------------------------------------------------- 1 | # Partial Correlation Coefficients 2 | # 3 | # Gilles Pujol 2006 4 | # Bertrand Iooss 2020 for Semi-Partial Correlation Coefficients and logistic model 5 | 6 | 7 | estim.pcc <- function(data, semi, logistic, i = 1:nrow(data) ) { 8 | d <- data[i, ] 9 | p <- ncol(d) - 1 10 | pcc <- numeric(p) 11 | for (j in 1:p) { 12 | Xtildej.lab <- paste(colnames(d)[c(-1, -j-1)], collapse = "+") 13 | if (!logistic){ 14 | lm.Y <- lm(formula(paste(colnames(d)[1], "~", Xtildej.lab)), data = d) 15 | } 16 | else{ 17 | lm.Y <- glm(formula(paste(colnames(d)[1], "~", Xtildej.lab)), family = "binomial", data = d) 18 | } 19 | lm.Xj <- lm(formula(paste(colnames(d)[j+1], "~", Xtildej.lab)), data = d) 20 | if (! semi) { 21 | pcc[j] <- cor(d[1] - fitted(lm.Y), d[j+1] - fitted(lm.Xj)) 22 | } else { 23 | pcc[j] <- cor(d[1], d[j+1] - fitted(lm.Xj)) 24 | } 25 | } 26 | pcc 27 | } 28 | 29 | 30 | pcc <- function(X, y, rank = FALSE, semi = FALSE, logistic = FALSE, nboot = 0, conf = 0.95) { 31 | data <- cbind(Y = y, X) 32 | 33 | if (logistic) rank <- FALSE # Impossible to perform logistic regression with a rank transformation 34 | 35 | if (rank) { 36 | for (i in 1:ncol(data)) { 37 | data[,i] <- rank(data[,i]) 38 | } 39 | } 40 | 41 | if (nboot == 0) { 42 | pcc <- data.frame(original = estim.pcc(data, semi, logistic)) 43 | rownames(pcc) <- colnames(X) 44 | } else { 45 | boot.pcc <- boot(data, estim.pcc, semi = semi, logistic = logistic, R = nboot) 46 | pcc <- bootstats(boot.pcc, conf, "basic") 47 | rownames(pcc) <- colnames(X) 48 | } 49 | 50 | out <- list(X = X, y = y, rank = rank, nboot = nboot, conf = conf, 51 | call = match.call()) 52 | class(out) <- "pcc" 53 | if (! semi) { 54 | if (! rank) { 55 | out$PCC <- pcc 56 | } else { 57 | out$PRCC = pcc 58 | } 59 | } else { 60 | if (! rank) { 61 | out$SPCC <- pcc 62 | } else { 63 | out$SPRCC = pcc 64 | } 65 | } 66 | return(out) 67 | } 68 | 69 | 70 | print.pcc <- function(x, ...) { 71 | cat("\nCall:\n", deparse(x$call), "\n", sep = "") 72 | if ("PCC" %in% names(x)) { 73 | cat("\nPartial Correlation Coefficients (PCC):\n") 74 | print(x$PCC) 75 | } else if ("PRCC" %in% names(x)) { 76 | cat("\nPartial Rank Correlation Coefficients (PRCC):\n") 77 | print(x$PRCC) 78 | } else if ("SPCC" %in% names(x)) { 79 | cat("\nSemi-Partial Correlation Coefficients (SPCC):\n") 80 | print(x$SPCC) 81 | } else if ("SPRCC" %in% names(x)) { 82 | cat("\nSemi-Partial Rank Correlation Coefficients (SPRCC):\n") 83 | print(x$SPRCC) 84 | } 85 | } 86 | 87 | 88 | plot.pcc <- function(x, ylim = c(-1,1), ...) { 89 | if ("PCC" %in% names(x)) { 90 | nodeplot(x$PCC, ylim = ylim, main = "PCC") 91 | } else if ("PRCC" %in% names(x)) { 92 | nodeplot(x$PRCC, ylim = ylim, main = "PRCC") 93 | } else if ("SPCC" %in% names(x)) { 94 | nodeplot(x$SPCC, ylim = ylim, main = "SPCC") 95 | } else if ("SPRCC" %in% names(x)) { 96 | nodeplot(x$SPRCC, ylim = ylim, main = "SPRCC") 97 | } 98 | } 99 | 100 | 101 | ggplot.pcc <- function(data, mapping = aes(), ..., environment = parent.frame(), ylim = c(-1,1)) { 102 | x <- data 103 | if ("PCC" %in% names(x)) { 104 | nodeggplot(listx = list(x$PCC), xname = "PCC", ylim = ylim, title = "PCC") 105 | } else if ("PRCC" %in% names(x)) { 106 | nodeggplot(listx = list(x$PRCC), xname = "PRCC", ylim = ylim, title = "PRCC") 107 | } else if ("SPCC" %in% names(x)) { 108 | nodeggplot(listx = list(x$SPCC), xname = "SPCC", ylim = ylim, title = "SPCC") 109 | } else if ("SPRCC" %in% names(x)) { 110 | nodeggplot(listx = list(x$SPRCC), xname = "SPRCC", ylim = ylim, title = "SPRCC") 111 | } 112 | } 113 | 114 | -------------------------------------------------------------------------------- /R/shapleyLinearGaussian.R: -------------------------------------------------------------------------------- 1 | shapleyLinearGaussian <-function(Beta,Sigma,tol=10^(-6)){ 2 | ##################################################### 3 | # This function computes the Shapley effects in the linear Gaussian framework 4 | # 5 | # List of inputs to this function: 6 | # Beta: a vector containing the coefficients of the linear model (without the value at zero). 7 | # Sigma: covariance matrix of the inputs. Has to be positive semi-definite matrix with same size that Beta. 8 | # tol: a relative tolerance to detect zero singular values of Sigma. 9 | # 10 | ##################################################### 11 | 12 | 13 | # require 14 | # library(MASS) 15 | # library(igraph) 16 | 17 | 18 | 19 | p=length(Beta) 20 | mn=dim(Sigma) 21 | if(mn[1]!=p | mn[2]!=p) 22 | { 23 | print("'Sigma' should be a symmetric matrix with same size than 'Beta'.") 24 | } 25 | 26 | 27 | VarY=t(Beta)%*%Sigma%*%Beta 28 | 29 | G=igraph::clusters(igraph::graph.adjacency(Sigma,weighted = TRUE)) 30 | 31 | if(max(G$csize)>=25) 32 | { 33 | rep=readline("The largest block has a size larger than 25. Are you sure to continue? (y/n) ") 34 | if(rep!="y") 35 | { 36 | return(0) 37 | } 38 | } 39 | 40 | Eta=function(Beta_k,Sigma_k) 41 | { 42 | p_k=length(Beta_k) 43 | if(p_k==1) 44 | { 45 | return(Beta_k^2*Sigma_k) 46 | } 47 | 48 | Eu=rep(0,2^p_k) 49 | Eu[2^p_k]=t(Beta_k)%*%Sigma_k%*%Beta_k 50 | for(j in 1:(2^p_k-2)) 51 | { 52 | u=as.numeric(intToBits(j)[1:p_k]) 53 | Eu[j+1]=Beta_k[u==1]%*%(Sigma_k[u==1,u==1]-(Sigma_k[u==1,u==0]%*% 54 | MASS::ginv(Sigma_k[u==0,u==0],tol=tol)%*%Sigma_k[u==0,u==1]))%*%Beta_k[u==1] 55 | } 56 | eta_k=rep(0,p_k) 57 | for (i in 1:p_k) 58 | { 59 | for(l in 0: (2^p_k-1)) 60 | { 61 | if (floor(l/(2^(i-1)))%%2==0) 62 | { 63 | u=as.numeric(intToBits(l)[1:p_k]) 64 | cardu=sum(u) 65 | eta_k[i]=eta_k[i]+(Eu[l+1+2^(i-1)]- Eu[l+1])/choose(p_k-1,cardu) 66 | } 67 | } 68 | } 69 | eta_k=eta_k/p_k 70 | return(eta_k) 71 | } 72 | 73 | 74 | eta=rep(0,p) 75 | K=G$no 76 | for (k in 1:K) 77 | { 78 | eta_k=Eta(Beta[G$membership==k],Sigma[G$membership==k,G$membership==k]) 79 | eta[G$membership==k]=eta_k 80 | } 81 | eta=as.vector(eta)/as.vector(VarY) 82 | return(eta) 83 | } -------------------------------------------------------------------------------- /R/simplex.R: -------------------------------------------------------------------------------- 1 | # Morris' simplex sub-routines. (See main file morris.R) 2 | # 3 | # Gilles Pujol 2007-2008 4 | # Modified by Frank Weber (2016): support model functions 5 | # returning a matrix or a 3-dimensional array. 6 | 7 | simplex.reg <- function(p) { 8 | # generates the matrix of a regular simplex, of edge length = 1, 9 | # centered on the origin 10 | S <- matrix(0, nrow = p + 1, ncol = p) 11 | S[2,1] <- 1 12 | for (i in 3 : (p + 1)) { 13 | for (j in 1 : (i - 2)) { 14 | S[i,j] <- mean(S[1 : (i - 1), j]) 15 | } 16 | S[i, i - 1] <- sqrt(1 - sum(S[i, 1 : (i - 2)]^2)) 17 | } 18 | scale(S, scale = FALSE) 19 | } 20 | 21 | 22 | simplex.rect <- function(p) { 23 | # generates the matrix of a rectangle ("orthonormal") simplex 24 | S <- matrix(0, nrow = p + 1, ncol = p) 25 | for (i in 1:p) { 26 | S[i+1,i] <- 1 27 | } 28 | S 29 | } 30 | 31 | 32 | plane.rot <- function(p, i, j, theta) { 33 | # matrix of the plane (i,j)-rotation of angle theta in dimension p 34 | R <- diag(nrow = p) 35 | R[c(i,j), c(i,j)] <- matrix(c(cos(theta), sin(theta), - sin(theta), cos(theta)), nrow = 2) 36 | return(R) 37 | } 38 | 39 | random.simplexes <- function(p, r, min = rep(0, p), max = rep(1, p), h = 0.25) { 40 | # generates r random simplexes 41 | 42 | # Check if p >= 2: 43 | if(p < 2){ 44 | stop("At least 2 factors have to be analyzed.") 45 | } 46 | X <- matrix(nrow = r * (p + 1), ncol = p) 47 | 48 | # initial random rotation matrix 49 | R <- diag(nrow = p, ncol = p) 50 | ind <- combn(p, 2) 51 | theta <- runif(choose(p, 2), min = 0, max = 2 * pi) 52 | for (i in 1 : choose(p, 2)) { 53 | R <- plane.rot(p, ind[1,i], ind[2,i], theta[i]) %*% R 54 | } 55 | 56 | # reference simplex 57 | S.ref <- R %*% (h * t(simplex.reg(p))) 58 | 59 | for (i in 1 : r) { 60 | # one more random plane rotation of the reference simplex 61 | ind <- sample(p, 2) 62 | theta <- runif(1, min = 0, max = 2 * pi) 63 | S.ref <- plane.rot(p, ind[1], ind[2], theta) %*% S.ref 64 | 65 | # translation to put the simplex into the domain 66 | tau.min <- min - apply(S.ref, 1, min) 67 | tau.max <- max - apply(S.ref, 1, max) 68 | X[ind.rep(i, p),] <- t(S.ref + runif(n = p, min = tau.min, max = tau.max)) 69 | } 70 | 71 | return(X) 72 | } 73 | 74 | 75 | ee.simplex <- function(X, y) { 76 | # compute the elementary effects for a simplex design 77 | p <- ncol(X) 78 | r <- nrow(X) / (p + 1) 79 | if(inherits(y, "numeric")){ 80 | one_i_vector <- function(i){ 81 | j <- ind.rep(i, p) 82 | return(solve(cbind(as.matrix(X[j, ]), rep(1, p + 1)), y[j])[1:p]) 83 | } 84 | ee <- vapply(1:r, one_i_vector, FUN.VALUE = numeric(p)) 85 | ee <- t(ee) 86 | # "ee" is now a (r times p)-matrix. 87 | } else if(inherits(y, "matrix")){ 88 | one_i_matrix <- function(i){ 89 | j <- ind.rep(i, p) 90 | return(solve(cbind(as.matrix(X[j, ]), rep(1, p + 1)), 91 | y[j, , drop = FALSE])[1:p, , drop = FALSE]) 92 | } 93 | ee <- vapply(1:r, one_i_matrix, 94 | FUN.VALUE = matrix(0, nrow = p, ncol = ncol(y))) 95 | # Transpose "ee" (an array of dimensions c(p, ncol(y), r)) to an array of 96 | # dimensions c(r, p, ncol(y)) (for better consistency with the standard 97 | # case that "class(y) == "numeric""): 98 | ee <- aperm(ee, perm = c(3, 1, 2)) 99 | } else if(inherits(y, "array")){ 100 | one_i_array <- function(i){ 101 | j <- ind.rep(i, p) 102 | ee_per_3rd_dim <- sapply(1:(dim(y)[3]), function(idx_3rd_dim){ 103 | y_j_matrix <- y[j, , idx_3rd_dim] 104 | # Correction needed if "dim(y)[2] == 1", so "y_j_matrix" has been 105 | # dropped to a vector: 106 | if(inherits(y_j_matrix, "numeric")){ 107 | y_j_matrix <- matrix(y_j_matrix) 108 | } 109 | # Here, the result of "solve(...)" is a (p times dim(y)[2])-matrix: 110 | solve(cbind(as.matrix(X[j, ]), rep(1, p + 1)), 111 | y_j_matrix)[1:p, , drop = FALSE] 112 | }, simplify = "array") 113 | # "ee_per_3rd_dim" is an array of dimensions c(p, dim(y)[2], dim(y)[3]). 114 | # Assign the corresponding names for the third dimension: 115 | dimnames(ee_per_3rd_dim)[[3]] <- dimnames(y)[[3]] 116 | return(ee_per_3rd_dim) 117 | } 118 | ee <- sapply(1:r, one_i_array, simplify = "array") 119 | # "ee" is an array of dimensions c(p, dim(y)[2], dim(y)[3], r), so it is 120 | # transposed to an array of dimensions c(r, p, dim(y)[2], dim(y)[3]): 121 | ee <- aperm(ee, perm = c(4, 1, 2, 3)) 122 | } 123 | return(ee) 124 | } 125 | -------------------------------------------------------------------------------- /R/sobol2002.R: -------------------------------------------------------------------------------- 1 | # Sobol' indices estimation (Saltelli 2002) 2 | # 3 | # Gilles Pujol 2006 4 | 5 | 6 | sobol2002 <- function(model = NULL, X1, X2, nboot = 0, conf = 0.95, ...) { 7 | if ((ncol(X1) != ncol(X2)) | (nrow(X1) != nrow(X2))) 8 | stop("The samples X1 and X2 must have the same dimensions") 9 | p <- ncol(X1) 10 | 11 | X <- rbind(X1, X2) 12 | for (i in 1:p) { 13 | Xb <- X1 14 | Xb[,i] <- X2[,i] 15 | X <- rbind(X, Xb) 16 | } 17 | 18 | x <- list(model = model, X1 = X1, X2 = X2, nboot = nboot, conf = conf, X = X, 19 | call = match.call()) 20 | class(x) <- "sobol2002" 21 | 22 | if (!is.null(x$model)) { 23 | response(x, ...) 24 | tell(x) 25 | } 26 | 27 | return(x) 28 | } 29 | 30 | 31 | estim.sobol2002 <- function(data, i = 1 : nrow(data)) { 32 | d <- as.matrix(data[i, ]) # as.matrix for colSums 33 | n <- nrow(d) 34 | V <- var(d[, 1]) 35 | VCE <- (colSums(d[, - c(1, 2)] * d[, 2]) / (n - 1) - mean(d[,1] * d[,2])) 36 | VCE.compl <- (colSums(d[, - c(1, 2)] * d[, 1]) / (n - 1) - mean(d[, 1])^2) 37 | c(V, VCE, VCE.compl) 38 | } 39 | 40 | 41 | tell.sobol2002 <- function(x, y = NULL, return.var = NULL, ...) { 42 | id <- deparse(substitute(x)) 43 | 44 | if (! is.null(y)) { 45 | x$y <- y 46 | } else if (is.null(x$y)) { 47 | stop("y not found") 48 | } 49 | 50 | p <- ncol(x$X1) 51 | n <- nrow(x$X1) 52 | 53 | data <- matrix(x$y, nrow = n) 54 | 55 | # estimation of the partial variances (V, D1 and Dt) 56 | 57 | if (x$nboot == 0){ 58 | V <- data.frame(original = estim.sobol2002(data)) 59 | } 60 | else{ 61 | V.boot <- boot(data, estim.sobol2002, R = x$nboot) 62 | V <- bootstats(V.boot, x$conf, "basic") 63 | } 64 | rownames(V) <- c("global", colnames(x$X1), paste("-", colnames(x$X1), sep = "")) 65 | 66 | # estimation of the Sobol' indices (S1 and St) 67 | 68 | if (x$nboot == 0) { 69 | S <- V[2:(p + 1), 1, drop = FALSE] / V[1,1] 70 | T <- 1 - V[(p + 2):(2 * p + 1), 1, drop = FALSE] / V[1,1] 71 | } else { 72 | S.boot <- V.boot 73 | S.boot$t0 <- V.boot$t0[2:(p + 1)] / V.boot$t0[1] 74 | S.boot$t <- V.boot$t[,2:(p + 1)] / V.boot$t[,1] 75 | S <- bootstats(S.boot, x$conf, "basic") 76 | 77 | T.boot <- V.boot 78 | T.boot$t0 <- 1 - V.boot$t0[(p + 2):(2 * p + 1)] / V.boot$t0[1] 79 | T.boot$t <- 1 - V.boot$t[,(p + 2):(2 * p + 1)] / V.boot$t[,1] 80 | T <- bootstats(T.boot, x$conf, "basic") 81 | } 82 | rownames(S) <- colnames(x$X1) 83 | rownames(T) <- colnames(x$X1) 84 | 85 | # return 86 | x$V <- V 87 | x$S <- S 88 | x$T <- T 89 | 90 | for (i in return.var) { 91 | x[[i]] <- get(i) 92 | } 93 | 94 | assign(id, x, parent.frame()) 95 | } 96 | 97 | 98 | print.sobol2002 <- function(x, ...) { 99 | cat("\nCall:\n", deparse(x$call), "\n", sep = "") 100 | if (!is.null(x$y)) { 101 | cat("\nModel runs:", length(x$y), "\n") 102 | cat("\nFirst order indices:\n") 103 | print(x$S) 104 | cat("\nTotal indices:\n") 105 | print(x$T) 106 | } 107 | } 108 | 109 | 110 | plot.sobol2002 <- function(x, ylim = c(0, 1), ...) { 111 | if (!is.null(x$y)) { 112 | p <- ncol(x$X1) 113 | pch = c(21, 24) 114 | nodeplot(x$S, xlim = c(1, p + 1), ylim = ylim, pch = pch[1]) 115 | nodeplot(x$T, xlim = c(1, p + 1), ylim = ylim, labels = FALSE, 116 | pch = pch[2], at = (1:p)+.3, add = TRUE) 117 | legend(x = "topright", legend = c("main effect", "total effect"), pch = pch) 118 | } 119 | } 120 | 121 | ggplot.sobol2002 <- function(data, mapping = aes(), ylim = c(0,1), ..., environment = parent.frame()) { 122 | x <- data 123 | if (!is.null(x$y)) { 124 | p <- ncol(x$X1) 125 | pch = c(21, 24) 126 | nodeggplot(listx = list(x$S,x$T), xname = c("Main effet","Total effect"), ylim = ylim, pch = pch) 127 | } 128 | } 129 | 130 | plotMultOut.sobol2002 <- function(x, ylim = c(0, 1), ...) { 131 | if (!is.null(x$y)) { 132 | p <- ncol(x$X1) 133 | if (!x$ubiquitous){ 134 | stop("Cannot plot functional indices since ubiquitous option was not activated") 135 | }else{ 136 | if (x$Tot == T) par(mfrow=c(2,1)) 137 | plot(0,ylim=ylim,xlim=c(1,x$q),main="First order Sobol indices",ylab="",xlab="",type="n") 138 | for (i in 1:p) lines(x$Sfct[,i],col=i) 139 | legend(x = "topright", legend = dimnames(x$X1)[[2]], lty=1, col=1:p, cex=0.6) 140 | 141 | if (x$Tot == T){ 142 | plot(0,ylim=ylim,xlim=c(1,x$q),main="Total Sobol indices",ylab="",xlab="",type="n") 143 | for (i in 1:p) lines(x$Tfct[,i],col=i) 144 | legend(x = "topright", legend = dimnames(x$X1)[[2]], lty=1, col=1:p, cex=0.6) 145 | } 146 | } 147 | } 148 | } 149 | -------------------------------------------------------------------------------- /R/sobol2007.R: -------------------------------------------------------------------------------- 1 | # Sobol' indices estimation (Sobol 2007 - Saltelli 2010) 2 | # 3 | # Author: Bertrand Iooss 2012 4 | 5 | 6 | sobol2007 <- function(model = NULL, X1, X2, nboot = 0, conf = 0.95, ...) { 7 | if ((ncol(X1) != ncol(X2)) | (nrow(X1) != nrow(X2))) 8 | stop("The samples X1 and X2 must have the same dimensions") 9 | p <- ncol(X1) 10 | 11 | X <- rbind(X1, X2) 12 | for (i in 1:p) { 13 | Xb <- X1 14 | Xb[,i] <- X2[,i] 15 | X <- rbind(X, Xb) 16 | } 17 | 18 | x <- list(model = model, X1 = X1, X2 = X2, nboot = nboot, conf = conf, X = X, 19 | call = match.call()) 20 | class(x) <- "sobol2007" 21 | 22 | if (!is.null(x$model)) { 23 | response(x, ...) 24 | tell(x) 25 | } 26 | 27 | return(x) 28 | } 29 | 30 | 31 | estim.sobol2007 <- function(data, i = 1 : nrow(data)) { 32 | d <- as.matrix(data[i, ]) # as.matrix for colSums 33 | n <- nrow(d) 34 | V <- var(d[, 1]) 35 | VCE <- (colSums((d[, - c(1, 2)] - d[,1]) * d[, 2]) / (n - 1)) 36 | VCE.compl <- (colSums((d[,1] - d[, - c(1, 2)]) * d[,1]) / (n - 1)) 37 | c(V, VCE, VCE.compl) 38 | } 39 | 40 | 41 | tell.sobol2007 <- function(x, y = NULL, return.var = NULL, ...) { 42 | id <- deparse(substitute(x)) 43 | 44 | if (! is.null(y)) { 45 | x$y <- y 46 | } else if (is.null(x$y)) { 47 | stop("y not found") 48 | } 49 | 50 | p <- ncol(x$X1) 51 | n <- nrow(x$X1) 52 | 53 | data <- matrix(x$y, nrow = n) 54 | 55 | # estimation of the partial variances (V, D1 and Dt) 56 | 57 | if (x$nboot == 0){ 58 | V <- data.frame(original = estim.sobol2007(data)) 59 | } 60 | else{ 61 | V.boot <- boot(data, estim.sobol2007, R = x$nboot) 62 | V <- bootstats(V.boot, x$conf, "basic") 63 | } 64 | rownames(V) <- c("global", colnames(x$X1), paste("-", colnames(x$X1), sep = "")) 65 | 66 | # estimation of the Sobol' indices (S1 and St) 67 | 68 | if (x$nboot == 0) { 69 | S <- V[2:(p + 1), 1, drop = FALSE] / V[1,1] 70 | T <- V[(p + 2):(2 * p + 1), 1, drop = FALSE] / V[1,1] 71 | } else { 72 | S.boot <- V.boot 73 | S.boot$t0 <- V.boot$t0[2:(p + 1)] / V.boot$t0[1] 74 | S.boot$t <- V.boot$t[,2:(p + 1)] / V.boot$t[,1] 75 | S <- bootstats(S.boot, x$conf, "basic") 76 | 77 | T.boot <- V.boot 78 | T.boot$t0 <- V.boot$t0[(p + 2):(2 * p + 1)] / V.boot$t0[1] 79 | T.boot$t <- V.boot$t[,(p + 2):(2 * p + 1)] / V.boot$t[,1] 80 | T <- bootstats(T.boot, x$conf, "basic") 81 | } 82 | rownames(S) <- colnames(x$X1) 83 | rownames(T) <- colnames(x$X1) 84 | 85 | # return 86 | x$V <- V 87 | x$S <- S 88 | x$T <- T 89 | 90 | for (i in return.var) { 91 | x[[i]] <- get(i) 92 | } 93 | 94 | assign(id, x, parent.frame()) 95 | } 96 | 97 | 98 | print.sobol2007 <- function(x, ...) { 99 | cat("\nCall:\n", deparse(x$call), "\n", sep = "") 100 | if (!is.null(x$y)) { 101 | cat("\nModel runs:", length(x$y), "\n") 102 | cat("\nFirst order indices:\n") 103 | print(x$S) 104 | cat("\nTotal indices:\n") 105 | print(x$T) 106 | } 107 | } 108 | 109 | 110 | plot.sobol2007 <- function(x, ylim = c(0, 1), ...) { 111 | if (!is.null(x$y)) { 112 | p <- ncol(x$X1) 113 | pch = c(21, 24) 114 | nodeplot(x$S, xlim = c(1, p + 1), ylim = ylim, pch = pch[1]) 115 | nodeplot(x$T, xlim = c(1, p + 1), ylim = ylim, labels = FALSE, 116 | pch = pch[2], at = (1:p)+.3, add = TRUE) 117 | legend(x = "topright", legend = c("main effect", "total effect"), pch = pch) 118 | } 119 | } 120 | 121 | ggplot.sobol2007 <- function(data, mapping = aes(), ylim = c(0,1), ..., environment = parent.frame()) { 122 | x <- data 123 | if (!is.null(x$y)) { 124 | p <- ncol(x$X1) 125 | pch = c(21, 24) 126 | nodeggplot(listx = list(x$S,x$T), xname = c("Main effet","Total effect"), ylim = ylim, pch = pch) 127 | } 128 | } 129 | 130 | plotMultOut.sobol2007 <- function(x, ylim = c(0, 1), ...) { 131 | if (!is.null(x$y)) { 132 | p <- ncol(x$X1) 133 | if (!x$ubiquitous){ 134 | stop("Cannot plot functional indices since ubiquitous option was not activated") 135 | }else{ 136 | if (x$Tot == T) par(mfrow=c(2,1)) 137 | plot(0,ylim=ylim,xlim=c(1,x$q),main="First order Sobol indices",ylab="",xlab="",type="n") 138 | for (i in 1:p) lines(x$Sfct[,i],col=i) 139 | legend(x = "topright", legend = dimnames(x$X1)[[2]], lty=1, col=1:p, cex=0.6) 140 | 141 | if (x$Tot == T){ 142 | plot(0,ylim=ylim,xlim=c(1,x$q),main="Total Sobol indices",ylab="",xlab="",type="n") 143 | for (i in 1:p) lines(x$Tfct[,i],col=i) 144 | legend(x = "topright", legend = dimnames(x$X1)[[2]], lty=1, col=1:p, cex=0.6) 145 | } 146 | } 147 | } 148 | } 149 | 150 | -------------------------------------------------------------------------------- /R/sobolSmthSpl.R: -------------------------------------------------------------------------------- 1 | # Author: Filippo Monari 2 | 3 | sobolSmthSpl <- function (Y, X) { 4 | #Determines the Si coefficient for singular parameters through smoothing with roughness penalty. 5 | #Reference: Saltelli, A; Ratto, M; Andres, T; Campolongo, F; Cariboni, J; Gatelli, D; Saisana, M & Tarantola, S. 6 | #Global Sensitivity Analysis: The Primer Wiley-Interscience, 2008 7 | #Arguments: 8 | #Y: matrix of model outputs (only one column) 9 | #X: matrix model parameters 10 | #MAIN 11 | ANS = list() 12 | ANS[['call']] = match.call() 13 | ANS[['X']] = X 14 | ANS[['Y']] = Y 15 | par.names = colnames(X) #gets parameters names 16 | if (is.null(colnames(X))) par.names = paste0('X', 1:ncol(X)) 17 | X = normalize(X) #normalize inpiuts between [0,1] 18 | Y = Y - mean(Y) #center model responses 19 | Y = sapply(1:ncol(X), function(i)return(Y[order(X[,i])])) #order Y before X (or create a new variable for X) 20 | X = sapply(1:ncol(X), function(i)return(X[order(X[,i]),i])) 21 | SMTH = optSmooth(Y, X, c(-2, 2)) 22 | SA.tab = t(sapply(SMTH, est.Si)) 23 | colnames(SA.tab) = c('Si', 'se', 'q0.05') 24 | rownames(SA.tab) = par.names 25 | ANS[['S']] = SA.tab 26 | class(ANS) = 'sobolSmthSpl' 27 | return(ANS) 28 | } 29 | 30 | est.Si <-function (SMTH) { 31 | gi = SMTH[['y']] 32 | yi = SMTH[['yin']] 33 | Si = var(gi) / var(yi) 34 | #calculates the standard error of the main effect estimates 35 | yi.sc = (yi - mean(yi)) / sd(yi) #scaled yi 36 | u = (yi - gi) / (sd(yi) * abs(1 - Si)**0.5) #scales residuals 37 | Si.se = abs(1 - Si) * sd(yi.sc**2 - u**2) / length(yi)**0.5 38 | q0.05 = qnorm(0.05, Si, Si.se) 39 | return(c(Si, Si.se, q0.05)) 40 | } 41 | 42 | optSmooth <- function (Y, X, interval) { 43 | #DOC 44 | #Optimises the spline smoothing across all the column of the matrix Y. 45 | #Argumnts: 46 | #Y: matrix containing the observation to smooth 47 | #X: matrix of inputs 48 | #interval: interval where to search for the spar smoothing parameter 49 | #CONTAINS 50 | objective = function(spar) { 51 | nc = min(ncol(Y), parallel::detectCores()) 52 | ANS = try(parallel::mclapply(1:ncol(Y), function(i)smooth.spline(X[,i], Y[,i], spar = spar, all.knots = T), mc.cores = nc), silent = T) 53 | if (is(ANS, 'try-error')) { #Windows does not support mclapply... 54 | SMTH <<- lapply(1:ncol(Y), function(i)smooth.spline(X[,i], Y[,i], spar = spar, all.knots = T)) 55 | } else { 56 | SMTH <<- ANS 57 | } 58 | return(sum(sapply(SMTH, function(x)x$cv))) 59 | } 60 | SMTH = NULL 61 | ANS = optimize(f = objective, interval = interval, tol = sqrt(.Machine$double.eps), maximum = FALSE) 62 | return(SMTH) 63 | } 64 | 65 | normalize <- function (X, MAXS = NULL, MINS = NULL, inv = F) { 66 | #DOC 67 | #Normalizes a vector or a matrix according to the given 'MAXS' and 'MINS'. 68 | #If 'MAXS' and 'MINS' are not provided 'X' is scaled so that each column is within [0,1]. 69 | #ARGUMENTS 70 | #X: matrix or vector to normalize 71 | #MAXS, MINS: maxima and minima. NULL or NA values are set to max(X[,i]) and min(X[,i]) respectively. 72 | #inv: if T performs the inverse transformation 73 | #MAIN 74 | X = as.matrix(X) 75 | if (inv) { 76 | return(scale(scale(X, center = F, scale = (MAXS - MINS)**(-1)), center = -MINS, scale = F)) 77 | } else { 78 | if (is.null(MAXS)) MAXS = apply(X, 2, max) 79 | if (is.null(MINS)) MINS = apply(X, 2, min) 80 | for (i in 1:ncol(X)) { 81 | if (is.na(MAXS[i])) MAXS[i] = max(X[,i]) 82 | if (is.na(MINS[i])) MINS[i] = min(X[,i]) 83 | } 84 | return(scale(X, center = MINS, scale = MAXS - MINS)) 85 | } 86 | } 87 | 88 | plot.sobolSmthSpl <- function(x, ...) { 89 | yrng = range(c(1 + x[['S']][,'se'], x[['S']][,'q0.05'])) 90 | #plot estimates 91 | plot(x = 1:nrow(x[['S']]), y = x[['S']][,'Si'], pch = 19, ylim = yrng, xaxt = 'n', xlab = 'parameter', ylab = 'Si and se', ...) 92 | #plot q 0.05 93 | points(x = 1:nrow(x[['S']]), y = x[['S']][,'q0.05'], pch = 19, col = 2) 94 | #plot se 95 | arrows(x0 = 1:nrow(x[['S']]), y0 = x[['S']][,'Si'], y1 = x[['S']][,'Si'] - x[['S']][,'se'], length = 0) #lower 96 | arrows(x0 = 1:nrow(x[['S']]), y0 = x[['S']][,'Si'], y1 = x[['S']][,'Si'] + x[['S']][,'se'], length = 0) #upper 97 | #plot 0 98 | abline(h = 0, lty = 2) 99 | #x axis 100 | axis(side = 1, at = 1:nrow(x[['S']]), labels = row.names(x[['S']])) 101 | #legend 102 | legend('topright', legend = c('Si', 'se', 'q0.05'), pch = c(19, NA, 19), lty = c(NA, 1, NA), col = c(1, 1, 2), horiz = T, bty = 'n') 103 | } 104 | 105 | print.sobolSmthSpl <- function(x, ...) { 106 | cat("\nCall:\n", deparse(x[['call']]), "\n", sep = "") 107 | cat("\nModel runs:", length(x[['Y']]), "\n") 108 | cat("\nFirst order indices:\n") 109 | print(x[['S']]) 110 | } 111 | -------------------------------------------------------------------------------- /R/sobolTIIpf.R: -------------------------------------------------------------------------------- 1 | # Total Interaction Indices (TII) by the pick-freeze method 2 | # Author: Jana Fruth (2014) 3 | 4 | sobolTIIpf <- function (model = NULL, X1, X2, ...){ 5 | if ((ncol(X1) != ncol(X2)) | (nrow(X1) != nrow(X2))) { 6 | stop("The samples X1 and X2 must have the same dimensions") 7 | } 8 | p <- ncol(X1) 9 | indices.list <- subsets(set = 1:p, size = 1) 10 | X <- X1 11 | # X is the final matrix to be evaluated 12 | # contains: X1, all X1 with col i from X2 13 | for (i in indices.list) { 14 | Xb <- X1 15 | Xb[, i] <- X2[, i] 16 | X <- rbind(X, Xb) 17 | } 18 | x <- list(model = model, X1 = X1, X2 = X2, X = X, call = match.call()) 19 | # match.call erinnert sich nur an den ursprunglichen Funktionsaufruf (superliuowen.. usw) 20 | class(x) <- "sobolTIIpf" 21 | if (!is.null(x$model)) { 22 | response(x, ...) 23 | # response rechnet das Modell an den ganzen x aus und hangt es als y dran 24 | tell(x, ...) 25 | } 26 | return(x) 27 | } 28 | 29 | 30 | 31 | tell.sobolTIIpf <- function (x, y = NULL, ...) { 32 | id <- deparse(substitute(x)) 33 | if (!is.null(y)) { 34 | x$y <- y 35 | } 36 | else if (is.null(x$y)) { 37 | stop("y not found") 38 | } 39 | p <- ncol(x$X1) 40 | n <- nrow(x$X1) 41 | indices.list2 <- subsets(set = 1:p, size = 2)[-(1:p)] 42 | ni <- length(indices.list2) 43 | indices.labels <- lapply(indices.list2, function(i) paste(colnames(x$X1)[i], 44 | collapse = "*")) 45 | data <- matrix(x$y, nrow = n) 46 | # y vector seperated columnwise according to the matrices in X 47 | V <- data.frame(original = estim.sobolTIIpf(data, indices.list2 = indices.list2)) 48 | tii <- V[2:(ni+1),,drop=FALSE] 49 | colnames(tii) <- c("original") 50 | rownames(tii) <- indices.labels 51 | x$V <- V[1,1] 52 | x$tii.unscaled <- tii 53 | x$tii.scaled <- tii[,1,drop=FALSE]/x$V 54 | assign(id, x, parent.frame()) 55 | } 56 | 57 | 58 | estim.sobolTIIpf <- function (data, i = 1:nrow(data), indices.list2) 59 | { 60 | d <- as.matrix(data[i, ]) 61 | n <- nrow(d) 62 | ni <- length(indices.list2) 63 | p <- indices.list2[[ni]][2] 64 | V <- var(as.numeric(data)) * (n - 1)/n 65 | tii <- numeric(ni) 66 | DC.but.i <- numeric(p) 67 | for (i in 1:p) { 68 | mu <- 1/2 * mean(data[,1] + data[, i+1]) 69 | DC.but.i[i] <- mean(data[, i+1] * data[,1]) - mu^2 70 | } 71 | DC.but.ij <- numeric(ni) 72 | for (r in 1:ni) { 73 | i <- indices.list2[[r]][1] 74 | j <- indices.list2[[r]][2] 75 | mu <- 1/2 * mean(data[, i+1] + data[, j+1]) 76 | DC.but.ij[r] <- mean(data[, i+1] * data[, j+1]) - mu^2 77 | } 78 | for (r in 1:ni) { 79 | tii[r] <- V + DC.but.ij[r] - sum(DC.but.i[indices.list2[[r]]]) 80 | } 81 | return(c(V, tii)) 82 | } 83 | 84 | print.sobolTIIpf <- function (x, ...) 85 | { 86 | cat("\nCall:\n", deparse(x$call), "\n", sep = "") 87 | if (!is.null(x$y)) { 88 | cat("\nModel runs:", length(x$y), "\n") 89 | if (!is.null(x$tii.scaled)) { 90 | cat("\nscaled tii\n") 91 | print(x$tii.scaled) 92 | } 93 | } 94 | else { 95 | cat("(empty)\n") 96 | } 97 | } 98 | 99 | plot.sobolTIIpf <- function(x, ylim = NULL, ...) 100 | { 101 | if (is.null(ylim)){ 102 | ylim <- range(x$tii.scaled[,1]) 103 | } 104 | if (!is.null(x$y)) { 105 | nodeplot(x$tii.scaled, ylim = ylim) 106 | } 107 | } 108 | 109 | ggplot.sobolTIIpf <- function(data, mapping = aes(), ylim = NULL, ..., environment = parent.frame()){ 110 | x <- data 111 | if (is.null(ylim)){ 112 | ylim <- range(x$tii.scaled[,1]) 113 | } 114 | if (!is.null(x$y)) { 115 | nodeggplot(listx = list(x$tii.scaled), xname="",ylim = ylim) 116 | } 117 | } 118 | 119 | plotFG.sobolTIIpf <- function (x) 120 | { 121 | if (!is.null(x$y)) { 122 | max.thickness <- 15 123 | diameter <- 28 124 | p <- ncol(x$X1) 125 | tii <- x$tii.unscaled[,1] 126 | active <- which(tii > 0) 127 | tii <- tii[active] 128 | E <- t(combn(p, 2)) 129 | E <- E[active, ] 130 | if (requireNamespace("igraph", quietly = TRUE)){ 131 | g <- igraph::graph(as.vector(t(E)), n = p, directed = FALSE) 132 | } 133 | if (requireNamespace("igraph", quietly = TRUE)){ 134 | layout <- igraph::layout.fruchterman.reingold(g) 135 | } 136 | names <- colnames(x$X1) 137 | edge.weight.scale <- tii/(max(tii)) * max.thickness 138 | if (requireNamespace("igraph", quietly = TRUE)){ 139 | igraph::plot.igraph(g,layout = layout, edge.width = edge.weight.scale, vertex.frame.color="darkgrey", 140 | vertex.color = "white", vertex.label = names, vertex.size=diameter) 141 | } 142 | } 143 | } 144 | -------------------------------------------------------------------------------- /R/sobolmara.R: -------------------------------------------------------------------------------- 1 | # Sobol' indices estimation by matrix random permutation (Mara 2008) 2 | # Bootstrap is actually not possible 3 | # 4 | # Bertrand Iooss 2013 5 | 6 | 7 | sobolmara <- function(model = NULL, X1, ...) { 8 | p <- ncol(X1) 9 | n <- nrow(X1) 10 | 11 | XX <- matrix(1:n,ncol=p,nrow=n) 12 | RP <- apply(XX,2,sample) 13 | X2 <- X1 14 | for (j in 1:p) X2[,j] <- X1[RP[,j],j] 15 | 16 | X <- rbind(X1, X2) 17 | 18 | x <- list(model = model, X1 = X1, RP = RP, X = X, call = match.call()) 19 | class(x) <- "sobolmara" 20 | 21 | if (! is.null(x$model)) { 22 | response(x, ...) 23 | x=tell(x, ...) 24 | } 25 | 26 | return(x) 27 | } 28 | 29 | estim.sobolmara <- function(data, i = 1 : nrow(data), RP) { 30 | d <- as.matrix(data[i, ]) # as.matrix for colSums 31 | n <- nrow(d) 32 | p <- ncol(RP) 33 | V <- var(d[, 1]) 34 | m2 <- mean(d[,1])^2 35 | VCE <- NULL 36 | 37 | for (j in 1:p){ 38 | hoy <- 0 39 | hoy <- sum(d[RP[,j],1]*d[,2]) 40 | VCE <- cbind(VCE, hoy / (n - 1) - m2) 41 | } 42 | c(V, VCE) 43 | } 44 | 45 | 46 | tell.sobolmara <- function(x, y = NULL, return.var = NULL, ...) { 47 | id <- deparse(substitute(x)) 48 | 49 | if (! is.null(y)) { 50 | x$y <- y 51 | } else if (is.null(x$y)) { 52 | stop("y not found") 53 | } 54 | 55 | p <- ncol(x$X1) 56 | n <- nrow(x$X1) 57 | 58 | data <- matrix(x$y, nrow = n) 59 | 60 | # estimation of the variances of the conditional expectations (V) 61 | 62 | V <- data.frame(original = estim.sobolmara(data,RP=x$RP)) 63 | rownames(V) <- c("global", colnames(x$X1)) 64 | 65 | # estimation of the Sobol' indices 66 | 67 | S <- V[2:(p + 1), 1, drop = FALSE] / V[1,1] 68 | rownames(S) <- colnames(x$X1) 69 | 70 | # return 71 | x$V <- V 72 | x$S <- S 73 | 74 | for (i in return.var) { 75 | x[[i]] <- get(i) 76 | } 77 | 78 | assign(id, x, parent.frame()) 79 | } 80 | 81 | 82 | print.sobolmara <- function(x, ...) { 83 | cat("\nCall:\n", deparse(x$call), "\n", sep = "") 84 | if (! is.null(x$y)) { 85 | cat("\nModel runs:", length(x$y), "\n") 86 | if (! is.null(x$S)) { 87 | cat("\nSobol indices\n") 88 | print(x$S) 89 | } 90 | } else { 91 | cat("(empty)\n") 92 | } 93 | } 94 | 95 | plot.sobolmara <- function(x, ylim = c(0, 1), ...) { 96 | if (! is.null(x$y)) { 97 | nodeplot(x$S, ylim = ylim) 98 | } 99 | } 100 | 101 | ggplot.sobolmara <- function(data, mapping = aes(), ylim = c(0,1), ..., environment = parent.frame()) { 102 | x <- data 103 | if (! is.null(x$y)) { 104 | nodeggplot(listx = list(x$S), xname="",ylim = ylim) 105 | } 106 | } 107 | 108 | plotMultOut.sobolmara <- function(x, ylim = c(0, 1), ...) { 109 | if (!is.null(x$y)) { 110 | p <- ncol(x$X1) 111 | if (!x$ubiquitous){ 112 | stop("Cannot plot functional indices since ubiquitous option was not activated") 113 | }else{ 114 | if (x$Tot == T) par(mfrow=c(2,1)) 115 | plot(0,ylim=ylim,xlim=c(1,x$q),main="First order Sobol indices",ylab="",xlab="",type="n") 116 | for (i in 1:p) lines(x$Sfct[,i],col=i) 117 | legend(x = "topright", legend = dimnames(x$X1)[[2]], lty=1, col=1:p, cex=0.6) 118 | 119 | if (x$Tot == T){ 120 | plot(0,ylim=ylim,xlim=c(1,x$q),main="Total Sobol indices",ylab="",xlab="",type="n") 121 | for (i in 1:p) lines(x$Tfct[,i],col=i) 122 | legend(x = "topright", legend = dimnames(x$X1)[[2]], lty=1, col=1:p, cex=0.6) 123 | } 124 | } 125 | } 126 | } 127 | -------------------------------------------------------------------------------- /R/sobolrank.R: -------------------------------------------------------------------------------- 1 | sobolrank <- function(model = NULL, X, nboot = 0, conf = 0.95, nsample = round(0.8*nrow(X)), ...) { 2 | 3 | if (is.data.frame(X)){ 4 | X <- as.matrix(unname(X)) 5 | }else if(!is.matrix(X)){ 6 | stop("The sample X must be a matrix or a data frame") 7 | } 8 | 9 | x <- list(model = model, X = X, nboot = nboot, conf = conf, nsample = nsample, call = match.call()) 10 | class(x) <- "sobolrank" 11 | 12 | #calcul of the response for explicit model 13 | if (! is.null(x$model)) { 14 | response(x, ...) 15 | x=tell(x, ...) 16 | } 17 | return(x) 18 | } 19 | 20 | estim.sobolrank <- function(data, i=1:nrow(data)) { 21 | n <- nrow(data) 22 | ptot <- ncol(data) 23 | p <- ptot - 1 24 | X <- data[i,1:p] 25 | Y <- data[i,ptot] 26 | S = matrix(0,nrow=p,ncol=1) 27 | EY <- mean(Y) 28 | VarY <- var(Y) 29 | 30 | for (j in 1:p){ 31 | id.sort <- sort(X[,j], decreasing = FALSE, index.return = TRUE)$ix 32 | S[j] <- (mean(Y[id.sort]*Y[id.sort[c(2:n,1)]]) - EY^2)/VarY 33 | } 34 | return(S) 35 | } 36 | 37 | tell.sobolrank <- function(x, y = NULL, ...) { 38 | 39 | id <- deparse(substitute(x)) 40 | if (! is.null(y)) { 41 | x$y <- y 42 | } 43 | else if (is.null(x$y)) { 44 | stop("y not found") 45 | } 46 | 47 | n <- nrow(x$X) 48 | p <- ncol(x$X) 49 | 50 | data <-cbind(x$X,x$y) 51 | if (x$nboot == 0){ 52 | res <- estim.sobolrank(data, 1:n) 53 | x$S <- data.frame(res) 54 | colnames(x$S) <- "original" 55 | rownames(x$S) <- colnames(x$X) 56 | }else{ 57 | sample.boot <- function(data,mle){ 58 | out <- data[sample.int(nrow(data),mle),,drop=FALSE] 59 | return(out) 60 | } 61 | S.boot <- boot(data, estim.sobolrank, R = x$nboot, sim = "parametric", ran.gen = sample.boot, mle = x$nsample) 62 | x$S <- bootstats(S.boot, x$conf, "basic") 63 | } 64 | 65 | assign(id, x, parent.frame()) 66 | return(x) 67 | } 68 | 69 | print.sobolrank <- function(x, ...) { 70 | cat("\nCall:\n", deparse(x$call), "\n", sep = "") 71 | if (! is.null(x$y)) { 72 | cat("\nModel runs:", length(x$y), "\n") 73 | if (! is.null(x$S)) { 74 | cat("\n\n\nFirst order indices: \n") 75 | print(x$S) 76 | } 77 | else{ 78 | cat("(empty)\n") 79 | } 80 | } 81 | } 82 | 83 | plot.sobolrank <- function(x, ylim = c(0, 1), ...) { 84 | 85 | if (! is.null(x$y)) { 86 | nodeplot(x$S, ylim = ylim) 87 | legend(x = "topright", legend = "First-order indices") 88 | } 89 | } 90 | 91 | ggplot.sobolrank <- function(data, mapping = aes(), ..., environment = parent.frame(), ylim = c(0,1)) { 92 | x <- data 93 | 94 | if (! is.null(x$y)) { 95 | nodeggplot(list(x$S), xname = "First-order indices") 96 | } 97 | } 98 | -------------------------------------------------------------------------------- /R/squaredIntEstim.R: -------------------------------------------------------------------------------- 1 | squaredIntEstim <- function(x, method = "unbiased"){ 2 | res <- (mean(x))^2 3 | if (method == "unbiased"){ 4 | n <- length(x) 5 | res <- res - var(x)/n 6 | } 7 | return(res) 8 | } 9 | -------------------------------------------------------------------------------- /R/src.R: -------------------------------------------------------------------------------- 1 | # Standardized Regression Coefficients 2 | # 3 | # Gilles Pujol 2006 4 | # Bertrand Iooss 2020 for logistic model 5 | 6 | 7 | estim.src <- function(data, logistic, i = 1:nrow(data) ) { 8 | d <- data[i, ] 9 | if (!logistic){ 10 | lm.Y <- lm(formula(paste(colnames(d)[1], "~", paste(colnames(d)[-1], collapse = "+"))), data = d) 11 | coefficients(lm.Y)[-1] * sapply(d[-1], sd) / sapply(d[1], sd) 12 | } else{ 13 | glm.Y <- glm(formula(paste(colnames(d)[1], "~", paste(colnames(d)[-1], collapse = "+"))), family = "binomial", data = d) 14 | varY <- glm.Y$linear.predictors/(1-glm.Y$deviance/glm.Y$null.deviance) 15 | coefficients(glm.Y)[-1] * sapply(d[-1], sd) / sd(varY) 16 | } 17 | } 18 | 19 | src <- function(X, y, rank = FALSE, logistic = FALSE, nboot = 0, conf = 0.95) { 20 | data <- data.frame(Y = y, X) 21 | 22 | if (logistic) rank <- FALSE # Impossible to perform logistic regression with a rank transformation 23 | 24 | if (rank) { 25 | for (i in 1:ncol(data)) { 26 | data[,i] <- rank(data[,i]) 27 | } 28 | } 29 | 30 | if (nboot == 0) { 31 | src <- data.frame(original = estim.src(data, logistic )) 32 | rownames(src) <- colnames(X) 33 | } else { 34 | boot.src <- boot(data, estim.src, logistic = logistic, R = nboot) 35 | src <- bootstats(boot.src, conf, "basic") 36 | rownames(src) <- colnames(X) 37 | } 38 | 39 | out <- list(X = X, y = y, rank = rank, nboot = nboot, conf = conf, 40 | call = match.call()) 41 | class(out) <- "src" 42 | if (! rank) { 43 | out$SRC <- src 44 | } else { 45 | out$SRRC = src 46 | } 47 | return(out) 48 | } 49 | 50 | 51 | print.src <- function(x, ...) { 52 | cat("\nCall:\n", deparse(x$call), "\n", sep = "") 53 | if ("SRRC" %in% names(x)) { 54 | cat("\nStandardized Rank Regression Coefficients (SRRC):\n") 55 | print(x$SRRC) 56 | } else if ("SRC" %in% names(x)) { 57 | cat("\nStandardized Regression Coefficients (SRC):\n") 58 | print(x$SRC) 59 | } 60 | } 61 | 62 | 63 | plot.src <- function(x, ylim = c(-1,1), ...) { 64 | if ("SRRC" %in% names(x)) { 65 | nodeplot(x$SRRC, ylim = ylim, main = "SRRC") 66 | } else if ("SRC" %in% names(x)) { 67 | nodeplot(x$SRC, ylim = ylim, main = "SRC") 68 | } 69 | } 70 | 71 | ggplot.src <- function(data, mapping = aes(), ylim = c(-1,1), ..., environment = parent.frame()) { 72 | x <- data 73 | if ("SRRC" %in% names(x)) { 74 | nodeggplot(listx = list(x$SRRC), xname = "SRRC", ylim = ylim, title = "SRRC") 75 | } else if ("SRC" %in% names(x)) { 76 | nodeggplot(listx = list(x$SRC), xname = "SRC", ylim = ylim, title = "SRC") 77 | } 78 | } 79 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/sensitivity/9906c3bf764048f438c2dff3970d5e48b145e74f/R/sysdata.rda -------------------------------------------------------------------------------- /R/template_replace.R: -------------------------------------------------------------------------------- 1 | template.replace <- function(text, replacement, eval = FALSE, 2 | key.pattern = NULL, code.pattern = NULL) { 3 | if (is.null(key.pattern)) { 4 | key.pattern <- "\\$\\(KEY\\)" 5 | } 6 | if (is.null(code.pattern)) { 7 | code.pattern = "@\\{CODE\\}" 8 | } 9 | code.pattern <- sub("CODE", ".+?", code.pattern) 10 | 11 | # loop on the template text lines 12 | 13 | for (i in 1 : length(text)) { 14 | 15 | # replacement of the keys 16 | 17 | for (keyname in names(replacement)) { 18 | text[i] <- gsub(sub("KEY", keyname, key.pattern, perl = TRUE), 19 | paste(replacement[[keyname]]), text[i], perl = TRUE) 20 | } 21 | 22 | if (eval) { 23 | 24 | # code evaluation 25 | 26 | reg <- regexpr(code.pattern, text[i], perl = TRUE) 27 | while (reg > -1) { 28 | matched.first <- as.numeric(reg) 29 | matched.last <- matched.first + attr(reg, "match.length") - 1 30 | matched.text <- substr(text[i], matched.first + 2, matched.last - 1) 31 | 32 | val.matched.text <- eval(parse(text = matched.text)) 33 | 34 | line.begin <- substr(text[i], 1, matched.first - 1) 35 | line.middle <- paste(val.matched.text) 36 | line.end <- substr(text[i], matched.last + 1, nchar(text[i])) 37 | text[i] <- paste(line.begin, line.middle, line.end, sep = "") 38 | 39 | reg <- regexpr(code.pattern, text[i], perl = TRUE) 40 | } 41 | } 42 | } 43 | 44 | return(text) 45 | } 46 | -------------------------------------------------------------------------------- /R/weightTSA.R: -------------------------------------------------------------------------------- 1 | # Author : Bertrand Iooss (2020) 2 | 3 | weightTSA <- function(Y, c, upper = TRUE, type="indicTh", param=1) { 4 | # Y = the output vector 5 | # c = the threshold 6 | # upper = TRUE for upper threshold and FALSE for lower threshold 7 | # type = the weight function type ("indicTh", "zeroTh", logistic", "exp1side") 8 | # indicTh: indicator-thresholding, zeroTh: zero-thresholding, 9 | # logistic: logistic transf. at the threshold, 10 | # exp1side: exponential transf. below the threshold 11 | # param = the parameter value for "logistic" and "exp1side" types 12 | 13 | if(is.data.frame(Y) == TRUE){ 14 | Y <- as.matrix(Y) 15 | } 16 | 17 | if (upper){ 18 | if (type == "indicTh") wY <- as.numeric(Y>c) 19 | if (type == "zeroTh") wY <- Y * (Y>c) 20 | if (type == "logistic") wY <- 1 / (1 + exp(-param * (Y-c) / abs(c)) ) # Spagnol & Da Veiga 21 | if (type == "exp1side") wY <- exp( - (c-Y)*((c-Y)>0) / (param * sd(Y)/5) ) # Raguet & Marrel 22 | } else{ 23 | if (type == "indicTh") wY <- as.numeric(Y0) / (param * sd(Y)/5) ) # Raguet & Marrel 27 | } 28 | return(as.vector(wY)) 29 | } 30 | -------------------------------------------------------------------------------- /inst/COPYRIGHT: -------------------------------------------------------------------------------- 1 | Copyright CEA - EMSE - EDF (2008-01-19). 2 | 3 | This software was developped at: 4 | * Commissariat a l'Energie Atomique - CEA, Service d'Etudes et de 5 | Simulation du Comportement des Combustibles (DEN/CAD/DEC/SESC), 6 | untill june 2006 (version 1.0); 7 | * Ecole Nationale Superieure des Mines de Saint-Etienne - EMSE, Centre 8 | Genie Industriel et Informatique (G2I), from august 2006 (versions 9 | 1.1, 1.2, 1.3-0 and 1.4-0). 10 | * Electricite de France - Research and Development, from june 2012 11 | (versions 1.5 and further). 12 | 13 | This software is a computer program whose purpose is to perform 14 | sensitivity analyses within the R environment. 15 | 16 | This software is governed by the CeCILL license under French law and 17 | abiding by the rules of distribution of free software. You can use, 18 | modify and/ or redistribute the software under the terms of the CeCILL 19 | license as circulated by CEA, CNRS and INRIA at the following URL 20 | "http://www.cecill.info". 21 | 22 | As a counterpart to the access to the source code and rights to copy, 23 | modify and redistribute granted by the license, users are provided only 24 | with a limited warranty and the software's author, the holder of the 25 | economic rights, and the successive licensors have only limited 26 | liability. 27 | 28 | In this respect, the user's attention is drawn to the risks associated 29 | with loading, using, modifying and/or developing or reproducing the 30 | software by the user in light of its specific status of free software, 31 | that may mean that it is complicated to manipulate, and that also 32 | therefore means that it is reserved for developers and experienced 33 | professionals having in-depth computer knowledge. Users are therefore 34 | encouraged to load and test the software's suitability as regards their 35 | requirements in conditions enabling the security of their systems and/or 36 | data to be ensured and, more generally, to use and operate it in the 37 | same conditions as regards security. 38 | 39 | The fact that you are presently reading this means that you have had 40 | knowledge of the CeCILL license and that you accept its terms. 41 | -------------------------------------------------------------------------------- /man/EPtest.Rd: -------------------------------------------------------------------------------- 1 | \name{EPtest} 2 | \alias{EPtest} 3 | 4 | \title{Non-parametric variable significance test based on the empirical process} 5 | 6 | \description{ 7 | \code{EPtest} builds the non-parametric variable significance test from Klein and Rochet (2022) for the null hypothesis \eqn{H_0: S^u = S}{H0: Su = S} where \eqn{S^u}{Su} is the Sobol index for the inputs \eqn{X_i, i \in u}{Xi,i in u} ans \eqn{S}{S} is the Sobol index for all the inputs in \eqn{X}{X}. 8 | } 9 | 10 | \usage{ 11 | EPtest(X, y, u = NULL, doe = NULL, Kdoe = 10, tau = 0.1) 12 | } 13 | 14 | \arguments{ 15 | \item{X}{a matrix or data.frame that contains the numerical inputs as columns.} 16 | \item{y}{a vector of output.} 17 | \item{u}{the vector of indices of the columns of X for which we want to test the significance.} 18 | \item{doe}{the design of experiment on which the empirical process is to be evaluated. It should be independent from X.} 19 | \item{Kdoe}{if doe is null and Kdoe is specified, the design of experiment is taken as Kdoe points drawn uniformly independently on intervals delimited by the range of each input.} 20 | \item{tau}{a regularization parameter to approximate the limit chi2 distribution of the test statistics under H0.} 21 | } 22 | 23 | \value{ 24 | \code{EPtest} returns a list containing: 25 | \item{statistics}{The test statistics that follows a chi-squared distribution under the null hypothesis.} 26 | \item{ddl}{The number of degrees of freedom used in the limit chi-square distribution for the test.} 27 | \item{p-value}{The test p-value.} 28 | } 29 | 30 | \references{ 31 | T. Klein and P. Rochet, \emph{Test comparison for Sobol Indices over nested sets of variables}, SIAM/ASA Journal on Uncertainty Quantification 10.4 (2022): 1586-1600.} 32 | 33 | \author{Paul Rochet} 34 | 35 | \seealso{\link{sobol}} 36 | 37 | \examples{ 38 | 39 | # Model: Ishigami 40 | 41 | n = 100 42 | X = matrix(runif(3*n, -pi, pi), ncol = 3) 43 | 44 | y = ishigami.fun(X) 45 | 46 | # Test the significance of X1, H0: S1 = 0 47 | EPtest(X[, 1], y, u = NULL) 48 | 49 | # Test if X1 is sufficient to explain Y, H0: S1 = S123 50 | EPtest(X, y, u = 1) 51 | 52 | # Test if X3 is significant in presence of X2, H0: S2 = S23 53 | EPtest(X[, 2:3], y, u = 1) 54 | 55 | } 56 | -------------------------------------------------------------------------------- /man/addelman_const.Rd: -------------------------------------------------------------------------------- 1 | \name{addelman_const} 2 | \alias{addelman_const} 3 | \title{Addelman and Kempthorne construction} 4 | \description{ 5 | \code{addelman_const} implements the Addelman and Kempthorne construction of orthogonal arrays of strength two. 6 | } 7 | \usage{ 8 | addelman_const(dimension, levels, choice="U") 9 | } 10 | 11 | \arguments{ 12 | \item{dimension}{The number of columns of the orthogonal array.} 13 | \item{levels}{The number of levels of the orthogonal array. Either a prime number or a prime power number.} 14 | \item{choice}{A character from the list ("U","V","W","X") specifying which orthogonal array to construct (see "Details").} 15 | 16 | } 17 | \details{ 18 | The method of Addelman and Kempthorne allows to construct up to four orthogonal arrays. \code{choice} specify which orthogonal array is to be constructed. Note that the four orthognal arrays depends on each others through linear equations. 19 | } 20 | 21 | \value{ 22 | A matrix corresponding to the orthogonal array constructed. 23 | } 24 | 25 | \references{ 26 | A.S. Hedayat, N.J.A. Sloane and J. Stufken, 1999, \emph{Orthogonal Arrays: Theory and Applications}, Springer Series in Statistics. 27 | } 28 | \author{ 29 | Laurent Gilquin 30 | } 31 | 32 | \examples{ 33 | dimension <- 6 34 | levels <- 7 35 | OA <- addelman_const(dimension,levels,choice="U") 36 | } 37 | -------------------------------------------------------------------------------- /man/correlRatio.Rd: -------------------------------------------------------------------------------- 1 | \name{correlRatio} 2 | \alias{correlRatio} 3 | 4 | \title{Correlation Ratio} 5 | 6 | \description{ 7 | \code{correlRatio} computes the correlation ratio between 8 | a quantitative variable and a qualitative variable 9 | } 10 | 11 | \usage{ 12 | correlRatio(X, y) 13 | } 14 | 15 | \arguments{ 16 | \item{X}{a vector containing the quantitative variable.} 17 | \item{y}{a vector containing the qualitative variable (e.g. a factor).} 18 | } 19 | 20 | \value{ 21 | The value of the correlation ratio 22 | } 23 | 24 | \references{ 25 | 26 | L. Clouvel, B. Iooss, V. Chabridon, M. Il Idrissi and F. Robin, 2024, 27 | \emph{An overview of variance-based importance measures in the linear regression context: 28 | comparative analyses and numerical tests}, Preprint. 29 | \url{https://hal.science/hal-04102053} 30 | 31 | } 32 | 33 | \author{ 34 | Bertrand Iooss 35 | } 36 | 37 | \examples{ 38 | x <- runif(100) 39 | y <- round(x) 40 | correlRatio(x,y) 41 | } -------------------------------------------------------------------------------- /man/decoupling.Rd: -------------------------------------------------------------------------------- 1 | \name{decoupling} 2 | \alias{decoupling} 3 | \alias{tell} 4 | \alias{ask} 5 | \alias{extract} 6 | 7 | \title{Decoupling Simulations and Estimations} 8 | 9 | \description{ 10 | \code{tell} and \code{ask} are S3 generic methods for decoupling 11 | simulations and sensitivity measures estimations. In general, they are 12 | not used by the end-user for a simple \R model, but rather for an 13 | external computational code. Most of the sensitivity analyses objects 14 | of this package overload \code{tell}, whereas \code{ask} is overloaded 15 | for iterative methods only. 16 | \code{extract} is used as a post-treatment of a \code{sobolshap_knn} object 17 | } 18 | 19 | \usage{ 20 | tell(x, y = NULL, \dots) 21 | ask(x, \dots) 22 | extract(x, \dots) 23 | } 24 | 25 | \arguments{ 26 | \item{x}{a typed list storing the state of the sensitivity study 27 | (parameters, data, estimates), as returned by sensitivity analyses 28 | objects constructors, such as \code{\link{src}}, \code{\link{morris}}, 29 | etc.} 30 | \item{y}{a vector of model responses.} 31 | \item{\dots}{additional arguments, depending on the method used.} 32 | } 33 | 34 | \details{ 35 | 36 | When a sensitivity analysis method is called with no model 37 | (i.e. argument \code{model = NULL}), it generates an incomplete object 38 | \code{x} that stores the design of experiments (field \code{X}), 39 | allowing the user to launch "by hand" the corresponding 40 | simulations. The method \code{tell} allows to pass these simulation 41 | results to the incomplete object \code{x}, thereafter estimating the 42 | sensitivity measures. 43 | 44 | The \code{extract} method is useful if in a first step the Shapley effects 45 | have been computed and thus sensitivity indices for all possible subsets 46 | are available. The resulting \code{sobolshap_knn} object can be 47 | post-treated by \code{extract} to get first-order and total Sobol indices 48 | very easily. 49 | 50 | % For example, whith an external computational code, one 51 | % would typically: 52 | % \enumerate{ 53 | % \item Save the data \code{x$X} to a file. Also, save the sensitivity 54 | % object \code{x} to a \code{.Rdata} file (see \code{\link{save}}). 55 | % \item Generate the simulator input files, for example with a Perl 56 | % script, or in \R with the function \code{\link{template.replace}}. 57 | % \item launch the simulations, for example with a shell 58 | % script. Simulations may be distributed across a cluster of machines. 59 | % \item Gather the output files an extract the data of interest (shell 60 | % commands \code{grep} and \code{awk} are invaluable in 61 | % this task). We assume at this point that a file contains 62 | % a table of model responses. 63 | % \item Back to \R, load the sensitivity object \code{x} (saved at step 1) and 64 | % the responses \code{y} (saved at step 4). 65 | % \item Call the method \code{tell} to compute the sensitivity 66 | % measures, and do \code{print} and \code{plot} to analyze them. 67 | % } 68 | 69 | When the method is iterative, the data to simulate are not stored in 70 | the sensitivity analysis object \code{x}, but generated at each 71 | iteration with the \code{ask} method; see for example 72 | \code{\link{sb}}. 73 | 74 | } 75 | 76 | \value{ 77 | \code{tell} doesn't return anything. It computes the sensitivity 78 | measures, and stores them in the list \code{x}. 79 | \strong{Side effect: \code{tell} modifies its argument \code{x}.} 80 | 81 | \code{ask} returns the set of data to simulate. 82 | 83 | \code{extract} returns an object, from a \code{sobolshap_knn} object, 84 | containing first-order and total Sobol indices. 85 | } 86 | 87 | \author{ 88 | Gilles Pujol and Bertrand Iooss 89 | } 90 | 91 | \examples{ 92 | # Example of use of fast99 with "model = NULL" 93 | x <- fast99(model = NULL, factors = 3, n = 1000, 94 | q = "qunif", q.arg = list(min = -pi, max = pi)) 95 | y <- ishigami.fun(x$X) 96 | tell(x, y) 97 | print(x) 98 | plot(x) 99 | } 100 | 101 | \keyword{methods} 102 | -------------------------------------------------------------------------------- /man/delsa.Rd: -------------------------------------------------------------------------------- 1 | \name{delsa} 2 | \alias{delsa} 3 | \alias{tell.delsa} 4 | \alias{print.delsa} 5 | \alias{plot.delsa} 6 | 7 | \title{Distributed Evaluation of Local Sensitivity Analysis} 8 | 9 | \description{ \code{delsa} implements Distributed Evaluation of 10 | Local Sensitivity Analysis to calculate first order parameter 11 | sensitivity at multiple locations in parameter space. The locations 12 | in parameter space can either be obtained by a call to \code{\link{parameterSets}} 13 | or by specifying \code{X0} directly, in which case the prior variance 14 | of each parameter \code{varprior} also needs to be specified. Via \code{plot} 15 | (which uses functions of the package \code{ggplot2} and \code{reshape2}), 16 | the indices can be visualized. 17 | } 18 | \usage{ 19 | delsa(model = NULL, perturb=1.01, 20 | par.ranges, samples, method, 21 | X0, varprior, varoutput, 22 | \dots) 23 | 24 | \method{tell}{delsa}(x, y = NULL,\dots) 25 | 26 | \method{print}{delsa}(x, \dots) 27 | 28 | \method{plot}{delsa}(x, which=1:3, ask = dev.interactive(), \dots) 29 | } 30 | 31 | \arguments{ 32 | \item{model}{a function, or a model with a \code{predict} method, 33 | defining the model to analyze.} 34 | \item{perturb}{Perturbation used to calculate sensitivity at each evaluation location} 35 | \item{par.ranges}{A named list of minimum and maximum parameter values} 36 | \item{samples}{Number of samples to generate. For the \code{"grid"} and 37 | \code{"innergrid"} method, corresponds to the number of samples for 38 | each parameter, and may be a vector.} 39 | \item{method}{Sampling scheme. See \code{\link{parameterSets}}} 40 | \item{X0}{Parameter values at which to evaluate sensitivity indices. 41 | Can be used instead of specifying sampling \code{method}} 42 | \item{varprior}{Prior variance. If \code{X0} is specified, \code{varprior} 43 | must also be specified.} 44 | \item{varoutput}{Output variance. If \code{"summation"} is specified (default value), 45 | the ouput variance is computed by summing the first order effects. If \code{"empirical"} 46 | is specified, the ouput variance is estimated frome the output sample.} 47 | \item{\dots}{any other arguments for \code{model} which are passed 48 | unchanged each time it is called.} 49 | \item{x}{a list of class \code{"delsa"} storing the state of the 50 | sensitivity study (parameters, data, estimates).} 51 | \item{y}{a vector of model responses.} 52 | \item{which}{if a subset of the plots is required, specify a subset of the numbers 1:3} 53 | \item{ask}{logical; if TRUE, the user is asked before each plot, see \code{\link{par}(ask=.)}} 54 | } 55 | 56 | \value{ 57 | \code{delsa} returns a list of class \code{"delsa"}, containing all 58 | the input arguments detailed before, plus the following components: 59 | 60 | \item{call}{the matched call.} 61 | \item{X}{a \code{data.frame} containing the design of experiments.} 62 | \item{y}{a vector of model responses.} 63 | \item{delsafirst}{the first order indices for each location in \code{X0}.} 64 | \item{deriv}{the values of derivatives for each location in \code{X0}} 65 | } 66 | \details{ 67 | \code{print} shows summary of the first order indices across parameter space. 68 | 69 | \code{plot} shows: (1) the cumulative distribution function of first order 70 | sensitivity across parameter space, (2) variation of first order sensitivity 71 | in relation to model response, and (3) sensitivity in relation to parameter value. 72 | } 73 | \author{ 74 | Conversion for \code{sensitivity} package by Joseph Guillaume, 75 | based on original R code by Oldrich Rakovec. 76 | Addition of the \code{varoutput} argument by Bertrand Iooss (2020). 77 | } 78 | \references{ 79 | Rakovec, O., M. C. Hill, M. P. Clark, A. H. Weerts, A. J. Teuling, R. Uijlenhoet (2014), 80 | Distributed 81 | Evaluation of Local Sensitivity Analysis (DELSA), with application to hydrologic models, 82 | Water Resour. Res., 50, 1-18 83 | } 84 | \seealso{ 85 | \code{\link{parameterSets}} which is used to generate points, \code{\link{sensitivity}} 86 | for other methods in the package 87 | } 88 | 89 | \examples{ 90 | # Test case : the non-monotonic Sobol g-function 91 | # (there are 8 factors, all following the uniform distribution on [0,1]) 92 | 93 | \donttest{ 94 | library(randtoolbox) 95 | x <- delsa(model=sobol.fun, 96 | par.ranges=replicate(8,c(0,1),simplify=FALSE), 97 | samples=100,method="sobol") 98 | 99 | # Summary of sensitivity indices of each parameter across parameter space 100 | print(x) 101 | 102 | library(ggplot2) 103 | library(reshape2) 104 | plot(x) 105 | } 106 | } 107 | \keyword{design} -------------------------------------------------------------------------------- /man/discrepancyCriteria_cplus.Rd: -------------------------------------------------------------------------------- 1 | \name{discrepancyCriteria_cplus} 2 | \alias{discrepancyCriteria_cplus} 3 | 4 | \title{Discrepancy measure} 5 | \description{Compute discrepancy criteria. This function uses a C++ implementation of the function \code{discrepancyCriteria} from package \pkg{DiceDesign}.} 6 | \usage{discrepancyCriteria_cplus(design,type='all')} 7 | 8 | \arguments{ 9 | \item{design}{a matrix corresponding to the design of experiments. 10 | The discrepancy criteria are computed for a design in the unit cube [0,1]\eqn{^d}. 11 | If this condition is not satisfied the design is automatically rescaled.} 12 | \item{type}{type of discrepancies (single value or vector) to be computed: 13 | \tabular{ll}{ 14 | \code{'all'} \tab all type of discrepancies (default) \cr 15 | \code{'C2'} \tab centered L2-discrepancy \cr 16 | \code{'L2'} \tab L2-discrepancy \cr 17 | \code{'L2star'} \tab L2star-discrepancy \cr 18 | \code{'M2'} \tab modified L2-discrepancy \cr 19 | \code{'S2'} \tab symmetric L2-discrepancy \cr 20 | \code{'W2'} \tab wrap-around L2-discrepancy \cr 21 | } 22 | } 23 | } 24 | 25 | \details{The discrepancy measures how far a given distribution of points deviates 26 | from a perfectly uniform one. Different discrepancies are available. 27 | For example, if we denote by \eqn{Vol(J)} the volume of a subset \eqn{J} of \eqn{[0; 1]^d} and \eqn{A(X; J)} the number of points of \eqn{X} falling in \eqn{J}, the \eqn{L2} discrepancy is: 28 | \deqn{D_{L2} (X) = \left[ \int_{[0,1]^{2d}}{} \left( \frac{A(X,J_{a,b})}{n} - Vol (J_{a,b}) \right)^{2} da db \right]^{1/2}}{DL2 (X)^2 = \int_{[0,1]^d} [(A(X,J_{a,b})/n - Vol(J_{a,b})]^2 da db} 29 | where \eqn{a = (a_{1}; ... ; a_{d})'}{a = (a1; ... ; ad)'}, \eqn{b = (b_{1};...; b_{d})'}{b = (b1;...; bd)'} and \eqn{J_{a,b} = 30 | [a_{1}; b_{1}) \times ... \times [a_{d};b_{d})}{J_{a,b} = 31 | [a1; b1) X ... X [ad;bd)}. The other L2-discrepancies are defined according to the same principle with different form from the subset \eqn{J}. 32 | Among all the possibilities, discrepancyCriteria_cplus implements only the L2 discrepancies because it can be expressed analytically even for high dimension. 33 | 34 | 35 | Centered L2-discrepancy is computed using the analytical expression done by Hickernell (1998). The user will refer to Pleming and Manteufel (2005) to have more details about the wrap around discrepancy. 36 | } 37 | 38 | \value{A list containing the L2-discrepancies of the \code{design}.} 39 | 40 | \references{ 41 | Fang K.T, Li R. and Sudjianto A. (2006) Design and Modeling for 42 | Computer Experiments, \emph{Chapman & Hall}. 43 | 44 | Hickernell F.J. (1998) A generalized discrepancy and quadrature error bound. 45 | \emph{Mathematics of Computation}, \bold{67}, 299-322. 46 | 47 | Pleming J.B. and Manteufel R.D. (2005) \emph{Replicated Latin Hypercube Sampling}, 48 | 46th Structures, Structural Dynamics & Materials Conference, 16-21 April 2005, Austin 49 | (Texas) -- AIAA 2005-1819. 50 | } 51 | 52 | \author{Laurent Gilquin} 53 | 54 | \seealso{The distance criterion provided by \code{\link{maximin_cplus}}} 55 | 56 | \examples{ 57 | dimension <- 2 58 | n <- 40 59 | X <- matrix(runif(n*dimension),n,dimension) 60 | discrepancyCriteria_cplus(X) 61 | } 62 | 63 | \keyword{ design } 64 | 65 | -------------------------------------------------------------------------------- /man/fast99.Rd: -------------------------------------------------------------------------------- 1 | \name{fast99} 2 | \alias{fast99} 3 | \alias{tell.fast99} 4 | \alias{print.fast99} 5 | \alias{plot.fast99} 6 | 7 | \title{Extended Fourier Amplitude Sensitivity Test} 8 | 9 | \description{ 10 | \code{fast99} implements the so-called "extended-FAST" method 11 | (Saltelli et al. 1999). This method allows the estimation of first 12 | order and total Sobol' indices for all the factors (alltogether 13 | \eqn{2p}{2p} indices, where \eqn{p}{p} is the number of factors) at a 14 | total cost of \eqn{n \times p}{n * p} simulations. 15 | } 16 | 17 | \usage{ 18 | fast99(model = NULL, factors, n, M = 4, omega = NULL, 19 | q = NULL, q.arg = NULL, \dots) 20 | \method{tell}{fast99}(x, y = NULL, \dots) 21 | \method{print}{fast99}(x, \dots) 22 | \method{plot}{fast99}(x, ylim = c(0, 1), \dots) 23 | } 24 | 25 | \arguments{ 26 | \item{model}{a function, or a model with a \code{predict} method, 27 | defining the model to analyze.} 28 | \item{factors}{an integer giving the number of factors, or a vector of 29 | character strings giving their names.} 30 | \item{n}{an integer giving the sample size, i.e. the length of the 31 | discretization of the s-space (see Cukier et al.).} 32 | \item{M}{an integer specifying the interference parameter, i.e. the 33 | number of harmonics to sum in the Fourier series decomposition (see 34 | Cukier et al.).} 35 | \item{omega}{a vector giving the set of frequencies, one frequency for 36 | each factor (see details below).} 37 | \item{q}{a vector of quantile functions names corresponding to 38 | wanted factors distributions (see details below).} 39 | \item{q.arg}{a list of quantile functions parameters (see details below).} 40 | \item{x}{a list of class \code{"fast99"} storing the state of the 41 | sensitivity study (parameters, data, estimates).} 42 | \item{y}{a vector of model responses.} 43 | \item{ylim}{y-coordinate plotting limits.} 44 | \item{\dots}{any other arguments for \code{model} which are passed 45 | unchanged each time it is called.} 46 | } 47 | 48 | \details{ 49 | 50 | If not given, the set of frequencies \code{omega} is taken from 51 | Saltelli et al. The first frequency of the vector \code{omega} is 52 | assigned to each factor \eqn{X_i}{X_i} in turn (corresponding to the 53 | estimation of Sobol' indices \eqn{S_i}{S_i} and \eqn{S_{T_i}}{ST_i}), 54 | other frequencies being assigned to the remaining factors. 55 | 56 | If the arguments \code{q} and \code{q.args} are not given, the factors 57 | are taken uniformly distributed on \eqn{[0,1]}{[0,1]}. The 58 | argument \code{q} must be list of character strings, giving the names 59 | of the quantile functions (one for each factor), such as \code{qunif}, 60 | \code{qnorm}\dots It can also be a single character string, meaning 61 | same distribution for all. The argument \code{q.arg} must be a list of 62 | lists, each one being additional parameters for the corresponding 63 | quantile function. For example, the parameters of the quantile 64 | function \code{qunif} could be \code{list(min=1, max=2)}, giving an 65 | uniform distribution on \eqn{[1,2]}{[1,2]}. If \code{q} is a single 66 | character string, then \code{q.arg} must be a single list (rather than 67 | a list of one list). 68 | 69 | } 70 | 71 | \value{ 72 | \code{fast99} returns a list of class \code{"fast99"}, containing all 73 | the input arguments detailed before, plus the following components: 74 | 75 | \item{call}{the matched call.} 76 | \item{X}{a \code{data.frame} containing the factors sample values.} 77 | \item{y}{a vector of model responses.} 78 | \item{V}{the estimation of variance.} 79 | \item{D1}{the estimations of Variances of the Conditional Expectations 80 | (VCE) with respect to each factor.} 81 | \item{Dt}{the estimations of VCE with respect to each factor 82 | complementary set of factors ("all but \eqn{X_i}{Xi}").} 83 | } 84 | 85 | 86 | \references{ 87 | A. Saltelli, S. Tarantola and K. Chan, 1999, \emph{A quantitative, model 88 | independent method for global sensitivity analysis of model 89 | output}, Technometrics, 41, 39--56. 90 | 91 | R. I. Cukier, H. B. Levine and K. E. Schuler, 1978, \emph{Nonlinear 92 | sensitivity analysis of multiparameter model 93 | systems}. J. Comput. Phys., 26, 1--42. 94 | } 95 | 96 | \author{ 97 | Gilles Pujol 98 | } 99 | 100 | \examples{ 101 | # Test case : the non-monotonic Ishigami function 102 | x <- fast99(model = ishigami.fun, factors = 3, n = 1000, 103 | q = "qunif", q.arg = list(min = -pi, max = pi)) 104 | print(x) 105 | plot(x) 106 | } 107 | 108 | \keyword{design} 109 | -------------------------------------------------------------------------------- /man/maximin_cplus.Rd: -------------------------------------------------------------------------------- 1 | \name{maximin_cplus} 2 | \alias{maximin_cplus} 3 | \title{Maximin criterion} 4 | \description{Compute the \code{maximin} criterion (also called mindist). This function uses a C++ implementation of the function mindist from package \pkg{DiceDesign}.} 5 | \usage{maximin_cplus(design)} 6 | 7 | \arguments{ 8 | \item{design}{a matrix representing the design of experiments in the unit cube [0,1]\eqn{^d}. If this last condition is not fulfilled, a transformation into [0,1]\eqn{^{d}} is applied before the computation of the criteria.} 9 | } 10 | 11 | \details{The maximin criterion is defined by: 12 | \deqn{maximin= \min_{x_{i}\in X} \left( \gamma_{i} \right)}{maximin = min (g_1, ... g_n)} 13 | where \eqn{\gamma_{i}}{g_i} is the minimal distance between the point \eqn{x_{i}}{x_i} 14 | and the other points \eqn{x_{k}}{x_k} of the \code{design}. 15 | 16 | A higher value corresponds to a more regular scaterring of design points. 17 | } 18 | 19 | \value{A real number equal to the value of the maximin criterion for the \code{design}.} 20 | 21 | \references{Gunzburer M., Burkdart J. (2004) \emph{Uniformity measures for point 22 | samples in hypercubes} 23 | \url{https://people.sc.fsu.edu/~jburkardt/}. 24 | 25 | Jonshon M.E., Moore L.M. and Ylvisaker D. (1990) \emph{Minmax and maximin distance 26 | designs}, J. of Statis. Planning and Inference, 26, 131-148. 27 | 28 | Chen V.C.P., Tsui K.L., Barton R.R. and Allen J.K. (2003) \emph{A review of design 29 | and modeling in computer experiments}, Handbook of Statistics, 22, 231-261. 30 | } 31 | 32 | \author{Laurent Gilquin} 33 | 34 | \seealso{discrepancy measures provided by \code{\link{discrepancyCriteria_cplus}}.} 35 | 36 | \examples{ 37 | dimension <- 2 38 | n <- 40 39 | X <- matrix(runif(n*dimension),n,dimension) 40 | maximin_cplus(X) 41 | } 42 | -------------------------------------------------------------------------------- /man/parameterSets.Rd: -------------------------------------------------------------------------------- 1 | \name{parameterSets} 2 | \alias{parameterSets} 3 | \title{ 4 | Generate parameter sets 5 | } 6 | \description{ 7 | Generate parameter sets from given ranges, with chosen sampling scheme 8 | } 9 | \usage{ 10 | parameterSets(par.ranges, samples, method = c("sobol", "innergrid", "grid")) 11 | } 12 | \arguments{ 13 | \item{par.ranges}{ 14 | A named list of minimum and maximum parameter values 15 | } 16 | \item{samples}{ 17 | Number of samples to generate. For the \code{"grid"} and \code{"innergrid"} 18 | method, may be a vector of number of samples for each parameter. 19 | } 20 | \item{method}{ 21 | the sampling scheme; see Details 22 | } 23 | } 24 | \details{ 25 | Method \code{"sobol"} generates uniformly distributed Sobol low discrepancy numbers, 26 | using the sobol function in the randtoolbox package. 27 | 28 | Method \code{"grid"} generates a grid within the parameter ranges, including its extremes, 29 | with number of points determined by \code{samples} 30 | 31 | Method \code{"innergrid"} generates a grid within the parameter ranges, with edges 32 | of the grid offset from the extremes. The offset is calculated as half 33 | of the resolution of the grid \code{diff(par.ranges)/samples/2}. 34 | 35 | } 36 | \value{ 37 | the result is a \code{matrix}, with named columns for each parameter in \code{par.ranges}. 38 | Each row represents one parameter set. 39 | } 40 | \author{ 41 | Joseph Guillaume, based on similar function by Felix Andrews 42 | } 43 | \seealso{ 44 | \code{\link{delsa}}, which uses this function 45 | } 46 | \examples{ 47 | 48 | X.grid <- parameterSets(par.ranges=list(V1=c(1,1000),V2=c(1,4)), 49 | samples=c(10,10),method="grid") 50 | plot(X.grid) 51 | 52 | X.innergrid<-parameterSets(par.ranges=list(V1=c(1,1000),V2=c(1,4)), 53 | samples=c(10,10),method="innergrid") 54 | points(X.innergrid,col="red") 55 | 56 | \donttest{ 57 | library(randtoolbox) 58 | X.sobol<-parameterSets(par.ranges=list(V1=c(1,1000),V2=c(1,4)), 59 | samples=100,method="sobol") 60 | plot(X.sobol) 61 | } 62 | } 63 | \keyword{ utilities } 64 | -------------------------------------------------------------------------------- /man/pcc.Rd: -------------------------------------------------------------------------------- 1 | \name{pcc} 2 | \alias{pcc} 3 | \alias{print.pcc} 4 | \alias{plot.pcc} 5 | \alias{ggplot.pcc} 6 | 7 | \title{Partial Correlation Coefficients} 8 | 9 | \description{ 10 | \code{pcc} computes the Partial Correlation Coefficients (PCC), 11 | Semi-Partial Correlation Coefficients (SPCC), Partial Rank Correlation 12 | Coefficients (PRCC) or Semi-Partial Rank Correlation Coefficients (SPRCC), 13 | which are variance-based measures based on linear (resp. monotonic) 14 | assumptions, in the case of (linearly) correlated factors. 15 | } 16 | 17 | \usage{ 18 | pcc(X, y, rank = FALSE, semi = FALSE, logistic = FALSE, nboot = 0, conf = 0.95) 19 | \method{print}{pcc}(x, \dots) 20 | \method{plot}{pcc}(x, ylim = c(-1,1), \dots) 21 | \method{ggplot}{pcc}(data, mapping = aes(), \dots, environment 22 | = parent.frame(), ylim = c(-1,1)) 23 | } 24 | 25 | \arguments{ 26 | \item{X}{a data frame (or object coercible by \code{as.data.frame}) 27 | containing the design of experiments (model input variables).} 28 | \item{y}{a vector containing the responses corresponding to the design 29 | of experiments (model output variables).} 30 | \item{rank}{logical. If \code{TRUE}, the analysis is done on the 31 | ranks.} 32 | \item{semi}{logical. If \code{TRUE}, semi-PCC are computed.} 33 | \item{logistic}{logical. If \code{TRUE}, the analysis is done via a 34 | logistic regression (binomial GLM).} 35 | \item{nboot}{the number of bootstrap replicates.} 36 | \item{conf}{the confidence level of the bootstrap confidence intervals.} 37 | \item{x}{the object returned by \code{pcc}.} 38 | \item{data}{the object returned by \code{pcc}.} 39 | \item{ylim}{the y-coordinate limits of the plot.} 40 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 41 | must be supplied in each layer added to the plot.} 42 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 43 | \item{\dots}{arguments to be passed to methods, such as graphical 44 | parameters (see \code{par}).} 45 | } 46 | 47 | \value{ 48 | \code{pcc} returns a list of class \code{"pcc"}, containing the following 49 | components: 50 | 51 | \item{call}{the matched call.} 52 | \item{PCC}{a data frame containing the estimations of the PCC 53 | indices, bias and confidence intervals (if \code{rank = TRUE} 54 | and \code{semi = FALSE}).} 55 | \item{PRCC}{a data frame containing the estimations of the PRCC 56 | indices, bias and confidence intervals (if \code{rank = TRUE} 57 | and \code{semi = FALSE}).} 58 | \item{SPCC}{a data frame containing the estimations of the PCC 59 | indices, bias and confidence intervals (if \code{rank = TRUE} 60 | and \code{semi = TRUE}).} 61 | \item{SPRCC}{a data frame containing the estimations of the PRCC 62 | indices, bias and confidence intervals (if \code{rank = TRUE} 63 | and \code{semi = TRUE}).} 64 | } 65 | 66 | \details{ 67 | Logistic regression model (\code{logistic = TRUE}) and rank-based indices 68 | (\code{rank = TRUE}) are incompatible. 69 | } 70 | 71 | \references{ 72 | 73 | L. Clouvel, B. Iooss, V. Chabridon, M. Il Idrissi and F. Robin, 2023, 74 | \emph{An overview of variance-based importance measures in the linear regression context: 75 | comparative analyses and numerical tests}, Preprint. 76 | \url{https://hal.science/hal-04102053} 77 | 78 | B. Iooss, V. Chabridon and V. Thouvenot, \emph{Variance-based importance 79 | measures for machine learning model interpretability}, Congres lambda-mu23, 80 | Saclay, France, 10-13 octobre 2022 81 | \url{https://hal.science/hal-03741384} 82 | 83 | J.W. Johnson and J.M. LeBreton, 2004, \emph{History and use of relative 84 | importance indices in organizational research}, Organizational 85 | Research Methods, 7:238-257. 86 | 87 | A. Saltelli, K. Chan and E. M. Scott eds, 2000, \emph{Sensitivity 88 | Analysis}, Wiley. 89 | } 90 | 91 | \author{ 92 | Gilles Pujol and Bertrand Iooss 93 | } 94 | 95 | \examples{ 96 | \donttest{ 97 | # a 100-sample with X1 ~ U(0.5, 1.5) 98 | # X2 ~ U(1.5, 4.5) 99 | # X3 ~ U(4.5, 13.5) 100 | library(boot) 101 | n <- 100 102 | X <- data.frame(X1 = runif(n, 0.5, 1.5), 103 | X2 = runif(n, 1.5, 4.5), 104 | X3 = runif(n, 4.5, 13.5)) 105 | 106 | # linear model : Y = X1^2 + X2 + X3 107 | y <- with(X, X1^2 + X2 + X3) 108 | 109 | # sensitivity analysis 110 | x <- pcc(X, y, nboot = 100) 111 | print(x) 112 | plot(x) 113 | 114 | library(ggplot2) 115 | ggplot(x) 116 | ggplot(x, ylim = c(-1.5,1.5)) 117 | 118 | x <- pcc(X, y, semi = TRUE, nboot = 100) 119 | print(x) 120 | plot(x) 121 | } 122 | } 123 | 124 | \seealso{ 125 | \code{\link{src}}, \code{\link{lmg}}, \code{\link{pmvd}} 126 | } 127 | 128 | \keyword{regression} 129 | -------------------------------------------------------------------------------- /man/plot.support.Rd: -------------------------------------------------------------------------------- 1 | \name{plot.support} 2 | \alias{plot.support} 3 | \alias{plot} 4 | \alias{scatterplot.support} 5 | \alias{scatterplot} 6 | 7 | \title{ 8 | Support index functions: Measuring the effect of input variables over their support 9 | } 10 | 11 | \description{ 12 | Methods to plot the normalized support index functions (Fruth et al., 2016). 13 | } 14 | 15 | \usage{ 16 | \method{plot}{support}(x, i = 1:ncol(x$X), 17 | xprob = FALSE, p = NULL, p.arg = NULL, 18 | ylim = NULL, col = 1:3, lty = 1:3, lwd = c(2,2,1), cex = 1, ...) 19 | \method{scatterplot}{support}(x, i = 1:ncol(x$X), 20 | xprob = FALSE, p = NULL, p.arg = NULL, 21 | cex = 1, cex.lab = 1, ...) 22 | 23 | } 24 | 25 | \arguments{ 26 | \item{x}{an object of class support.} 27 | \item{i}{an optional vector of integers indicating the subset of input variables \code{X_i} for plotting. Default is the entire set of input variables.} 28 | \item{xprob}{an optional boolean indicating whether the inputs should be plotted in probability scale.} 29 | \item{p}{,} 30 | \item{p.arg}{list of probability names and parameters for the input distribution.} 31 | \item{ylim}{,} 32 | \item{col}{,} 33 | \item{lty}{,} 34 | \item{lwd}{,} 35 | \item{cex}{,} 36 | \item{cex.lab}{usual graphical parameters.} 37 | \item{\dots}{additional graphical parameters to be passed to \code{scatterplot} method (\code{ggMarginal} function).} 38 | } 39 | 40 | \details{ 41 | If \code{xprob = TRUE}, the input variable \code{X_i} is plotted in probability scale according to the informations provided in the arguments \code{p, p.arg}: The x-axis is thus \code{F(x)}, where \code{F} is the cdf of \code{X_i}. If these ones are not provided, the empirical distribution is used for rescaling: The x-axis is thus \code{Fn(x)}, where \code{Fn} is the empirical cdf of \code{X_i}. 42 | 43 | Legend details: 44 | 45 | zeta*T : normalized total support index function 46 | 47 | zeta* : normalized 1st-order support index function 48 | 49 | nu* : normalized DGSM 50 | 51 | Notice that the sum of (normalized) DGSM (nu*) over all input variables is equal to 1. 52 | Furthermore, the expectation of the total support index function (zeta*T) is equal to the (normalized) DGSM (nu*). 53 | } 54 | 55 | \author{O. Roustant} 56 | 57 | \seealso{ 58 | Estimation of support index functions: \code{\link{support}} 59 | } 60 | -------------------------------------------------------------------------------- /man/sb.Rd: -------------------------------------------------------------------------------- 1 | \name{sb} 2 | \alias{sb} 3 | \alias{ask.sb} 4 | \alias{tell.sb} 5 | \alias{print.sb} 6 | \alias{plot.sb} 7 | 8 | \title{Sequential Bifurcations} 9 | 10 | \description{ \code{sb} implements the Sequential Bifurcations screening 11 | method (Bettonvil and Kleijnen 1996).} 12 | 13 | \usage{ 14 | sb(p, sign = rep("+", p), interaction = FALSE) 15 | \method{ask}{sb}(x, i = NULL, \dots) 16 | \method{tell}{sb}(x, y, \dots) 17 | \method{print}{sb}(x, \dots) 18 | \method{plot}{sb}(x, \dots) 19 | } 20 | 21 | \arguments{ 22 | \item{p}{number of factors.} 23 | \item{sign}{a vector fo length \code{p} filled with \code{"+"} and 24 | \code{"-"}, giving the (assumed) signs of the factors effects.} 25 | \item{interaction}{a boolean, \code{TRUE} if the model is supposed to 26 | be with interactions, \code{FALSE} otherwise.} 27 | \item{x}{a list of class \code{"sb"} storing the state of the 28 | screening study at the current iteration.} 29 | \item{y}{a vector of model responses.} 30 | \item{i}{an integer, used to force a wanted bifurcation instead of that 31 | proposed by the algorithm.} 32 | \item{\dots}{not used.} 33 | } 34 | 35 | \details{ 36 | The model without interaction is 37 | \deqn{Y=\beta_0 + \sum_{i=1}^p \beta_i X_i}{ 38 | Y = beta_0 + sum_{i=1}^p beta_i X_i} 39 | while the model with interactions is 40 | \deqn{Y=\beta_0 + \sum_{i=1}^p \beta_i X_i + \sum_{1 \leq i < j \leq 41 | p} \gamma_{ij} X_i X_j}{ 42 | Y = beta_0 + sum_{i=1}^p beta_i X_i + sum_{1 <= i < j <= p} gamma_{ij} X_i X_j} 43 | In both cases, the factors are assumed to be uniformly distributed on 44 | \eqn{[-1,1]}{[-1,1]}. This is a difference with Bettonvil 45 | et al. where the factors vary across \eqn{[0,1]}{[0,1]} in the former 46 | case, while \eqn{[-1,1]}{[-1,1]} in the latter. 47 | 48 | Another difference with Bettonvil et al. is that in the current 49 | implementation, the groups are splitted right in the middle. 50 | } 51 | 52 | \value{ 53 | \code{sb} returns a list of class \code{"sb"}, containing all 54 | the input arguments detailed before, plus the following components: 55 | 56 | \item{i}{the vector of bifurcations.} 57 | \item{y}{the vector of observations.} 58 | \item{ym}{the vector of mirror observations (model with interactions 59 | only).} 60 | 61 | The groups effects can be displayed with the \code{print} method. 62 | } 63 | 64 | \references{ 65 | B. Bettonvil and J. P. C. Kleijnen, 1996, \emph{Searching for important 66 | factors in simulation models with many factors: sequential 67 | bifurcations}, European Journal of Operational Research, 96, 180--194. 68 | } 69 | 70 | \author{ 71 | Gilles Pujol 72 | } 73 | 74 | \examples{ 75 | # a model with interactions 76 | p <- 50 77 | beta <- numeric(length = p) 78 | beta[1:5] <- runif(n = 5, min = 10, max = 50) 79 | beta[6:p] <- runif(n = p - 5, min = 0, max = 0.3) 80 | beta <- sample(beta) 81 | gamma <- matrix(data = runif(n = p^2, min = 0, max = 0.1), nrow = p, ncol = p) 82 | gamma[lower.tri(gamma, diag = TRUE)] <- 0 83 | gamma[1,2] <- 5 84 | gamma[5,9] <- 12 85 | f <- function(x) { return(sum(x * beta) + (x \%*\% gamma \%*\% x))} 86 | 87 | # 10 iterations of SB 88 | sa <- sb(p, interaction = TRUE) 89 | for (i in 1 : 10) { 90 | x <- ask(sa) 91 | y <- list() 92 | for (i in names(x)) { 93 | y[[i]] <- f(x[[i]]) 94 | } 95 | tell(sa, y) 96 | } 97 | print(sa) 98 | plot(sa) 99 | } 100 | 101 | \keyword{design} 102 | -------------------------------------------------------------------------------- /man/sensiFdiv.Rd: -------------------------------------------------------------------------------- 1 | \name{sensiFdiv} 2 | \alias{sensiFdiv} 3 | \alias{tell.sensiFdiv} 4 | \alias{print.sensiFdiv} 5 | \alias{plot.sensiFdiv} 6 | \alias{ggplot.sensiFdiv} 7 | 8 | \title{Sensitivity Indices based on Csiszar f-divergence} 9 | 10 | \description{ \code{sensiFdiv} conducts a density-based sensitivity 11 | analysis where the impact of an input variable is defined 12 | in terms of dissimilarity between the original output density function 13 | and the output density function when the input variable is fixed. 14 | The dissimilarity between density functions is measured with Csiszar f-divergences. 15 | Estimation is performed through kernel density estimation and 16 | the function \code{kde} of the package \code{ks}.} 17 | 18 | \usage{ 19 | sensiFdiv(model = NULL, X, fdiv = "TV", nboot = 0, conf = 0.95, ...) 20 | \method{tell}{sensiFdiv}(x, y = NULL, \dots) 21 | \method{print}{sensiFdiv}(x, \dots) 22 | \method{plot}{sensiFdiv}(x, ylim = c(0, 1), \dots) 23 | \method{ggplot}{sensiFdiv}(data, mapping = aes(), ylim = c(0, 1), \dots, environment 24 | = parent.frame()) 25 | } 26 | 27 | \arguments{ 28 | \item{model}{a function, or a model with a \code{predict} method, 29 | defining the model to analyze.} 30 | \item{X}{a matrix or \code{data.frame} representing the input random sample.} 31 | \item{fdiv}{a string or a list of strings specifying the Csiszar f-divergence 32 | to be used. Available choices are "TV" (Total-Variation), 33 | "KL" (Kullback-Leibler), "Hellinger" and "Chi2" (Neyman chi-squared).} 34 | \item{nboot}{the number of bootstrap replicates} 35 | \item{conf}{the confidence level for confidence intervals.} 36 | \item{x}{a list of class \code{"sensiFdiv"} storing the state of the 37 | sensitivity study (parameters, data, estimates).} 38 | \item{data}{a list of class \code{"sensiFdiv"} storing the state of the 39 | sensitivity study (parameters, data, estimates).} 40 | \item{y}{a vector of model responses.} 41 | \item{ylim}{y-coordinate plotting limits.} 42 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 43 | must be supplied in each layer added to the plot.} 44 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 45 | \item{\dots}{any other arguments for \code{model} which are passed 46 | unchanged each time it is called.} 47 | } 48 | 49 | \value{ 50 | \code{sensiFdiv} returns a list of class \code{"sensiFdiv"}, containing all 51 | the input arguments detailed before, plus the following components: 52 | 53 | \item{call}{the matched call.} 54 | \item{X}{a \code{data.frame} containing the design of experiments.} 55 | \item{y}{a vector of model responses.} 56 | \item{S}{the estimations of the Csiszar f-divergence sensitivity indices. 57 | If several divergences have been selected, Sis a list where each element 58 | encompasses the estimations of the sensitivity indices for one of the divergence.} 59 | } 60 | 61 | \details{ 62 | Some of the Csiszar f-divergences produce sensitivity indices that have 63 | already been studied in the context of sensitivity analysis. 64 | In particular, "TV" leads to the importance measure proposed by Borgonovo (2007) 65 | (up to a constant), "KL" corresponds to the mutual information (Krzykacz-Hausmann 2001) and 66 | "Chi2" produces the squared-loss mutual information. See Da Veiga (2015) for details. 67 | } 68 | \references{ 69 | Borgonovo E. (2007), \emph{A new uncertainty importance measure}, 70 | Reliability Engineering and System Safety 92(6), 771--784. 71 | 72 | Da Veiga S. (2015), \emph{Global sensitivity analysis with dependence measures}, 73 | Journal of Statistical Computation and Simulation, 85(7), 1283--1305. 74 | 75 | Krzykacz-Hausmann B. (2001), \emph{Epistemic sensitivity analysis based on the 76 | concept of entropy}, Proceedings of SAMO2001, 53--57. 77 | } 78 | 79 | \author{ 80 | Sebastien Da Veiga, Snecma 81 | } 82 | 83 | \seealso{ 84 | \code{\link[ks]{kde}, \link{sensiHSIC}} 85 | } 86 | 87 | \examples{ 88 | \donttest{ 89 | library(ks) 90 | 91 | # Test case : the non-monotonic Sobol g-function 92 | n <- 100 93 | X <- data.frame(matrix(runif(8 * n), nrow = n)) 94 | 95 | # Density-based sensitivity analysis 96 | # the next lines are put in comment because too long for CRAN tests 97 | #x <- sensiFdiv(model = sobol.fun, X = X, fdiv = c("TV","KL"), nboot=30) 98 | #print(x) 99 | #library(ggplot2) 100 | #ggplot(x) 101 | } 102 | } 103 | 104 | -------------------------------------------------------------------------------- /man/shapleyLinearGaussian.Rd: -------------------------------------------------------------------------------- 1 | \name{shapleyLinearGaussian} 2 | \alias{shapleyLinearGaussian} 3 | 4 | 5 | \title{Computation of the Shapley effects in the linear Gaussian framework} 6 | 7 | \description{ 8 | \code{shapleyLinearGaussian} implements the computation of 9 | the Shapley effects in the linear Gaussian framework, using the linear model 10 | (without the value at zero) and the covariance matrix of the inputs. 11 | It uses the block-diagonal covariance trick of Broto et al. (2019) which allows 12 | to go through high-dimensional cases (nb of inputs > 25). 13 | It gives a warning in case of dim(block) > 25. 14 | } 15 | 16 | \usage{ 17 | shapleyLinearGaussian(Beta, Sigma, tol=10^(-6)) 18 | } 19 | 20 | \arguments{ 21 | \item{Beta}{a vector containing the coefficients of the linear model (without the value at zero).} 22 | \item{Sigma}{covariance matrix of the inputs. Has to be positive semi-definite matrix with same size that Beta.} 23 | \item{tol}{a relative tolerance to detect zero singular values of Sigma.} 24 | } 25 | 26 | \value{ 27 | \code{shapleyLinearGaussian} returns a numeric vector containing all the Shapley effects. 28 | } 29 | 30 | \references{ 31 | B. Broto, F. Bachoc, M. Depecker, and J-M. Martinez, 2019, \emph{Sensitivity indices 32 | for independent groups of variables}, Mathematics and Computers in Simulation, 163, 19--31. 33 | 34 | B. Broto, F. Bachoc, L. Clouvel and J-M Martinez, 2022,\emph{Block-diagonal 35 | covariance estimation and application to the Shapley effects in sensitivity analysis}, 36 | SIAM/ASA Journal on Uncertainty Quantification, 10, 379--403. 37 | 38 | B. Iooss and C. Prieur, 2019, \emph{Shapley effects for sensitivity analysis with 39 | correlated inputs: comparisons with Sobol' indices, numerical estimation and 40 | applications}, International Journal for Uncertainty Quantification, 9, 493--514. 41 | 42 | A.B. Owen and C. Prieur, 2016, \emph{On Shapley value for measuring importance 43 | of dependent inputs}, SIAM/ASA Journal of Uncertainty Quantification, 5, 986--1002. 44 | } 45 | 46 | \author{ 47 | Baptiste Broto 48 | } 49 | 50 | \seealso{ 51 | \link{shapleyBlockEstimation}, \link{shapleyPermEx}, \link{shapleyPermRand}, 52 | \link{shapleySubsetMc}, \link{shapleysobol_knn}, \link{johnsonshap} 53 | } 54 | 55 | 56 | \examples{ 57 | 58 | library(MASS) 59 | library(igraph) 60 | 61 | # First example: 62 | 63 | p=5 #dimension 64 | A=matrix(rnorm(p^2),nrow=p,ncol=p) 65 | Sigma=t(A)\%*\%A 66 | Beta=runif(p) 67 | Shapley=shapleyLinearGaussian(Beta,Sigma) 68 | plot(Shapley) 69 | 70 | 71 | # Second Example, block-diagonal: 72 | 73 | K=5 #number of groups 74 | m=5 # number of variables in each group 75 | p=K*m 76 | Sigma=matrix(0,ncol=p,nrow=p) 77 | 78 | for(k in 1:K) 79 | { 80 | A=matrix(rnorm(m^2),nrow=m,ncol=m) 81 | Sigma[(m*(k-1)+1):(m*k),(m*(k-1)+1):(m*k)]=t(A)\%*\%A 82 | } 83 | # we mix the variables: 84 | samp=sample(1:p,p) 85 | Sigma=Sigma[samp,samp] 86 | 87 | Beta=runif(p) 88 | Shapley=shapleyLinearGaussian(Beta,Sigma) 89 | plot(Shapley) 90 | 91 | } -------------------------------------------------------------------------------- /man/shapleySubsetMc.Rd: -------------------------------------------------------------------------------- 1 | \name{shapleySubsetMc} 2 | \alias{shapleySubsetMc} 3 | \alias{plot.shapleySubsetMc} 4 | 5 | \title{Estimation of Shapley effects from data using nearest neighbors method} 6 | 7 | \description{ 8 | \code{shapleySubsetMc} implements the estimation of 9 | the Shapley effects from data using some nearest neighbors method 10 | to generate according to the conditional distributions of the inputs. 11 | It can be used with categorical inputs. 12 | } 13 | 14 | \usage{ 15 | shapleySubsetMc(X,Y, Ntot=NULL, Ni=3, cat=NULL, weight=NULL, discrete=NULL, 16 | noise=FALSE) 17 | \method{plot}{shapleySubsetMc}(x, ylim = c(0, 1), \dots) 18 | } 19 | 20 | \arguments{ 21 | \item{X}{a matrix or a dataframe of the input sample} 22 | \item{Y}{a vector of the output sample} 23 | \item{Ntot}{an integer of the approximate cost wanted} 24 | \item{Ni}{the number of nearest neighbours taken for each point} 25 | \item{cat}{a vector giving the indices of the input categorical variables} 26 | \item{weight}{a vector with the same length of \code{cat} giving the weight of each 27 | categorical variable in the product distance} 28 | \item{discrete}{a vector giving the indices of the input variable that are 29 | real, and not categorical, but that can take several times the same values} 30 | \item{noise}{logical. If FALSE (the default), the variable Y is a function of X} 31 | \item{x}{a list of class \code{"shapleySubsetMc"} storing the state of the 32 | sensitivity study (Shapley effects, cost, names of inputs)} 33 | \item{ylim}{y-coordinate plotting limits} 34 | \item{\dots}{any other arguments for plotting} 35 | } 36 | 37 | \value{ 38 | \code{shapleySubsetMc} returns a list of class \code{"shapleySubsetMc"}, 39 | containing: 40 | \item{shapley}{the Shapley effects estimates.} 41 | \item{cost}{the real total cost of these estimates: the total number of points for which 42 | the nearest neighbours were computed.} 43 | \item{names}{the labels of the input variables.} 44 | } 45 | 46 | \details{ 47 | If \code{weight = NULL}, all the categorical variables will have the same weight 1. 48 | 49 | If \code{Ntot = NULL}, the nearest neighbours will be compute for all the \eqn{n (2^p-2)} points, 50 | where n is the length of the sample. The estimation can be very long with this parameter. 51 | } 52 | 53 | \references{ 54 | B. Broto, F. Bachoc, M. Depecker, 2020, \emph{Variance reduction for estimation of 55 | Shapley effects and adaptation to unknown input distribution}, 56 | SIAM/ASA Journal of Uncertainty Quantification, 8:693-716. 57 | } 58 | 59 | \author{ 60 | Baptiste Broto 61 | } 62 | 63 | \seealso{ 64 | \link{shapleyPermEx}, \link{shapleyPermRand}, \link{shapleyLinearGaussian}, \link{sobolrank}, \link{shapleysobol_knn} 65 | } 66 | 67 | \examples{ 68 | \donttest{ 69 | 70 | # First example: the linear Gaussian framework 71 | 72 | # we generate a covariance matrice Sigma 73 | p <- 4 #dimension 74 | A <- matrix(rnorm(p^2),nrow=p,ncol=p) 75 | Sigma <- t(A)\%*\%A # it means t(A)%*%A 76 | C <- chol(Sigma) 77 | n <- 500 #sample size (put n=2000 for more consistency) 78 | 79 | Z=matrix(rnorm(p*n),nrow=n,ncol=p) 80 | X=Z\%*\%C # X is a gaussian vector with zero mean and covariance Sigma 81 | Y=rowSums(X) 82 | Shap=shapleySubsetMc(X=X,Y=Y,Ntot=5000) 83 | plot(Shap) 84 | 85 | 86 | #Second example: The Sobol model with heterogeneous inputs 87 | 88 | p=8 #dimension 89 | A=matrix(rnorm(p^2),nrow=p,ncol=p) 90 | Sigma=t(A)\%*\%A 91 | C=chol(Sigma) 92 | n=500 #sample size (put n=5000 for more consistency) 93 | 94 | Z=matrix(rnorm(p*n),nrow=n,ncol=p) 95 | X=Z%*%C+1 # X is a gaussian vector with mean (1,1,..,1) and covariance Sigma 96 | 97 | #we create discrete and categorical variables 98 | X[,1]=round(X[,1]/2) 99 | X[,2]=X[,2]>2 100 | X[,4]=-2*round(X[,4])+4 101 | X[(X[,6]>0 &X[,6]<1),6]=1 102 | 103 | cat=c(1,2) # we choose to take X1 and X2 as categorical variables 104 | # (with the discrete distance) 105 | discrete=c(4,6) # we indicate that X4 and X6 can take several times the same value 106 | 107 | Y=sobol.fun(X) 108 | Ntot <- 2000 # put Ntot=20000 for more consistency 109 | Shap=shapleySubsetMc(X=X,Y=Y, cat=cat, discrete=discrete, Ntot=Ntot, Ni=10) 110 | 111 | plot(Shap) 112 | } 113 | 114 | } -------------------------------------------------------------------------------- /man/sobol.Rd: -------------------------------------------------------------------------------- 1 | \name{sobol} 2 | \alias{sobol} 3 | \alias{tell.sobol} 4 | \alias{print.sobol} 5 | \alias{plot.sobol} 6 | \alias{plotMultOut.sobol} 7 | \alias{ggplot.sobol} 8 | 9 | \title{Monte Carlo Estimation of Sobol' Indices} 10 | 11 | \description{ \code{sobol} implements the Monte Carlo estimation of 12 | the Sobol' sensitivity indices (standard estimator). This method allows the estimation of 13 | the indices of the variance decomposition, sometimes referred to as 14 | functional ANOVA decomposition, up to a given order, at a total cost 15 | of \eqn{(N+1) \times n}{(N + 1) * n} where \eqn{N}{N} is the number 16 | of indices to estimate. This function allows also the estimation of 17 | the so-called subset (or group) indices, i.e. the first-order indices with respect to 18 | single multidimensional inputs.} 19 | 20 | \usage{ 21 | sobol(model = NULL, X1, X2, order = 1, nboot = 0, conf = 0.95, \dots) 22 | \method{tell}{sobol}(x, y = NULL, return.var = NULL, \dots) 23 | \method{print}{sobol}(x, \dots) 24 | \method{plot}{sobol}(x, ylim = c(0, 1), \dots) 25 | \method{plotMultOut}{sobol}(x, ylim = c(0, 1), \dots) 26 | \method{ggplot}{sobol}(data, mapping = aes(), ylim = c(0, 1), \dots, environment 27 | = parent.frame()) 28 | } 29 | 30 | \arguments{ 31 | \item{model}{a function, or a model with a \code{predict} method, 32 | defining the model to analyze.} 33 | \item{X1}{the first random sample.} 34 | \item{X2}{the second random sample.} 35 | \item{order}{either an integer, the maximum order in the ANOVA 36 | decomposition (all indices up to this order will be computed), or a 37 | list of numeric vectors, the multidimensional compounds 38 | of the wanted subset indices.} 39 | \item{nboot}{the number of bootstrap replicates.} 40 | \item{conf}{the confidence level for bootstrap confidence intervals.} 41 | \item{x}{a list of class \code{"sobol"} storing the state of the 42 | sensitivity study (parameters, data, estimates).} 43 | \item{data}{a list of class \code{"sobol"} storing the state of the 44 | sensitivity study (parameters, data, estimates).} 45 | \item{y}{a vector of model responses.} 46 | \item{return.var}{a vector of character strings giving further 47 | internal variables names to store in the output object \code{x}.} 48 | \item{ylim}{y-coordinate plotting limits.} 49 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 50 | must be supplied in each layer added to the plot.} 51 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 52 | \item{\dots}{any other arguments for \code{model} which are passed 53 | unchanged each time it is called.} 54 | } 55 | 56 | \value{ 57 | \code{sobol} returns a list of class \code{"sobol"}, containing all 58 | the input arguments detailed before, plus the following components: 59 | 60 | \item{call}{the matched call.} 61 | \item{X}{a \code{data.frame} containing the design of experiments.} 62 | \item{y}{a vector of model responses.} 63 | \item{V}{the estimations of Variances of the Conditional Expectations 64 | (VCE) with respect to one factor or one group of factors.} 65 | \item{D}{the estimations of the terms of the ANOVA decomposition (not 66 | for subset indices).} 67 | \item{S}{the estimations of the Sobol' sensitivity indices (not for 68 | subset indices).} 69 | 70 | Users can ask more ouput variables with the argument 71 | \code{return.var} (for example, bootstrap outputs \code{V.boot}, 72 | \code{D.boot} and \code{S.boot}). 73 | } 74 | 75 | \references{ 76 | I. M. Sobol, 1993, \emph{Sensitivity analysis for non-linear mathematical 77 | model}, Math. Modelling Comput. Exp., 1, 407--414. 78 | } 79 | 80 | \author{ 81 | Gilles Pujol 82 | } 83 | 84 | \seealso{ 85 | \code{\link{sobol2002}, \link{sobolSalt}, \link{sobol2007}, \link{soboljansen}, 86 | \link{sobolmartinez}},\code{\link{sobolEff}, \link{sobolSmthSpl}, \link{sobolmara}, 87 | \link{sobolroalhs}, \link{fast99}, \link{sobolGP}},\code{\link{sobolMultOut}} 88 | } 89 | 90 | \examples{ 91 | # Test case : the non-monotonic Sobol g-function 92 | 93 | # The method of sobol requires 2 samples 94 | # (there are 8 factors, all following the uniform distribution on [0,1]) 95 | library(boot) 96 | n <- 1000 97 | X1 <- data.frame(matrix(runif(8 * n), nrow = n)) 98 | X2 <- data.frame(matrix(runif(8 * n), nrow = n)) 99 | 100 | # sensitivity analysis 101 | x <- sobol(model = sobol.fun, X1 = X1, X2 = X2, order = 2, nboot = 100) 102 | print(x) 103 | #plot(x) 104 | 105 | library(ggplot2) 106 | ggplot(x) 107 | } 108 | 109 | \keyword{design} 110 | -------------------------------------------------------------------------------- /man/sobol2002.Rd: -------------------------------------------------------------------------------- 1 | \name{sobol2002} 2 | \alias{sobol2002} 3 | \alias{tell.sobol2002} 4 | \alias{print.sobol2002} 5 | \alias{plot.sobol2002} 6 | \alias{plotMultOut.sobol2002} 7 | \alias{ggplot.sobol2002} 8 | 9 | \title{Monte Carlo Estimation of Sobol' Indices (scheme by Saltelli 2002)} 10 | 11 | \description{ 12 | \code{sobol2002} implements the Monte Carlo estimation of 13 | the Sobol' indices for both first-order and total indices at the same 14 | time (alltogether \eqn{2p}{2p} indices), at a total cost of \eqn{(p+2) 15 | \times n}{(p + 2) * n} model evaluations. These are called the Saltelli estimators. 16 | } 17 | 18 | \usage{ 19 | sobol2002(model = NULL, X1, X2, nboot = 0, conf = 0.95, \dots) 20 | \method{tell}{sobol2002}(x, y = NULL, return.var = NULL, \dots) 21 | \method{print}{sobol2002}(x, \dots) 22 | \method{plot}{sobol2002}(x, ylim = c(0, 1), \dots) 23 | \method{plotMultOut}{sobol2002}(x, ylim = c(0, 1), \dots) 24 | \method{ggplot}{sobol2002}(data, mapping = aes(), ylim = c(0, 1), \dots, environment 25 | = parent.frame()) 26 | } 27 | 28 | \arguments{ 29 | \item{model}{a function, or a model with a \code{predict} method, 30 | defining the model to analyze.} 31 | \item{X1}{the first random sample.} 32 | \item{X2}{the second random sample.} 33 | \item{nboot}{the number of bootstrap replicates.} 34 | \item{conf}{the confidence level for bootstrap confidence intervals.} 35 | \item{x}{a list of class \code{"sobol2002"} storing the state of the 36 | sensitivity study (parameters, data, estimates).} 37 | \item{data}{a list of class \code{"sobol2002"} storing the state of the 38 | sensitivity study (parameters, data, estimates).} 39 | \item{y}{a vector of model responses.} 40 | \item{return.var}{a vector of character strings giving further 41 | internal variables names to store in the output object \code{x}.} 42 | \item{ylim}{y-coordinate plotting limits.} 43 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 44 | must be supplied in each layer added to the plot.} 45 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 46 | \item{\dots}{any other arguments for \code{model} which are passed 47 | unchanged each time it is called} 48 | } 49 | 50 | \value{ 51 | \code{sobol2002} returns a list of class \code{"sobol2002"}, containing all 52 | the input arguments detailed before, plus the following components: 53 | 54 | \item{call}{the matched call.} 55 | \item{X}{a \code{data.frame} containing the design of experiments.} 56 | \item{y}{the response used} 57 | \item{V}{the estimations of Variances of the Conditional Expectations 58 | (VCE) with respect to each factor and also with respect to the 59 | complementary set of each factor ("all but \eqn{X_i}{Xi}").} 60 | \item{S}{the estimations of the Sobol' first-order indices.} 61 | \item{T}{the estimations of the Sobol' total sensitivity indices.} 62 | 63 | Users can ask more ouput variables with the argument 64 | \code{return.var} (for example, bootstrap outputs \code{V.boot}, 65 | \code{S.boot} and \code{T.boot}). 66 | } 67 | 68 | \details{ 69 | BE CAREFUL! This estimator suffers from a conditioning problem when estimating 70 | the variances behind the indices computations. This can seriously affect the 71 | Sobol' indices estimates in case of largely non-centered output. To avoid this 72 | effect, you have to center the model output before applying \code{"sobol2002"}. 73 | Functions \code{"sobolEff"}, \code{"soboljansen"} and \code{"sobolmartinez"} 74 | do not suffer from this problem. 75 | } 76 | 77 | \references{ 78 | A. Saltelli, 2002, \emph{Making best use of model evaluations to compute 79 | sensitivity indices}, Computer Physics Communication, 145, 580--297. 80 | } 81 | 82 | \author{ 83 | Gilles Pujol 84 | } 85 | 86 | \seealso{ 87 | \code{\link{sobol}, \link{sobolSalt}, \link{sobol2007}, \link{soboljansen}, \link{sobolmartinez}, \link{sobolEff}, \link{sobolmara}, \link{sobolGP}, \link{sobolMultOut}} 88 | } 89 | 90 | \examples{ 91 | # Test case : the non-monotonic Sobol g-function 92 | 93 | # The method of sobol requires 2 samples 94 | # There are 8 factors, all following the uniform distribution 95 | # on [0,1] 96 | 97 | library(boot) 98 | n <- 1000 99 | X1 <- data.frame(matrix(runif(8 * n), nrow = n)) 100 | X2 <- data.frame(matrix(runif(8 * n), nrow = n)) 101 | 102 | # sensitivity analysis 103 | 104 | x <- sobol2002(model = sobol.fun, X1, X2, nboot = 100) 105 | print(x) 106 | plot(x) 107 | 108 | library(ggplot2) 109 | ggplot(x) 110 | } 111 | 112 | \keyword{design} 113 | -------------------------------------------------------------------------------- /man/sobolEff.Rd: -------------------------------------------------------------------------------- 1 | \name{sobolEff} 2 | \alias{sobolEff} 3 | \alias{tell.sobolEff} 4 | \alias{print.sobolEff} 5 | \alias{plot.sobolEff} 6 | \alias{ggplot.sobolEff} 7 | 8 | \title{Monte Carlo Estimation of Sobol' Indices (formulas of Janon-Monod)} 9 | 10 | \description{ \code{sobolEff} implements the Monte Carlo estimation of the Sobol' sensitivity indices using the asymptotically efficient formulas in section 4.2.4.2 of Monod et al. (2006). Either all first-order indices or all total-effect indices are estimated at a cost of \eqn{N \times (p+1)}{N*(p+1)} model calls or all closed second-order indices are estimated at a cost of \eqn{N \times p \choose 2)}{N*(p*(p-1)/2+1)} model calls.} 11 | 12 | \usage{ 13 | sobolEff(model = NULL, X1, X2, order=1, nboot = 0, conf = 0.95, \dots) 14 | \method{tell}{sobolEff}(x, y = NULL, \dots) 15 | \method{print}{sobolEff}(x, \dots) 16 | \method{plot}{sobolEff}(x, ylim = c(0, 1), \dots) 17 | \method{ggplot}{sobolEff}(data, mapping = aes(), ylim = c(0, 1), \dots, environment 18 | = parent.frame()) 19 | } 20 | 21 | \arguments{ 22 | \item{model}{a function, or a model with a \code{predict} method, 23 | defining the model to analyze.} 24 | \item{X1}{the first random sample.} 25 | \item{X2}{the second random sample.} 26 | \item{order}{an integer specifying the indices to estimate: 0 for total effect indices,1 for first-order indices and 2 for closed second-order indices.} 27 | \item{nboot}{the number of bootstrap replicates, or zero to use asymptotic 28 | standard deviation estimates given in Janon et al. (2012).} 29 | \item{conf}{the confidence level for confidence intervals.} 30 | \item{x}{a list of class \code{"sobolEff"} storing the state of the 31 | sensitivity study (parameters, data, estimates).} 32 | \item{data}{a list of class \code{"sobolEff"} storing the state of the 33 | sensitivity study (parameters, data, estimates).} 34 | \item{y}{a vector of model responses.} 35 | \item{ylim}{y-coordinate plotting limits.} 36 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 37 | must be supplied in each layer added to the plot.} 38 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 39 | \item{\dots}{any other arguments for \code{model} which are passed 40 | unchanged each time it is called.} 41 | } 42 | 43 | \value{ 44 | \code{sobolEff} returns a list of class \code{"sobolEff"}, containing all 45 | the input arguments detailed before, plus the following components: 46 | 47 | \item{call}{the matched call.} 48 | \item{X}{a \code{data.frame} containing the design of experiments.} 49 | \item{y}{a vector of model responses.} 50 | \item{S}{the estimations of the Sobol' sensitivity indices.} 51 | 52 | } 53 | 54 | \details{ 55 | The estimator used by sobolEff is defined in Monod et al. (2006), 56 | Section 4.2.4.2 and studied under the name T_N in Janon et al. (2012). 57 | This estimator is good for large first-order indices. 58 | } 59 | 60 | \references{ 61 | Monod, H., Naud, C., Makowski, D. (2006), Uncertainty and sensitivity 62 | analysis for crop models in Working with Dynamic Crop Models: Evaluation, 63 | Analysis, Parameterization, and Applications, Elsevier. 64 | 65 | A. Janon, T. Klein, A. Lagnoux, M. Nodet, C. Prieur (2014), \emph{Asymptotic normality and efficiency of two Sobol index estimators}, ESAIM: Probability and Statistics, 18:342-364. 66 | 67 | } 68 | 69 | \author{ 70 | Alexandre Janon, Laurent Gilquin 71 | } 72 | 73 | \seealso{ 74 | \code{\link{sobol}, \link{sobol2002}, \link{sobolSalt}, \link{sobol2007}, \link{soboljansen}, \link{sobolmartinez}, 75 | \link{sobolSmthSpl}} 76 | } 77 | 78 | \examples{ 79 | # Test case : the non-monotonic Sobol g-function 80 | 81 | # The method of sobol requires 2 samples 82 | # (there are 8 factors, all following the uniform distribution on [0,1]) 83 | n <- 1000 84 | X1 <- data.frame(matrix(runif(8 * n), nrow = n)) 85 | X2 <- data.frame(matrix(runif(8 * n), nrow = n)) 86 | 87 | # sensitivity analysis 88 | x <- sobolEff(model = sobol.fun, X1 = X1, X2 = X2, nboot = 0) 89 | print(x) 90 | 91 | library(ggplot2) 92 | ggplot(x) 93 | } 94 | 95 | \keyword{design} -------------------------------------------------------------------------------- /man/sobolSalt.Rd: -------------------------------------------------------------------------------- 1 | \name{sobolSalt} 2 | \alias{sobolSalt} 3 | \alias{tell.sobolSalt} 4 | \alias{print.sobolSalt} 5 | \alias{plot.sobolSalt} 6 | \alias{ggplot.sobolSalt} 7 | 8 | \title{Monte Carlo Estimation of Sobol' Indices based on Saltelli schemes} 9 | 10 | \description{ 11 | \code{sobolSalt} implements the Monte Carlo estimation of 12 | the Sobol' indices for either both first-order and total effect indices at the same 13 | time (alltogether \eqn{2p}{2p} indices) at a total cost of \eqn{n\times(p+2)}{n*(p + 2)} model evaluations; or first-order, second-order and total indices at the same time (alltogether \eqn{2p+ p\times(p-1)/2}{2p+ p*(p-1)/2} indices) at a total cost of \eqn{n\times(2\times p+2)}{n*(2*p + 2)} model evaluations. 14 | } 15 | 16 | \usage{ 17 | sobolSalt(model = NULL, X1, X2, scheme="A", nboot = 0, conf = 0.95, \dots) 18 | \method{tell}{sobolSalt}(x, y = NULL, \dots) 19 | \method{print}{sobolSalt}(x, \dots) 20 | \method{plot}{sobolSalt}(x, ylim = c(0, 1), choice, \dots) 21 | \method{ggplot}{sobolSalt}(data, mapping = aes(), ylim = c(0, 1), choice, \dots, environment 22 | = parent.frame()) 23 | } 24 | 25 | \arguments{ 26 | \item{model}{a function, or a model with a \code{predict} method, 27 | defining the model to analyze.} 28 | \item{X1}{the first random sample (containing \code{n} points).} 29 | \item{X2}{the second random sample (containing \code{n} points).} 30 | \item{scheme}{a letter \code{"A"} or \code{"B"} indicating which scheme to use (see "Details")} 31 | \item{nboot}{the number of bootstrap replicates.} 32 | \item{conf}{the confidence level for bootstrap confidence intervals.} 33 | \item{x}{a list of class \code{"sobolSalt"} storing the state of the 34 | sensitivity study (parameters, data, estimates).} 35 | \item{data}{a list of class \code{"sobolSalt"} storing the state of the 36 | sensitivity study (parameters, data, estimates).} 37 | \item{y}{a vector of model responses.} 38 | \item{ylim}{y-coordinate plotting limits.} 39 | \item{choice}{an integer specifying which indices to plot: \code{1} for first-order and total effect indices, \code{2} for second-order indices.} 40 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 41 | must be supplied in each layer added to the plot.} 42 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 43 | \item{\dots}{any other arguments for \code{model} which are passed 44 | unchanged each time it is called} 45 | } 46 | 47 | \value{ 48 | \code{sobolSalt} returns a list of class \code{"sobolSalt"}, containing all 49 | the input arguments detailed before, plus the following components: 50 | 51 | \item{call}{the matched call.} 52 | \item{X}{a \code{data.frame} containing the design of experiments.} 53 | \item{y}{the response used.} 54 | \item{V}{the model variance.} 55 | \item{S}{the estimations of the Sobol' first-order indices.} 56 | \item{S2}{the estimations of the Sobol' second-order indices (only for scheme \code{"B"}).} 57 | \item{T}{the estimations of the Sobol' total sensitivity indices.} 58 | } 59 | 60 | \details{ 61 | The estimators used are the one implemented in \code{"sobolEff"}. 62 | 63 | \code{scheme} specifies which Saltelli's scheme is to be used: \code{"A"} to estimate both first-order and total effect indices, \code{"B"} to estimate first-order, second-order and total effect indices. 64 | } 65 | 66 | \references{ 67 | A. Janon, T. Klein, A. Lagnoux, M. Nodet, C. Prieur (2014), \emph{Asymptotic normality and efficiency of two Sobol index estimators}, ESAIM: Probability and Statistics, 18:342-364. 68 | 69 | A. Saltelli, 2002, \emph{Making best use of model evaluations to compute 70 | sensitivity indices}, Computer Physics Communication, 145:580-297. 71 | } 72 | 73 | \author{ 74 | Laurent Gilquin 75 | } 76 | 77 | \seealso{ 78 | \code{\link{sobol}, \link{sobol2007}, \link{soboljansen}, \link{sobolmartinez}, \link{sobolEff}} 79 | } 80 | 81 | \examples{ 82 | # Test case : the non-monotonic Sobol g-function 83 | 84 | # The method of sobol requires 2 samples 85 | # There are 8 factors, all following the uniform distribution 86 | # on [0,1] 87 | 88 | library(boot) 89 | n <- 1000 90 | X1 <- data.frame(matrix(runif(8 * n), nrow = n)) 91 | X2 <- data.frame(matrix(runif(8 * n), nrow = n)) 92 | 93 | # sensitivity analysis 94 | 95 | x <- sobolSalt(model = sobol.fun, X1, X2, scheme="A", nboot = 100) 96 | print(x) 97 | plot(x, choice=1) 98 | 99 | library(ggplot2) 100 | ggplot(x, choice=1) 101 | } 102 | 103 | \keyword{design} 104 | -------------------------------------------------------------------------------- /man/sobolSmthSpl.Rd: -------------------------------------------------------------------------------- 1 | %Documentation for sobolSmthSpl. 2 | \name{sobolSmthSpl} 3 | \alias{sobolSmthSpl} 4 | \title{Estimation of Sobol' First Order Indices with B-spline Smoothing} 5 | \description{ 6 | Determines the Si coefficient for singular parameters through B-spline smoothing with roughness penalty. 7 | } 8 | \usage{ 9 | sobolSmthSpl(Y, X) 10 | } 11 | \arguments{ 12 | \item{Y}{vector of model responses.} 13 | \item{X}{matrix having as rows the input vectors corresponding to the responses in Y.} 14 | } 15 | \value{ 16 | sobolSmthSpl returns a list of class "sobolSmthSpl" containing the following components: 17 | \item{call}{the matched call.} 18 | \item{X}{the provided input matrix.} 19 | \item{Y}{the provided matrix of model responses.} 20 | \item{S}{a matrix having the following columns: 21 | Si (the estimated first order Sobol' indices), 22 | Si.e (the standard errors for the estimated first order Sobol' indices) and 23 | q0.05 (the 0.05 quantiles assuming for the Si indices Normal distributions centred on the 24 | Si estimates and with standard deviations the calculated standard errors) 25 | } 26 | } 27 | \details{ 28 | WARNING: This function can give bad results for reasons that have not been yet investigated. 29 | } 30 | \author{ 31 | Filippo Monari 32 | } 33 | \references{ 34 | Saltelli, A; Ratto, M; Andres, T; Campolongo, F; Cariboni, J; Gatelli, D; Saisana, M & Tarantola, S. 35 | \emph{Global Sensitivity Analysis: The Primer Wiley-Interscience}, 2008 36 | 37 | M Ratto and A. Pagano, 2010, \emph{Using recursive algorithms for the efficient identification 38 | of smoothing spline ANOVA models}, Advances in Statistical Analysis, 94, 367--388. 39 | 40 | } 41 | \seealso{ 42 | \code{\link{sobol}, \link{sobolEff}, \link{sobolGP}} 43 | } 44 | 45 | \examples{ 46 | X = matrix(runif(5000), ncol = 10) 47 | Y = sobol.fun(X) 48 | sa = sobolSmthSpl(Y, X) 49 | plot(sa) 50 | } 51 | -------------------------------------------------------------------------------- /man/sobolTIIlo.Rd: -------------------------------------------------------------------------------- 1 | \name{sobolTIIlo} 2 | \alias{sobolTIIlo} 3 | \alias{tell.sobolTIIlo} 4 | \alias{print.sobolTIIlo} 5 | \alias{plot.sobolTIIlo} 6 | \alias{ggplot.sobolTIIlo} 7 | \alias{plotFG.sobolTIIlo} 8 | 9 | \title{Liu and Owen Estimation of Total Interaction Indices} 10 | 11 | \description{\code{sobolTIIlo} implements the asymptotically efficient formula of Liu and Owen (2006) for the estimation of total interaction indices as described e.g. in Section 3.4 of Fruth et al. (2014). Total interaction indices (TII) are superset indices of pairs of variables, thus give the total influence of each second-order interaction. The total cost of the method is \eqn{(1+N+\choose(N,2)) \times n} where \eqn{N}{N} is the number 12 | of indices to estimate. Asymptotic confidence intervals are provided. Via \code{plotFG} (which uses functions of the package \code{igraph}), the TIIs can be visualized in a so-called FANOVA graph as described in section 2.2 of Muehlenstaedt et al. (2012).} 13 | 14 | \usage{ 15 | sobolTIIlo(model = NULL, X1, X2, conf = 0.95, \dots) 16 | \method{tell}{sobolTIIlo}(x, y = NULL, \dots) 17 | \method{print}{sobolTIIlo}(x, \dots) 18 | \method{plot}{sobolTIIlo}(x, ylim = NULL, \dots) 19 | \method{ggplot}{sobolTIIlo}(data, mapping = aes(), ylim = NULL, \dots, environment 20 | = parent.frame()) 21 | \method{plotFG}{sobolTIIlo}(x) 22 | } 23 | 24 | \arguments{ 25 | \item{model}{a function, or a model with a \code{predict} method, 26 | defining the model to analyze.} 27 | \item{X1}{the first random sample.} 28 | \item{X2}{the second random sample.} 29 | \item{conf}{the confidence level for asymptotic confidence intervals, defaults to 0.95.} 30 | \item{x}{a list of class \code{"sobolTIIlo"} storing the state of the 31 | sensitivity study (parameters, data, estimates).} 32 | \item{data}{a list of class \code{"sobolTIIlo"} storing the state of the 33 | sensitivity study (parameters, data, estimates).} 34 | \item{y}{a vector of model responses.} 35 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 36 | must be supplied in each layer added to the plot.} 37 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 38 | \item{\dots}{any other arguments for \code{model} which are passed 39 | unchanged each time it is called.} 40 | \item{ylim}{optional, the y limits of the plot.} 41 | } 42 | 43 | \value{ 44 | \code{sobolTIIlo} returns a list of class \code{"sobolTIIlo"}, containing all 45 | the input arguments detailed before, plus the following components: 46 | 47 | \item{call}{the matched call.} 48 | \item{X}{a \code{data.frame} containing the design of experiments.} 49 | \item{y}{a vector of model responses.} 50 | \item{V}{the estimation of the overall variance.} 51 | \item{tii.unscaled}{the unscaled estimations of the TIIs.} 52 | \item{tii.scaled}{the scaled estimations of the TIIs together with asymptotic confidence intervals.} 53 | } 54 | 55 | \references{ 56 | R. Liu, A. B. Owen, 2006, \emph{Estimating mean dimensionality of analysis of variance decompositions}, JASA, 101 (474), 712--721. 57 | 58 | J. Fruth, O. Roustant, S. Kuhnt, 2014, \emph{Total interaction index: A variance-based sensitivity index for second-order interaction screening}, J. Stat. Plan. Inference, 147, 212--223. 59 | 60 | T. Muehlenstaedt, O. Roustant, L. Carraro, S. Kuhnt, 2012, \emph{Data-driven Kriging models based on FANOVA-decomposition}, Stat. Comput., 22 (3), 723--738. 61 | } 62 | 63 | \author{ 64 | Jana Fruth 65 | } 66 | 67 | \seealso{ 68 | \code{\link{sobolTIIpf}} 69 | } 70 | 71 | \examples{ 72 | # Test case : the Ishigami function 73 | 74 | # The method requires 2 samples 75 | n <- 1000 76 | X1 <- data.frame(matrix(runif(3 * n, -pi, pi), nrow = n)) 77 | X2 <- data.frame(matrix(runif(3 * n, -pi, pi), nrow = n)) 78 | 79 | # sensitivity analysis (the true values of the scaled TIIs are 0, 0.244, 0) 80 | x <- sobolTIIlo(model = ishigami.fun, X1 = X1, X2 = X2) 81 | print(x) 82 | 83 | # plot of tiis and FANOVA graph 84 | plot(x) 85 | 86 | library(ggplot2) 87 | ggplot(x) 88 | 89 | \donttest{ 90 | library(igraph) 91 | plotFG(x) 92 | } 93 | 94 | 95 | } 96 | 97 | \keyword{design} 98 | -------------------------------------------------------------------------------- /man/sobolTIIpf.Rd: -------------------------------------------------------------------------------- 1 | \name{sobolTIIpf} 2 | \alias{sobolTIIpf} 3 | \alias{tell.sobolTIIpf} 4 | \alias{print.sobolTIIpf} 5 | \alias{plot.sobolTIIpf} 6 | \alias{ggplot.sobolTIIpf} 7 | \alias{plotFG.sobolTIIpf} 8 | \alias{plotFG} 9 | 10 | \title{Pick-freeze Estimation of Total Interaction Indices} 11 | 12 | \description{\code{sobolTIIpf} implements the pick-freeze estimation of total interaction indices as described in Section 3.3 of Fruth et al. (2014). Total interaction indices (TII) are superset indices of pairs of variables, thus give the total influence of each second-order interaction. The pick-freeze estimation enables the strategy to reuse evaluations of Saltelli (2002). The total costs are \eqn{(1+N) \times n} where \eqn{N}{N} is the number of indices to estimate. Via \code{plotFG}, the TIIs can be visualized in a so-called FANOVA graph as described in section 2.2 of Muehlenstaedt et al. (2012).} 13 | 14 | \usage{ 15 | sobolTIIpf(model = NULL, X1, X2, \dots) 16 | \method{tell}{sobolTIIpf}(x, y = NULL, \dots) 17 | \method{print}{sobolTIIpf}(x, \dots) 18 | \method{plot}{sobolTIIpf}(x, ylim = NULL, \dots) 19 | \method{ggplot}{sobolTIIpf}(data, mapping = aes(), ylim = NULL, \dots, environment 20 | = parent.frame()) 21 | \method{plotFG}{sobolTIIpf}(x) 22 | } 23 | 24 | \arguments{ 25 | \item{model}{a function, or a model with a \code{predict} method, 26 | defining the model to analyze.} 27 | \item{X1}{the first random sample.} 28 | \item{X2}{the second random sample.} 29 | \item{x}{a list of class \code{"sobolTIIpf"} storing the state of the 30 | sensitivity study (parameters, data, estimates).} 31 | \item{data}{a list of class \code{"sobolTIIpf"} storing the state of the 32 | sensitivity study (parameters, data, estimates).} 33 | \item{y}{a vector of model responses.} 34 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 35 | must be supplied in each layer added to the plot.} 36 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 37 | \item{\dots}{any other arguments for \code{model} which are passed 38 | unchanged each time it is called.} 39 | \item{ylim}{optional, the y limits of the plot.} 40 | } 41 | 42 | \value{ 43 | \code{sobolTIIpf} returns a list of class \code{"sobolTIIpf"}, containing all 44 | the input arguments detailed before, plus the following components: 45 | 46 | \item{call}{the matched call.} 47 | \item{X}{a \code{data.frame} containing the design of experiments.} 48 | \item{y}{a vector of model responses.} 49 | \item{V}{the estimation of the overall variance.} 50 | \item{tii.unscaled}{the unscaled estimations of the TIIs together.} 51 | \item{tii.scaled}{the scaled estimations of the TIIs.} 52 | } 53 | 54 | \references{ 55 | J. Fruth, O. Roustant, S. Kuhnt, 2014, \emph{Total interaction index: A variance-based sensitivity index for second-order interaction screening}, J. Stat. Plan. Inference, 147, 212--223. 56 | 57 | A. Saltelli, 2002, \emph{Making best use of model evaluations to compute sensitivity indices}, Comput. Phys. Commun., 145, 580-297. 58 | 59 | T. Muehlenstaedt, O. Roustant, L. Carraro, S. Kuhnt, 2012, \emph{Data-driven Kriging models based on FANOVA-decomposition}, Stat. Comput., 22 (3), 723--738. 60 | } 61 | 62 | \author{ 63 | Jana Fruth 64 | } 65 | 66 | \seealso{ 67 | \code{\link{sobolTIIlo}} 68 | } 69 | 70 | \examples{ 71 | # Test case : the Ishigami function 72 | 73 | # The method requires 2 samples 74 | n <- 1000 75 | X1 <- data.frame(matrix(runif(3 * n, -pi, pi), nrow = n)) 76 | X2 <- data.frame(matrix(runif(3 * n, -pi, pi), nrow = n)) 77 | 78 | # sensitivity analysis (the true values are 0, 0.244, 0) 79 | x <- sobolTIIpf(model = ishigami.fun, X1 = X1, X2 = X2) 80 | print(x) 81 | 82 | # plot of tiis and FANOVA graph 83 | plot(x) 84 | 85 | library(ggplot2) 86 | ggplot(x) 87 | 88 | \donttest{ 89 | library(igraph) 90 | plotFG(x) 91 | } 92 | } 93 | 94 | \keyword{design} 95 | -------------------------------------------------------------------------------- /man/sobolmara.Rd: -------------------------------------------------------------------------------- 1 | \name{sobolmara} 2 | \alias{sobolmara} 3 | \alias{tell.sobolmara} 4 | \alias{print.sobolmara} 5 | \alias{plot.sobolmara} 6 | \alias{plotMultOut.sobolmara} 7 | \alias{ggplot.sobolmara} 8 | 9 | \title{Monte Carlo Estimation of Sobol' Indices via matrix permutations} 10 | 11 | \description{ \code{sobolmara} implements the Monte Carlo estimation of 12 | the first-order Sobol' sensitivity indices using the formula of Mara and Joseph (2008), called the 13 | Mara estimator. 14 | This method allows the estimation of all first-order p indices at a cost of 15 | 2N model calls (the random sample size), then independently of p (the number of inputs). } 16 | 17 | \usage{ 18 | sobolmara(model = NULL, X1, \dots) 19 | \method{tell}{sobolmara}(x, y = NULL, return.var = NULL, \dots) 20 | \method{print}{sobolmara}(x, \dots) 21 | \method{plot}{sobolmara}(x, ylim = c(0, 1), \dots) 22 | \method{plotMultOut}{sobolmara}(x, ylim = c(0, 1), \dots) 23 | \method{ggplot}{sobolmara}(data, mapping = aes(), ylim = c(0, 1), \dots, environment 24 | = parent.frame()) 25 | } 26 | 27 | \arguments{ 28 | \item{model}{a function, or a model with a \code{predict} method, 29 | defining the model to analyze.} 30 | \item{X1}{the random sample.} 31 | \item{x}{a list of class \code{"sobolmara"} storing the state of the 32 | sensitivity study (parameters, data, estimates).} 33 | \item{data}{a list of class \code{"sobolmara"} storing the state of the 34 | sensitivity study (parameters, data, estimates).} 35 | \item{y}{a vector of model responses.} 36 | \item{return.var}{a vector of character strings giving further 37 | internal variables names to store in the output object \code{x}.} 38 | \item{ylim}{y-coordinate plotting limits.} 39 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 40 | must be supplied in each layer added to the plot.} 41 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 42 | \item{\dots}{any other arguments for \code{model} which are passed 43 | unchanged each time it is called.} 44 | } 45 | 46 | \value{ 47 | \code{sobolmara} returns a list of class \code{"sobolmara"}, containing all 48 | the input arguments detailed before, plus the following components: 49 | 50 | \item{call}{the matched call.} 51 | \item{X}{a \code{data.frame} containing the design of experiments.} 52 | \item{y}{a vector of model responses.} 53 | \item{S}{the estimations of the Sobol' sensitivity indices.} 54 | 55 | } 56 | 57 | \details{ 58 | The estimator used by sobolmara is based on rearragement of a unique matrix via random permutations (see Mara and Joseph, 2008). Bootstrap confidence intervals are not available. 59 | } 60 | 61 | \references{ 62 | Mara, T. and Joseph, O.R. (2008), \emph{Comparison of some efficient methods to evaluate the main effect of computer model factors}, Journal of Statistical Computation and Simulation, 78:167--178 63 | } 64 | 65 | \author{ 66 | Bertrand Iooss 67 | } 68 | 69 | \seealso{ 70 | \code{\link{sobolroalhs}, \link{sobol}, \link{sobolMultOut}} 71 | } 72 | 73 | \examples{ 74 | # Test case : the non-monotonic Sobol g-function 75 | 76 | # The method of sobolmara requires 1 sample 77 | # (there are 8 factors, all following the uniform distribution on [0,1]) 78 | n <- 1000 79 | X1 <- data.frame(matrix(runif(8 * n), nrow = n)) 80 | 81 | # sensitivity analysis 82 | x <- sobolmara(model = sobol.fun, X1 = X1) 83 | print(x) 84 | plot(x) 85 | 86 | library(ggplot2) 87 | ggplot(x) 88 | } 89 | 90 | \keyword{design} 91 | -------------------------------------------------------------------------------- /man/sobolowen.Rd: -------------------------------------------------------------------------------- 1 | \name{sobolowen} 2 | \alias{sobolowen} 3 | \alias{tell.sobolowen} 4 | \alias{print.sobolowen} 5 | \alias{plot.sobolowen} 6 | \alias{ggplot.sobolowen} 7 | 8 | \title{Monte Carlo Estimation of Sobol' Indices (improved formulas of Owen (2013)} 9 | 10 | \description{ 11 | \code{sobolowen} implements the Monte Carlo estimation of 12 | the Sobol' indices for both first-order and total indices at the same 13 | time (alltogether \eqn{2p}{2p} indices). Take as input 3 independent matrices. 14 | These are called the Owen estimators. 15 | } 16 | 17 | \usage{ 18 | sobolowen(model = NULL, X1, X2, X3, nboot = 0, conf = 0.95, varest = 2, \dots) 19 | \method{tell}{sobolowen}(x, y = NULL, return.var = NULL, varest = 2, \dots) 20 | \method{print}{sobolowen}(x, \dots) 21 | \method{plot}{sobolowen}(x, ylim = c(0, 1), \dots) 22 | \method{ggplot}{sobolowen}(data, mapping = aes(), ylim = c(0, 1), \dots, environment 23 | = parent.frame()) 24 | } 25 | 26 | \arguments{ 27 | \item{model}{a function, or a model with a \code{predict} method, 28 | defining the model to analyze.} 29 | \item{X1}{the first random sample.} 30 | \item{X2}{the second random sample.} 31 | \item{X3}{the third random sample.} 32 | \item{nboot}{the number of bootstrap replicates.} 33 | \item{conf}{the confidence level for bootstrap confidence intervals.} 34 | \item{varest}{choice for the variance estimator for the denominator of 35 | the Sobol' indices. varest=1 is for a classical estimator. 36 | varest=2 (default) is for the estimator proposed in Janon et al. (2012).} 37 | \item{x}{a list of class \code{"sobolowen"} storing the state of the 38 | sensitivity study (parameters, data, estimates).} 39 | \item{data}{a list of class \code{"sobolowen"} storing the state of the 40 | sensitivity study (parameters, data, estimates).} 41 | \item{y}{a vector of model responses.} 42 | \item{return.var}{a vector of character strings giving further 43 | internal variables names to store in the output object \code{x}.} 44 | \item{ylim}{y-coordinate plotting limits.} 45 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 46 | must be supplied in each layer added to the plot.} 47 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 48 | \item{\dots}{any other arguments for \code{model} which are passed 49 | unchanged each time it is called} 50 | } 51 | 52 | \value{ 53 | \code{sobolowen} returns a list of class \code{"sobolowen"}, containing all 54 | the input arguments detailed before, plus the following components: 55 | 56 | \item{call}{the matched call.} 57 | \item{X}{a \code{data.frame} containing the design of experiments.} 58 | \item{y}{the response used} 59 | \item{V}{the estimations of Variances of the Conditional Expectations 60 | (VCE) with respect to each factor and also with respect to the 61 | complementary set of each factor ("all but \eqn{X_i}{Xi}").} 62 | \item{S}{the estimations of the Sobol' first-order indices.} 63 | \item{T}{the estimations of the Sobol' total sensitivity indices.} 64 | 65 | Users can ask more ouput variables with the argument 66 | \code{return.var} (for example, bootstrap outputs \code{V.boot}, 67 | \code{S.boot} and \code{T.boot}). 68 | } 69 | 70 | \references{ 71 | A. Owen, 2013, \emph{Better estimations of small Sobol' sensitivity indices}, 72 | ACM Transactions on Modeling and Computer Simulations (TOMACS), 23(2), 11. 73 | 74 | Janon, A., Klein T., Lagnoux A., Nodet M., Prieur C. (2012), Asymptotic 75 | normality and efficiency of two Sobol index estimators. Accepted in 76 | ESAIM: Probability and Statistics. 77 | } 78 | 79 | \author{ 80 | Taieb Touati and Bernardo Ramos 81 | } 82 | 83 | \seealso{ 84 | \code{\link{sobol}, \link{sobol2002}, \link{sobolSalt}, \link{sobol2007}, \link{soboljansen}, \link{sobolmartinez}, \link{sobolEff}} 85 | } 86 | 87 | \examples{ 88 | # Test case : the non-monotonic Sobol g-function 89 | 90 | # The method of sobolowen requires 3 samples 91 | # There are 8 factors, all following the uniform distribution 92 | # on [0,1] 93 | 94 | library(boot) 95 | n <- 1000 96 | X1 <- data.frame(matrix(runif(8 * n), nrow = n)) 97 | X2 <- data.frame(matrix(runif(8 * n), nrow = n)) 98 | X3 <- data.frame(matrix(runif(8 * n), nrow = n)) 99 | 100 | # sensitivity analysis 101 | 102 | \donttest{ 103 | x <- sobolowen(model = sobol.fun, X1, X2, X3, nboot = 10) # put nboot=100 104 | print(x) 105 | plot(x) 106 | 107 | library(ggplot2) 108 | ggplot(x) 109 | } 110 | } 111 | 112 | \keyword{design} 113 | -------------------------------------------------------------------------------- /man/sobolrank.Rd: -------------------------------------------------------------------------------- 1 | \name{sobolrank} 2 | \alias{sobolrank} 3 | \alias{tell.sobolrank} 4 | \alias{print.sobolrank} 5 | \alias{plot.sobolrank} 6 | \alias{ggplot.sobolrank} 7 | 8 | \title{First-order sensitivity indices estimation via ranking} 9 | 10 | \description{ \code{sobolrank} implements the estimation of all first-order indices using only N model evaluations 11 | via ranking following Gamboa et al. (2020) and inspired by Chatterjee (2019). 12 | } 13 | 14 | \usage{ 15 | sobolrank(model = NULL, X, nboot = 0, conf = 0.95, nsample = round(0.8*nrow(X)), 16 | \dots) 17 | \method{tell}{sobolrank}(x, y = NULL, \dots) 18 | \method{print}{sobolrank}(x, \dots) 19 | \method{plot}{sobolrank}(x, ylim = c(0, 1), \dots) 20 | \method{ggplot}{sobolrank}(data, mapping = aes(), \dots, environment 21 | = parent.frame(), ylim = c(0, 1)) 22 | } 23 | 24 | \arguments{ 25 | \item{model}{a function, or a model with a \code{predict} method, 26 | defining the model to analyze.} 27 | \item{X}{a random sample of the inputs.} 28 | \item{nboot}{the number of bootstrap replicates, see details.} 29 | \item{conf}{the confidence level for confidence intervals, see details.} 30 | \item{nsample}{the size of the bootstrap sample, see details.} 31 | \item{x}{a list of class \code{"sobolrank"} storing the state of the 32 | sensitivity study (parameters, data, estimates).} 33 | \item{data}{a list of class \code{"sobolrank"} storing the state of the 34 | sensitivity study (parameters, data, estimates).} 35 | \item{y}{a vector of model responses.} 36 | \item{ylim}{y-coordinate plotting limits.} 37 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 38 | must be supplied in each layer added to the plot.} 39 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 40 | \item{\dots}{any other arguments for \code{model} which are passed 41 | unchanged each time it is called.} 42 | } 43 | 44 | \value{ 45 | \code{sobolrank} returns a list of class \code{"sobolrank"}, containing all 46 | the input arguments detailed before, plus the following components: 47 | 48 | \item{call}{the matched call.} 49 | \item{X}{a \code{data.frame} containing the design of experiments.} 50 | \item{y}{a vector of model responses.} 51 | \item{S}{the estimations of the Sobol' sensitivity indices.} 52 | } 53 | \details{ 54 | The estimator used by sobolrank is defined in Gamboa et al. (2020). 55 | It is based on ranking the inputs as was first proposed by Chatterjee (2019) for a Cramer-Von Mises based estimator. 56 | All first-order indices can be estimated with a single sample of size N. 57 | Since boostrap creates ties which are not accounted for in the algorithm, confidence intervals are obtained by 58 | sampling without replacement with a sample size \code{nsample}. 59 | } 60 | 61 | \references{ 62 | Gamboa, F., Gremaud, P., Klein, T., & Lagnoux, A., 2022, \emph{Global Sensitivity Analysis: 63 | a novel generation of mighty estimators based on rank statistics}, 64 | Bernoulli 28: 2345-2374. 65 | 66 | Chatterjee, S., 2021, \emph{A new coefficient of correlation}, Journal of the American 67 | Statistical Association, 116:2009-2022. 68 | } 69 | 70 | \author{ 71 | Sebastien Da Veiga 72 | } 73 | 74 | \seealso{ 75 | \code{\link{sobol}, \link{sobol2002}, \link{sobolSalt}, \link{sobol2007}, \link{soboljansen}, \link{sobolmartinez}, 76 | \link{sobolSmthSpl}, \link{sobolEff}, \link{sobolshap_knn}} 77 | } 78 | \examples{ 79 | # Test case : the non-monotonic Sobol g-function 80 | # Example with a call to a numerical model 81 | library(boot) 82 | n <- 1000 83 | X <- data.frame(matrix(runif(8 * n), nrow = n)) 84 | x <- sobolrank(model = sobol.fun, X = X, nboot = 100) 85 | print(x) 86 | library(ggplot2) 87 | ggplot(x) 88 | # Test case : the Ishigami function 89 | # Example with given data 90 | n <- 500 91 | X <- data.frame(matrix(-pi+2*pi*runif(3 * n), nrow = n)) 92 | Y <- ishigami.fun(X) 93 | x <- sobolrank(model = NULL, X) 94 | tell(x,Y) 95 | print(x) 96 | ggplot(x) 97 | } -------------------------------------------------------------------------------- /man/soboltouati.Rd: -------------------------------------------------------------------------------- 1 | \name{soboltouati} 2 | \alias{soboltouati} 3 | \alias{tell.soboltouati} 4 | \alias{print.soboltouati} 5 | \alias{plot.soboltouati} 6 | \alias{ggplot.soboltouati} 7 | 8 | \title{Monte Carlo Estimation of Sobol' Indices (formulas of Martinez (2011) and Touati (2016))} 9 | 10 | \description{ 11 | \code{soboltouati} implements the Monte Carlo estimation of 12 | the Sobol' indices for both first-order and total indices using 13 | correlation coefficients-based formulas, at a total cost of 14 | \eqn{(p+2) \times n}{(p + 2) * n} model evaluations. 15 | These are called the Martinez estimators. It also computes their 16 | confidence intervals based on asymptotic properties of empirical 17 | correlation coefficients. 18 | } 19 | 20 | \usage{ 21 | soboltouati(model = NULL, X1, X2, conf = 0.95, \dots) 22 | \method{tell}{soboltouati}(x, y = NULL, return.var = NULL, \dots) 23 | \method{print}{soboltouati}(x, \dots) 24 | \method{plot}{soboltouati}(x, ylim = c(0, 1), \dots) 25 | \method{ggplot}{soboltouati}(data, mapping = aes(), ylim = c(0, 1), \dots, environment 26 | = parent.frame()) 27 | } 28 | 29 | \arguments{ 30 | \item{model}{a function, or a model with a \code{predict} method, 31 | defining the model to analyze.} 32 | \item{X1}{the first random sample.} 33 | \item{X2}{the second random sample.} 34 | \item{conf}{the confidence level for confidence intervals, or zero to 35 | avoid their computation if they are not needed.} 36 | \item{x}{a list of class \code{"soboltouati"} storing the state of the 37 | sensitivity study (parameters, data, estimates).} 38 | \item{data}{a list of class \code{"soboltouati"} storing the state of the 39 | sensitivity study (parameters, data, estimates).} 40 | \item{y}{a vector of model responses.} 41 | \item{return.var}{a vector of character strings giving further 42 | internal variables names to store in the output object \code{x}.} 43 | \item{ylim}{y-coordinate plotting limits.} 44 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 45 | must be supplied in each layer added to the plot.} 46 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 47 | \item{\dots}{any other arguments for \code{model} which are passed 48 | unchanged each time it is called} 49 | } 50 | 51 | \value{ 52 | \code{soboltouati} returns a list of class \code{"soboltouati"}, 53 | containing all the input arguments detailed before, plus the following 54 | components: 55 | 56 | \item{call}{the matched call.} 57 | \item{X}{a \code{data.frame} containing the design of experiments.} 58 | \item{y}{the response used} 59 | \item{V}{the estimations of normalized variances of the Conditional 60 | Expectations (VCE) with respect to each factor and also with respect 61 | to the complementary set of each factor ("all but \eqn{X_i}{Xi}").} 62 | \item{S}{the estimations of the Sobol' first-order indices.} 63 | \item{T}{the estimations of the Sobol' total sensitivity indices.} 64 | 65 | } 66 | 67 | \details{ 68 | This estimator supports missing values (NA or NaN) which can occur during the 69 | simulation of the model on the design of experiments (due to code failure) 70 | even if Sobol' indices are no more rigorous variance-based sensitivity 71 | indices if missing values are present. In this case, a warning is displayed. 72 | } 73 | 74 | \references{ 75 | J-M. Martinez, 2011, \emph{Analyse de sensibilite globale par decomposition 76 | de la variance}, Presentation in the meeting of GdR Ondes and GdR MASCOT-NUM, 77 | January, 13th, 2011, Institut Henri Poincare, Paris, France. 78 | 79 | T. Touati, 2016, Confidence intervals for Sobol' indices. 80 | Proceedings of the SAMO 2016 Conference, Reunion Island, France, December 2016. 81 | 82 | T. Touati, 2017, \emph{Intervalles de confiance pour les indices de Sobol}, 83 | 49emes Journees de la SFdS, Avignon, France, Juin 2017. 84 | } 85 | 86 | \author{ 87 | Taieb Touati, Khalid Boumhaout 88 | } 89 | 90 | \seealso{ 91 | \code{\link{sobol}, \link{sobol2002}, \link{sobolSalt}, \link{sobol2007}, \link{soboljansen}, \link{sobolmartinez}} 92 | } 93 | 94 | \examples{ 95 | # Test case : the non-monotonic Sobol g-function 96 | 97 | # The method of sobol requires 2 samples 98 | # There are 8 factors, all following the uniform distribution 99 | # on [0,1] 100 | 101 | library(boot) 102 | n <- 1000 103 | X1 <- data.frame(matrix(runif(8 * n), nrow = n)) 104 | X2 <- data.frame(matrix(runif(8 * n), nrow = n)) 105 | 106 | # sensitivity analysis 107 | 108 | x <- soboltouati(model = sobol.fun, X1, X2) 109 | print(x) 110 | plot(x) 111 | 112 | library(ggplot2) 113 | ggplot(x) 114 | } 115 | 116 | \keyword{design} 117 | -------------------------------------------------------------------------------- /man/squaredIntEstim.Rd: -------------------------------------------------------------------------------- 1 | \name{squaredIntEstim} 2 | \alias{squaredIntEstim} 3 | 4 | \title{ 5 | Squared integral estimate 6 | } 7 | \description{ 8 | This function provides two estimators of a squared expectation. 9 | The first one, naive, is the square of the sample mean. It is positively biased. 10 | The second one is a U-statistics, and unbiased. The two are equivalent for large sample sizes. 11 | } 12 | \usage{ 13 | squaredIntEstim(x, method = "unbiased") 14 | } 15 | \arguments{ 16 | \item{x}{A vector of observations supposed to be drawn independently from a square integrable random variable} 17 | \item{method}{If "unbiased", computes the U-statistics, otherwise the square of the sample mean is computed} 18 | } 19 | 20 | \details{ 21 | Let X1, ..., Xn be i.i.d. random variables. The aim is to estimate t = E(Xi)^2. 22 | The naive estimator is the square of the sample mean: T1 = [(X1 + ... + Xn)/n]^2. 23 | It is positively biased, and the bias is equal to s^2/n, where s^2 = var(X1). 24 | The U-statistics estimator is the average of Xi * Xj over all unordered pairs (i,j). 25 | Equivalently, it is equal to T1 minus the (unbiased) sample variance divided by n. 26 | } 27 | 28 | \value{ 29 | A real number, corresponding to the estimated value of the squared integral. 30 | } 31 | 32 | \references{ 33 | O. Roustant, F. Gamboa and B. Iooss, \emph{Parseval inequalities and lower bounds for 34 | variance-based sensitivity indices}, Electronic Journal of Statistics, 14:386-412, 2020 35 | 36 | Van der Vaart, A. W. Asymptotic statistics. Vol. 3. Cambridge university press, 2000. 37 | } 38 | 39 | \author{ 40 | O. Roustant 41 | } 42 | 43 | \examples{ 44 | n <- 100 # sample size 45 | nsim <- 100 # number of simulations 46 | mu <- 0 47 | 48 | T <- Tunb <- rep(NA, nsim) 49 | theta <- mu^2 # E(X)^2, with X following N(mu, 1) 50 | 51 | for (i in 1:nsim){ 52 | x <- rnorm(n, mean = mu, sd = 1) 53 | T[i] <- squaredIntEstim(x, method = "biased") 54 | Tunb[i] <- squaredIntEstim(x, method = "unbiased") 55 | } 56 | 57 | par(mfrow = c(1, 1)) 58 | boxplot(cbind(T, Tunb)) 59 | abline(h = theta, col = "red") 60 | abline(h = c(mean(T), mean(Tunb)), col = c("blue", "cyan"), lty = "dotted") 61 | # look at the difference between median and mean 62 | } -------------------------------------------------------------------------------- /man/src.Rd: -------------------------------------------------------------------------------- 1 | \name{src} 2 | \alias{src} 3 | \alias{print.src} 4 | \alias{plot.src} 5 | \alias{ggplot.src} 6 | 7 | \title{Standardized Regression Coefficients} 8 | 9 | \description{ 10 | \code{src} computes the Standardized Regression Coefficients 11 | (SRC), or the Standardized Rank Regression Coefficients (SRRC), which 12 | are sensitivity indices based on linear or monotonic assumptions in 13 | the case of independent factors. 14 | } 15 | 16 | \usage{ 17 | src(X, y, rank = FALSE, logistic = FALSE, nboot = 0, conf = 0.95) 18 | \method{print}{src}(x, \dots) 19 | \method{plot}{src}(x, ylim = c(-1,1), \dots) 20 | \method{ggplot}{src}(data, mapping = aes(), ylim = c(-1, 1), \dots, environment 21 | = parent.frame()) 22 | } 23 | 24 | \arguments{ 25 | \item{X}{a data frame (or object coercible by \code{as.data.frame}) 26 | containing the design of experiments (model input variables).} 27 | \item{y}{a vector containing the responses corresponding to the design 28 | of experiments (model output variables).} 29 | \item{rank}{logical. If \code{TRUE}, the analysis is done on the 30 | ranks.} 31 | \item{logistic}{logical. If \code{TRUE}, the analysis is done via a 32 | logistic regression (binomial GLM).} 33 | \item{nboot}{the number of bootstrap replicates.} 34 | \item{conf}{the confidence level of the bootstrap confidence intervals.} 35 | \item{x}{the object returned by \code{src}.} 36 | \item{data}{the object returned by \code{src}.} 37 | \item{ylim}{the y-coordinate limits of the plot.} 38 | \item{mapping}{Default list of aesthetic mappings to use for plot. If not specified, 39 | must be supplied in each layer added to the plot.} 40 | \item{environment}{[Deprecated] Used prior to tidy evaluation.} 41 | \item{\dots}{arguments to be passed to methods, such as graphical 42 | parameters (see \code{par}).} 43 | } 44 | 45 | \value{ 46 | \code{src} returns a list of class \code{"src"}, containing the following 47 | components: 48 | 49 | \item{call}{the matched call.} 50 | \item{SRC}{a data frame containing the estimations of the SRC 51 | indices, bias and confidence intervals (if \code{rank = FALSE}).} 52 | \item{SRRC}{a data frame containing the estimations of the SRRC 53 | indices, bias and confidence intervals (if \code{rank = TRUE}).} 54 | } 55 | 56 | \details{ 57 | Logistic regression model (\code{logistic = TRUE}) and rank-based indices 58 | (\code{rank = TRUE}) are incompatible. 59 | } 60 | 61 | \references{ 62 | 63 | L. Clouvel, B. Iooss, V. Chabridon, M. Il Idrissi and F. Robin, 2023, 64 | \emph{An overview of variance-based importance measures in the linear regression context: 65 | comparative analyses and numerical tests}, Preprint. 66 | \url{https://hal.science/hal-04102053} 67 | 68 | B. Iooss, V. Chabridon and V. Thouvenot, \emph{Variance-based importance 69 | measures for machine learning model interpretability}, Congres lambda-mu23, 70 | Saclay, France, 10-13 octobre 2022 71 | \url{https://hal.science/hal-03741384} 72 | 73 | A. Saltelli, K. Chan and E. M. Scott eds, 2000, \emph{Sensitivity 74 | Analysis}, Wiley. 75 | 76 | } 77 | 78 | \author{ 79 | Gilles Pujol and Bertrand Iooss 80 | } 81 | 82 | \examples{ 83 | 84 | # a 100-sample with X1 ~ U(0.5, 1.5) 85 | # X2 ~ U(1.5, 4.5) 86 | # X3 ~ U(4.5, 13.5) 87 | 88 | library(boot) 89 | n <- 100 90 | X <- data.frame(X1 = runif(n, 0.5, 1.5), 91 | X2 = runif(n, 1.5, 4.5), 92 | X3 = runif(n, 4.5, 13.5)) 93 | 94 | # linear model : Y = X1 + X2 + X3 95 | 96 | y <- with(X, X1 + X2 + X3) 97 | 98 | # sensitivity analysis 99 | 100 | x <- src(X, y, nboot = 100) 101 | print(x) 102 | plot(x) 103 | 104 | library(ggplot2) 105 | ggplot(x) 106 | } 107 | 108 | \seealso{ 109 | \code{\link{pcc}}, \code{\link{lmg}}, \code{\link{pmvd}} 110 | } 111 | 112 | \keyword{regression} 113 | -------------------------------------------------------------------------------- /man/support.Rd: -------------------------------------------------------------------------------- 1 | \name{support} 2 | \alias{support} 3 | 4 | \title{ 5 | Support index functions: Measuring the effect of input variables over their support 6 | } 7 | 8 | \description{ 9 | Function to estimate the first-order and total support index functions (Fruth et al., 2016). 10 | } 11 | 12 | \usage{ 13 | support(model, X, Xnew = NULL, fX = NULL, gradfX = NULL, h = 1e-06, ...) 14 | } 15 | 16 | \arguments{ 17 | \item{model}{a function, or a model with a predict method, defining the model to analyze.} 18 | \item{X}{a random sample.} 19 | \item{Xnew}{an optional set of points where to visualize the support indices. If missing, \code{X} is used.} 20 | \item{fX}{an optional vector containing the evaluations of \code{model} at \code{X}. If missing, \code{fX} is computed by evaluating \code{model} at \code{X}.} 21 | \item{gradfX}{an optional vector containing the evaluations of the gradient of \code{model} at \code{X}. If missing, \code{gradfX} is approximated by finite differences of \code{model} at \code{X}.} 22 | \item{h}{a small number for computing finite differences \code{(f(X_i + h) - f(X_i))/h}. Default is \code{1e-6}.} 23 | \item{\dots}{optional arguments to be passed to \code{model}.} 24 | } 25 | 26 | \value{ 27 | \item{main}{a matrix whose columns contain the first-order support index functions, estimated at \code{Xnew}.} 28 | \item{total}{a matrix whose columns contain the total support index functions, estimated at \code{Xnew}.} 29 | \item{DGSM}{a vector containing an estimation of DGSM.} 30 | \item{X}{...} 31 | \item{Xnew}{...} 32 | \item{fX}{...} 33 | \item{gradfX}{... see 'arguments' section.} 34 | } 35 | 36 | \details{ 37 | The first-order support index of \code{f(X)} relative to \code{X_i} is the squared conditional expectation of its partial derivative with respect to \code{X_i}. 38 | 39 | The total support index of \code{f(X)} relative to \code{X_i} is the conditional expectation of its squared partial derivative with respect to \code{X_i}. 40 | 41 | These two functions measure the local influence of \code{X_i}, in the global space of the other input variables. 42 | Up to square transformations, support indices can be viewed as regression curves of partial derivatives \code{df(X)/dX_i} with respect to \code{X_i}. 43 | Estimation is performed by smoothing from the diagonal scatterplots \code{(X_i, df/dX_i)} with the function \code{smooth.spline{stats}} with the default options. 44 | 45 | For the sake of comparison, support index functions may be normalized. The proposed normalization is the sum of the DGSM, equal to the sum of the overall means of total support functions. 46 | Normalized support index functions can be plotted with the S3 method \code{plot}, as well as the underlying diagonal scatterplots of derivatives (S3 method \code{scatterplot}). 47 | } 48 | 49 | 50 | \references{ 51 | J. Fruth, O. Roustant, S. Kuhnt, 2019, \emph{Support indices: Measuring the effects 52 | of input variables over their support}, Reliability Engineering and System Safety, 53 | 187:17-27. 54 | } 55 | 56 | \author{ 57 | O. Roustant 58 | } 59 | 60 | \seealso{ 61 | S3 methods \code{plot} and \code{scatterplot}: \code{\link{plot.support}} 62 | } 63 | 64 | 65 | \examples{ 66 | 67 | \donttest{ 68 | # ----------------- 69 | # ishigami function 70 | # ----------------- 71 | n <- 5000 72 | n.points <- 1000 73 | d <- 3 74 | 75 | set.seed(0) 76 | X <- matrix(runif(d*n, min = -pi, max = pi), n, d) 77 | Xnew <- matrix(seq(from = -pi, to = pi, length=n.points), n.points, d) 78 | 79 | b <- support(model = ishigami.fun, X, Xnew) 80 | 81 | # plot method (x-axis in probability scale), of the normalized support index functions 82 | plot(b, col = c("lightskyblue4", "lightskyblue1", "black"), 83 | xprob = TRUE, p = 'punif', p.arg = list(min = -pi, max = pi), ylim = c(0, 2)) 84 | 85 | # below : diagonal scatterplots of the gradient, 86 | # on which are based the estimation by smoothing 87 | scatterplot(b, xprob = TRUE) 88 | 89 | # now with normal margins 90 | # ----------------------- 91 | X <- matrix(rnorm(d*n), n, d) 92 | Xnew <- matrix(rnorm(d*n.points), n.points, d) 93 | b <- support(model = ishigami.fun, X, Xnew) 94 | 95 | plot(b, col = c("lightskyblue4", "lightskyblue1", "black"), xprob = FALSE) 96 | scatterplot(b, xprob = FALSE, type = "histogram", bins = 10, cex = 1, cex.lab = 1.5) 97 | } 98 | } 99 | 100 | -------------------------------------------------------------------------------- /man/template_replace.Rd: -------------------------------------------------------------------------------- 1 | \name{template.replace} 2 | \alias{template.replace} 3 | 4 | \title{Replace Values in a Template Text} 5 | 6 | \description{ 7 | \code{template.replace} replaces keys within special markups with 8 | values in a so-called template file. Pieces of \R code can be put into 9 | the markups of the template file, and are evaluated during the 10 | replacement. 11 | } 12 | 13 | \usage{ 14 | template.replace(text, replacement, eval = FALSE, 15 | key.pattern = NULL, code.pattern = NULL) 16 | } 17 | 18 | \arguments{ 19 | \item{text}{vector of character strings, the template text.} 20 | \item{replacement}{the list values to replace in \code{text}.} 21 | \item{eval}{boolean, \code{TRUE} if the code within 22 | \code{code.pattern} has to be evaluated, \code{FALSE} otherwise.} 23 | \item{key.pattern}{custom pattern for key replacement (see below)} 24 | \item{code.pattern}{custom pattern for code replacement (see below)} 25 | } 26 | 27 | \details{ 28 | In most cases, a computational code reads its inputs from a text 29 | file. A template file is like an input file, but where some missing 30 | values, identified with generic keys, will be replaced by specific 31 | values. 32 | 33 | By default, the keys are enclosed into markups of the form \code{$(KEY)}. 34 | 35 | Code to be interpreted with \R can be put in the template text. Pieces 36 | of code must be enclosed into markups of the form 37 | \code{@\{CODE\}}. This is useful for example for formating the key 38 | values (see example). For interpreting the code, set \code{eval = TRUE}. 39 | 40 | Users can define custom patterns. These patterns must be 41 | perl-compatible regular expressions (see \code{\link{regexpr}}. 42 | The default ones are: 43 | \preformatted{key.pattern = "\\\\$\\\\(KEY\\\\)" 44 | code.pattern = "@\\\\{CODE\\\\}"} 45 | Note that special characters have to 46 | be escaped both (one for perl, one for \R). 47 | } 48 | 49 | \author{ 50 | Gilles Pujol 51 | } 52 | 53 | \examples{ 54 | txt <- c("Hello $(name)!", "$(a) + $(b) = @{$(a)+$(b)}", 55 | "pi = @{format(pi,digits=5)}") 56 | replacement <- list(name = "world", a = 1, b = 2) 57 | # 1. without code evaluation: 58 | txt.rpl1 <- template.replace(txt, replacement) 59 | print(txt.rpl1) 60 | # 2. with code evalutation: 61 | txt.rpl2 <- template.replace(txt, replacement, eval = TRUE) 62 | print(txt.rpl2) 63 | } 64 | 65 | \keyword{IO} -------------------------------------------------------------------------------- /man/testmodels.Rd: -------------------------------------------------------------------------------- 1 | \name{testmodels} 2 | \alias{testmodels} 3 | \alias{sobol.fun} 4 | \alias{ishigami.fun} 5 | \alias{morris.fun} 6 | \alias{atantemp.fun} 7 | \alias{campbell1D.fun} 8 | \alias{linkletter.fun} 9 | \alias{heterdisc.fun} 10 | \alias{friedman.fun} 11 | \alias{matyas.fun} 12 | 13 | \title{Test Models for Sensitivity Analysis} 14 | 15 | \description{ 16 | These functions are standard testcases for sensitivity analysis 17 | benchmarks. For a scalar output 18 | (see Saltelli et al. 2000 and https://www.sfu.ca/~ssurjano/): 19 | \itemize{ 20 | \item the g-function of Sobol' with 8 inputs, X ~ U[0,1]; 21 | \item the function of Ishigami with 3 inputs, X ~ U[-pi,pi]; 22 | \item the function of Morris with 20 inputs, X ~ U[0,1]; 23 | \item the Linkletter decreasing coefficients function, X ~ U[0,1] 24 | (Linkletter et al. (2006)); 25 | \item the heterdisc function with 4 inputs, X ~ U[0,20]; 26 | \item the Friedman function with 5 inputs, X ~ U[0,1] 27 | (Friedman, 1991); 28 | \item the Matyas function with 2 inputs, X ~ U[0,1]. 29 | } 30 | For functional output cases: 31 | \itemize{ 32 | \item the Arctangent temporal function with 2 inputs, X ~ U[-7,7] 33 | (Auder, 2011). The functional support is on [0,2pi]; 34 | \item the Cambell1D function with 4 inputs, X ~U[-1,5] 35 | (Campbell et al. 2006). The functional support is on [-90,90]. 36 | } 37 | } 38 | 39 | \usage{ 40 | sobol.fun(X) 41 | ishigami.fun(X) 42 | morris.fun(X) 43 | atantemp.fun(X, q = 100) 44 | campbell1D.fun(X, theta = -90:90) 45 | linkletter.fun(X) 46 | heterdisc.fun(X) 47 | friedman.fun(X) 48 | matyas.fun(X) 49 | } 50 | 51 | \arguments{ 52 | \item{X}{a matrix (or \code{data.frame}) containing the input 53 | sample.} 54 | \item{q}{for the atantemp() function: 55 | the number of discretization steps of the functional output} 56 | \item{theta}{for the campbell1D() function: 57 | the discretization steps (angles in degrees)} 58 | } 59 | 60 | \value{ 61 | A vector of function responses. 62 | } 63 | 64 | \references{ 65 | A. Saltelli, K. Chan and E. M. Scott eds, 2000, \emph{Sensitivity Analysis}, Wiley. 66 | } 67 | 68 | \author{ 69 | Gilles Pujol and Bertrand Iooss 70 | } 71 | 72 | \examples{ 73 | \donttest{ 74 | 75 | # Examples for the functional toy fonctions 76 | 77 | # atantemp function 78 | 79 | y0 <- atantemp.fun(matrix(c(-7,0,7,-7,0,7),ncol=2)) 80 | plot(y0[1,],type="l") 81 | apply(y0,1,lines) 82 | 83 | n <- 100 84 | X <- matrix(c(runif(2*n,-7,7)),ncol=2) 85 | y <- atantemp.fun(X) 86 | plot(y0[2,],ylim=c(-2,2),type="l") 87 | apply(y,1,lines) 88 | 89 | # campbell1D function 90 | 91 | N1=100 # nombre de simulations pour courbes 1D 92 | min=-1 ; max=5 93 | nominal=(max+min)/2 94 | 95 | X1 = NULL ; y1 = NULL 96 | Xnom=matrix(nominal,nr=1,nc=4) 97 | ynom=campbell1D.fun(Xnom,theta=-90:90) 98 | plot(ynom,ylim=c(8,30),type="l",col="red") 99 | for (i in 1:N1){ 100 | X=matrix(runif(4,min=min,max=max),nr=1,nc=4) 101 | rbind(X1,X) 102 | y=campbell1D.fun(X,theta=-90:90) 103 | rbind(y1,y) 104 | lines(y) 105 | } 106 | 107 | } 108 | } 109 | 110 | \keyword{misc} 111 | -------------------------------------------------------------------------------- /man/truncateddistrib.Rd: -------------------------------------------------------------------------------- 1 | \name{truncateddistrib} 2 | \alias{truncateddistrib} 3 | \alias{dnorm.trunc} 4 | \alias{pnorm.trunc} 5 | \alias{qnorm.trunc} 6 | \alias{rnorm.trunc} 7 | \alias{dgumbel.trunc} 8 | \alias{pgumbel.trunc} 9 | \alias{qgumbel.trunc} 10 | \alias{rgumbel.trunc} 11 | 12 | \title{Truncated distributions} 13 | 14 | \description{ 15 | \code{dnorm.trunc}, \code{pnorm.trunc}, \code{qnorm.trunc} and 16 | \code{rnorm.trunc} are functions for the Truncated Normal Distribution. 17 | \code{dgumbel.trunc}, \code{pgumbel.trunc}, \code{qgumbel.trunc} and 18 | \code{rgumbel.trunc} are functions for the Truncated Gumbel Distribution. 19 | } 20 | 21 | \usage{ 22 | dnorm.trunc(x, mean = 0, sd = 1, min = -1e6, max = 1e6) 23 | pnorm.trunc(q, mean = 0, sd = 1, min = -1e6, max = 1e6) 24 | qnorm.trunc(p, mean = 0, sd = 1, min = -1e6, max = 1e6) 25 | rnorm.trunc(n, mean = 0, sd = 1, min = -1e6, max = 1e6) 26 | dgumbel.trunc(x, loc = 0, scale = 1, min = -1e6, max = 1e6) 27 | pgumbel.trunc(q, loc = 0, scale = 1, min = -1e6, max = 1e6) 28 | qgumbel.trunc(p, loc = 0, scale = 1, min = -1e6, max = 1e6) 29 | rgumbel.trunc(n, loc = 0, scale = 1, min = -1e6, max = 1e6) 30 | } 31 | 32 | \arguments{ 33 | \item{x, q}{vector of quantiles} 34 | \item{p}{vector of probabilities} 35 | \item{n}{number of observations} 36 | \item{mean, sd}{means and standard deviation parameters} 37 | \item{loc, scale}{location and scale parameters} 38 | \item{min}{vector of minimal bound values} 39 | \item{max}{vector of maximal bound values} 40 | } 41 | 42 | \details{ 43 | See \code{dnorm} for details on the Normal distribution. 44 | The Gumbel distribution comes from the evd package. 45 | See \code{dgumbel} for details on the Gumbel distribution. 46 | } 47 | 48 | \value{ 49 | \code{dnorm.trunc} and \code{dgumbel.trunc} give the density, \code{pnorm} and \code{pgumbel.trunc} give the distribution function, \code{qnorm} and \code{qgumbel.trunc} give the quantile function, \code{rnorm} and \code{rgumbel.trunc} generate random deviates. 50 | } 51 | 52 | \author{ 53 | Gilles Pujol and Bertrand Iooss 54 | } 55 | 56 | \keyword{misc} 57 | -------------------------------------------------------------------------------- /man/weightTSA.Rd: -------------------------------------------------------------------------------- 1 | \name{weightTSA} 2 | \alias{weightTSA} 3 | 4 | \title{ 5 | Weight-function to transform an output variable in order to perform Target Sensitivity Analysis (TSA) 6 | } 7 | \description{ 8 | Transformation function of one variable (vector sample) 9 | } 10 | \usage{ 11 | weightTSA(Y, c, upper = TRUE, type="indicTh", param=1) 12 | } 13 | 14 | \arguments{ 15 | \item{Y}{The output vector} 16 | \item{c}{The threshold} 17 | \item{upper}{TRUE for upper threshold and FALSE for lower threshold} 18 | \item{type}{The weight function type ("indicTh", "zeroTh", logistic", "exp1side"): 19 | \itemize{ 20 | \item indicTh : indicator-thresholding 21 | \item zeroTh : zero-thresholding (keeps the variable value above (upper=TRUE case) or below the threshold) 22 | \item logistic : logistic transformation at the threshold 23 | \item exp1side : exponential transformation above (upper=TRUE case) or below the threshold (see Raguet and Marrel) 24 | }} 25 | \item{param}{The parameter value for "logistic" and "exp1side" types} 26 | } 27 | 28 | \details{The weight functions depend on a threshold \eqn{c} and/or a smooth relaxation. These functions are defined as follows 29 | \itemize{ 30 | \item if type = "indicTh": \eqn{w = 1_{Y>c}} (upper threshold) and \eqn{w = 1_{Yc}} (upper threshold) and \eqn{w = Y 1_{Y 2 | using namespace Rcpp; 3 | using namespace std; 4 | 5 | 6 | double DisC2_super_Operation(double i){ 7 | return 1.0 + abs(i - 0.5)*0.5; 8 | } 9 | 10 | double DisC2_super_Operation_Magic(double i){ 11 | return 0.5 * abs(i - 0.5); 12 | } 13 | 14 | void DisC2_perElement_AbsDiff(NumericVector Xi,NumericVector Xk,NumericVector LocalVecXi_k, int size, int i, int k){ 15 | 16 | for (int elem=0;elem()); 55 | } else { 56 | std::transform(Xkptr.begin()+k*d,Xkptr.begin()+(k+1)*d, LocalVecXk.begin(), DisC2_super_Operation_Magic); 57 | DisC2_perElement_AbsDiff(Xiptr,Xkptr,LocalVecXi_k, d, i, k); 58 | DisC2_perElement_Final(LocalVecXi , LocalVecXk , LocalVecXi_k, LocalVecFinal, d); 59 | s += std::accumulate(LocalVecFinal.begin(), LocalVecFinal.end(), 1.0, std::multiplies()); 60 | } 61 | } 62 | } 63 | return s; 64 | } 65 | 66 | // [[Rcpp::export]] 67 | double DisC2_Rowprod(NumericVector x, int d){ 68 | int n = x.size(); 69 | int l = n/d; 70 | double out = 0.0; 71 | 72 | for (int i = 0; i < l; i++) { 73 | out += std::accumulate(x.begin()+i*d, x.begin()+(i+1)*d, 1.0, std::multiplies()); 74 | } 75 | return(out); 76 | } 77 | -------------------------------------------------------------------------------- /src/DisL2_criteria.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | using namespace std; 4 | 5 | 6 | void DisL2_perElement_MinMax(NumericVector Xi,NumericVector Xk,NumericVector LocalVecXi_k, int size, int i, int k){ 7 | 8 | for (int elem=0;elem()); 35 | } else { 36 | DisL2_perElement_MinMax(Xiptr,Xkptr,LocalVecFinal, d, i, k); 37 | s += std::accumulate(LocalVecFinal.begin(), LocalVecFinal.end(), 1.0, std::multiplies()); 38 | } 39 | } 40 | } 41 | return s; 42 | } 43 | 44 | // [[Rcpp::export]] 45 | double DisL2_Rowprod(NumericVector x, int d){ 46 | int n = x.size(); 47 | int l = n/d; 48 | double out = 0.0; 49 | 50 | // std::cout << n << ' ' << l << std::endl; 51 | // NumericVector out(l); 52 | 53 | for (int i = 0; i < l; i++) { 54 | out += std::accumulate(x.begin()+i*d, x.begin()+(i+1)*d, 1.0, std::multiplies()); 55 | } 56 | return(out); 57 | } 58 | -------------------------------------------------------------------------------- /src/DisL2star_criteria.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | using namespace std; 4 | 5 | 6 | double DisL2star_super_Operation(double i){ 7 | return 1.0 - i; 8 | } 9 | 10 | double DisL2star_super_Operation_Magic(double i){ 11 | return 1.0 - i*i; 12 | } 13 | 14 | void DisL2star_perElement_Max(NumericVector Xi,NumericVector Xk,NumericVector LocalVecXi_k, int size, int i, int k){ 15 | 16 | for (int elem=0;elem())/(l*l); 48 | } else { 49 | std::transform(Xiptr.begin()+i*d,Xiptr.begin()+(i+1)*d, v1.begin(), DisL2star_super_Operation); 50 | t1 = std::accumulate(v1.begin(), v1.end(), 1.0, std::multiplies()); 51 | std::transform(Xiptr.begin()+i*d,Xiptr.begin()+(i+1)*d, v2.begin(), DisL2star_super_Operation_Magic); 52 | t2 = std::accumulate(v2.begin(), v2.end(), 1.0, std::multiplies()); 53 | t = t1/(l*l) - std::pow(2,1 - d)/l * t2; 54 | } 55 | 56 | s += t; 57 | 58 | } 59 | } 60 | return s; 61 | } 62 | -------------------------------------------------------------------------------- /src/DisM2_criteria.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | using namespace std; 4 | 5 | 6 | void DisM2_perElement_Max(NumericVector Xi,NumericVector Xk,NumericVector LocalVecXi_k, int size, int i, int k){ 7 | 8 | for (int elem=0;elem()); 35 | } else { 36 | DisM2_perElement_Max(Xiptr,Xkptr,LocalVecFinal, d, i, k); 37 | s += std::accumulate(LocalVecFinal.begin(), LocalVecFinal.end(), 1.0, std::multiplies()); 38 | } 39 | } 40 | } 41 | return s; 42 | } 43 | 44 | // [[Rcpp::export]] 45 | double DisM2_Rowprod(NumericVector x, int d){ 46 | int n = x.size(); 47 | int l = n/d; 48 | double out = 0.0; 49 | 50 | // std::cout << n << ' ' << l << std::endl; 51 | // NumericVector out(l); 52 | 53 | for (int i = 0; i < l; i++) { 54 | out += std::accumulate(x.begin()+i*d, x.begin()+(i+1)*d, 1.0, std::multiplies()); 55 | } 56 | return(out); 57 | } 58 | -------------------------------------------------------------------------------- /src/DisS2_criteria.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | using namespace std; 4 | 5 | 6 | void DisS2_perElement_AbsDiff(NumericVector Xi,NumericVector Xk,NumericVector LocalVecXi_k, int size, int i, int k){ 7 | 8 | for (int elem=0;elem()); 35 | } else { 36 | DisS2_perElement_AbsDiff(Xiptr,Xkptr,LocalVecFinal, d, i, k); 37 | s += std::accumulate(LocalVecFinal.begin(), LocalVecFinal.end(), 1.0, std::multiplies()); 38 | } 39 | } 40 | } 41 | return s; 42 | } 43 | 44 | // [[Rcpp::export]] 45 | double DisS2_Rowprod(NumericVector x, int d){ 46 | int n = x.size(); 47 | int l = n/d; 48 | double out = 0.0; 49 | 50 | // std::cout << n << ' ' << l << std::endl; 51 | // NumericVector out(l); 52 | 53 | for (int i = 0; i < l; i++) { 54 | out += std::accumulate(x.begin()+i*d, x.begin()+(i+1)*d, 1.0, std::multiplies()); 55 | } 56 | return(out); 57 | } 58 | 59 | -------------------------------------------------------------------------------- /src/DisW2_criteria.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | using namespace std; 4 | 5 | 6 | void DisW2_perElement_AbsDiff(NumericVector Xi,NumericVector Xk,NumericVector LocalVecXi_k, int size, int i, int k){ 7 | 8 | for (int elem=0;elem()); 35 | } else { 36 | DisW2_perElement_AbsDiff(Xiptr,Xkptr,LocalVecXi_k, d, i, k); 37 | s += std::accumulate(LocalVecXi_k.begin(), LocalVecXi_k.end(), 1.0, std::multiplies()); 38 | } 39 | } 40 | } 41 | return s; 42 | } 43 | 44 | -------------------------------------------------------------------------------- /src/LG_Rowsort.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | using namespace std; 7 | 8 | extern "C" 9 | { 10 | int LG_compare(const void * a, const void * b) 11 | { 12 | if (*(double*)a > *(double*)b) return 1; 13 | else if (*(double*)a < *(double*)b) return -1; 14 | else return 0; 15 | } 16 | } 17 | 18 | extern "C" 19 | { 20 | void LG_rowsort(int* N, double* x, int*d, double*inter, double* out) 21 | { 22 | //cout<<"Sorting the array"< 2 | #include 3 | #include 4 | #include 5 | 6 | using namespace std; 7 | 8 | 9 | extern "C" 10 | { 11 | void LG_estimator(const double* Y, const double* mean, const int*d, const int* N, const int* ind, const int* ind2, double* a, double *b, double* c, double* S) 12 | { 13 | int i_1; 14 | int i_2; 15 | //cout<<"Sorting the array"<