Leave one out

Packages utiles

library("parallel")
library("foreach")
library("microbenchmark")
library("tidyverse")

Contexte

Supposons que l’on souhaite estimer la qualité de prédiction d’un modèle linéaire, ici un modèle linéaire pour la régression de la largeur d’une pétale sur une longueur sur le jeu de données iris de R. On peut utiliser la technique du leave-one-out qui consiste à estimer l’erreur de généralisation : erreur observée pour des nouveaux individus qui viennent de la même distribution que les individus utilisés pour apprendre le modèle

Principe de la technique du leave-one-out

• estimation du modèle avec tous les individus sauf un,
• prédiction pour cet individu
• Calcul de l’erreur quadratique (Prediction sum of squares statistic) entre la prédiction et la valeur connue
• répéttition de l’opération pour chacun des individus
• sommation des erreurs obtenues

Implémentation

leave_one_out <- function(i) {
    model <- lm(Petal.Width ~ Petal.Length, data = iris[-i,])
    pred.petal.width <- predict(model, data.frame(Petal.Length = iris[i, "Petal.Length"]))
    return((pred.petal.width - iris[i, "Petal.Width"]) ^ 2)
}

Appelons la fonction pour 100 individus du jeu de données iris.

microbenchmark::microbenchmark(
    lapply(1:100, FUN = function(i)leave_one_out(i)),
    times = 10
)

## Unit: milliseconds
##                                               expr      min       lq     mean
##  lapply(1:100, FUN = function(i) leave_one_out(i)) 174.8284 182.0132 237.1855
##    median       uq      max neval
##  221.6049 239.4821 430.2745    10

Chaque appel de la fonction est indépendant. Proposons donc un test de la fonction par parrallèle.

leave_one_out2 <- function(){
    library("parallel")
 output <- foreach(i = 1:100) %dopar% {
      model <- lm(Petal.Width ~ Petal.Length, data = iris[-i,])
    pred.petal.width <- predict(model, data.frame(Petal.Length = iris[i, "Petal.Length"]))
    return((pred.petal.width - iris[i, "Petal.Width"]) ^ 2)
 }
   return(output)
 }

library(parallel)
cl <- detectCores()
cl2 <- makeCluster(cl - 1) # a adapter suivant le nombre de coeurs de ta machine
microbenchmark(lapply(1:100, FUN = function(i)leave_one_out(i)),leave_one_out2(), times = 10) %>% print(digits = 3)

## Warning: executing %dopar% sequentially: no parallel backend registered

## Unit: milliseconds
##                                               expr min  lq mean median  uq max
##  lapply(1:100, FUN = function(i) leave_one_out(i)) 166 169  189    175 178 286
##                                   leave_one_out2() 206 214  246    226 260 365
##  neval cld
##     10  a 
##     10   b

stopCluster(cl2)