# \donttest{
# Test case: the Matyas function.
n <- 300 # nb of samples
p <- 3 # nb of input variables (including 1 dummy variable)
########################################
### PRELIMINARY SENSITIVITY ANALYSIS ###
########################################
X <- matrix(runif(n*p), n, p)
sensi <- sensiHSIC(model=matyas.fun, X,
kernelX="sobolev1", anova=list(obj="both", is.uniform=TRUE))
print(sensi)
plot(sensi)
title("GSA for the Matyas function")
#############################
### TESTS OF INDEPENDENCE ###
#############################
### HSIC indices ###
test.asymp <- testHSIC(sensi)
test.perm <- testHSIC(sensi, test.method="Permutation")
test.seq.screening <- testHSIC(sensi, test.method="Seq_Permutation")
test.seq.ranking <- testHSIC(sensi, test.method="Seq_Permutation",
seq.options=list(criterion="ranking"))
test.seq.both <- testHSIC(sensi, test.method="Seq_Permutation",
seq.options=list(criterion="both"))
test.gamma <- testHSIC(sensi, test.method="Gamma")
# comparison of p-values
res <- rbind( t(as.matrix(test.asymp$pval)), t(as.matrix(test.perm$pval)),
t(as.matrix(test.seq.screening$pval)), t(as.matrix(test.seq.ranking$pval)),
t(as.matrix(test.seq.both$pval)), t(as.matrix(test.gamma$pval)) )
rownames(res) <- c("asymp", "perm", "seq_perm_screening",
"seq_perm_ranking", "seq_perm_both", "gamma")
res
### total-order HSIC-ANOVA indices ###
test.tot.perm <- testHSIC(sensi, test.method="Tot_Permutation")
test.tot.seq.screening <- testHSIC(sensi, test.method="Tot_Seq_Permutation")
test.tot.seq.ranking <- testHSIC(sensi, test.method="Tot_Seq_Permutation",
seq.options=list(criterion="ranking"))
test.tot.seq.both <- testHSIC(sensi, test.method="Tot_Seq_Permutation",
seq.options=list(criterion="both"))
test.tot.gamma <- testHSIC(sensi, test.method="Tot_Gamma")
res <- rbind( t(as.matrix(test.tot.perm$pval)),
t(as.matrix(test.tot.seq.screening$pval)),
t(as.matrix(test.tot.seq.ranking$pval)),
t(as.matrix(test.tot.seq.both$pval)),
t(as.matrix(test.tot.gamma$pval)) )
rownames(res) <- c("tot_perm", "tot_seq_perm_screening",
"tot_seq_perm_ranking", "tot_seq_perm_both", "tot_gamma")
res
#####################
### VISUALIZATION ###
#####################
# simulated values of HSIC indices under H0 (random permutations)
Hperm <- t(unname(test.perm$Hperm))
# simulated values of total-order HSIC-ANOVA indices under H0 (random permutations)
tot.Hperm <- t(unname(test.tot.perm$Hperm))
for(i in 1:p){
ttl <- paste0("First-order and total-order HSIC-ANOVA indices for X", i)
######################################
### FIRST-ORDER HSIC-ANOVA INDICES ###
######################################
# histogram of the test statistic under H0 (random permutations)
hist(Hperm[,i], probability=TRUE,
nclass=70, main=ttl, xlab="", ylab="", col="cyan")
xx <- seq(0, max(tot.Hperm[,i]), length.out=200)
# asymptotic Gamma distribution
shape.asymp <- test.asymp$param[i, "shape"]
scale.asymp <- test.asymp$param[i, "scale"]
dens.asymp <- dgamma(xx, shape=shape.asymp, scale=scale.asymp)
lines(xx, dens.asymp, lwd=2, col="darkorchid")
# finite-sample Gamma distribution
shape.perm <- test.gamma$param[i, "shape"]
scale.perm <- test.gamma$param[i, "scale"]
dens.perm <- dgamma(xx, shape=shape.perm, scale=scale.perm)
lines(xx, dens.perm, lwd=2, col="blue")
######################################
### TOTAL-ORDER HSIC-ANOVA INDICES ###
######################################
# histogram of the test statistic under H0 (random permutations)
hist(tot.Hperm[,i], probability=TRUE, add=TRUE,
nclass=70, xlab="", ylab="", col="deeppink")
# finite-sample Gamma distribution
shape.tot.perm <- test.tot.gamma$param[i, "shape"]
scale.tot.perm <- test.tot.gamma$param[i, "scale"]
dens.tot.perm <- dgamma(xx, shape=shape.tot.perm, scale=scale.tot.perm)
lines(xx, dens.tot.perm, lwd=2, col="red")
### legend ###
txt.1 <- paste0("Histogram of HSIC(X", i, ",Y)")
txt.11 <- "Asymptotic Gamma distribution"
txt.12 <- "Finite-sample Gamma distribution"
txt.2 <- paste0("Histogram of T", i, " = HSIC(X,Y) - HSIC(X",
paste(setdiff(1:p, i), collapse=""), ",Y)")
txt.21 <- "Finite-sample Gamma distribution"
all.cap <- c(txt.1, txt.11, txt.12, txt.2, txt.21)
all.col <- c("cyan", "darkorchid", "blue", "deeppink", "red")
all.lwd <- c(7, 2, 2, 7, 2)
legend("topright", legend=all.cap, col=all.col, lwd=all.lwd, y.intersp=1.3)
}
# }
Run the code above in your browser using DataLab