Teoría

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

Algunos ejemplos de aplicación de ANN son:

  • La recomendación de contenido de Netflix.
  • El feed de Instagram.
  • Determinar el número escrito a mano.

Ejercicio 1. ¿Pasé la materia?

Paso 1: Instalar paquetes y llamar librerías

#install.packages("neurnalnet")
library(neuralnet)

Paso 2: Obtener datos

examen <- c(20,10,30,20,80,30)
proyecto <- c(90,20,40,50,50,80)
status <- c(1,0,0,0,0,1)

df1 <- data.frame(examen, proyecto, status)
df1
##   examen proyecto status
## 1     20       90      1
## 2     10       20      0
## 3     30       40      0
## 4     20       50      0
## 5     80       50      0
## 6     30       80      1

Paso 3: Crear Red Neuronal

set.seed(123)
rn1 <- neuralnet(status ~ ., data = df1)
summary(rn1)
##                     Length Class      Mode    
## call                 3     -none-     call    
## response             6     -none-     numeric 
## covariate           12     -none-     numeric 
## model.list           2     -none-     list    
## err.fct              1     -none-     function
## act.fct              1     -none-     function
## linear.output        1     -none-     logical 
## data                 3     data.frame list    
## exclude              0     -none-     NULL    
## net.result           1     -none-     list    
## weights              1     -none-     list    
## generalized.weights  1     -none-     list    
## startweights         1     -none-     list    
## result.matrix        8     -none-     numeric
plot(rn1, rep="best")

Paso 4: Predecir Resultados

prueba_examen <- c(30,40,85)
prueba_proyecto <- c(85,50,40)
prueba1 <- data.frame(prueba_examen,prueba_proyecto)
prediccion <- compute(rn1, prueba1)
prediccion$net.result
##             [,1]
## [1,]  1.04011743
## [2,] -0.02359178
## [3,] -0.02359178
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad >0.5, 1,0)
resultado
##      [,1]
## [1,]    1
## [2,]    0
## [3,]    0

Ejercicio 2. Cáncer de Mama

Paso 1: Instalar paquetes y llamar librerías

#install.packages("neurnalnet")
library(neuralnet)

Paso 2: Obtener datos

library(readr)
df2 <- read.csv("C:/Users/luisa/Downloads/cancer_de_mama.csv")


df2$diagnosis <- ifelse(df2$diagnosis == "M", 1, 0)
summary(df2)
##    diagnosis       radius_mean      texture_mean   perimeter_mean  
##  Min.   :0.0000   Min.   : 6.981   Min.   : 9.71   Min.   : 43.79  
##  1st Qu.:0.0000   1st Qu.:11.697   1st Qu.:16.20   1st Qu.: 75.14  
##  Median :0.0000   Median :13.355   Median :18.86   Median : 86.21  
##  Mean   :0.3723   Mean   :14.125   Mean   :19.31   Mean   : 91.95  
##  3rd Qu.:1.0000   3rd Qu.:15.780   3rd Qu.:21.80   3rd Qu.:103.88  
##  Max.   :1.0000   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.2   1st Qu.:0.08604   1st Qu.:0.06431   1st Qu.:0.02940  
##  Median : 548.8   Median :0.09578   Median :0.09252   Median :0.06140  
##  Mean   : 654.6   Mean   :0.09629   Mean   :0.10424   Mean   :0.08877  
##  3rd Qu.: 782.6   3rd Qu.:0.10530   3rd Qu.:0.13043   3rd Qu.:0.12965  
##  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.02030     1st Qu.:0.1619   1st Qu.:0.05777        1st Qu.:0.2324  
##  Median :0.03345     Median :0.1792   Median :0.06152        Median :0.3246  
##  Mean   :0.04883     Mean   :0.1811   Mean   :0.06278        Mean   :0.4051  
##  3rd Qu.:0.07373     3rd Qu.:0.1956   3rd Qu.:0.06609        3rd Qu.:0.4773  
##  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.8351   1st Qu.: 1.605   1st Qu.: 17.858   1st Qu.:0.005166  
##  Median :1.1270   Median : 2.288   Median : 24.565   Median :0.006363  
##  Mean   :1.2195   Mean   : 2.865   Mean   : 40.304   Mean   :0.007040  
##  3rd Qu.:1.4752   3rd Qu.: 3.337   3rd Qu.: 45.017   3rd Qu.:0.008129  
##  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.012942   1st Qu.:0.01494   1st Qu.:0.007634   1st Qu.:0.015128  
##  Median :0.020475   Median :0.02592   Median :0.010905   Median :0.018740  
##  Mean   :0.025541   Mean   :0.03195   Mean   :0.011791   Mean   :0.020570  
##  3rd Qu.:0.032482   3rd Qu.:0.04237   3rd Qu.:0.014730   3rd Qu.:0.023500  
##  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.0022445    1st Qu.:13.01   1st Qu.:21.16   1st Qu.: 84.10  
##  Median :0.0032075    Median :14.96   Median :25.43   Median : 97.66  
##  Mean   :0.0038040    Mean   :16.26   Mean   :25.70   Mean   :107.18  
##  3rd Qu.:0.0045600    3rd Qu.:18.77   3rd Qu.:29.68   3rd Qu.:125.17  
##  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.0   1st Qu.:0.11650   1st Qu.:0.14690   1st Qu.:0.1145  
##  Median : 685.5   Median :0.13125   Median :0.21185   Median :0.2266  
##  Mean   : 878.9   Mean   :0.13223   Mean   :0.25420   Mean   :0.2719  
##  3rd Qu.:1073.5   3rd Qu.:0.14600   3rd Qu.:0.33930   3rd Qu.:0.3814  
##  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.06473      1st Qu.:0.2504   1st Qu.:0.07127        
##  Median :0.09984      Median :0.2821   Median :0.08005        
##  Mean   :0.11436      Mean   :0.2900   Mean   :0.08394        
##  3rd Qu.:0.16132      3rd Qu.:0.3177   3rd Qu.:0.09208        
##  Max.   :0.29100      Max.   :0.6638   Max.   :0.20750

