Árboles de Decisión

Instalar Paqutes y Llamar Librerías

# install.packages(c("rpart","rpart.plot","caret"))
suppressPackageStartupMessages({
  library(rpart)
  library(rpart.plot)
  library(caret)
})

Importar la Base de Datos

titanic <- read.csv("~/Library/CloudStorage/OneDrive-InstitutoTecnologicoydeEstudiosSuperioresdeMonterrey/SEM 7/M2/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

Transformar Base de Datos

titanic$survived <- as.factor(titanic$survived)
titanic$pclass <- as.factor(titanic$pclass)
titanic$sex <-  as.factor(titanic$sex)
titanic <- titanic[,c("pclass", "age", "sex", "survived")]
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 ...

Crear Árbol de Decisión

arbol_titanic <- rpart(survived~., data=titanic)
rpart.plot(arbol_titanic)

prp(arbol_titanic, extra=7, prefix="fracción\n") # % en decimal es la probabilidad del evento positivo, el otro es el % del total del conjunto de clases

Conclusiones

En conclusión, las más altas probabilidades 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 de 9.5 años de 3° clase.

Árbol de Decisión — Cáncer de mama

A continuación, entrenamos un árbol de decisión y evaluamos su desempeño sobre un conjunto de prueba.

Importar la Base de Datos

datos <- read.csv("~/Library/CloudStorage/OneDrive-InstitutoTecnologicoydeEstudiosSuperioresdeMonterrey/SEM 7/M2/cancer_de_mama.csv", stringsAsFactors = FALSE, fileEncoding = "UTF-8-BOM")

Transformación

# Nombres seguros para fórmulas
names(datos) <- make.names(names(datos))

# Definir variable objetivo
objetivo <- "diagnosis"

# Convertir variable objetivo a factor
datos[[objetivo]] <- as.factor(datos[[objetivo]])

# Eliminar NAs
datos <- na.omit(datos)

Crear árbol

# Dividir en train/test
set.seed(123)
idx <- createDataPartition(datos[[objetivo]], p = 0.7, list = FALSE)
train <- datos[idx, ]
test  <- datos[-idx, ]

# Fórmula
form <- as.formula(paste(objetivo, "~ ."))

# Entrenar árbol
arbol <- rpart(
  form, data = train, method = "class",
  parms = list(split = "gini"),
  control = rpart.control(cp = 0.01, minsplit = 10, xval = 10)
)

# Ver complejidad
printcp(arbol)

## 
## Classification tree:
## rpart(formula = form, data = train, method = "class", parms = list(split = "gini"), 
##     control = rpart.control(cp = 0.01, minsplit = 10, xval = 10))
## 
## Variables actually used in tree construction:
## [1] concave_points_worst radius_worst         texture_mean        
## 
## Root node error: 149/399 = 0.37343
## 
## n= 399 
## 
##         CP nsplit rel error  xerror     xstd
## 1 0.805369      0  1.000000 1.00000 0.064847
## 2 0.100671      1  0.194631 0.28859 0.041571
## 3 0.013423      2  0.093960 0.17450 0.033088
## 4 0.010067      3  0.080537 0.16779 0.032489
## 5 0.010000      5  0.060403 0.19463 0.034804

# Graficar árbol
rpart.plot(
  arbol,
  type = 2,
  extra = 104,
  under = TRUE,
  faclen = 0,
  tweak = 1.0,
  fallen.leaves = TRUE
)

Métricas

# Predicciones
pred <- predict(arbol, newdata = test, type = "class")

# Matriz de confusión
confusionMatrix(pred, test[[objetivo]])

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   B   M
##          B 100   4
##          M   7  59
##                                           
##                Accuracy : 0.9353          
##                  95% CI : (0.8872, 0.9673)
##     No Information Rate : 0.6294          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.8626          
##                                           
##  Mcnemar's Test P-Value : 0.5465          
##                                           
##             Sensitivity : 0.9346          
##             Specificity : 0.9365          
##          Pos Pred Value : 0.9615          
##          Neg Pred Value : 0.8939          
##              Prevalence : 0.6294          
##          Detection Rate : 0.5882          
##    Detection Prevalence : 0.6118          
##       Balanced Accuracy : 0.9355          
##                                           
##        'Positive' Class : B               
##