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)) 163.4646 164.5139 188.2996
##    median       uq      max neval
##  169.5455 179.8084 290.8857    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)) 158 159  169    165 169 208
##                                   leave_one_out2() 201 206  216    208 222 265
##  neval cld
##     10  a 
##     10   b

stopCluster(cl2)