Leave-One-Week-Out Cross Validation

1. Generar la base de practica

Esta es una base de datos simulada para entender como se hace el cross validation y para saber si lo que estoy haciendo esta bien o no. Es solo practica.

set.seed(123)

# Crear una secuencia de fechas por hora durante 8 meses (~5800 horas)
fecha_hora <- seq(from = as.POSIXct("2023-01-01 00:00:00"), 
                  to = as.POSIXct("2023-08-31 23:00:00"), 
                  by = "1 hour")

n <- length(fecha_hora)

# Simular variables
pm25_referencia <- rnorm(n, mean = 35, sd = 10)  # valor de referencia
temperatura <- rnorm(n, mean = 22, sd = 3)
humedad <- runif(n, min = 40, max = 95)
presion <- rnorm(n, mean = 1013, sd = 5)

# Simular el sensor purple air 
pm25_sensor <- pm25_referencia + rnorm(n, mean = 5, sd = 7)

# Crear dataframe
datos <- data.frame(
  fecha_hora,
  pm25_sensor,
  pm25_referencia,
  temperatura,
  humedad,
  presion
)

# Ver parte de la base
head(datos)

##            fecha_hora pm25_sensor pm25_referencia temperatura  humedad  presion
## 1 2023-01-01 00:00:00    44.90418        29.39524    19.00719 53.49386 1012.942
## 2 2023-01-01 01:00:00    40.24733        32.69823    20.91135 55.85911 1024.600
## 3 2023-01-01 02:00:00    48.09675        50.58708    21.87895 42.11854 1013.735
## 4 2023-01-01 03:00:00    43.91935        35.70508    23.54299 92.53469 1014.016
## 5 2023-01-01 04:00:00    32.68420        36.29288    21.77125 47.66512 1006.956
## 6 2023-01-01 05:00:00    66.88761        52.15065    25.69726 83.04508 1018.420

2. Agregar columna de semana y año

library(lubridate)

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

datos$semana <- isoweek(datos$fecha_hora)
datos$anio <- year(datos$fecha_hora)
datos$id_semana <- paste(datos$anio, datos$semana, sep = "-")

3. Definir los modelos que probare

Solo estoy poniendo 5 modelos de prueba muy simples.

lista_modelos <- list(
  modelo_1 = pm25_referencia ~ pm25_sensor,
  modelo_2 = pm25_referencia ~ pm25_sensor + temperatura,
  modelo_3 = pm25_referencia ~ pm25_sensor + humedad,
  modelo_4 = pm25_referencia ~ pm25_sensor + presion,
  modelo_5 = pm25_referencia ~ pm25_sensor + temperatura + humedad + presion
)

4. Proceso de Leave-One-Week-Out Cross

Por lo que leí el (s in semanas) estás implementando el Leave-One-Week-Out Cross Validation. Entonces en cada iteración selecciona una semana s como el conjunto de pruebas.

Luego en la sección de modelo estoy entrenando el modelo con los datos de entrenamiento y luego haciendo las predicciones sobre los datos de prueba?

Y segun lo que entiendo en cada iteración se guardan los errores de predicción.

Se repite este proceso de dejar una semana hasta que todas las semanas fueron usadas unas vez como prueba, por eso tengo 180 observaciones.

library(Metrics)

semanas <- unique(datos$id_semana)
resultados <- data.frame()

for (modelo_nombre in names(lista_modelos)) {
  formula_actual <- lista_modelos[[modelo_nombre]]
  
  for (s in semanas) {
    datos_prueba <- subset(datos, id_semana == s)
    datos_entrenamiento <- subset(datos, id_semana != s)
    
    modelo <- lm(formula_actual, data = datos_entrenamiento)
    pred <- predict(modelo, newdata = datos_prueba)
    real <- datos_prueba$pm25_referencia
    
    metrica <- data.frame(
      modelo = modelo_nombre,
      semana = s,
      RMSE = rmse(real, pred),
      MAE = mae(real, pred),
      Bias = mean(pred - real),
      R2 = 1 - sum((pred - real)^2) / sum((real - mean(real))^2)
    )
    
    resultados <- rbind(resultados, metrica)
  }
}

5. Resumen

Y finalmente con aggregate sago el promedio por modelo y por variable.

aggregate(cbind(RMSE, MAE, Bias, R2) ~ modelo, data = resultados, mean)

##     modelo     RMSE      MAE        Bias        R2
## 1 modelo_1 5.744893 4.606229 -0.01082470 0.6582205
## 2 modelo_2 5.742961 4.608050 -0.01153438 0.6584473
## 3 modelo_3 5.745490 4.606983 -0.01020508 0.6581509
## 4 modelo_4 5.745426 4.606815 -0.01096614 0.6581565
## 5 modelo_5 5.744079 4.609301 -0.01103664 0.6583158