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

set.seed(123)
library(plsRglm)

## ----linear-pls---------------------------------------------------------------
data(Cornell)
XCornell <- Cornell[, 1:7]
yCornell <- Cornell$Y

pls_fit_matrix <- plsR(yCornell, XCornell, nt = 3, verbose = FALSE)
pls_fit_formula <- plsR(Y ~ ., data = Cornell, nt = 3, pvals.expli = TRUE, verbose = FALSE)

pls_fit_formula$InfCrit
coef(pls_fit_formula)

## ----glm-fits-----------------------------------------------------------------
data(aze_compl)
logit_fit <- plsRglm(y ~ ., data = aze_compl, nt = 3, modele = "pls-glm-logistic", verbose = FALSE)

logit_fit$InfCrit
head(predict(logit_fit, type = "response"))

family_fit <- plsRglm(
  Y ~ .,
  data = Cornell,
  nt = 2,
  modele = "pls-glm-family",
  family = gaussian(link = "log"),
  verbose = FALSE
)

family_fit$family$family
family_fit$family$link

## ----supported-modes, eval = FALSE--------------------------------------------
# plsRglm(Y ~ ., data = Cornell, nt = 3, modele = "pls")
# plsRglm(Y ~ ., data = Cornell, nt = 3, modele = "pls-glm-gaussian")
# plsRglm(Y ~ ., data = Cornell, nt = 3, modele = "pls-glm-inverse.gaussian")
# plsRglm(y ~ ., data = aze_compl, nt = 3, modele = "pls-glm-logistic")
# data(pine)
# plsRglm(round(x11) ~ ., data = pine, nt = 3, modele = "pls-glm-poisson")
# plsRglm(x11 ~ ., data = pine, nt = 3, modele = "pls-glm-Gamma")
# plsRglm(Quality ~ ., data = bordeaux, nt = 2, modele = "pls-glm-polr")
# plsRglm(
#   Y ~ .,
#   data = Cornell,
#   nt = 3,
#   modele = "pls-glm-family",
#   family = gaussian(link = "log")
# )

## ----polr-fit-----------------------------------------------------------------
data(bordeaux)
bordeaux$Quality <- factor(bordeaux$Quality, ordered = TRUE)
polr_fit <- plsRglm(Quality ~ ., data = bordeaux, nt = 2, modele = "pls-glm-polr", verbose = FALSE)

head(predict(polr_fit, type = "class"))

## ----linear-cv----------------------------------------------------------------
cv_pls <- cv.plsR(Y ~ ., data = Cornell, nt = 3, K = 4, NK = 2, verbose = FALSE)
cv_pls_summary <- cvtable(summary(cv_pls))

cv_pls_summary
plot(cv_pls_summary)

## ----glm-cv-------------------------------------------------------------------
cv_logit <- cv.plsRglm(
  y ~ .,
  data = aze_compl,
  nt = 3,
  K = 4,
  NK = 2,
  modele = "pls-glm-logistic",
  verbose = FALSE
)
cv_logit_summary <- cvtable(summary(cv_logit, MClassed = TRUE))

cv_logit_summary
plot(cv_logit_summary)

## ----prediction-missing-------------------------------------------------------
data(pine)
data(pine_sup)
data(pineNAX21)

pred_fit <- plsRglm(
  x11 ~ .,
  data = pine,
  nt = 3,
  modele = "pls-glm-family",
  family = gaussian(),
  verbose = FALSE
)

pine_sup_small <- pine_sup[1:3, 1:10]
pine_sup_small[1, 1] <- NA

predict(pred_fit, newdata = pine_sup_small, type = "response", methodNA = "missingdata")
predict(pred_fit, newdata = pine_sup_small, type = "scores", methodNA = "missingdata")

missing_train_fit <- plsR(x11 ~ ., data = pineNAX21, nt = 3, verbose = FALSE)
missing_train_fit$na.miss.X

## ----bootstrap----------------------------------------------------------------
boot_pls <- bootpls(pls_fit_formula, R = 20, verbose = FALSE)
dim(boot_pls$t)
confints.bootpls(boot_pls, indices = 2:4, typeBCa = FALSE)

boot_logit <- bootplsglm(logit_fit, R = 20, verbose = FALSE)
dim(boot_logit$t)
confints.bootpls(boot_logit, indices = 1:4, typeBCa = FALSE)

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

