Laboratorio 4

El documento está públicado aquí https://rpubs.com/psantizo/1197446

Walmart <- read_csv("Walmart.csv")

## Rows: 6435 Columns: 8
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Date
## dbl (7): Store, Weekly_Sales, Holiday_Flag, Temperature, Fuel_Price, CPI, Un...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Walmart$Date <- dmy(Walmart$Date)

Ejercicio 1 Para el dataset walmart.csv adjunto a este laboratorio deberá desarrollar y encontrar un modelo de regresión que funcione lo mejor posible, tome en cuenta el siguiente flujo de trabajo para resolver el problema.

a. Gráficas de Densidad – Deberá realizar una gráfica de densidad de cada variable continua del dataset (Weekly_Sales, Temperature, Fue_Price, CPI, Unenployment) haciendo un comentario general sobre su opinión al respecto del resultado.

Walmart_selected_variables <- Walmart %>%
  select(Weekly_Sales, Temperature, Fuel_Price, CPI, Unemployment) %>%
  pivot_longer(cols = everything(), names_to = "variable", values_to = "value")

ggplot(Walmart_selected_variables, aes(x = value, fill = variable)) +
  geom_density(alpha = 0.5) +
  facet_wrap(~ variable, scales = "free") +
  labs(title = "Gráficos de densidad", x = "Value", y = "Density") +
  theme(legend.position = "none")

Se observa que en general los graficos de densidad muestran un compartamiento diferente entr las variables seleccionadas, princiipalmente CPI y Fuel price.

b. Para la variable Holiday_Flag y Store deberá realizar una gráfica de barras con la cantidad de ocurrencias de cada clase dentro de la columna. Posteriormente deberá realizar un boxplot entre esta variable y el target (Wekly_Sales) y mostrar un comentario sobre su opinión al respecto de los resultados.

p1 <- ggplot(Walmart, aes(x = factor(Holiday_Flag))) +
  geom_bar(fill = "blue") +
  labs(title = "Ocurrencias of Holiday_Flag", x = "Holiday_Flag", y = "Count")

p2 <- ggplot(Walmart, aes(x = factor(Store))) +
  geom_bar(fill = "blue") +
  labs(title = "Ocurrencias of Store", x = "Store", y = "Count")

p3 <- ggplot(Walmart, aes(x = factor(Holiday_Flag), y = Weekly_Sales)) +
  geom_boxplot() +
  labs(title = "Weekly Sales y Holiday_Flag", x = "Holiday_Flag", y = "Weekly Sales")

p4 <- ggplot(Walmart, aes(x = factor(Store), y = Weekly_Sales)) +
  geom_boxplot() +
  labs(title = "Weekly Sales y Store", x = "Store", y = "Weekly Sales")

grid.arrange(p1, p2, p3, p4, ncol = 2)

Se observa que las ocurrencias de Holida_Flag son 0,1, en su gran mayoria 0. Para las ocurencias de Store se observa que son las misma en todas las observaciones. Para el caso de los Boxplot, se observa que en Holiday_Flag 1, hay outliers y el último cuartil muestra estar sesgado hacia la derecha. Por su parte Store, mutra un comportamiento más disperso entre tiendas.

C. Para la variable Date deberá mostrar una gráfica de serie temporal donde la serie sea el target (Wekly_Sales).

p1 <- ggplot(Walmart, aes(x = Date, y = Weekly_Sales)) +
  geom_line(color = "blue") +  
  labs(title = "Weekly diario", x = "Date", y = "Weekly Sales") +
  theme_minimal()  

Walmart_weekly <- Walmart %>%
  mutate(Week = floor_date(Date, "week")) %>%
  group_by(Week) %>%
  summarise(Weekly_Sales = sum(Weekly_Sales, na.rm = TRUE))

p2 <- ggplot(Walmart_weekly, aes(x = Week, y = Weekly_Sales)) +
  geom_line(color = "blue") +  
  labs(title = "Weekly Sales semanal", x = "Week", y = "Weekly Sales") +
  theme_minimal()  

grid.arrange(p1, p2, ncol = 1)

d. Posteriormente deberá mostrar una gráfica de la matriz de correlación entre todas las variables continuas.

corr_matrix <- cor(Walmart[, c("Weekly_Sales", "Temperature", "Fuel_Price", "CPI", "Unemployment")])
corrplot(corr_matrix, method = "circle",addCoef.col = "grey50")

