Actividad 01 - Módulo 02: Redes Neuronales vs Regresión Lineal Múltiple
Base de datos: Seatbelts (variable a predecir: DriversKilled)
Lucero Montserrat Salazar Loera - A00834893
27/09/2026
Librerías
#install.packages("stats")
library(stats)
#install.packages("psych")
library(psych)## Warning: package 'psych' was built under R version 4.5.3#install.packages("MASS")
library(MASS)## Warning: package 'MASS' was built under R version 4.5.3library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following object is masked from 'package:MASS':
##
## select## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(magrittr)
library(neuralnet)##
## Adjuntando el paquete: 'neuralnet'## The following object is masked from 'package:dplyr':
##
## computelibrary(caret)## Cargando paquete requerido: ggplot2##
## Adjuntando el paquete: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alpha## Cargando paquete requerido: latticeLeer base de datos
Se utiliza la base de datos “Seatbelts”, proporcionada en formato
.csv. La variable que buscamos explicar/predecir es
DriversKilled.
data <- read.csv("C:/TEC 8° (DermaNova)/Seatbelts(in).csv", stringsAsFactors = FALSE)
str(data)## 'data.frame': 192 obs. of 9 variables:
## $ Date : chr "1/1/1969" "1/2/1969" "1/3/1969" "1/4/1969" ...
## $ DriversKilled: int 107 97 102 87 119 106 110 106 107 134 ...
## $ drivers : int 1687 1508 1507 1385 1632 1511 1559 1630 1579 1653 ...
## $ front : int 867 825 806 814 991 945 1004 1091 958 850 ...
## $ rear : int 269 265 319 407 454 427 522 536 405 437 ...
## $ kms : int 9059 7685 9963 10955 11823 12391 13460 14055 12106 11372 ...
## $ PetrolPrice : num 0.103 0.102 0.102 0.101 0.101 ...
## $ VanKilled : int 12 6 12 8 10 13 11 6 10 16 ...
## $ law : int 0 0 0 0 0 0 0 0 0 0 ...head(data)## Date DriversKilled drivers front rear kms PetrolPrice VanKilled law
## 1 1/1/1969 107 1687 867 269 9059 0.1029718 12 0
## 2 1/2/1969 97 1508 825 265 7685 0.1023630 6 0
## 3 1/3/1969 102 1507 806 319 9963 0.1020625 12 0
## 4 1/4/1969 87 1385 814 407 10955 0.1008733 8 0
## 5 1/5/1969 119 1632 991 454 11823 0.1010197 10 0
## 6 1/6/1969 106 1511 945 427 12391 0.1005812 13 0La columna Date es de tipo texto (fecha) y no aporta
información numérica útil para el modelo, por lo que la eliminamos. El
resto de las variables (drivers, front,
rear, kms, PetrolPrice,
VanKilled, law) son numéricas, tal como lo
requiere neuralnet.
data$Date <- NULL
str(data)## 'data.frame': 192 obs. of 8 variables:
## $ DriversKilled: int 107 97 102 87 119 106 110 106 107 134 ...
## $ drivers : int 1687 1508 1507 1385 1632 1511 1559 1630 1579 1653 ...
## $ front : int 867 825 806 814 991 945 1004 1091 958 850 ...
## $ rear : int 269 265 319 407 454 427 522 536 405 437 ...
## $ kms : int 9059 7685 9963 10955 11823 12391 13460 14055 12106 11372 ...
## $ PetrolPrice : num 0.103 0.102 0.102 0.101 0.101 ...
## $ VanKilled : int 12 6 12 8 10 13 11 6 10 16 ...
## $ law : int 0 0 0 0 0 0 0 0 0 0 ...Verificamos que no existan NAs en la base de datos, pues de haberlos el modelo de Redes Neuronales no podría ser ajustado.
colSums(is.na(data))## DriversKilled drivers front rear kms
## 0 0 0 0 0
## PetrolPrice VanKilled law
## 0 0 0Train / Test Split (75/25)
Tal como lo pide la actividad, se realiza un train/test split de 75/25 para la base de datos Seatbelts.
set.seed(13)
train <- createDataPartition(y = data$DriversKilled, p = 0.75, list = FALSE, times = 1)
data_train <- data[train, ]
data_test <- data[-train, ]
nrow(data_train)## [1] 145nrow(data_test)## [1] 47Preparación de matrices y estandarización
Guardamos la información como matrices y separamos la variable a
predecir (DriversKilled, primera columna de la base). Es
importante estandarizar tanto data_train como
data_test utilizando únicamente las medias y desviaciones
estándar obtenidas con los datos de entrenamiento.
# La variable a predecir (DriversKilled) queda en la columna 1
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 de variables
m <- colMeans(training)
s <- apply(training, 2, sd)
training <- scale(training, center = m, scale = s)
test <- scale(test, center = m, scale = s)Modelo 1 de Red Neuronal
Primer modelo: dos capas ocultas, la primera con 8 neuronas y la segunda con 4 neuronas.
data_train_S <- as.data.frame(cbind(training, (trainingtarget - mean(trainingtarget)) / sd(trainingtarget)))
colnames(data_train_S) <- colnames(data_train)
RNS <- neuralnet(DriversKilled ~ .,
data = data_train_S,
hidden = c(8, 4),
linear.output = T,
lifesign = 'full',
rep = 1,
stepmax = 200000)Visualizar la Red Neuronal ajustada
plot(RNS, col.hidden = 'darkgreen',
col.hidden.synapse = 'darkgreen',
show.weights = T,
information = F,
fill = 'lightblue')Predicciones Modelo 1
data_test_S <- as.data.frame(test)
colnames(data_test_S) <- colnames(data_test)[-1]
RNSPredictions <- predict(RNS, data_test_S)
cor(RNSPredictions, (testtarget - mean(trainingtarget)) / sd(trainingtarget))## [,1]
## [1,] 0.5019811Desestandarizamos las predicciones para calcular las métricas de
regresión frente a testtarget.
RNSPred <- RNSPredictions * sd(trainingtarget) + mean(trainingtarget)
plot(RNSPred, testtarget)
abline(a = 0, b = 1)
RSSnn <- (RNSPred - testtarget)^2
MSE_NN1 <- sum(RSSnn) / nrow(testtarget)
R2_NN1 <- 1 - sum(RSSnn) / sum((testtarget - mean(trainingtarget))^2)
MSE_NN1## [1] 528.9063R2_NN1## [1] 0.09988809Modelo 2 de Red Neuronal
Segundo modelo, variando la arquitectura: una sola capa oculta con menos neuronas (3), para comparar el efecto de reducir la complejidad de la red.
RNS2 <- neuralnet(DriversKilled ~ .,
data = data_train_S,
hidden = c(3),
linear.output = T,
lifesign = 'full',
rep = 1,
stepmax = 200000)Visualizar la Red Neuronal ajustada
plot(RNS2, col.hidden = 'darkgreen',
col.hidden.synapse = 'darkgreen',
show.weights = T,
information = F,
fill = 'lightblue')Predicciones Modelo 2
RNS2Predictions <- predict(RNS2, data_test_S)
cor(RNS2Predictions, (testtarget - mean(trainingtarget)) / sd(trainingtarget))## [,1]
## [1,] 0.5650963RNS2Pred <- RNS2Predictions * sd(trainingtarget) + mean(trainingtarget)
plot(RNS2Pred, testtarget)
abline(a = 0, b = 1)
RSS2nn <- (RNS2Pred - testtarget)^2
MSE_NN2 <- sum(RSS2nn) / nrow(testtarget)
R2_NN2 <- 1 - sum(RSS2nn) / sum((testtarget - mean(trainingtarget))^2)
MSE_NN2## [1] 424.2648R2_NN2## [1] 0.2779708Regresión Lineal Múltiple
Ajustamos un modelo de Regresión Lineal Múltiple utilizando todas las variables disponibles en la base de datos, para comparar contra el mejor de los dos modelos de Red Neuronal.
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-16LRMPred <- predict(LRM, data_test[, -1])
cor(LRMPred, data_test[, 1])## [1] 0.848806plot(LRMPred, data_test[, 1])
abline(a = 0, b = 1)
LRMRSS <- (LRMPred - data_test[, 1])^2
MSE_LRM <- sum(LRMRSS) / nrow(testtarget)
R2_LRM <- 1 - sum(LRMRSS) / sum((data_test[, 1] - mean(data_train[, 1]))^2)
MSE_LRM## [1] 165.3711R2_LRM## [1] 0.7185655Comparación de Modelos
Tabla resumen de métricas
comparacion <- data.frame(
Modelo = c("Red Neuronal 1 (8,4)", "Red Neuronal 2 (3)", "Regresión Lineal Múltiple"),
MSE = c(MSE_NN1, MSE_NN2, MSE_LRM),
R2 = c(R2_NN1, R2_NN2, R2_LRM)
)
comparacion## Modelo MSE R2
## 1 Red Neuronal 1 (8,4) 528.9063 0.09988809
## 2 Red Neuronal 2 (3) 424.2648 0.27797085
## 3 Regresión Lineal Múltiple 165.3711 0.71856553Comparación gráfica: mejor Red Neuronal vs Regresión Lineal Múltiple
Aquí se compara, en una misma gráfica, el modelo de Red Neuronal con
mejor desempeño (ajustar cuál de los dos, RNSPred o
RNS2Pred, resultó mejor según la tabla anterior) contra la
Regresión Lineal Múltiple.
# NOTA: revisar la tabla de comparación e intercambiar RNS2Pred por RNSPred
# si el Modelo 1 resulta ser el de mejor desempeño.
plot(data_test$DriversKilled, RNS2Pred, col = 'red',
main = 'Real vs Predicho: NN vs LM', pch = 19, cex = 1,
xlab = 'Valor real (DriversKilled)', ylab = 'Valor predicho')
points(data_test$DriversKilled, LRMPred, col = 'blue', pch = 15, cex = 1)
abline(0, 1, lwd = 2)
legend('bottomright', legend = c('Red Neuronal', 'Regresión Lineal'),
pch = c(19, 15), col = c('red', 'blue'))
Insights
(Completar esta sección después de correr el documento, con los números que te arroje tu propia ejecución; los comentarios de abajo son guía de qué observar, no resultados ya calculados.)
- Comparación de arquitecturas de Red Neuronal: compara el MSE y la R² de la Red Neuronal 1 (8,4 neuronas) contra la Red Neuronal 2 (3 neuronas). Comenta si añadir más capas/neuronas mejoró o empeoró la capacidad de predicción sobre el set de prueba (posible sobreajuste si el modelo más complejo tiene mejor desempeño en train pero peor en test).
- Red Neuronal vs Regresión Lineal: compara el mejor modelo de Red Neuronal contra la Regresión Lineal Múltiple usando la tabla de métricas y la gráfica de dispersión. Un R² más alto y un MSE más bajo indican mejor ajuste.
- Variables relevantes: revisa el
summary(LRM)para identificar qué variables (drivers,front,rear,kms,PetrolPrice,VanKilled,law) resultan estadísticamente significativas para explicarDriversKilled, y relaciona esto con lo que observas en el gráfico de pesos de la Red Neuronal. - Conclusión: indica cuál modelo recomendarías usar para este problema y por qué (interpretabilidad vs. desempeño predictivo).