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)) 185.4462 193.1641 214.1645
##   median       uq      max neval
##  201.862 231.1189 278.0691    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)) 185 189  231    203 232 376
##                                   leave_one_out2() 219 237  271    243 252 507
##  neval cld
##     10   a
##     10   a

stopCluster(cl2)