Árbol de Decisión
Javier Ayala-A00823958
2022-09-08
Titanic
Librerias
library(rpart)
library(rpart.plot)Importar base de datos
bd<-read.csv("C:\\Users\\javaw\\OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey\\7mo Semestre\\Modulo 3\\titanic.csv")Entender base de datos
summary(bd)## ï..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 :1189Filtrar base de datos
titanic <- bd[,c("ï..pclass","age","sex","survived")]
titanic$survived <-as.factor(ifelse(titanic$survived==0,"Murio","Sobrevivio"))
titanic$ï..pclass <-as.factor(titanic$ï..pclass)
titanic$sex <- as.factor(titanic$sex)
str(titanic)## 'data.frame': 1310 obs. of 4 variables:
## $ ï..pclass: 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/ 3 levels "","female","male": 2 3 2 3 2 3 2 3 2 3 ...
## $ survived : Factor w/ 2 levels "Murio","Sobrevivio": 2 2 1 1 1 2 2 1 2 1 ...sum(is.na(titanic))## [1] 266titanic<-na.omit(titanic)Crear arbol de decision
arbol <- rpart(formula=survived~., data=titanic)
arbol## n= 1046
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 1046 427 Murio (0.59177820 0.40822180)
## 2) sex=male 658 135 Murio (0.79483283 0.20516717)
## 4) age>=9.5 615 110 Murio (0.82113821 0.17886179) *
## 5) age< 9.5 43 18 Sobrevivio (0.41860465 0.58139535)
## 10) ï..pclass=3 29 11 Murio (0.62068966 0.37931034) *
## 11) ï..pclass=1,2 14 0 Sobrevivio (0.00000000 1.00000000) *
## 3) sex=female 388 96 Sobrevivio (0.24742268 0.75257732)
## 6) ï..pclass=3 152 72 Murio (0.52631579 0.47368421)
## 12) age>=1.5 145 66 Murio (0.54482759 0.45517241) *
## 13) age< 1.5 7 1 Sobrevivio (0.14285714 0.85714286) *
## 7) ï..pclass=1,2 236 16 Sobrevivio (0.06779661 0.93220339) *rpart.plot(arbol)
prp(arbol,extra=7,prefix="Fraccion\n")
Cáncer de Mama
Librerias
library(rpart)
library(rpart.plot)
library(janitor)
library(ggplot2)
library(tidyverse)Importar base de datos
df<-read.csv("C:\\Users\\javaw\\OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey\\7mo Semestre\\Modulo 3\\cancer_de_mama.csv")Entender base de datos
summary(df)## ï..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.20750Crear arbol de decision
arbolcm <- rpart(formula=ï..diagnosis~., data=df)
arbolcm## 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(arbolcm)
prp(arbolcm,extra=7,prefix="Fraccion\n")
ggplot(data=df,mapping = aes(radius_worst,concave.points_worst))+geom_point(aes(color=ï..diagnosis))+theme_bw()
Conclusiones
Podemos concluir a través del análisis lo siguiente:
Titanic Quienes tenían mayor probabilidad de sobrevivir
en el Titanic eran las mujeres y niños, su probabilidad aumenta si son
de primera clase. Al observar el árbol de decisión encontramos que el
93% de las mujeres que no eran de la clase tres sobrevivieron, además
que el 100% de los niños varones menores a 9.5 años que no eran de la
clase 3 sobrevivieron también.
Cancer de mama Aquellos tumores que tuvieran un radio mayor a 17, puntos concavos mayores a 0.14, y textura mayor a 26 tienen mayor probabilidad de ser malignos. El 94% de los tumores con un radio mayor a 17 fueron malignos, el 61% de los tumores con puntos concavos mayores a 0.14 fueron malignos y el 89% de los tumores con textura mayor a 26 fueron malignos también.
LS0tDQp0aXRsZTogIsOBcmJvbCBkZSBEZWNpc2nDs24iDQphdXRob3I6ICJKYXZpZXIgQXlhbGEtQTAwODIzOTU4Ig0KZGF0ZTogJzIwMjItMDktMDgnDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiB0cnVlDQogICAgdG9jX2Zsb2F0OiB0cnVlDQogICAgY29kZV9kb3dubG9hZDogdHJ1ZQ0KLS0tDQo8Y2VudGVyPg0KPGltZyBzcmM9IkM6Ly9Vc2Vycy8vamF2YXcvL09uZURyaXZlIC0gSW5zdGl0dXRvIFRlY25vbG9naWNvIHkgZGUgRXN0dWRpb3MgU3VwZXJpb3JlcyBkZSBNb250ZXJyZXkvL0xvZ28gSVRFU00gc21hbGwucG5nIj4NCjwvY2VudGVyPiAgDQoNCmBgYHtjc3MsIGVjaG89RkFMU0V9DQpoMSwgaDQgew0KICB0ZXh0LWFsaWduOiBjZW50ZXI7DQp9DQoNCmgxLCBoMiwgaDMgew0KICBjb2xvcjogIzA2MUY2QjsNCn0NCmBgYA0KDQojIFRpdGFuaWMgIA0KDQoNCg0KIyMjIExpYnJlcmlhcyAgDQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KbGlicmFyeShycGFydCkNCmxpYnJhcnkocnBhcnQucGxvdCkNCmBgYA0KDQoNCg0KIyMjIEltcG9ydGFyIGJhc2UgZGUgZGF0b3MgIA0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmJkPC1yZWFkLmNzdigiQzpcXFVzZXJzXFxqYXZhd1xcT25lRHJpdmUgLSBJbnN0aXR1dG8gVGVjbm9sb2dpY28geSBkZSBFc3R1ZGlvcyBTdXBlcmlvcmVzIGRlIE1vbnRlcnJleVxcN21vIFNlbWVzdHJlXFxNb2R1bG8gM1xcdGl0YW5pYy5jc3YiKQ0KYGBgDQoNCg0KIyMjIEVudGVuZGVyIGJhc2UgZGUgZGF0b3MNCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQpzdW1tYXJ5KGJkKQ0KYGBgDQoNCg0KIyMjIEZpbHRyYXIgYmFzZSBkZSBkYXRvcyAgDQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KdGl0YW5pYyA8LSBiZFssYygiw68uLnBjbGFzcyIsImFnZSIsInNleCIsInN1cnZpdmVkIildDQp0aXRhbmljJHN1cnZpdmVkIDwtYXMuZmFjdG9yKGlmZWxzZSh0aXRhbmljJHN1cnZpdmVkPT0wLCJNdXJpbyIsIlNvYnJldml2aW8iKSkNCnRpdGFuaWMkw68uLnBjbGFzcyA8LWFzLmZhY3Rvcih0aXRhbmljJMOvLi5wY2xhc3MpDQp0aXRhbmljJHNleCA8LSBhcy5mYWN0b3IodGl0YW5pYyRzZXgpDQpzdHIodGl0YW5pYykNCg0Kc3VtKGlzLm5hKHRpdGFuaWMpKQ0KDQp0aXRhbmljPC1uYS5vbWl0KHRpdGFuaWMpDQpgYGANCg0KDQojIyMgQ3JlYXIgYXJib2wgZGUgZGVjaXNpb24gIA0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmFyYm9sIDwtIHJwYXJ0KGZvcm11bGE9c3Vydml2ZWR+LiwgZGF0YT10aXRhbmljKQ0KYXJib2wNCnJwYXJ0LnBsb3QoYXJib2wpDQpwcnAoYXJib2wsZXh0cmE9NyxwcmVmaXg9IkZyYWNjaW9uXG4iKQ0KYGBgDQoNCg0KIyBDw6FuY2VyIGRlIE1hbWEgIA0KDQoNCiMjIyBMaWJyZXJpYXMgIA0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmxpYnJhcnkocnBhcnQpDQpsaWJyYXJ5KHJwYXJ0LnBsb3QpDQpsaWJyYXJ5KGphbml0b3IpDQpsaWJyYXJ5KGdncGxvdDIpDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmBgYA0KIA0KIyMjIEltcG9ydGFyIGJhc2UgZGUgZGF0b3MgIA0KYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0NCmRmPC1yZWFkLmNzdigiQzpcXFVzZXJzXFxqYXZhd1xcT25lRHJpdmUgLSBJbnN0aXR1dG8gVGVjbm9sb2dpY28geSBkZSBFc3R1ZGlvcyBTdXBlcmlvcmVzIGRlIE1vbnRlcnJleVxcN21vIFNlbWVzdHJlXFxNb2R1bG8gM1xcY2FuY2VyX2RlX21hbWEuY3N2IikNCmBgYA0KDQojIyMgRW50ZW5kZXIgYmFzZSBkZSBkYXRvcyAgDQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0Kc3VtbWFyeShkZikNCmBgYA0KDQojIyMgQ3JlYXIgYXJib2wgZGUgZGVjaXNpb24gIA0KYGBge3J9DQphcmJvbGNtIDwtIHJwYXJ0KGZvcm11bGE9w68uLmRpYWdub3Npc34uLCBkYXRhPWRmKQ0KYXJib2xjbQ0KcnBhcnQucGxvdChhcmJvbGNtKQ0KcHJwKGFyYm9sY20sZXh0cmE9NyxwcmVmaXg9IkZyYWNjaW9uXG4iKQ0KDQpgYGANCg0KDQpgYGB7cn0NCmdncGxvdChkYXRhPWRmLG1hcHBpbmcgPSBhZXMocmFkaXVzX3dvcnN0LGNvbmNhdmUucG9pbnRzX3dvcnN0KSkrZ2VvbV9wb2ludChhZXMoY29sb3I9w68uLmRpYWdub3NpcykpK3RoZW1lX2J3KCkNCmBgYA0KDQojIENvbmNsdXNpb25lcyAgDQpQb2RlbW9zIGNvbmNsdWlyIGEgdHJhdsOpcyBkZWwgYW7DoWxpc2lzIGxvIHNpZ3VpZW50ZTogIA0KKipUaXRhbmljKiogDQpRdWllbmVzIHRlbsOtYW4gbWF5b3IgcHJvYmFiaWxpZGFkIGRlIHNvYnJldml2aXIgZW4gZWwgVGl0YW5pYyBlcmFuIGxhcyBtdWplcmVzIHkgbmnDsW9zLCBzdSBwcm9iYWJpbGlkYWQgYXVtZW50YSBzaSBzb24gZGUgcHJpbWVyYSBjbGFzZS4gQWwgb2JzZXJ2YXIgZWwgw6FyYm9sIGRlIGRlY2lzacOzbiBlbmNvbnRyYW1vcyBxdWUgZWwgOTMlIGRlIGxhcyBtdWplcmVzIHF1ZSBubyBlcmFuIGRlIGxhIGNsYXNlIHRyZXMgc29icmV2aXZpZXJvbiwgYWRlbcOhcyBxdWUgZWwgMTAwJSBkZSBsb3MgbmnDsW9zIHZhcm9uZXMgbWVub3JlcyBhIDkuNSBhw7FvcyBxdWUgbm8gZXJhbiBkZSBsYSBjbGFzZSAzIHNvYnJldml2aWVyb24gdGFtYmnDqW4uIA0KDQoqKkNhbmNlciBkZSBtYW1hKioNCkFxdWVsbG9zIHR1bW9yZXMgcXVlIHR1dmllcmFuIHVuIHJhZGlvIG1heW9yIGEgMTcsIHB1bnRvcyBjb25jYXZvcyBtYXlvcmVzIGEgMC4xNCwgeSB0ZXh0dXJhIG1heW9yIGEgMjYgdGllbmVuIG1heW9yIHByb2JhYmlsaWRhZCBkZSBzZXIgbWFsaWdub3MuIEVsIDk0JSBkZSBsb3MgdHVtb3JlcyBjb24gdW4gcmFkaW8gbWF5b3IgYSAxNyBmdWVyb24gbWFsaWdub3MsIGVsIDYxJSBkZSBsb3MgdHVtb3JlcyBjb24gcHVudG9zIGNvbmNhdm9zIG1heW9yZXMgYSAwLjE0IGZ1ZXJvbiBtYWxpZ25vcyB5IGVsIDg5JSBkZSBsb3MgdHVtb3JlcyBjb24gdGV4dHVyYSBtYXlvciBhIDI2IGZ1ZXJvbiBtYWxpZ25vcyB0YW1iacOpbi4=