(I've used the tidyverse tag because my question somewhat broadly asks for the 'tidy' approach to a problem)
I am attempting to build a structure for training and evaluating various models.
In the past I have used the caret packages resamples() function where you pass a list of models to evaluate and caret::resamples() outputs the name of each model and it's evaluation based.
This time I am using rsample package and am instead iterating over tibbles with k folds.
I would like to crate a function similar to resamples() that outputs the evaluation metrics for each model. Here's my code and what I have tried:
library(rsample)
library(Metrics)
library(xgboost)
# 5 fold split stratified on spender
train_cv <- vfold_cv(diamonds, 5) %>%
# create training and validation sets within each fold
mutate(train = map(splits, ~training(.x)),
validate = map(splits, ~testing(.x)))
# ranger random forrest across each fold
mod.rf <- train_cv %>%
mutate(regression = map(train, ~ranger::ranger(formula = price ~ carat, data = .x))) %>% # fit the model
mutate(predictions = map2(.x = regression, .y = validate, ~predict(.x, .y)$predictions)) %>% # predictions
mutate(validation_actuals = map(validate, ~.x$carat)) %>% # get the actuals for computing evaluation metrics
mutate(mae = map2_dbl(.x = validation_actuals, .y = predictions, ~Metrics::mae(actual = .x, predicted = .y))) %>% # mae
mutate(rmse = map2_dbl(.x = validation_actuals, .y = predictions, ~Metrics::rmse(actual = .x, predicted = .y))) # rmse
# xgb across each fold
mod.xgb <- train_cv %>%
# convert regression data to a dmatrix for xgb. Just simple price ~ carat for here and now
mutate(train_dmatrix = map(train, ~xgb.DMatrix(.x %>% select(carat) %>% as.matrix(), label = .x$price)),
validate_dmatrix = map(validate, ~xgb.DMatrix(.x %>% select(carat) %>% as.matrix(), label = .x$price))) %>%
mutate(regression = map(train_dmatrix, ~xgboost(.x, objective = "reg:squarederror", nrounds = 100))) %>% # fit the model
mutate(predictions =map2(.x = regression, .y = validate_dmatrix, ~predict(.x, .y))) %>% # predictions
mutate(validation_actuals = map(validate, ~.x$carat)) %>% # get the actuals for computing evaluation metrics
mutate(mae = map2_dbl(.x = validation_actuals, .y = predictions, ~Metrics::mae(actual = .x, predicted = .y))) %>% # mae
mutate(rmse = map2_dbl(.x = validation_actuals, .y = predictions, ~Metrics::rmse(actual = .x, predicted = .y))) # rmse
The random forrest: mod.rf
# 5-fold cross-validation
# A tibble: 5 x 9
splits id train validate regression predictions validation_actuals mae rmse
* <named list> <chr> <named list> <named list> <named list> <named list> <named list> <dbl> <dbl>
1 <split [43.2K/10.8K]> Fold1 <tibble [43,152 × 10]> <tibble [10,788 × 10]> <ranger> <dbl [10,788]> <dbl [10,788]> 3867. 5318.
2 <split [43.2K/10.8K]> Fold2 <tibble [43,152 × 10]> <tibble [10,788 × 10]> <ranger> <dbl [10,788]> <dbl [10,788]> 3916. 5414.
3 <split [43.2K/10.8K]> Fold3 <tibble [43,152 × 10]> <tibble [10,788 × 10]> <ranger> <dbl [10,788]> <dbl [10,788]> 3946. 5448.
4 <split [43.2K/10.8K]> Fold4 <tibble [43,152 × 10]> <tibble [10,788 × 10]> <ranger> <dbl [10,788]> <dbl [10,788]> 3996. 5514.
5 <split [43.2K/10.8K]> Fold5 <tibble [43,152 × 10]> <tibble [10,788 × 10]> <ranger> <dbl [10,788]> <dbl [10,788]> 3936. 5414.
And the XGBoost:
mod.xgb
# 5-fold cross-validation
# A tibble: 5 x 11
splits id train validate train_dmatrix validate_dmatrix regression predictions validation_actuals mae rmse
* <named list> <chr> <named list> <named list> <named list> <named list> <named list> <named list> <named list> <dbl> <dbl>
1 <split [43.2K/10.8K]> Fold1 <tibble [43,152 × 10]> <tibble [10,788 × 10]> <xgb.DMtr> <xgb.DMtr> <xgb.Bstr> <dbl [10,788]> <dbl [10,788]> 3868. 5319.
2 <split [43.2K/10.8K]> Fold2 <tibble [43,152 × 10]> <tibble [10,788 × 10]> <xgb.DMtr> <xgb.DMtr> <xgb.Bstr> <dbl [10,788]> <dbl [10,788]> 3916. 5414.
3 <split [43.2K/10.8K]> Fold3 <tibble [43,152 × 10]> <tibble [10,788 × 10]> <xgb.DMtr> <xgb.DMtr> <xgb.Bstr> <dbl [10,788]> <dbl [10,788]> 3945. 5447.
4 <split [43.2K/10.8K]> Fold4 <tibble [43,152 × 10]> <tibble [10,788 × 10]> <xgb.DMtr> <xgb.DMtr> <xgb.Bstr> <dbl [10,788]> <dbl [10,788]> 3995. 5511.
5 <split [43.2K/10.8K]> Fold5 <tibble [43,152 × 10]> <tibble [10,788 × 10]> <xgb.DMtr> <xgb.DMtr> <xgb.Bstr> <dbl [10,788]> <dbl [10,788]> 3935. 5413.
Now, if I want to know rmse or mae for each model I can just take the mean:
> mod.rf$mae %>% mean()
[1] 3932.181
> mod.rf$rmse %>% mean()
[1] 5421.681
> mod.xgb$mae %>% mean()
[1] 3931.967
> mod.xgb$rmse %>% mean()
[1] 5421.148
But, suppose that I have many models and I would list to pass a list or vector of model names where these models have the same structure as above, how can I return a e.g. data frame showing the model name along with the mean mae and rmse?
Tried so far:
model_list <- list(
mod.rf,
mod.xgb
)
purrr::imap(model_list, ~mean(.x$mae))
purrr::imap(model_list, ~mean(.x$rmse))
Which gives:
purrr::imap(model_list, ~mean(.x$mae))
[[1]]
[1] 3932.181
[[2]]
[1] 3931.967
> purrr::imap(model_list, ~mean(.x$rmse))
[[1]]
[1] 5421.681
[[2]]
[1] 5421.148
But what I'd like is something of the format (Supposed to look like a table but I've used bars | to separate columns):
model_name | mae | rmse
mod.rf | 3932.181 | 5421.681
mod.xgb | 3931.967 | 5421.148
I was looking at purrr::imap since I think it can output the name of the iteratd component as .y. From a saved code snippet from a while back:
imap(pr_curves_data, ~write.csv(x = .x,file = paste0(.y, ".csv"), row.names = F))
this would write a number of csv files where the name of each csv file was the name of the input variable being iterated over, in my current working example the equivalent would be 'mod.rf' and 'mod.xgb'.
What is the 'tidy' way of comparing the output of multiple models side by side?
Note I did not train xgb and rf within the same map() code block because in my actual code, there are many models with their own nuances (e.g. xgb with DMatrix), rf with mtry etc etc. So each model just shares the same folds train_cv.
