)

Teoría

Una red Neuronal Artificial (ANN) modela la relación entre un conjunto de entradas y una salida, resolviendo un problema de aprendizaje.

Instalar paquetes y llamar librerías

#install.packages("neuralnet") # Redes Neuronales
library(neuralnet)
#install.packages("caret") # Entrenamiento de ML
library(caret)
#install.packages("ggplot2")
library(ggplot2)
#install.packages("MASS")
library(MASS)

Importar la base de datos

boston_borrador <- read.csv("C:\\Tec\\6to semestre\\Modulo 2\\BostonHousing.csv")
boston <- as.data.frame(scale(boston_borrador))

Entender la base de datos

summary(boston)
##       crim                 zn               indus              chas        
##  Min.   :-0.419367   Min.   :-0.48724   Min.   :-1.5563   Min.   :-0.2723  
##  1st Qu.:-0.410563   1st Qu.:-0.48724   1st Qu.:-0.8668   1st Qu.:-0.2723  
##  Median :-0.390280   Median :-0.48724   Median :-0.2109   Median :-0.2723  
##  Mean   : 0.000000   Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.007389   3rd Qu.: 0.04872   3rd Qu.: 1.0150   3rd Qu.:-0.2723  
##  Max.   : 9.924110   Max.   : 3.80047   Max.   : 2.4202   Max.   : 3.6648  
##       nox                rm               age               dis         
##  Min.   :-1.4644   Min.   :-3.8764   Min.   :-2.3331   Min.   :-1.2658  
##  1st Qu.:-0.9121   1st Qu.:-0.5681   1st Qu.:-0.8366   1st Qu.:-0.8049  
##  Median :-0.1441   Median :-0.1084   Median : 0.3171   Median :-0.2790  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.5981   3rd Qu.: 0.4823   3rd Qu.: 0.9059   3rd Qu.: 0.6617  
##  Max.   : 2.7296   Max.   : 3.5515   Max.   : 1.1164   Max.   : 3.9566  
##       rad               tax             ptratio              b          
##  Min.   :-0.9819   Min.   :-1.3127   Min.   :-2.7047   Min.   :-3.9033  
##  1st Qu.:-0.6373   1st Qu.:-0.7668   1st Qu.:-0.4876   1st Qu.: 0.2049  
##  Median :-0.5225   Median :-0.4642   Median : 0.2746   Median : 0.3808  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 1.6596   3rd Qu.: 1.5294   3rd Qu.: 0.8058   3rd Qu.: 0.4332  
##  Max.   : 1.6596   Max.   : 1.7964   Max.   : 1.6372   Max.   : 0.4406  
##      lstat              medv        
##  Min.   :-1.5296   Min.   :-1.9063  
##  1st Qu.:-0.7986   1st Qu.:-0.5989  
##  Median :-0.1811   Median :-0.1449  
##  Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.6024   3rd Qu.: 0.2683  
##  Max.   : 3.5453   Max.   : 2.9865
str(boston)
## 'data.frame':    506 obs. of  14 variables:
##  $ crim   : num  -0.419 -0.417 -0.417 -0.416 -0.412 ...
##  $ zn     : num  0.285 -0.487 -0.487 -0.487 -0.487 ...
##  $ indus  : num  -1.287 -0.593 -0.593 -1.306 -1.306 ...
##  $ chas   : num  -0.272 -0.272 -0.272 -0.272 -0.272 ...
##  $ nox    : num  -0.144 -0.74 -0.74 -0.834 -0.834 ...
##  $ rm     : num  0.413 0.194 1.281 1.015 1.227 ...
##  $ age    : num  -0.12 0.367 -0.266 -0.809 -0.511 ...
##  $ dis    : num  0.14 0.557 0.557 1.077 1.077 ...
##  $ rad    : num  -0.982 -0.867 -0.867 -0.752 -0.752 ...
##  $ tax    : num  -0.666 -0.986 -0.986 -1.105 -1.105 ...
##  $ ptratio: num  -1.458 -0.303 -0.303 0.113 0.113 ...
##  $ b      : num  0.441 0.441 0.396 0.416 0.441 ...
##  $ lstat  : num  -1.074 -0.492 -1.208 -1.36 -1.025 ...
##  $ medv   : num  0.16 -0.101 1.323 1.182 1.486 ...
head(boston)
##         crim         zn      indus       chas        nox        rm        age
## 1 -0.4193669  0.2845483 -1.2866362 -0.2723291 -0.1440749 0.4132629 -0.1198948
## 2 -0.4169267 -0.4872402 -0.5927944 -0.2723291 -0.7395304 0.1940824  0.3668034
## 3 -0.4169290 -0.4872402 -0.5927944 -0.2723291 -0.7395304 1.2814456 -0.2655490
## 4 -0.4163384 -0.4872402 -1.3055857 -0.2723291 -0.8344581 1.0152978 -0.8090878
## 5 -0.4120741 -0.4872402 -1.3055857 -0.2723291 -0.8344581 1.2273620 -0.5106743
## 6 -0.4166314 -0.4872402 -1.3055857 -0.2723291 -0.8344581 0.2068916 -0.3508100
##        dis        rad        tax    ptratio         b      lstat       medv
## 1 0.140075 -0.9818712 -0.6659492 -1.4575580 0.4406159 -1.0744990  0.1595278
## 2 0.556609 -0.8670245 -0.9863534 -0.3027945 0.4406159 -0.4919525 -0.1014239
## 3 0.556609 -0.8670245 -0.9863534 -0.3027945 0.3960351 -1.2075324  1.3229375
## 4 1.076671 -0.7521778 -1.1050216  0.1129203 0.4157514 -1.3601708  1.1815886
## 5 1.076671 -0.7521778 -1.1050216  0.1129203 0.4406159 -1.0254866  1.4860323
## 6 1.076671 -0.7521778 -1.1050216  0.1129203 0.4101651 -1.0422909  0.6705582