e. Para finalizar el EDA deberá realizar un comentario solido sobre sus hallazgos en el dataset previo a realizar un modelo, la idea es proporcionar una opinión a priori de que se puede esperar de las variables involucradas en el este modelo.

• La distribución de las ventas semanales es sesgada a la derecha.
• Las variables de temperatura, precio del combustible, CPI y desempleo presentan parecidas a una normal
• Las ventas tienden a ser más altas en días festivos.
• Hay variabilidad considerable entre tiendas en términos de ventas semanales.
• La serie temporal diaria es muy volatil, pero semanal muestra un mejor comportamiento.
• Existen correlaciones debiles entre las variables continuas, puede ser porque la base de datos esta diaria.

Modelos de Regresión – Luego del EDA y considerando sus hallazgos, deberá desarrollar los siguientes pasos para implementar modelos de regresión:

a. Realice una partición de datos para entrenamiento y testing de los modelos resultantes (registro y calificación de los modelos).

train_index <- createDataPartition(Walmart$Weekly_Sales, p = 0.8, list = FALSE)
train_data <- Walmart[train_index, ]
test_data <- Walmart[-train_index, ]

b. Con la variable Date cree nuevas columnas realizando una descomposición en año, mes y día, además agregue el día de la semana y si es fin de semana esto lo puede hacer usando la librería lubridate. Al completar, elimine la columna de Date original.

train_data <- train_data %>%
  mutate(Year = year(Date), 
         Month = month(Date), 
         Day = day(Date), 
         Weekday = wday(Date, label = TRUE),
         Is_Weekend = ifelse(Weekday %in% c("Sat", "Sun"), 1, 0)) %>%
  select(-Date)

test_data <- test_data %>%
  mutate(Year = year(Date), 
         Month = month(Date), 
         Day = day(Date), 
         Weekday = wday(Date, label = TRUE),
         Is_Weekend = ifelse(Weekday %in% c("Sat", "Sun"), 1, 0)) %>%
  select(-Date)

head(train_data)

## # A tibble: 6 × 12
##   Store Weekly_Sales Holiday_Flag Temperature Fuel_Price   CPI Unemployment
##   <dbl>        <dbl>        <dbl>       <dbl>      <dbl> <dbl>        <dbl>
## 1     1     1643691.            0        42.3       2.57  211.         8.11
## 2     1     1611968.            0        39.9       2.51  211.         8.11
## 3     1     1409728.            0        46.6       2.56  211.         8.11
## 4     1     1439542.            0        57.8       2.67  211.         8.11
## 5     1     1472516.            0        54.6       2.72  211.         8.11
## 6     1     1404430.            0        51.4       2.73  211.         8.11
## # ℹ 5 more variables: Year <dbl>, Month <dbl>, Day <int>, Weekday <ord>,
## #   Is_Weekend <dbl>

c. Verifique si su dataset tiene faltantes, en caso de ser así puede utilizar alguna estrategia de imputación como imputación por media o mediana.

sum(is.na(train_data))

## [1] 0

sum(is.na(test_data))

## [1] 0

d. Defina un driver de control de entrenamiento y validación cruzada utilizando el método repeatedcv (Repeated Cross-Validation)

train_control <- trainControl(method = "repeatedcv", number = 10, repeats = 3)

Implemente los siguientes modelos considerando la métrica de RMSE como base para decidir que modelo funciona mejor, recuerde usar la variable Weekly_Sales como target:

Regrsesión lineal multiple

lm_model <- train(Weekly_Sales ~ ., data = train_data, method = "lm", trControl = train_control)
summary(lm_model)

## 
## Call:
## lm(formula = .outcome ~ ., data = dat)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1053531  -382736   -35156   366973  2522795 
## 
## Coefficients: (7 not defined because of singularities)
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  79197330.9 33520797.2   2.363   0.0182 *  
## Store          -15788.8      580.6 -27.194  < 2e-16 ***
## Holiday_Flag    -1146.3    29690.9  -0.039   0.9692    
## Temperature     -1618.3      434.9  -3.721   0.0002 ***
## Fuel_Price      61313.7    28423.6   2.157   0.0310 *  
## CPI             -2176.0      213.7 -10.180  < 2e-16 ***
## Unemployment   -23346.9     4351.9  -5.365 8.46e-08 ***
## Year           -38495.7    16705.3  -2.304   0.0212 *  
## Month           15018.2     2436.3   6.164 7.62e-10 ***
## Day             -1103.0      825.1  -1.337   0.1814    
## Weekday.L            NA         NA      NA       NA    
## Weekday.Q            NA         NA      NA       NA    
## Weekday.C            NA         NA      NA       NA    
## `Weekday^4`          NA         NA      NA       NA    
## `Weekday^5`          NA         NA      NA       NA    
## `Weekday^6`          NA         NA      NA       NA    
## Is_Weekend           NA         NA      NA       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 518900 on 5141 degrees of freedom
## Multiple R-squared:  0.1569, Adjusted R-squared:  0.1554 
## F-statistic: 106.3 on 9 and 5141 DF,  p-value: < 2.2e-16

