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)
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.
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)
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
plot(RNS,
col.hidden = 'darkgreen',
col.hidden.synapse = 'darkgreen',
show.weights = TRUE,
information = FALSE,
fill = 'lightblue')
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).
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.
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
plot(RNS2,
col.hidden = 'darkgreen',
col.hidden.synapse = 'darkgreen',
show.weights = TRUE,
information = FALSE,
fill = 'lightblue')
# 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).
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.
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
# 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).
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.
# 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
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).
par(mfrow = c(1, 1))
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.