Redes Neuronales

Concepto
Una Red Neuronal Artificial (ANN) modela la relación entre un
conjunto de entradas y una salida, resolviedno un problema de
aprendizaje.
Ejemplos de aplicación de Redes Neuronales:
1. Recomendación de contenido de Netflix.
2.El feed de Instagram o Tiktok.
3.Determinar el número de letra escrito o a mano.
1. Instalar paquetes y llamar
librerias
#install.packages("neuralnet")
library(neuralnet)
## Warning: package 'neuralnet' was built under R version 4.3.1
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)
df <- data.frame(examen, proyecto, estatus)
3.Generar la Red Neuronal
red_neuronal <- neuralnet(estatus~.,data = df)
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.3331327
## [2,] 0.3331327
## [3,] 0.3331327
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad>0.5,1,0)
resultado
## [,1]
## [1,] 0
## [2,] 0
## [3,] 0
Redes Neuronales Cáncer de
Mamá
1. Importar base de datos
df <- read.csv("C:\\Users\\ximen\\OneDrive\\Escritorio\\Negocios\\7° Semestre\\AnalÃtica de negocios\\cancer_de_mama.csv")
df$diagnosis <- ifelse(df$diagnosis == "M",1,0)
2. General la Red Neuronal
red_neuronal <- neuralnet(diagnosis ~., data=df)
plot(red_neuronal, rep="best")

