Instalar librerías y llamar librerías

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

Importar la base de datos

titanic <- read.csv("C:\\Users\\Adrián\\Downloads\\titanic.csv")

Entender la base de datos

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
str(titanic)
## 'data.frame':    1310 obs. of  14 variables:
##  $ pclass   : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ survived : int  1 1 0 0 0 1 1 0 1 0 ...
##  $ name     : chr  "Allen, Miss. Elisabeth Walton" "Allison, Master. Hudson Trevor" "Allison, Miss. Helen Loraine" "Allison, Mr. Hudson Joshua Creighton" ...
##  $ sex      : chr  "female" "male" "female" "male" ...
##  $ age      : num  29 0.917 2 30 25 ...
##  $ sibsp    : int  0 1 1 1 1 0 1 0 2 0 ...
##  $ parch    : int  0 2 2 2 2 0 0 0 0 0 ...
##  $ ticket   : chr  "24160" "113781" "113781" "113781" ...
##  $ fare     : num  211 152 152 152 152 ...
##  $ cabin    : chr  "B5" "C22 C26" "C22 C26" "C22 C26" ...
##  $ embarked : chr  "S" "S" "S" "S" ...
##  $ boat     : chr  "2" "11" "" "" ...
##  $ body     : int  NA NA NA 135 NA NA NA NA NA 22 ...
##  $ home.dest: chr  "St Louis, MO" "Montreal, PQ / Chesterville, ON" "Montreal, PQ / Chesterville, ON" "Montreal, PQ / Chesterville, ON" ...
head(titanic)
##   pclass survived                                            name    sex
## 1      1        1                   Allen, Miss. Elisabeth Walton female
## 2      1        1                  Allison, Master. Hudson Trevor   male
## 3      1        0                    Allison, Miss. Helen Loraine female
## 4      1        0            Allison, Mr. Hudson Joshua Creighton   male
## 5      1        0 Allison, Mrs. Hudson J C (Bessie Waldo Daniels) female
## 6      1        1                             Anderson, Mr. Harry   male
##       age sibsp parch ticket     fare   cabin embarked boat body
## 1 29.0000     0     0  24160 211.3375      B5        S    2   NA
## 2  0.9167     1     2 113781 151.5500 C22 C26        S   11   NA
## 3  2.0000     1     2 113781 151.5500 C22 C26        S        NA
## 4 30.0000     1     2 113781 151.5500 C22 C26        S       135
## 5 25.0000     1     2 113781 151.5500 C22 C26        S        NA
## 6 48.0000     0     0  19952  26.5500     E12        S    3   NA
##                         home.dest
## 1                    St Louis, MO
## 2 Montreal, PQ / Chesterville, ON
## 3 Montreal, PQ / Chesterville, ON
## 4 Montreal, PQ / Chesterville, ON
## 5 Montreal, PQ / Chesterville, ON
## 6                    New York, NY

Crear árbol de decisión

titanic <- titanic[,c("pclass","age","sex","survived")]
titanic$survived <- as.factor(titanic$survived)
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 "0","1": 2 2 1 1 1 2 2 1 2 1 ...
arbol_titanic <- rpart(survived~., data=titanic)
rpart.plot(arbol_titanic)

prp(arbol_titanic, extra=7, prefix="fracción\n")

Conclusiones (Titanic)

En conclusión, las más altas probabilidad de sobrevivir en el naufragio del Titanic son:

  • 100%: Si eres niño varón menor de 9.5 años de 1°o 2° clase.
  • 73%: Si eres mujer.

Y, por el contrario las más bajas probabilidades de sobrevivir son:

  • 17%: Si eres hombre mayor a 9.5 años.
  • 38%: Si eres niño varón menor a 9.5 años de 3° clase.

Cáncer de Mama

Importar base de datos

df <- read.csv("C:\\Users\\Adrián\\Downloads\\cancer_de_mama.csv")
df$diagnosis <- as.factor(df$diagnosis)

Crear árbol de decisión

