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 ML
library(caret)

Importar base de datos

boston <- read.csv("C:\\Users\\almai\\Downloads\\BostonHousing(2).csv")
#boston_borrador <- read.csv("C:\\Users\\almai\\Downloads\\BostonHousing(2).csv")
#boston <- scale(boston_borrador)

Entender la base de datos

summary(boston)
##       crim                zn             indus            chas        
##  Min.   : 0.00632   Min.   :  0.00   Min.   : 0.46   Min.   :0.00000  
##  1st Qu.: 0.08205   1st Qu.:  0.00   1st Qu.: 5.19   1st Qu.:0.00000  
##  Median : 0.25651   Median :  0.00   Median : 9.69   Median :0.00000  
##  Mean   : 3.61352   Mean   : 11.36   Mean   :11.14   Mean   :0.06917  
##  3rd Qu.: 3.67708   3rd Qu.: 12.50   3rd Qu.:18.10   3rd Qu.:0.00000  
##  Max.   :88.97620   Max.   :100.00   Max.   :27.74   Max.   :1.00000  
##       nox               rm             age              dis        
##  Min.   :0.3850   Min.   :3.561   Min.   :  2.90   Min.   : 1.130  
##  1st Qu.:0.4490   1st Qu.:5.886   1st Qu.: 45.02   1st Qu.: 2.100  
##  Median :0.5380   Median :6.208   Median : 77.50   Median : 3.207  
##  Mean   :0.5547   Mean   :6.285   Mean   : 68.57   Mean   : 3.795  
##  3rd Qu.:0.6240   3rd Qu.:6.623   3rd Qu.: 94.08   3rd Qu.: 5.188  
##  Max.   :0.8710   Max.   :8.780   Max.   :100.00   Max.   :12.127  
##       rad              tax           ptratio            b         
##  Min.   : 1.000   Min.   :187.0   Min.   :12.60   Min.   :  0.32  
##  1st Qu.: 4.000   1st Qu.:279.0   1st Qu.:17.40   1st Qu.:375.38  
##  Median : 5.000   Median :330.0   Median :19.05   Median :391.44  
##  Mean   : 9.549   Mean   :408.2   Mean   :18.46   Mean   :356.67  
##  3rd Qu.:24.000   3rd Qu.:666.0   3rd Qu.:20.20   3rd Qu.:396.23  
##  Max.   :24.000   Max.   :711.0   Max.   :22.00   Max.   :396.90  
##      lstat            medv      
##  Min.   : 1.73   Min.   : 5.00  
##  1st Qu.: 6.95   1st Qu.:17.02  
##  Median :11.36   Median :21.20  
##  Mean   :12.65   Mean   :22.53  
##  3rd Qu.:16.95   3rd Qu.:25.00  
##  Max.   :37.97   Max.   :50.00
head(boston)
##      crim zn indus chas   nox    rm  age    dis rad tax ptratio      b lstat
## 1 0.00632 18  2.31    0 0.538 6.575 65.2 4.0900   1 296    15.3 396.90  4.98
## 2 0.02731  0  7.07    0 0.469 6.421 78.9 4.9671   2 242    17.8 396.90  9.14
## 3 0.02729  0  7.07    0 0.469 7.185 61.1 4.9671   2 242    17.8 392.83  4.03
## 4 0.03237  0  2.18    0 0.458 6.998 45.8 6.0622   3 222    18.7 394.63  2.94
## 5 0.06905  0  2.18    0 0.458 7.147 54.2 6.0622   3 222    18.7 396.90  5.33
## 6 0.02985  0  2.18    0 0.458 6.430 58.7 6.0622   3 222    18.7 394.12  5.21
##   medv
## 1 24.0
## 2 21.6
## 3 34.7
## 4 33.4
## 5 36.2
## 6 28.7
str(boston)
## 'data.frame':    506 obs. of  14 variables:
##  $ crim   : num  0.00632 0.02731 0.02729 0.03237 0.06905 ...
##  $ zn     : num  18 0 0 0 0 0 12.5 12.5 12.5 12.5 ...
##  $ indus  : num  2.31 7.07 7.07 2.18 2.18 2.18 7.87 7.87 7.87 7.87 ...
##  $ chas   : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ nox    : num  0.538 0.469 0.469 0.458 0.458 0.458 0.524 0.524 0.524 0.524 ...
##  $ rm     : num  6.58 6.42 7.18 7 7.15 ...
##  $ age    : num  65.2 78.9 61.1 45.8 54.2 58.7 66.6 96.1 100 85.9 ...
##  $ dis    : num  4.09 4.97 4.97 6.06 6.06 ...
##  $ rad    : int  1 2 2 3 3 3 5 5 5 5 ...
##  $ tax    : int  296 242 242 222 222 222 311 311 311 311 ...
##  $ ptratio: num  15.3 17.8 17.8 18.7 18.7 18.7 15.2 15.2 15.2 15.2 ...
##  $ b      : num  397 397 393 395 397 ...
##  $ lstat  : num  4.98 9.14 4.03 2.94 5.33 ...
##  $ medv   : num  24 21.6 34.7 33.4 36.2 28.7 22.9 27.1 16.5 18.9 ...

