Red neuronal

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

Ejemplos de aplicación

1.Recomendaciones en plataformas digitales como Netflix, HBO 2.Algoritmo de TikTok

1. Llamar librerías

library(neuralnet)

2. Alinear los 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)
df <- data.frame(examen,proyecto,estatus)

3. Generar Red Neuronal

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

4. Producir con la Red Neuronal

prueba_examen <- c(30,40,85)
prueba_proyecto <- c(85, 50, 40)
prueba <- data.frame(prueba_examen, prueba_proyecto)

predicccion <- compute(red_neuronal, prueba)
predicccion$net.result
##           [,1]
## [1,] 1.0270780
## [2,] 0.2470431
## [3,] 0.2470430
probabilidad <- predicccion$net.result
resultado <- ifelse(probabilidad>0.5,1,0)
resultado 
##      [,1]
## [1,]    1
## [2,]    0
## [3,]    0

Cancer de Mama

Alimentar con ejemplos

#file.choose()
cancermama <- read.csv("C:/Users/lynet/OneDrive/Documents/Analítica 2023/cancer_de_mama.csv")
cancermama$diagnosis<- ifelse(cancermama$diagnosis == "M", 1,0)
redne<- neuralnet(diagnosis~., data=cancermama)
plot(redne)
prueba_cancer <- cancermama[c(19,20,21,22,23), ]

prediccion1 <- compute(redne, prueba_cancer)
prediccion1$net.result
##         [,1]
## 19 0.3725784
## 20 0.3725784
## 21 0.3725784
## 22 0.3725784
## 23 0.3725784
probabilidad1 <- prediccion1$net.result
resultado1<- ifelse(probabilidad1>0.5,1,0)
resultado1
##    [,1]
## 19    0
## 20    0
## 21    0
## 22    0
## 23    0
LS0tDQp0aXRsZTogIkFjdCA0LjciDQphdXRob3I6ICJMeW5ldHRlIFNvbGlzIEEwMTU2MjM4OSINCmRhdGU6ICIyMDIzLTA5LTI5Ig0Kb3V0cHV0OiANCiBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICB0aGVtZTogInlldGkiDQotLS0NCg0KPGNlbnRlcj4NCiFbIF0oQzovVXNlcnMvbHluZXQvT25lRHJpdmUvRG9jdW1lbnRzL0FuYWzDrXRpY2EgMjAyMy9uZXVyb25hLnBuZykgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij5SZWQgbmV1cm9uYWw8L3NwYW4+DQoNClVuYSBSZWQgTmV1cm9uYWwgQXJ0aWZpY2lhbCAoQU5OKSBtb2RlbGEgbGEgcmVsYWNpw7NuIGVudHJlIHVuIGNvbmp1bnRvIGRlIGVudHJhZGFzIHkgdW5hIHNhbGlkYSwgcmVzb2x2aWVuZG8gdW4gcHJvYmxlbWEgZGUgYXByZW5kaXphamUuICANCg0KRWplbXBsb3MgZGUgYXBsaWNhY2nDs24gDQoNCjEuUmVjb21lbmRhY2lvbmVzIGVuIHBsYXRhZm9ybWFzIGRpZ2l0YWxlcyBjb21vIE5ldGZsaXgsIEhCTw0KMi5BbGdvcml0bW8gZGUgVGlrVG9rDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+MS4gTGxhbWFyIGxpYnJlcsOtYXM8L3NwYW4+DQpgYGB7cn0NCmxpYnJhcnkobmV1cmFsbmV0KQ0KYGBgDQoNCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4yLiBBbGluZWFyIGxvcyBlamVtcGxvczwvc3Bhbj4NCg0KYGBge3J9DQpleGFtZW4gPC0gYygyMCwxMCwzMCwyMCw4MCwzMCkNCnByb3llY3RvIDwtIGMoOTAsMjAsNDAsNTAsNTAsODApDQplc3RhdHVzIDwtIGMoMSwwLDAsMCwxLDEpDQpkZiA8LSBkYXRhLmZyYW1lKGV4YW1lbixwcm95ZWN0byxlc3RhdHVzKQ0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+My4gR2VuZXJhciBSZWQgTmV1cm9uYWw8L3NwYW4+DQoNCmBgYHtyfQ0KcmVkX25ldXJvbmFsIDwtIG5ldXJhbG5ldChlc3RhdHVzfi4sIGRhdGE9ZGYpDQpwbG90KHJlZF9uZXVyb25hbCkNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPjQuIFByb2R1Y2lyIGNvbiBsYSBSZWQgTmV1cm9uYWw8L3NwYW4+DQoNCmBgYHtyfQ0KcHJ1ZWJhX2V4YW1lbiA8LSBjKDMwLDQwLDg1KQ0KcHJ1ZWJhX3Byb3llY3RvIDwtIGMoODUsIDUwLCA0MCkNCnBydWViYSA8LSBkYXRhLmZyYW1lKHBydWViYV9leGFtZW4sIHBydWViYV9wcm95ZWN0bykNCg0KcHJlZGljY2Npb24gPC0gY29tcHV0ZShyZWRfbmV1cm9uYWwsIHBydWViYSkNCnByZWRpY2NjaW9uJG5ldC5yZXN1bHQNCnByb2JhYmlsaWRhZCA8LSBwcmVkaWNjY2lvbiRuZXQucmVzdWx0DQpyZXN1bHRhZG8gPC0gaWZlbHNlKHByb2JhYmlsaWRhZD4wLjUsMSwwKQ0KcmVzdWx0YWRvIA0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOnBpbms7Ij5DYW5jZXIgZGUgTWFtYTwvc3Bhbj4NCg0KIVsgXShDOi9Vc2Vycy9seW5ldC9PbmVEcml2ZS9Eb2N1bWVudHMvQW5hbMOtdGljYSAyMDIzL2NhbmNlcnIucG5nKQ0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6cGluazsiPkFsaW1lbnRhciBjb24gZWplbXBsb3M8L3NwYW4+DQoNCmBgYHtyfQ0KI2ZpbGUuY2hvb3NlKCkNCmNhbmNlcm1hbWEgPC0gcmVhZC5jc3YoIkM6L1VzZXJzL2x5bmV0L09uZURyaXZlL0RvY3VtZW50cy9BbmFsw610aWNhIDIwMjMvY2FuY2VyX2RlX21hbWEuY3N2IikNCmNhbmNlcm1hbWEkZGlhZ25vc2lzPC0gaWZlbHNlKGNhbmNlcm1hbWEkZGlhZ25vc2lzID09ICJNIiwgMSwwKQ0KYGBgDQoNCmBgYHtyfQ0KcmVkbmU8LSBuZXVyYWxuZXQoZGlhZ25vc2lzfi4sIGRhdGE9Y2FuY2VybWFtYSkNCnBsb3QocmVkbmUpDQpgYGANCg0KYGBge3J9DQpwcnVlYmFfY2FuY2VyIDwtIGNhbmNlcm1hbWFbYygxOSwyMCwyMSwyMiwyMyksIF0NCg0KcHJlZGljY2lvbjEgPC0gY29tcHV0ZShyZWRuZSwgcHJ1ZWJhX2NhbmNlcikNCnByZWRpY2Npb24xJG5ldC5yZXN1bHQNCnByb2JhYmlsaWRhZDEgPC0gcHJlZGljY2lvbjEkbmV0LnJlc3VsdA0KcmVzdWx0YWRvMTwtIGlmZWxzZShwcm9iYWJpbGlkYWQxPjAuNSwxLDApDQpyZXN1bHRhZG8xDQpgYGANCg0KDQoNCg0KDQoNCg==