prueba <- df[c(19,20,21,22,23),]
prediccion <- compute(red_neuronal, prueba)
prediccion$net.result
## [,1]
## 19 0.3732365
## 20 0.3732365
## 21 0.3732365
## 22 0.3732365
## 23 0.3732365
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad>0.5,1,0)
resultado
## [,1]
## 19 0
## 20 0
## 21 0
## 22 0
## 23 0
LS0tDQp0aXRsZTogIkFjdGl2aWRhZCA0LjcgUmVkZXMgTmV1cm9uYWxlcyINCmF1dGhvcjogIlhpbWVuYSBDYXN0aWxsbyBBMDEzNjk5NDkiDQpkYXRlOiAiMjAyMy0xMC0wMiINCm91dHB1dDoNCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQogICAgdGhlbWU6ICJzaW1wbGV4Ig0KICAgIGhpZ2hsaWdodDogIm1vbm9jaHJvbWUiDQotLS0NCjxjZW50ZXI+DQojIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiPlJlZGVzIE5ldXJvbmFsZXM8L3NwYW4+ICANCg0KIVtdKEM6XFxVc2Vyc1xceGltZW5cXERvd25sb2Fkc1xccmVkZXNuZXVyb25hbGVzLmdpZikNCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij5Db25jZXB0bzwvc3Bhbj4gIA0KVW5hIFJlZCBOZXVyb25hbCBBcnRpZmljaWFsIChBTk4pIG1vZGVsYSBsYSByZWxhY2nDs24gZW50cmUgdW4gY29uanVudG8gZGUgZW50cmFkYXMgeSB1bmEgc2FsaWRhLCByZXNvbHZpZWRubyB1biBwcm9ibGVtYSBkZSBhcHJlbmRpemFqZS4gIA0KDQpFamVtcGxvcyBkZSBhcGxpY2FjacOzbiBkZSBSZWRlcyBOZXVyb25hbGVzOiAgDQoxLiBSZWNvbWVuZGFjacOzbiBkZSBjb250ZW5pZG8gZGUgTmV0ZmxpeC4gIA0KMi5FbCBmZWVkIGRlIEluc3RhZ3JhbSBvIFRpa3Rvay4gIA0KMy5EZXRlcm1pbmFyIGVsIG7Dum1lcm8gZGUgbGV0cmEgZXNjcml0byBvIGEgbWFuby4gIA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij4xLiBJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXJpYXM8L3NwYW4+IA0KDQpgYGB7cn0NCiNpbnN0YWxsLnBhY2thZ2VzKCJuZXVyYWxuZXQiKQ0KbGlicmFyeShuZXVyYWxuZXQpDQoNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij4yLkFsaW1lbnRhciBjb24gZWplbXBsb3M8L3NwYW4+IA0KDQpgYGB7cn0NCmV4YW1lbiA8LSBjKDIwLDEwLDMwLDIwLDgwLDMwKQ0KcHJveWVjdG8gPC0gYyg5MCwyMCw0MCw1MCw1MCw4MCkNCmVzdGF0dXMgPC0gYygxLDAsMCwwLDAsMSkNCmRmIDwtIGRhdGEuZnJhbWUoZXhhbWVuLCBwcm95ZWN0bywgZXN0YXR1cykNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij4zLkdlbmVyYXIgbGEgUmVkIE5ldXJvbmFsPC9zcGFuPiANCg0KYGBge3J9DQpyZWRfbmV1cm9uYWwgPC0gbmV1cmFsbmV0KGVzdGF0dXN+LixkYXRhID0gZGYpDQpwbG90KHJlZF9uZXVyb25hbCwgcmVwPSJiZXN0IikNCmBgYA0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+NC5QcmVkZWNpciBjb24gbGEgUmVkIE5ldXJvbmFsPC9zcGFuPiANCg0KYGBge3J9DQpwcnVlYmFfZXhhbWVuIDwtIGMoMzAsNDAsODUpDQpwcnVlYmFfcHJveWVjdG8gPC0gYyg4NSw1MCw0MCkNCnBydWViYSA8LWRhdGEuZnJhbWUocHJ1ZWJhX2V4YW1lbixwcnVlYmFfcHJveWVjdG8pDQpwcmVkaWNjaW9uIDwtIGNvbXB1dGUocmVkX25ldXJvbmFsLHBydWViYSkNCnByZWRpY2Npb24kbmV0LnJlc3VsdA0KcHJvYmFiaWxpZGFkIDwtIHByZWRpY2Npb24kbmV0LnJlc3VsdA0KcmVzdWx0YWRvIDwtIGlmZWxzZShwcm9iYWJpbGlkYWQ+MC41LDEsMCkNCnJlc3VsdGFkbw0KYGBgDQojIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMgIA0KIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjICANCg0KPGNlbnRlcj4NCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiByZWQ7Ij5SZWRlcyBOZXVyb25hbGVzIEPDoW5jZXIgZGUgTWFtw6E8L3NwYW4+IA0KDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkOyI+MS4gSW1wb3J0YXIgYmFzZSBkZSBkYXRvczwvc3Bhbj4gDQpgYGB7cn0NCmRmIDwtIHJlYWQuY3N2KCJDOlxcVXNlcnNcXHhpbWVuXFxPbmVEcml2ZVxcRXNjcml0b3Jpb1xcTmVnb2Npb3NcXDfCsCBTZW1lc3RyZVxcQW5hbMOtdGljYSBkZSBuZWdvY2lvc1xcY2FuY2VyX2RlX21hbWEuY3N2IikNCmRmJGRpYWdub3NpcyA8LSBpZmVsc2UoZGYkZGlhZ25vc2lzID09ICJNIiwxLDApDQpgYGANCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiByZWQ7IiA+Mi4gR2VuZXJhbCBsYSBSZWQgTmV1cm9uYWw8L3NwYW4+DQpgYGB7cn0NCnJlZF9uZXVyb25hbCA8LSBuZXVyYWxuZXQoZGlhZ25vc2lzIH4uLCBkYXRhPWRmKQ0KcGxvdChyZWRfbmV1cm9uYWwsIHJlcD0iYmVzdCIpDQoNCmBgYA0KYGBge3J9DQpwcnVlYmEgPC0gZGZbYygxOSwyMCwyMSwyMiwyMyksXQ0KcHJlZGljY2lvbiA8LSBjb21wdXRlKHJlZF9uZXVyb25hbCwgcHJ1ZWJhKQ0KcHJlZGljY2lvbiRuZXQucmVzdWx0DQpwcm9iYWJpbGlkYWQgPC0gcHJlZGljY2lvbiRuZXQucmVzdWx0DQoNCnJlc3VsdGFkbyA8LSBpZmVsc2UocHJvYmFiaWxpZGFkPjAuNSwxLDApDQpyZXN1bHRhZG8NCmBgYA0KDQoNCg==