## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  message = FALSE,
  warning = FALSE,
  fig.width = 7,
  fig.height = 5,
  dpi = 150
)

# Render as a lightweight source document by default. To rerun the analyses,
# render with `options(plsRglm.rebuild_vignette = TRUE)` set beforehand.
run_examples <- isTRUE(getOption("plsRglm.rebuild_vignette", FALSE))
has_chemometrics <- requireNamespace("chemometrics", quietly = TRUE)
has_xtable <- requireNamespace("xtable", quietly = TRUE)

weighted_significance <- function(cv_counts, matind) {
  counts <- prop.table(cv_counts)
  row_keys <- paste0("YT", names(counts))
  keep <- row_keys %in% rownames(matind)

  if (!any(keep)) {
    return(rep(NA_real_, ncol(matind)))
  }

  weights <- as.numeric(prop.table(counts[keep]))
  indicator <- as.matrix(matind[row_keys[keep], , drop = FALSE])
  as.numeric(weights %*% indicator)
}

library(plsRglm)

## ----cornell-cross-validation, eval = run_examples----------------------------
# data(Cornell)
# 
# cv.modpls <- cv.plsR(Y ~ ., data = Cornell, nt = 6, K = 6)
# res.cv.modpls <- cvtable(summary(cv.modpls))
# 
# res6 <- plsR(Y ~ ., data = Cornell, nt = 6, typeVC = "standard", pvals.expli = TRUE)
# colSums(res6$pvalstep)
# res6$InfCrit
# 
# res6 <- plsR(Y ~ ., data = Cornell, nt = 6, pvals.expli = TRUE)
# colSums(res6$pvalstep)

## ----cornell-cross-validation-repeat, eval = run_examples---------------------
# set.seed(123)
# cv.modpls <- cv.plsR(
#   Y ~ .,
#   data = Cornell,
#   nt = 6,
#   K = 6,
#   NK = 100,
#   random = TRUE,
#   verbose = FALSE
# )
# res.cv.modpls <- cvtable(summary(cv.modpls))
# plot(res.cv.modpls)

## ----cornell-model, eval = run_examples---------------------------------------
# res <- plsR(Y ~ ., data = Cornell, nt = 1, pvals.expli = TRUE)
# res
# res$wwetoile
# biplot(res6$tt, res6$pp)
# 
# modpls2 <- plsR(Y ~ ., data = Cornell, 6, sparse = TRUE)
# modpls3 <- plsR(Y ~ ., data = Cornell, 6, sparse = TRUE, sparseStop = FALSE)

## ----cornell-bootstrap-yx, eval = run_examples--------------------------------
# set.seed(123)
# Cornell.bootYX1 <- bootpls(res, R = 1000, verbose = FALSE)
# 
# boxplots.bootpls(Cornell.bootYX1, indice = 2:8)
# temp.ci <- confints.bootpls(Cornell.bootYX1, indice = 2:8)
# plots.confints.bootpls(
#   temp.ci,
#   typeIC = "BCa",
#   colIC = c("blue", "blue", "blue", "blue"),
#   legendpos = "topright"
# )
# 
# plot(Cornell.bootYX1, index = 2, jack = TRUE)
# car::dataEllipse(
#   Cornell.bootYX1$t[, 2],
#   Cornell.bootYX1$t[, 3],
#   cex = 0.3,
#   levels = c(0.5, 0.95, 0.99),
#   robust = TRUE,
#   xlab = "X2",
#   ylab = "X3"
# )

## ----cornell-bootstrap-yt, eval = run_examples--------------------------------
# set.seed(123)
# Cornell.bootYT1 <- bootpls(res, typeboot = "fmodel_np", R = 1000)
# boxplots.bootpls(Cornell.bootYT1, indices = 2:8)
# 
# temp.ci <- confints.bootpls(Cornell.bootYT1, indices = 2:8)
# plots.confints.bootpls(
#   temp.ci,
#   typeIC = "BCa",
#   colIC = c("blue", "blue", "blue", "blue"),
#   legendpos = "topright"
# )
# 
# res2 <- plsR(Y ~ ., data = Cornell, nt = 2)
# Cornell.bootYT2 <- bootpls(res2, typeboot = "fmodel_np", R = 1000)
# temp.ci2 <- confints.bootpls(Cornell.bootYT2, indices = 2:8)
# 
# ind.BCa.CornellYT1 <- (temp.ci[, 7] < 0 & temp.ci[, 8] < 0) | (temp.ci[, 7] > 0 & temp.ci[, 8] > 0)
# ind.BCa.CornellYT2 <- (temp.ci2[, 7] < 0 & temp.ci2[, 8] < 0) | (temp.ci2[, 7] > 0 & temp.ci2[, 8] > 0)
# 
# matind <- rbind(YT1 = ind.BCa.CornellYT1, YT2 = ind.BCa.CornellYT2)
# pi.e <- prop.table(res.cv.modpls$CVQ2)[-1] %*% matind
# 
# signpred(t(matind), labsize = 0.5, plotsize = 12)
# text(1:(ncol(matind)) - 0.5, -0.5, pi.e, cex = 1.4)
# mtext(expression(pi[e]), side = 2, las = 1, line = 2, at = -0.5, cex = 1.4)