Regresiónn ridge

set.seed(123)
ridge_model <- train(Weekly_Sales ~ ., data = train_data, method = "glmnet",
                     trControl = train_control,
                     tuneGrid = expand.grid(alpha = 0, lambda = seq(0.001, 0.1, by = 0.001)))
ridge_model$bestTune

##     alpha lambda
## 100     0    0.1

Regresión lasso

lasso_model <- train(Weekly_Sales ~ ., data = train_data, method = "glmnet",
                     trControl = train_control,
                     tuneGrid = expand.grid(alpha = 1, lambda = seq(0.001, 0.1, by = 0.001)))
lasso_model$bestTune

##     alpha lambda
## 100     1    0.1

Regresión elastic-net

elastic_net_model <- train(Weekly_Sales ~ ., data = train_data, method = "glmnet",
                           trControl = train_control,
                           tuneGrid = expand.grid(alpha = seq(0, 1, by = 0.1), 
                                                  lambda = seq(0.001, 0.1, by = 0.001)))
elastic_net_model$bestTune

##     alpha lambda
## 700   0.6    0.1

###Stewise Regression

stepwise_model <- train(Weekly_Sales ~ ., data = train_data, method = "leapSeq",
                        trControl = train_control, tuneGrid = data.frame(nvmax = 1:10))
stepwise_model$bestTune

##   nvmax
## 8     8

##Evaluación de los modelos

models <- list(lm = lm_model, ridge = ridge_model, lasso = lasso_model, elastic_net = elastic_net_model, stepwise = stepwise_model)

results <- resamples(models)
summary(results)

## 
## Call:
## summary.resamples(object = results)
## 
## Models: lm, ridge, lasso, elastic_net, stepwise 
## Number of resamples: 30 
## 
## MAE 
##                 Min.  1st Qu.   Median     Mean  3rd Qu.     Max. NA's
## lm          405666.8 424204.7 428288.3 428035.6 435864.6 449215.1    0
## ridge       407559.2 419990.6 426963.2 428340.5 436206.8 455629.6    0
## lasso       407691.8 419920.7 428382.3 428199.7 434419.4 450755.5    0
## elastic_net 397587.3 424400.2 429564.9 428154.4 433711.3 457214.1    0
## stepwise    411085.6 419722.8 430383.3 428018.0 435101.9 444681.4    0
## 
## RMSE 
##                 Min.  1st Qu.   Median     Mean  3rd Qu.     Max. NA's
## lm          486158.5 513208.9 519654.4 518986.1 530542.7 542231.0    0
## ridge       492175.3 510287.8 514891.0 519101.0 531797.1 557589.8    0
## lasso       495470.2 510533.7 518190.3 519271.6 526347.6 545015.9    0
## elastic_net 479554.5 508476.4 516951.1 519183.2 530202.3 563209.9    0
## stepwise    499464.4 509061.6 521751.9 519034.3 528662.0 537393.7    0
## 
## Rsquared 
##                   Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
## lm          0.08639323 0.1406601 0.1555420 0.1558615 0.1718240 0.1977384    0
## ridge       0.09283812 0.1377377 0.1545919 0.1556647 0.1775073 0.2085665    0
## lasso       0.08863227 0.1283891 0.1528924 0.1556263 0.1750210 0.2352555    0
## elastic_net 0.10260639 0.1262758 0.1629519 0.1553575 0.1725995 0.2437330    0
## stepwise    0.06809077 0.1418184 0.1617290 0.1561421 0.1763471 0.1976659    0

final_models <- lapply(models, function(model) {
  train(Weekly_Sales ~ ., data = train_data, method = model$method, trControl = train_control, 
        tuneGrid = model$bestTune)
})



final_results <- sapply(final_models, function(model) {
  pred <- predict(model, newdata = test_data)
  RMSE(pred, test_data$Weekly_Sales)
})


