Redes Neuronales
0. Concepto
Una Red Neural Artificial (ANN) modela la relación entre un conjunto
de entradas y una salida resolviendo un problema de aprendizaje.
Ejemplos de aplicación de Redes Neuronales son: 1. La recomendación
de contenido de Netflix. 2. El feed de Instagram o TikTok. 3. Determinar
el número o letra escrito a mano.
1. Instalar paquetes y llamas
librerÃas
# install.packages("neuralnet")
library(neuralnet)
2. Alimentar con ejemplos
examen <- c(20,10,30,20,80,30)
proyecto <- c(90,20,40,50,50,80)
estatus <- c(1,0,0,0,0,1)
dfclase <- data.frame(examen,proyecto,estatus)
3. Generar la red neuronal
red_neuronal <- neuralnet(estatus~., data=dfclase)
plot(red_neuronal, rep = "best")

4. Predecir con la Red
Neuronal
prueba_examen <- c(30,40,85)
prueba_proyecto <- c(85,50,40)
prueba <- data.frame(prueba_examen,prueba_proyecto)
prediccion <- compute(red_neuronal, prueba)
prediccion$net.result
## [,1]
## [1,] 0.3339497
## [2,] 0.3339497
## [3,] 0.3339497
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad>0.5,1,0)
resultado
## [,1]
## [1,] 0
## [2,] 0
## [3,] 0
Redes Neuronales con Base de Datos
Cáncer de Mama
1. Importar base de datos
# file.choose()
cancerdemama <- read.csv("C:\\Users\\sguerra\\OneDrive - GRUPO ACERERO, SA DE CV\\Documentos\\cancer_de_mama.csv")
cancerdemama$diagnosis <- ifelse(cancerdemama$diagnosis == "M",1,0)
2. Alimentar con ejemplos
red_neuronal <- neuralnet(diagnosis~., data=cancerdemama)
plot(red_neuronal, rep = "best")