## ----microsat-original-data, eval = run_examples------------------------------
# data(aze)
# Xaze <- aze[, 2:34]
# yaze <- aze$y

## ----microsat-original-cross-validation, eval = run_examples------------------
# cv.modpls <- cv.plsRglm(
#   object = yaze,
#   dataX = Xaze,
#   nt = 10,
#   modele = "pls-glm-logistic",
#   K = 8
# )
# res.cv.modpls <- cvtable(summary(cv.modpls, MClassed = TRUE))
# 
# res10 <- plsRglm(yaze, Xaze, nt = 10, modele = "pls-glm-logistic", pvals.expli = TRUE)
# colSums(res10$pvalstep)
# 
# modpls2 <- plsRglm(
#   dataY = yaze,
#   dataX = Xaze,
#   nt = 10,
#   modele = "pls-glm-logistic",
#   sparse = TRUE,
#   sparseStop = TRUE
# )
# 
# set.seed(123)
# cv.modpls.logit <- cv.plsRglm(
#   object = yaze,
#   dataX = Xaze,
#   nt = 10,
#   modele = "pls-glm-logistic",
#   K = 8,
#   NK = 100
# )
# res.cv.modpls.logit <- cvtable(summary(cv.modpls.logit, MClassed = TRUE))
# plot(res.cv.modpls.logit)

## ----microsat-original-model, eval = run_examples-----------------------------
# res <- plsRglm(yaze, Xaze, nt = 4, modele = "pls-glm-logistic", pvals.expli = TRUE)
# res
# res$wwetoile
# biplot(res$tt, res$pp)
# 
# modpls3 <- plsRglm(yaze, Xaze, nt = 10, modele = "pls-glm-logistic", sparse = FALSE, pvals.expli = TRUE)
# modpls4 <- plsRglm(yaze, Xaze, nt = 10, modele = "pls-glm-logistic", sparse = TRUE, pvals.expli = TRUE)

## ----microsat-original-bootstrap-yx, eval = run_examples----------------------
# set.seed(123)
# aze.bootYX4 <- bootplsglm(res, typeboot = "plsmodel", R = 1000, verbose = FALSE)
# 
# boxplots.bootpls(aze.bootYX4, las = 2, mar = c(5, 2, 1, 1) + 0.1)
# temp.ci <- confints.bootpls(aze.bootYX4)
# plots.confints.bootpls(
#   temp.ci,
#   typeIC = "BCa",
#   colIC = c("blue", "blue", "blue", "blue"),
#   legendpos = "topright",
#   las = 2,
#   mar = c(5, 2, 1, 1) + 0.1
# )

