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?

1. Instalar paquetes y llamar a las librerías

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

2. Obtener datos

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

3. Generar la red neuronal

set.seed(123)
rn1 <- neuralnet(estatus~., data=df1)
plot(rn1, rep="best")

4. Predecir Resutados

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

1. Instalar paquetes y llamar a las librerías

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

2. Obtener datos

#file.choose()
df2 <- read.csv("C:\\Users\\Diego Pérez\\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.700   1st Qu.:16.17   1st Qu.: 75.17  
##  Median :0.0000   Median :13.370   Median :18.84   Median : 86.24  
##  Mean   :0.3726   Mean   :14.127   Mean   :19.29   Mean   : 91.97  
##  3rd Qu.:1.0000   3rd Qu.:15.780   3rd Qu.:21.80   3rd Qu.:104.10  
##  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.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

3. Generar la red neuronal

set.seed(123)
rn2 <- neuralnet(df2$diagnosis~., data=df2)
summary(rn2)
##                     Length Class      Mode    
## call                    3  -none-     call    
## response              569  -none-     numeric 
## covariate           17070  -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")

4. Predecir Resutados

prueba_cancer<- df2[18:22, ]
prueba_cancer$diagnosis<- NULL
prueba_cancer
##    radius_mean texture_mean perimeter_mean area_mean smoothness_mean
## 18      16.130        20.68         108.10     798.8         0.11700
## 19      19.810        22.15         130.00    1260.0         0.09831
## 20      13.540        14.36          87.46     566.3         0.09779
## 21      13.080        15.71          85.63     520.0         0.10750
## 22       9.504        12.44          60.34     273.9         0.10240
##    compactness_mean concavity_mean concave.points_mean symmetry_mean
## 18          0.20220        0.17220             0.10280        0.2164
## 19          0.10270        0.14790             0.09498        0.1582
## 20          0.08129        0.06664             0.04781        0.1885
## 21          0.12700        0.04568             0.03110        0.1967
## 22          0.06492        0.02956             0.02076        0.1815
##    fractal_dimension_mean radius_se texture_se perimeter_se area_se
## 18                0.07356    0.5692     1.0730        3.854   54.18
## 19                0.05395    0.7582     1.0170        5.865  112.40
## 20                0.05766    0.2699     0.7886        2.058   23.56
## 21                0.06811    0.1852     0.7477        1.383   14.67
## 22                0.06905    0.2773     0.9768        1.909   15.70
##    smoothness_se compactness_se concavity_se concave.points_se symmetry_se
## 18      0.007026        0.02501      0.03188           0.01297     0.01689
## 19      0.006494        0.01893      0.03391           0.01521     0.01356
## 20      0.008462        0.01460      0.02387           0.01315     0.01980
## 21      0.004097        0.01898      0.01698           0.00649     0.01678
## 22      0.009606        0.01432      0.01985           0.01421     0.02027
##    fractal_dimension_se radius_worst texture_worst perimeter_worst area_worst
## 18             0.004142        20.96         31.48          136.80     1315.0
## 19             0.001997        27.32         30.88          186.80     2398.0
## 20             0.002300        15.11         19.26           99.70      711.2
## 21             0.002425        14.50         20.49           96.09      630.5
## 22             0.002968        10.23         15.66           65.13      314.9
##    smoothness_worst compactness_worst concavity_worst concave.points_worst
## 18           0.1789            0.4233         0.47840              0.20730
## 19           0.1512            0.3150         0.53720              0.23880
## 20           0.1440            0.1773         0.23900              0.12880
## 21           0.1312            0.2776         0.18900              0.07283
## 22           0.1324            0.1148         0.08867              0.06227
##    symmetry_worst fractal_dimension_worst
## 18         0.3706                 0.11420
## 19         0.2768                 0.07615
## 20         0.2977                 0.07259
## 21         0.3184                 0.08183
## 22         0.2450                 0.07773
prediccion2<- compute(rn2, prueba_cancer)
prediccion2$net.result
##         [,1]
## 18 0.3725802
## 19 0.3725802
## 20 0.3725802
## 21 0.3725802
## 22 0.3725802
probabilidad2<- prediccion2$net.result
probabilidad2
##         [,1]
## 18 0.3725802
## 19 0.3725802
## 20 0.3725802
## 21 0.3725802
## 22 0.3725802
resultado2<- ifelse(probabilidad2>0.5,1,0)
resultado2
##    [,1]
## 18    0
## 19    0
## 20    0
## 21    0
## 22    0
LS0tDQp0aXRsZTogIlJlZGVzIE5ldXJvbmFsZXMiDQphdXRob3I6ICJEaWVnbyBQZXJleiINCmRhdGU6ICIyLzIyLzIwMjQiDQpvdXRwdXQ6IA0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogdHJ1ZQ0KICAgIHRvY19mbG9hdDogdHJ1ZQ0KICAgIGNvZGVfZG93bmxvYWQ6IHRydWUgDQotLS0NCiFbXShDOlxcVXNlcnNcXERpZWdvIFDDqXJlelxcRG93bmxvYWRzXFxkZXNjYXJnYSAoMSkuanBlZykNCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiID5UZW9yw61hPC9zcGFuPg0KDQpVbmEgcmVkIE5ldXJvbmFsIEFydGlmaWNpYWwgKEFOTikgbW9kZWxhIGxhIHJlbGFjacOzbiBlbnRyZSB1biBjb25qdW50byBkZSANCmVudHJhZGFzIHkgdW5hIHNhbGlkYSwgcmVzb2x2aWVuZG8gdW4gcHJvYmxlbWEgZGUgYXByZW5kaXphamUuICANCg0KQWxndW5vcyBlamVtcGxvcyBkZSBhcGxpY2FjacOzbiBkZSBBTk4gc29uOiAgDQoNCiogTGEgcmVjb21lbmRhY2nDs24gZGUgY29udGVuaWRvIGRlIE5ldGZsaXguICANCiogRWwgZmVlZCBkZSBJbnN0YWdyYW0uICANCiogRGV0ZXJtaW5hciBlbCBuw7ptZXJvIGVzY3JpdG8gYSBtYW5vLiAgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyIgPkVqZXJjaWNpbyAxIMK/UGFzw6kgbGEgbWF0ZXJpYT88L3NwYW4+DQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiID4xLiBJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBhIGxhcyBsaWJyZXLDrWFzPC9zcGFuPg0KYGBge3J9DQojaW5zdGFsbC5wYWNrYWdlcygibmV1cmFsbmV0IikNCmxpYnJhcnkobmV1cmFsbmV0KQ0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiID4yLiBPYnRlbmVyIGRhdG9zPC9zcGFuPg0KYGBge3J9DQpleGFtZW4gPC0gYygyMCwxMCwzMCwyMCw4MCwzMCkNCnByb3llY3RvIDwtIGMoOTAsMjAsNDAsNTAsNTAsODApDQplc3RhdHVzIDwtIGMoMSwwLDAsMCwwLDEpDQpkZjE8LSBkYXRhLmZyYW1lKGV4YW1lbiwgcHJveWVjdG8sIGVzdGF0dXMpDQpgYGANCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyIgPjMuIEdlbmVyYXIgbGEgcmVkIG5ldXJvbmFsPC9zcGFuPg0KYGBge3J9DQpzZXQuc2VlZCgxMjMpDQpybjEgPC0gbmV1cmFsbmV0KGVzdGF0dXN+LiwgZGF0YT1kZjEpDQpwbG90KHJuMSwgcmVwPSJiZXN0IikNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7IiA+NC4gUHJlZGVjaXIgUmVzdXRhZG9zPC9zcGFuPg0KYGBge3J9DQpwcnVlYmFfZXhhbWVuIDwtIGMoMzAsNDAsODUpDQpwcnVlYmFfcHJveWVjdG88LSBjKDg1LDUwLDQwKQ0KcHJ1ZWJhMSA8LSBkYXRhLmZyYW1lKHBydWViYV9leGFtZW4scHJ1ZWJhX3Byb3llY3RvKQ0KcHJlZGljY2lvbiA8LSBjb21wdXRlKHJuMSxwcnVlYmExKQ0KcHJlZGljY2lvbiRuZXQucmVzdWx0DQpwcm9iYWJpbGlkYWQgPC0gcHJlZGljY2lvbiRuZXQucmVzdWx0DQpyZXN1bHRhZG88LWlmZWxzZShwcm9iYWJpbGlkYWQ+MC41LDEsMCkNCnJlc3VsdGFkbw0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyIgPkVqZXJjaWNpbyAyIEPDoW5jZXIgZGUgbWFtYTwvc3Bhbj4NCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyIgPjEuIEluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGEgbGFzIGxpYnJlcsOtYXM8L3NwYW4+DQpgYGB7cn0NCiNpbnN0YWxsLnBhY2thZ2VzKCJuZXVyYWxuZXQiKQ0KbGlicmFyeShuZXVyYWxuZXQpDQpsaWJyYXJ5KHJlYWRyKQ0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiID4yLiBPYnRlbmVyIGRhdG9zPC9zcGFuPg0KYGBge3J9DQojZmlsZS5jaG9vc2UoKQ0KZGYyIDwtIHJlYWQuY3N2KCJDOlxcVXNlcnNcXERpZWdvIFDDqXJlelxcRG93bmxvYWRzXFxjYW5jZXJfZGVfbWFtYS5jc3YiKQ0KZGYyJGRpYWdub3NpcyA8LSBpZmVsc2UoZGYyJGRpYWdub3Npcz09Ik0iLDEsMCkNCnN1bW1hcnkoZGYyKQ0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiID4zLiBHZW5lcmFyIGxhIHJlZCBuZXVyb25hbDwvc3Bhbj4NCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKQ0Kcm4yIDwtIG5ldXJhbG5ldChkZjIkZGlhZ25vc2lzfi4sIGRhdGE9ZGYyKQ0Kc3VtbWFyeShybjIpDQpgYGANCmBgYHtyfQ0KcGxvdChybjIsIHJlcCA9ICJiZXN0IikNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiID40LiBQcmVkZWNpciBSZXN1dGFkb3M8L3NwYW4+DQpgYGB7cn0NCnBydWViYV9jYW5jZXI8LSBkZjJbMTg6MjIsIF0NCnBydWViYV9jYW5jZXIkZGlhZ25vc2lzPC0gTlVMTA0KcHJ1ZWJhX2NhbmNlcg0KDQpwcmVkaWNjaW9uMjwtIGNvbXB1dGUocm4yLCBwcnVlYmFfY2FuY2VyKQ0KcHJlZGljY2lvbjIkbmV0LnJlc3VsdA0KcHJvYmFiaWxpZGFkMjwtIHByZWRpY2Npb24yJG5ldC5yZXN1bHQNCnByb2JhYmlsaWRhZDINCnJlc3VsdGFkbzI8LSBpZmVsc2UocHJvYmFiaWxpZGFkMj4wLjUsMSwwKQ0KcmVzdWx0YWRvMg0KYGBgDQo=