7. Regularización

Regularización (lasso-ridge)

El primer paso es especificar el modelo

spec_lasso <-
  linear_reg(penalty = 0.5, mixture = 1) |>
  # En glmnet, mixture = 1 es un modelo lasso. Mixture = 0 es ridge regression.
  set_engine("glmnet") |>
  set_mode("regression")

spec_lasso |> translate()

El segundo paso es crear un workflow. A ese workflow le vamos añadir diferentes pasos. Agregamos el modelo.

wf <-
  workflow() |>
  add_model(spec_lasso)

Después agregarmos las transformaciones que debemos realizar a las variables.

Dummy
Centrar
Escalar

Centrar los datos significa restar la media de una variable de los datos. Escalar los datos significa dividir sobre la desviación estándar.

Receta

receta_lasso <- recipe(punt_matematicas_11 ~ ., data = mini_datos) |>
  step_normalize(all_double_predictors()) |>
  step_dummy(all_factor_predictors())

prep(receta_lasso) |>
  bake(new_data = mini_datos) |>
  view()

Ahora podemos agregar la receta al workflow, para que se aplique a los datos antes de estimar el modelo

wf <- wf |>
  add_recipe(receta_lasso)

Estimar el error en el training

wf %>%
  fit(mini_datos) |>
  extract_fit_parsnip()

lasso_fit <- wf %>%
  last_fit(datos_divididos)

collect_metrics(lasso_fit)

Pero, ¿por qué elegimos esa penalidad? Podemos usar cross-validation para tener algo de información sobre los hiperparámetros que nos dan mejor rendimiento en los datos de prueba.

tuned_spec <-
  linear_reg(penalty = tune(), mixture = 1) |>
  set_mode("regression") |>
  set_engine("glmnet")

tune_wf <-
  workflow() |>
  add_model(tuned_spec) |>
  add_recipe(receta_lasso)

lambda_grid <- grid_regular(penalty(), levels = 10)

set.seed(1234)
folds <-
  vfold_cv(datos_entrenamiento,
    v = 5
  )

doParallel::registerDoParallel()

set.seed(2023)

lasso_grid <- tune_grid(
  tune_wf,
  resamples = folds,
  grid = lambda_grid
)

doParallel::stopImplicitCluster()

show_best(lasso_grid, metric = "rsq")

best <- select_best(lasso_grid, metric = "rsq")

final_lasso <- finalize_workflow(
  tune_wf, best
)

last_fit(final_lasso, split = datos_divididos) |> collect_metrics()

library(vip)

final_lasso %>%
  fit(datos_entrenamiento) %>%
  extract_fit_parsnip() %>%
  vip::vi(lambda = best$penalty) %>%
  mutate(
    Importance = abs(Importance),
    Variable = fct_reorder(Variable, Importance)
  ) %>%
  head(20) |>
  ggplot(aes(x = Importance, y = Variable, fill = Sign)) +
  geom_col() +
  scale_x_continuous(expand = c(0, 0)) +
  labs(y = NULL) +
  facet_wrap(~Sign, scales = "free_y") +
  theme(legend.position = "none")

Usar recetas

Construir la receta:

recipe(punt_matematicas_11 ~ ., data = datos_entrenamiento) crea un objeto recipe que especifica que se va a predecir la variable punt_matematicas_11 usando todas las otras variables (.) en los datos de entrenamiento datos_entrenamiento.

step_mutate(across(everything(), ~ if_else(.x == "NA", NA, .x))) reemplaza todos los valores de “NA” en todas las columnas con el valor NA. Esto se hace para asegurarse de que los datos faltantes estén representados correctamente en el conjunto de datos.

step_mutate(estu_cod_mcpio_presentacion_9 = as_factor(estu_cod_mcpio_presentacion_9)) convierte la columna estu_cod_mcpio_presentacion_9 a un factor. Esto es necesario porque esta columna representa códigos de municipios y no debería tratarse como una variable numérica continua.

step_mutate(estu_cod_depto_presentacion_9 = as_factor(estu_cod_depto_presentacion_9)) convierte la columna estu_cod_depto_presentacion_9 a un factor. Esto se hace por la misma razón que en el paso anterior.

step_mutate(estu_edad_9 = as.numeric(str_extract_all(estu_edad_9, "\\d+"))) extrae los números de la columna estu_edad_9 y los convierte a valores numéricos. Esto se hace para asegurarse de que la variable se trate como numérica en lugar de como un factor.

