Teoria

El arbol de decision es un diagrama de aprendizaje automatico que modela las opciones, eventos y posibles resultados de una decision de forma visual.

sus partes principales son:

  • Nodo raiz: Inicio del diagrama
  • Ramas: Opciones disponibles
  • Nodos Internos: Nuevas decisiones
  • Hojas: Resultado final de cada camino
#file.choose()
titanic <- read.csv("C:\\Users\\usuario1\\Downloads\\titanic (1).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   N.unique :1308   N.unique :   3  
##  Median :3.000   Median :0.000   N.blank  :   1   N.blank  :   1  
##  Mean   :2.295   Mean   :0.382   Min.nchar:   0   Min.nchar:   0  
##  3rd Qu.:3.000   3rd Qu.:1.000   Max.nchar:  82   Max.nchar:   6  
##  Max.   :3.000   Max.   :1.000                                    
##  NAs    :1       NAs    :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   N.unique : 930  
##  Median :28.0000   Median :0.0000   Median :0.000   N.blank  :   1  
##  Mean   :29.8811   Mean   :0.4989   Mean   :0.385   Min.nchar:   0  
##  3rd Qu.:39.0000   3rd Qu.:1.0000   3rd Qu.:0.000   Max.nchar:  18  
##  Max.   :80.0000   Max.   :8.0000   Max.   :9.000                   
##  NAs    :264       NAs    :1        NAs    :1                       
##       fare               cabin           embarked           boat     
##  Min.   :  0.000   Length   :1310   Length   :1310   Length   :1310  
##  1st Qu.:  7.896   N.unique : 187   N.unique :   4   N.unique :  28  
##  Median : 14.454   N.blank  :1015   N.blank  :   3   N.blank  : 824  
##  Mean   : 33.295   Min.nchar:   0   Min.nchar:   0   Min.nchar:   0  
##  3rd Qu.: 31.275   Max.nchar:  15   Max.nchar:   1   Max.nchar:   7  
##  Max.   :512.329                                                     
##  NAs    :2                                                           
##       body           home.dest   
##  Min.   :  1.0   Length   :1310  
##  1st Qu.: 72.0   N.unique : 370  
##  Median :155.0   N.blank  : 565  
##  Mean   :160.8   Min.nchar:   0  
##  3rd Qu.:256.0   Max.nchar:  50  
##  Max.   :328.0                   
##  NAs    :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" ...

Filtrar la base de datos

Titanic <- titanic[,c("pclass","age","sex","survived")]
Titanic$survived <- as.factor(ifelse(Titanic$survived==0, "Murio",
"Sobrevive"))

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","Sobrevive": 2 2 1 1 1 2 2 1 2 1 ...
sum(is.na(Titanic))
## [1] 266
sapply(Titanic, function(x) sum(is.na(x)))
##   pclass      age      sex survived 
##        1      264        0        1
Titanic <- na.omit(Titanic)

Crear arbol de decisión

#install.packages("rpart")
library(rpart)
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 Sobrevive (0.41860465 0.58139535)  
##       10) pclass=3 29  11 Murio (0.62068966 0.37931034) *
##       11) pclass=1,2 14   0 Sobrevive (0.00000000 1.00000000) *
##    3) sex=female 388  96 Sobrevive (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 Sobrevive (0.14285714 0.85714286) *
##      7) pclass=1,2 236  16 Sobrevive (0.06779661 0.93220339) *
#install.packages("rpart.plot")
library(rpart.plot)
rpart.plot(arbol)

prp(arbol,extra = 7,prefix = "fraccion")

Conclusiones

    1. Las más altas probabilidades de sobrevivir en el Titanic son niño varón menor de 9.5 años de 1° y 2° clase (100%), y mujeres en 1° y 2° clase (93%).
    1. Las más bajas probabilidades de sobrevivir en el Titanic son los hombres mayores de 9.5 años (18%), y los hombres menores de 9.5 años en 3° clase (38%)
LS0tDQp0aXRsZTogIklBc2VzaW9uNCINCmF1dGhvcjogIkthbWlsIE0iDQpkYXRlOiAiMjAyNi0wOC0yMCINCm91dHB1dDogDQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2F0OiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KICAgIHRoZW1lOiB5ZXRpDQotLS0NCiFbXShodHRwczovL2kucGluaW1nLmNvbS9vcmlnaW5hbHMvOGEvMTcvYmEvOGExN2JhYTM4NTE4NzA5NDY5OTE1NzQxZDExY2VhMWEuZ2lmKQ0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj5UZW9yaWE8L3NwYW4+DQpFbCBhcmJvbCBkZSBkZWNpc2lvbiBlcyB1biBkaWFncmFtYSBkZSBhcHJlbmRpemFqZSBhdXRvbWF0aWNvIHF1ZSBtb2RlbGEgbGFzIG9wY2lvbmVzLCBldmVudG9zIHkgcG9zaWJsZXMgcmVzdWx0YWRvcyBkZSB1bmEgZGVjaXNpb24gZGUgZm9ybWEgdmlzdWFsLiAgDQoNCnN1cyBwYXJ0ZXMgcHJpbmNpcGFsZXMgc29uOiAgDQoNCiogTm9kbyByYWl6OiBJbmljaW8gZGVsIGRpYWdyYW1hDQoqIFJhbWFzOiBPcGNpb25lcyBkaXNwb25pYmxlcw0KKiBOb2RvcyBJbnRlcm5vczogTnVldmFzIGRlY2lzaW9uZXMNCiogSG9qYXM6IFJlc3VsdGFkbyBmaW5hbCBkZSBjYWRhIGNhbWlubw0KDQoNCg0KDQoNCg0KYGBge3J9DQojZmlsZS5jaG9vc2UoKQ0KdGl0YW5pYyA8LSByZWFkLmNzdigiQzpcXFVzZXJzXFx1c3VhcmlvMVxcRG93bmxvYWRzXFx0aXRhbmljICgxKS5jc3YiDQopDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IEVudGVuZGVyIGxhIGJhc2UgZGUgZGF0b3M8L3NwYW4+DQoNCmBgYHtyfQ0Kc3VtbWFyeSh0aXRhbmljKQ0Kc3RyKHRpdGFuaWMpDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+IEZpbHRyYXIgbGEgYmFzZSBkZSBkYXRvczwvc3Bhbj4NCmBgYHtyfQ0KVGl0YW5pYyA8LSB0aXRhbmljWyxjKCJwY2xhc3MiLCJhZ2UiLCJzZXgiLCJzdXJ2aXZlZCIpXQ0KVGl0YW5pYyRzdXJ2aXZlZCA8LSBhcy5mYWN0b3IoaWZlbHNlKFRpdGFuaWMkc3Vydml2ZWQ9PTAsICJNdXJpbyIsDQoiU29icmV2aXZlIikpDQoNClRpdGFuaWMkcGNsYXNzIDwtIGFzLmZhY3RvcihUaXRhbmljJHBjbGFzcykNClRpdGFuaWMkc2V4IDwtIGFzLmZhY3RvcihUaXRhbmljJHNleCkNCnN0cihUaXRhbmljKQ0Kc3VtKGlzLm5hKFRpdGFuaWMpKQ0KDQpzYXBwbHkoVGl0YW5pYywgZnVuY3Rpb24oeCkgc3VtKGlzLm5hKHgpKSkNCg0KVGl0YW5pYyA8LSBuYS5vbWl0KFRpdGFuaWMpDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6Ymx1ZSI+Q3JlYXIgYXJib2wgZGUgZGVjaXNpw7NuPC9zcGFuPg0KDQpgYGB7cn0NCiNpbnN0YWxsLnBhY2thZ2VzKCJycGFydCIpDQpsaWJyYXJ5KHJwYXJ0KQ0KYXJib2wgPC0gcnBhcnQoZm9ybXVsYT1zdXJ2aXZlZCB+IC4sIGRhdGEgPSBUaXRhbmljKQ0KYXJib2wNCiNpbnN0YWxsLnBhY2thZ2VzKCJycGFydC5wbG90IikNCmxpYnJhcnkocnBhcnQucGxvdCkNCnJwYXJ0LnBsb3QoYXJib2wpDQpwcnAoYXJib2wsZXh0cmEgPSA3LHByZWZpeCA9ICJmcmFjY2lvbiIpDQpgYGANCg0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj4gQ29uY2x1c2lvbmVzPC9zcGFuPg0KKiAxLiBMYXMgbcOhcyBhbHRhcyBwcm9iYWJpbGlkYWRlcyBkZSBzb2JyZXZpdmlyIGVuIGVsIFRpdGFuaWMgc29uIG5pw7FvDQp2YXLDs24gbWVub3IgZGUgOS41IGHDsW9zIGRlIDHCsCB5IDLCsCBjbGFzZSAoMTAwJSksIHkgbXVqZXJlcyBlbiAxwrAgeSAywrANCmNsYXNlICg5MyUpLg0KKiAyLiBMYXMgbcOhcyBiYWphcyBwcm9iYWJpbGlkYWRlcyBkZSBzb2JyZXZpdmlyIGVuIGVsIFRpdGFuaWMgc29uIGxvcw0KaG9tYnJlcyBtYXlvcmVzIGRlIDkuNSBhw7FvcyAoMTglKSwgeSBsb3MgaG9tYnJlcyBtZW5vcmVzIGRlIDkuNSBhw7Fvcw0KZW4gM8KwIGNsYXNlICgzOCUpDQoNCg0KDQoNCg0K