1 Librerías

Se cargan las librerías necesarias para el análisis, incluyendo herramientas para redes neuronales, regresión y visualización.

library(stats)
library(psych)
library(MASS)
library(ISLR)
library(fRegression)
library(vcd)
library(dplyr)
library(openxlsx)
library(mlbench)
library(magrittr)
library(neuralnet)
library(keras3)
library(caret)

2 Lectura y Exploración de Datos

En este análisis se utilizó el dataset Seatbelts, el cual contiene información sobre muertes en carreteras en Gran Bretaña. Se verificó la estructura de los datos mediante las funciones str() y head(), con el objetivo de entender las variables disponibles y su tipo de dato.

data("Seatbelts")
data <- as.data.frame(Seatbelts)
str(data)
## '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 ...
head(data)
##   DriversKilled drivers front rear   kms PetrolPrice VanKilled law
## 1           107    1687   867  269  9059   0.1029718        12   0
## 2            97    1508   825  265  7685   0.1023630         6   0
## 3           102    1507   806  319  9963   0.1020625        12   0
## 4            87    1385   814  407 10955   0.1008733         8   0
## 5           119    1632   991  454 11823   0.1010197        10   0
## 6           106    1511   945  427 12391   0.1005812        13   0

Como parte del preprocesamiento, se revisó que todas las variables fueran numéricas, ya que las redes neuronales requieren este tipo de entradas para poder operar correctamente. En este caso, todas las variables del dataset ya se encontraban en formato numérico, por lo que no fue necesario realizar transformaciones adicionales.

# Verificación de valores faltantes por columna
colSums(is.na(data))
## DriversKilled       drivers         front          rear           kms 
##             0             0             0             0             0 
##   PetrolPrice     VanKilled           law 
##             0             0             0

No se detectaron valores faltantes en el dataset, por lo que no fue necesario realizar imputaciones.


3 Partición de Datos y Estandarización

Se realizó una partición de los datos en conjuntos de entrenamiento (75%) y prueba (25%), con el objetivo de evaluar el desempeño de los modelos sobre datos no vistos previamente.

set.seed(13)
train = createDataPartition(y = data$DriversKilled, p = 0.75, list = FALSE, times = 1)
data_train = data[train,]
data_test  = data[-train,]

A continuación se separan las matrices de entrenamiento y prueba, y se estandarizan las variables predictoras utilizando únicamente la media y desviación estándar del conjunto de entrenamiento, con el fin de evitar fuga de información hacia el conjunto de prueba.

# Separar variable objetivo y predictoras
training      <- as.matrix(data_train[,-1])
trainingtarget <- as.matrix(data_train[,1])
test          <- as.matrix(data_test[,-1])
testtarget    <- as.matrix(data_test[,1])

# Estandarización con media y desviación estándar del conjunto de entrenamiento
m <- colMeans(training)            # Media por columna
s <- apply(training, 2, sd)       # Desviación estándar por columna

training <- scale(training, center = m, scale = s)
test     <- scale(test,     center = m, scale = s)

4 Modelo 1: Red Neuronal con 2 Capas Ocultas (8, 5 neuronas)

Se construyó la primera red neuronal con dos capas ocultas de 8 y 5 neuronas respectivamente. El objetivo del modelo es predecir la variable DriversKilled a partir del resto de las variables del dataset. Se utilizó función de activación sigmoide, estandarización previa, y múltiples inicializaciones aleatorias (rep = 3) para mejorar la estabilidad del entrenamiento.

# Preparar datos de entrenamiento estandarizados (incluyendo variable objetivo estandarizada)
data_train_S <- as.data.frame(cbind(training, (trainingtarget - mean(trainingtarget)) / sd(trainingtarget)))
colnames(data_train_S) <- colnames(data_train)

# Ajuste: Red Neuronal con 2 capas ocultas (8 y 5 neuronas)
RNS <- neuralnet(DriversKilled ~ .,
                 data          = data_train_S,
                 hidden        = c(8, 5),        # 2 capas ocultas: 8 y 5 neuronas
                 linear.output = TRUE,
                 lifesign      = 'full',
                 rep           = 3,              # 3 inicializaciones aleatorias
                 threshold     = 0.02,           # Criterio de convergencia
                 stepmax       = 50000)          # Límite máximo de iteraciones