## ----microsat-original-bootstrap-yt, eval = run_examples----------------------
# set.seed(123)
# aze.bootYT4 <- bootplsglm(res, R = 1000, verbose = FALSE)
# 
# boxplots.bootpls(aze.bootYT4, las = 2, mar = c(5, 2, 1, 1) + 0.1)
# temp.ci4 <- confints.bootpls(aze.bootYT4)
# plots.confints.bootpls(
#   temp.ci4,
#   typeIC = "BCa",
#   colIC = c("blue", "blue", "blue", "blue"),
#   legendpos = "topright",
#   las = 2,
#   mar = c(5, 2, 1, 1) + 0.1
# )
# 
# res1 <- plsRglm(yaze, Xaze, nt = 1, modele = "pls-glm-logistic")
# res2 <- plsRglm(yaze, Xaze, nt = 2, modele = "pls-glm-logistic")
# res3 <- plsRglm(yaze, Xaze, nt = 3, modele = "pls-glm-logistic")
# res5 <- plsRglm(yaze, Xaze, nt = 5, modele = "pls-glm-logistic")
# res6 <- plsRglm(yaze, Xaze, nt = 6, modele = "pls-glm-logistic")
# res7 <- plsRglm(yaze, Xaze, nt = 7, modele = "pls-glm-logistic")
# res8 <- plsRglm(yaze, Xaze, nt = 8, modele = "pls-glm-logistic")
# 
# aze.bootYT1 <- bootplsglm(res1, R = 1000)
# aze.bootYT2 <- bootplsglm(res2, R = 1000)
# aze.bootYT3 <- bootplsglm(res3, R = 1000)
# aze.bootYT5 <- bootplsglm(res5, R = 1000)
# aze.bootYT6 <- bootplsglm(res6, R = 1000)
# aze.bootYT7 <- bootplsglm(res7, R = 1000)
# aze.bootYT8 <- bootplsglm(res8, R = 1000)
# 
# temp.ci1 <- confints.bootpls(aze.bootYT1)
# temp.ci2 <- confints.bootpls(aze.bootYT2)
# temp.ci3 <- confints.bootpls(aze.bootYT3)
# temp.ci5 <- confints.bootpls(aze.bootYT5)
# temp.ci6 <- confints.bootpls(aze.bootYT6)
# temp.ci7 <- confints.bootpls(aze.bootYT7)
# temp.ci8 <- confints.bootpls(aze.bootYT8)
# 
# ind.BCa.azeYT1 <- (temp.ci1[, 7] < 0 & temp.ci1[, 8] < 0) | (temp.ci1[, 7] > 0 & temp.ci1[, 8] > 0)
# ind.BCa.azeYT2 <- (temp.ci2[, 7] < 0 & temp.ci2[, 8] < 0) | (temp.ci2[, 7] > 0 & temp.ci2[, 8] > 0)
# ind.BCa.azeYT3 <- (temp.ci3[, 7] < 0 & temp.ci3[, 8] < 0) | (temp.ci3[, 7] > 0 & temp.ci3[, 8] > 0)
# ind.BCa.azeYT4 <- (temp.ci4[, 7] < 0 & temp.ci4[, 8] < 0) | (temp.ci4[, 7] > 0 & temp.ci4[, 8] > 0)
# ind.BCa.azeYT5 <- (temp.ci5[, 7] < 0 & temp.ci5[, 8] < 0) | (temp.ci5[, 7] > 0 & temp.ci5[, 8] > 0)
# ind.BCa.azeYT6 <- (temp.ci6[, 7] < 0 & temp.ci6[, 8] < 0) | (temp.ci6[, 7] > 0 & temp.ci6[, 8] > 0)
# ind.BCa.azeYT7 <- (temp.ci7[, 7] < 0 & temp.ci7[, 8] < 0) | (temp.ci7[, 7] > 0 & temp.ci7[, 8] > 0)
# ind.BCa.azeYT8 <- (temp.ci8[, 7] < 0 & temp.ci8[, 8] < 0) | (temp.ci8[, 7] > 0 & temp.ci8[, 8] > 0)
# 
# matind <- rbind(
#   YT1 = ind.BCa.azeYT1,
#   YT2 = ind.BCa.azeYT2,
#   YT3 = ind.BCa.azeYT3,
#   YT4 = ind.BCa.azeYT4,
#   YT5 = ind.BCa.azeYT5,
#   YT6 = ind.BCa.azeYT6,
#   YT7 = ind.BCa.azeYT7,
#   YT8 = ind.BCa.azeYT8
# )
# 
# pi.e <- weighted_significance(res.cv.modpls.logit$CVMC, matind)
# signpred(t(matind), labsize = 2, plotsize = 12)
# text(1:(ncol(matind)) - 0.5, -1, pi.e, cex = 0.5)
# mtext(expression(pi[e]), side = 2, las = 1, line = 2, at = -1)

## ----microsat-link-options, eval = run_examples-------------------------------
# modpls <- plsRglm(yaze, Xaze, nt = 10, modele = "pls-glm-logistic", MClassed = TRUE, pvals.expli = TRUE)
# modpls2 <- plsRglm(yaze, Xaze, nt = 10, modele = "pls-glm-family", family = binomial(link = "logit"), MClassed = TRUE, pvals.expli = TRUE)
# modpls3 <- plsRglm(yaze, Xaze, nt = 10, modele = "pls-glm-family", family = binomial(link = "probit"), MClassed = TRUE, pvals.expli = TRUE)
# modpls4 <- plsRglm(yaze, Xaze, nt = 10, modele = "pls-glm-family", family = binomial(link = "cauchit"), MClassed = TRUE, pvals.expli = TRUE)
# modpls5 <- plsRglm(yaze, Xaze, nt = 10, modele = "pls-glm-family", family = binomial(link = "cloglog"), MClassed = TRUE, pvals.expli = TRUE)
# 
# set.seed(123)
# cv.modpls.probit <- cv.plsRglm(object = yaze, dataX = Xaze, nt = 10, modele = "pls-glm-family", family = binomial(link = "probit"), K = 8, NK = 100)
# cv.modpls.cauchit <- cv.plsRglm(object = yaze, dataX = Xaze, nt = 10, modele = "pls-glm-family", family = binomial(link = "cauchit"), K = 8, NK = 100)
# cv.modpls.cloglog <- cv.plsRglm(object = yaze, dataX = Xaze, nt = 10, modele = "pls-glm-family", family = binomial(link = "cloglog"), K = 8, NK = 100)
# 
# res.cv.modpls.probit <- cvtable(summary(cv.modpls.probit, MClassed = TRUE))
# res.cv.modpls.cauchit <- cvtable(summary(cv.modpls.cauchit, MClassed = TRUE))
# 
# layout(matrix(1:4, nrow = 2))
# plot(res.cv.modpls.logit)
# plot(res.cv.modpls.probit)
# plot(res.cv.modpls.cauchit)
# layout(1)

