Titanic

1. Importar

#file.choose()
titanic <- read.csv("C:/Users/Admin/OneDrive/Documentos/TEC/Curso Actual/Materia/R/Ejercicios/titanic.csv")

2. Enteder

summary(titanic)
##      pclass         survived         name               sex           
##  Min.   :1.000   Min.   :0.000   Length:1310        Length:1310       
##  1st Qu.:2.000   1st Qu.:0.000   Class :character   Class :character  
##  Median :3.000   Median :0.000   Mode  :character   Mode  :character  
##  Mean   :2.295   Mean   :0.382                                        
##  3rd Qu.:3.000   3rd Qu.:1.000                                        
##  Max.   :3.000   Max.   :1.000                                        
##  NA's   :1       NA's   :1                                            
##       age              sibsp            parch          ticket         
##  Min.   : 0.1667   Min.   :0.0000   Min.   :0.000   Length:1310       
##  1st Qu.:21.0000   1st Qu.:0.0000   1st Qu.:0.000   Class :character  
##  Median :28.0000   Median :0.0000   Median :0.000   Mode  :character  
##  Mean   :29.8811   Mean   :0.4989   Mean   :0.385                     
##  3rd Qu.:39.0000   3rd Qu.:1.0000   3rd Qu.:0.000                     
##  Max.   :80.0000   Max.   :8.0000   Max.   :9.000                     
##  NA's   :264       NA's   :1        NA's   :1                         
##       fare            cabin             embarked             boat          
##  Min.   :  0.000   Length:1310        Length:1310        Length:1310       
##  1st Qu.:  7.896   Class :character   Class :character   Class :character  
##  Median : 14.454   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 33.295                                                           
##  3rd Qu.: 31.275                                                           
##  Max.   :512.329                                                           
##  NA's   :2                                                                 
##       body        home.dest        
##  Min.   :  1.0   Length:1310       
##  1st Qu.: 72.0   Class :character  
##  Median :155.0   Mode  :character  
##  Mean   :160.8                     
##  3rd Qu.:256.0                     
##  Max.   :328.0                     
##  NA's   :1189
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
#count(titanic, name, sort = TRUE)
#count(titanic, sex, sort = TRUE)
#count(titanic, ticket, sort = TRUE)
#count(titanic, cabin, sort = TRUE)
#count(titanic, embarked, sort = TRUE)
#count(titanic, boat, sort = TRUE)
#count(titanic, home.dest, sort = TRUE)

Observaciones: 1. Existen NA’s. 2. Algunos nombres se repiten.

3. Limpiar base de datos

# Cambiar nombre a la variable pclass
colnames(titanic)[1] <- "class"

# Extraer las variables de interés
ttnc <- titanic[,c("class","age","sex", "survived")]

# ¿Cuántos NA tengo por variable?
sapply(ttnc, function(x) sum(is.na(x)))
##    class      age      sex survived 
##        1      264        0        1
# Eliminar NA
ttnc <- na.omit(ttnc)
#str(ttnc)

# Convertir las variables categóricas en factores
ttnc$class <- as.factor(ttnc$class)
ttnc$sex <- as.factor(ttnc$sex)
ttnc$survived <- as.factor(ttnc$survived)

str(ttnc)
## 'data.frame':    1046 obs. of  4 variables:
##  $ class   : Factor w/ 3 levels "1","2","3": 1 1 1 1 1 1 1 1 1 1 ...
##  $ age     : num  29 0.917 2 30 25 ...
##  $ sex     : Factor w/ 2 levels "female","male": 1 2 1 2 1 2 1 2 1 2 ...
##  $ survived: Factor w/ 2 levels "0","1": 2 2 1 1 1 2 2 1 2 1 ...
##  - attr(*, "na.action")= 'omit' Named int [1:264] 16 38 41 47 60 70 71 75 81 107 ...
##   ..- attr(*, "names")= chr [1:264] "16" "38" "41" "47" ...

4. Crear árbol de decisión

library(rpart)
library(rpart.plot)

arbol <- rpart(formula = survived ~ ., data=ttnc)
arbol
## n= 1046 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##  1) root 1046 427 0 (0.59177820 0.40822180)  
##    2) sex=male 658 135 0 (0.79483283 0.20516717)  
##      4) age>=9.5 615 110 0 (0.82113821 0.17886179) *
##      5) age< 9.5 43  18 1 (0.41860465 0.58139535)  
##       10) class=3 29  11 0 (0.62068966 0.37931034) *
##       11) class=1,2 14   0 1 (0.00000000 1.00000000) *
##    3) sex=female 388  96 1 (0.24742268 0.75257732)  
##      6) class=3 152  72 0 (0.52631579 0.47368421)  
##       12) age>=1.5 145  66 0 (0.54482759 0.45517241) *
##       13) age< 1.5 7   1 1 (0.14285714 0.85714286) *
##      7) class=1,2 236  16 1 (0.06779661 0.93220339) *
rpart.plot(arbol)

