El dataset corresponde a Boston, que se encuentra disponible en Kaggle; una plataforma de competencia de machine learning. Más info en: https://www.cs.toronto.edu/~delve/data/boston/bostonDetail.html
#si no tengo instalado la libreria, la instalo
#install.packages(tidymodels)
library(tidymodels)
library(tidyverse)
library(magrittr)
library(corrr)
library(MASS) #el dataset se encuentra en esta librería
data(Boston)
En primera instancia dividimos en TRAIN Y TEST
set.seed(1234)
p_split <- Boston %>%
initial_split(prop = 0.75)
p_train <- training(p_split)
p_test <- testing(p_split)
glimpse(p_train)
## Rows: 379
## Columns: 14
## $ crim <dbl> 0.01501, 0.03961, 67.92080, 0.14866, 0.10574, 0.10793, 11.5779…
## $ zn <dbl> 90, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20, …
## $ indus <dbl> 1.21, 5.19, 18.10, 8.56, 27.74, 8.56, 18.10, 21.89, 18.10, 18.…
## $ chas <int> 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,…
## $ nox <dbl> 0.401, 0.515, 0.693, 0.520, 0.609, 0.520, 0.700, 0.624, 0.718,…
## $ rm <dbl> 7.923, 6.037, 5.683, 6.727, 5.983, 6.195, 5.036, 6.372, 6.006,…
## $ age <dbl> 24.8, 34.5, 100.0, 79.9, 98.8, 54.4, 97.0, 97.9, 95.3, 77.8, 8…
## $ dis <dbl> 5.8850, 5.9853, 1.4254, 2.7778, 1.8681, 2.7778, 1.7700, 2.3274…
## $ rad <int> 1, 5, 24, 5, 4, 5, 24, 4, 24, 24, 24, 2, 5, 4, 2, 5, 5, 24, 24…
## $ tax <dbl> 198, 224, 666, 384, 711, 384, 666, 437, 666, 666, 666, 276, 38…
## $ ptratio <dbl> 13.6, 20.2, 20.2, 20.9, 20.1, 20.9, 20.2, 21.2, 20.2, 20.2, 20…
## $ black <dbl> 395.52, 396.90, 384.97, 394.76, 390.11, 393.49, 396.90, 385.76…
## $ lstat <dbl> 3.16, 8.01, 22.98, 9.42, 18.07, 13.00, 25.68, 11.12, 15.70, 29…
## $ medv <dbl> 50.0, 21.1, 5.0, 27.5, 13.6, 21.7, 9.7, 23.0, 14.2, 6.3, 7.4, …
p_split
## <Analysis/Assess/Total>
## <379/127/506>
head(p_test)
## crim zn indus chas nox rm age dis rad tax ptratio black
## 1 0.00632 18.0 2.31 0 0.538 6.575 65.2 4.0900 1 296 15.3 396.90
## 5 0.06905 0.0 2.18 0 0.458 7.147 54.2 6.0622 3 222 18.7 396.90
## 7 0.08829 12.5 7.87 0 0.524 6.012 66.6 5.5605 5 311 15.2 395.60
## 8 0.14455 12.5 7.87 0 0.524 6.172 96.1 5.9505 5 311 15.2 396.90
## 9 0.21124 12.5 7.87 0 0.524 5.631 100.0 6.0821 5 311 15.2 386.63
## 11 0.22489 12.5 7.87 0 0.524 6.377 94.3 6.3467 5 311 15.2 392.52
## lstat medv
## 1 4.98 24.0
## 5 5.33 36.2
## 7 12.43 22.9
## 8 19.15 27.1
## 9 29.93 16.5
## 11 20.45 15.0
p_folds <- vfold_cv(p_train, v=3)
Veo los splits creados en la validación cruzada
p_folds$splits
## [[1]]
## <Analysis/Assess/Total>
## <252/127/379>
##
## [[2]]
## <Analysis/Assess/Total>
## <253/126/379>
##
## [[3]]
## <Analysis/Assess/Total>
## <253/126/379>
recipe_dt <- p_train %>%
recipe(medv~.) %>%
step_corr(all_predictors()) %>% #elimino las correlaciones
step_center(all_predictors(), -all_outcomes()) %>% #centrado
step_scale(all_predictors(), -all_outcomes()) %>% #escalado
prep()
Aca vamos a especificar las variables que vamos a hacer tunning de estas variables.
tree_spec <- decision_tree(
cost_complexity = tune(),
tree_depth = tune(),
min_n = tune()
) %>%
set_engine("rpart") %>%
set_mode("regression")
tree_spec
## Decision Tree Model Specification (regression)
##
## Main Arguments:
## cost_complexity = tune()
## tree_depth = tune()
## min_n = tune()
##
## Computational engine: rpart
Veamos los posibles valores en esta grilla.
tree_grid <- grid_regular(cost_complexity(), tree_depth(), min_n(), levels = 4)
tree_grid
## # A tibble: 64 × 3
## cost_complexity tree_depth min_n
## <dbl> <int> <int>
## 1 0.0000000001 1 2
## 2 0.0000001 1 2
## 3 0.0001 1 2
## 4 0.1 1 2
## 5 0.0000000001 5 2
## 6 0.0000001 5 2
## 7 0.0001 5 2
## 8 0.1 5 2
## 9 0.0000000001 10 2
## 10 0.0000001 10 2
## # … with 54 more rows
En esta etapa vamos a hacer el tuneo de los hiperparámetros que hemos definido anteriormente. Vamos a consignar las métricas de regresión usuales.
Importante: Los datos son los folds de la validación cruzada.
doParallel::registerDoParallel() #paralelizamos los cálculos
set.seed(345)
tree_rs <- tune_grid(
tree_spec,
medv ~ .,
resamples = p_folds,
grid = tree_grid,
metrics = metric_set(rmse, rsq, mae)
)
tree_rs
## # Tuning results
## # 3-fold cross-validation
## # A tibble: 3 × 4
## splits id .metrics .notes
## <list> <chr> <list> <list>
## 1 <split [252/127]> Fold1 <tibble [192 × 7]> <tibble [0 × 1]>
## 2 <split [253/126]> Fold2 <tibble [192 × 7]> <tibble [0 × 1]>
## 3 <split [253/126]> Fold3 <tibble [192 × 7]> <tibble [0 × 1]>
collect_metrics(tree_rs)
## # A tibble: 192 × 9
## cost_complexity tree_depth min_n .metric .estimator mean n std_err
## <dbl> <int> <int> <chr> <chr> <dbl> <int> <dbl>
## 1 0.0000000001 1 2 mae standard 5.44 3 0.276
## 2 0.0000000001 1 2 rmse standard 7.23 3 0.277
## 3 0.0000000001 1 2 rsq standard 0.395 3 0.0420
## 4 0.0000001 1 2 mae standard 5.44 3 0.276
## 5 0.0000001 1 2 rmse standard 7.23 3 0.277
## 6 0.0000001 1 2 rsq standard 0.395 3 0.0420
## 7 0.0001 1 2 mae standard 5.44 3 0.276
## 8 0.0001 1 2 rmse standard 7.23 3 0.277
## 9 0.0001 1 2 rsq standard 0.395 3 0.0420
## 10 0.1 1 2 mae standard 5.44 3 0.276
## # … with 182 more rows, and 1 more variable: .config <fct>
tree_rs %>%
collect_metrics(summarize=FALSE)
## # A tibble: 576 × 8
## id cost_complexity tree_depth min_n .metric .estimator .estimate .config
## <chr> <dbl> <int> <int> <chr> <chr> <dbl> <fct>
## 1 Fold1 0.0000000001 1 2 rmse standard 6.85 Preproce…
## 2 Fold1 0.0000000001 1 2 rsq standard 0.328 Preproce…
## 3 Fold1 0.0000000001 1 2 mae standard 4.94 Preproce…
## 4 Fold2 0.0000000001 1 2 rmse standard 7.07 Preproce…
## 5 Fold2 0.0000000001 1 2 rsq standard 0.472 Preproce…
## 6 Fold2 0.0000000001 1 2 mae standard 5.51 Preproce…
## 7 Fold3 0.0000000001 1 2 rmse standard 7.77 Preproce…
## 8 Fold3 0.0000000001 1 2 rsq standard 0.386 Preproce…
## 9 Fold3 0.0000000001 1 2 mae standard 5.89 Preproce…
## 10 Fold1 0.0000001 1 2 rmse standard 6.85 Preproce…
## # … with 566 more rows
Vamos a plotear los 3 hiperparámetros q hicimos tunning, lo hacemos mediante la función autoplot() disponible en tidymodels.
autoplot(tree_rs)
show_best(tree_rs)
## Warning: No value of `metric` was given; metric 'rmse' will be used.
## # A tibble: 5 × 9
## cost_complexity tree_depth min_n .metric .estimator mean n std_err
## <dbl> <int> <int> <chr> <chr> <dbl> <int> <dbl>
## 1 0.0000000001 10 14 rmse standard 4.43 3 0.337
## 2 0.0000001 10 14 rmse standard 4.43 3 0.337
## 3 0.0001 10 14 rmse standard 4.43 3 0.337
## 4 0.0000000001 15 14 rmse standard 4.43 3 0.337
## 5 0.0000001 15 14 rmse standard 4.43 3 0.337
## # … with 1 more variable: .config <fct>
En esta etapa finalizamos el modelo, con el mejor valor de rsme obtenido, vamos a elegir este modelo.
final_tree <- finalize_model(tree_spec, select_best(tree_rs, "rmse"))
final_tree
## Decision Tree Model Specification (regression)
##
## Main Arguments:
## cost_complexity = 1e-10
## tree_depth = 10
## min_n = 14
##
## Computational engine: rpart
Mediante la función last_fit() de tidymodels, lo que hacemos es tomar el mejor modelo que fue ajustado anteriormente y devolver los resultados en TEST.
final_rs <- last_fit(final_tree, medv ~ ., p_split)
final_rs
## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [379/127]> train/test split <tibble [… <tibble… <tibble [127… <workflo…
final_rs %>%
collect_metrics()
## # A tibble: 2 × 4
## .metric .estimator .estimate .config
## <chr> <chr> <dbl> <fct>
## 1 rmse standard 4.80 Preprocessor1_Model1
## 2 rsq standard 0.718 Preprocessor1_Model1
Podemos ver las predicciones del modelo en TEST mediante la función collect_predictions().
final_rs %>%
collect_predictions()
## # A tibble: 127 × 5
## id .pred .row medv .config
## <chr> <dbl> <int> <dbl> <fct>
## 1 train/test split 30.8 1 24 Preprocessor1_Model1
## 2 train/test split 35.4 5 36.2 Preprocessor1_Model1
## 3 train/test split 19.9 7 22.9 Preprocessor1_Model1
## 4 train/test split 17.4 8 27.1 Preprocessor1_Model1
## 5 train/test split 17.4 9 16.5 Preprocessor1_Model1
## 6 train/test split 17.4 11 15 Preprocessor1_Model1
## 7 train/test split 14.3 23 15.2 Preprocessor1_Model1
## 8 train/test split 14.3 25 15.6 Preprocessor1_Model1
## 9 train/test split 14.3 27 16.6 Preprocessor1_Model1
## 10 train/test split 19.8 32 14.5 Preprocessor1_Model1
## # … with 117 more rows
collect_predictions(final_rs) %>%
ggplot(aes(medv, .pred)) +
geom_abline(lty = 2, color = "gray50") +
geom_point(alpha = 0.5, color = "midnightblue") +
coord_fixed()