results_df <- data.frame(
  Id = 1:length(final_models),
  Nombre_del_modelo = names(final_models),
  Hyper_parametros_ganadores = sapply(final_models, function(model) paste(model$bestTune, collapse = ",")),
  RMSE_de_registro = final_results,
  Variables_incluidas = sapply(final_models, function(model) {
    if (inherits(model$finalModel, "regsubsets")) {
      # Here we assume the bestTune contains the id for regsubsets, or adapt this part accordingly
      id <- model$bestTune$nvmax  # Replace with appropriate method to get 'id' if different
      paste(names(coef(model$finalModel, id = id)), collapse = ",")
    } else {
      paste(names(coef(model$finalModel)), collapse = ",")
    }
  }),
  Tag_del_modelo = ifelse(final_results == min(final_results), "Champion", ifelse(final_results == max(final_results), "Deprecated", "Challenger"))
)

results_df

##             Id Nombre_del_modelo Hyper_parametros_ganadores RMSE_de_registro
## lm           1                lm                       TRUE         529621.6
## ridge        2             ridge                      0,0.1         529197.1
## lasso        3             lasso                      1,0.1         529551.6
## elastic_net  4       elastic_net                    0.6,0.1         529549.3
## stepwise     5          stepwise                          8         529825.2
##                                                                                                                                                            Variables_incluidas
## lm          (Intercept),Store,Holiday_Flag,Temperature,Fuel_Price,CPI,Unemployment,Year,Month,Day,Weekday.L,Weekday.Q,Weekday.C,`Weekday^4`,`Weekday^5`,`Weekday^6`,Is_Weekend
## ridge                                                                                                                                                                         
## lasso                                                                                                                                                                         
## elastic_net                                                                                                                                                                   
## stepwise                                                                                     (Intercept),Store,Holiday_Flag,Temperature,Fuel_Price,CPI,Unemployment,Year,Month
##             Tag_del_modelo
## lm              Challenger
## ridge             Champion
## lasso           Challenger
## elastic_net     Challenger
## stepwise        Deprecated

test_data$Id <- 1:nrow(test_data)

predictions_df <- data.frame(Id = test_data$Id)

for (name in names(final_models)) {
  predictions_df[[name]] <- predict(final_models[[name]], newdata = test_data)
}

write.csv(results_df, "results_summary.csv", row.names = FALSE)
write.csv(predictions_df, "predictions.csv", row.names = FALSE)

#El modelo lasso mostró un mejor resultado.

results_df%>%filter(Tag_del_modelo=="Champion")

##       Id Nombre_del_modelo Hyper_parametros_ganadores RMSE_de_registro
## ridge  2             ridge                      0,0.1         529197.1
##       Variables_incluidas Tag_del_modelo
## ridge                           Champion

Ejercicio #2: Algoritmos de Machine Learning para Regresión

1. Árboles de Decisión para Regresiones

¿Cómo funciona el algoritmo? El árbol de decisión divide los datos en subconjuntos basados en características específicas.

¿Para qué casos es bueno este algoritmo? Es ideal para datos con relaciones no lineales complejas.

¿Para qué casos no es bueno este algoritmo? No es adecuado para datos con alta variabilidad y ruido.

¿Cuál es la complejidad computacional de este algoritmo? Su complejidad es O(n*log(n)).

¿Qué ventajas tiene este algoritmo sobre los demás? Ofrece facilidad de interpretación y visualización.

¿Qué desventajas tiene este algoritmo sobre los demás? Es propenso a sobreajuste sin una poda adecuada.

Hiper-parámetros en scikit-learn: Los parámetros configurables incluyen max_depth, min_samples_split, min_samples_leaf, y max_features.

2. K-Nearest Neighbors para Regresiones

¿Cómo funciona el algoritmo? El K-Nearest Neighbors promedia los valores de los vecinos más cercanos.

¿Para qué casos es bueno este algoritmo? Funciona bien con datos pequeños y bien distribuidos.

¿Para qué casos no es bueno este algoritmo? No es adecuado para datos grandes y con alta dimensionalidad.

¿Cuál es la complejidad computacional de este algoritmo? Tiene una complejidad de O(n^2).

¿Qué ventajas tiene este algoritmo sobre los demás? Es intuitivo y fácil de implementar.

¿Qué desventajas tiene este algoritmo sobre los demás? Se vuelve lento con grandes conjuntos de datos.

Hiper-parámetros en scikit-learn: Los parámetros a configurar son n_neighbors, weights, algorithm, y leaf_size.

3. SVR – Support Vector Regression

¿Cómo funciona el algoritmo? El Support Vector Regression encuentra un hiperplano que minimiza el error total.

