Sobreajuste y entrenamiento de modelos

Fecha de publicación

16 de diciembre de 2024

Objetivo del manual

Entender el concepto de sobreajuste en modelos de aprendizaje estadístico
Aprender a detectar sobreajuste en modelos de aprendizaje estadístico
Aplicar métodos estadisticos para evitar el sobreajuste

Paquetes a utilizar en este manual:

Código

# instalar/cargar paquetes
sketchy::load_packages(
  c("ggplot2", 
    "viridis", 
    "caret",
    "MuMIn",
    "nnet",
    "themis"
   )
  )

Funcion personalizada a utilizar en este manual:

Código

r2_lm <- function(model, data, response = "y"){
  pred <- predict(model, newdata = data)
  caret::R2(pred, data[, response])
  }

1 Entrenamiento de modelos

El objetivo de los modelos de aprendizaje estadístico es el de obtener patrones de los datos de entrenamiento para predecir o inferir correctamente los patrones en la población original de donde provienen esos datos de entrenamiento. Es decir, la clave esta en obtener patrones generales que sean extrapolables a nuevos datos. La idea principal del entrenamiento es ajustar el modelo a los datos de entrenamiento para aprender patrones que se puedan generalizar a datos nuevos. Sin embargo, parte de este proceso implica estrategias para evitar tanto el sobreajuste como el subajuste.

1.1 Sobreajuste

El sobreajuste ocurre cuando un modelo se ajusta demasiado bien a los datos de entrenamiento, capturando tanto los patrones verdaderos como el ruido o variaciones aleatorias de los datos. Como resultado, el modelo funciona bien en el conjunto de entrenamiento, pero tiene un rendimiento deficiente en nuevos datos (pobre capacidad de generalización). El sobreajuste se refiere a cuando modelo está tan ajustado a los datos de entrenamiento que afecta su capacidad de generalización. El sobreajuste se produce cuando un sistema de aprendizaje automático se entrena demasiado o con datos (levemente) sesgados, que hace que el algoritmo aprenda patrones que no son generales. Aprende características especificas pero no los patrones generales, el concepto.

Una forma de evaluar la capacidad de generalización de un modelo es mediante la división de los datos en dos conjuntos: entrenamiento y prueba. El modelo se ajusta a los datos de entrenamiento y se evalúa en los datos de prueba. El sobreajuste se puede detectar cuando el error en los datos de prueba es mucho mayor que el error en los datos de entrenamiento.

Los modelos más complejos tienden a sobreajustar más que lo modelos más simples. Además, ante un mismo modelo, a menor cantidad de datos es más posible que ese modelo se sobreajuste. Existen varios métodos para evaluar cuándo un modelo está sobreajustando. En la simulación que se muestra a continuación, se ajusta un modelo de regresión lineal con diferentes cantidades de predictores (p). Se calcula el error cuadrático medio en los datos de entrenamiento y en los datos de prueba.

Código

repeticiones <- 100 # Número de repeticiones
n <- 100  # Número de observaciones
p <- 20  # Número de predictores

expr <- expression({
# Generar datos sintéticos


# Crear variables predictoras aleatorias
datos <- as.data.frame(matrix(rnorm(n * p), n, p))
colnames(datos) <- paste0("x", 1:p)

# Crear variable de respuesta con una combinación de algunas variables
datos$y <-
  3 * datos$x1 - 2 * datos$x2 + 1 * datos$x3 + rnorm(n, 0, 2)

# Dividir en conjunto de entrenamiento y prueba
entren_indice <- createDataPartition(datos$y, p = 0.9, list = FALSE)
datos_entren <- datos[entren_indice, ]
datos_prueba <- datos[-entren_indice, ]


resultados_lista <- lapply(1:(ncol(datos) - 1), function(z) {
  # Ajustar modelo de regresión lineal
  modelo <-
    lm(y ~ ., data = datos_entren[, c("y", paste0("x", 1:z))])
  
  r2_entren <- r2_lm(modelo, datos_entren)
  r2_prueba <- r2_lm(modelo, datos_prueba)
  
  resultados <-
    data.frame(
       r2 = c(r2_prueba, r2_entren)
    )
  
  return(resultados)
  
})

resultados_df <- do.call(rbind, resultados_lista)
})

# repetir x veces
reps <- replicate(repeticiones, eval(expr), simplify = TRUE)

# promediar resultados
r2 <- apply(as.data.frame(reps), 1, mean)


resultados_promedio <-
    data.frame(
      n_predictores = rep(1:p, each = 2),
      Tipo = c("Prueba", "Entrenamiendo"),
      r2 = r2
    )

saveRDS(resultados_promedio, "resultados_promedio.rds")

ggplot(resultados_promedio, aes(x = n_predictores, y = r2, color = Tipo)) +
  geom_line(lwd = 2) +
  scale_x_continuous(breaks = seq(0, p, 1)) +
  scale_color_viridis_d(end = 0.9) +
  labs(x = "Número de predictores",
       y = bquote('Coeficiente de determinación' ~ R ^ 2)) +
  theme(
    legend.background = element_rect(fill = "#fff3cd"),
    legend.position = c(0.5, 0.2),
    panel.background = element_rect(fill = "#fff3cd"),
    plot.background = element_rect(fill = "#fff3cd", colour = NA)
  )

Podemos ver como en ambos casos el coeficiente de determinación (R²) aumenta en los primeros 3 predictores. Esto es de esperar ya que estos son los predictores asociados a la respuesta. Sin embargo, luego de este punto el R² aumenta para los datos de entrenamiento, pero no para los datos de prueba. Esto es un claro indicio de sobreajuste.

En la siguiente simulación podemos ver mas claramente como el R² calculado sobre datos de entrenamiento aumenta con la cantidad de predictores, a pesar de no haber un solo predictor asociado a la variable respuesta:

Código

repeticiones <- 100 # Número de repeticiones
n <- 100  # Número de observaciones
p <- 20  # Número de predictores