Partir la base de datos

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

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

Generar el modelo

modelo_boston <-neuralnet(medv~.,data=entrenamiento_boston)
summary(modelo_boston)
##                     Length Class      Mode    
## call                   3   -none-     call    
## response             407   -none-     numeric 
## covariate           5291   -none-     numeric 
## model.list             2   -none-     list    
## err.fct                1   -none-     function
## act.fct                1   -none-     function
## linear.output          1   -none-     logical 
## data                  14   data.frame list    
## exclude                0   -none-     NULL    
## net.result             1   -none-     list    
## weights                1   -none-     list    
## generalized.weights    1   -none-     list    
## startweights           1   -none-     list    
## result.matrix         19   -none-     numeric

Predecir con la Red Neuronal

prediccion <- compute(modelo_boston,prueba_boston)
prediccion$net.result
##         [,1]
## 3   22.51056
## 6   22.51056
## 9   22.51056
## 11  22.51056
## 14  22.51056
## 15  22.51056
## 31  22.51056
## 32  22.51056
## 36  22.51056
## 41  22.51056
## 45  22.51056
## 51  22.51056
## 54  22.51056
## 74  22.51056
## 76  22.51056
## 78  22.51056
## 79  22.51056
## 82  22.51056
## 86  22.51056
## 92  22.51056
## 105 22.51056
## 108 22.51056
## 109 22.51056
## 111 22.51056
## 120 22.51056
## 127 22.51056
## 130 22.51056
## 131 22.51056
## 138 22.51056
## 142 22.51056
## 146 22.51056
## 151 22.51056
## 152 22.51056
## 155 22.51056
## 163 22.51056
## 167 22.51056
## 168 22.51056
## 170 22.51056
## 172 22.51056
## 178 22.51056
## 182 22.51056
## 184 22.51056
## 188 22.51056
## 198 22.51056
## 203 22.51056
## 205 22.51056
## 215 22.51056
## 218 22.51056
## 221 22.51056
## 224 22.51056
## 244 22.51056
## 246 22.51056
## 247 22.51056
## 250 22.51056
## 252 22.51056
## 255 22.51056
## 257 22.51056
## 262 22.51056
## 271 22.51056
## 293 22.51056
## 294 22.51056
## 300 22.51056
## 305 22.51056
## 307 22.51056
## 312 22.51056
## 316 22.51056
## 320 22.51056
## 323 22.51056
## 326 22.51056
## 330 22.51056
## 348 22.51056
## 352 22.51056
## 355 22.51056
## 357 22.51056
## 370 22.51056
## 378 22.51056
## 393 22.51056
## 394 22.51056
## 401 22.51056
## 403 22.51056
## 405 22.51056
## 406 22.51056
## 410 22.51056
## 411 22.51056
## 417 22.51056
## 422 22.51056
## 445 22.51056
## 449 22.51056
## 453 22.51056
## 455 22.51056
## 472 22.51056
## 481 22.51056
## 484 22.51056
## 486 22.51056
## 487 22.51056
## 490 22.51056
## 493 22.51056
## 495 22.51056
## 496 22.51056
LS0tDQp0aXRsZTogIlJlZGVzIE5ldXJvbmFsZXMiDQphdXRob3I6ICJBbG1hIFNhbnRpYWdvLUEwMDgzNjYzNiINCmRhdGU6ICIyMDI1LTAyLTI4Ig0Kb3V0cHV0OiANCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQogICAgdGhlbWU6IGJvb3RzdHJhcA0KICAgIGhpZ2hsaWdodHMgOiBoYWRkb2NrDQotLS0NCg0KIVtdKEM6XFxVc2Vyc1xcYWxtYWlcXERvd25sb2Fkc1xcQklzdi5naWYpDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOnJlZDsiPlRlb3LDrWE8L3NwYW4+DQpVbmEgKipSZWQgTmV1cm9uYWwgQXJ0aWZpY2lhbCAoQU5OKSoqIG1vZGVsYSBsYSByZWxhY2nDs24gZW50cmUgdW4gY29uanVudG8gZGUgZW50cmFkYXMgeSB1bmEgc2FsaWRhLCByZXNvbHZpZW5kbyB1biBwcm9ibGVtYSBkZSBhcHJlbmRpemFqZS4gDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOnJlZDsiPkluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxpYnJlcsOtYXM8L3NwYW4+DQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KI2luc3RhbGwucGFja2FnZXMoIm5ldXJhbG5ldCIpICMgUmVkZXMgTmV1cm9uYWxlcw0KbGlicmFyeShuZXVyYWxuZXQpDQojaW5zdGFsbC5wYWNrYWdlcygiY2FyZXQiKSAjIEVudHJlbmFtaWVudG8gTUwNCmxpYnJhcnkoY2FyZXQpDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6cmVkOyI+SW1wb3J0YXIgYmFzZSBkZSBkYXRvczwvc3Bhbj4NCmBgYHtyfQ0KDQpib3N0b24gPC0gcmVhZC5jc3YoIkM6XFxVc2Vyc1xcYWxtYWlcXERvd25sb2Fkc1xcQm9zdG9uSG91c2luZygyKS5jc3YiKQ0KI2Jvc3Rvbl9ib3JyYWRvciA8LSByZWFkLmNzdigiQzpcXFVzZXJzXFxhbG1haVxcRG93bmxvYWRzXFxCb3N0b25Ib3VzaW5nKDIpLmNzdiIpDQojYm9zdG9uIDwtIHNjYWxlKGJvc3Rvbl9ib3JyYWRvcikNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpyZWQ7Ij5FbnRlbmRlciBsYSBiYXNlIGRlIGRhdG9zPC9zcGFuPg0KYGBge3J9DQpzdW1tYXJ5KGJvc3RvbikNCmhlYWQoYm9zdG9uKQ0Kc3RyKGJvc3RvbikNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpyZWQ7Ij5QYXJ0aXIgbGEgYmFzZSBkZSBkYXRvczwvc3Bhbj4NCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKQ0KcmVuZ2xvbmVzX2VudHJlbmFtaWVudG9fYm9zdG9uIDwtIGNyZWF0ZURhdGFQYXJ0aXRpb24oYm9zdG9uJG1lZHYscD0wLjgsbGlzdD1GQUxTRSkNCmVudHJlbmFtaWVudG9fYm9zdG9uIDwtIGJvc3RvbltyZW5nbG9uZXNfZW50cmVuYW1pZW50b19ib3N0b24sIF0NCnBydWViYV9ib3N0b24gPC0gYm9zdG9uWy1yZW5nbG9uZXNfZW50cmVuYW1pZW50b19ib3N0b24sIF0NCg0KI3NldC5zZWVkKDEyMykNCiNyZW5nbG9uZXNfZW50cmVuYW1pZW50b19ib3N0b24gPC0gY3JlYXRlRGF0YVBhcnRpdGlvbihib3N0b25fYm9ycmFkb3IkbWVkdiwgcCA9IDAuOCAsIGxpc3QgPSBGQUxTRSkNCiNlbnRyZW5hbWllbnRvX2Jvc3RvbiA8LSBib3N0b25bcmVuZ2xvbmVzX2VudHJlbmFtaWVudG9fYm9zdG9uLF0NCiNwcnVlYmFfYm9zdG9uIDwtIGJvc3RvblstcmVuZ2xvbmVzX2VudHJlbmFtaWVudG9fYm9zdG9uLF0NCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpyZWQ7Ij5HZW5lcmFyIGVsIG1vZGVsbzwvc3Bhbj4NCmBgYHtyfQ0KbW9kZWxvX2Jvc3RvbiA8LW5ldXJhbG5ldChtZWR2fi4sZGF0YT1lbnRyZW5hbWllbnRvX2Jvc3RvbikNCnN1bW1hcnkobW9kZWxvX2Jvc3RvbikNCg0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOnJlZDsiPlByZWRlY2lyIGNvbiBsYSBSZWQgTmV1cm9uYWw8L3NwYW4+DQpgYGB7cn0NCg0KcHJlZGljY2lvbiA8LSBjb21wdXRlKG1vZGVsb19ib3N0b24scHJ1ZWJhX2Jvc3RvbikNCnByZWRpY2Npb24kbmV0LnJlc3VsdA0KYGBgDQoNCg==