¿Para qué casos es bueno este algoritmo? Es efectivo con datos que tienen una clara separación de margen.

¿Para qué casos no es bueno este algoritmo? No funciona bien con datos ruidosos y sin un patrón claro.

¿Cuál es la complejidad computacional de este algoritmo? Su complejidad es O(n^2 * m).

¿Qué ventajas tiene este algoritmo sobre los demás? Es eficaz en espacios de alta dimensión.

¿Qué desventajas tiene este algoritmo sobre los demás? Requiere un ajuste intensivo de parámetros.

Hiper-parámetros en scikit-learn: Los parámetros importantes incluyen C, epsilon, kernel, y gamma.

4. Ensambles para Regresiones

a. Random Forest

¿Cómo funciona el algoritmo? El Random Forest promedia los resultados de múltiples árboles de decisión.

¿Para qué casos es bueno este algoritmo? Es útil para datos con ruido y estructuras complejas.

¿Para qué casos no es bueno este algoritmo? No es ideal para datos con gran número de características irrelevantes.

¿Cuál es la complejidad computacional de este algoritmo? Su complejidad es O(n*m*log(m)).

¿Qué ventajas tiene este algoritmo sobre los demás? Reduce el sobreajuste y es robusto al ruido.

¿Qué desventajas tiene este algoritmo sobre los demás? Tiene una interpretabilidad limitada.

Hiper-parámetros en scikit-learn: Se pueden configurar n_estimators, max_depth, min_samples_split, y max_features.

b. Gradient Boosting

¿Cómo funciona el algoritmo? El Gradient Boosting combina múltiples modelos débiles secuencialmente.

¿Para qué casos es bueno este algoritmo? Es adecuado para datos con tendencias graduales complejas.

¿Para qué casos no es bueno este algoritmo? No es bueno para datos con ruido extremo.

¿Cuál es la complejidad computacional de este algoritmo? Su complejidad es O(n*m*log(m)).

¿Qué ventajas tiene este algoritmo sobre los demás? Mejora iterativa y alta precisión.

¿Qué desventajas tiene este algoritmo sobre los demás? Es propenso a sobreajuste y es más lento.

Hiper-parámetros en scikit-learn: Los parámetros a ajustar son n_estimators, learning_rate, max_depth, y min_samples_split.

c. XGBoost

¿Cómo funciona el algoritmo? El XGBoost es una optimización avanzada de gradient boosting.

¿Para qué casos es bueno este algoritmo? Es ideal para datos grandes con muchas características.

¿Para qué casos no es bueno este algoritmo? No es adecuado para pequeños conjuntos de datos simples.

¿Cuál es la complejidad computacional de este algoritmo? Tiene una complejidad de O(n*log(n)).

¿Qué ventajas tiene este algoritmo sobre los demás? Ofrece alta velocidad y rendimiento.

¿Qué desventajas tiene este algoritmo sobre los demás? Es complejo de implementar.

Hiper-parámetros en scikit-learn: Los parámetros configurables incluyen n_estimators, learning_rate, max_depth, y subsample.

d. Ada Boost

¿Cómo funciona el algoritmo? El Ada Boost combina varios modelos débiles y pondera los errores.

¿Para qué casos es bueno este algoritmo? Es útil para datos con desequilibrio de clases.

¿Para qué casos no es bueno este algoritmo? No es adecuado para datos con mucho ruido y outliers.

¿Cuál es la complejidad computacional de este algoritmo? La complejidad computacional de AdaBoost depende del número de iteraciones \(T\) y del número de muestras \(n\). Si el clasificador débil es un árbol de decisión de profundidad uno (stump), la complejidad es \(O(T \cdot n \cdot \log(n))\).

¿Qué ventajas tiene este algoritmo sobre los demás? Ofrece simplicidad y eficiencia.

¿Qué desventajas tiene este algoritmo sobre los demás? Es sensible a datos ruidosos.

Hiper-parámetros en scikit-learn: Los parámetros importantes son n_estimators, learning_rate, y base_estimator.

Referencias

• Hastie, T., Tibshirani, R., & Friedman, J. (2009). The Elements of Statistical Learning. Springer.
• Pedregosa, F., et al. (2011). Scikit-learn: Machine Learning in Python. Journal of Machine Learning Research
• Breiman, L. (2001). Random Forests. Machine Learning
• Friedman, J. H. (2001). Greedy Function Approximation: A Gradient Boosting Machine. Annals of Statistics