expr <- expression({
# Generar datos sintéticos


# Crear variables predictoras aleatorias
datos <- as.data.frame(matrix(rnorm(n * p), n, p))
colnames(datos) <- paste0("x", 1:p)

# Crear variable de respuesta con una combinación de algunas variables
datos$y <- rnorm(n, 0, 2)

# Dividir en conjunto de entrenamiento y prueba
entren_indice <- createDataPartition(datos$y, p = 0.9, list = FALSE)
datos_entren <- datos[entren_indice, ]
datos_prueba <- datos[-entren_indice, ]


resultados_lista <- lapply(1:(ncol(datos) - 1), function(z) {
  # Ajustar modelo de regresión lineal
  modelo <-
    lm(y ~ ., data = datos_entren[, c("y", paste0("x", 1:z))])
  
  r2_entren <- r2_lm(modelo, datos_entren)
  r2_prueba <- r2_lm(modelo, datos_prueba)
  
  resultados <-
    data.frame(
       r2 = c(r2_prueba, r2_entren)
    )
  
  return(resultados)
  
})

resultados_df <- do.call(rbind, resultados_lista)
})

# repetir x veces
reps <- replicate(repeticiones, eval(expr), simplify = TRUE)

# promediar resultados
r2 <- apply(as.data.frame(reps), 1, mean)


resultados_promedio_aleatorio <-
    data.frame(
      n_predictores = rep(1:p, each = 2),
      Tipo = c("Prueba", "Entrenamiendo"),
      r2 = r2
    )

saveRDS(resultados_promedio_aleatorio, "resultados_promedio_aleatorio.rds")

ggplot(resultados_promedio_aleatorio, aes(x = n_predictores, y = r2, color = Tipo)) +
  geom_line(lwd = 2) +
  scale_x_continuous(breaks = seq(0, p, 1)) +
  scale_color_viridis_d(end = 0.9) +
  labs(x = "Número de predictores",
       y = bquote('Coeficiente de determinación' ~ R ^ 2)) +
  theme(
    legend.background = element_rect(fill = "#fff3cd"),
    legend.position = c(0.7, 0.2),
    panel.background = element_rect(fill = "#fff3cd"),
    plot.background = element_rect(fill = "#fff3cd", colour = NA)
  )

Sin embargo, el R² calculado sobre datos de prueba se mantiene constante.

2 Herramientas para evitar el sobreajuste

Existen una gran cantidad de técnicas para mejorar la generalización de los modelos de aprendizaje estadístico. En este tutorial veremos 2 de las mas comunes y útiles: la selección de modelos y la validación cruzada.

2.1 Selección de modelos con AIC

El criterio de información de Akaike (AIC) es una medida de la calidad relativa de un modelo estadístico para un conjunto dado de datos. EL AIC penaliza la complejidad del modelo, lo que ayuda a evitar el sobreajuste. El AIC se calcula como:

\[AIC = -2 * log(L) + 2 * k\]

L es la función de verosimilitud del modelo y k es el número de parámetros del modelo.

El AIC proporciona una medida relativa de la calidad de cada modelo, en relación con los otros modelos. Por lo tanto, el AIC se puede utilizar para seleccionar el mejor modelo de un conjunto de modelos candidatos. Un AIC más bajo indica un mejor modelo. En el contexto de selección de modelos el modelo preferido sería el que tiene el menor AIC. Una diferencia de AIC de 2 o más unidades se considera evidencia fuerte a favor del modelo con el AIC más bajo.

Podemos ver como el AIC aumenta con la cantidad de predictores en el modelo. En el siguiente gráfico se muestra el AIC para un modelo de regresión lineal con diferentes cantidades de predictores:

Código

repeticiones <- 100 # Número de repeticiones
n <- 100  # Número de observaciones
p <- 20  # Número de predictores

expr <- expression({
# Generar datos sintéticos


# Crear variables predictoras aleatorias
datos <- as.data.frame(matrix(rnorm(n * p), n, p))
colnames(datos) <- paste0("x", 1:p)


# Crear variable de respuesta con una combinación de algunas variables
datos$y <-
  3 * datos$x1 - 2 * datos$x2 + 1 * datos$x3 + rnorm(n, 0, 2)

# Dividir en conjunto de entrenamiento y prueba
entren_indice <- createDataPartition(datos$y, p = 0.9, list = FALSE)
datos_entren <- datos[entren_indice, ]
datos_prueba <- datos[-entren_indice, ]


resultados_lista <- lapply(1:(ncol(datos) - 1), function(z) {
  # Ajustar modelo de regresión lineal
   modelo <-
    lm(y ~ ., data = datos[, c("y", paste0("x", 1:z))])
  
  # modelos nulos
  modelo_nulo <- lm(y ~ 1, data = datos[, c("y", paste0("x", 1:z))])
  
  # Calcular AIC
  aics <- AIC(modelo, modelo_nulo)
  aics$delta.aic <- aics$AIC - min(aics$AIC)
  
  resultados <- aics["modelo_nulo", "delta.aic"]
  
  return(resultados)
  
})

resultados_df <- do.call(rbind, resultados_lista)
})

# repetir x veces
reps <- replicate(repeticiones, eval(expr), simplify = TRUE)

# promediar resultados
delta_aic <- apply(as.data.frame(reps), 1, mean)


resultados_promedio_aic <-
    data.frame(
      n_predictores = rep(1:p),
      delta_aic = delta_aic
    )

ggplot(resultados_promedio_aic, aes(x = n_predictores, y = delta_aic)) +
  geom_line(lwd = 2, color = viridis(1)) +
  scale_x_continuous(breaks = seq(0, p, 1)) +
  labs(x = "Número de predictores", y = "Delta AIC") +
  theme(legend.position = c(0.5, 0.7)) +
  scale_y_reverse()

Datos donde ningun predictor está asociado:

Código

