Importar la base de datos

titanic <- read.csv("/Users/kamilahchaidez/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   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" ...
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

Filtrar 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)

str(Titanic)
## 'data.frame':    1046 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 ...
##  - 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" ...

Crear árbol de decisión

library(rpart)

arbol <- rpart(
  formula = survived ~ .,
  data = Titanic,
  method = "class"
)

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) *

Graficar árbol de decisión

library(rpart.plot)

rpart.plot(arbol)

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

Información del árbol

printcp(arbol)
## 
## Classification tree:
## rpart(formula = survived ~ ., data = Titanic, method = "class")
## 
## Variables actually used in tree construction:
## [1] age    pclass sex   
## 
## Root node error: 427/1046 = 0.40822
## 
## n= 1046 
## 
##         CP nsplit rel error  xerror     xstd
## 1 0.459016      0   1.00000 1.00000 0.037228
## 2 0.018735      1   0.54098 0.54098 0.031419
## 3 0.016393      2   0.52225 0.59016 0.032390
## 4 0.011710      4   0.48946 0.55035 0.031612
## 5 0.010000      5   0.47775 0.54333 0.031468
summary(arbol)
## Call:
## rpart(formula = survived ~ ., data = Titanic, method = "class")
##   n= 1046 
## 
##           CP nsplit rel error    xerror       xstd
## 1 0.45901639      0 1.0000000 1.0000000 0.03722764
## 2 0.01873536      1 0.5409836 0.5409836 0.03141891
## 3 0.01639344      2 0.5222482 0.5901639 0.03239044
## 4 0.01170960      4 0.4894614 0.5503513 0.03161190
## 5 0.01000000      5 0.4777518 0.5433255 0.03146752
## 
## Variable importance
##    sex pclass    age 
##     68     22     10 
## 
## Node number 1: 1046 observations,    complexity param=0.4590164
##   predicted class=Murio      expected loss=0.4082218  P(node) =1
##     class counts:   619   427
##    probabilities: 0.592 0.408 
##   left son=2 (658 obs) right son=3 (388 obs)
##   Primary splits:
##       sex    splits as  -RL,       improve=146.278900, (0 missing)
##       pclass splits as  RRL,       improve= 41.412180, (0 missing)
##       age    < 8.5   to the right, improve=  8.228231, (0 missing)
## 
## Node number 2: 658 observations,    complexity param=0.01639344
##   predicted class=Murio      expected loss=0.2051672  P(node) =0.6290631
##     class counts:   523   135
##    probabilities: 0.795 0.205 
##   left son=4 (615 obs) right son=5 (43 obs)
##   Primary splits:
##       age    < 9.5   to the right, improve=13.024220, (0 missing)
##       pclass splits as  RLL,       improve= 8.334816, (0 missing)
## 
## Node number 3: 388 observations,    complexity param=0.01873536
##   predicted class=Sobrevive  expected loss=0.2474227  P(node) =0.3709369
##     class counts:    96   292
##    probabilities: 0.247 0.753 
##   left son=6 (152 obs) right son=7 (236 obs)
##   Primary splits:
##       pclass splits as  RRL,       improve=38.874860, (0 missing)
##       age    < 30.75 to the left,  improve= 2.915006, (0 missing)
##   Surrogate splits:
##       age < 18.75 to the left,  agree=0.673, adj=0.164, (0 split)
## 
## Node number 4: 615 observations
##   predicted class=Murio      expected loss=0.1788618  P(node) =0.5879541
##     class counts:   505   110
##    probabilities: 0.821 0.179 
## 
## Node number 5: 43 observations,    complexity param=0.01639344
##   predicted class=Sobrevive  expected loss=0.4186047  P(node) =0.04110899
##     class counts:    18    25
##    probabilities: 0.419 0.581 
##   left son=10 (29 obs) right son=11 (14 obs)
##   Primary splits:
##       pclass splits as  RRL,       improve=7.2750600, (0 missing)
##       age    < 3.5   to the right, improve=0.9085875, (0 missing)
## 
## Node number 6: 152 observations,    complexity param=0.0117096
##   predicted class=Murio      expected loss=0.4736842  P(node) =0.1453155
##     class counts:    80    72
##    probabilities: 0.526 0.474 
##   left son=12 (145 obs) right son=13 (7 obs)
##   Primary splits:
##       age < 1.5   to the right, improve=2.157947, (0 missing)
## 
## Node number 7: 236 observations
##   predicted class=Sobrevive  expected loss=0.06779661  P(node) =0.2256214
##     class counts:    16   220
##    probabilities: 0.068 0.932 
## 
## Node number 10: 29 observations
##   predicted class=Murio      expected loss=0.3793103  P(node) =0.02772467
##     class counts:    18    11
##    probabilities: 0.621 0.379 
## 
## Node number 11: 14 observations
##   predicted class=Sobrevive  expected loss=0  P(node) =0.01338432
##     class counts:     0    14
##    probabilities: 0.000 1.000 
## 
## Node number 12: 145 observations
##   predicted class=Murio      expected loss=0.4551724  P(node) =0.1386233
##     class counts:    79    66
##    probabilities: 0.545 0.455 
## 
## Node number 13: 7 observations
##   predicted class=Sobrevive  expected loss=0.1428571  P(node) =0.006692161
##     class counts:     1     6
##    probabilities: 0.143 0.857