3. Generar la red neuronal
prueba <- cancerdemama[c(19,20,21,22,23), ]
prediccion <- compute(red_neuronal,prueba)
prediccion$net.result
## [,1]
## 19 0.3725903
## 20 0.3725903
## 21 0.3725903
## 22 0.3725903
## 23 0.3725903
4. Predecir con la Red
Neuronal
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad>0.5,1,0)
resultado
## [,1]
## 19 0
## 20 0
## 21 0
## 22 0
## 23 0
LS0tDQp0aXRsZTogIlJlZGVzIE5ldXJvbmFsZXMiDQphdXRob3I6ICJTYW50aWFnbyBHdWVycmEgTGVpamEiDQpkYXRlOiAiMi8xMC8yMDIzIg0Kb3V0cHV0OiANCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQogICAgdGhlbWU6ICJzcGFjZWxhYiINCiAgICBoaWdobGlnaHQ6ICJrYXRlIg0KLS0tDQoNCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IGhvdHBpbms7Ij5SZWRlcyBOZXVyb25hbGVzPC9zcGFuPg0KDQojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBob3RwaW5rOyI+MC4gQ29uY2VwdG88L3NwYW4+DQpVbmEgUmVkIE5ldXJhbCBBcnRpZmljaWFsIChBTk4pIG1vZGVsYSBsYSByZWxhY2nDs24gZW50cmUgdW4gY29uanVudG8gZGUgZW50cmFkYXMgeSANCnVuYSBzYWxpZGEgcmVzb2x2aWVuZG8gdW4gcHJvYmxlbWEgZGUgYXByZW5kaXphamUuDQoNCkVqZW1wbG9zIGRlIGFwbGljYWNpw7NuIGRlIFJlZGVzIE5ldXJvbmFsZXMgc29uOg0KMS4gTGEgcmVjb21lbmRhY2nDs24gZGUgY29udGVuaWRvIGRlIE5ldGZsaXguDQoyLiBFbCBmZWVkIGRlIEluc3RhZ3JhbSBvIFRpa1Rvay4NCjMuIERldGVybWluYXIgZWwgbsO6bWVybyBvIGxldHJhIGVzY3JpdG8gYSBtYW5vLg0KDQojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBob3RwaW5rOyI+MS4gSW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXMgbGlicmVyw61hczwvc3Bhbj4NCmBgYHtyfQ0KIyBpbnN0YWxsLnBhY2thZ2VzKCJuZXVyYWxuZXQiKQ0KbGlicmFyeShuZXVyYWxuZXQpDQpgYGANCg0KIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogaG90cGluazsiPjIuIEFsaW1lbnRhciBjb24gZWplbXBsb3M8L3NwYW4+DQpgYGB7cn0NCmV4YW1lbiA8LSBjKDIwLDEwLDMwLDIwLDgwLDMwKQ0KcHJveWVjdG8gPC0gYyg5MCwyMCw0MCw1MCw1MCw4MCkNCmVzdGF0dXMgPC0gYygxLDAsMCwwLDAsMSkNCmRmY2xhc2UgPC0gZGF0YS5mcmFtZShleGFtZW4scHJveWVjdG8sZXN0YXR1cykNCmBgYA0KDQojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBob3RwaW5rOyI+My4gR2VuZXJhciBsYSByZWQgbmV1cm9uYWw8L3NwYW4+DQpgYGB7cn0NCnJlZF9uZXVyb25hbCA8LSBuZXVyYWxuZXQoZXN0YXR1c34uLCBkYXRhPWRmY2xhc2UpDQpwbG90KHJlZF9uZXVyb25hbCwgcmVwID0gImJlc3QiKQ0KYGBgDQoNCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6IGhvdHBpbms7Ij40LiBQcmVkZWNpciBjb24gbGEgUmVkIE5ldXJvbmFsPC9zcGFuPg0KYGBge3J9DQpwcnVlYmFfZXhhbWVuIDwtIGMoMzAsNDAsODUpDQpwcnVlYmFfcHJveWVjdG8gPC0gYyg4NSw1MCw0MCkNCnBydWViYSA8LSBkYXRhLmZyYW1lKHBydWViYV9leGFtZW4scHJ1ZWJhX3Byb3llY3RvKQ0KcHJlZGljY2lvbiA8LSBjb21wdXRlKHJlZF9uZXVyb25hbCwgcHJ1ZWJhKQ0KcHJlZGljY2lvbiRuZXQucmVzdWx0DQoNCnByb2JhYmlsaWRhZCA8LSBwcmVkaWNjaW9uJG5ldC5yZXN1bHQNCnJlc3VsdGFkbyA8LSBpZmVsc2UocHJvYmFiaWxpZGFkPjAuNSwxLDApDQpyZXN1bHRhZG8NCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogb3JhbmdlOyI+UmVkZXMgTmV1cm9uYWxlcyBjb24gQmFzZSBkZSBEYXRvcyBDw6FuY2VyIGRlIE1hbWE8L3NwYW4+DQoNCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6IG9yYW5nZTsiPjEuIEltcG9ydGFyIGJhc2UgZGUgZGF0b3M8L3NwYW4+DQpgYGB7cn0NCiMgZmlsZS5jaG9vc2UoKQ0KY2FuY2VyZGVtYW1hIDwtIHJlYWQuY3N2KCJDOlxcVXNlcnNcXHNndWVycmFcXE9uZURyaXZlIC0gR1JVUE8gQUNFUkVSTywgU0EgREUgQ1ZcXERvY3VtZW50b3NcXGNhbmNlcl9kZV9tYW1hLmNzdiIpDQpjYW5jZXJkZW1hbWEkZGlhZ25vc2lzIDwtIGlmZWxzZShjYW5jZXJkZW1hbWEkZGlhZ25vc2lzID09ICJNIiwxLDApDQpgYGANCg0KIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogb3JhbmdlOyI+Mi4gQWxpbWVudGFyIGNvbiBlamVtcGxvczwvc3Bhbj4NCmBgYHtyfQ0KcmVkX25ldXJvbmFsIDwtIG5ldXJhbG5ldChkaWFnbm9zaXN+LiwgZGF0YT1jYW5jZXJkZW1hbWEpDQpwbG90KHJlZF9uZXVyb25hbCwgcmVwID0gImJlc3QiKQ0KYGBgDQoNCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6IG9yYW5nZTsiPjMuIEdlbmVyYXIgbGEgcmVkIG5ldXJvbmFsPC9zcGFuPg0KYGBge3J9DQpwcnVlYmEgPC0gY2FuY2VyZGVtYW1hW2MoMTksMjAsMjEsMjIsMjMpLCBdDQpwcmVkaWNjaW9uIDwtIGNvbXB1dGUocmVkX25ldXJvbmFsLHBydWViYSkNCnByZWRpY2Npb24kbmV0LnJlc3VsdA0KYGBgDQoNCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6IG9yYW5nZTsiPjQuIFByZWRlY2lyIGNvbiBsYSBSZWQgTmV1cm9uYWw8L3NwYW4+DQpgYGB7cn0NCnByb2JhYmlsaWRhZCA8LSBwcmVkaWNjaW9uJG5ldC5yZXN1bHQNCnJlc3VsdGFkbyA8LSBpZmVsc2UocHJvYmFiaWxpZGFkPjAuNSwxLDApDQpyZXN1bHRhZG8NCmBgYA0KDQoNCg==