step_mutate(fami_cuartoshogar_9 = if_else(fami_cuartoshogar_9 == "NA", NA, fami_cuartoshogar_9)) reemplaza los valores “NA” en la columna fami_cuartoshogar_9 con el valor NA. Esto es necesario para asegurarse de que los datos faltantes estén representados correctamente.

step_mutate(fami_cuartoshogar_9 = as.numeric(fami_cuartoshogar_9)) convierte la columna fami_cuartoshogar_9 a valores numéricos. Esto se hace porque esta variable representa el número de habitaciones en el hogar y se espera que sea una variable numérica.

step_impute_mode(all_nominal_predictors()) imputa los valores faltantes en todas las variables nominales (factores) con el modo (valor más común) de cada columna.

step_impute_mean(all_double()) imputa los valores faltantes en todas las variables continuas con la media de cada columna.

step_zv(all_predictors()) elimina las variables que tienen una varianza cero. Esto se hace para asegurarse de que las variables que no cambian en todo el conjunto de datos no estén incluidas en el modelo.

step_normalize(all_double_predictors()) normaliza todas las variables continuas para que tengan media cero y varianza unitaria. Esto se hace para asegurarse de que las variables estén en la misma métrica

set.seed(2231)

mini_datos <- data_icfes |>
  select(contains("fami"), starts_with("estu"), "punt_matematicas_11") |>
  select(contains("9"), "punt_matematicas_11") |> tidyREDCap::drop_labels()

datos_divididos <- initial_split(mini_datos, prop = 0.8)

datos_entrenamiento <- training(datos_divididos)
datos_prueba <- testing(datos_divididos)

mean(datos_entrenamiento$punt_matematicas_11, na.rm = T)
mean(datos_prueba$punt_matematicas_11, na.rm = T)

receta_lasso_2 <- 
  recipe(punt_matematicas_11 ~ ., data = datos_entrenamiento) |>
  step_mutate(across(everything(), ~ if_else(.x == "NA", NA, .x))) |>
  step_mutate(estu_cod_mcpio_presentacion_9 = as_factor(estu_cod_mcpio_presentacion_9)) |>
  step_mutate(estu_cod_depto_presentacion_9 = as_factor(estu_cod_depto_presentacion_9)) |>
  step_mutate(estu_edad_9 = as.numeric(str_extract_all(estu_edad_9, "\\d+"))) |>
  step_mutate(fami_cuartoshogar_9 = if_else(fami_cuartoshogar_9 == "NA", NA, 
                                            fami_cuartoshogar_9)) |>
  step_mutate(fami_cuartoshogar_9 = as.numeric(fami_cuartoshogar_9)) |>
  step_impute_mode(all_nominal_predictors()) |>
  step_impute_mean(all_double()) |>
  step_zv(all_predictors()) |>
  step_normalize(all_double_predictors()) |>
  step_dummy(all_factor_predictors())

Aplicar la receta y obtener los datos transformados.

despues_receta <- prep(receta_lasso) |> bake(new_data = datos_entrenamiento)

spec_lasso <-
  linear_reg(penalty = 0.5, mixture = 1) |>
  # En glmnet, mixture = 1 es un modelo lasso. Mixture = 0 es ridge regression.
  set_engine("glmnet") |>
  set_mode("regression")

El segundo paso es crear un workflow. A ese workflow le vamos añadir diferentes pasos. Agregamos el modelo.

wf2 <-
  workflow() |>
  add_model(spec_lasso)

Después agregarmos las transformaciones que debemos realizar a las variables.

Dummy
Centrar
Escalar

Centrar los datos significa restar la media de una variable de los datos. Escalar los datos significa dividir sobre la desviación estándar.

Ahora podemos agregar la receta al workflow, para que se aplique a los datos antes de estimar el modelo

wf2 <- wf2 |>
  add_recipe(receta_lasso_2)

Estimar el error en el training

lasso_fit <- wf2 |> 
  last_fit(datos_divididos)

collect_metrics(lasso_fit)

wf2 %>%
  fit(datos_entrenamiento) %>%
  extract_fit_parsnip() %>%
  vip::vi() %>%
  mutate(
    Importance = abs(Importance),
    Variable = fct_reorder(Variable, Importance)
  ) %>%
  head(20) |>
  ggplot(aes(x = Importance, y = Variable, fill = Sign)) +
  geom_col() +
  scale_x_continuous(expand = c(0, 0)) +
  labs(y = NULL) +
  facet_wrap(~Sign, scales = "free_y") +
  theme(legend.position = "none")

El paquete usemodels propone una manera de hacer el recipe, el engine y el workflow

usemodels::use_ranger(punt_matematicas_11 ~ ., data = datos_entrenamiento)