repeticiones <- 100 # Número de repeticiones
n <- 100  # Número de observaciones
p <- 20  # Número de predictores

expr <- expression({
# Generar datos sintéticos

# Crear variables predictoras aleatorias
datos <- as.data.frame(matrix(rnorm(n * p), n, p))
colnames(datos) <- paste0("x", 1:p)


# Crear variable de respuesta no asociada a los predictores
datos$y <- rnorm(n, 0, 2)

resultados_lista <- lapply(1:(ncol(datos) - 1), function(z) {
  # Ajustar modelo de regresión lineal
   modelo <-
    lm(y ~ ., data = datos[, c("y", paste0("x", 1:z))])
  
  # modelos nulos
  modelo_nulo <- lm(y ~ 1, data = datos[, c("y", paste0("x", 1:z))])
  
  # Calcular AIC
  aics <- AIC(modelo, modelo_nulo)
  aics$delta.aic <- aics$AIC - min(aics$AIC)
  
  resultados <- aics["modelo_nulo", "delta.aic"]
  
  return(resultados)
  
})

resultados_df <- do.call(rbind, resultados_lista)
})

# repetir x veces
reps <- replicate(repeticiones, eval(expr), simplify = TRUE)

# promediar resultados
delta_aic <- apply(as.data.frame(reps), 1, mean)


resultados_promedio_aic <-
    data.frame(
      n_predictores = rep(1:p),
      delta_aic = delta_aic
    )

ggplot(resultados_promedio_aic, aes(x = n_predictores, y = delta_aic)) +
  geom_line(lwd = 2, color = viridis(1)) + 
  scale_x_continuous(breaks = seq(0, p, 1)) +
  labs(x = "Número de predictores", y = "Delta AIC") +
  theme(legend.position = c(0.5, 0.7)) +
  scale_y_reverse(limits = c(1, -2))

2.2 Aplicación del AIC

Como se mencionó anteriormente, el AIC se puede utilizar para seleccionar el mejor modelo de un conjunto de modelos candidatos. El modelo preferido es el que tiene el menor AIC. Por ejemplo, podemos construir un conjunto de modelos de regresión lineal con diferentes predictores y seleccionar el modelo con el menor AIC. En el siguiente ejemplo, se ajustan modelos de regresión lineal a los datos Titanic con diferentes predictores y comparemos el ajuste relativo de los modelos con AIC:

Código

# cargar datos
data("Titanic")

# dar formato con una observacion por fila
datos_titanic <- as.data.frame(Titanic)
datos_titanic <- datos_titanic[datos_titanic$Freq > 0, ]

datos_tab_titanic <- do.call(rbind, lapply(1:nrow(datos_titanic), function(x) datos_titanic[rep(x, datos_titanic$Freq[x]),]))
datos_tab_titanic$Freq <- NULL

# explorar datos
head(datos_tab_titanic, 10)

	Class	Sex	Age	Survived
3	3rd	Male	Child	No
3.1	3rd	Male	Child	No
3.2	3rd	Male	Child	No
3.3	3rd	Male	Child	No
3.4	3rd	Male	Child	No
3.5	3rd	Male	Child	No
3.6	3rd	Male	Child	No
3.7	3rd	Male	Child	No
3.8	3rd	Male	Child	No
3.9	3rd	Male	Child	No

Código

# correr un modelo con clase como predictor
modelo_clase <- glm(Survived ~ Class, data = datos_tab_titanic, family = binomial)

# correr un modelo con edad como predictor
modelo_edad <- glm(Survived ~ Age, data = datos_tab_titanic, family = binomial)

tabla_aic <- AIC(modelo_clase, modelo_edad)

tabla_aic

	df	AIC
modelo_clase	4	2596.6
modelo_edad	2	2753.9

En este caso, el modelo con la clase como predictor tiene un AIC más bajo que el modelo con la edad como predictor, lo que sugiere que el modelo con la clase como predictor es preferido. Resulta mas intuitivo comparar los modelos utilizando la diferencia en AIC (comúnmente llamada “delta AIC”), ya que esta diferencia nos da una idea de cuan mejor es un modelo con respecto a otro:

Código

# calcular delta AIC
tabla_aic$delta.aic <- tabla_aic$AIC - min(tabla_aic$AIC)

tabla_aic

	df	AIC	delta.aic
modelo_clase	4	2596.6	0.00
modelo_edad	2	2753.9	157.34

El modelo con la clase como predictor tiene un delta AIC de 0. Por lo tanto este es el mejor modelo. También podemos ver que la diferencia con el modelo de edad es de 157.34, lo que indica que el modelo con la clase como predictor es significativamente mejor que el modelo con la edad como predictor.

En algunos casos donde el número de posibles modelos es alto resulta útil utilizar la funcion dredge del paquete MuMIn para calcular el AIC de todos los modelos posibles y seleccionar el mejor modelo.

Código

datos_tab_titanic$aleat <- rnorm(n = nrow(datos_tab_titanic))

# crear modelo global
modelo_global <- glm(Survived ~ ., data = datos_tab_titanic, family = binomial)

# cambiar comportamiento en presencia de NAs (para evitar problemas con la funcion dredge)
options(na.action = "na.fail")

# usar la funcion dredge
dredge(modelo_global)

Fixed term is "(Intercept)"

	(Intercept)	Age	aleat	Class	Sex	df	logLik	AICc	delta	weight