## ----microsat-imputed, eval = run_examples------------------------------------
# data(aze_compl)
# Xaze_compl <- aze_compl[, 2:34]
# yaze_compl <- aze_compl$y
# 
# cv.modpls_compl <- cv.plsRglm(
#   object = yaze_compl,
#   dataX = Xaze_compl,
#   nt = 10,
#   modele = "pls-glm-logistic",
#   K = 8
# )
# res.cv.modpls_compl <- cvtable(summary(cv.modpls_compl, MClassed = TRUE))
# 
# set.seed(123)
# cv.modpls_compl <- cv.plsRglm(
#   object = yaze_compl,
#   dataX = Xaze_compl,
#   nt = 10,
#   modele = "pls-glm-logistic",
#   K = 8,
#   NK = 100
# )
# res.cv.modpls_compl <- cvtable(summary(cv.modpls_compl, MClassed = TRUE))
# plot(res.cv.modpls_compl)
# 
# res_compl <- plsRglm(yaze_compl, Xaze_compl, nt = 3, modele = "pls-glm-logistic", pvals.expli = TRUE)
# res_compl
# 
# aze_compl.bootYX3 <- bootplsglm(res_compl, typeboot = "plsmodel", R = 1000, verbose = FALSE)
# boxplots.bootpls(aze_compl.bootYX3, las = 2, mar = c(5, 2, 1, 1) + 0.1)
# temp.ci <- confints.bootpls(aze_compl.bootYX3)
# plots.confints.bootpls(temp.ci, typeIC = "BCa", colIC = c("blue", "blue", "blue", "blue"), legendpos = "topright", las = 2, mar = c(5, 2, 1, 1) + 0.1)
# 
# aze_compl.bootYT3 <- bootplsglm(res_compl, R = 1000, verbose = FALSE)
# boxplots.bootpls(aze_compl.bootYT3, las = 2, mar = c(5, 2, 1, 1) + 0.1)
# temp.ci3 <- confints.bootpls(aze_compl.bootYT3)
# plots.confints.bootpls(temp.ci3, typeIC = "BCa", colIC = c("blue", "blue", "blue", "blue"), legendpos = "topright", las = 2, mar = c(5, 2, 1, 1) + 0.1)

## ----pine-cross-validation, eval = run_examples-------------------------------
# data(pine)
# Xpine <- pine[, 1:10]
# ypine <- pine[, 11]
# 
# cv.modpls <- cv.plsR(ypine, Xpine, nt = 10)
# res.cv.modpls <- cvtable(summary(cv.modpls))
# 
# res1 <- plsR(ypine, Xpine, nt = 10, typeVC = "standard", pvals.expli = TRUE)
# colSums(res1$pvalstep)
# res1$InfCrit
# 
# set.seed(123)
# cv.modpls <- cv.plsR(x11 ~ ., data = pine, nt = 10, NK = 100)
# res.cv.modpls <- cvtable(summary(cv.modpls))
# plot(res.cv.modpls)

## ----pine-models, eval = run_examples-----------------------------------------
# res <- plsR(x11 ~ ., data = pine, nt = 1, pvals.expli = TRUE)
# res
# biplot(res1$tt, res1$pp)
# 
# data(pine_full)
# Xpine_full <- pine_full[, 1:10]
# ypine_full <- pine_full[, 11]
# modpls5 <- plsR(log(ypine_full), Xpine_full, 1)
# 
# XpineNAX21 <- Xpine
# XpineNAX21[1, 2] <- NA
# modpls6 <- plsR(ypine, XpineNAX21, 4)
# modpls6$YChapeau[1, ]
# plsR(ypine, XpineNAX21, 2, dataPredictY = XpineNAX21[1, ])$ValsPredictY
# 
# modpls7 <- plsR(ypine, XpineNAX21, 4, EstimXNA = TRUE)
# modpls7$XChapeau
# modpls7$XChapeauNA
# 
# plsR(ypine, Xpine, 10, typeVC = "none")$InfCrit
# plsR(ypine, Xpine, 10, typeVC = "standard")$InfCrit
# plsR(ypine, Xpine, 10, typeVC = "adaptative")$InfCrit
# plsR(ypine, Xpine, 10, typeVC = "missingdata")$InfCrit
# plsR(ypine, XpineNAX21, 10, typeVC = "none")$InfCrit
# plsR(ypine, XpineNAX21, 10, typeVC = "standard")$InfCrit
# plsR(ypine, XpineNAX21, 10, typeVC = "adaptative")$InfCrit
# plsR(ypine, XpineNAX21, 10, typeVC = "missingdata")$InfCrit

