Redes neuronales

Ejercicio

Concepto

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

Ejemplos:
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 llamar librerías

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)

df <- data.frame(examen, proyecto,estatus)

3. General Red Neuronal

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

4. Predecir con la Red Neuronal

prueba_examen <- c(40,30,85)
prueba_proyecto <- c(85,50,40)
prueba <- data.frame(prueba_examen,prueba_proyecto)
prediccion <- compute(red_neuronal,prueba)
prediccion$net.result
##             [,1]
## [1,]  1.00876187
## [2,]  0.02577299
## [3,] -0.02015257
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad>0.5,1,0)
resultado
##      [,1]
## [1,]    1
## [2,]    0
## [3,]    0

Cancer de Mama

1. Alimentar con ejemplos

df_1 <- read.csv( "C:\\Users\\Deisy Lopez\\Documents\\7. Séptimo Semestre Ago-Dic 2023\\RStudio_AN\\cancer_de_mama.csv")
df_1$diagnosis <- ifelse(df_1$diagnosis == "M",1,0)

2. General Red Neuronal

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

3. Predecir con la Red Neuronal

prueba <- df_1[c(19,20,21,22,23),]
prediccion <- compute(red_neuronal,prueba)
prediccion$net.result
##          [,1]
## 19 1.00064227
## 20 0.01631248
## 21 0.01631248
## 22 0.01631248
## 23 1.00064227
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad>0.5,1,0)
resultado
##    [,1]
## 19    1
## 20    0
## 21    0
## 22    0
## 23    1
LS0tDQp0aXRsZTogIkFjdGl2aWRhZCA0LjciDQphdXRob3I6ICJEZWlzeSBMw7NwZXoiDQpkYXRlOiAiMjAyMy0xMC0wMiINCm91dHB1dDogDQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2F0OiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KICAgIHRoZW1lOiAiZGFya2x5Ig0KICAgIGhpZ2hsaWdodDogImhhZGRvY2siDQplZGl0b3Jfb3B0aW9uczogDQogIGNodW5rX291dHB1dF90eXBlOiBjb25zb2xlDQotLS0NCg0KIyBSZWRlcyBuZXVyb25hbGVzDQoNCiFbXShDOlxcVXNlcnNcXERlaXN5IExvcGV6XFxEb2N1bWVudHNcXDcuIFPDqXB0aW1vIFNlbWVzdHJlIEFnby1EaWMgMjAyM1xcUlN0dWRpb19BTlxccmVkLmdpZikNCg0KDQojIyBFamVyY2ljaW8NCg0KIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogZ3JheTsiPkNvbmNlcHRvPC9zcGFuPg0KDQpVbmEgUmVkIE5ldXJhbCBBcnRpZmljaWFsIChBTk4pIG1vZGVsYSBsYSByZWxhY2nDs24gZW50cmUgdW4gY29uanVudG8gZGUgZW50cmFkYSB5IHVuYSBzYWxpZGEsIHJlc29sdmllbmRvIHVuIHByb2JsZW1hIGRlIGFwcmVuZGl6YWplLiAgDQoNCkVqZW1wbG9zOiAgDQoxLiBMYSByZWNvbWVuZGFjacOzbiBkZSBjb250ZW5pZG8gZGUgTmV0ZmxpeC4gIA0KMi4gRWwgZmVlZCBkZSBJbnN0YWdyYW0gbyBUaWt0b2suICANCjMuIERldGVybWluYXIgZWwgbsO6bWVybyBvIGxldHJhIGVzY3JpdG8gYSBtYW5vLiAgDQoNCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6IGdyYXk7Ij4xLiBJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXLDrWFzPC9zcGFuPg0KYGBge3J9DQpsaWJyYXJ5KG5ldXJhbG5ldCkNCmBgYA0KDQojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBncmF5OyI+Mi4gQWxpbWVudGFyIGNvbiBlamVtcGxvczwvc3Bhbj4NCmBgYHtyfQ0KZXhhbWVuIDwtIGMoMjAsMTAsMzAsMjAsODAsMzApDQpwcm95ZWN0byA8LSBjKDkwLDIwLDQwLDUwLDUwLDgwKQ0KZXN0YXR1cyA8LSBjKDEsMCwwLDAsMCwxKQ0KDQpkZiA8LSBkYXRhLmZyYW1lKGV4YW1lbiwgcHJveWVjdG8sZXN0YXR1cykNCmBgYA0KDQojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBncmF5OyI+My4gR2VuZXJhbCBSZWQgTmV1cm9uYWw8L3NwYW4+DQpgYGB7cn0NCnJlZF9uZXVyb25hbCA8LSBuZXVyYWxuZXQoZXN0YXR1cyB+IC4sIGRhdGE9ZGYpDQpwbG90KHJlZF9uZXVyb25hbCwgcmVwPSJiZXN0IikNCmBgYA0KDQojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBncmF5OyI+NC4gUHJlZGVjaXIgY29uIGxhIFJlZCBOZXVyb25hbDwvc3Bhbj4NCmBgYHtyfQ0KcHJ1ZWJhX2V4YW1lbiA8LSBjKDQwLDMwLDg1KQ0KcHJ1ZWJhX3Byb3llY3RvIDwtIGMoODUsNTAsNDApDQpwcnVlYmEgPC0gZGF0YS5mcmFtZShwcnVlYmFfZXhhbWVuLHBydWViYV9wcm95ZWN0bykNCnByZWRpY2Npb24gPC0gY29tcHV0ZShyZWRfbmV1cm9uYWwscHJ1ZWJhKQ0KcHJlZGljY2lvbiRuZXQucmVzdWx0DQpwcm9iYWJpbGlkYWQgPC0gcHJlZGljY2lvbiRuZXQucmVzdWx0DQpyZXN1bHRhZG8gPC0gaWZlbHNlKHByb2JhYmlsaWRhZD4wLjUsMSwwKQ0KcmVzdWx0YWRvDQpgYGANCg0KIyMgQ2FuY2VyIGRlIE1hbWENCg0KIyMjIDxzcGFuIHN0eWxlPSJjb2xvcjogcGluazsiPjEuIEFsaW1lbnRhciBjb24gZWplbXBsb3M8L3NwYW4+DQpgYGB7cn0NCmRmXzEgPC0gcmVhZC5jc3YoICJDOlxcVXNlcnNcXERlaXN5IExvcGV6XFxEb2N1bWVudHNcXDcuIFPDqXB0aW1vIFNlbWVzdHJlIEFnby1EaWMgMjAyM1xcUlN0dWRpb19BTlxcY2FuY2VyX2RlX21hbWEuY3N2IikNCmBgYA0KDQpgYGB7cn0NCmRmXzEkZGlhZ25vc2lzIDwtIGlmZWxzZShkZl8xJGRpYWdub3NpcyA9PSAiTSIsMSwwKQ0KYGBgDQoNCiMjIyA8c3BhbiBzdHlsZT0iY29sb3I6IHBpbms7Ij4yLiBHZW5lcmFsIFJlZCBOZXVyb25hbDwvc3Bhbj4NCmBgYHtyfQ0KcmVkX25ldXJvbmFsIDwtIG5ldXJhbG5ldChkaWFnbm9zaXMgfiAuLCBkYXRhPWRmXzEpDQpwbG90KHJlZF9uZXVyb25hbCwgcmVwPSJiZXN0IikNCmBgYA0KDQojIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBwaW5rOyI+My4gUHJlZGVjaXIgY29uIGxhIFJlZCBOZXVyb25hbDwvc3Bhbj4NCmBgYHtyfQ0KcHJ1ZWJhIDwtIGRmXzFbYygxOSwyMCwyMSwyMiwyMyksXQ0KcHJlZGljY2lvbiA8LSBjb21wdXRlKHJlZF9uZXVyb25hbCxwcnVlYmEpDQpwcmVkaWNjaW9uJG5ldC5yZXN1bHQNCnByb2JhYmlsaWRhZCA8LSBwcmVkaWNjaW9uJG5ldC5yZXN1bHQNCnJlc3VsdGFkbyA8LSBpZmVsc2UocHJvYmFiaWxpZGFkPjAuNSwxLDApDQpyZXN1bHRhZG8NCmBgYA==