Predicciones

predicciones <- predict(
  arbol,
  Titanic,
  type = "class"
)

head(predicciones)
##         1         2         3         4         5         6 
## Sobrevive Sobrevive Sobrevive     Murio Sobrevive     Murio 
## Levels: Murio Sobrevive

Matriz de confusión

matriz_confusion <- table(
  Real = Titanic$survived,
  Prediccion = predicciones
)

matriz_confusion
##            Prediccion
## Real        Murio Sobrevive
##   Murio       602        17
##   Sobrevive   187       240

Exactitud del modelo

exactitud <- sum(
  diag(matriz_confusion)
) / sum(matriz_confusion)

exactitud
## [1] 0.8049713

Conclusiones

  1. Las probabilidades más altas de sobrevivir en el Titanic corresponden principalmente a mujeres de primera y segunda clase y a algunos niños.

  2. Las probabilidades más bajas de sobrevivir corresponden principalmente a hombres adultos.

  3. El árbol de decisión permite observar cómo variables como la edad, el sexo y la clase del pasajero ayudan a clasificar si una persona sobrevivió o murió.

  4. La matriz de confusión permite comparar los valores reales con las predicciones del modelo.

  5. La exactitud muestra qué proporción de pasajeros fue clasificada correctamente por el árbol de decisión.