## ----pine-bootstrap, eval = run_examples--------------------------------------
# set.seed(123)
# Pine.bootYX1 <- bootpls(res, R = 1000)
# boxplots.bootpls(Pine.bootYX1, indice = 2:11)
# temp.ci <- confints.bootpls(Pine.bootYX1, indice = 2:11)
# plots.confints.bootpls(temp.ci, typeIC = "BCa", colIC = c("blue", "blue", "blue", "blue"), legendpos = "topright")
# plot(Pine.bootYX1, index = 2, jack = TRUE)
# car::dataEllipse(Pine.bootYX1$t[, 2], Pine.bootYX1$t[, 3], cex = 0.3, levels = c(0.5, 0.95, 0.99), robust = TRUE, xlab = "X2", ylab = "X3")
# 
# set.seed(123)
# Pine.bootYT1 <- bootpls(res, typeboot = "fmodel_np", R = 1000)
# boxplots.bootpls(Pine.bootYT1, indices = 2:11)
# temp.ci <- confints.bootpls(Pine.bootYT1, indices = 2:11)
# plots.confints.bootpls(temp.ci, typeIC = "BCa", colIC = c("blue", "blue", "blue", "blue"), legendpos = "topright")

## ----bordeaux-cross-validation, eval = run_examples---------------------------
# set.seed(12345)
# data(bordeaux)
# bordeaux$Quality <- factor(bordeaux$Quality, ordered = TRUE)
# 
# modpls1 <- plsRglm(Quality ~ ., data = bordeaux, 4, modele = "pls-glm-polr", pvals.expli = TRUE)
# modpls1
# 
# Xbordeaux <- bordeaux[, 1:4]
# ybordeaux <- bordeaux$Quality
# modpls2 <- plsRglm(ybordeaux, Xbordeaux, 4, modele = "pls-glm-polr", pvals.expli = TRUE)
# modpls2
# 
# all(modpls1$InfCrit == modpls2$InfCrit)
# colSums(modpls2$pvalstep)
# 
# set.seed(123)
# cv.modpls <- cv.plsRglm(ybordeaux, Xbordeaux, nt = 4, modele = "pls-glm-polr", NK = 100, verbose = FALSE)
# res.cv.modpls <- cvtable(summary(cv.modpls, MClassed = TRUE))
# plot(res.cv.modpls)
# 
# res <- plsRglm(ybordeaux, Xbordeaux, 1, modele = "pls-glm-polr")
# res$FinalModel
# biplot(modpls1$tt, modpls1$pp)
# 
# XbordeauxNA <- Xbordeaux
# XbordeauxNA[1, 1] <- NA
# modplsNA <- plsRglm(ybordeaux, XbordeauxNA, 4, modele = "pls-glm-polr")
# modplsNA
# data.frame(formula = modpls1$Coeffs, datasets = modpls2$Coeffs, datasetsNA = modplsNA$Coeffs)

## ----bordeaux-bootstrap-yx, eval = run_examples-------------------------------
# options(contrasts = c("contr.treatment", "contr.poly"))
# 
# modplsglm3 <- plsRglm(ybordeaux, Xbordeaux, 1, modele = "pls-glm-polr")
# bordeaux.bootYT <- bootplsglm(modplsglm3, sim = "permutation", R = 250, verbose = FALSE)
# boxplots.bootpls(bordeaux.bootYT)
# boxplots.bootpls(bordeaux.bootYT, ranget0 = TRUE)
# 
# bordeaux.bootYX1 <- bootplsglm(res, typeboot = "plsmodel", sim = "balanced", R = 1000, verbose = FALSE)
# boxplots.bootpls(bordeaux.bootYX1)
# temp.ci <- confints.bootpls(bordeaux.bootYX1)
# plots.confints.bootpls(temp.ci, typeIC = "BCa", colIC = c("blue", "blue", "blue", "blue"), legendpos = "topright")
# 
# bordeaux.bootYX1strata <- bootplsglm(res, typeboot = "plsmodel", sim = "balanced", R = 1000, strata = unclass(ybordeaux), verbose = FALSE)
# boxplots.bootpls(bordeaux.bootYX1strata)
# confints.bootpls(bordeaux.bootYX1strata)
# plots.confints.bootpls(confints.bootpls(bordeaux.bootYX1strata), typeIC = "BCa", colIC = c("blue", "blue", "blue", "blue"), legendpos = "topright")

