Surveiller la progression/Imprimer sur la console à partir de purrr :: invoke_map()

Question

J'essaye de former plusieurs modèles caret à partir d'un format de colonne de liste dans R (voir: this blog post) en utilisant purrr::invoke_map().

Lorsque j'appelle invoke_map(), j'aimerais pouvoir suivre la progression d'une manière ou d'une autre. Spécifiquement, je voudrais imprimer le numéro de ligne, ou la colonne id en tant que invoke_map() itère à travers les combinaisons modèle/données. Y at-il un moyen de le faire, éventuellement en modifiant la fonction d'entraînement (linearRegModel() ci-dessous)?

library(tidyverse) 
library(mlbench) 
library(caret) 
data("BostonHousing") # from mlbench 


starter_df <- 
    list(BostonHousing) %>% 
    rep(3) %>% 
    enframe(name = 'id', value = 'rawdata') %>% 
    transmute(
    id 
    , train.X = map(rawdata, ~ .x %>% select(-medv)) 
    , train.Y = map(rawdata, ~ .x$medv) 
) 



# re-write any caret training method as a function. 
# using linear regression here for simplicity 
linearRegModel <- function(X, Y) { 
ctrl <- trainControl(
    method = "repeatedcv", 
    number = 2 
) 
    train(
    x = X, 
    y = Y, 
    method = 'lm', 
    trControl = ctrl, 
    preProc = c('center', 'scale') 
) 
} 


# convert models to tibble 
model_list <- 
    list(linearRegModel = linearRegModel, 
     linearRegModel2 = linearRegModel) %>% 
    enframe(name = 'modelName',value = 'model') 

# combine model tibble with the data tibble 
train_df <- 
    starter_df[rep(1:nrow(starter_df),nrow(model_list)),] %>% 
    bind_cols(
    model_list[rep(1:nrow(model_list),nrow(starter_df)),] %>% arrange(modelName) 
) %>% 
    mutate(id=1:nrow(.)) 

train_df 



# A tibble: 6 x 5 
    id     train.X  train.Y  modelName model 
    <int>     <list>  <list>   <chr> <list> 
1  1 <data.frame [506 x 13]> <dbl [506]> linearRegModel <fun> 
2  2 <data.frame [506 x 13]> <dbl [506]> linearRegModel <fun> 
3  3 <data.frame [506 x 13]> <dbl [506]> linearRegModel <fun> 
4  4 <data.frame [506 x 13]> <dbl [506]> linearRegModel2 <fun> 
5  5 <data.frame [506 x 13]> <dbl [506]> linearRegModel2 <fun> 
6  6 <data.frame [506 x 13]> <dbl [506]> linearRegModel2 <fun> 


# train models by calling invoke_map() 
# (takes a few seconds) 
data_with_model_fits <- 
    train_df %>% 
    mutate(params = map2(train.X, train.Y, ~ list(X = .x, Y = .y)), 
     modelFits = invoke_map(model,params) 
) 

Answer 1

Le package progress peut vous intéresser. Ci-dessous, je l'ai intégré dans votre problème. Notez deux choses:

• INITIALISATION la barre de progression avant de commencer à adapter les modèles avec progress::progress_bar(tick = number_of_ticks). A l'intérieur de la fonction linRegModel(), vous "cocher" la barre de progression vers l'avant après que le modèle a été ajusté avec pb$tick().

pb est une des techniques orientées, de sorte que vous n'avez pas l'objet R6 en utilisant l'objet de passer dans votre fonction linRegModel() comme argument.

Espérons que ça aide.

library(tidyverse) 
library(mlbench) 
library(caret) 

data("BostonHousing") # from mlbench 

library(progress) 

starter_df <- 
    list(BostonHousing) %>% 
    rep(3) %>% 
    enframe(name = 'id', value = 'rawdata') %>% 
    transmute(
     id 
     , train.X = map(rawdata, ~ .x %>% select(-medv)) 
     , train.Y = map(rawdata, ~ .x$medv) 
    ) 



# re-write any caret training method as a function. 
# using linear regression here for simplicity 
linearRegModel <- function(X, Y) { 
    ctrl <- trainControl(
     method = "repeatedcv", 
     number = 2 
    ) 
    train(
     x = X, 
     y = Y, 
     method = 'lm', 
     trControl = ctrl, 
     preProc = c('center', 'scale') 
    ) 

    # Tick the progress bar forward 1 tick after each completed model fit 
    pb$tick() 
} 


# convert models to tibble 
model_list <- 
    list(linearRegModel = linearRegModel, 
     linearRegModel2 = linearRegModel) %>% 
    enframe(name = 'modelName',value = 'model') 

# combine model tibble with the data tibble 
train_df <- 
    starter_df[rep(1:nrow(starter_df),nrow(model_list)),] %>% 
    bind_cols(
     model_list[rep(1:nrow(model_list),nrow(starter_df)),] %>% arrange(modelName) 
    ) %>% 
    mutate(id=1:nrow(.)) 

train_df 


# initialize progress bar 
ticks <- nrow(train_df) 
pb <- progress::progress_bar$new(total = ticks) 

# train models by calling invoke_map() 
# (takes a few seconds) 
data_with_model_fits <- 
train_df %>% 
mutate(params = map2(train.X, train.Y, ~ list(X = .x, Y = .y)), 
     modelFits = invoke_map(model,params) 
) 

Pour plus de flexibilité, vous pouvez utiliser un token par l'argument format lors de la création de la barre de progression. Quelques-uns sont intégrés, comme :current pour vous montrer l'itération en cours. Cela pourrait répondre plus directement à votre question. J'appellerais pb$tick() avant que le modèle fonctionne dans ce cas. La documentation conseille également d'exécuter pb$tick(0) avant un calcul de longue durée pour afficher immédiatement la barre de progression.

# initialize progress bar 
pb <- progress::progress_bar$new(format = "running model :current", show_after = .01) 
pb$tick(0)