## hidden: 8, 5    thresh: 0.02    rep: 1/3    steps:    1000   min thresh: 0.0976385672195642
##                                                       2000   min thresh: 0.0637331991731137
##                                                       3000   min thresh: 0.0379752072012789
##                                                       4000   min thresh: 0.0355597121528305
##                                                       5000   min thresh: 0.027547547346676
##                                                       6000   min thresh: 0.027547547346676
##                                                       7000   min thresh: 0.027547547346676
##                                                       8000   min thresh: 0.027547547346676
##                                                       9000   min thresh: 0.027547547346676
##                                                       9874   error: 0.84627  time: 2.12 secs
## hidden: 8, 5    thresh: 0.02    rep: 2/3    steps:    1000   min thresh: 0.10024749039274
##                                                       2000   min thresh: 0.0719825180494916
##                                                       3000   min thresh: 0.0410014806650157
##                                                       4000   min thresh: 0.0274942553791839
##                                                       4395   error: 0.51832  time: 0.78 secs
## hidden: 8, 5    thresh: 0.02    rep: 3/3    steps:    1000   min thresh: 0.100847616250768
##                                                       2000   min thresh: 0.070757475110224
##                                                       3000   min thresh: 0.046275905226086
##                                                       4000   min thresh: 0.0315445401883229
##                                                       5000   min thresh: 0.0228582636012015
##                                                       6000   min thresh: 0.0217377105339415
##                                                       7000   min thresh: 0.0211694653798529
##                                                       7825   error: 1.1811   time: 1.46 secs

4.1 Visualización de la Red Neuronal 1

plot(RNS,
     col.hidden         = 'darkgreen',
     col.hidden.synapse = 'darkgreen',
     show.weights       = TRUE,
     information        = FALSE,
     fill               = 'lightblue')

4.2 Predicciones y Métricas — Modelo 1

Se realizaron predicciones sobre el conjunto de prueba y se desestandarizaron los resultados para interpretarlos en la escala original de DriversKilled.

# Preparar datos de prueba estandarizados
data_test_S <- as.data.frame(test)
colnames(data_test_S) <- colnames(data_test)[-1]

# Predicciones en escala estandarizada
RNSPredictions <- predict(RNS, data_test_S)

# [MÉTRICA] Correlación — Modelo 1 (RNS)
cor(RNSPredictions, (testtarget - mean(trainingtarget)) / sd(trainingtarget))
##           [,1]
## [1,] 0.3454296
# Desestandarización de predicciones a escala original
RNSPred <- RNSPredictions * sd(trainingtarget) + mean(trainingtarget)

# [MÉTRICA] MSE — Modelo 1 (RNS)
RSSnn   <- (RNSPred - testtarget)^2
MSE_NN1 <- sum(RSSnn) / nrow(testtarget)   # MSE = 584.915
MSE_NN1
## [1] 665.3969
# [MÉTRICA] R² — Modelo 1 (RNS)
R2_NN1 <- 1 - sum(RSSnn) / sum((testtarget - mean(trainingtarget))^2)   # R² = 0.00457
R2_NN1
## [1] -0.1323966
plot(RNSPred, testtarget,
     xlab = "Predicciones RNS",
     ylab = "Valores Reales (DriversKilled)",
     main = "Real vs. Predicho — Modelo 1: Red Neuronal (8, 5)")
abline(a = 0, b = 1, col = "red", lwd = 2)
Figura 2. Valores reales vs. predichos — Red Neuronal RNS (8, 5 neuronas).

Figura 2. Valores reales vs. predichos — Red Neuronal RNS (8, 5 neuronas).

A pesar de la estandarización y múltiples inicializaciones, el modelo muestra un desempeño muy pobre (R² ≈ -13.24%), indicando que la arquitectura de 2 capas ocultas con 8 y 5 neuronas no captura efectivamente las relaciones en este conjunto de datos.


5 Modelo 2: Red Neuronal con 2 Capas Ocultas (4, 2 neuronas)

Se realizó un segundo intento utilizando una arquitectura más simple, con 2 capas ocultas de 4 y 2 neuronas respectivamente, con el fin de evaluar si una menor complejidad mejora el desempeño del modelo.

# Ajuste: Red Neuronal simplificada con 2 capas ocultas (4 y 2 neuronas)
RNS2 <- neuralnet(DriversKilled ~ .,
                  data          = data_train_S,
                  hidden        = c(4, 2),       # 2 capas ocultas: 4 y 2 neuronas
                  linear.output = TRUE,
                  lifesign      = 'full',
                  rep           = 2,             # 2 inicializaciones aleatorias
                  threshold     = 0.02,          # Criterio de convergencia (igual que Modelo 1)
                  stepmax       = 35000)         # Límite de iteraciones reducido