Cáncer de mama

1. Importar la base de datos

#file.choose()
cancer_de_mama <- read.csv("C:/Users/Admin/OneDrive/Documentos/TEC/Curso Actual/Materia/R/Ejercicios/cancer_de_mama.csv")

2. Entender la base de datos

summary(cancer_de_mama)
##   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
#install.packages("dplyr")
library(dplyr)

count(cancer_de_mama, diagnosis, sort=TRUE)
##   diagnosis   n
## 1         B 357
## 2         M 212

Observaciones: 1. No es necesaria hacer limpieza de base de datos.

3. Crear el arbol de decisión

#install.packages("rpart")
library(rpart)

#install.packages("rpart.plot")
library(rpart.plot)

arbol <- rpart(formula = diagnosis ~ ., data= cancer_de_mama)
arbol
## n= 569 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##  1) root 569 212 B (0.62741652 0.37258348)  
##    2) radius_worst< 16.795 379  33 B (0.91292876 0.08707124)  
##      4) concave.points_worst< 0.1358 333   5 B (0.98498498 0.01501502) *
##      5) concave.points_worst>=0.1358 46  18 M (0.39130435 0.60869565)  
##       10) texture_worst< 25.67 19   4 B (0.78947368 0.21052632) *
##       11) texture_worst>=25.67 27   3 M (0.11111111 0.88888889) *
##    3) radius_worst>=16.795 190  11 M (0.05789474 0.94210526) *
rpart.plot(arbol)

prp(arbol, extra=7)

