Redes Neuronales

#Redes neuronales Una Red Artificial (ANN) modela la relación entre un conjunto de entradas y una salida, resolviendo un problema de aprendizaje.

Un ejemplo de aplicación de Redes Neuronales son: 1.La recomendación de contenido de Netflix. 2.El feed de TikTok, o instagram.

1.Instalar paquetes y llamar librerías

#install.packages("neuralnet")
library(neuralnet)
## Warning: package 'neuralnet' was built under R version 4.1.3

2.Alimentar como ejemplos

examen <- c(20,10,30,20,80,30)
proyecto <- c(90,20,40,50,50,80)
estatus <- c(1,0,0,0,1,1)
bd <- data.frame(examen,proyecto,estatus)

3.Generar Red Neuronal

red_neuronal <- neuralnet(estatus~ ., data=bd)
plot(red_neuronal)

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.4016212
## [2,] 0.4014047
## [3,] 0.4014047
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad>0.5,1,0)
resultado
##      [,1]
## [1,]    0
## [2,]    0
## [3,]    0

Ejemplo Cáncer de mamá

1. Cargar la base de datos

df <- read.csv("C:\\Users\\A00831614\\Documents\\Directorio de trabajo\\cancer_de_mama.csv")

2.Alimentar como ejemplos

df$ï..diagnosis <- ifelse(df$ï..diagnosis=="M",1,0)

3.Generar Red Neuronal

red_neuronal <- neuralnet(ï..diagnosis~ ., data=df)
plot(red_neuronal,rep="best")

4.Predecir con la Red Neuronal

