Redes Neuronales

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 llamar librería

library(neuralnet)

2. Alimentar con ejemplos.

examen <- c(20,10,30,20,80,30)
proyecto <- c(90,20,40,50,50,60)
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_proyeto <- c(85, 50, 40)
prueba <- data.frame(prueba_examen, prueba_proyeto)
prediccion <- compute(red_neuronal, prueba)
probabilidad <- prediccion$net.result
resulado <- ifelse(probabilidad >0.5,1,0)
resulado
##      [,1]
## [1,]    0
## [2,]    0
## [3,]    0

Cancer de mama.

bd <- read.csv("/Users/benjaminreyessanchez/Downloads/cancer_de_mama.csv")
summary(bd)
##   diagnosis          radius_mean      texture_mean   perimeter_mean  
##  Length:569         Min.   : 6.981   Min.   : 9.71   Min.   : 43.79  
##  Class :character   1st Qu.:11.700   1st Qu.:16.17   1st Qu.: 75.17  
##  Mode  :character   Median :13.370   Median :18.84   Median : 86.24  
##                     Mean   :14.127   Mean   :19.29   Mean   : 91.97  
##                     3rd Qu.:15.780   3rd Qu.:21.80   3rd Qu.:104.10  
##                     Max.   :28.110   Max.   :39.28   Max.   :188.50  
##    area_mean      smoothness_mean   compactness_mean  concavity_mean   
##  Min.   : 143.5   Min.   :0.05263   Min.   :0.01938   Min.   :0.00000  
##  1st Qu.: 420.3   1st Qu.:0.08637   1st Qu.:0.06492   1st Qu.:0.02956  
##  Median : 551.1   Median :0.09587   Median :0.09263   Median :0.06154  
##  Mean   : 654.9   Mean   :0.09636   Mean   :0.10434   Mean   :0.08880  
##  3rd Qu.: 782.7   3rd Qu.:0.10530   3rd Qu.:0.13040   3rd Qu.:0.13070  
##  Max.   :2501.0   Max.   :0.16340   Max.   :0.34540   Max.   :0.42680  
##  concave.points_mean symmetry_mean    fractal_dimension_mean   radius_se     
##  Min.   :0.00000     Min.   :0.1060   Min.   :0.04996        Min.   :0.1115  
##  1st Qu.:0.02031     1st Qu.:0.1619   1st Qu.:0.05770        1st Qu.:0.2324  
##  Median :0.03350     Median :0.1792   Median :0.06154        Median :0.3242  
##  Mean   :0.04892     Mean   :0.1812   Mean   :0.06280        Mean   :0.4052  
##  3rd Qu.:0.07400     3rd Qu.:0.1957   3rd Qu.:0.06612        3rd Qu.:0.4789  
##  Max.   :0.20120     Max.   :0.3040   Max.   :0.09744        Max.   :2.8730  
##    texture_se      perimeter_se       area_se        smoothness_se     
##  Min.   :0.3602   Min.   : 0.757   Min.   :  6.802   Min.   :0.001713  
##  1st Qu.:0.8339   1st Qu.: 1.606   1st Qu.: 17.850   1st Qu.:0.005169  
##  Median :1.1080   Median : 2.287   Median : 24.530   Median :0.006380  
##  Mean   :1.2169   Mean   : 2.866   Mean   : 40.337   Mean   :0.007041  
##  3rd Qu.:1.4740   3rd Qu.: 3.357   3rd Qu.: 45.190   3rd Qu.:0.008146  
##  Max.   :4.8850   Max.   :21.980   Max.   :542.200   Max.   :0.031130  
##  compactness_se      concavity_se     concave.points_se   symmetry_se      
##  Min.   :0.002252   Min.   :0.00000   Min.   :0.000000   Min.   :0.007882  
##  1st Qu.:0.013080   1st Qu.:0.01509   1st Qu.:0.007638   1st Qu.:0.015160  
##  Median :0.020450   Median :0.02589   Median :0.010930   Median :0.018730  
##  Mean   :0.025478   Mean   :0.03189   Mean   :0.011796   Mean   :0.020542  
##  3rd Qu.:0.032450   3rd Qu.:0.04205   3rd Qu.:0.014710   3rd Qu.:0.023480  
##  Max.   :0.135400   Max.   :0.39600   Max.   :0.052790   Max.   :0.078950  
##  fractal_dimension_se  radius_worst   texture_worst   perimeter_worst 
##  Min.   :0.0008948    Min.   : 7.93   Min.   :12.02   Min.   : 50.41  
##  1st Qu.:0.0022480    1st Qu.:13.01   1st Qu.:21.08   1st Qu.: 84.11  
##  Median :0.0031870    Median :14.97   Median :25.41   Median : 97.66  
##  Mean   :0.0037949    Mean   :16.27   Mean   :25.68   Mean   :107.26  
##  3rd Qu.:0.0045580    3rd Qu.:18.79   3rd Qu.:29.72   3rd Qu.:125.40  
##  Max.   :0.0298400    Max.   :36.04   Max.   :49.54   Max.   :251.20  
##    area_worst     smoothness_worst  compactness_worst concavity_worst 
##  Min.   : 185.2   Min.   :0.07117   Min.   :0.02729   Min.   :0.0000  
##  1st Qu.: 515.3   1st Qu.:0.11660   1st Qu.:0.14720   1st Qu.:0.1145  
##  Median : 686.5   Median :0.13130   Median :0.21190   Median :0.2267  
##  Mean   : 880.6   Mean   :0.13237   Mean   :0.25427   Mean   :0.2722  
##  3rd Qu.:1084.0   3rd Qu.:0.14600   3rd Qu.:0.33910   3rd Qu.:0.3829  
##  Max.   :4254.0   Max.   :0.22260   Max.   :1.05800   Max.   :1.2520  
##  concave.points_worst symmetry_worst   fractal_dimension_worst
##  Min.   :0.00000      Min.   :0.1565   Min.   :0.05504        
##  1st Qu.:0.06493      1st Qu.:0.2504   1st Qu.:0.07146        
##  Median :0.09993      Median :0.2822   Median :0.08004        
##  Mean   :0.11461      Mean   :0.2901   Mean   :0.08395        
##  3rd Qu.:0.16140      3rd Qu.:0.3179   3rd Qu.:0.09208        
##  Max.   :0.29100      Max.   :0.6638   Max.   :0.20750
#count(bd, diagnosis, sort = TRUE)
bd$diagnosis = ifelse(bd$diagnosis == "M",1,0) 
red_neuronal <- neuralnet(diagnosis~ ., data=bd)
plot((red_neuronal), rep = "best")

