1 Introducción

En esta actividad se construyen dos modelos de redes neuronales para predecir la variable DriversKilled de la base de datos Seatbelts. Posteriormente, el mejor modelo obtenido se compara contra una Regresión Lineal Múltiple utilizando todas las variables disponibles en la base. El objetivo es identificar cuál enfoque ofrece un mejor desempeño predictivo a partir de métricas de error y visualizaciones comparativas.

2 Objetivo

Desarrollar dos modelos de redes neuronales con distintas arquitecturas para explicar la variable dependiente DriversKilled, y comparar el mejor de ellos contra una Regresión Lineal Múltiple, utilizando:

  • MAE
  • MSE
  • RMSE
  • R²

3 Modelos a comparar

  1. Red Neuronal 1
  2. Red Neuronal 2
  3. Regresión Lineal Múltiple

4 1. Librerías

library(ggplot2)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(corrplot)
## corrplot 0.95 loaded
library(neuralnet)
## 
## Attaching package: 'neuralnet'
## The following object is masked from 'package:dplyr':
## 
##     compute

4.1 Carga de datos

data("Seatbelts")
df <- as.data.frame(Seatbelts)

head(df)
dim(df)
## [1] 192   8
str(df)
## 'data.frame':    192 obs. of  8 variables:
##  $ DriversKilled: num  107 97 102 87 119 106 110 106 107 134 ...
##  $ drivers      : num  1687 1508 1507 1385 1632 ...
##  $ front        : num  867 825 806 814 991 ...
##  $ rear         : num  269 265 319 407 454 427 522 536 405 437 ...
##  $ kms          : num  9059 7685 9963 10955 11823 ...
##  $ PetrolPrice  : num  0.103 0.102 0.102 0.101 0.101 ...
##  $ VanKilled    : num  12 6 12 8 10 13 11 6 10 16 ...
##  $ law          : num  0 0 0 0 0 0 0 0 0 0 ...

4.1.1 VALORES FALTANTES

colSums(is.na(df))
## DriversKilled       drivers         front          rear           kms 
##             0             0             0             0             0 
##   PetrolPrice     VanKilled           law 
##             0             0             0
if (sum(is.na(df)) > 0) {
  for (col in names(df)) {
    if (is.numeric(df[[col]])) {
      df[[col]][is.na(df[[col]])] <- median(df[[col]], na.rm = TRUE)
    }
  }
}

4.1.2 Distribución de la variable DriversKilled

ggplot(df, aes(x = DriversKilled)) +
  geom_histogram(bins = 15, fill = "steelblue", color = "white") +
  labs(
    title = "Distribución de DriversKilled",
    x = "DriversKilled",
    y = "Frecuencia"
  ) +
  theme_minimal()

### Comportamiento temporal de DriversKilled

ggplot(df, aes(x = 1:nrow(df), y = DriversKilled)) +
  geom_line(color = "darkred", linewidth = 1) +
  labs(
    title = "Comportamiento temporal de DriversKilled",
    x = "Periodo",
    y = "DriversKilled"
  ) +
  theme_minimal()

### Matriz de correlación

matriz_cor <- cor(df)
corrplot(matriz_cor, method = "color", type = "upper", tl.col = "black", tl.srt = 45)

4.2 Train test

n <- nrow(df)
train_size <- floor(0.75 * n)

train <- df[1:train_size, ]
test  <- df[(train_size + 1):n, ]

4.3 Definición de métricas de evaluación

evaluar <- function(y_true, y_pred) {
  mae <- mean(abs(y_true - y_pred))
  mse <- mean((y_true - y_pred)^2)
  rmse <- sqrt(mse)
  r2 <- 1 - sum((y_true - y_pred)^2) / sum((y_true - mean(y_true))^2)

  data.frame(MAE = mae, MSE = mse, RMSE = rmse, R2 = r2)
}

4.4 Escalado de variables

features <- setdiff(names(df), "DriversKilled")

# Detectar variables con varianza cero en train
sds <- sapply(train[, features], sd)
features_nn <- names(sds[sds > 0])

features_nn
## [1] "drivers"     "front"       "rear"        "kms"         "PetrolPrice"
## [6] "VanKilled"
train_scaled <- train
test_scaled <- test

means <- sapply(train[, features_nn], mean)
sds   <- sapply(train[, features_nn], sd)

for (col in features_nn) {
  train_scaled[[col]] <- (train[[col]] - means[col]) / sds[col]
  test_scaled[[col]]  <- (test[[col]] - means[col]) / sds[col]
}

4.5 Modelo 1: Red Neuronal simple

formula_nn <- as.formula(
  paste("DriversKilled ~", paste(features_nn, collapse = " + "))
)

train_nn <- train_scaled[, c("DriversKilled", features_nn)]
test_nn  <- test_scaled[, features_nn]

train_nn <- as.data.frame(train_nn)
test_nn  <- as.data.frame(test_nn)