prueba <- df[c(19,20,21,22,23),]
prediccion <- compute (red_neuronal,prueba)
prediccion$net.result
##         [,1]
## 19 0.9062841
## 20 0.1007783
## 21 0.1007783
## 22 0.1007783
## 23 0.9062841
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad> 0.5,1,0)
resultado
##    [,1]
## 19    1
## 20    0
## 21    0
## 22    0
## 23    1
LS0tDQp0aXRsZTogIkFDVDQuNyINCmF1dGhvcjogIkJlYXRyaXogUGFsYWNpb3MiDQpkYXRlOiAiOS8yOC8yMDIzIg0Kb3V0cHV0OiANCiBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICB0aGVtZTogInlldGkiDQogICAgaGlnaGxpZ2h0OiAidGFuZ28iDQotLS0NCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij4gUmVkZXMgTmV1cm9uYWxlczwvc3Bhbj4NCg0KIVtdKEM6XFxVc2Vyc1xcQTAwODMxNjE0XFxEb2N1bWVudHNcXERpcmVjdG9yaW8gZGUgdHJhYmFqb1xccmQud2VicCkNCg0KI1JlZGVzIG5ldXJvbmFsZXMNClVuYSBSZWQgQXJ0aWZpY2lhbCAoQU5OKSBtb2RlbGEgbGEgcmVsYWNpw7NuIGVudHJlICB1biBjb25qdW50byBkZSBlbnRyYWRhcyB5IHVuYSBzYWxpZGEsIHJlc29sdmllbmRvIHVuIHByb2JsZW1hIGRlIGFwcmVuZGl6YWplLg0KDQpVbiBlamVtcGxvIGRlIGFwbGljYWNpw7NuIGRlIFJlZGVzIE5ldXJvbmFsZXMgc29uOg0KMS5MYSByZWNvbWVuZGFjacOzbiBkZSBjb250ZW5pZG8gZGUgTmV0ZmxpeC4gDQoyLkVsIGZlZWQgZGUgVGlrVG9rLCBvIGluc3RhZ3JhbS4gDQoNCiMgMS5JbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXLDrWFzDQpgYGB7cn0NCiNpbnN0YWxsLnBhY2thZ2VzKCJuZXVyYWxuZXQiKQ0KbGlicmFyeShuZXVyYWxuZXQpDQpgYGANCg0KIyMgMi5BbGltZW50YXIgY29tbyBlamVtcGxvcw0KYGBge3J9DQpleGFtZW4gPC0gYygyMCwxMCwzMCwyMCw4MCwzMCkNCnByb3llY3RvIDwtIGMoOTAsMjAsNDAsNTAsNTAsODApDQplc3RhdHVzIDwtIGMoMSwwLDAsMCwxLDEpDQpiZCA8LSBkYXRhLmZyYW1lKGV4YW1lbixwcm95ZWN0byxlc3RhdHVzKQ0KYGBgDQoNCiMgMy5HZW5lcmFyIFJlZCBOZXVyb25hbA0KYGBge3J9DQpyZWRfbmV1cm9uYWwgPC0gbmV1cmFsbmV0KGVzdGF0dXN+IC4sIGRhdGE9YmQpDQpwbG90KHJlZF9uZXVyb25hbCkNCmBgYA0KDQojIyA0LlByZWRlY2lyIGNvbiBsYSBSZWQgTmV1cm9uYWwNCmBgYHtyfQ0KcHJ1ZWJhX2V4YW1lbiA8LSBjKDMwLDQwLDg1KQ0KcHJ1ZWJhX3Byb3llY3RvIDwtIGMoODUsNTAsNDApDQpwcnVlYmEgPC0gZGF0YS5mcmFtZShwcnVlYmFfZXhhbWVuLHBydWViYV9wcm95ZWN0bykNCnByZWRpY2Npb24gPC0gY29tcHV0ZShyZWRfbmV1cm9uYWwscHJ1ZWJhKQ0KcHJlZGljY2lvbiRuZXQucmVzdWx0DQpwcm9iYWJpbGlkYWQgPC0gcHJlZGljY2lvbiRuZXQucmVzdWx0DQpyZXN1bHRhZG8gPC0gaWZlbHNlKHByb2JhYmlsaWRhZD4wLjUsMSwwKQ0KcmVzdWx0YWRvDQpgYGANCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogcGluazsiPiBFamVtcGxvIEPDoW5jZXIgZGUgbWFtw6E8L3NwYW4+DQoNCg0KIyMgMS4gQ2FyZ2FyIGxhIGJhc2UgZGUgZGF0b3MNCmBgYHtyfQ0KZGYgPC0gcmVhZC5jc3YoIkM6XFxVc2Vyc1xcQTAwODMxNjE0XFxEb2N1bWVudHNcXERpcmVjdG9yaW8gZGUgdHJhYmFqb1xcY2FuY2VyX2RlX21hbWEuY3N2IikNCmBgYA0KDQojIyAyLkFsaW1lbnRhciBjb21vIGVqZW1wbG9zDQpgYGB7cn0NCmRmJMOvLi5kaWFnbm9zaXMgPC0gaWZlbHNlKGRmJMOvLi5kaWFnbm9zaXM9PSJNIiwxLDApDQpgYGANCg0KIyAzLkdlbmVyYXIgUmVkIE5ldXJvbmFsDQpgYGB7cn0NCnJlZF9uZXVyb25hbCA8LSBuZXVyYWxuZXQow68uLmRpYWdub3Npc34gLiwgZGF0YT1kZikNCnBsb3QocmVkX25ldXJvbmFsLHJlcD0iYmVzdCIpDQpgYGANCg0KIyMgNC5QcmVkZWNpciBjb24gbGEgUmVkIE5ldXJvbmFsDQpgYGB7cn0NCnBydWViYSA8LSBkZltjKDE5LDIwLDIxLDIyLDIzKSxdDQpwcmVkaWNjaW9uIDwtIGNvbXB1dGUgKHJlZF9uZXVyb25hbCxwcnVlYmEpDQpwcmVkaWNjaW9uJG5ldC5yZXN1bHQNCnByb2JhYmlsaWRhZCA8LSBwcmVkaWNjaW9uJG5ldC5yZXN1bHQNCnJlc3VsdGFkbyA8LSBpZmVsc2UocHJvYmFiaWxpZGFkPiAwLjUsMSwwKQ0KcmVzdWx0YWRvDQpgYGANCg0KDQo=