## ----bordeaux-bootstrap-yt, eval = run_examples-------------------------------
# bordeaux.bootYT1 <- bootplsglm(res, sim = "balanced", R = 1000, verbose = FALSE)
# boxplots.bootpls(bordeaux.bootYT1)
# temp.ci <- confints.bootpls(bordeaux.bootYT1)
# plots.confints.bootpls(temp.ci, typeIC = "BCa", colIC = c("blue", "blue", "blue", "blue"), legendpos = "topright")
# 
# bordeaux.bootYT1strata <- bootplsglm(res, sim = "balanced", R = 1000, strata = unclass(ybordeaux), verbose = FALSE)
# boxplots.bootpls(bordeaux.bootYT1strata)
# temp.cis <- confints.bootpls(bordeaux.bootYT1strata)
# plots.confints.bootpls(temp.cis, typeIC = "BCa", colIC = c("blue", "blue", "blue", "blue"), legendpos = "topright")
# 
# res2 <- plsRglm(ybordeaux, Xbordeaux, 2, modele = "pls-glm-polr", verbose = FALSE)
# res3 <- plsRglm(ybordeaux, Xbordeaux, 3, modele = "pls-glm-polr", verbose = FALSE)
# res4 <- plsRglm(ybordeaux, Xbordeaux, 4, modele = "pls-glm-polr", verbose = FALSE)
# 
# bordeaux.bootYT2 <- bootplsglm(res2, sim = "balanced", R = 1000, verbose = FALSE)
# bordeaux.bootYT3 <- bootplsglm(res3, sim = "balanced", R = 1000, verbose = FALSE)
# bordeaux.bootYT4 <- bootplsglm(res4, sim = "balanced", R = 1000, verbose = FALSE)
# bordeaux.bootYT2s <- bootplsglm(res2, sim = "balanced", R = 1000, strata = unclass(ybordeaux), verbose = FALSE)
# bordeaux.bootYT3s <- bootplsglm(res3, sim = "balanced", R = 1000, strata = unclass(ybordeaux), verbose = FALSE)
# bordeaux.bootYT4s <- bootplsglm(res4, sim = "balanced", R = 1000, strata = unclass(ybordeaux), verbose = FALSE)
# 
# temp.ci2 <- confints.bootpls(bordeaux.bootYT2)
# temp.ci3 <- confints.bootpls(bordeaux.bootYT3)
# temp.ci4 <- confints.bootpls(bordeaux.bootYT4)
# temp.cis2 <- confints.bootpls(bordeaux.bootYT2s)
# temp.cis3 <- confints.bootpls(bordeaux.bootYT3s)
# temp.cis4 <- confints.bootpls(bordeaux.bootYT4s)
# 
# ind.BCa.bordeauxYT1 <- (temp.ci[, 7] < 0 & temp.ci[, 8] < 0) | (temp.ci[, 7] > 0 & temp.ci[, 8] > 0)
# ind.BCa.bordeauxYT2 <- (temp.ci2[, 7] < 0 & temp.ci2[, 8] < 0) | (temp.ci2[, 7] > 0 & temp.ci2[, 8] > 0)
# ind.BCa.bordeauxYT3 <- (temp.ci3[, 7] < 0 & temp.ci3[, 8] < 0) | (temp.ci3[, 7] > 0 & temp.ci3[, 8] > 0)
# ind.BCa.bordeauxYT4 <- (temp.ci4[, 7] < 0 & temp.ci4[, 8] < 0) | (temp.ci4[, 7] > 0 & temp.ci4[, 8] > 0)
# ind.BCa.bordeauxYT1s <- (temp.cis[, 7] < 0 & temp.cis[, 8] < 0) | (temp.cis[, 7] > 0 & temp.cis[, 8] > 0)
# ind.BCa.bordeauxYT2s <- (temp.cis2[, 7] < 0 & temp.cis2[, 8] < 0) | (temp.cis2[, 7] > 0 & temp.cis2[, 8] > 0)
# ind.BCa.bordeauxYT3s <- (temp.cis3[, 7] < 0 & temp.cis3[, 8] < 0) | (temp.cis3[, 7] > 0 & temp.cis3[, 8] > 0)
# ind.BCa.bordeauxYT4s <- (temp.cis4[, 7] < 0 & temp.cis4[, 8] < 0) | (temp.cis4[, 7] > 0 & temp.cis4[, 8] > 0)
# 
# matind <- rbind(YT1 = ind.BCa.bordeauxYT1, YT2 = ind.BCa.bordeauxYT2, YT3 = ind.BCa.bordeauxYT3, YT4 = ind.BCa.bordeauxYT4)
# pi.e <- weighted_significance(res.cv.modpls$CVMC, matind)
# signpred(t(matind), labsize = 0.5, plotsize = 12)
# mtext(expression(pi[e]), side = 2, las = 1, line = 2, at = -0.3, cex = 1.4)
# text(1:(ncol(matind)) - 0.5, -0.3, pi.e, cex = 1.4)
# text(1:(ncol(matind)) - 0.5, -0.75, c("Temp", "Sun", "Heat", "Rain"), cex = 1.4)
# 
# matinds <- rbind(YT1 = ind.BCa.bordeauxYT1s, YT2 = ind.BCa.bordeauxYT2s, YT3 = ind.BCa.bordeauxYT3s, YT4 = ind.BCa.bordeauxYT4s)
# pi.es <- weighted_significance(res.cv.modpls$CVMC, matinds)
# signpred(t(matinds), pred.lablength = 10, labsize = 0.5, plotsize = 12)
# mtext(expression(pi[e]), side = 2, las = 1, line = 2, at = -0.3, cex = 1.4)
# text(1:(ncol(matinds)) - 0.5, -0.3, pi.es, cex = 1.4)
# text(1:(ncol(matinds)) - 0.5, -0.75, c("Temp", "Sun", "Heat", "Rain"), cex = 1.4)

