library(tidyverse)
library(mosaicData)
library(kableExtra)
data("RailTrail")Tema 08. Ejemplo 1
Introducción
Datos
Usaremos el conjunto de datos RailTrail, que ya usamos previamente, sobre el volumen de usuarios de un camino ciclista (“via verde”).
Análisis exploratorio de los datos
Aquí NO vamos a desarrollar explícitamente el análisis exploratorio de datos. Pero siempre debemos conocer las características de nuestros datos, incluidas la distribución de valores de las variables y las relaciones entre ellas. Además, deberíamos haber realizado un proceso de limpieza y transformación de los datos, en parte sugerido por este análisis exploratorio.
En este caso, convertimos las variables categóricas a factores y eliminamos las variables redundantes.
railtrail <- RailTrail %>%
mutate(dayType = parse_factor(dayType)) %>%
select(-c(weekday, lowtemp, avgtemp))
rm(RailTrail)Modelización I
Paso 0: Partición en Entrenamiento y Prueba
Partición en Entrenamiento y Prueba
- Usamos
initial_split()para generar el objeto que almacena las dos particiones
library(tidymodels)
set.seed(9753)
railtrailPart <- railtrail %>%
initial_split(prop = .8)- Podríamos extraer los data frame con cada conjunto de datos, de entrenamiento y de prueba. Pero esto no es necesario porque siempre podemos llamar a las funciones
training()ytesting().
railtrailEntren <- railtrailPart %>% training()
railtrailPrueba <- railtrailPart %>% testing()Paso 1: Preparar los datos y Especificación
En principio, consideraremos la siguiente especificación, es decir, variables incluidas en el modelo. Dado lo que hemos discutido anteriormente (que habríamos visto en el análisis exploratorio de datos), incluimos un polinomio para temperatura, una relación no lineal con la nubosidad e interacciones entre todas las variables continuas y el tipo de día de la semana.
\[ \begin{aligned} volumen &= \beta_0 + \beta_1 hightemp + \beta_2 hightemp^2 + \dots + \beta_{21} hightemp^{21} \\ & + \beta_{22} D_{cloudclover \in (2.5,5]}+\beta_{23} D_{cloudclover \in (5,7.5]}+\beta_{24} D_{cloudclover \in (7.5,10]} \\ &+ \beta_{25} precip + \beta_{26} dayType + \beta_{27} precip \times dayType + u \end{aligned} \]
Esta especificación se corresponde con la siguiente receta:
receta1 <-railtrailPart %>% training() %>%
recipe(volume ~ hightemp + cloudcover + precip + dayType) %>%
step_dummy(dayType) %>%
step_poly(hightemp, degree = 21) %>%
step_cut(cloudcover, breaks = c(0, 2.5, 5, 7.5, 10),
include_outside_range = T) %>%
step_dummy(cloudcover) %>%
step_interact(~precip:starts_with("dayType_"))Podemos ver cómo quedan los datos preprocesados para usarlos luego en el modelo de esta forma:
datosPrep <- receta1 %>% prep() %>% bake(railtrailEntren)
datosPrep %>% slice_head() %>% kbl() %>% kable_paper()| precip | volume | dayType_weekend | hightemp_poly_1 | hightemp_poly_2 | hightemp_poly_3 | hightemp_poly_4 | hightemp_poly_5 | hightemp_poly_6 | hightemp_poly_7 | hightemp_poly_8 | hightemp_poly_9 | hightemp_poly_10 | hightemp_poly_11 | hightemp_poly_12 | hightemp_poly_13 | hightemp_poly_14 | hightemp_poly_15 | hightemp_poly_16 | hightemp_poly_17 | hightemp_poly_18 | hightemp_poly_19 | hightemp_poly_20 | hightemp_poly_21 | cloudcover_X.2.5.5. | cloudcover_X.5.7.5. | cloudcover_X.7.5.max. | precip_x_dayType_weekend |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 0 | 287 | 0 | -0.2453388 | 0.3215624 | -0.2978088 | 0.2259474 | -0.1921686 | 0.1818106 | -0.1878811 | 0.1623743 | -0.1188715 | 0.0997763 | -0.1085769 | 0.096653 | -0.0650102 | 0.0357273 | -0.0184597 | 0.0074644 | -0.0030106 | 0.0012088 | -0.0005804 | 0.0002402 | -9.98e-05 | 0 | 0 | 0 | 0 |
Paso 2: Entrenamiento
Paso 2.A: Definición del modelo
Definimos un modelo lineal
modelo_lm1 <- linear_reg(mode= "regression", engine = "lm",
penalty = 0)Paso 2.B: Creación del flujo de trabajo
Creamos el flujo de trabajo combinando la receta y modelo
flujo_lm1 <- workflow() %>%
add_recipe(receta1) %>%
add_model(modelo_lm1)Paso 2.C: Estimación del flujo
- Estimamos el flujo
flujo_lm1_est <- flujo_lm1 %>%
fit(data = railtrailPart %>% training()) - Los resultados de esta estimación son:
flujo_lm1_est %>% extract_fit_parsnip() %>%
tidy() %>% kbl() %>% kable_paper()| term | estimate | std.error | statistic | p.value |
|---|---|---|---|---|
| (Intercept) | 398.3618778 | 30.45639 | 13.0797462 | 0.0000000 |
| precip | -101.8519213 | 44.22143 | -2.3032256 | 0.0260516 |
| dayType_weekend | 69.0130077 | 30.19285 | 2.2857404 | 0.0271425 |
| hightemp_poly_1 | 620.0779680 | 100.48002 | 6.1711570 | 0.0000002 |
| hightemp_poly_2 | -231.1870251 | 102.56389 | -2.2540781 | 0.0292222 |
| hightemp_poly_3 | -319.5934391 | 112.86361 | -2.8316785 | 0.0069576 |
| hightemp_poly_4 | 30.6658218 | 104.43119 | 0.2936462 | 0.7704090 |
| hightemp_poly_5 | 43.9761289 | 98.81637 | 0.4450288 | 0.6584807 |
| hightemp_poly_6 | 120.6375158 | 105.39037 | 1.1446730 | 0.2585333 |
| hightemp_poly_7 | 89.9817670 | 110.15218 | 0.8168860 | 0.4183947 |
| hightemp_poly_8 | 26.7967468 | 112.40311 | 0.2383986 | 0.8126787 |
| hightemp_poly_9 | 19.8361352 | 102.83515 | 0.1928926 | 0.8479307 |
| hightemp_poly_10 | -50.3726593 | 97.43376 | -0.5169939 | 0.6077496 |
| hightemp_poly_11 | 50.1886586 | 89.13451 | 0.5630665 | 0.5762478 |
| hightemp_poly_12 | 95.8849122 | 89.00669 | 1.0772775 | 0.2872274 |
| hightemp_poly_13 | 10.3773965 | 94.83236 | 0.1094289 | 0.9133599 |
| hightemp_poly_14 | 55.7038090 | 89.93601 | 0.6193716 | 0.5388657 |
| hightemp_poly_15 | 37.2235990 | 90.04709 | 0.4133793 | 0.6813366 |
| hightemp_poly_16 | 64.4296348 | 92.57077 | 0.6960041 | 0.4900866 |
| hightemp_poly_17 | -11.1127383 | 92.51757 | -0.1201149 | 0.9049389 |
| hightemp_poly_18 | -91.7282722 | 89.76033 | -1.0219244 | 0.3124027 |
| hightemp_poly_19 | -184.3159907 | 91.55332 | -2.0132092 | 0.0502353 |
| hightemp_poly_20 | 43.2073141 | 90.75385 | 0.4760934 | 0.6363634 |
| hightemp_poly_21 | -66.3777436 | 91.75642 | -0.7234125 | 0.4732550 |
| cloudcover_X.2.5.5. | 0.5148961 | 43.76892 | 0.0117640 | 0.9906671 |
| cloudcover_X.5.7.5. | -42.2736984 | 37.12645 | -1.1386411 | 0.2610146 |
| cloudcover_X.7.5.max. | -61.9777168 | 35.36681 | -1.7524261 | 0.0866671 |
| precip_x_dayType_weekend | -110.0796100 | 243.06658 | -0.4528784 | 0.6528616 |
Predicción
¿Cuál es el número de visitantes esperado un día con una temperatura máxima de 80ºF, con un nubosidad de 8.5, con una precipitación de 0.02 y que es fin de semana? ¿Cuál es un intervalo de confianza para la predicción?
valores <- tibble(hightemp = 80, cloudcover = 8.5,
precip = 0.02, dayType = "weekend")
pred <- flujo_lm1_est %>% predict(new_data = valores)
CI <- flujo_lm1_est %>% predict(new_data = valores, type = "conf_int")
pred %>% bind_cols(CI) %>% kbl() %>% kable_classic()| .pred | .pred_lower | .pred_upper |
|---|---|---|
| 518.8108 | 420.7957 | 616.8258 |
Modelización II
Consideramos un modelo alternativo donde la variable dependiente esté en logaritmos.
Paso 1: Preparar los datos y Especificación
Definimos la nueva receta:
receta2 <-receta1 %>%
step_log(volume) Podemos ver que efectivamente los nuevos datos incluyen la transformación en logaritmos:
datosPrep2 <- receta2 %>% prep() %>% bake(railtrailEntren)
datosPrep2 %>% slice_head() %>% kbl() %>% kable_paper()| precip | volume | dayType_weekend | hightemp_poly_1 | hightemp_poly_2 | hightemp_poly_3 | hightemp_poly_4 | hightemp_poly_5 | hightemp_poly_6 | hightemp_poly_7 | hightemp_poly_8 | hightemp_poly_9 | hightemp_poly_10 | hightemp_poly_11 | hightemp_poly_12 | hightemp_poly_13 | hightemp_poly_14 | hightemp_poly_15 | hightemp_poly_16 | hightemp_poly_17 | hightemp_poly_18 | hightemp_poly_19 | hightemp_poly_20 | hightemp_poly_21 | cloudcover_X.2.5.5. | cloudcover_X.5.7.5. | cloudcover_X.7.5.max. | precip_x_dayType_weekend |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 0 | 5.659482 | 0 | -0.2453388 | 0.3215624 | -0.2978088 | 0.2259474 | -0.1921686 | 0.1818106 | -0.1878811 | 0.1623743 | -0.1188715 | 0.0997763 | -0.1085769 | 0.096653 | -0.0650102 | 0.0357273 | -0.0184597 | 0.0074644 | -0.0030106 | 0.0012088 | -0.0005804 | 0.0002402 | -9.98e-05 | 0 | 0 | 0 | 0 |
Paso 2: Entrenamiento
Paso 2.A: Definición del modelo
- Vamos a usar el mismo modelo anterior
Paso 2.B: Creación del flujo de trabajo
- Actualizamos el flujo de trabajo con la nueva receta, bien añadiendo cada paso o bien actualizando la receta
flujo_lm2 <- workflow() %>%
add_recipe(receta2) %>%
add_model(modelo_lm1)
flujo_lm2 <- flujo_lm1 %>%
update_recipe(receta2) Paso 2.C: Estimación del flujo
- Estimamos el nuevo flujo
flujo_lm2_est <- flujo_lm2 %>%
fit(data = railtrailPart %>% training()) - Los resultados de esta estimación son:
flujo_lm2_est %>% extract_fit_parsnip() %>%
tidy() %>% kbl() %>% kable_paper()| term | estimate | std.error | statistic | p.value |
|---|---|---|---|---|
| (Intercept) | 5.9435257 | 0.0915221 | 64.9408675 | 0.0000000 |
| precip | -0.3120388 | 0.1328863 | -2.3481628 | 0.0234256 |
| dayType_weekend | 0.1668725 | 0.0907302 | 1.8392180 | 0.0726370 |
| hightemp_poly_1 | 1.9187719 | 0.3019446 | 6.3547143 | 0.0000001 |
| hightemp_poly_2 | -0.7643930 | 0.3082067 | -2.4801310 | 0.0170322 |
| hightemp_poly_3 | -0.8602522 | 0.3391576 | -2.5364380 | 0.0148224 |
| hightemp_poly_4 | 0.1559080 | 0.3138180 | 0.4968103 | 0.6217961 |
| hightemp_poly_5 | -0.0950682 | 0.2969453 | -0.3201539 | 0.7503671 |
| hightemp_poly_6 | 0.2940672 | 0.3167004 | 0.9285345 | 0.3581964 |
| hightemp_poly_7 | 0.1377186 | 0.3310097 | 0.4160560 | 0.6793915 |
| hightemp_poly_8 | 0.0218299 | 0.3377738 | 0.0646288 | 0.9487623 |
| hightemp_poly_9 | 0.0465628 | 0.3090218 | 0.1506780 | 0.8809184 |
| hightemp_poly_10 | -0.3319480 | 0.2927906 | -1.1337387 | 0.2630437 |
| hightemp_poly_11 | 0.0742108 | 0.2678511 | 0.2770599 | 0.7830316 |
| hightemp_poly_12 | 0.3632786 | 0.2674670 | 1.3582182 | 0.1813183 |
| hightemp_poly_13 | 0.0692958 | 0.2849733 | 0.2431658 | 0.8090070 |
| hightemp_poly_14 | 0.2291434 | 0.2702597 | 0.8478640 | 0.4011025 |
| hightemp_poly_15 | -0.0870908 | 0.2705935 | -0.3218511 | 0.7490896 |
| hightemp_poly_16 | 0.1971445 | 0.2781772 | 0.7087013 | 0.4822480 |
| hightemp_poly_17 | -0.0064423 | 0.2780173 | -0.0231723 | 0.9816176 |
| hightemp_poly_18 | -0.2404118 | 0.2697317 | -0.8912998 | 0.3776166 |
| hightemp_poly_19 | -0.6493733 | 0.2751197 | -2.3603300 | 0.0227567 |
| hightemp_poly_20 | 0.2433132 | 0.2727173 | 0.8921809 | 0.3771494 |
| hightemp_poly_21 | -0.3602797 | 0.2757300 | -1.3066393 | 0.1981239 |
| cloudcover_X.2.5.5. | -0.0377363 | 0.1315265 | -0.2869102 | 0.7755279 |
| cloudcover_X.5.7.5. | -0.1314990 | 0.1115658 | -1.1786675 | 0.2448655 |
| cloudcover_X.7.5.max. | -0.1947940 | 0.1062780 | -1.8328715 | 0.0735935 |
| precip_x_dayType_weekend | 0.0459736 | 0.7304203 | 0.0629413 | 0.9500983 |
Modelos LASSO
Vamos a estimar mediante LASSO los dos modelos anteriores.
Paso 1: Preparar los datos y Especificación
Debemos estandarizar las variables y debe ser antes de transformaciones no lineales de los regresores, como polinomios o interacciones. Por tanto, NO podemos simplemente añadir un paso de estandarización a la receta anterior.
Además debemos tener cuidado con el orden de los pasos. Si se discretiza una variable continua, debemos hacerlo antes de estandarizar (o bien los puntos de corte deben ser con los nuevos valores, estandarizados). La estandarización debe ser antes de la transformación en polinomios.
receta1LASSO <- railtrailPart %>% training() %>%
recipe(volume ~ hightemp + cloudcover + precip + dayType) %>%
step_cut(cloudcover, breaks = c(0, 2.5, 5, 7.5, 10),
include_outside_range = T) %>%
step_scale(all_predictors(), -all_nominal()) %>%
step_poly(hightemp, degree = 21) %>%
step_dummy(cloudcover) %>%
step_dummy(dayType) %>%
step_interact(~precip:starts_with("dayType_"))
receta2LASSO <- receta1LASSO %>%
step_log(volume)Paso 2: Entrenamiento
Paso 2.A: Definición del modelo
- Definimos el modelo con el hiperparámetro para ajustar:
modelo_LASSO <- linear_reg(mode= "regression", engine = "glmnet",
penalty = tune(), mixture = 1)Paso 2.B: Creación del flujo de trabajo
- Creamos los flujos de trabajo combinando las recetas y el modelo
flujo_LASSO1 <- workflow() %>%
add_recipe(receta1LASSO) %>%
add_model(modelo_LASSO)
flujo_LASSO2 <- flujo_LASSO1 %>%
update_recipe(receta2LASSO)- Podemos comprobar que el flujo depende un parámetro a ajustar:
flujo_LASSO1 %>% extract_parameter_set_dials()Paso 2.C: Estimación del flujo
Paso 2.C.1: Ajuste del hiperparámetros
En este caso, la estimación del flujo requiere más pasos, ya que debemos ajustar el hiperparámetro del modelo LASSO.
Definimos las particiones de validación cruzada en la muestra de entrenamiento que vamos a utilizar, para ambos casos:
set.seed(9753)
railtrail_entrenCV <- railtrailPart %>% training() %>%
vfold_cv(v=10)Proceso de ajuste del primer modelo
- Definimos un primer rango y valores de búsqueda del hiperparámetro:
LASSO_grid <- grid_regular(penalty(range = c(0, 20), trans = NULL),
levels = 21)flujo_LASSO1_ajust <- flujo_LASSO1 %>%
tune_grid(resamples = railtrail_entrenCV,
metrics = metric_set(rmse, mae),
grid = LASSO_grid )
flujo_LASSO1_ajust %>% autoplot()
- Dado que lo que observamos, ampliamos el rango por la derecha probando muchos valores:
LASSO_grid <- grid_regular(penalty(range = c(18, 68), trans = NULL),
levels = 51)flujo_LASSO1_ajust <- flujo_LASSO1 %>%
tune_grid(resamples = railtrail_entrenCV,
metrics = metric_set(rmse, mae),
grid = LASSO_grid )
flujo_LASSO1_ajust %>% autoplot()
- Nos centramos en un rango plausible probando más valores:
LASSO_grid <- grid_regular(penalty(range = c(24, 29), trans = NULL),
levels = 51)flujo_LASSO1_ajust <- flujo_LASSO1 %>%
tune_grid(resamples = railtrail_entrenCV,
metrics = metric_set(rmse, mae),
grid = LASSO_grid )
flujo_LASSO1_ajust %>% autoplot()
- Notad que hay varios valores con métricas muy similares. Nos quedamos con el mejor, pero serían igualmente válidos:
flujo_LASSO1_ajust %>% show_best(metric = "rmse")
mejor_lambda1 <- flujo_LASSO1_ajust %>% select_best(metric = "rmse")Proceso de ajuste del segundo modelo
- Probamos un primer rango
LASSO_grid <- grid_regular(penalty(range = c(0, 5), trans = NULL),
levels = 21)flujo_LASSO2_ajust <- flujo_LASSO2 %>%
tune_grid(resamples = railtrail_entrenCV,
metrics = metric_set(rmse, mae),
grid = LASSO_grid )
flujo_LASSO2_ajust %>% autoplot()
- Vemos un cambio fuerte entorno a 0.2 miramos que pasa a su izquierda
LASSO_grid <- grid_regular(penalty(range = c(0, 0.2), trans = NULL),
levels = 21)flujo_LASSO2_ajust <- flujo_LASSO2 %>%
tune_grid(resamples = railtrail_entrenCV,
metrics = metric_set(rmse, mae),
grid = LASSO_grid )
flujo_LASSO2_ajust %>% autoplot()
- … y a su derecha
LASSO_grid <- grid_regular(penalty(range = c(0.1, 1.1), trans = NULL),
levels = 21)flujo_LASSO2_ajust <- flujo_LASSO2 %>%
tune_grid(resamples = railtrail_entrenCV,
metrics = metric_set(rmse, mae),
grid = LASSO_grid )
flujo_LASSO2_ajust %>% autoplot()
- Focalizamos más en la parte a la izquierda de 0.3 (porque a la derecha, la métrica no varía: la penalización no hace cambiar el modelo)
LASSO_grid <- grid_regular(penalty(range = c(0.09, 0.11), trans = NULL),
levels = 51)flujo_LASSO2_ajust <- flujo_LASSO2 %>%
tune_grid(resamples = railtrail_entrenCV,
metrics = metric_set(rmse, mae),
grid = LASSO_grid )
flujo_LASSO2_ajust %>% autoplot()
- Nos quedamos con el mejor
mejor_lambda2 <- flujo_LASSO2_ajust %>% select_best(metric = "rmse")Paso 2.C.2: Finalizando y estimando
- Para el primer modelo
flujo_LASSO_final1 <- flujo_LASSO1 %>%
finalize_workflow(mejor_lambda1) flujo_LASSO_final1_est <- flujo_LASSO_final1 %>%
fit(data = railtrailPart %>% training())
flujo_LASSO_final1_est %>% extract_fit_parsnip() %>% tidy() %>%
kbl() %>% kable_styling()| term | estimate | penalty |
|---|---|---|
| (Intercept) | 380.895481 | 25.2 |
| precip | -7.442689 | 25.2 |
| hightemp_poly_1 | 424.152202 | 25.2 |
| hightemp_poly_2 | -50.391223 | 25.2 |
| hightemp_poly_3 | -95.487801 | 25.2 |
| hightemp_poly_4 | 0.000000 | 25.2 |
| hightemp_poly_5 | 0.000000 | 25.2 |
| hightemp_poly_6 | 0.000000 | 25.2 |
| hightemp_poly_7 | 0.000000 | 25.2 |
| hightemp_poly_8 | 0.000000 | 25.2 |
| hightemp_poly_9 | 0.000000 | 25.2 |
| hightemp_poly_10 | 0.000000 | 25.2 |
| hightemp_poly_11 | 0.000000 | 25.2 |
| hightemp_poly_12 | 0.000000 | 25.2 |
| hightemp_poly_13 | 0.000000 | 25.2 |
| hightemp_poly_14 | 0.000000 | 25.2 |
| hightemp_poly_15 | 0.000000 | 25.2 |
| hightemp_poly_16 | 0.000000 | 25.2 |
| hightemp_poly_17 | 0.000000 | 25.2 |
| hightemp_poly_18 | 0.000000 | 25.2 |
| hightemp_poly_19 | 0.000000 | 25.2 |
| hightemp_poly_20 | 0.000000 | 25.2 |
| hightemp_poly_21 | 0.000000 | 25.2 |
| cloudcover_X.2.5.5. | 0.000000 | 25.2 |
| cloudcover_X.5.7.5. | 0.000000 | 25.2 |
| cloudcover_X.7.5.max. | -19.908599 | 25.2 |
| dayType_weekend | 5.727394 | 25.2 |
| precip_x_dayType_weekend | 0.000000 | 25.2 |
- Para el segundo modelo
flujo_LASSO_final2 <- flujo_LASSO2 %>%
finalize_workflow(mejor_lambda2) flujo_LASSO_final2_est <- flujo_LASSO_final2 %>%
fit(data = railtrailPart %>% training())
flujo_LASSO_final2_est %>% extract_fit_parsnip() %>% tidy() %>%
kbl() %>% kable_styling()| term | estimate | penalty |
|---|---|---|
| (Intercept) | 5.8649640 | 0.0928 |
| precip | -0.0087859 | 0.0928 |
| hightemp_poly_1 | 1.2004631 | 0.0928 |
| hightemp_poly_2 | -0.0171432 | 0.0928 |
| hightemp_poly_3 | 0.0000000 | 0.0928 |
| hightemp_poly_4 | 0.0000000 | 0.0928 |
| hightemp_poly_5 | 0.0000000 | 0.0928 |
| hightemp_poly_6 | 0.0000000 | 0.0928 |
| hightemp_poly_7 | 0.0000000 | 0.0928 |
| hightemp_poly_8 | 0.0000000 | 0.0928 |
| hightemp_poly_9 | 0.0000000 | 0.0928 |
| hightemp_poly_10 | 0.0000000 | 0.0928 |
| hightemp_poly_11 | 0.0000000 | 0.0928 |
| hightemp_poly_12 | 0.0000000 | 0.0928 |
| hightemp_poly_13 | 0.0000000 | 0.0928 |
| hightemp_poly_14 | 0.0000000 | 0.0928 |
| hightemp_poly_15 | 0.0000000 | 0.0928 |
| hightemp_poly_16 | 0.0000000 | 0.0928 |
| hightemp_poly_17 | 0.0000000 | 0.0928 |
| hightemp_poly_18 | 0.0000000 | 0.0928 |
| hightemp_poly_19 | 0.0000000 | 0.0928 |
| hightemp_poly_20 | 0.0000000 | 0.0928 |
| hightemp_poly_21 | 0.0000000 | 0.0928 |
| cloudcover_X.2.5.5. | 0.0000000 | 0.0928 |
| cloudcover_X.5.7.5. | 0.0000000 | 0.0928 |
| cloudcover_X.7.5.max. | -0.0272226 | 0.0928 |
| dayType_weekend | 0.0000000 | 0.0928 |
| precip_x_dayType_weekend | 0.0000000 | 0.0928 |
- Nota: también podríamos poner los dos modelos juntos en la misma tabla, en columnas diferentes.
Evaluación de modelos
- Usamos
final_fit()en cada modelo para calcular las métricas de error:
lm1_final_fit <- flujo_lm1 %>%
last_fit(split = railtrailPart,
metrics = metric_set(rmse, mae))
lm2_final_fit <- flujo_lm2 %>%
last_fit(split = railtrailPart,
metrics = metric_set(rmse, mae))
LASSO1_final_fit <- flujo_LASSO_final1 %>%
last_fit(split = railtrailPart,
metrics = metric_set(rmse, mae))
LASSO2_final_fit <- flujo_LASSO_final2 %>%
last_fit(split = railtrailPart,
metrics = metric_set(rmse, mae)) - Recopilamos las métricas y las presentamos en una tabla
lm1 <- lm1_final_fit %>% collect_metrics() %>%
select(.metric, .estimate) %>% rename(lm1 = .estimate)
lm2 <- lm2_final_fit %>% collect_metrics() %>%
select(.metric, .estimate) %>% rename(lm2 = .estimate)
LASSO1 <- LASSO1_final_fit %>% collect_metrics() %>%
select(.metric, .estimate) %>% rename(LASSO1 = .estimate)
LASSO2 <- LASSO2_final_fit %>% collect_metrics() %>%
select(.metric, .estimate) %>% rename(LASSO2 = .estimate)
lm1 %>% inner_join(lm2) %>%
inner_join(LASSO1) %>% inner_join(LASSO2) %>%
kbl() %>% kable_classic()| .metric | lm1 | lm2 | LASSO1 | LASSO2 |
|---|---|---|---|---|
| rmse | 864.4011 | 4.213944 | 88.98326 | 0.2546021 |
| mae | 263.4489 | 1.162545 | 67.28979 | 0.2085878 |
Conclusiones
Los resultados de las métricas indican que los modelos en logaritmos son mejores para predicción. En este caso, LASSO tiene un rendimiento claramente superior al del modelo de regresión lineal; si tuvieramos menos variables que se puedan eliminar, el rendimiento podría ser similar y quizás habría que probar cómo funciona “Ridge regression”.
Si nuestro objetivo es predecir, podemos utilizar LASSO: aunque sus coeficientes están sesgados, la mejora en varianza implica que el error cuadrático medio es menor. Si nuestro objetivo es interpretar, podemos utilizar el modelo de regresión lineal en logaritmos pero incluyendo solo las variables seleccionadas por LASSO.