14	0.68532	+	NA	+	+	6	-1105.0	2222.1	0.0000	7.2170e-01
16	0.68614	+	0.01731	+	+	7	-1105.0	2224.0	1.9074	2.7808e-01
13	-0.35312	NA	NA	+	+	5	-1114.5	2238.9	16.8408	1.5901e-04
15	-0.35416	NA	0.00902	+	+	6	-1114.4	2240.9	18.8228	5.9025e-05
10	-0.78004	+	NA	NA	+	3	-1164.5	2335.1	113.0065	2.0860e-25
12	-0.77729	+	0.02275	NA	+	4	-1164.5	2336.9	114.8197	8.4250e-26
9	-1.31281	NA	NA	NA	+	2	-1167.5	2339.0	116.8940	2.9865e-26
11	-1.31280	NA	0.01923	NA	+	3	-1167.4	2340.9	118.7603	1.1746e-26
6	1.56519	+	NA	+	NA	5	-1281.5	2573.0	350.9003	4.5849e-77
8	1.56497	+	-0.00448	+	NA	6	-1281.5	2575.0	352.9026	1.6847e-77
5	0.50918	NA	NA	+	NA	4	-1294.3	2596.6	374.4742	3.4859e-82
7	0.51011	NA	-0.01204	+	NA	5	-1294.2	2598.5	376.4207	1.3172e-82
2	0.09181	+	NA	NA	NA	2	-1374.9	2753.9	531.8022	2.3932e-116
4	0.09343	+	0.01238	NA	NA	3	-1374.9	2755.8	533.7356	9.1022e-117
1	-0.73986	NA	NA	NA	NA	1	-1384.7	2771.5	549.3592	3.6858e-120
3	-0.73980	NA	0.00645	NA	NA	2	-1384.7	2773.4	551.3430	1.3669e-120

Esta función usa el AICc para estimar el ajuste del modelo. EL AICc es una versión corregida del AIC para muestras pequeñas. La función calcula el AICc de todos los modelos posibles y selecciona el mejor modelo. Las cruces en las columnas con los nombres de los predictores indican si el predictor está presente en el modelo. En este ejemplo, el modelo con los 3 predictores es el mejor modelo.

Es importante destacar que el AIC no está definido para ciertos tipos de modelos, lo que imposibilita su cálculo en esas circunstancias. En tales casos, se pueden emplear otros criterios de información, como el BIC o el DIC (ver más adelante). Sin embargo, para modelos más complejos en el ámbito del aprendizaje estadístico, la estructura intrincada de estos modelos a menudo impide la aplicación de criterios de información tradicionales. En estas situaciones, los métodos de selección de modelos basados en la validación cruzada se convierten en una herramienta fundamental, ya que permiten evaluar el desempeño del modelo utilizando particiones repetidas del conjunto de datos.

2.3 Criterios de información adicionales

El AIC es solo uno de varios criterios de información utilizados para evaluar modelos estadísticos. Otros criterios comunes incluyen el Criterio de Información Bayesiano (BIC), el Criterio de Información de Deviance (DIC) y el DIC (una versión corregida del AIC para muestras pequeñas). Aunque cada criterio tiene su propia formulación y énfasis (por ejemplo, el BIC penaliza más fuertemente los modelos con mayor complejidad), todos comparten el objetivo de balancear la calidad de ajuste del modelo con su complejidad para evitar el sobreajuste. Estos criterios pueden ser aplicados de manera similar al AIC y seleccionados según el contexto y los objetivos del análisis. Por ejemplo, el BIC es más conservador en términos de selección de predictores, lo que puede ser útil cuando se desea un modelo más parsimonioso.

El uso de ‘dredge’ para la selección de variables debería ser evitado cuando hay prueba de hipótesis. En lugar de esto, se recomienda el uso de modelos causales por medio de grafos dirigidos acíclicos (DAGs: Directed Acyclic Graphs) para seleccionar las variables, ya que proporcionan un enfoque más sólido y coherente con la inferencia causal.

2.4 Ejercicio 1

Ajusta un modelo de regresión lineal global con los datos de mtcars donde la variable respuesta sea mpg.
Utilice la función dredge para seleccionar el mejor modelo.

3 Validación cruzada

La validación cruzada es una técnica que se utiliza para evaluar la capacidad de generalización de un modelo. Consiste en dividir los datos en k subconjuntos (folds) y ajustar el modelo k veces, cada vez utilizando un subconjunto distinto como conjunto de prueba y el resto como conjunto de entrenamiento. La validación cruzada proporciona una estimación más precisa del rendimiento del modelo en nuevos datos que la división de los datos en un conjunto de entrenamiento y un conjunto de prueba. Esta técnica es particularmente útil cuando se dispone de un número limitado de datos, ya que permite utilizar todos los datos para ajustar el modelo y evaluar su rendimiento. Hay varias variantes de validación cruzada, cada una adecuada para diferentes contextos.

3.1 Validación simple

En su forma mas simple la división de los datos produce un único conjunto de entrenamiento y un único conjunto de prueba. Se conoce en inglés como “hold-out validation”. Aunque no es realmente una forma de validación cruzada en el sentido técnico, es una estrategia ampliamente utilizada para evaluar el desempeño de modelos en situaciones simples o preliminares y es útil para introducir ejemplificar el uso de datos de entrenamiento y datos de ejemplo. Esta estrategia consiste en dividir el conjunto de datos en dos partes:

Conjunto de entrenamiento: Se utiliza para ajustar (entrenar) el modelo.
Conjunto de prueba: Se utiliza para evaluar el modelo ajustado.

Código

# Configurar el conjunto de datos
set.seed(123)
data(mtcars)
mtcars$am <- as.factor(mtcars$am) # Convertir la variable am a factor para clasificación

# Dividir los datos en entrenamiento (80%) y prueba (20%)
indice_entrenamiento <- caret::createDataPartition(mtcars$am, p = 0.8, list = FALSE)
datos_entrenamiento <- mtcars[indice_entrenamiento, ]
datos_prueba <- mtcars[-indice_entrenamiento, ]

# Ajustar un modelo de regresión logística usando los datos de entrenamiento
model <- caret::train(
  am ~ hp + wt,
  data = datos_entrenamiento,
  method = "glm",
  family = "binomial"
)

# Resumen del modelo ajustado
print(model)

Generalized Linear Model 

27 samples
 2 predictor
 2 classes: '0', '1' 