## ----hyptis-analysis, eval = run_examples && has_chemometrics-----------------
# data("hyptis", package = "chemometrics")
# yhyptis <- factor(hyptis$Group, ordered = TRUE)
# Xhyptis <- as.data.frame(hyptis[, 1:6])
# 
# modpls <- plsRglm(yhyptis, Xhyptis, 6, modele = "pls-glm-polr", pvals.expli = TRUE)
# modpls
# colSums(modpls$pvalstep)
# 
# set.seed(123)
# cv.modpls <- cv.plsRglm(object = yhyptis, dataX = Xhyptis, nt = 4, K = 5, NK = 100, modele = "pls-glm-polr")
# res.cv.modpls <- cvtable(summary(cv.modpls, MClassed = TRUE))
# plot(res.cv.modpls)
# 
# modpls2 <- plsRglm(yhyptis, Xhyptis, 3, modele = "pls-glm-polr")
# modpls2
# table(yhyptis, predict(modpls2$FinalModel, type = "class"))
# biplot(modpls2$tt, modpls2$pp)
# 
# modpls3 <- plsRglm(
#   yhyptis[-c(1, 11, 17, 22)],
#   Xhyptis[-c(1, 11, 17, 22), ],
#   3,
#   modele = "pls-glm-polr",
#   dataPredictY = Xhyptis[c(1, 11, 17, 22), ]
# )
# modpls3$ValsPredictY
# cbind(modpls3$ValsPredictYCat, yhyptis[c(1, 11, 17, 22)])
# 
# hyptis.bootYX3 <- bootplsglm(modpls2, typeboot = "plsmodel", R = 1000, strata = unclass(yhyptis), sim = "permutation")
# rownames(hyptis.bootYX3$t0) <- c("1|2\n", "2|3\n", "3|4\n", "Sabi\nnene", "Pin\nene", "Cine\nole", "Terpi\nnene", "Fenc\nhone", "Terpi\nnolene")
# boxplots.bootpls(hyptis.bootYX3, xaxisticks = FALSE, ranget0 = TRUE)
# plots.confints.bootpls(confints.bootpls(hyptis.bootYX3, typeBCa = FALSE), legendpos = "bottomleft", xaxisticks = FALSE)
# points(1:9, hyptis.bootYX3$t0, col = "red", pch = 19)
# 
# hyptis.bootYT3 <- bootplsglm(modpls2, R = 1000, strata = unclass(yhyptis), sim = "permutation")
# rownames(hyptis.bootYT3$t0) <- c("Sabi\nnene", "Pin\nene", "Cine\nole", "Terpi\nnene", "Fenc\nhone", "Terpi\nnolene")
# boxplots.bootpls(hyptis.bootYT3, xaxisticks = FALSE, ranget0 = TRUE)
# plots.confints.bootpls(confints.bootpls(hyptis.bootYT3, typeBCa = FALSE), legendpos = "topright", xaxisticks = FALSE)
# points(1:6, hyptis.bootYT3$t0, col = "red", pch = 19)