set.seed(42)
rn1 <- neuralnet(
  formula_nn,
  data = train_nn,
  hidden = 8,
  linear.output = TRUE,
  stepmax = 1e+06
)

pred_rn1 <- as.vector(compute(rn1, test_nn)$net.result)
metricas_rn1 <- evaluar(test_scaled$DriversKilled, pred_rn1)

4.6 Modelo 2: Red Neuronal profunda

set.seed(42)
rn2 <- neuralnet(
  formula_nn,
  data = train_nn,
  hidden = c(8, 4),
  linear.output = TRUE,
  stepmax = 1e+06
)

pred_rn2 <- as.vector(compute(rn2, test_nn)$net.result)
metricas_rn2 <- evaluar(test_scaled$DriversKilled, pred_rn2)

metricas_rn2

4.7 Modelo 3: Regresión Lineal Múltiple

modelo_rl <- lm(formula_nn, data = train)

pred_rl <- predict(modelo_rl, newdata = test)
metricas_rl <- evaluar(test$DriversKilled, pred_rl)

metricas_rl

4.8 Comparación de modelos

comparacion <- rbind(
  cbind(Modelo = "Red Neuronal 1", metricas_rn1),
  cbind(Modelo = "Red Neuronal 2", metricas_rn2),
  cbind(Modelo = "Regresión Lineal", metricas_rl)
)

comparacion

4.9 Mejor red neuronal vs valores reales

if (metricas_rn1$RMSE < metricas_rn2$RMSE) {
  mejor_nn_nombre <- "Red Neuronal 1"
  mejor_pred <- pred_rn1
  mejor_metricas <- metricas_rn1
} else {
  mejor_nn_nombre <- "Red Neuronal 2"
  mejor_pred <- pred_rn2
  mejor_metricas <- metricas_rn2
}

df_plot_nn <- data.frame(
  Observacion = 1:length(test_scaled$DriversKilled),
  Real = test_scaled$DriversKilled,
  Prediccion = mejor_pred
)

ggplot(df_plot_nn, aes(x = Observacion)) +
  geom_line(aes(y = Real, color = "Real"), linewidth = 1) +
  geom_line(aes(y = Prediccion, color = "Predicción"), linewidth = 1) +
  labs(
    title = paste("Valores reales vs", mejor_nn_nombre),
    x = "Observación",
    y = "DriversKilled",
    color = ""
  ) +
  theme_minimal()

## Regresión lineal vs valores reales

df_plot_rl <- data.frame(
  Observacion = 1:length(test$DriversKilled),
  Real = test$DriversKilled,
  Prediccion = pred_rl
)

ggplot(df_plot_rl, aes(x = Observacion)) +
  geom_line(aes(y = Real, color = "Real"), linewidth = 1) +
  geom_line(aes(y = Prediccion, color = "Predicción"), linewidth = 1) +
  labs(
    title = "Valores reales vs Regresión Lineal Múltiple",
    x = "Observación",
    y = "DriversKilled",
    color = ""
  ) +
  theme_minimal()

## Interpretación de resultados

cat("Resultados generales\n\n")
## Resultados generales
if (mejor_metricas$RMSE < metricas_rl$RMSE) {
  cat("El modelo con mejor desempeño es", mejor_nn_nombre, ".\n")
  cat("Este modelo presenta un menor RMSE que la regresión lineal múltiple, por lo que ofrece una mejor capacidad predictiva.\n\n")
} else {
  cat("El modelo con mejor desempeño es la Regresión Lineal Múltiple.\n")
  cat("Este modelo presenta un menor RMSE que la mejor red neuronal.\n\n")
}
## El modelo con mejor desempeño es la Regresión Lineal Múltiple.
## Este modelo presenta un menor RMSE que la mejor red neuronal.
cat("Interpretación:\n")
## Interpretación:
cat("Se utilizaron todas las variables disponibles de la base Seatbelts para predecir la variable DriversKilled.\n")
## Se utilizaron todas las variables disponibles de la base Seatbelts para predecir la variable DriversKilled.
cat("Se entrenaron dos redes neuronales con arquitecturas distintas y posteriormente se compararon con una regresión lineal múltiple.\n")
## Se entrenaron dos redes neuronales con arquitecturas distintas y posteriormente se compararon con una regresión lineal múltiple.
cat("El modelo con menor RMSE se considera el más adecuado, ya que sus predicciones se aproximan mejor a los valores reales.\n")
## El modelo con menor RMSE se considera el más adecuado, ya que sus predicciones se aproximan mejor a los valores reales.
cat("Si una red neuronal supera a la regresión lineal, esto sugiere que la relación entre las variables explicativas y DriversKilled no es completamente lineal.\n")
## Si una red neuronal supera a la regresión lineal, esto sugiere que la relación entre las variables explicativas y DriversKilled no es completamente lineal.