No pre-processing
Resampling: Bootstrapped (25 reps) 
Summary of sample sizes: 27, 27, 27, 27, 27, 27, ... 
Resampling results:

  Accuracy  Kappa  
  0.90663   0.79597

Código

# Hacer predicciones en el conjunto de prueba
predictions <- predict(model, newdata = datos_prueba)

# Evaluar el desempeño del modelo
confusion_matrix <- caret::confusionMatrix(predictions, datos_prueba$am)

# Mostrar los resultados
print(confusion_matrix)

Confusion Matrix and Statistics

          Reference
Prediction 0 1
         0 3 0
         1 0 2
                                    
               Accuracy : 1         
                 95% CI : (0.478, 1)
    No Information Rate : 0.6       
    P-Value [Acc > NIR] : 0.0778    
                                    
                  Kappa : 1         
                                    
 Mcnemar's Test P-Value : NA        
                                    
            Sensitivity : 1.0       
            Specificity : 1.0       
         Pos Pred Value : 1.0       
         Neg Pred Value : 1.0       
             Prevalence : 0.6       
         Detection Rate : 0.6       
   Detection Prevalence : 0.6       
      Balanced Accuracy : 1.0       
                                    
       'Positive' Class : 0

3.2 Validación cruzada simple (k-fold)

La validación cruzada simple divide el conjunto de datos en k subconjuntos y se entrena el modelo k veces, usando cada uno de los subconjuntos como conjunto de prueba una vez. Esta técnica es comúnmente utilizada para evaluar modelos de aprendizaje estadístico. La validación cruzada simple proporciona una estimación más precisa del rendimiento del modelo en nuevos datos que la validación simple, ya que utiliza todos los datos para ajustar el modelo y evaluar su rendimiento. La validación cruzada simple es particularmente útil cuando se dispone de un número limitado de datos, ya que permite utilizar todos los datos para ajustar el modelo y evaluar su rendimiento. Podemos ver un ejemplo de validación cruzada simple en el siguiente código. La función train del paquete caret ajusta el modelo y evalúa su rendimiento utilizando validación cruzada simple:

Código

# Configurar validación cruzada simple con 5 folds
control <- trainControl(method = "cv", number = 5)

# Ajustar modelo usando validación cruzada
set.seed(123)
modelo <- train(
  mpg ~ wt + hp,
  data = mtcars,
  method = "lm",  # Modelo de regresión lineal
  trControl = control
)

# Resultados del modelo
print(modelo)

Linear Regression 

32 samples
 2 predictor

No pre-processing
Resampling: Cross-Validated (5 fold) 
Summary of sample sizes: 26, 25, 25, 26, 26 
Resampling results:

  RMSE    Rsquared  MAE  
  2.7007  0.84844   2.144

Tuning parameter 'intercept' was held constant at a value of TRUE

El argumento “number” controla el numero de subconjuntos (k) en los que se divide el conjunto de datos. En este caso, se utiliza un valor de 5. El modelo se ajusta 5 veces, utilizando cada uno de los subconjuntos como conjunto de prueba una vez.

Código

modelo$resample

RMSE	Rsquared	MAE	Resample
1.8112	0.93248	1.4489	Fold1
2.9085	0.88885	2.2319	Fold2
2.4782	0.72856	2.0412	Fold3
3.2604	0.84493	2.8800	Fold4
3.0452	0.84737	2.1181	Fold5

Código

modelo$results

intercept	RMSE	Rsquared	MAE	RMSESD	RsquaredSD	MAESD
TRUE	2.7007	0.84844	2.144	0.57356	0.07596	0.51082

Note que el resultado del código resume los datos calculando un promedio de las métricas de desempeño en los diferentes subconjuntos:

Código

mean(modelo$resample$RMSE)

[1] 2.7007

Código

mean(modelo$resample$Rsquared)

[1] 0.84844

También podemos extraer un modelo final. En este caso el modelo final es un modelo ajustado en la totalidad de los datos:

Código

summary(modelo$finalModel)


Call:
lm(formula = .outcome ~ ., data = dat)

Residuals:
   Min     1Q Median     3Q    Max 
-3.941 -1.600 -0.182  1.050  5.854 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 37.22727    1.59879   23.28  < 2e-16 ***
wt          -3.87783    0.63273   -6.13  1.1e-06 ***
hp          -0.03177    0.00903   -3.52   0.0015 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 2.59 on 29 degrees of freedom
Multiple R-squared:  0.827, Adjusted R-squared:  0.815 
F-statistic: 69.2 on 2 and 29 DF,  p-value: 9.11e-12

3.3 Dejar uno fuera (Leave-One-Out Cross-Validation, LOOCV)

Cada observación es utilizada como conjunto de prueba una vez. Este enfoque es adecuado para conjuntos de datos pequeños, pero computacionalmente costoso para grandes conjuntos de datos.

Código

# Configurar LOOCV
control <- trainControl(method = "LOOCV")

# Ajustar modelo
set.seed(123)
modelo <- train(
  mpg ~ wt + hp,
  data = mtcars,
  method = "lm",  # Modelo de regresión lineal
  trControl = control
)

# Resultados del modelo
print(modelo)

Linear Regression 

32 samples
 2 predictor

No pre-processing
Resampling: Leave-One-Out Cross-Validation 
Summary of sample sizes: 31, 31, 31, 31, 31, 31, ... 
Resampling results:

  RMSE    Rsquared  MAE   
  2.7755  0.78303   2.1234

Tuning parameter 'intercept' was held constant at a value of TRUE

Este método no devuelve los valores individuales por iteración, pero podemos obtener el modelo final ajustado:

Código

summary(modelo$finalModel)


Call:
lm(formula = .outcome ~ ., data = dat)

Residuals:
   Min     1Q Median     3Q    Max 