## ----rock-analysis, eval = run_examples---------------------------------------
# data(rock)
# 
# modpls <- plsRglm(
#   area ~ .,
#   data = rock,
#   nt = 6,
#   modele = "pls-glm-family",
#   family = poisson(),
#   pvals.expli = TRUE
# )
# modpls
# colSums(modpls$pvalstep)
# 
# modpls2 <- plsRglm(
#   area ~ .^2,
#   data = rock,
#   nt = 6,
#   modele = "pls-glm-family",
#   family = poisson(),
#   pvals.expli = TRUE
# )
# modpls2
# colSums(modpls2$pvalstep)
# 
# set.seed(123)
# cv.modpls2 <- cv.plsRglm(area ~ .^2, data = rock, nt = 6, modele = "pls-glm-poisson", K = 8, NK = 100)
# res.cv.modpls2 <- cvtable(summary(cv.modpls2))
# plot(res.cv.modpls2, type = "CVPreChi2")
# 
# modpls3 <- plsRglm(area ~ .^2, data = rock, nt = 3, modele = "pls-glm-poisson")
# 
# rock.bootYX3 <- bootplsglm(modpls3, typeboot = "plsmodel", R = 1000, sim = "antithetic")
# rownames(rock.bootYX3$t0) <- c("Intercept\n", "peri\n", "shape\n", "perm\n", "peri.\nshape", "peri.\nperm", "shape.\nperm")
# boxplots.bootpls(rock.bootYX3, indice = 2:7, xaxisticks = FALSE)
# plots.confints.bootpls(confints.bootpls(rock.bootYX3), legendpos = "topright", xaxisticks = FALSE)
# 
# rock.bootYT3 <- bootplsglm(modpls3, R = 1000, stabvalue = 1e10, sim = "antithetic")
# rownames(rock.bootYT3$t0) <- c("peri\n", "shape\n", "perm\n", "peri.\nshape", "peri.\nperm", "shape.\nperm")
# boxplots.bootpls(rock.bootYT3, xaxisticks = FALSE, ranget0 = TRUE)
# plots.confints.bootpls(confints.bootpls(rock.bootYT3), legendpos = "topright", xaxisticks = FALSE)

## ----simulated-plsr, eval = run_examples--------------------------------------
# dimX <- 24
# Astar <- 2
# 
# simul_data_UniYX(dimX, Astar)
# dataAstar2 <- as.data.frame(t(replicate(250, simul_data_UniYX(dimX, Astar))))
# 
# modpls2 <- plsR(Y ~ ., data = dataAstar2, 10, typeVC = "standard")
# modpls2
# 
# set.seed(123)
# cv.modpls2 <- cv.plsR(Y ~ ., data = dataAstar2, nt = 10, K = 10, NK = 100)
# res.cv.modpls2 <- cvtable(summary(cv.modpls2))
# plot(res.cv.modpls2)

## ----simulated-logistic-continuous, eval = run_examples-----------------------
# ydataAstar2 <- dataAstar2[, 1]
# XdataAstar2 <- dataAstar2[, 2:(dimX + 1)]
# ysimbin1 <- dicho(ydataAstar2)
# 
# res <- plsR(ysimbin1, XdataAstar2, 10, typeVC = "standard", MClassed = TRUE)
# res$MissClassed
# res
# 
# res$Probs
# res$Probs.trc

## ----simulated-logistic-dichotomous, eval = run_examples----------------------
# bindataAstar2 <- as.data.frame(dicho(dataAstar2))
# resdicho <- plsR(Y ~ ., data = bindataAstar2, 10, typeVC = "standard", MClassed = TRUE)
# 
# resdicho$MissClassed
# resdicho
# 
# resdicho$Probs
# resdicho$Probs.trc

## ----validation-cornell, eval = run_examples----------------------------------
# data(Cornell)
# XCornell <- Cornell[, 1:7]
# yCornell <- Cornell[, 8]
# 
# modpls <- plsR(yCornell, XCornell, 3)
# modpls
# modpls$uscores
# modpls$pp
# modpls$Coeffs
# 
# modpls2 <- plsR(yCornell, XCornell, 4, typeVC = "standard")
# modpls2$press.ind
# modpls2$press.tot
# modpls2$InfCrit

## ----validation-bordeaux, eval = run_examples---------------------------------
# set.seed(12345)
# data(bordeaux)
# Xbordeaux <- bordeaux[, 1:4]
# ybordeaux <- factor(bordeaux$Quality, ordered = TRUE)
# 
# modpls <- plsRglm(ybordeaux, Xbordeaux, 4, modele = "pls-glm-polr")
# modpls
# 
# XbordeauxNA <- Xbordeaux
# XbordeauxNA[1, 1] <- NA
# modplsNA <- plsRglm(ybordeaux, XbordeauxNA, 10, modele = "pls-glm-polr")
# modplsNA

## ----export-latex, eval = run_examples && has_xtable--------------------------
# CVresults1 <- summary(cv.modpls.logit, MClassed = TRUE)
# 
# resCVtab1 <- print(
#   xtable::xtable(
#     CVresults1[[1]][, c(1:6)],
#     digits = c(0, 1, 1, 0, 0, -1, 4),
#     caption = "Cross-validation results, $k=8$, part one"
#   )
# )
# 
# resCVtab2 <- print(
#   xtable::xtable(
#     CVresults1[[1]][, c(7:11)],
#     digits = c(0, -1, -1, 1, 1, 3),
#     caption = "Cross-validation results, $k=8$, part two"
#   )
# )
# 
# resCVtab1
# resCVtab2

## ----session-information------------------------------------------------------
sessionInfo()

