10 Comparaison des différentes méthodes, étude de cas réels

Exercice 1 (Fonctions R)  

1. fonction sse_regbic :

   sse_regbic <- function(don, bloc, b, nvmax, method) {
       recherche <- regsubsets(maxO3~., int=T, nbest=1,data=don[bloc!=b, ],
                          nvmax=nvmax, method=method)
       resume <- summary(recherche)
       nomselec <- colnames(resume$which)[resume$which[which.min(resume$bic), ]][-1]
       formule <- formula(paste("maxO3 ~", paste(nomselec, collapse = "+")))
       m_reg <- lm(formule, data=don[bloc!=b, ])
       previsions <- predict(m_reg, don[bloc==b, ])
       return(sum((don[bloc==b,"maxO3"] - previsions)^2))
   }

2. fonction sse_glmnet :

   library(glmnet)
   sse_glmnet <- function(X, Y, bloc, b, a) {
       rech <- cv.glmnet(X[bloc!=b, ], Y[bloc!=b, drop=FALSE], alpha=a)
       prev <- predict(rech, newx=X[bloc==b, ], s=rech$lambda.min)
       return(sum((Y[bloc==b, "maxO3"] - as.vector(prev))^2))
   }

   On obtient les résultats du test de Wald sur la nullité des paramètres \(\beta_0,\beta_2\) et \(\beta_3\).

3. fonction sse_pls :

   sse_pls <- function(don, bloc, b, compmax) {
       rech <- plsr(maxO3~., data=don[bloc!=b, ], ncomp=compmax, validation="CV", scale=TRUE)
       ncomp <- which.min(MSEP(rech)$val["CV", , ])-1
       prev <- predict(rech, newdata=don[bloc==b, ], ncomp=ncomp)
       return(sum((don[bloc==b, "maxO3"] - as.vector(prev))^2))
   }

4. fonction sse_pls :

   sse_pcr <- function(don, bloc, b, compmax) {
       rech <- pcr(maxO3~., data=don[bloc!=b, ],ncomp=compmax, validation="CV", scale=TRUE)
       ncomp <- which.min(MSEP(rech)$val["CV", , ])-1
       prev <- predict(rech, newdata=don[bloc==b, ], ncomp=ncomp)
       return(sum((don[bloc==b, "maxO3"] - as.vector(prev))^2))
   }