-3.941 -1.600 -0.182  1.050  5.854 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 37.22727    1.59879   23.28  < 2e-16 ***
wt          -3.87783    0.63273   -6.13  1.1e-06 ***
hp          -0.03177    0.00903   -3.52   0.0015 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 2.59 on 29 degrees of freedom
Multiple R-squared:  0.827, Adjusted R-squared:  0.815 
F-statistic: 69.2 on 2 and 29 DF,  p-value: 9.11e-12

3.4 Validación cruzada repetida

En este enfoque, la validación cruzada simple se repite varias veces para obtener una evaluación más robusta del modelo.

Código

# Configurar validación cruzada repetida (5 folds, 3 repeticiones)
control <- trainControl(method = "repeatedcv", number = 5, repeats = 3)

# Ajustar modelo
set.seed(123)
modelo <- train(
  mpg ~ wt + hp,
  data = mtcars,
  method = "lm",  # Modelo de regresión lineal
  trControl = control
)

# Resultados del modelo
print(modelo)

Linear Regression 

32 samples
 2 predictor

No pre-processing
Resampling: Cross-Validated (5 fold, repeated 3 times) 
Summary of sample sizes: 26, 25, 25, 26, 26, 25, ... 
Resampling results:

  RMSE    Rsquared  MAE   
  2.6093  0.85947   2.1656

Tuning parameter 'intercept' was held constant at a value of TRUE

Código

modelo$resample

RMSE	Rsquared	MAE	Resample
1.8112	0.93248	1.44890	Fold1.Rep1
2.9085	0.88885	2.23185	Fold2.Rep1
2.4782	0.72856	2.04122	Fold3.Rep1
3.2604	0.84493	2.87996	Fold4.Rep1
3.0452	0.84737	2.11810	Fold5.Rep1
3.7273	0.70065	2.91640	Fold1.Rep2
1.4267	0.94729	1.31007	Fold2.Rep2
0.8549	0.98663	0.66527	Fold3.Rep2
3.8493	0.90974	3.49789	Fold4.Rep2
2.7973	0.75968	2.42463	Fold5.Rep2
4.0172	0.81159	3.39130	Fold1.Rep3
1.9829	0.95206	1.63557	Fold2.Rep3
1.8503	0.91850	1.54283	Fold3.Rep3
3.2477	0.74280	2.63592	Fold4.Rep3
1.8819	0.92096	1.74432	Fold5.Rep3

3.5 Validación de remuestreo con reemplazo (“bootstrap”)

El remuestreo bootstrap genera múltiples muestras con reemplazo para entrenar el modelo y estimar su desempeño.

Código

# Configurar remuestreo bootstrap
control <- trainControl(method = "boot", number = 10)

# Ajustar modelo
set.seed(123)
modelo <- train(
  mpg ~ wt + hp,
  data = mtcars,
  method = "lm",  # Modelo de regresión lineal
  trControl = control
)

# Resultados del modelo
print(modelo)

Linear Regression 

32 samples
 2 predictor

No pre-processing
Resampling: Bootstrapped (10 reps) 
Summary of sample sizes: 32, 32, 32, 32, 32, 32, ... 
Resampling results:

  RMSE    Rsquared  MAE   
  2.9646  0.74983   2.3132

Tuning parameter 'intercept' was held constant at a value of TRUE

Código

modelo$resample

RMSE	Rsquared	MAE	Resample
2.7283	0.61356	2.2136	Resample01
2.8014	0.57724	2.2220	Resample02
2.7525	0.86627	2.0515	Resample03
2.9532	0.72869	2.2321	Resample04
2.7605	0.89815	2.0242	Resample05
2.7978	0.75217	2.3469	Resample06
3.8496	0.77098	3.0208	Resample07
3.0133	0.79124	2.4657	Resample08
2.7202	0.72953	1.9825	Resample09
3.2696	0.77051	2.5720	Resample10

3.6 Validación cruzada balanceada

En problemas de clasificación, la distribución de las clases puede ser desbalanceada. La validación cruzada balanceada garantiza que cada subconjunto tenga una proporción similar de clases, mejorando la estabilidad de las métricas.

Hay dos formas basicas en las que se puede balancear los datos durante las iteraciones de la validación cruzada. La primera (muestrear hacia arriba o “up-sampling”) es balancear forzando que todas las clases tengan el mismo numero de observaciones que la clase mas frecuente. tenga el mismo numero de observaciones. La segunda es balancear “hacia abajo” (down-sampling) forzando todas las clases a tener el mismo numero de observaciones que la clase menos frecuente.

Para muestrear hacia abajo, simplemente definimos el argumento sampling = "up" en la función trainControl:

Código

# Configurar validación cruzada con 10 folds
control <- caret::trainControl(
  method = "cv",
  number = 10,
  classProbs = TRUE,
  sampling = "up"
)

# Ajustar modelo de clasificación
mtcars$am_f <- ifelse(mtcars$am == 1, "manual", "automatico")


set.seed(123)
modelo <- caret::train(
  am_f ~ wt + hp,
  data = mtcars,
  method = "glm",
  family = binomial,
  trControl = control
)

Warning: glm.fit: algorithm did not converge

Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

Código

# Resultados del modelo
print(modelo)

Generalized Linear Model 

32 samples
 2 predictor
 2 classes: 'automatico', 'manual' 

No pre-processing
Resampling: Cross-Validated (10 fold) 
Summary of sample sizes: 29, 29, 28, 28, 28, 29, ... 
Addtional sampling using up-sampling

Resampling results:

  Accuracy  Kappa
  0.95      0.9

Podemos ver las categorías no estaban perfectamente balanceada en los datos originales:

Código

table(mtcars$am_f)


automatico     manual 
        19         13

Sin embargo, la proporción de clases se mantiene constante durante el entrenamiento y para cada categoría el número de observaciones es igual al de la clase mas numerosa:

Código

# ver frecuencia de clases en el modelo final
table(modelo$finalModel$data$.outcome)


automatico     manual 
        19         19

Para muestrear hacia abajo, definimos el argumento sampling = "down":

Código