prueba <- bd[c(19,20,21,22,34), ]
prediccion <- compute(red_neuronal, prueba)
prediccion$net.result
##        [,1]
## 19 0.372569
## 20 0.372569
## 21 0.372569
## 22 0.372569
## 34 0.372569
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad >0.5,1,0)
resultado
##    [,1]
## 19    0
## 20    0
## 21    0
## 22    0
## 34    0
LS0tCnRpdGxlOiAiUmVkZXMgTmV1cm9uYWxlcyIKYXV0aG9yOiAiQmVuamFtw61uIFJleWVzIEEwMDgzMDUxMyIKZGF0ZTogIjAyLTEwLTIwMjMiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogVFJVRQogICAgdG9jX2Zsb2F0OiBUUlVFCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFCiAgICB0aGVtZTogInJlYWRhYmxlIgogICAgaGlnaGxpZ2h0OiAia2F0ZSIKLS0tCgojIDxzcGFuIHN0eWxlPSJjb2xvcjogcHVycGxlOyI+UmVkZXMgTmV1cm9uYWxlczwvc3Bhbj4KCiFbXSgvVXNlcnMvYmVuamFtaW5yZXllc3NhbmNoZXovRG93bmxvYWRzLzBjNGY2NDE0YzIxMTA1ZDc4OGQ0N2ZjZmEzODFiYWU3LmdpZi53ZWJwKQoKVW5hIFJlZCBOZXVyYWwgQXJ0aWZpY2lhbCAoQU5OKSBtb2RlbGEgbGEgcmVsYWNpw7NuIGVudHJlIHVuIGNvbmp1bnRvIGRlIGVudHJhZGFzIHkgdW5hIHNhbGlkYSByZXNvbHZpZW5kbyB1biBwcm9ibGVtYSBkZSBhcHJlbmRpemFqZSAKCkVqZW1wbG9zIGRlIGFwbGljYWNpw7NuIGRlIHJlZGVzIG5ldXJvbmFsZXMgc29uOiAgCjEuIExhIHJlY29tZW5kYWNpw7NuIGRlIGNvbnRlbmlkbyBkZSBuZXRmbGl4LiAgCjIuIEVsIGZlZWQgZGUgSW5zdGFncmFtIG8gVGlrVG9rLgozLiBEZXRlcm1pbmFyIGVsIG7Dum1lcm8gbyBsZXRyYSBlc2NyaXRvIGEgbWFuby4gCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IHB1cnBsZTsiPjEuIEluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxpYnJlcsOtYTwvc3Bhbj4KCmBgYHtyfQpsaWJyYXJ5KG5ldXJhbG5ldCkKYGBgCgoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBwdXJwbGU7Ij4yLiBBbGltZW50YXIgY29uIGVqZW1wbG9zLjwvc3Bhbj4gCmBgYHtyfQpleGFtZW4gPC0gYygyMCwxMCwzMCwyMCw4MCwzMCkKcHJveWVjdG8gPC0gYyg5MCwyMCw0MCw1MCw1MCw2MCkKZXN0YXR1cyA8LSBjKDEsMCwwLDAsMCwxKQpkZiA8LSBkYXRhLmZyYW1lKGV4YW1lbiwgcHJveWVjdG8sIGVzdGF0dXMpCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBwdXJwbGU7Ij4zLiBHZW5lcmFyIGxhIHJlZCBuZXVyb25hbC48L3NwYW4+IApgYGB7cn0KcmVkX25ldXJvbmFsIDwtIG5ldXJhbG5ldChlc3RhdHVzfiAuLCBkYXRhPWRmKQpwbG90KChyZWRfbmV1cm9uYWwpLCByZXAgPSAiYmVzdCIpCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBwdXJwbGU7Ij40LiBQcmVkZWNpciBjb24gbGEgcmVkIG5ldXJvbmFsLjwvc3Bhbj4gCgpgYGB7cn0KcHJ1ZWJhX2V4YW1lbiA8LSBjKDMwLDQwLDg1KQpwcnVlYmFfcHJveWV0byA8LSBjKDg1LCA1MCwgNDApCnBydWViYSA8LSBkYXRhLmZyYW1lKHBydWViYV9leGFtZW4sIHBydWViYV9wcm95ZXRvKQpwcmVkaWNjaW9uIDwtIGNvbXB1dGUocmVkX25ldXJvbmFsLCBwcnVlYmEpCnByb2JhYmlsaWRhZCA8LSBwcmVkaWNjaW9uJG5ldC5yZXN1bHQKcmVzdWxhZG8gPC0gaWZlbHNlKHByb2JhYmlsaWRhZCA+MC41LDEsMCkKcmVzdWxhZG8KYGBgCgoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBwdXJwbGU7Ij5DYW5jZXIgZGUgbWFtYS48L3NwYW4+IApgYGB7cn0KYmQgPC0gcmVhZC5jc3YoIi9Vc2Vycy9iZW5qYW1pbnJleWVzc2FuY2hlei9Eb3dubG9hZHMvY2FuY2VyX2RlX21hbWEuY3N2IikKc3VtbWFyeShiZCkKI2NvdW50KGJkLCBkaWFnbm9zaXMsIHNvcnQgPSBUUlVFKQpiZCRkaWFnbm9zaXMgPSBpZmVsc2UoYmQkZGlhZ25vc2lzID09ICJNIiwxLDApIApgYGAKCmBgYHtyfQpyZWRfbmV1cm9uYWwgPC0gbmV1cmFsbmV0KGRpYWdub3Npc34gLiwgZGF0YT1iZCkKcGxvdCgocmVkX25ldXJvbmFsKSwgcmVwID0gImJlc3QiKQpgYGAKCmBgYHtyfQoKcHJ1ZWJhIDwtIGJkW2MoMTksMjAsMjEsMjIsMzQpLCBdCnByZWRpY2Npb24gPC0gY29tcHV0ZShyZWRfbmV1cm9uYWwsIHBydWViYSkKcHJlZGljY2lvbiRuZXQucmVzdWx0CnByb2JhYmlsaWRhZCA8LSBwcmVkaWNjaW9uJG5ldC5yZXN1bHQKcmVzdWx0YWRvIDwtIGlmZWxzZShwcm9iYWJpbGlkYWQgPjAuNSwxLDApCnJlc3VsdGFkbwpgYGAKCg==