LS0tCnRpdGxlOiAiS2FtaWxhaCBDaGFpZGV6LUEwMTc0MTk0MyIKYXV0aG9yOiAiS2FtaWxhaCBDaGFpZGV6IEEwMTc0MTk0MyIKZGF0ZTogIjIwMjUtMDItMjAiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogdHJ1ZQogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlCi0tLQoKIVtdKGh0dHBzOi8vbWVkaWEwLmdpcGh5LmNvbS9tZWRpYS92MS5ZMmxrUFRaak1EbGlPVFV5WVhoNGMySmtkbnAwYlhjek9XZGpjbTV3ZVRZMmVUTjRkR3RpTUhkMlp6aHJiM3BsWlRGdmNDWmxjRDEyTVY5bmFXWnpYM05sWVhKamFDWmpkRDFuL1hPWTV5N1lYalREN3EvZ2lwaHkuZ2lmKQoKIyMgSW1wb3J0YXIgbGEgYmFzZSBkZSBkYXRvcwoKYGBge3IsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CnRpdGFuaWMgPC0gcmVhZC5jc3YoIi9Vc2Vycy9rYW1pbGFoY2hhaWRlei9Eb3dubG9hZHMvdGl0YW5pYy5jc3YiKQpgYGAKCiMjIEVudGVuZGVyIGxhIGJhc2UgZGUgZGF0b3MKCmBgYHtyLCBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpzdW1tYXJ5KHRpdGFuaWMpCnN0cih0aXRhbmljKQpoZWFkKHRpdGFuaWMpCmBgYAoKIyMgRmlsdHJhciBiYXNlIGRlIGRhdG9zCgpgYGB7ciwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KClRpdGFuaWMgPC0gdGl0YW5pY1ssIGMoInBjbGFzcyIsICJhZ2UiLCAic2V4IiwgInN1cnZpdmVkIildCgpUaXRhbmljJHN1cnZpdmVkIDwtIGFzLmZhY3RvcigKICBpZmVsc2UoCiAgICBUaXRhbmljJHN1cnZpdmVkID09IDAsCiAgICAiTXVyaW8iLAogICAgIlNvYnJldml2ZSIKICApCikKClRpdGFuaWMkcGNsYXNzIDwtIGFzLmZhY3RvcihUaXRhbmljJHBjbGFzcykKClRpdGFuaWMkc2V4IDwtIGFzLmZhY3RvcihUaXRhbmljJHNleCkKCnN0cihUaXRhbmljKQoKc3VtKGlzLm5hKFRpdGFuaWMpKQoKc2FwcGx5KAogIFRpdGFuaWMsCiAgZnVuY3Rpb24oeCkgc3VtKGlzLm5hKHgpKQopCgpUaXRhbmljIDwtIG5hLm9taXQoVGl0YW5pYykKCnN0cihUaXRhbmljKQpgYGAKCiMjIENyZWFyIMOhcmJvbCBkZSBkZWNpc2nDs24KCmBgYHtyLCBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQoKbGlicmFyeShycGFydCkKCmFyYm9sIDwtIHJwYXJ0KAogIGZvcm11bGEgPSBzdXJ2aXZlZCB+IC4sCiAgZGF0YSA9IFRpdGFuaWMsCiAgbWV0aG9kID0gImNsYXNzIgopCgphcmJvbApgYGAKCiMjIEdyYWZpY2FyIMOhcmJvbCBkZSBkZWNpc2nDs24KCmBgYHtyLCBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQoKbGlicmFyeShycGFydC5wbG90KQoKcnBhcnQucGxvdChhcmJvbCkKCnBycCgKICBhcmJvbCwKICBleHRyYSA9IDcsCiAgcHJlZml4ID0gImZyYWNjaW9uICIKKQpgYGAKCiMjIEluZm9ybWFjacOzbiBkZWwgw6FyYm9sCgpgYGB7ciwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KCnByaW50Y3AoYXJib2wpCgpzdW1tYXJ5KGFyYm9sKQpgYGAKCiMjIFByZWRpY2Npb25lcwoKYGBge3IsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CgpwcmVkaWNjaW9uZXMgPC0gcHJlZGljdCgKICBhcmJvbCwKICBUaXRhbmljLAogIHR5cGUgPSAiY2xhc3MiCikKCmhlYWQocHJlZGljY2lvbmVzKQpgYGAKCiMjIE1hdHJpeiBkZSBjb25mdXNpw7NuCgpgYGB7ciwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KCm1hdHJpel9jb25mdXNpb24gPC0gdGFibGUoCiAgUmVhbCA9IFRpdGFuaWMkc3Vydml2ZWQsCiAgUHJlZGljY2lvbiA9IHByZWRpY2Npb25lcwopCgptYXRyaXpfY29uZnVzaW9uCmBgYAoKIyMgRXhhY3RpdHVkIGRlbCBtb2RlbG8KCmBgYHtyLCBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQoKZXhhY3RpdHVkIDwtIHN1bSgKICBkaWFnKG1hdHJpel9jb25mdXNpb24pCikgLyBzdW0obWF0cml6X2NvbmZ1c2lvbikKCmV4YWN0aXR1ZApgYGAKCiMjIENvbmNsdXNpb25lcwoKMS4gTGFzIHByb2JhYmlsaWRhZGVzIG3DoXMgYWx0YXMgZGUgc29icmV2aXZpciBlbiBlbCBUaXRhbmljIGNvcnJlc3BvbmRlbiBwcmluY2lwYWxtZW50ZSBhIG11amVyZXMgZGUgcHJpbWVyYSB5IHNlZ3VuZGEgY2xhc2UgeSBhIGFsZ3Vub3MgbmnDsW9zLgoKMi4gTGFzIHByb2JhYmlsaWRhZGVzIG3DoXMgYmFqYXMgZGUgc29icmV2aXZpciBjb3JyZXNwb25kZW4gcHJpbmNpcGFsbWVudGUgYSBob21icmVzIGFkdWx0b3MuCgozLiBFbCDDoXJib2wgZGUgZGVjaXNpw7NuIHBlcm1pdGUgb2JzZXJ2YXIgY8OzbW8gdmFyaWFibGVzIGNvbW8gbGEgZWRhZCwgZWwgc2V4byB5IGxhIGNsYXNlIGRlbCBwYXNhamVybyBheXVkYW4gYSBjbGFzaWZpY2FyIHNpIHVuYSBwZXJzb25hIHNvYnJldml2acOzIG8gbXVyacOzLgoKNC4gTGEgbWF0cml6IGRlIGNvbmZ1c2nDs24gcGVybWl0ZSBjb21wYXJhciBsb3MgdmFsb3JlcyByZWFsZXMgY29uIGxhcyBwcmVkaWNjaW9uZXMgZGVsIG1vZGVsby4KCjUuIExhIGV4YWN0aXR1ZCBtdWVzdHJhIHF1w6kgcHJvcG9yY2nDs24gZGUgcGFzYWplcm9zIGZ1ZSBjbGFzaWZpY2FkYSBjb3JyZWN0YW1lbnRlIHBvciBlbCDDoXJib2wgZGUgZGVjaXNpw7NuLg==