# Configurar validación cruzada con 10 folds
control <- caret::trainControl(
  method = "cv",
  number = 10,
  classProbs = TRUE,
  sampling = "down"
)


set.seed(123)
modelo <- caret::train(
  am_f ~ wt + hp,
  data = mtcars,
  method = "glm",
  family = binomial,
  trControl = control
)

Warning: glm.fit: algorithm did not converge

Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

Warning: glm.fit: algorithm did not converge

Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

Warning: glm.fit: algorithm did not converge

Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

Warning: glm.fit: algorithm did not converge

Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

Código

# Resultados del modelo
print(modelo)

Generalized Linear Model 

32 samples
 2 predictor
 2 classes: 'automatico', 'manual' 

No pre-processing
Resampling: Cross-Validated (10 fold) 
Summary of sample sizes: 29, 29, 28, 28, 28, 29, ... 
Addtional sampling using down-sampling

Resampling results:

  Accuracy  Kappa
  0.925     0.85

Podemos ver nuevamente como la proporción de clases se mantiene constante durante en el entrenamieto, pero en este caso con el número de observaciones en la categoría menos numerosa:

Código

# ver frecuencia de clases en el modelo final
table(modelo$finalModel$data$.outcome)


automatico     manual 
        13         13

Tambien se han desarrollado metodos hibridos que combinan “up-sampling” y “down-sampling”. El método híbrido “smote” puede ser utilizado de esta forma:

Para muestrear hacia abajo, definimos el argumento sampling = "down":

Código

# Configurar validación cruzada con 10 folds
control <- caret::trainControl(
  method = "cv",
  number = 10,
  classProbs = TRUE,
  sampling = "smote"
)


set.seed(123)
modelo <- caret::train(
  am_f ~ wt + hp,
  data = mtcars,
  method = "glm",
  family = binomial,
  trControl = control
)

Warning: glm.fit: algorithm did not converge

Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

Código

# Resultados del modelo
print(modelo)

Generalized Linear Model 

32 samples
 2 predictor
 2 classes: 'automatico', 'manual' 

No pre-processing
Resampling: Cross-Validated (10 fold) 
Summary of sample sizes: 29, 29, 28, 28, 28, 29, ... 
Addtional sampling using SMOTE

Resampling results:

  Accuracy  Kappa
  0.95      0.9

3.7 Resumen de las técnicas de validación cruzada

Método	Descripcion	Código de caret
Validación cruzada (k-fold)	Divide el conjunto de datos en k partes y usa cada una de ellas como conjunto de prueba una vez.	`trainControl(..., number = 5)`
Balanceada	Similar a k-fold, pero mantiene las proporciones de clases en cada fold.	`trainControl(..., classProbs = TRUE, sampling = 'smote')`
LOOCV (Leave-One-Out)	Usa una observación como conjunto de prueba y las restantes como conjunto de entrenamiento.	`trainControl(method = 'LOOCV')`
Repetida (repeatedcv)	Repite k-fold varias veces para obtener una estimación más robusta del rendimiento del modelo.	`trainControl(method = 'repeatedcv', number = ..., repeats = ...)`
Bootstrap	Genera múltiples muestras con reemplazo para entrenar el modelo y evaluar su desempeño.	`trainControl(method = 'boot', number = ...)`

Cada uno de estos métodos tiene sus ventajas y desventajas, y la elección del método dependerá del tamaño de los datos y de las características del problema (por ejemplo, si es un problema de clasificación o regresión).

Método	Ventajas	Desventajas
Validación cruzada (k-fold)	Rápido y fácil de implementar.	Puede variar según la partición.
Balanceada	Mejora estabilidad en clasificación.	Sólo aplicable en clasificación.
LOOCV (Leave-One-Out)	Usa toda la información disponible.	Computacionalmente costoso.
Repetida (repeatedcv)	Más robusto que k-fold.	Incrementa el tiempo de cómputo.
Bootstrap	Estimación robusta en datos limitados.	Sesgo si hay alta correlación en los datos.

3.8 Ejercicio 2

Utilice 2 de los métodos de validación cruzada mencionados anteriormente para evaluar el desempeño de un modelo de regresión logística en los datos mtcars.

El siguiente código simula un juego de datos donde solo los primeros 3 predictores están asociados a la variable respuesta.

Código

n <- 100  # Número de observaciones
p <- 20  # Número de predictores

# Crear variables predictoras aleatorias
datos <- as.data.frame(matrix(rnorm(n * p), n, p))
colnames(datos) <- paste0("x", 1:p)

# Crear variable de respuesta con una combinación de algunas variables
datos$y <-
  3 * datos$x1 - 2 * datos$x2 + 1 * datos$x3 + rnorm(n, 0, 2)

Utilice la función ‘dredge’ para seleccionar los predictores del modelo de regresión lineal para estos datos.
Utilice la función ‘dredge’ sobre un modelo de regresión lineal utilizando los datos de mtcars donde la variable respuesta sea mpg (millas por galón).
Una vez seleccionados los predictores, ajuste el modelo y evalúe su desempeño utilizando validación cruzada.

4 AIC vs validación cruzada

La elección entre el AIC (Criterio de Información de Akaike) (o selección de modelos en general) y la validación cruzada depende de varios factores relacionados con los datos, el objetivo del modelo y las limitaciones computacionales. Ambos métodos tienen ventajas y desventajas en el contexto de evitar el sobreajuste:

4.0.1 Cuándo usar AIC

Modelos paramétricos bien especificados: AIC es ideal cuando se supone que el modelo sigue una distribución específica y esta está correctamente especificada.
Evaluación relativa de modelos: AIC es útil para comparar varios modelos ajustados a un mismo conjunto de datos y elegir el modelo más parsimonioso (con el mejor equilibrio entre ajuste y complejidad).
Tamaños de muestra moderados a grandes: AIC funciona bien con datos suficientes para que las estimaciones de parámetros sean confiables.
Menor costo computacional: Como AIC no requiere dividir ni reentrenar modelos, es más rápido y eficiente que la validación cruzada.