Partir la base de datos

set.seed(123)
renglones_entrenamiento_boston <- createDataPartition(boston$medv,p=0.7,list=FALSE)
entrenamiento_boston <- boston[renglones_entrenamiento_boston, ]
prueba_boston <- boston[-renglones_entrenamiento_boston, ]

Generar el Modelo

modelo_boston <-neuralnet(medv ~ ., data=entrenamiento_boston, linear.output=TRUE,
stepmax=1e6)
plot(modelo_boston)

Predecir con la Red Neuronal

prediccion <- compute(modelo_boston, prueba_boston[, -which(names(prueba_boston) == "medv")])$net.result
real <- prueba_boston$medv

boston_resultados <- data.frame(Real = real, Predicción = prediccion)
ggplot(boston_resultados, aes(x=Real, y= Predicción)) +
geom_point(color="blue") +
geom_abline(slope=1, intercept=0, color="red") +
theme_minimal() +
ggtitle("Predicción vs. Valores Reales")

LS0tDQp0aXRsZTogIkNsYXNlIDgiDQphdXRob3I6ICJEYW5pZWwgWsOhcmF0ZSAtICBBMDEyODU1NjEiDQpkYXRlOiAiMjAyNS0wMi0yNiINCm91dHB1dDogIA0KICAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQogICAgdGhlbWU6ICJ1bml0ZWQiDQogICAgaGlnaGxpZ2h0OiAiZXNwcmVzc28iDQotLS0NCg0KIVtdKEM6XFxUZWNcXDZ0byBzZW1lc3RyZVxcTW9kdWxvIDJcXGJvc3Rvbi5naWYpKQ0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+VGVvcsOtYTwvc3Bhbj4NClVuYSAqKnJlZCBOZXVyb25hbCBBcnRpZmljaWFsIChBTk4pKiogbW9kZWxhIGxhIHJlbGFjacOzbiBlbnRyZSB1biBjb25qdW50byBkZSBlbnRyYWRhcyB5IHVuYSBzYWxpZGEsIHJlc29sdmllbmRvIHVuIHByb2JsZW1hIGRlIGFwcmVuZGl6YWplLg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+SW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyw61hczwvc3Bhbj4NCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQoNCiNpbnN0YWxsLnBhY2thZ2VzKCJuZXVyYWxuZXQiKSAjIFJlZGVzIE5ldXJvbmFsZXMNCmxpYnJhcnkobmV1cmFsbmV0KQ0KI2luc3RhbGwucGFja2FnZXMoImNhcmV0IikgIyBFbnRyZW5hbWllbnRvIGRlIE1MDQpsaWJyYXJ5KGNhcmV0KQ0KI2luc3RhbGwucGFja2FnZXMoImdncGxvdDIiKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KI2luc3RhbGwucGFja2FnZXMoIk1BU1MiKQ0KbGlicmFyeShNQVNTKQ0KDQpgYGANCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+SW1wb3J0YXIgbGEgYmFzZSBkZSBkYXRvczwvc3Bhbj4NCmBgYHtyfQ0KDQpib3N0b25fYm9ycmFkb3IgPC0gcmVhZC5jc3YoIkM6XFxUZWNcXDZ0byBzZW1lc3RyZVxcTW9kdWxvIDJcXEJvc3RvbkhvdXNpbmcuY3N2IikNCmJvc3RvbiA8LSBhcy5kYXRhLmZyYW1lKHNjYWxlKGJvc3Rvbl9ib3JyYWRvcikpDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IHJlZDsiPkVudGVuZGVyIGxhIGJhc2UgZGUgZGF0b3M8L3NwYW4+DQpgYGB7cn0NCg0Kc3VtbWFyeShib3N0b24pDQpzdHIoYm9zdG9uKQ0KaGVhZChib3N0b24pDQoNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+UGFydGlyIGxhIGJhc2UgZGUgZGF0b3M8L3NwYW4+DQpgYGB7cn0NCg0Kc2V0LnNlZWQoMTIzKQ0KcmVuZ2xvbmVzX2VudHJlbmFtaWVudG9fYm9zdG9uIDwtIGNyZWF0ZURhdGFQYXJ0aXRpb24oYm9zdG9uJG1lZHYscD0wLjcsbGlzdD1GQUxTRSkNCmVudHJlbmFtaWVudG9fYm9zdG9uIDwtIGJvc3RvbltyZW5nbG9uZXNfZW50cmVuYW1pZW50b19ib3N0b24sIF0NCnBydWViYV9ib3N0b24gPC0gYm9zdG9uWy1yZW5nbG9uZXNfZW50cmVuYW1pZW50b19ib3N0b24sIF0NCg0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiByZWQ7Ij5HZW5lcmFyIGVsIE1vZGVsbzwvc3Bhbj4NCmBgYHtyfQ0KDQptb2RlbG9fYm9zdG9uIDwtbmV1cmFsbmV0KG1lZHYgfiAuLCBkYXRhPWVudHJlbmFtaWVudG9fYm9zdG9uLCBsaW5lYXIub3V0cHV0PVRSVUUsDQpzdGVwbWF4PTFlNikNCnBsb3QobW9kZWxvX2Jvc3RvbikNCg0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiByZWQ7Ij5QcmVkZWNpciBjb24gbGEgUmVkIE5ldXJvbmFsPC9zcGFuPg0KYGBge3J9DQoNCnByZWRpY2Npb24gPC0gY29tcHV0ZShtb2RlbG9fYm9zdG9uLCBwcnVlYmFfYm9zdG9uWywgLXdoaWNoKG5hbWVzKHBydWViYV9ib3N0b24pID09ICJtZWR2IildKSRuZXQucmVzdWx0DQpyZWFsIDwtIHBydWViYV9ib3N0b24kbWVkdg0KDQpib3N0b25fcmVzdWx0YWRvcyA8LSBkYXRhLmZyYW1lKFJlYWwgPSByZWFsLCBQcmVkaWNjacOzbiA9IHByZWRpY2Npb24pDQpnZ3Bsb3QoYm9zdG9uX3Jlc3VsdGFkb3MsIGFlcyh4PVJlYWwsIHk9IFByZWRpY2Npw7NuKSkgKw0KZ2VvbV9wb2ludChjb2xvcj0iYmx1ZSIpICsNCmdlb21fYWJsaW5lKHNsb3BlPTEsIGludGVyY2VwdD0wLCBjb2xvcj0icmVkIikgKw0KdGhlbWVfbWluaW1hbCgpICsNCmdndGl0bGUoIlByZWRpY2Npw7NuIHZzLiBWYWxvcmVzIFJlYWxlcyIpDQoNCmBgYA0KDQo=