arbol_df <- rpart(diagnosis~., data=df)
rpart.plot(arbol_df)

prp(arbol_df, extra=7, prefix="fracción\n")

Conclusiones (Cáncer de Mama)

De acuerdo con los resultados del árbol de decisión, un tumor tiene una mayor probabilidad de ser cancerigeno bajo las siguientes circunstancias:

  • 94%: El radio del tumor es mayor a 17
  • 89% El radio del tumor es menor a 17 pero la textura mayor a 26

Por el contrario la mayor probabilidad para que el tumor sea benigno es bajo las siguientes circunstancias:

  • 21%: Radio menor a 17, Puntos concavos mayor a 0.14, con Textura menor a 26.
LS0tDQp0aXRsZTogIlRpdGFuaWMgJiBDw6FuY2VyIGRlIE1hbWEiDQphdXRob3I6ICJMdWlzIETDoXZpbGEgLSBBMDEyODU1MjEiDQpkYXRlOiAiMjAyNS0wOC0yMCINCm91dHB1dDoNCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQogICAgdGhlbWU6IGNvc21vDQotLS0NCg0KIVtdKGh0dHBzOi8vd3d3LndvcmxkaGlzdG9yeS5vcmcvaW1nL3IvcC8xNTAweDE1MDAvMTQwNDcucG5nKSAgICAgIA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IEluc3RhbGFyIGxpYnJlcsOtYXMgeSBsbGFtYXIgbGlicmVyw61hcyA8L3NwYW4+ICAgICAgICANCmBgYHtyIHdhcm5pbmc9RkFMU0V9DQojIGluc3RhbGwucGFja2FnZXMoInJwYXJ0IikNCmxpYnJhcnkocnBhcnQpDQojIGluc3RhbGwucGFja2FnZXMoInJwYXJ0LnBsb3QiKQ0KbGlicmFyeShycGFydC5wbG90KQ0KYGBgDQoNCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBJbXBvcnRhciBsYSBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4gICAgDQpgYGB7cn0NCnRpdGFuaWMgPC0gcmVhZC5jc3YoIkM6XFxVc2Vyc1xcQWRyacOhblxcRG93bmxvYWRzXFx0aXRhbmljLmNzdiIpDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBFbnRlbmRlciBsYSBiYXNlIGRlIGRhdG9zIDwvc3Bhbj4gICAgDQpgYGB7cn0NCnN1bW1hcnkodGl0YW5pYykNCnN0cih0aXRhbmljKQ0KaGVhZCh0aXRhbmljKQ0KYGBgDQogICAgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IENyZWFyIMOhcmJvbCBkZSBkZWNpc2nDs24gPC9zcGFuPiAgICANCmBgYHtyfQ0KdGl0YW5pYyA8LSB0aXRhbmljWyxjKCJwY2xhc3MiLCJhZ2UiLCJzZXgiLCJzdXJ2aXZlZCIpXQ0KdGl0YW5pYyRzdXJ2aXZlZCA8LSBhcy5mYWN0b3IodGl0YW5pYyRzdXJ2aXZlZCkNCnRpdGFuaWMkcGNsYXNzIDwtIGFzLmZhY3Rvcih0aXRhbmljJHBjbGFzcykNCnRpdGFuaWMkc2V4IDwtIGFzLmZhY3Rvcih0aXRhbmljJHNleCkNCnN0cih0aXRhbmljKQ0KYXJib2xfdGl0YW5pYyA8LSBycGFydChzdXJ2aXZlZH4uLCBkYXRhPXRpdGFuaWMpDQpycGFydC5wbG90KGFyYm9sX3RpdGFuaWMpDQpwcnAoYXJib2xfdGl0YW5pYywgZXh0cmE9NywgcHJlZml4PSJmcmFjY2nDs25cbiIpDQpgYGANCiAgIA0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBDb25jbHVzaW9uZXMgKFRpdGFuaWMpIDwvc3Bhbj4gICAgICAgDQpFbiBjb25jbHVzacOzbiwgbGFzIG3DoXMgYWx0YXMgcHJvYmFiaWxpZGFkIGRlIHNvYnJldml2aXIgZW4gZWwgbmF1ZnJhZ2lvIGRlbCBUaXRhbmljIHNvbjogICAgDQoNCiogMTAwJTogU2kgZXJlcyBuacOxbyB2YXLDs24gbWVub3IgZGUgOS41IGHDsW9zIGRlIDHCsG8gMsKwIGNsYXNlLiAgICAgDQoqIDczJTogU2kgZXJlcyBtdWplci4gICAgDQoNClksIHBvciBlbCBjb250cmFyaW8gbGFzIG3DoXMgYmFqYXMgcHJvYmFiaWxpZGFkZXMgZGUgc29icmV2aXZpciBzb246ICAgDQoNCiogMTclOiBTaSBlcmVzIGhvbWJyZSBtYXlvciBhIDkuNSBhw7Fvcy4gICAgDQoqIDM4JTogU2kgZXJlcyBuacOxbyB2YXLDs24gbWVub3IgYSA5LjUgYcOxb3MgZGUgM8KwIGNsYXNlLiAgICAgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWU7Ij4gQ8OhbmNlciBkZSBNYW1hIA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IEltcG9ydGFyIGJhc2UgZGUgZGF0b3MgPC9zcGFuPiAgDQpgYGB7cn0NCmRmIDwtIHJlYWQuY3N2KCJDOlxcVXNlcnNcXEFkcmnDoW5cXERvd25sb2Fkc1xcY2FuY2VyX2RlX21hbWEuY3N2IikNCmRmJGRpYWdub3NpcyA8LSBhcy5mYWN0b3IoZGYkZGlhZ25vc2lzKQ0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlOyI+IENyZWFyIMOhcmJvbCBkZSBkZWNpc2nDs24gPC9zcGFuPiAgICAgICAgICANCmBgYHtyfQ0KYXJib2xfZGYgPC0gcnBhcnQoZGlhZ25vc2lzfi4sIGRhdGE9ZGYpDQpycGFydC5wbG90KGFyYm9sX2RmKQ0KcHJwKGFyYm9sX2RmLCBleHRyYT03LCBwcmVmaXg9ImZyYWNjacOzblxuIikNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZTsiPiBDb25jbHVzaW9uZXMgKEPDoW5jZXIgZGUgTWFtYSkgPC9zcGFuPiAgICAgICAgICAgICAgDQpEZSBhY3VlcmRvIGNvbiBsb3MgcmVzdWx0YWRvcyBkZWwgw6FyYm9sIGRlIGRlY2lzacOzbiwgdW4gdHVtb3IgdGllbmUgdW5hIG1heW9yIHByb2JhYmlsaWRhZCBkZSBzZXIgY2FuY2VyaWdlbm8gYmFqbyBsYXMgc2lndWllbnRlcyBjaXJjdW5zdGFuY2lhczogICAgIA0KDQoqIDk0JTogRWwgcmFkaW8gZGVsIHR1bW9yIGVzIG1heW9yIGEgMTcgICAgICANCiogODklIEVsIHJhZGlvIGRlbCB0dW1vciBlcyBtZW5vciBhIDE3IHBlcm8gbGEgdGV4dHVyYSBtYXlvciBhIDI2DQoNClBvciBlbCBjb250cmFyaW8gbGEgbWF5b3IgcHJvYmFiaWxpZGFkIHBhcmEgcXVlIGVsIHR1bW9yIHNlYSBiZW5pZ25vIGVzIGJham8gbGFzIHNpZ3VpZW50ZXMgY2lyY3Vuc3RhbmNpYXM6ICAgICANCg0KKiAyMSU6IFJhZGlvIG1lbm9yIGEgMTcsIFB1bnRvcyBjb25jYXZvcyBtYXlvciBhIDAuMTQsIGNvbiBUZXh0dXJhIG1lbm9yIGEgMjYuICAgICAgDQo=