4.0.2 Cuándo usar validación cruzada

Modelos no paramétricos o más complejos: La validación cruzada se adapta bien a métodos como árboles de decisión, Random Forest o XGBoost, donde las suposiciones paramétricas son menos claras.
Evaluación de capacidad predictiva: Es preferible si el objetivo principal es maximizar la capacidad predictiva en datos futuros.
Tamaños de muestra pequeños: La validación cruzada utiliza el conjunto completo de datos de manera eficiente al dividirlo en diferentes subconjuntos.
Datos con ruido o alta dimensionalidad: Es más robusta para medir el rendimiento real del modelo en presencia de ruido o muchos predictores.

Característica	AIC	Validacion_Cruzada
Objetivo	Equilibrar ajuste y complejidad del modelo.	Maximizar capacidad predictiva.
Naturaleza de los datos	Modelos paramétricos bien especificados.	Modelos complejos o no paramétricos.
Computación	Rápida y eficiente.	Más costosa computacionalmente.
Tamaño de muestra	Moderado a grande.	Pequeño a grande.
Medida de evaluación	Basada en la verosimilitud penalizada.	Basada en error promedio en datos no usados.
Ejemplos de Modelos	Regresiónes: lineal, generalizada, mixta, logística …	Random Forest, XGBoost, Support Vector Machines (SVM).

4.0.3 Recomendación

Usa AIC: Cuando necesitas comparar modelos paramétricos rápidamente en situaciones con suficiente información para confiar en la especificación del modelo.
Usa validación cruzada: Cuando estás trabajando con métodos más complejos, datos con ruido o si la predicción futura precisa es tu principal objetivo.

Ambos enfoques pueden ser complementarios. Por ejemplo, puedes usar AIC para seleccionar un modelo inicial y luego aplicar validación cruzada para confirmar su capacidad predictiva. Estas dos estrategias se eligieron para este tutorial porque abordan el sobreajuste desde perspectivas complementarias. El AIC, basado en principios de inferencia estadística, es ideal cuando los datos se ajustan bien a la estructura asumida por el modelo. Por otro lado, la validación cruzada es flexible y no asume una especificación estricta del modelo, siendo útil en problemas complejos y de aprendizaje estadístico.

Existen otros métodos que permiten evitar el sobreajuste. Algunos de estos son:

Regularización: Métodos como LASSO y Ridge penalizan la complejidad del modelo para evitar ajustes excesivos.
Dropout: Usado en redes neuronales para prevenir dependencia excesiva en nodos específicos durante el entrenamiento.

Información de la sesión

R version 4.4.1 (2024-06-14)
Platform: x86_64-pc-linux-gnu
Running under: Ubuntu 22.04.4 LTS

Matrix products: default
BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.10.0 
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.10.0

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
 [3] LC_TIME=es_CR.UTF-8        LC_COLLATE=en_US.UTF-8    
 [5] LC_MONETARY=es_CR.UTF-8    LC_MESSAGES=en_US.UTF-8   
 [7] LC_PAPER=es_CR.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=es_CR.UTF-8 LC_IDENTIFICATION=C       

time zone: America/Costa_Rica
tzcode source: system (glibc)

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] themis_1.0.2      recipes_1.0.10    dplyr_1.1.4       caret_6.0-94     
 [5] lattice_0.22-6    MuMIn_1.48.4      nnet_7.3-19       viridis_0.6.5    
 [9] viridisLite_0.4.2 ggplot2_3.5.1     knitr_1.49       

loaded via a namespace (and not attached):
 [1] tidyselect_1.2.1     timeDate_4032.109    farver_2.1.2        
 [4] fastmap_1.2.0        RANN_2.6.1           pROC_1.18.5         
 [7] digest_0.6.37        rpart_4.1.23         timechange_0.3.0    
[10] lifecycle_1.0.4      survival_3.7-0       magrittr_2.0.3      
[13] compiler_4.4.1       rlang_1.1.4          tools_4.4.1         
[16] utf8_1.2.4           yaml_2.3.10          data.table_1.15.4   
[19] labeling_0.4.3       htmlwidgets_1.6.4    plyr_1.8.9          
[22] withr_3.0.2          purrr_1.0.2          grid_4.4.1          
[25] stats4_4.4.1         fansi_1.0.6          e1071_1.7-16        
[28] colorspace_2.1-1     future_1.34.0        globals_0.16.3      
[31] scales_1.3.0         iterators_1.0.14     MASS_7.3-61         
[34] cli_3.6.3            rmarkdown_2.28       crayon_1.5.3        
[37] generics_0.1.3       remotes_2.5.0        rstudioapi_0.16.0   
[40] future.apply_1.11.2  reshape2_1.4.4       proxy_0.4-27        
[43] stringr_1.5.1        splines_4.4.1        parallel_4.4.1      
[46] vctrs_0.6.5          hardhat_1.4.0        Matrix_1.7-0        
[49] jsonlite_1.8.9       listenv_0.9.1        packrat_0.9.2       
[52] foreach_1.5.2        gower_1.0.1          glue_1.8.0          
[55] parallelly_1.38.0    codetools_0.2-20     xaringanExtra_0.8.0 
[58] lubridate_1.9.3      stringi_1.8.4        gtable_0.3.6        
[61] munsell_0.5.1        ROSE_0.0-4           tibble_3.2.1        
[64] pillar_1.9.0         htmltools_0.5.8.1    ipred_0.9-14        
[67] lava_1.8.0           R6_2.5.1             evaluate_1.0.1      
[70] sketchy_1.0.3        class_7.3-22         Rcpp_1.0.13-1       
[73] gridExtra_2.3        nlme_3.1-165         prodlim_2024.06.25  
[76] xfun_0.49            pkgconfig_2.0.3      ModelMetrics_1.2.2.2