## hidden: 4, 2    thresh: 0.02    rep: 1/2    steps:    1000   min thresh: 0.0731160388248888
##                                                       2000   min thresh: 0.0731160388248888
##                                                       3000   min thresh: 0.0731160388248888
##                                                       4000   min thresh: 0.0731160388248888
##                                                       5000   min thresh: 0.0300506862039487
##                                                       6000   min thresh: 0.0273828969667945
##                                                       7000   min thresh: 0.0273828969667945
##                                                       8000   min thresh: 0.0273828969667945
##                                                       8852   error: 3.40672  time: 1.69 secs
## hidden: 4, 2    thresh: 0.02    rep: 2/2    steps:    1000   min thresh: 0.0621912822719282
##                                                       2000   min thresh: 0.0621912822719282
##                                                       3000   min thresh: 0.0621912822719282
##                                                       4000   min thresh: 0.0621912822719282
##                                                       5000   min thresh: 0.0621912822719282
##                                                       6000   min thresh: 0.0574192756500299
##                                                       7000   min thresh: 0.0574192756500299
##                                                       8000   min thresh: 0.052351887877389
##                                                       9000   min thresh: 0.052351887877389
##                                                      10000   min thresh: 0.0496073970249901
##                                                      11000   min thresh: 0.0496073970249901
##                                                      12000   min thresh: 0.0465918712548444
##                                                      13000   min thresh: 0.0310198913169473
##                                                      14000   min thresh: 0.022897779314653
##                                                      15000   min thresh: 0.022897779314653
##                                                      15262   error: 4.20629  time: 1.88 secs

5.1 Visualización de la Red Neuronal 2

plot(RNS2,
     col.hidden         = 'darkgreen',
     col.hidden.synapse = 'darkgreen',
     show.weights       = TRUE,
     information        = FALSE,
     fill               = 'lightblue')

5.2 Predicciones y Métricas — Modelo 2

# Predicciones en escala estandarizada
RNS2Predictions <- predict(RNS2, data_test_S)

# [MÉTRICA] Correlación — Modelo 2 (RNS2)
cor(RNS2Predictions, (testtarget - mean(trainingtarget)) / sd(trainingtarget))
##           [,1]
## [1,] 0.5716882
# Desestandarización de predicciones a escala original
RNS2Pred <- RNS2Predictions * sd(trainingtarget) + mean(trainingtarget)

# [MÉTRICA] MSE — Modelo 2 (RNS2)
RSS2nn  <- (RNS2Pred - testtarget)^2
MSE_NN2 <- sum(RSS2nn) / nrow(testtarget)   # MSE = 661.54
MSE_NN2
## [1] 790.6726
# [MÉTRICA] R² — Modelo 2 (RNS2)
R2_NN2 <- 1 - sum(RSS2nn) / sum((testtarget - mean(trainingtarget))^2)   # R² = -0.1258
R2_NN2
## [1] -0.3455954
plot(RNS2Pred, testtarget,
     xlab = "Predicciones RNS2",
     ylab = "Valores Reales (DriversKilled)",
     main = "Real vs. Predicho — Modelo 2: Red Neuronal (4, 2)")
abline(a = 0, b = 1, col = "red", lwd = 2)
Figura 4. Valores reales vs. predichos — Red Neuronal RNS2 (4, 2 neuronas).

Figura 4. Valores reales vs. predichos — Red Neuronal RNS2 (4, 2 neuronas).

Al simplificar la arquitectura a 2 capas ocultas con 4 y 2 neuronas, el desempeño se deteriora aún más, resultando en un R² negativo (R² = -34.56%). Esto significa que el modelo realiza predicciones peor que simplemente usar la media del conjunto de entrenamiento como predictor.


6 Modelo 3: Regresión Lineal Múltiple

Como punto de comparación, se ajustó un modelo de regresión lineal múltiple utilizando todas las variables explicativas disponibles en el dataset.

# Ajuste del modelo de Regresión Lineal Múltiple
LRM <- lm(DriversKilled ~ ., data = data_train)
summary(LRM)
## 
## Call:
## lm(formula = DriversKilled ~ ., data = data_train)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -29.578  -7.211  -0.655   6.310  35.889 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -2.622e+01  1.672e+01  -1.569    0.119    
## drivers      8.760e-02  5.850e-03  14.974   <2e-16 ***
## front       -7.972e-03  1.895e-02  -0.421    0.675    
## rear         5.546e-03  2.663e-02   0.208    0.835    
## kms          6.525e-04  5.511e-04   1.184    0.238    
## PetrolPrice -1.404e+01  9.296e+01  -0.151    0.880    
## VanKilled   -1.829e-01  3.197e-01  -0.572    0.568    
## law          4.072e+00  4.594e+00   0.886    0.377    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11.18 on 137 degrees of freedom
## Multiple R-squared:  0.8206, Adjusted R-squared:  0.8115 
## F-statistic: 89.55 on 7 and 137 DF,  p-value: < 2.2e-16

