Los árboles de decisión representan una alternativa a los modelos de regresión para resolver problemas tanto de clasificación como de predicción numérica.
Existen diversos algoritmos para desarrollar árboles de decisión, como ID3, CART, C4.5, C5.0, y CHAID, entre otros. En R, hay una variedad de paquetes disponibles para la construcción de árboles y conjuntos de árboles, como rpart, ipred, adabag, fastAdaboost, ada, tree, treebag, C5.0, party, CHAID, gbm, deepboost, xgboost, h2o, e1071, evtree y ranger, entre otros.
Para obtener detalles específicos sobre estos algoritmos y sus ajustes de parámetros, se puede consultar la sección 6 y 7 de la documentación (vignette) de la librería caret. Esta documentación también incluye múltiples variantes implementadas como diferentes métodos.
En este documento exploraremos ejemplos de cómo construir tanto un árbol único como bosques aleatorios.
library(titanic)
library(tibble)
library(kableExtra)
library(tidyverse)
library(rpart.plot)
library(rpart)
library(caret)
library(randomForest)
library(AmesHousing)
library(rsample)
Para este trabajo trabajaremos con el conjunto de datos titanic, disponible en el paquete titanic. El objetivo del problema es predecir a partir de las personas que viajaban en el barco, la probabilidad de supervivencia a la colisión con el iceberg, a partir de las diferentes características de los viajeros.
El conjunto de datos ya está dividido en dos subconjuntos (train y test).
En el dataset de Titanic observamos las variables siguientes:
dim(titanic_train)
## [1] 891 12
dim(titanic_test)
## [1] 418 11
Como podemos observar el conjunto de entrenamiento contiene 12 variables y 891 observaciones. Por otro lado, el conjunto de test se observan 11 variables y 418 observaciones.
A continuación, vemos una tabla con las primeras 6 filas del dataframe titanic_train (del conjunto de entrenamiento y conjunto de test).
head(titanic_train) %>%
as_tibble() %>%
kable("html") %>%
kable_styling(full_width = FALSE, position = "left")
| PassengerId | Survived | Pclass | Name | Sex | Age | SibSp | Parch | Ticket | Fare | Cabin | Embarked |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 0 | 3 | Braund, Mr. Owen Harris | male | 22 | 1 | 0 | A/5 21171 | 7.2500 | S | |
| 2 | 1 | 1 | Cumings, Mrs. John Bradley (Florence Briggs Thayer) | female | 38 | 1 | 0 | PC 17599 | 71.2833 | C85 | C |
| 3 | 1 | 3 | Heikkinen, Miss. Laina | female | 26 | 0 | 0 | STON/O2. 3101282 | 7.9250 | S | |
| 4 | 1 | 1 | Futrelle, Mrs. Jacques Heath (Lily May Peel) | female | 35 | 1 | 0 | 113803 | 53.1000 | C123 | S |
| 5 | 0 | 3 | Allen, Mr. William Henry | male | 35 | 0 | 0 | 373450 | 8.0500 | S | |
| 6 | 0 | 3 | Moran, Mr. James | male | NA | 0 | 0 | 330877 | 8.4583 | Q |
head(titanic_test) %>%
as_tibble() %>%
kable("html") %>%
kable_styling(full_width = FALSE, position = "left")
| PassengerId | Pclass | Name | Sex | Age | SibSp | Parch | Ticket | Fare | Cabin | Embarked |
|---|---|---|---|---|---|---|---|---|---|---|
| 892 | 3 | Kelly, Mr. James | male | 34.5 | 0 | 0 | 330911 | 7.8292 | Q | |
| 893 | 3 | Wilkes, Mrs. James (Ellen Needs) | female | 47.0 | 1 | 0 | 363272 | 7.0000 | S | |
| 894 | 2 | Myles, Mr. Thomas Francis | male | 62.0 | 0 | 0 | 240276 | 9.6875 | Q | |
| 895 | 3 | Wirz, Mr. Albert | male | 27.0 | 0 | 0 | 315154 | 8.6625 | S | |
| 896 | 3 | Hirvonen, Mrs. Alexander (Helga E Lindqvist) | female | 22.0 | 1 | 1 | 3101298 | 12.2875 | S | |
| 897 | 3 | Svensson, Mr. Johan Cervin | male | 14.0 | 0 | 0 | 7538 | 9.2250 | S |
En primer lugar, antes de comenzar a resolver el problema, nos hemos de preguntar si es necesario realizar un análisis exploratorio de los datos. Podemos observar que la variable respuesta claramente depende del sexo, del puerto de embarque, de la clase en la que se viajaba, del precio del billete (correlacionado con la anterior), de la edad o del número de familiares con los que se viajaba.
Debemos de cuestionarnos la siguiente pregunta:
¿Vamos a utilizar todas las variables?
No se usarán todas las variables, ya que algunas no aportan información importante al estudio. En este caso, se considera que se pueden excluir, por no ser relevantes para la predicción:
Nombre del pasajero (Name): A pesar de ser una identificación única para cada pasajero, es poco probable que el nombre tenga una relación directa con la probabilidad de supervivencia.
Número de identificación del pasajero (PassengerId): Esta variable también es poco probable que tenga una relación directa con su supervivencia.
Número de ticket (Ticket): Esta variable tampoco nos va a resultar útil para la predicción ya que no ofrece información relevante.
Número de cabina (Cabin): Dada la gran cantidad de NA’s , la variable podría tener menos relevancia para predecir la supervivencia.
# Eliminamos variables
train <- titanic_train %>%
dplyr::select(-c(PassengerId, Name, Cabin, Ticket))
¿Están todas las variables definidas con la clase adecuada?
La variable Pclass, que indica la clase del pasajero, tiene solo tres valores distintos representados como enteros. Dado este número limitado de categorías, es conveniente convertirla en un factor para facilitar su manejo en el análisis. De manera similar, la variable Survived, que indica si un pasajero sobrevivió (1) o no (0), también será convertida a tipo factor debido a su naturaleza binaria, lo cual hará más cómodo el tratamiento de los datos. También se cambiará la variable sexo a factor.
train$Survived <- factor(train$Survived, levels = c(0, 1), labels = c("Died", "Survived"))
train$Pclass <- factor(train$Pclass, levels = c(1, 2, 3), labels = c('Upper', 'Middle', 'Lower'))
train$Sex <- factor(train$Sex)
También se hace una pequeña transformación a las variables SibSp y Parch, puesto que sólo pueden tomar valores enteros, por lo que será más fácil trabajarlas como un factor
train$SibSp <- factor(train$SibSp)
train$Parch <- factor(train$Parch)
Además, se realiza un pequeño cambio para la variable Embarked, para que se más fácil de intrepretar, asignándole como etiquetas los nombres de los puertos de embarque:
train$Embarked <- factor(train$Embarked, levels = c('C', 'Q', 'S'), labels = c('Cherbourg', 'Queenstown', 'Southampton'))
Una vez modificadas las variables realizamos una observación.
summary(train)
## Survived Pclass Sex Age SibSp Parch
## Died :549 Upper :216 female:314 Min. : 0.42 0:608 0:678
## Survived:342 Middle:184 male :577 1st Qu.:20.12 1:209 1:118
## Lower :491 Median :28.00 2: 28 2: 80
## Mean :29.70 3: 16 3: 5
## 3rd Qu.:38.00 4: 18 4: 4
## Max. :80.00 5: 5 5: 5
## NA's :177 8: 7 6: 1
## Fare Embarked
## Min. : 0.00 Cherbourg :168
## 1st Qu.: 7.91 Queenstown : 77
## Median : 14.45 Southampton:644
## Mean : 32.20 NA's : 2
## 3rd Qu.: 31.00
## Max. :512.33
##
¿Qué hacemos con los NAs? ¿Es preciso eliminar NAs? ¿Qué implicaciones tiene?
Comprobamos si hay NAs:
NAs <- any(is.na(train))
NAs
## [1] TRUE
Se constata la presencia de valores faltantes (NAs). Aunque los árboles tienen la capacidad de manejarlos como si fueran valores más de la variable, se podría optar por mantenerlos para evitar pérdida de información, lo que podría sesgar la muestra.
Sin embargo, en este caso se ha decidido eliminar los valores faltantes debido a que su presencia podría complicar la construcción de los árboles y la interpretación de los resultados. Además, la eliminación de valores perdidos puede ser beneficiosa si la ausencia de datos no es aleatoria y está relacionada con la variable objetivo.
train <- train %>% na.omit()
head(train) %>%
as_tibble() %>%
kable("html") %>%
kable_styling(full_width = FALSE, position = "left")
| Survived | Pclass | Sex | Age | SibSp | Parch | Fare | Embarked |
|---|---|---|---|---|---|---|---|
| Died | Lower | male | 22 | 1 | 0 | 7.2500 | Southampton |
| Survived | Upper | female | 38 | 1 | 0 | 71.2833 | Cherbourg |
| Survived | Lower | female | 26 | 0 | 0 | 7.9250 | Southampton |
| Survived | Upper | female | 35 | 1 | 0 | 53.1000 | Southampton |
| Died | Lower | male | 35 | 0 | 0 | 8.0500 | Southampton |
| Died | Upper | male | 54 | 0 | 0 | 51.8625 | Southampton |
Para evaluar correctamente los modelos que se generen, el conjunto de entrenamiento y prueba deben de tener la misma estructura. Por ello, se aplican todos los cambios que se han realizado anteriormente en el conjunto de training al conjunto de test.
# Eliminamos variables
test <- titanic_test %>%
dplyr::select(-c(PassengerId, Name, Cabin, Ticket)) %>%
#Convertimos a factor y personalizamos los niveles
mutate(Pclass = factor(Pclass, levels = c(1, 2, 3),
labels = c('Upper', 'Middle', 'Lower')), Sex = factor(Sex), Embarked = factor(Embarked, levels = c('C', 'Q', 'S'), labels = c('Cherbourg', 'Queenstown', 'Southampton'))) %>%
##Eliminamos NA
na.omit()
test$SibSp <- as.factor(test$SibSp)
test$Parch <- as.factor(test$Parch)
Realizamos el mismo procedimiento para el conjunto de test. En primer lugar, se suprimen las mismas variables que para el conjunto de entrenamiento. En segundo lugar, se modifican el tipo de las clase factor de la variable Pclass. Por último, se suprimen las filas que continen valores NA.
head(test) %>%
as_tibble() %>%
kable("html") %>%
kable_styling(full_width = FALSE, position = "left")
| Pclass | Sex | Age | SibSp | Parch | Fare | Embarked |
|---|---|---|---|---|---|---|
| Lower | male | 34.5 | 0 | 0 | 7.8292 | Queenstown |
| Lower | female | 47.0 | 1 | 0 | 7.0000 | Southampton |
| Middle | male | 62.0 | 0 | 0 | 9.6875 | Queenstown |
| Lower | male | 27.0 | 0 | 0 | 8.6625 | Southampton |
| Lower | female | 22.0 | 1 | 1 | 12.2875 | Southampton |
| Lower | male | 14.0 | 0 | 0 | 9.2250 | Southampton |
Vamos a utilizar la librería rpart, que implementa el algoritmo CART.
Utilizaremos la libreria rpart, para poder implementar el algortimo CART.
Creamos un árbol utilizando las configuraciones predeterminadas. Entre otras características, utiliza la medida de Gini para determinar las particiones en cada nodo.
arbol <- rpart(Survived ~ ., data = train, method = 'class')
rpart.plot(arbol, extra = 101)
Cada nodo muestra:
En el árbol generado, se aprecia una profundidad de 6 niveles, donde se distinguen varias variables.
Es evidente que la mayoría de los fallecidos son hombres, mientras que la mayoría de los sobrevivientes son mujeres, lo que indica que el sexo es la variable con mayor capacidad predictiva en el modelo.
rpart.plot(arbol, extra = 1)
¿Qué diferencias observas?
La diferencia notoria radica en que solo se muestra la probabilidad estimada de supervivencia, sin incluir el porcentaje de observaciones en el nodo correspondiente. En la siguiente situación, también se presenta únicamente la probabilidad, aunque en un formato distinto.
rpart.plot(arbol, extra = 9)
Los árboles de decisión presentan diversas ventajas, siendo su interpretabilidad una de las más destacadas, como podemos apreciar. Además, desde la perspectiva de preprocesamiento de datos, necesitan muy poca preparación previa. Por ejemplo, no necesitan escalado ni centrado de variables.
Sin embargo, como contrapartida, son altamente sensibles al conjunto de datos y, por ende, poco robustos. Observemos un ejemplo:
arbol2 <- rpart(Survived ~ ., data = train[1:500, ], method = 'class')
rpart.plot(arbol2, extra = 101)
En este ejemplo, se seleccionan 500 observaciones del conjunto de entrenamiento, lo que representa una reducción en el número de casos en comparación con el primer árbol. Esta selección modifica la representación obtenida, resultando en porcentajes y probabilidades diferentes a los de la primera vez. Se limita la selección desde la fila 1 hasta la 500.
Prueba otros ejemplos
Como otros ejemplos, podemos observar los siguientes:
rpart.plot(arbol, extra = 7)
En esta primera instancia, se observan variaciones en las formas de los nodos de decisión, que ahora se presentan de forma ovalada. Además, en estos nodos se muestran las diferentes probabilidades correspondientes a los árboles iniciales. Como una alternativa similar a esta, donde solo cambia el aspecto y no los datos, se puede presentar:
rpart.plot(arbol, extra = 3)
Por otro lado, un ejemplo en el que se produce una modificación en el conjunto de datos podría ser el siguiente:
arbolextra <- rpart(Survived ~ ., data = train[100:500, ], method = 'class')
rpart.plot(arbolextra, extra = 103)
En este caso, se sigue el procedimiento de arbol2 pero modificando el límite de filas. Se consideran las filas desde la 100 hasta la 500. También se ha ajustado la apariencia, mostrando los nodos con el porcentaje de observaciones correctamente clasificadas en cada uno, así como la distribución de clases.
Evalúa todos modelos ensayados con rpart utilizando las respuestas correctas del conjunto de test.
Observamos la sintaxis:
predict_test <-predict(arbol, test, type = 'class')
predict_test2 <-predict(arbol2, test, type = 'class')
En este caso cogemos los dos árboles de decisión que hemos ajustado previamente, para hacer predicciones sobre el conjunto de test. Estamos interesados en obtener las predicciones de clase, por lo que usamos class.
Observamos la variabilidad, el impacto de los diferentes datos:
tabla_contingencia <- table(predict_test, predict_test2)
tabla_bonita <- as.data.frame(tabla_contingencia) %>%
kable("html") %>%
kable_styling(full_width = TRUE)
tabla_bonita
| predict_test | predict_test2 | Freq |
|---|---|---|
| Died | Died | 203 |
| Survived | Died | 9 |
| Died | Survived | 12 |
| Survived | Survived | 107 |
En la tabla anterior, se pueden extraer varias conclusiones:
En primer lugar, se observan 104 verdaderos positivos. Esto indica que el modelo predijo correctamente esas observaciones como pertenecientes a la clase “Survived”.
En segundo lugar, se identifican 206 verdaderos negativos. Estas observaciones fueron correctamente predichas como pertenecientes a la clase “Died”.
En tercer lugar, se registran 13 falsos positivos. Esto significa que el modelo predijo incorrectamente esas observaciones como pertenecientes a la clase “Survived”, cuando en realidad son de la clase “Died”.
En cuarto lugar, se analizan 8 falsos negativos. Estas observaciones fueron incorrectamente predichas como pertenecientes a la clase “Died”, cuando en realidad son de la clase “Survived”.
Además, se considerará el árbol adicional agregado, denominado arbolextra, para comparar la calidad de la predicción con respecto a la realidad.
predict_test3 <-predict(arbolextra, test, type = 'class')
tabla_contingencia2 <- table(predict_test, predict_test3)
tabla_bonita2 <- as.data.frame(tabla_contingencia2) %>%
kable("html") %>%
kable_styling(full_width = TRUE)
tabla_bonita2
| predict_test | predict_test3 | Freq |
|---|---|---|
| Died | Died | 179 |
| Survived | Died | 5 |
| Died | Survived | 36 |
| Survived | Survived | 111 |
Para la nueva tabla, se pueden obtener las siguientes conclusiones:
En primer lugar, se observan 103 verdaderos positivos. Esto indica que el modelo predijo correctamente esas observaciones como pertenecientes a la clase “Survived”.
En segundo lugar, se identifican 199 verdaderos negativos. Estas observaciones fueron correctamente predichas como pertenecientes a la clase “Died”.
En tercer lugar, se registran 20 falsos positivos. Esto significa que el modelo predijo incorrectamente esas observaciones como pertenecientes a la clase “Survived”, cuando en realidad son de la clase “Died”.
En cuarto lugar, se analizan 9 falsos negativos. Estas observaciones fueron incorrectamente predichas como pertenecientes a la clase “Died”, cuando en realidad son de la clase “Survived”.
Como evaluación del modelo, se considerarán las predicciones realizadas anteriormente para los árboles creados al inicio. Las medidas estadísticas utilizadas son las siguientes:
sensibilidad <- tabla_contingencia[2, 2] / (tabla_contingencia[2, 2] + tabla_contingencia[2, 1])
especificidad <- tabla_contingencia[1, 1] / (tabla_contingencia[1, 1] + tabla_contingencia[1, 2])
print(paste("Sensibilidad:", sensibilidad))
## [1] "Sensibilidad: 0.922413793103448"
print(paste("Especificidad:", especificidad))
## [1] "Especificidad: 0.944186046511628"
En el primer caso, observamos una sensibilidad del 0.9286 y una especificidad del 0.9406. Ambas métricas indican que este modelo arbol2 es efectivo para identificar tanto los casos positivos como los negativos (buscando minimizar ambos). Una alta especificidad señala correctamente la mayoría de los pasajeros que realmente no sobrevivieron.
Para el modelo de arbolextra se observa:
sensibilidad2 <- tabla_contingencia2[2, 2] / (tabla_contingencia2[2, 2] + tabla_contingencia2[2, 1])
especificidad2 <- tabla_contingencia2[1, 1] / (tabla_contingencia2[1, 1] + tabla_contingencia2[1, 2])
print(paste("Sensibilidad:", sensibilidad2))
## [1] "Sensibilidad: 0.956896551724138"
print(paste("Especificidad:", especificidad2))
## [1] "Especificidad: 0.832558139534884"
En este caso, se observa una disminución en los valores de las métricas, lo que puede interpretarse como un empeoramiento con respecto al segundo modelo. Tanto la especificidad (0.9087) como la sensibilidad (0.9196) son menores, lo que indica una menor capacidad para identificar correctamente tanto los casos positivos como los negativos. A pesar de ello, ambos modelos muestran buenos valores en las métricas.
Ambos modelos presentan un rendimiento sólido, pero hay algunas diferencias notables:
Precisión: El modelo arbol2 tiene una precisión ligeramente superior (0.92 frente a 0.89), lo que significa que acierta más en general que arbolextra.
Sensibilidad: La sensibilidad, que mide la capacidad de predecir correctamente los positivos reales, es similar en ambos modelos (0.93 frente a 0.92).
Especificidad: arbol2 también muestra una especificidad ligeramente superior (0.94 frente a 0.91), lo que indica una mejor capacidad para predecir correctamente los negativos reales.
F1 Score: El F1 Score, que es una medida de equilibrio entre precisión y sensibilidad, es más alto para el arbol2 (0.92 frente a 0.90).
En general, si la precisión y la capacidad para predecir correctamente los negativos son de alta importancia, el arbol2 podría ser más útil. Sin embargo, el arbolextra también proporciona predicciones de calidad, casi al mismo nivel que el arbol2, para las métricas evaluadas.
Explora la ayuda de la función y descubre los hipérparametros que estamos incluyendo. Para descubir una buena combinación de hiperparámetros puedes utilizar cross-validation.
Evalúa por cross-validation al menos 9 especificaciones con rpart, combinando diferentes valores para los argumentos minsplit, minbucket, maxdepth y cp, y, a partir de la métrica que consideres adecuada (argumenta su elección), determina cual es la mejor.
En el ajuste de los árboles, hemos utilizado opciones por defecto. La mayoría de los algoritmos disponen de muchos parámetros de tuneado. La solución puede depender de cómo se fijen estos.
La función rpart.control() de la librería rpart puede ser utilizada para esto en este caso.
control <- rpart.control(minsplit = 4,
minbucket = round(7/3),
maxdepth = 3,
cp = 0)
arbol3 <- rpart(Survived ~ ., data = train, method = 'class', control = control)
En el fragmento de código anterior, se observan los diferentes hiperparámetros utilizados:
rpart.plot(arbol3)
La validación cruzada es una técnica importante para evaluar el rendimiento del modelo y garantizar que sea eneralizable a datos no vistos. Se procede a realizar a continuación una combinación de validación cruzada con diferentes valores de hiperparámetros utilizando la función train del paquete caret:
#Definimos los valores a probar para los hiperparámetros
grid <- data.frame(cp = c(0.005, 0.01, 0.02, 0.03, 0.04, 0.05, 0.1,0.15, 0.2))
# Creamos un objeto de control para la validación cruzada
control <- trainControl(
method = "cv",
number = 5,
verboseIter = FALSE)
# Realizamos la búsqueda de hiperparámetros con validación cruzada
modelo_cv <- train(
Survived ~ .,
data = train,
method = 'rpart',
trControl = control,
tuneGrid = grid)
print(modelo_cv)
## CART
##
## 712 samples
## 7 predictor
## 2 classes: 'Died', 'Survived'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 570, 570, 569, 570, 569
## Resampling results across tuning parameters:
##
## cp Accuracy Kappa
## 0.005 0.7864572 0.5492810
## 0.010 0.7864868 0.5494857
## 0.020 0.7977544 0.5671658
## 0.030 0.7822909 0.5377508
## 0.040 0.7752782 0.5210173
## 0.050 0.7795036 0.5341813
## 0.100 0.7795036 0.5341813
## 0.150 0.7795036 0.5341813
## 0.200 0.7795036 0.5341813
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was cp = 0.02.
Para esta validación cruzada de 5 folds, se prueba un valor de 0.01 para el hiperparámetro “cp”. Los resultados se agregan para identificar el mejor valor, seleccionando así los mejores hiperparámetros. Además, se proporciona un resumen del rendimiento del modelo para diferentes valores de “cp”. Como resultado, se determina que el valor óptimo es 0.01, ya que condujo al mejor rendimiento según la métrica de precisión.
A continuación, se vuelven a fijar los parámetros de control, esta vez directamente con el valor óptimo de cp y los mismos valores para particiones, número de hojas y observaciones mínimas.
control_cv <- rpart.control(minsplit = 4,
minbucket = round(7/3),
maxdepth = 3,
cp = 0.01)
arbol_cv1 <- rpart(Survived ~ ., data = train, method = 'class', control = control_cv)
Para verificar si los números de observaciones para dividir un nodo, en una hoja y la profundidad del árbol son óptimos, probaremos con otras combinaciones de especificaciones. Posteriormente, evaluaremos los árboles resultantes para determinar cuál es el mejor y mostraremos su arquitectura.
control_cv2 <- rpart.control(minsplit = 3,
minbucket = round(7/3),
maxdepth = 3,
cp = 0.01)
arbol_cv2 <- rpart(Survived ~ ., data = train, method = 'class', control = control_cv2)
control_cv3 <- rpart.control(minsplit = 5,
minbucket = round(7/3),
maxdepth = 3,
cp = 0.01)
arbol_cv3 <- rpart(Survived ~ ., data = train, method = 'class', control = control_cv3)
control_cv4 <- rpart.control(minsplit = 4,
minbucket = 4,
maxdepth = 3,
cp = 0.01)
arbol_cv4 <- rpart(Survived ~ ., data = train, method = 'class', control = control_cv4)
control_cv5 <- rpart.control(minsplit = 4,
minbucket = 3,
maxdepth = 3,
cp = 0.01)
arbol_cv5 <- rpart(Survived ~ ., data = train, method = 'class', control = control_cv5)
control_cv6 <- rpart.control(minsplit = 4,
minbucket = 2,
maxdepth = 2,
cp = 0.01)
arbol_cv6 <- rpart(Survived ~ ., data = train, method = 'class', control = control_cv6)
control_cv7 <- rpart.control(minsplit = 4,
minbucket = 2,
maxdepth = 4,
cp = 0.01)
arbol_cv7 <- rpart(Survived ~ ., data = train, method = 'class', control = control_cv7)
control_cv8 <- rpart.control(minsplit = 5,
minbucket = 3,
maxdepth = 5,
cp = 0.01)
arbol_cv8 <- rpart(Survived ~ ., data = train, method = 'class', control = control_cv8)
control_cv9 <- rpart.control(minsplit = 3,
minbucket = 4,
maxdepth = 4,
cp = 0.01)
arbol_cv9 <- rpart(Survived ~ ., data = train, method = 'class', control = control_cv9)
# Lista de árboles
arboles <- list(arbol_cv1, arbol_cv2, arbol_cv3, arbol_cv4, arbol_cv5, arbol_cv6, arbol_cv7, arbol_cv8, arbol_cv9)
# Crear dataframe para almacenar resultados
resultados_df <- data.frame(Arbol = character(), TP = integer(),
TN = integer(),
FP = integer(),
FN = integer(),
Accuracy = numeric())
# Iterar sobre los árboles
for (i in seq_along(arboles)) {
# Obtener el árbol actual
arbol_actual <- arboles[[i]]
# Realizar predicciones en el conjunto de prueba
predicciones <- predict(arbol_actual, test, type = "class")
# Crear tabla de confusión
tabla_confusion <- table(predict_test, predicciones)
# Extraer medidas de la tabla de confusión
TP <- tabla_confusion[2, 2]
TN <- tabla_confusion[1, 1]
FP <- tabla_confusion[1, 2]
FN <- tabla_confusion[2, 1]
# Calcular la exactitud (Accuracy)
accuracy <- (TP + TN) / sum(tabla_confusion)
# Almacenar resultados en el dataframe
resultados_df <- rbind(resultados_df, data.frame(Arbol = paste("arbol_cv", i, sep = ""),
TP = TP,
TN = TN,
FP = FP,
FN = FN,
Accuracy = accuracy))
}
# Mostrar los resultados
print(resultados_df)
## Arbol TP TN FP FN Accuracy
## 1 arbol_cv1 116 201 14 0 0.9577039
## 2 arbol_cv2 116 201 14 0 0.9577039
## 3 arbol_cv3 116 201 14 0 0.9577039
## 4 arbol_cv4 116 201 14 0 0.9577039
## 5 arbol_cv5 116 201 14 0 0.9577039
## 6 arbol_cv6 83 213 2 33 0.8942598
## 7 arbol_cv7 91 215 0 25 0.9244713
## 8 arbol_cv8 91 215 0 25 0.9244713
## 9 arbol_cv9 91 215 0 25 0.9244713
En la tabla se observa que, con las especificaciones indicadas, los primeros cinco árboles predicen de la misma forma, arrojando el mejor resultado. Esto indica que cambiar la profundidad del árbol, ya sea haciéndolo más profundo o menos, empeora la calidad de las predicciones sobre el conjunto de prueba. Por ello, se concluye que se optará por el árbol con los valores predeterminados de minsplit, minbucket y maxdepth, pero estableciendo el cp en 0.01 para penalizar la complejidad. Este árbol sería el siguiente:
rpart.plot(arbol_cv1)
La idea en postprunning es permitir que el árbol crezca completamente y observar el valor de coeficiente cp. A continuación, podamos/cortamos el árbol empleando el cp óptimo como parámetro.
arbol4 <- rpart(Survived ~ ., data = train, method = "class",
control = rpart.control(cp = 0))
Este resultado proviene de un modelo de árbol de decisión construido con el método CART para clasificación.
Entre las observaciones se destaca, en primer lugar, que el árbol se construyó con un hiperparámetro de complejidad de 0.454861111. El conjunto de datos incluye 712 observaciones. El modelo se evaluó utilizando la tasa de error de clasificación (xerror). A medida que se reduce la complejidad (cp), se observa cómo cambian las tasas de error.
Por otro lado, la tabla de “Variable importance” muestra la relevancia de cada variable en la construcción del modelo, destacándose Sex, Pclass y Fare como las más importantes. La estructura del árbol se presenta en términos de nodos, donde cada nodo tiene un número y se describen las divisiones basadas en variables predictoras. El desglose detallado de los nodos muestra cómo se dividen las observaciones en subconjuntos basados en diferentes variables y umbrales.
A continuación se muestra la representación del árbol definido en el apartado anterior:
rpart.plot(arbol4)
printcp(arbol4)
##
## Classification tree:
## rpart(formula = Survived ~ ., data = train, method = "class",
## control = rpart.control(cp = 0))
##
## Variables actually used in tree construction:
## [1] Age Fare Parch Pclass Sex SibSp
##
## Root node error: 288/712 = 0.40449
##
## n= 712
##
## CP nsplit rel error xerror xstd
## 1 0.4548611 0 1.00000 1.00000 0.045472
## 2 0.0295139 1 0.54514 0.54514 0.038412
## 3 0.0277778 3 0.48611 0.56597 0.038927
## 4 0.0243056 4 0.45833 0.54167 0.038324
## 5 0.0115741 5 0.43403 0.50000 0.037215
## 6 0.0057870 8 0.39931 0.50347 0.037312
## 7 0.0046296 11 0.38194 0.53125 0.038056
## 8 0.0000000 17 0.35069 0.52431 0.037874
Se imprime una tabla que muestra los valores de complejidad para diferentes árboles generados con distintos valores de cp. Esta tabla muestra que se han utilizado las variables: Age, Fare, Parch, Pclass, Sex y SibSp.
El error del nodo raíz es de 0.40449 (40.449%). El árbol se ajusta a diferentes niveles de complejidad y se muestra el número de divisiones (nsplit), el error relativo (rel error), el error de validación cruzada (xerror) y la desviación estándar del error de validación cruzada (xstd) para cada valor de complejidad.
La selección del valor de cp implica encontrar un equilibrio entre un árbol demasiado complejo (sobreajustado) y uno demasiado simple (subajustado). La elección típica es aquella que minimiza el error de validación cruzada (xerror), que en este caso corresponde a un cp de 0.0057870.
plotcp(arbol4)
El valor donde el error de validación cruzada es mínimo se encuentra entre las profundidades 6 y 9, siendo este el punto óptimo para seleccionar el valor de complejidad o cp.
Con el siguiente fragmento de código, se crea una versión podada del árbol original, buscando evitar el sobreajuste y mejorar la generalización del modelo:
arbol4_pruned <- prune(arbol4, cp = 0.026)
rpart.plot(arbol4_pruned)
Este árbol es similar al árbol original, pero con algunas ramas eliminadas para simplificar la estructura y evitar el sobreajuste.
Compara las predicciones de este modelo con las del primer modelo.
Primero, se calculan las predicciones para el conjunto de prueba utilizando el árbol podado arbol4. Luego, creamos una tabla de contingencia para comparar las predicciones del primer árbol con las del árbol podado arbol4. Esto nos permitirá calcular ciertas medidas de evaluación para comparar ambos modelos. Se observa que el árbol arbol4 clasifica incorrectamente 16 observaciones de las 331 que tiene el conjunto de prueba, todas ellas prediciendo incorrectamente que los pasajeros fallecieron cuando en realidad sobrevivieron. Para profundizar, calcularemos las medidas de evaluación:
predict_pod <- predict(arbol4_pruned, test, type = 'class')
tabla <- table(predict_test, predict_pod)
tabla
## predict_pod
## predict_test Died Survived
## Died 199 16
## Survived 0 116
TP <- tabla[2, 2]
TN <- tabla[1, 1]
FP <- tabla[1, 2]
FN <- tabla[2, 1]
precision <- TP / (TP + FP)
sensibilidad <- TP / (TP + FN)
especificidad <- TN / (TN + FP)
f1_score <- 2 * (precision * sensibilidad) / (precision + sensibilidad)
medidas_df <- data.frame(
Medida = c("Precisión (Precision)", "Sensibilidad (Recall)", "Especificidad", "F1-Score"),
Valor = c(precision, sensibilidad, especificidad, f1_score)
)
kable(medidas_df, "html") %>%
kable_styling(full_width = FALSE)
| Medida | Valor |
|---|---|
| Precisión (Precision) | 0.8787879 |
| Sensibilidad (Recall) | 1.0000000 |
| Especificidad | 0.9255814 |
| F1-Score | 0.9354839 |
Los resultados de las métricas de evaluación muestran que el modelo basado en el árbol podado arbol4 tiene un rendimiento positivo. La alta precisión del 87.88% indica que la mayoría de las predicciones positivas son correctas, mientras que una sensibilidad del 100% resalta la capacidad del modelo para identificar todas las instancias positivas reales. La especificidad del 92.56% sugiere que el modelo clasifica correctamente la mayoría de las instancias negativas. Además, el F1-Score del 93.55%, que equilibra precisión y sensibilidad, indica un buen rendimiento general del modelo. En conjunto, estos resultados destacan la eficacia del árbol de decisión en la tarea de clasificación, demostrando su capacidad para realizar predicciones precisas tanto para instancias positivas como negativas.
Los árboles son modelos poco robustos: son muy sensibles a los conjuntos de entrenamiento, aunque tienen muchas ventajas. Los bosques aleatorios pretenden aprovechar sus ventajas, reduciendo su variabilidad, mediante modelos de ensemble.
El paquete randomForest ofrece una implementación básica.
El paquete ranger permite una implementación más rápida.
El paquete h2o permite una implementación distribuida.
Los Random Forest tienen varios hiperparámetros que pueden ajustarse mediante validación cruzada para optimizar el rendimiento del modelo. Uno de los más importantes es el número de variables candidatas a considerar en cada ramificación.
La lista de hiperparámetros relevantes, junto con los nombres de los argumentos utilizados en el paquete randomForest, incluye:
Número de árboles en el bosque (ntree): Este parámetro especifica cuántos árboles se incluirán en el bosque. Es crucial para estabilizar el error, pero usar demasiados árboles puede ser computacionalmente costoso e innecesario.
Número de variables a considerar en cada ramificación (mtry): Determina cuántas variables se seleccionan al azar como candidatas para cada decisión en un nodo del árbol. Controla la diversidad entre los árboles y es fundamental para el rendimiento del modelo.
Tamaño de muestra para entrenar en cada ramificación (sampsize): Indica el número de muestras utilizadas para entrenar en cada nodo del árbol. El valor por defecto es 63.25%, pero puede ajustarse según las características del conjunto de datos. Valores más bajos pueden introducir sesgo, mientras que valores más altos pueden aumentar el rendimiento del modelo, aunque con riesgo de overfitting. Generalmente se mantiene en el rango de 60% a 80%.
Número mínimo de muestras en los nodos terminales (nodesize): Controla el número mínimo de muestras requeridas en los nodos hoja del árbol. Ayuda a equilibrar el trade-off entre sesgo y varianza del modelo.
Número máximo de nodos terminales (maxnodes): Establece el límite superior para el número total de nodos hoja en el árbol. Limitar este valor puede ayudar a prevenir el sobreajuste al restringir la complejidad del modelo.
Ajustar adecuadamente estos hiperparámetros mediante validación cruzada es crucial para optimizar la capacidad predictiva del modelo de Random Forest en diferentes problemas de aprendizaje automático.
Out-of-Bag (OOB) es equivalente a un conjunto de validación o prueba. En los bosques aleatorios, teóricamente no es necesario tener un conjunto de muestras independiente para validar los resultados. Este se estima internamente durante el ajuste. En la construcción de cada árbol del bosque, aproximadamente el 1/3 de las muestras (36.8%) no se utilizan, lo cual permite utilizar estos datos para estimar el error del modelo en datos no observados. Esto proporciona una estimación del error del bosque mientras se construye.
En el primer ejemplo, exploraremos cómo clasificar el conjunto de flores del dataset iris según sus características físicas, específicamente el ancho y largo de los pétalos y sépalos.
El conjunto de datos Iris en R es un conjunto de datos clásico que describe características de tres especies de iris. Estas son las variables presentes en el conjunto de datos:
Sepal.Length (Numérica): Longitud del sépalo en centímetros.
Sepal.Width (Numérica): Ancho del sépalo en centímetros.
Petal.Length (Numérica): Longitud del pétalo en centímetros.
Petal.Width (Numérica): Ancho del pétalo en centímetros.
Species (Categórica): Especie de iris (Setosa, Versicolor, Virginica).
data(iris)
datos <- iris
A continuación, los datos se dividen en dos conjuntos: entrenamiento y prueba. El conjunto de entrenamiento contendrá 2/3 del total de los datos, lo que equivale a 100 observaciones de las 150 disponibles. El conjunto de prueba consistirá en las 50 observaciones restantes, la mitad del tamaño del conjunto de entrenamiento.
set.seed(123)
n.train <- round(nrow(datos)*0.6667)
indices <- sample(1:nrow(datos), size = n.train)
train <- datos[indices, ]
test <- datos[-indices, ]
En este caso, se está utilizando la función randomForest para construir el modelo, donde la variable dependiente es “Species” y las variables independientes son todas las demás disponibles en el conjunto de datos de entrenamiento. Esta función implementa el algoritmo de Bosques Aleatorios, una técnica de aprendizaje supervisado que combina múltiples árboles de decisión para mejorar la precisión y robustez del modelo. Este enfoque es especialmente útil en problemas de clasificación, como parece ser el caso aquí, donde se intenta predecir la variable categórica “Species” basándose en otras características del conjunto de datos de entrenamiento.
# Ajustar modelo
rf1 <- randomForest(Species ~ ., data = train)
rf1
##
## Call:
## randomForest(formula = Species ~ ., data = train)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 4%
## Confusion matrix:
## setosa versicolor virginica class.error
## setosa 34 0 0 0.00000000
## versicolor 0 28 1 0.03448276
## virginica 0 3 34 0.08108108
El modelo consta de 500 árboles de decisión y evalúa dos variables en cada división. El error estimado fuera de la bolsa (OOB - Out of the Bag) es del 4%, lo que indica un buen rendimiento del modelo. La matriz de confusión proporciona detalles sobre la clasificación, mostrando que el modelo tiene un error de clasificación del 3.45% para la clase ‘versicolor’ y un 8.11% para la clase ‘virginica’. Para la clase ‘setosa’, el modelo clasifica perfectamente. En conjunto, estos resultados sugieren que el modelo de Bosques Aleatorios tiene un rendimiento sólido en la clasificación de las especies.
table_kable <- kable(rf1$importance, format = "html", caption = "Importancia de las variables en MeanDecreaseGini") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
table_kable
| MeanDecreaseGini | |
|---|---|
| Sepal.Length | 6.697601 |
| Sepal.Width | 1.153847 |
| Petal.Length | 27.366548 |
| Petal.Width | 30.415230 |
La tabla de “MeanDecreaseGini” resume la importancia relativa de las variables en un modelo de Bosques Aleatorios, evaluada mediante la disminución de la impureza de Gini. En este caso, “Petal.Width” y “Petal.Length” destacan como las variables más influyentes, con valores de 30.415230 y 27.366548, respectivamente.
Estos números subrayan la importancia crítica de la anchura y longitud de los pétalos para la precisión del modelo en la clasificación de especies de flores. Por otro lado, “Sepal.Length” también contribuye significativamente, aunque en menor medida, mientras que “Sepal.Width” muestra la menor influencia según este criterio. Esta información es crucial para entender qué características son más relevantes en las decisiones del modelo y puede orientar el análisis de datos subsiguiente.
Para poder evaluar el modelo, se necesita conocer las predicciones que produce sobre nuevos datos.
predicciones <- predict(rf1, test)
Se genera la matriz de confusión para poder conocer los ratios de verdaderos positivos, verdaderos negativos, falsos positivos y falsos negativos. A partir de estas ratios, se procederá a evaluar el modelo según distintas métricas…
mc <- table(predicciones, test$Species)
table_kable2 <- kable(mc, format = "html", caption = "Matriz de confusión") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
table_kable2
| setosa | versicolor | virginica | |
|---|---|---|---|
| setosa | 16 | 0 | 0 |
| versicolor | 0 | 19 | 0 |
| virginica | 0 | 2 | 13 |
En la matriz de confusión, cada fila representa la clase verdadera, mientras que cada columna representa la clase predicha por el modelo. La clase “setosa” fue correctamente clasificada en todas las 16 ocasiones, y la clase “versicolor” fue correctamente clasificada en 19 de las 21 instancias. Por otro lado, la clase “virginica” tuvo 13 clasificaciones correctas de las 15, resultando en un error del 15,38% para esta clase y un error total del 4,35%. Los valores fuera de la diagonal principal indican las instancias clasificadas incorrectamente, siendo dos instancias de la clase “versicolor” clasificadas erróneamente como “virginica” en este caso.
accuracy <- sum(diag(mc)) / sum(mc)
sensibilidad <- mc[2, 2] / sum(mc[2, ])
especificidad <- mc[1, 1] / sum(mc[1, ])
precision <- mc[2, 2] / sum(mc[, 2])
f1 <- 2 * (precision * sensibilidad) / (precision + sensibilidad)
metricas_df <- data.frame(
Métrica = c("Accuracy", "Sensibilidad", "Especificidad", "Precisión", "F1 Score"),
Valor = c(accuracy, sensibilidad, especificidad, precision, f1)
)
tabla_kable3 <- kable(metricas_df, format = "html", caption = "Métricas de Evaluación del Modelo") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
tabla_kable3
| Métrica | Valor |
|---|---|
| Accuracy | 0.9600000 |
| Sensibilidad | 1.0000000 |
| Especificidad | 1.0000000 |
| Precisión | 0.9047619 |
| F1 Score | 0.9500000 |
Las métricas de evaluación del modelo ofrecen una visión detallada de su rendimiento en la clasificación de especies en el conjunto de datos de prueba. Con una precisión del 96%, el modelo muestra una alta tasa de clasificación correcta en general. La sensibilidad y la especificidad del 100% destacan la capacidad del modelo para identificar correctamente todas las instancias de la clase de interés y evitar clasificaciones incorrectas de instancias negativas. Sin embargo, dado que se trata de una clasificación multiclase con 3 categorías, las métricas de sensibilidad y especificidad no son aplicables aquí en términos tradicionales.
La precisión del 90.48% subraya la proporción de instancias positivas correctamente identificadas entre todas las clasificadas como positivas. Por último, el F1 Score del 95% proporciona una medida equilibrada entre precisión y sensibilidad, consolidando el desempeño general del modelo en términos de clasificación y capacidad de discriminación entre las clases. Estas métricas proporcionan una evaluación completa de la efectividad del modelo en la tarea específica de clasificación de especies.
Analizamos el conjunto de préstamos que ya analizamos en el documento “Evaluación de un modelo de clasificación”.
creditos <- read.csv("http://www.uv.es/pavia/MCD/credit.csv", sep=";", stringsAsFactors = TRUE)
creditos$checking_balance <- ordered(creditos$checking_balance,
levels = c("< 0 DM", "1 - 200 DM", "> 200 DM", "unknown"))
creditos$savings_balance <- ordered(creditos$savings_balance,
levels = c("< 100 DM", "101 - 500 DM","501 - 1000 DM",
"> 1000 DM", "unknown"))
Para iniciar el procesamiento de los datos, se establece una semilla para asegurar que la muestra aleatoria sea reproducible bajo las mismas condiciones. Luego, se seleccionan aleatoriamente 1000 observaciones para formar el conjunto de datos utilizado en la construcción de los árboles posteriores. Finalmente, se divide esta muestra en un conjunto de entrenamiento, que incluye el 90% de las observaciones, y un conjunto de prueba, que contiene el 10% restante.
# Creamos conjuntos de entrenamiento (90%) y de test (10%)
set.seed(123) # Fijamos semilla
credit <- creditos[sample(1:1000),]
train <- credit[1:900,]
test <- credit[901:1000,]
Seguimos con la creación del modelo con Random Forest, para el conjunto de datos de entrenamiento. Se crearan 500 árboles de decisión.
set.seed(123)
rf2 <-randomForest(default ~ ., data = train, ntree = 500)
rf2
##
## Call:
## randomForest(formula = default ~ ., data = train, ntree = 500)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 4
##
## OOB estimate of error rate: 22.67%
## Confusion matrix:
## No-Default Si-Default class.error
## No-Default 590 45 0.07086614
## Si-Default 159 106 0.60000000
Durante la construcción de cada árbol, se seleccionan aleatoriamente 4 variables predictoras para evaluar cuál proporciona la mejor discriminación en cada nodo. La matriz de confusión detalla los resultados de la clasificación en el conjunto de entrenamiento, revelando un error del 7.09% para la clase “No-Default” y un 60% para la clase “Si-Default”. Esto indica que las predicciones para la clase “Si-Default” son significativamente menos precisas.
Evaluar el error de estimación Out-Of-Bag (OOB) y el conjunto de prueba (test) es fundamental al trabajar con Random Forests. El error OOB se calcula utilizando las instancias que no se usaron para construir cada árbol, ofreciendo una estimación imparcial del rendimiento del modelo sin necesidad de un conjunto de prueba separado. Esto es crucial para evaluar la capacidad de generalización del modelo. Por otro lado, el conjunto de prueba proporciona una validación independiente utilizando datos que no fueron vistos durante el entrenamiento. Combinar ambas evaluaciones ofrece una visión completa del rendimiento del Random Forest, ayudando a evitar el sobreajuste al conjunto de entrenamiento y asegurando que el modelo pueda generalizar bien a nuevos datos.
Se muestra por pantalla el resultado del modelo de Random Forest 2, dónde se indica el error de OOD.
rf2
##
## Call:
## randomForest(formula = default ~ ., data = train, ntree = 500)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 4
##
## OOB estimate of error rate: 22.67%
## Confusion matrix:
## No-Default Si-Default class.error
## No-Default 590 45 0.07086614
## Si-Default 159 106 0.60000000
En cuanto al error Out-Of-Bag (OOB), se estima en un 22.67%. Esto significa que, según la estimación utilizando las instancias que no fueron utilizadas para entrenar cada árbol individual en el Bosque Aleatorio, aproximadamente el 22.67% de las predicciones del modelo son incorrectas. En otras palabras, cuando se aplica el modelo a datos que no fueron parte del proceso de entrenamiento, se espera que alrededor del 22.67% de las predicciones sean erróneas. En este caso, un 22.67% de error OOD sugiere que el modelo podría beneficiarse de ajustes adicionales para mejorar su rendimiento y reducir el error en datos no vistos.
Ahora, se pasa a evaluar el error de estimación del test.
# Predicciones
predicciones <- predict(rf2, test)
# Matriz de confusión
mc <- table(predicciones, test$default)
tabla_kable4 <- kable(mc, format = "html", caption = "Matriz de confusión test") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
tabla_kable4
| No-Default | Si-Default | |
|---|---|---|
| No-Default | 60 | 16 |
| Si-Default | 5 | 19 |
#Métricas de evaluación
accuracy <- sum(diag(mc)) / sum(mc)
sensibilidad <- mc[2, 2] / sum(mc[2, ])
especificidad <- mc[1, 1] / sum(mc[1, ])
precision <- mc[2, 2] / sum(mc[, 2])
f1 <- 2 * (precision * sensibilidad) / (precision + sensibilidad)
metricas_df <- data.frame(
Métrica = c("Accuracy", "Sensibilidad", "Especificidad", "Precisión", "F1 Score"),
Valor = c(accuracy, sensibilidad, especificidad, precision, f1)
)
tabla_kable5 <- kable(metricas_df, format = "html", caption = "Métricas de Evaluación del Modelo") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
tabla_kable5
| Métrica | Valor |
|---|---|
| Accuracy | 0.7900000 |
| Sensibilidad | 0.7916667 |
| Especificidad | 0.7894737 |
| Precisión | 0.5428571 |
| F1 Score | 0.6440678 |
El modelo muestra un accuracy del 79%, indicando que clasifica correctamente aproximadamente el 79% de todas las instancias, lo cual refleja una capacidad general decente. La sensibilidad del 79.17% resalta la proporción de instancias reales “Si-Default” correctamente identificadas, mientras que la especificidad del 78.95% muestra la habilidad del modelo para clasificar correctamente instancias “No-Default”. La precisión del 54.29% refleja la proporción de instancias clasificadas como “Si-Default” que son realmente “Si-Default”.
Este modelo demuestra un rendimiento aceptable en general, aunque existen áreas específicas que podrían beneficiarse de mejoras. El accuracy indica que el modelo puede clasificar correctamente una proporción significativa de instancias, pero la precisión sugiere que hay margen para mejorar la identificación precisa de instancias “Si-Default”. La sensibilidad y especificidad equilibradas indican que el modelo tiene una capacidad razonable para identificar tanto instancias “Si-Default” como “No-Default”.
¿Podemos mejorar el modelo?
En términos generales, el modelo exhibe habilidades decentes de clasificación. Sin embargo, podría ser beneficioso explorar ajustes en los umbrales de clasificación o implementar técnicas adicionales para mejorar la precisión, especialmente en la identificación de instancias clasificadas como “Si-Default”..
Para determinar el valor óptimo de mtry, seleccionaremos aquel que produzca el menor error Out-of-Bag (OOB) entre los valores probados. Lo realizamos utilizando el conjunto de entrenamiento, pero teóricamente podríamos hacerlo con todo el conjunto de datos porque el OOB error proporciona una estimación imparcial del rendimiento del modelo, utilizando las instancias no utilizadas durante la construcción de cada árbol. Esto nos permite evaluar la capacidad de generalización del modelo sin necesidad de un conjunto de prueba separado. Sin embargo, es importante destacar que los resultados pueden no coincidir porque el OOB error varía según la configuración de mtry y la aleatoriedad en la construcción de los árboles de decisión en el bosque aleatorio.
El proceso de selección del valor de
mtry y el número de variables consideradas
se realiza utilizando el conjunto de entrenamiento en lugar de emplear
todo el conjunto de datos, con el propósito de asegurar una evaluación
imparcial del modelo. La razón principal es evaluar la capacidad del
modelo para generalizar a datos no vistos. Utilizar todo el conjunto de
datos para ajustar los hiperparámetros podría llevar al sobreajuste del
modelo a la totalidad de los datos, lo cual podría generar resultados
optimistas que no reflejen necesariamente el rendimiento real en nuevas
instancias. La separación entre conjunto de entrenamiento y conjunto de
prueba proporciona una evaluación más realista del rendimiento del
modelo al verificar su capacidad para generalizar a datos no utilizados
durante el entrenamiento.
mtry <- tuneRF(train[, names(train) != "default"], train$default,
ntreeTry = 500,
stepFactor = 1.5,
improve = 0.01,
trace = TRUE, plot = TRUE)
## mtry = 4 OOB error = 23.22%
## Searching left ...
## mtry = 3 OOB error = 23.67%
## -0.01913876 0.01
## Searching right ...
## mtry = 6 OOB error = 22.89%
## 0.01435407 0.01
## mtry = 9 OOB error = 23.44%
## -0.02427184 0.01
La búsqueda del valor óptimo de mtry para el modelo de Random Forest indica que entre las opciones evaluadas, el valor de 4 produce el menor error Out-Of-Bag (OOB) con un 23.22%. Al explorar valores más bajos y más altos, se observa que tanto mtry = 3 como mtry = 6 muestran errores OOB cercanos, pero mtry = 6 resulta en el menor error OOB con un 22.89%. Aunque también se evaluó mtry = 9, su error OOB es mayor en comparación con mtry = 6. Estos resultados sugieren que dentro del rango de valores probados, mtry = 6 podría ser la elección más efectiva para minimizar el error OOB y mejorar la capacidad de generalización del modelo de Random Forest.
best.m <- mtry[mtry[, 2] == min(mtry[, 2]), 1]
print(mtry)
## mtry OOBError
## 3.OOB 3 0.2366667
## 4.OOB 4 0.2322222
## 6.OOB 6 0.2288889
## 9.OOB 9 0.2344444
print(best.m)
## [1] 6
Como se puede observar, tras hacer la comparación el mejor valor es del hiperparámetro es 6.
Nuevamente construimos el modelo empleando el mejor mtry encontrado.
set.seed(123)
rf3 <- randomForest(default ~ ., data = train,
mtry = best.m, importance = TRUE, ntree = 500)
print(rf3)
##
## Call:
## randomForest(formula = default ~ ., data = train, mtry = best.m, importance = TRUE, ntree = 500)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 6
##
## OOB estimate of error rate: 23.44%
## Confusion matrix:
## No-Default Si-Default class.error
## No-Default 577 58 0.09133858
## Si-Default 153 112 0.57735849
Determinar la relevancia de las variables en un Random Forest es fundamental porque ofrece información sobre qué características influyen más en las predicciones del modelo. Esto no solo facilita la comprensión de cómo toma decisiones el modelo, sino que también orienta la selección de características, mejora la interpretación de resultados y revela cuánto contribuye cada variable a la precisión general del modelo. Además, evaluar la importancia de las variables ayuda a identificar y eliminar aquellas que son redundantes o poco informativas, lo que optimiza el rendimiento del modelo.
varImpPlot(rf3)
En primer lugar, el “Mean Decrease Accuracy” mide la relevancia de cada variable al calcular cuánto se reduce la precisión del modelo al eliminar esa variable en comparación con mantenerla. Las variables que provocan una mayor reducción en la precisión al ser eliminadas se consideran más importantes para la capacidad predictiva del modelo.
Por otro lado, el “Mean Decrease Gini” evalúa cómo cada variable contribuye a la disminución de la impureza Gini, que indica la homogeneidad de las clases en los nodos del árbol. Las variables con un valor más alto en esta métrica tienen un mayor impacto en la capacidad del modelo para separar las clases, ya que contribuyen significativamente a la pureza de los nodos en los árboles de decisión.
En este contexto específico, se observa que las variables más influyentes en el modelo son “amount”, “checking_balance” y “months_loan_duration”, ya que aumentan tanto la precisión como el índice de Gini cuando se incluyen. En contraste, las variables menos influyentes son “telephone”, “foreign_worker” y “dependents”.
Este análisis cobra particular importancia en el ámbito de la evaluación crediticia, donde es crucial para las entidades financieras considerar el historial crediticio, la duración del préstamo y el monto solicitado debido a su impacto decisivo en las decisiones de aprobación o denegación. Por el contrario, factores como el número de teléfono, el estatus de extranjero o la cantidad de dependientes, como evidencia el análisis, no deberían influir significativamente en estas decisiones para evitar sesgar los resultados.
# Predicciones
predicciones <- predict(rf3, test)
# Matriz de confusión
mc <- table(predicciones, test$default)
tabla_kable6 <- kable(mc, format = "html", caption = "Matriz de confusión test") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
tabla_kable6
| No-Default | Si-Default | |
|---|---|---|
| No-Default | 58 | 16 |
| Si-Default | 7 | 19 |
En la evaluación del conjunto de prueba, el modelo mostró una precisión al clasificar 19 verdaderos positivos (TP), 59 verdaderos negativos (TN), 16 falsos positivos (FP) y 6 falsos negativos (FN).
A primera vista, el modelo parece tener un buen desempeño al clasificar correctamente las instancias de “Verdaderos negativos”, pero muestra dificultades en la precisión de las predicciones para las instancias de “verdaderos positivos”. Este aspecto será analizado con mayor detalle a continuación.
#Métricas de evaluación
accuracy <- sum(diag(mc)) / sum(mc)
sensibilidad <- mc[2, 2] / sum(mc[2, ])
especificidad <- mc[1, 1] / sum(mc[1, ])
precision <- mc[2, 2] / sum(mc[, 2])
f1 <- 2 * (precision * sensibilidad) / (precision + sensibilidad)
metricas_df <- data.frame(
Métrica = c("Accuracy", "Sensibilidad", "Especificidad", "Precisión", "F1 Score"),
Valor = c(accuracy, sensibilidad, especificidad, precision, f1)
)
tabla_kable7 <- kable(metricas_df, format = "html", caption = "Métricas de Evaluación del Modelo") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
tabla_kable7
| Métrica | Valor |
|---|---|
| Accuracy | 0.7700000 |
| Sensibilidad | 0.7307692 |
| Especificidad | 0.7837838 |
| Precisión | 0.5428571 |
| F1 Score | 0.6229508 |
Las métricas de evaluación proporcionan una visión más completa del desempeño de este modelo. Con un accuracy del 78%, el modelo clasifica correctamente aproximadamente el 78% de todas las instancias. La sensibilidad del 76% indica la proporción de instancias “Si-Default” correctamente identificadas, mientras que la especificidad del 78.67% destaca la capacidad del modelo para clasificar correctamente las instancias “No-Default”. La precisión del 54.29% refleja la proporción de instancias clasificadas como “Si-Default” que realmente lo son. El F1 Score del 63.33% proporciona una medida equilibrada entre precisión y sensibilidad, consolidando el rendimiento global del modelo en términos de clasificación y discriminación. Estas métricas ofrecen una evaluación detallada y orientación sobre cómo mejorar y ajustar el modelo para optimizar su rendimiento en situaciones del mundo real.
En este ejemplo utilizaremos el dataset Ames Housing disponible en el paquete AmesHousing.
El conjunto de datos Ames Housing recoge de manera exhaustiva información sobre propiedades inmobiliarias en Ames, Iowa, EE. UU. Este conjunto, derivado del estudio de viviendas de Dean De Cock, abarca una amplia gama de variables que describen diversos aspectos de las viviendas. Entre las características más destacadas se encuentran detalles sobre la estructura física, dimensiones del lote, atributos del vecindario y características específicas relacionadas con la calidad y comodidades de las viviendas.
datos <- AmesHousing::make_ames()
Algunas de las variables más relevantes de esta base de datos son:
SalePrice (Numérica): Precio de venta de la vivienda.
LotArea (Numérica): Área del lote en pies cuadrados.
OverallQual (Ordinal): Calidad general de la vivienda en una escala de 1 a 10.
OverallCond (Ordinal): Condición general de la vivienda en una escala de 1 a 10.
YearBuilt (Numérica): Año de construcción de la vivienda.
ExterQual (Ordinal): Calidad del material exterior.
BsmtFinSF1 (Numérica): Área terminada del sótano en pies cuadrados.
TotalBsmtSF (Numérica): Área total del sótano en pies cuadrados.
HeatingQC (Ordinal): Calidad de la calefacción.
CentralAir (Categórica): Si la casa tiene aire acondicionado central (Sí/No).
FullBath (Numérica): Número completo de baños.
HalfBath (Numérica): Número de medio baño.
BedroomAbvGr (Numérica): Número de dormitorios por encima del nivel del sótano.
KitchenQual (Ordinal): Calidad de la cocina.
TotRmsAbvGrd (Numérica): Total de habitaciones por encima del nivel del sótano.
Fireplaces (Numérica): Número de chimeneas.
GarageCars (Numérica): Capacidad del garaje en términos de automóviles.
GarageQual (Ordinal): Calidad del garaje.
Primero, emplearemos rsample para dividir inicialmente los datos en conjuntos de entrenamiento y prueba. Esto se realiza configurando una semilla aleatoria para asegurar que los resultados sean reproducibles.
Usando la función initial_split, asignamos el 70% de las observaciones a ames_train (conjunto de entrenamiento) y el 30% restante a ames_test (conjunto de prueba). Este paso nos permitirá evaluar y validar la efectividad de modelos predictivos en etapas posteriores.
set.seed(123)
ames_split <- initial_split(datos, prop = .7)
ames_train <- training(ames_split)
ames_test <- testing(ames_split)
# RF default model
# Controlamos tiempo de computación
start <- Sys.time()
mod.ames1 <- randomForest( formula = Sale_Price ~ ., data = ames_train)
end <- Sys.time()
time.mod.ames1 <- end - start
time.mod.ames1
## Time difference of 51.26747 secs
mod.ames1
##
## Call:
## randomForest(formula = Sale_Price ~ ., data = ames_train)
## Type of random forest: regression
## Number of trees: 500
## No. of variables tried at each split: 26
##
## Mean of squared residuals: 667302203
## % Var explained: 89.63
plot(mod.ames1)
La graficación del modelo ajustado permite observar cómo varía el error en función del número de árboles. El menor error se alcanza con 280 árboles, con un error medio en la estimación del precio de venta de la vivienda de 2.513587910^{4}.
# Valor de ntree con menor MSE
which.min(mod.ames1$mse)
## [1] 500
# RMSE asociado
sqrt(mod.ames1$mse[which.min(mod.ames1$mse)])
## [1] 25832.19
# Partimos de nuevo el conjunto de entrenamiento
set.seed(123)
train_split <- initial_split(ames_train, .8)
# datos de entrenamiento
ames_train_v2 <- analysis(train_split)
# datos de validación
ames_valid <- assessment(train_split)
x_test <- ames_valid[, names(ames_valid) != "Sale_Price"]
y_test <- ames_valid$Sale_Price
mod.ames1_v2 <- randomForest(formula = Sale_Price ~ ., data = ames_train_v2,
xtest = x_test,
ytest = y_test)
# Extraemos errores OOB y validation
oob <- sqrt(mod.ames1_v2$mse)
validation <- sqrt(mod.ames1_v2$test$mse)
# Graficamos los errores
# install.packages("ggplot2")
library(ggplot2)
tibble::tibble(
`Out of Bag Error` = oob,
`Test error` = validation,
ntrees = 1:mod.ames1_v2$ntree
) %>%
gather(Metric, RMSE, -ntrees) %>%
ggplot(aes(ntrees, RMSE, colour = Metric)) +
geom_line() +
xlab("Number of trees") +
theme_bw()
predictores <- setdiff(names(ames_train), "Sale_Price")
set.seed(123)
mod.ames2 <- tuneRF(
x = ames_train[, predictores],
y = ames_train$Sale_Price,
ntreeTry = 500,
mtryStart = 5,
stepFactor = 1.5,
improve = 0.01,
trace = FALSE
)
## -0.04729558 0.01
## 0.03029417 0.01
## 0.05173748 0.01
## 0.01723089 0.01
## -0.01689652 0.01
En este apartado se compara el tiempo de ejecución de dos métodos para ajustar modelos de Random Forest, utilizando la librería ‘randomForest’ y la librería ‘ranger’.
# velocidad randomForest
time.mod.ames1
## Time difference of 51.26747 secs
# ranger velocidad
## install.packages("ranger")
## install.packages("Rcpp")
library(Rcpp)
##
## Attaching package: 'Rcpp'
## The following object is masked from 'package:rsample':
##
## populate
library(ranger)
## Warning: package 'ranger' was built under R version 4.2.3
##
## Attaching package: 'ranger'
## The following object is masked from 'package:randomForest':
##
## importance
system.time(
ames_ranger <- ranger(
formula = Sale_Price ~ .,
data = ames_train,
num.trees = 500,
mtry = floor(length(predictores)/3)
)
)
## user system elapsed
## 7.64 0.05 2.26
El tiempo de CPU es 11.75 segundos para el usuario, 0.17 segundos para el sistema y el tiempo de reloj transcurrido fue de 4.17 segundos para el proceso completo de entrenamiento del modelo utilizando ranger.
Vamos a testar 96 modelos.
# Construcción del grid
grid <- expand.grid(
mtry = seq(20, 30, by = 2),
nodesize = seq(3, 9, by = 2),
sampsize = c(.55, .632, .70, .80),
OOB_RMSE = 0 # Aquí guardardaremos el error asociado a cada modelo
)
Observa la sintaxis:
for(i in 1:nrow(grid)) {
model <- ranger(
formula = Sale_Price ~ .,
data = ames_train,
num.trees = 500,
mtry = grid$mtry[i],
min.node.size = grid$nodesize[i],
sample.fraction = grid$sampsize[i],
seed = 123
)
# OOB error
grid$OOB_RMSE[i] <- sqrt(model$prediction.error)
}
grid<- grid %>%
dplyr::arrange(OOB_RMSE)
head(grid, 10)
## mtry nodesize sampsize OOB_RMSE
## 1 26 3 0.800 25562.07
## 2 26 5 0.800 25642.20
## 3 30 3 0.800 25643.97
## 4 30 5 0.800 25692.39
## 5 26 7 0.800 25703.74
## 6 30 7 0.800 25714.03
## 7 22 3 0.800 25750.93
## 8 26 9 0.800 25769.61
## 9 26 3 0.632 25782.45
## 10 24 3 0.800 25808.47
De los modelos testados el que presenta menor error de predicción medio a través del OOD error tiene como argumentos , y sample.fraction = grid$sampsize[1]. A continuación estudiamos la incertidumbre asociada a este modelo.
OOB_RMSE <- NULL
for(i in 1:100) {
optimal_ranger <- ranger(
formula = Sale_Price ~ .,
data = ames_train,
num.trees = 500,
mtry = grid$mtry[1],
min.node.size = grid$nodesize[1],
sample.fraction = grid$sampsize[1],
importance = 'impurity'
)
OOB_RMSE <- c(OOB_RMSE, sqrt(optimal_ranger$prediction.error))
}
hist(OOB_RMSE, breaks = 20)
El eje horizontal representa los rangos o intervalos de valores del error OOB, mientras que el vertical indica la frecuencia o cantidad de veces que el error OOB cae dentro de cada intervalo en el eje X.
Observa que durante el ajuste del modelo hemos fijado el argumento importance = ‘impurity’, lo que nos permite evaluar la importancia de los predictores.
A continuación, representaremos gráficamente la importancia de los predictores del modelo, con el objetivo de facilitar su interpretación:
optimal_ranger$variable.importance %>%
broom::tidy() %>%
dplyr::arrange(desc(x)) %>%
dplyr::top_n(25) %>%
ggplot(aes(reorder(names, x), x)) +
geom_col() +
coord_flip() +
theme_bw() +
ggtitle("Top 25 important variables") +
xlab("Importance") +
ylab("Predictores")
## Warning: 'tidy.numeric' is deprecated.
## See help("Deprecated")
## Selecting by x
Como se puede observar, el predictor más influyente es Overall_Qual, el cual destaca significativamente sobre los demás predictores. Le siguen en segundo y tercer lugar las variables Gr_Liv_Area y Garage_Cars. Esta observación tiene una clara relevancia en nuestro contexto de predicción del precio de venta de una vivienda.
# randomForest
pred_randomForest <- predict(mod.ames1, ames_test)
head(pred_randomForest)
## 1 2 3 4 5 6
## 155509.4 189053.1 222860.2 119899.6 166189.2 134961.5
# ranger
pred_ranger <- predict(ames_ranger, ames_test)
head(pred_ranger$predictions)
## [1] 153696.8 189258.7 226992.4 107528.3 164224.5 133864.4
Como se puede observar, para estas seis observaciones, los modelos Random Forest y ranger predicen valores bastante similares en la mayoría de los casos, aunque con algunas diferencias mínimas en la magnitud de las predicciones para ciertas observaciones específicas.
A continuación, vamos a ajustar un modelo basado en Random Forest para el conjunto de datos desequilibrado. Luego, evaluaremos el error de predicción de los mejores modelos en el conjunto de prueba utilizando un umbral de 0,5. Para ello, vamos a generar una muestra aleatoria simple sin reemplazo de tamaño 10.000 a partir de la base de datos original. Para asegurar que los resultados sean reproducibles, fijamos la semilla antes de comenzar el proceso.
#Cargamos los datos
library(readr)
fraud <- read_csv("C:/Users/Maria/Google Drive/2023-24 Técnicas Avanzadas de Predicción en Negocios Gr.BI (36520)/Practica_4/ccFraud.csv")
## Rows: 10000000 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (9): custID, gender, state, cardholder, balance, numTrans, numIntlTrans,...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Seleccionamos 10,000 registros aleatoriamente
library(tidyverse)
set.seed(123)
fraude <- sample_n(fraud, size = 10000, replace = FALSE)
save(fraude, file = "fraude.RData")
rm(fraud)
Recordemos que la base de datos fraude contenía información sobre operaciones con tarjetas de crédito, con 10,000,000 registros y 9 variables:
str(fraude)
## spc_tbl_ [10,000 × 9] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ custID : num [1:10000] 3269750 2782437 7705241 5891675 4691994 ...
## $ gender : num [1:10000] 1 2 2 2 1 1 2 2 2 2 ...
## $ state : num [1:10000] 44 13 44 45 44 35 44 13 32 23 ...
## $ cardholder : num [1:10000] 1 1 2 1 1 1 1 1 1 1 ...
## $ balance : num [1:10000] 2774 0 2977 1403 2000 ...
## $ numTrans : num [1:10000] 5 100 10 96 11 8 77 22 30 31 ...
## $ numIntlTrans: num [1:10000] 0 0 0 0 9 0 0 3 0 3 ...
## $ creditLine : num [1:10000] 7 9 27 2 1 9 4 5 18 4 ...
## $ fraudRisk : num [1:10000] 0 0 0 0 0 0 0 0 0 0 ...
## - attr(*, "spec")=
## .. cols(
## .. custID = col_double(),
## .. gender = col_double(),
## .. state = col_double(),
## .. cardholder = col_double(),
## .. balance = col_double(),
## .. numTrans = col_double(),
## .. numIntlTrans = col_double(),
## .. creditLine = col_double(),
## .. fraudRisk = col_double()
## .. )
## - attr(*, "problems")=<externalptr>
custID: identificador único para cada cliente.
gender: género del cliente, que es una variable binaria de codificación, de manera que toma valor 1 si la transacción la realizó un hombre, y 2 si la realizó una mujer.
state: estado de Estados Unidos donde vive el cliente.
cardholder: número de tarjetas de crédito que posee el cliente.
balance: saldo de la tarjeta de crédito.
numTrans: número de transacciones que ha realizado el cliente hasta la fecha.
numIntTrans: número de transacciones internacionales que ha realizado el cliente hasta la fecha.
creditLine: la empresa de servicios financieros (Visa, MasterCard…).
fraudRisk: variable binaria (1 significa fraude, 0 lo contrario).
set.seed(123)
train_fraude <- fraude[1:7000, ]
test_fraude <- fraude[7001:10000, ]
No utilizaremos todas las variables, ya que algunas no aportan información importante al estudio. En este caso, se ha decidido excluir el identificador único para cada cliente (la variable custID), considerando que no es relevante para la predicción.
# Eliminamos variables
train_f <- train_fraude %>%
dplyr::select(-c(custID))
En este caso, todas las variables de la base de datos son numéricas, por lo que no deberían presentar ningún problema a la hora de modelizar. Sin embargo, al construir el primer modelo, la variable fraudRisk se interpreta como un valor numérico que representa la cantidad de riesgo de fraude. Sin embargo, la variable en realidad indica la presencia o ausencia de fraude (0 si no hay riesgo, 1 si hay riesgo de fraude). Para asegurar que el modelo trate este problema como uno de clasificación, donde se predice la presencia o ausencia de fraude, y no como uno de regresión, convertiremos la variable fraudRisk a factor. Seguiremos el mismo procedimiento con la variable gender.
# Variables factor
train_f$fraudRisk <- as.factor(train_f$fraudRisk)
train_f$gender <- as.factor(train_f$gender)
Comprobamos si hay NAs:
# NAs
NAs <- any(is.na(train_f))
NAs
## [1] FALSE
Como podemos observar, nuestra base de datos no contiene ningún NA, por lo que no realizaremos ninguna modificación al respecto.
Se aplican todos los cambios que se han realizado anteriormente en el conjunto de training al conjunto de test.
# Eliminamos custID
test_f <- test_fraude %>%
dplyr::select(-c(custID))
# Variables factor
test_f$fraudRisk <- as.factor(test_f$fraudRisk)
test_f$gender <- as.factor(test_f$gender)
# Paquete
library(randomForest)
#Modelo básico
set.seed(123)
rf_c1 <-randomForest(fraudRisk ~ ., data = train_f, ntree = 500, type = "classification")
rf_c1
##
## Call:
## randomForest(formula = fraudRisk ~ ., data = train_f, ntree = 500, type = "classification")
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 4.41%
## Confusion matrix:
## 0 1 class.error
## 0 6528 59 0.008957037
## 1 250 163 0.605326877
Este modelo de clasificación Random Forest se ha construido con 500 árboles, seleccionando aleatoriamente 2 variables en cada división para encontrar la mejor partición. El error estimado fuera de la bolsa (OOB - Out Of the Bag) es del 4.41%, lo que significa que se espera que aproximadamente el 4.41% de las predicciones sean incorrectas cuando el modelo se aplica a datos no utilizados en el entrenamiento. En cuanto a la matriz de confusión:
La tasa de error para la clase 0 (ausencia de fraude) es del 0.896%, mientras que para la clase 1 (presencia de fraude) es significativamente más alta, aproximadamente del 60.77%. Esto indica que las predicciones para la clase presencia de fraude tienen un desempeño considerablemente deficiente.
Ahora evaluaremos el error de estimación del test:
# Predicciones
predicciones <- predict(rf_c1, test_f)
# Matriz de confusión
mc_f <- table(predicciones, test_f$fraudRisk)
library(kableExtra)
tabla_kable_c1 <- kable(mc_f, format = "html", caption = "Matriz de confusión test") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
tabla_kable_c1
| 0 | 1 | |
|---|---|---|
| 0 | 2806 | 97 |
| 1 | 29 | 68 |
En este caso, se observa que el modelo clasificó correctamente 28036 instancias “verdaderos negativos” y 68 instancias “verdaderos positivos”. Sin embargo, cometió errores al clasificar 29 instancias “falsos negativos” y 97 instancias “falsos positivos”. El modelo muestra una capacidad relativamente buena para identificar instancias de “no-fraude”, pero tiene dificultades al clasificar instancias de “sí-fraude”.
error_global <- 1 - sum(diag(mc_f)) / sum(mc_f)
error_global
## [1] 0.042
El error global de este modelo es del 4.23%.
#Métricas de evaluación
accuracy <- sum(diag(mc_f)) / sum(mc_f)
sensibilidad <- mc_f[2, 2] / sum(mc_f[2, ])
especificidad <- mc_f[1, 1] / sum(mc_f[1, ])
precision <- mc_f[2, 2] / sum(mc_f[, 2])
f1 <- 2 * (precision * sensibilidad) / (precision + sensibilidad)
metricas_df <- data.frame(
Métrica = c("Accuracy", "Sensibilidad", "Especificidad", "Precisión", "F1 Score"),
Valor = c(accuracy, sensibilidad, especificidad, precision, f1)
)
tabla_kable_c2 <- kable(metricas_df, format = "html", caption = "Métricas de Evaluación del Modelo") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
tabla_kable_c2
| Métrica | Valor |
|---|---|
| Accuracy | 0.9580000 |
| Sensibilidad | 0.7010309 |
| Especificidad | 0.9665863 |
| Precisión | 0.4121212 |
| F1 Score | 0.5190840 |
Con una precisión del 95.8%, el modelo clasifica correctamente aproximadamente el 95.8% de las instancias, lo cual indica una capacidad general sólida. La sensibilidad del 70% resalta la proporción de instancias reales “sí-fraude” que fueron correctamente identificadas, mientras que la especificidad del 96.66% muestra la habilidad del modelo para clasificar correctamente las instancias “no-fraude”. La precisión del 42.21% refleja la proporción de instancias clasificadas como “sí-fraude” que realmente son fraudulentas.
En términos generales, el modelo exhibe competencias aceptables en la clasificación, pero evaluaremos la viabilidad de ajustar los umbrales de clasificación o aplicar métodos adicionales para potenciar la precisión, particularmente en la detección de casos de fraude.
Elegiremos el que genere (de los testados) el menor OOB error.
mtry <- tuneRF(train_f[, names(train_f) != "fraudRisk"], train_f$fraudRisk,
ntreeTry = 500,
stepFactor = 1.5,
improve = 0.01,
trace = TRUE,
plot = TRUE)
## mtry = 2 OOB error = 4.43%
## Searching left ...
## Searching right ...
## mtry = 3 OOB error = 4.6%
## -0.03870968 0.01
El valor 2 produce el mejor error OOB con un 4.4%, lo que sugiere que mtry=2 puede ser la elección más efectiva para minimizar el error OOB y mejorar la capacidad de generalización del modelo Random Forest.
best.m <- mtry[mtry[, 2] == min(mtry[, 2]), 1]
print(mtry)
## mtry OOBError
## 2.OOB 2 0.04428571
## 3.OOB 3 0.04600000
Como podemos observar, tras realizar la comparación el mejor hiperparámetro en este contexto es 2.
set.seed(123)
rf_c2 <- randomForest(fraudRisk ~ ., data = train_f,
mtry = best.m, importance = TRUE, ntree = 500)
print(rf_c2)
##
## Call:
## randomForest(formula = fraudRisk ~ ., data = train_f, mtry = best.m, importance = TRUE, ntree = 500)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 4.43%
## Confusion matrix:
## 0 1 class.error
## 0 6524 63 0.009564293
## 1 247 166 0.598062954
Como se puede notar, los resultados obtenidos son muy parecidos a los del modelo básico, dado que ambos utilizan el mismo valor de mtry. La diferencia entre los modelos es mínima y no se observa una mejora significativa en el rendimiento al emplear el mejor mtry, dado que ya estábamos utilizando ese valor.
varImpPlot(rf_c2)
El “Mean Decrease Accuracy” evalúa la importancia de cada variable al medir cuánto disminuye la precisión del modelo al excluir esa variable en comparación con su inclusión. Variables que causan una mayor disminución en la precisión al ser excluidas se consideran más relevantes para la capacidad predictiva del modelo. Por otro lado, el “Mean Decrease Gini” evalúa cómo cada variable contribuye a reducir la impureza Gini, que mide la homogeneidad de las clases en los nodos del árbol de decisión. Variables con valores más altos en esta métrica tienen una influencia significativa en la capacidad del modelo para distinguir entre las clases, ya que contribuyen de manera crucial a mantener la pureza de los nodos en los árboles de decisión. En este contexto, las variables balance, numTrans y creditLine destacan como las más importantes, ya que influyen tanto en la precisión del modelo como en la reducción del índice de Gini.
# Predicciones
predicciones <- predict(rf_c2, test_f)
# Matriz de confusión
mc_f2 <- table(predicciones, test_f$fraudRisk)
tabla_kable_c3 <- kable(mc_f2, format = "html", caption = "Matriz de confusión test") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
tabla_kable_c3
| 0 | 1 | |
|---|---|---|
| 0 | 2805 | 94 |
| 1 | 30 | 71 |
Se observa que el modelo ha clasificado correctamente 2805 instancias “verdaderos negativos” y 71 instancias “verdaderos positivos”. Sin embargo, ha cometido errores al clasificar 30 instancias “falsos negativos”, y 94 instancias “falsos positivos”.
Calculamos a continuación el error global del modelo:
error_global2 <- 1 - sum(diag(mc_f2)) / sum(mc_f2)
error_global2
## [1] 0.04133333
#Métricas de evaluación
accuracy <- sum(diag(mc_f2)) / sum(mc_f2)
sensibilidad <- mc_f2[2, 2] / sum(mc_f2[2, ])
especificidad <- mc_f2[1, 1] / sum(mc_f2[1, ])
precision <- mc_f2[2, 2] / sum(mc_f2[, 2])
f1 <- 2 * (precision * sensibilidad) / (precision + sensibilidad)
metricas_df <- data.frame(
Métrica = c("Accuracy", "Sensibilidad", "Especificidad", "Precisión", "F1 Score"),
Valor = c(accuracy, sensibilidad, especificidad, precision, f1)
)
tabla_kable_c4 <- kable(metricas_df, format = "html", caption = "Métricas de Evaluación del Modelo") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
tabla_kable_c4
| Métrica | Valor |
|---|---|
| Accuracy | 0.9586667 |
| Sensibilidad | 0.7029703 |
| Especificidad | 0.9675750 |
| Precisión | 0.4303030 |
| F1 Score | 0.5338346 |
Con un nivel de precisión del 95.87%, el modelo logra clasificar correctamente aproximadamente el 95.87% de las instancias, lo que indica una capacidad general sólida. La sensibilidad del 70.3% destaca la proporción de instancias verdaderamente positivas de fraude que el modelo identifica correctamente, mientras que la especificidad del 96.76% muestra su capacidad para clasificar correctamente las instancias que no son fraudulentas. La precisión del 43.03% refleja la proporción de instancias clasificadas como fraude que realmente lo son, proporcionando una medida adicional del rendimiento del modelo en la detección de casos positivos.
Vamos a testar 96 modelos, variando los siguientes hiperparámetros: mtry, nodesize y sampsize.
library(ranger)
# Construcción del grid
grid <- expand.grid(
mtry = seq(2, 7, by = 1),
nodesize = seq(3, 9, by = 2),
sampsize = c(.55, .632, .70, .80),
OOB_RMSE = 0 # Aquí guardardaremos el error asociado a cada modelo
)
for(i in 1:nrow(grid)) {
model <- ranger(
formula = fraudRisk ~ .,
data = train_f,
num.trees = 500,
mtry = grid$mtry[i],
min.node.size = grid$nodesize[i],
sample.fraction = grid$sampsize[i],
seed = 123
)
# OOB error
grid$OOB_RMSE[i] <- sqrt(model$prediction.error)
}
grid<- grid %>%
dplyr::arrange(OOB_RMSE)
head(grid, 10)
## mtry nodesize sampsize OOB_RMSE
## 1 2 5 0.632 0.2070197
## 2 2 9 0.632 0.2070197
## 3 4 9 0.550 0.2077086
## 4 2 3 0.632 0.2077086
## 5 2 9 0.800 0.2077086
## 6 2 3 0.550 0.2080522
## 7 5 9 0.550 0.2080522
## 8 3 7 0.550 0.2083952
## 9 4 7 0.550 0.2083952
## 10 7 9 0.632 0.2083952
De los modelos testados el que presenta menor error de predicción medio a través del OOD error son el #1 (mtry = 2, nodesize = 5, sampsize = 0.632) y el #2 (mtry = 2, nodesize = 9, sampsize = 0.632).
OOB_RMSE <- NULL
for(i in 1:100) {
optimal_ranger <- ranger(
formula = fraudRisk ~ .,
data = train_f,
num.trees = 500,
mtry = grid$mtry[1],
min.node.size = grid$nodesize[1],
sample.fraction = grid$sampsize[1],
importance = 'impurity'
)
OOB_RMSE <- c(OOB_RMSE, sqrt(optimal_ranger$prediction.error))
}
hist(OOB_RMSE, breaks = 20)
optimal_ranger$variable.importance %>%
broom::tidy() %>%
dplyr::arrange(desc(x)) %>%
dplyr::top_n(25) %>%
ggplot(aes(reorder(names, x), x)) +
geom_col() +
coord_flip() +
theme_bw() +
ggtitle("Top important variables") +
xlab("Importance") +
ylab("Predictores")
## Warning: 'tidy.numeric' is deprecated.
## See help("Deprecated")
## Selecting by x
Nuevamente, tal y como sucedía en los anteriores modelos, las variables más importantes son balance, creditLine y numTrans.
# Definición de nuevos hiperparámetros
num_trees <- 500 # Cambia el número de árboles
num_variables <- 2 # Cambia el número de variables a considerar en cada división
min_node_size <- 5 # Cambia el número mínimo de observaciones en un nodo terminal
# Ajuste del modelo con nuevos hiperparámetros
modelo_ranger <- randomForest(
fraudRisk ~ .,
data = train_f,
ntree = num_trees,
mtry = num_variables,
nodesize = min_node_size
)
pred_ranger <- predict(modelo_ranger, test_f)
# Matriz de confusión
ranger_matriz <- table(pred_ranger, test_f$fraudRisk)
library(kableExtra)
tabla_ranger <- kable(ranger_matriz, format = "html", caption = "Matriz de confusión test") %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)
tabla_ranger
| 0 | 1 | |
|---|---|---|
| 0 | 2808 | 92 |
| 1 | 27 | 73 |
En este caso, se observa que el modelo clasificó correctamente 2808 instancias “verdaderos negativos” y 73 instancias “verdaderos positivos”. Sin embargo, cometió errores al clasificar 27 instancias “falsos negativos” y 92 instancias “falsos positivos”. El modelo muestra una capacidad relativamente buena para identificar instancias de “no-fraude”, pero tiene dificultades al clasificar instancias de “sí-fraude”.
Mostramos a continuación el error del modelo:
error_global3 <- 1 - sum(diag(ranger_matriz)) / sum(ranger_matriz)
error_global3
## [1] 0.03966667
Durante esta práctica sobre árboles de decisión y ensambles, se exploraron y compararon diversos modelos, incluyendo rpart (CART), random forest y ranger. Se realizó una evaluación exhaustiva mediante la manipulación de parámetros clave como minsplit, minbucket, maxdepth y cp, utilizando validación cruzada con una métrica adecuada para el problema específico. La elección de la métrica se basó en argumentos sólidos sobre su relevancia y capacidad para medir la calidad del modelo en términos de predicción y generalización.
Además, se ajustó un modelo de Random Forest para abordar un conjunto de datos desequilibrado, probando múltiples configuraciones para encontrar la más adecuada. Esta exploración proporcionó una comprensión detallada de cómo Random Forest responde a diferentes ajustes en términos de rendimiento y robustez. En la fase final de evaluación, se utilizó un conjunto de prueba independiente que comprendía el 30% de los datos totales, generado con una semilla específica para garantizar la reproducibilidad. Se empleó un umbral de 0.5 para evaluar el error de predicción de los modelos más prometedores, con un enfoque especial en los errores de falsos positivos y falsos negativos, aspectos críticos que afectan significativamente la aplicabilidad práctica de los modelos.