LS0tDQp0aXRsZTogIkFjdGl2aWRhZCA0LjIiDQphdXRob3I6ICJDYXJsb3MgU2VkYXMiDQpkYXRlOiAiMjAyMy0wOS0xOSINCm91dHB1dDogDQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2FkOiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KICAgIHRoZW1lOiAicmVhZGFibGUiDQogICAgaGlnaGxpZ2h0OiAicHlnbWVudHMiDQotLS0NCg0KPGNlbnRlcj4NCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+VGl0YW5pYzwvc3Bhbj4NCg0KIVtdKEM6L1VzZXJzL0FkbWluL09uZURyaXZlL0RvY3VtZW50b3MvVEVDL0N1cnNvIEFjdHVhbC9NYXRlcmlhL1IvRWplcmNpY2lvcy90aXRhbmljLmdpZikNCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+MS4gSW1wb3J0YXI8L3NwYW4+DQpgYGB7cn0NCiNmaWxlLmNob29zZSgpDQp0aXRhbmljIDwtIHJlYWQuY3N2KCJDOi9Vc2Vycy9BZG1pbi9PbmVEcml2ZS9Eb2N1bWVudG9zL1RFQy9DdXJzbyBBY3R1YWwvTWF0ZXJpYS9SL0VqZXJjaWNpb3MvdGl0YW5pYy5jc3YiKQ0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiPjIuIEVudGVkZXI8L3NwYW4+DQpgYGB7cn0NCnN1bW1hcnkodGl0YW5pYykNCmxpYnJhcnkoZHBseXIpDQojY291bnQodGl0YW5pYywgbmFtZSwgc29ydCA9IFRSVUUpDQojY291bnQodGl0YW5pYywgc2V4LCBzb3J0ID0gVFJVRSkNCiNjb3VudCh0aXRhbmljLCB0aWNrZXQsIHNvcnQgPSBUUlVFKQ0KI2NvdW50KHRpdGFuaWMsIGNhYmluLCBzb3J0ID0gVFJVRSkNCiNjb3VudCh0aXRhbmljLCBlbWJhcmtlZCwgc29ydCA9IFRSVUUpDQojY291bnQodGl0YW5pYywgYm9hdCwgc29ydCA9IFRSVUUpDQojY291bnQodGl0YW5pYywgaG9tZS5kZXN0LCBzb3J0ID0gVFJVRSkNCg0KYGBgDQoNCk9ic2VydmFjaW9uZXM6DQoxLiBFeGlzdGVuIE5BJ3MuDQoyLiBBbGd1bm9zIG5vbWJyZXMgc2UgcmVwaXRlbi4NCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+My4gTGltcGlhciBiYXNlIGRlIGRhdG9zPC9zcGFuPg0KYGBge3J9DQojIENhbWJpYXIgbm9tYnJlIGEgbGEgdmFyaWFibGUgcGNsYXNzDQpjb2xuYW1lcyh0aXRhbmljKVsxXSA8LSAiY2xhc3MiDQoNCiMgRXh0cmFlciBsYXMgdmFyaWFibGVzIGRlIGludGVyw6lzDQp0dG5jIDwtIHRpdGFuaWNbLGMoImNsYXNzIiwiYWdlIiwic2V4IiwgInN1cnZpdmVkIildDQoNCiMgwr9DdcOhbnRvcyBOQSB0ZW5nbyBwb3IgdmFyaWFibGU/DQpzYXBwbHkodHRuYywgZnVuY3Rpb24oeCkgc3VtKGlzLm5hKHgpKSkNCg0KIyBFbGltaW5hciBOQQ0KdHRuYyA8LSBuYS5vbWl0KHR0bmMpDQojc3RyKHR0bmMpDQoNCiMgQ29udmVydGlyIGxhcyB2YXJpYWJsZXMgY2F0ZWfDs3JpY2FzIGVuIGZhY3RvcmVzDQp0dG5jJGNsYXNzIDwtIGFzLmZhY3Rvcih0dG5jJGNsYXNzKQ0KdHRuYyRzZXggPC0gYXMuZmFjdG9yKHR0bmMkc2V4KQ0KdHRuYyRzdXJ2aXZlZCA8LSBhcy5mYWN0b3IodHRuYyRzdXJ2aXZlZCkNCg0Kc3RyKHR0bmMpDQpgYGANCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+NC4gQ3JlYXIgw6FyYm9sIGRlIGRlY2lzacOzbjwvc3Bhbj4NCmBgYHtyfQ0KbGlicmFyeShycGFydCkNCmxpYnJhcnkocnBhcnQucGxvdCkNCg0KYXJib2wgPC0gcnBhcnQoZm9ybXVsYSA9IHN1cnZpdmVkIH4gLiwgZGF0YT10dG5jKQ0KYXJib2wNCnJwYXJ0LnBsb3QoYXJib2wpDQpgYGANCg0KPGNlbnRlcj4NCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBwaW5rOyI+Q8OhbmNlciBkZSBtYW1hPC9zcGFuPg0KDQo8Y2VudGVyPg0KIVtdKEM6L1VzZXJzL0FkbWluL09uZURyaXZlL0RvY3VtZW50b3MvVEVDL0N1cnNvIEFjdHVhbC9NYXRlcmlhL1IvRWplcmNpY2lvcy9jbS5naWYpDQoNCjxjZW50ZXI+DQojIyA8c3BhbiBzdHlsZT0iY29sb3I6IHBpbms7Ij4xLiBJbXBvcnRhciBsYSBiYXNlIGRlIGRhdG9zPC9zcGFuPg0KYGBge3J9DQojZmlsZS5jaG9vc2UoKQ0KY2FuY2VyX2RlX21hbWEgPC0gcmVhZC5jc3YoIkM6L1VzZXJzL0FkbWluL09uZURyaXZlL0RvY3VtZW50b3MvVEVDL0N1cnNvIEFjdHVhbC9NYXRlcmlhL1IvRWplcmNpY2lvcy9jYW5jZXJfZGVfbWFtYS5jc3YiKQ0KDQpgYGANCg0KPGNlbnRlcj4NCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogcGluazsiPjIuIEVudGVuZGVyIGxhIGJhc2UgZGUgZGF0b3M8L3NwYW4+DQpgYGB7cn0NCnN1bW1hcnkoY2FuY2VyX2RlX21hbWEpDQoNCiNpbnN0YWxsLnBhY2thZ2VzKCJkcGx5ciIpDQpsaWJyYXJ5KGRwbHlyKQ0KDQpjb3VudChjYW5jZXJfZGVfbWFtYSwgZGlhZ25vc2lzLCBzb3J0PVRSVUUpDQoNCmBgYA0KT2JzZXJ2YWNpb25lczoNCjEuIE5vIGVzIG5lY2VzYXJpYSBoYWNlciBsaW1waWV6YSBkZSBiYXNlIGRlIGRhdG9zLiANCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBwaW5rOyI+My4gQ3JlYXIgZWwgYXJib2wgZGUgZGVjaXNpw7NuPC9zcGFuPg0KYGBge3IsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQojaW5zdGFsbC5wYWNrYWdlcygicnBhcnQiKQ0KbGlicmFyeShycGFydCkNCg0KI2luc3RhbGwucGFja2FnZXMoInJwYXJ0LnBsb3QiKQ0KbGlicmFyeShycGFydC5wbG90KQ0KDQphcmJvbCA8LSBycGFydChmb3JtdWxhID0gZGlhZ25vc2lzIH4gLiwgZGF0YT0gY2FuY2VyX2RlX21hbWEpDQphcmJvbA0KcnBhcnQucGxvdChhcmJvbCkNCg0KcHJwKGFyYm9sLCBleHRyYT03KQ0KICAgICAgICAgIA0KYGBgDQo=