6.1 Predicciones y Métricas — Modelo 3

# Predicciones sobre el conjunto de prueba
LRMPred <- predict(LRM, data_test)

# [MÉTRICA] Correlación — Modelo 3 (LRM)
cor(LRMPred, data_test$DriversKilled)   # Corr = 0.8488
## [1] 0.848806
# [MÉTRICA] MSE — Modelo 3 (LRM)
LRMRSS  <- (LRMPred - data_test$DriversKilled)^2
MSE_LRM <- sum(LRMRSS) / nrow(data_test)   # MSE = 165.37
MSE_LRM
## [1] 165.3711
# [MÉTRICA] R² — Modelo 3 (LRM)
R2_LM <- 1 - sum(LRMRSS) / sum((data_test$DriversKilled - mean(data_train$DriversKilled))^2)   # R² = 0.7186
R2_LM
## [1] 0.7185655
plot(LRMPred, data_test$DriversKilled,
     xlab = "Predicciones LRM",
     ylab = "Valores Reales (DriversKilled)",
     main = "Real vs. Predicho — Modelo 3: Regresión Lineal Múltiple")
abline(a = 0, b = 1, col = "blue", lwd = 2)
Figura 5. Valores reales vs. predichos — Regresión Lineal Múltiple (LRM).

Figura 5. Valores reales vs. predichos — Regresión Lineal Múltiple (LRM).

La regresión lineal múltiple logra un R² de 71.86%, lo que sugiere que las relaciones entre las variables en el dataset son predominantemente lineales. Esto hace que un modelo simple e interpretable sea más efectivo que las arquitecturas complejas de redes neuronales probadas.


7 Comparación de Modelos

7.1 Tabla Comparativa

# Tabla de comparación de los tres modelos
Model_Comparison <- data.frame(
  Modelo = c("Red Neuronal (8, 5) — RNS",
             "Red Neuronal (4, 2) — RNS2",
             "Regresión Lineal Múltiple — LRM"),
  R2     = c(R2_NN1, R2_NN2, R2_LM),
  MSE    = c(MSE_NN1, MSE_NN2, MSE_LRM),
  Corr   = c(
    cor(RNSPredictions,  (testtarget - mean(trainingtarget)) / sd(trainingtarget))[1],
    cor(RNS2Predictions, (testtarget - mean(trainingtarget)) / sd(trainingtarget))[1],
    cor(LRMPred, data_test$DriversKilled)
  )
)

Model_Comparison
##                            Modelo         R2      MSE      Corr
## 1       Red Neuronal (8, 5) — RNS -0.1323966 665.3969 0.3454296
## 2      Red Neuronal (4, 2) — RNS2 -0.3455954 790.6726 0.5716882
## 3 Regresión Lineal Múltiple — LRM  0.7185655 165.3711 0.8488060

7.2 Comparación Gráfica

par(mfrow = c(1, 2))

# Gráfica Red Neuronal (RNS2)
plot(data_test$DriversKilled, RNS2Pred,
     col  = 'red', pch = 19, cex = 1,
     main = "Real vs. Predicho — Red Neuronal (4, 2)",
     xlab = "Valores Reales (DriversKilled)",
     ylab = "Predicciones")
abline(0, 1, lwd = 2)
legend('bottomright', legend = 'RNS2', pch = 19, col = 'red', bty = 'n')

# Gráfica Regresión Lineal Múltiple
plot(data_test$DriversKilled, LRMPred,
     col  = 'blue', pch = 15, cex = 1,
     main = "Real vs. Predicho — Regresión Lineal Múltiple",
     xlab = "Valores Reales (DriversKilled)",
     ylab = "Predicciones")
abline(0, 1, lwd = 2)
legend('bottomright', legend = 'LRM', pch = 15, col = 'blue', bty = 'n', cex = 0.95)
Figura 6. Comparación visual: valores reales vs. predichos para RNS2 (rojo) y LRM (azul).

Figura 6. Comparación visual: valores reales vs. predichos para RNS2 (rojo) y LRM (azul).

par(mfrow = c(1, 1))

8 Conclusiones

Al comparar los tres modelos, se observa que las redes neuronales presentan un bajo desempeño sobre este dataset, mientras que la regresión lineal múltiple resulta ser el modelo más adecuado.

Esto sugiere que las relaciones entre las variables son principalmente lineales y que el tamaño del dataset (192 observaciones) limita el uso efectivo de modelos más complejos. Las redes neuronales requieren grandes volúmenes de datos para ser efectivas, mientras que modelos más simples pueden ofrecer mejores resultados en contextos con datos limitados.

Este análisis demuestra que una mayor complejidad arquitectónica no garantiza un mejor desempeño predictivo.