Paso 3: Crear Red Neuronal

set.seed(123)

rn2 <- neuralnet(df2$diagnosis~., data = df2)
summary(rn2)
##                     Length Class      Mode    
## call                    3  -none-     call    
## response              564  -none-     numeric 
## covariate           16920  -none-     numeric 
## model.list              2  -none-     list    
## err.fct                 1  -none-     function
## act.fct                 1  -none-     function
## linear.output           1  -none-     logical 
## data                   31  data.frame list    
## exclude                 0  -none-     NULL    
## net.result              1  -none-     list    
## weights                 1  -none-     list    
## generalized.weights     1  -none-     list    
## startweights            1  -none-     list    
## result.matrix          36  -none-     numeric
plot(rn2, rep="best")

Paso 4: Predecir Resultados

prueba2 <- read.csv("C:/Users/luisa/Downloads/cm_prueba.csv")
prediccion <- compute(rn2, prueba2)
prediccion$net.result
##           [,1]
## [1,] 0.3723412
## [2,] 0.3723412
## [3,] 0.3723412
## [4,] 0.3723412
## [5,] 0.3723412
probabilidad <- prediccion$net.result
resultado <- ifelse(probabilidad >0.5, 1,0)
resultado
##      [,1]
## [1,]    0
## [2,]    0
## [3,]    0
## [4,]    0
## [5,]    0
LS0tDQp0aXRsZTogIlJlZGVzIE5ldXJvbmFsZXMgLSAgQ8OhbmNlciBkZSBtYW1hIg0KYXV0aG9yOiAiTHVpcyBBbmdlbCBFbGl6b25kbyBHYWxsZWdvcyBBMDExOTgxODYiDQpkYXRlOiAiMjAyNC0wMi0yMiINCm91dHB1dDogDQogaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IHRydWUNCiAgICB0b2NfZmxvYXQ6IHRydWUNCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlDQogICAgdGhlbWU6IGNlcnVsZWFuDQogICAgaGlnaGxpZ2h0OiBweWdtZW50cw0KLS0tDQoNCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQ0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFKQ0KYGBgDQoNCiFbXShDOlxVc2Vyc1xsdWlzYVxEb3dubG9hZHNcbmV1cm9uYS5naWYpDQoNCg0KIyA8c3BhbiBzdHlsZT0gImNvbG9yOiBibHVlOyI+VGVvcsOtYTwvc3Bhbj4NCg0KVW5hIFJlZCBOZXVyb25hbCBBcnRpZmljaWFsIChBTk4pIG1vZGVsYSBsYSByZWxhY2nDs24gZW50cmUgdW4gY29uanVudG8gZGUgZW50cmFkYXMgeSB1bmEgc2FsaWRhLCByZXNvbHZpZW5kbyB1biBwcm9ibGVtYSBkZSBhcHJlbmRpemFqZS4NCg0KQWxndW5vcyBlamVtcGxvcyBkZSBhcGxpY2FjacOzbiBkZSBBTk4gc29uOg0KDQoqIExhIHJlY29tZW5kYWNpw7NuIGRlIGNvbnRlbmlkbyBkZSBOZXRmbGl4Lg0KKiBFbCBmZWVkIGRlIEluc3RhZ3JhbS4NCiogRGV0ZXJtaW5hciBlbCBuw7ptZXJvIGVzY3JpdG8gYSBtYW5vLg0KDQoNCg0KIyA8c3BhbiBzdHlsZT0gImNvbG9yOiBibHVlOyI+RWplcmNpY2lvIDEuIMK/UGFzw6kgbGEgbWF0ZXJpYT8gPC9zcGFuPg0KDQoNCiMjIFBhc28gMTogSW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyw61hcw0KYGBge3IgfQ0KI2luc3RhbGwucGFja2FnZXMoIm5ldXJuYWxuZXQiKQ0KbGlicmFyeShuZXVyYWxuZXQpDQpgYGANCg0KIyMgUGFzbyAyOiBPYnRlbmVyIGRhdG9zDQpgYGB7ciB9DQpleGFtZW4gPC0gYygyMCwxMCwzMCwyMCw4MCwzMCkNCnByb3llY3RvIDwtIGMoOTAsMjAsNDAsNTAsNTAsODApDQpzdGF0dXMgPC0gYygxLDAsMCwwLDAsMSkNCg0KZGYxIDwtIGRhdGEuZnJhbWUoZXhhbWVuLCBwcm95ZWN0bywgc3RhdHVzKQ0KZGYxDQpgYGANCg0KDQojIyBQYXNvIDM6IENyZWFyIFJlZCBOZXVyb25hbA0KYGBge3IgfQ0Kc2V0LnNlZWQoMTIzKQ0Kcm4xIDwtIG5ldXJhbG5ldChzdGF0dXMgfiAuLCBkYXRhID0gZGYxKQ0Kc3VtbWFyeShybjEpDQpwbG90KHJuMSwgcmVwPSJiZXN0IikNCmBgYA0KDQoNCg0KDQojIyBQYXNvIDQ6IFByZWRlY2lyIFJlc3VsdGFkb3MNCmBgYHtyIH0NCnBydWViYV9leGFtZW4gPC0gYygzMCw0MCw4NSkNCnBydWViYV9wcm95ZWN0byA8LSBjKDg1LDUwLDQwKQ0KcHJ1ZWJhMSA8LSBkYXRhLmZyYW1lKHBydWViYV9leGFtZW4scHJ1ZWJhX3Byb3llY3RvKQ0KcHJlZGljY2lvbiA8LSBjb21wdXRlKHJuMSwgcHJ1ZWJhMSkNCnByZWRpY2Npb24kbmV0LnJlc3VsdA0KcHJvYmFiaWxpZGFkIDwtIHByZWRpY2Npb24kbmV0LnJlc3VsdA0KcmVzdWx0YWRvIDwtIGlmZWxzZShwcm9iYWJpbGlkYWQgPjAuNSwgMSwwKQ0KcmVzdWx0YWRvDQpgYGANCg0KDQojIDxzcGFuIHN0eWxlPSAiY29sb3I6IGJsdWU7Ij5FamVyY2ljaW8gMi4gQ8OhbmNlciBkZSBNYW1hIDwvc3Bhbj4NCg0KDQojIyBQYXNvIDE6IEluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxpYnJlcsOtYXMNCmBgYHtyIH0NCiNpbnN0YWxsLnBhY2thZ2VzKCJuZXVybmFsbmV0IikNCmxpYnJhcnkobmV1cmFsbmV0KQ0KYGBgDQoNCiMjIFBhc28gMjogT2J0ZW5lciBkYXRvcw0KYGBge3IgfQ0KbGlicmFyeShyZWFkcikNCmRmMiA8LSByZWFkLmNzdigiQzovVXNlcnMvbHVpc2EvRG93bmxvYWRzL2NhbmNlcl9kZV9tYW1hLmNzdiIpDQoNCg0KZGYyJGRpYWdub3NpcyA8LSBpZmVsc2UoZGYyJGRpYWdub3NpcyA9PSAiTSIsIDEsIDApDQpzdW1tYXJ5KGRmMikNCg0KYGBgDQoNCg0KIyMgUGFzbyAzOiBDcmVhciBSZWQgTmV1cm9uYWwNCmBgYHtyIH0NCnNldC5zZWVkKDEyMykNCg0Kcm4yIDwtIG5ldXJhbG5ldChkZjIkZGlhZ25vc2lzfi4sIGRhdGEgPSBkZjIpDQpzdW1tYXJ5KHJuMikNCnBsb3Qocm4yLCByZXA9ImJlc3QiKQ0KYGBgDQoNCg0KDQoNCiMjIFBhc28gNDogUHJlZGVjaXIgUmVzdWx0YWRvcw0KYGBge3IgfQ0KcHJ1ZWJhMiA8LSByZWFkLmNzdigiQzovVXNlcnMvbHVpc2EvRG93bmxvYWRzL2NtX3BydWViYS5jc3YiKQ0KcHJlZGljY2lvbiA8LSBjb21wdXRlKHJuMiwgcHJ1ZWJhMikNCnByZWRpY2Npb24kbmV0LnJlc3VsdA0KcHJvYmFiaWxpZGFkIDwtIHByZWRpY2Npb24kbmV0LnJlc3VsdA0KcmVzdWx0YWRvIDwtIGlmZWxzZShwcm9iYWJpbGlkYWQgPjAuNSwgMSwwKQ0KcmVzdWx0YWRvDQpgYGA=