1 Objetivo

Implementar el modelo de bosques aleatorios (random forest (RF) con programación R para resolver la tarea de clasificación de una condición de salud de las personas mediante predicción de anomalías de corazón evaluando la exactitud del modelo mediante la matriz de confusión.

2 Descripción

Se cargan librerías y se descargan los datos: https://raw.githubusercontent.com/rpizarrog/Analisis-Inteligente-de-datos/main/datos/heart_2020_cleaned.csv

Los datos están relacionados con aspectos médicos y son valores categóricos y numéricos de varias variables que caracterizan el estado de salud de 319795 personas.

Se construye un modelo supervisado basado en el algoritmo de bosques aleatorio (RF) para resolver la tarea de clasificación binaria e identificar si una persona padece del corazón o no.

Se construyen datos de entrenamiento y validación al 80% y 20% cada uno.

Se toma una muestra al 99% de confianza con un margen de error del 2% de los datos de entrenamiento para construir el modelo.

Se desarrollan los modelos de:

  • Regresión Logística binaria

  • Árbol de Clasificación tipo class

  • KNN Vecinos mas cercanos

  • SVM Lineal

  • SVM Polinomial

  • SVM Radial

  • Bosques aleatorios. Random Forest

El modelo se acepta si tienen un valor de exactitud = accuracy por encima del 70%.

3 Fundamento teórico

Random Forest o Bosques Aleatorios fue propuesto por (Ho 1995) y consiste en crear muchos árboles para luego usarlos en la predicción de la variable de interés. A continuación se muestra una ilustración de la técnica.(Hernández 2020) (Hernández 2021)

4 Desarrollo

4.1 Cargar librerías

library(knitr) # Para ver tablas mas amigables en formato html markdown
library(ggplot2) # Gráficas

library(dplyr) # Varias operaciones 

library(caret) # Para particionar datos de entranamiento y de validación

library(randomForest) # Para modelo bosques

library(plotly) # Para gráficas interactivas

4.2 Cargar datos

Cargar datos de manera local o con URL.

Se cargan dos conjuntos de datos datos1 y dato2, ambos contienen la misma información solo que el segundo es la transformación a valores numéricos de los valores categóricos de datos1.

datos_cat <- read.csv("https://raw.githubusercontent.com/rpizarrog/Machine-Learning-con-R/main/datos/heart_2020_cleaned.csv", stringsAsFactors = TRUE, encoding = "UTF-8")

4.3 Explorar datos

Son 319795 registros y 18 variables. El 80% serán datos de entrenamiento y el 20% serán datos de validación.

La variable HeartDisease es de tipo factor y tiene dos niveles “No” y “Yes”.

4.3.1 Estructura de los datos

str(datos_cat)
## 'data.frame':    319795 obs. of  18 variables:
##  $ HeartDisease    : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 2 1 1 1 1 ...
##  $ BMI             : num  16.6 20.3 26.6 24.2 23.7 ...
##  $ Smoking         : Factor w/ 2 levels "No","Yes": 2 1 2 1 1 2 1 2 1 1 ...
##  $ AlcoholDrinking : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
##  $ Stroke          : Factor w/ 2 levels "No","Yes": 1 2 1 1 1 1 1 1 1 1 ...
##  $ PhysicalHealth  : num  3 0 20 0 28 6 15 5 0 0 ...
##  $ MentalHealth    : num  30 0 30 0 0 0 0 0 0 0 ...
##  $ DiffWalking     : Factor w/ 2 levels "No","Yes": 1 1 1 1 2 2 1 2 1 2 ...
##  $ Sex             : Factor w/ 2 levels "Female","Male": 1 1 2 1 1 1 1 1 1 2 ...
##  $ AgeCategory     : Factor w/ 13 levels "18-24","25-29",..: 8 13 10 12 5 12 11 13 13 10 ...
##  $ Race            : Factor w/ 6 levels "American Indian/Alaskan Native",..: 6 6 6 6 6 3 6 6 6 6 ...
##  $ Diabetic        : Factor w/ 4 levels "No","No, borderline diabetes",..: 3 1 3 1 1 1 1 3 2 1 ...
##  $ PhysicalActivity: Factor w/ 2 levels "No","Yes": 2 2 2 1 2 1 2 1 1 2 ...
##  $ GenHealth       : Factor w/ 5 levels "Excellent","Fair",..: 5 5 2 3 5 2 2 3 2 3 ...
##  $ SleepTime       : num  5 7 8 6 8 12 4 9 5 10 ...
##  $ Asthma          : Factor w/ 2 levels "No","Yes": 2 1 2 1 1 1 2 2 1 1 ...
##  $ KidneyDisease   : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 2 1 ...
##  $ SkinCancer      : Factor w/ 2 levels "No","Yes": 2 1 1 2 1 1 2 1 1 1 ...
# summary(datos_cat)

4.3.2 Primeros datos categóricos

kable(x = head(datos_cat, 10), caption = "Primeros diez registros datos con valores categóricos")
Primeros diez registros datos con valores categóricos
HeartDisease BMI Smoking AlcoholDrinking Stroke PhysicalHealth MentalHealth DiffWalking Sex AgeCategory Race Diabetic PhysicalActivity GenHealth SleepTime Asthma KidneyDisease SkinCancer
No 16.60 Yes No No 3 30 No Female 55-59 White Yes Yes Very good 5 Yes No Yes
No 20.34 No No Yes 0 0 No Female 80 or older White No Yes Very good 7 No No No
No 26.58 Yes No No 20 30 No Male 65-69 White Yes Yes Fair 8 Yes No No
No 24.21 No No No 0 0 No Female 75-79 White No No Good 6 No No Yes
No 23.71 No No No 28 0 Yes Female 40-44 White No Yes Very good 8 No No No
Yes 28.87 Yes No No 6 0 Yes Female 75-79 Black No No Fair 12 No No No
No 21.63 No No No 15 0 No Female 70-74 White No Yes Fair 4 Yes No Yes
No 31.64 Yes No No 5 0 Yes Female 80 or older White Yes No Good 9 Yes No No
No 26.45 No No No 0 0 No Female 80 or older White No, borderline diabetes No Fair 5 No Yes No
No 40.69 No No No 0 0 Yes Male 65-69 White No Yes Good 10 No No No

4.4 Limpiar datos

Se trabajará con el conjunto de datos datos_cat, los datos ya vienen preparados y limpios.

4.5 Las variables de interés

Todas las variables son de entrada o variables independientes:

  • “BMI”: Indice de masa corporal con valores entre 12.02 y 94.85.

  • “Smoking”: Si la persona es fumadora o no con valores categóritos de ‘Yes’ o ‘No’. [1 | 2]

  • “AlcoholDrinking” : Si consume alcohol o no, con valores categóricos de ‘Yes’ o ‘No’.[1 | 2]

  • “Stroke”: Si padece alguna anomalía cerebrovascular, apoplejia o algo similar, con valores categóricos de ‘Yes’ o ‘No’. [1 | 2]

  • “PhysicalHealth” Estado físico en lo general con valores entre 0 y 30.

  • “MentalHealth”. Estado mental en lo general con valores entre 0 y 30.

  • “DiffWalking” . Que si se le dificulta caminar o tiene algún padecimiento al caminar, con valores categóritoc de ‘Yes’ o ‘No’.[1 | 2]

  • “Sex”: Género de la persona, con valores de ‘Female’ y ‘Male’ para distinguir al género femenino y masculino respectivamente. [1 | 2]

  • “AgeCategory”: Una clasificación de la edad de la persona de entre 18 y 80 años. La primera categoría con un rango de edad entre 18-24, a partir de 25 con rangos de 5 en 5 hasta la clase de 75-80 y una última categoría mayores de 80 años. [1 - 13]

  • “Race”. Raza u origen de la persona con valores categóricos de ‘American Indian/Alaskan Native’, ’Asian’,’Black’, ’Hispanic’, ’Other’ y’White’. [1 - 6]

  • “Diabetic”. Si padece o ha padecido de diabetes en cuatro condiciones siendo Yes y No para si o no: ‘No’, ‘borderline diabetes’ condición antes de detectarse diabetes tipo 2, ‘Yes’, y ‘Yes (during pregnancy)’ durante embarazo. [1 - 4]

  • “PhysicalActivity” que si realiza actividad física, con valores categóricos de ‘Yes’ o ‘No’. [1 | 2]

  • “GenHealth”: EStado general de salud de la persona con valores categóricos de ‘Excellent’, ‘Very good’, ‘Good’, ‘Fair’ y ‘Poor’ con significado en español de excelente, muy buena, buena, regular y pobre o deficiente. [1 - 5]

  • “SleepTime”: valor numérico de las horas de sueño u horas que duerme la persona con valores en un rango entre 1 y 24.

  • “Asthma”: si padece de asma o no, con valores categóricos de ‘Yes’ o ‘No’. [1 | 2].

  • “KidneyDisease”: si tiene algún padecimiento en los riñones, con valores categóricos de ‘Yes’ o ‘No’. [1 | 2].

  • “SkinCancer”: si padece algún tipo de cáncer de piel, con valores categóricos de ‘Yes’ o ‘No’. [1 | 2].

  • La variable de interés como dependiente o variable de salida es la de daño al corazón (HeartDisease), con valores categóricos de ‘Yes’ o ‘No’. Ahora con la variable

4.6 Datos de entrenamiento y validación

Se parten los datos en en datos de entrenamiento con el 80% y datos de validación con el 20%.

set.seed(2022)
entrena <- createDataPartition(y = datos_cat$HeartDisease, 
                               p = 0.8, 
                               list = FALSE, 
                               times = 1)
# Datos entrenamiento
datos.entrenamiento <- datos_cat[entrena, ]  # [renglones, columna]
# Datos validación
datos.validacion <- datos_cat[-entrena, ]

4.6.1 Datos de entrenamiento

Se muestran los primeros 20 registros datos de entrenamiento. Son 255,836 observaciones en datos de entrenamiento que representa el 80% del total de los datos

paste("Registros en datos de entrenamiento: ", nrow(datos.entrenamiento))
## [1] "Registros en datos de entrenamiento:  255837"
kable(head(datos.entrenamiento, 20), caption = "Primeros 20 registros de datos de entrenamiento")
Primeros 20 registros de datos de entrenamiento
HeartDisease BMI Smoking AlcoholDrinking Stroke PhysicalHealth MentalHealth DiffWalking Sex AgeCategory Race Diabetic PhysicalActivity GenHealth SleepTime Asthma KidneyDisease SkinCancer
1 No 16.60 Yes No No 3 30 No Female 55-59 White Yes Yes Very good 5 Yes No Yes
2 No 20.34 No No Yes 0 0 No Female 80 or older White No Yes Very good 7 No No No
3 No 26.58 Yes No No 20 30 No Male 65-69 White Yes Yes Fair 8 Yes No No
4 No 24.21 No No No 0 0 No Female 75-79 White No No Good 6 No No Yes
5 No 23.71 No No No 28 0 Yes Female 40-44 White No Yes Very good 8 No No No
6 Yes 28.87 Yes No No 6 0 Yes Female 75-79 Black No No Fair 12 No No No
7 No 21.63 No No No 15 0 No Female 70-74 White No Yes Fair 4 Yes No Yes
8 No 31.64 Yes No No 5 0 Yes Female 80 or older White Yes No Good 9 Yes No No
9 No 26.45 No No No 0 0 No Female 80 or older White No, borderline diabetes No Fair 5 No Yes No
10 No 40.69 No No No 0 0 Yes Male 65-69 White No Yes Good 10 No No No
11 Yes 34.30 Yes No No 30 0 Yes Male 60-64 White Yes No Poor 15 Yes No No
12 No 28.71 Yes No No 0 0 No Female 55-59 White No Yes Very good 5 No No No
13 No 28.37 Yes No No 0 0 Yes Male 75-79 White Yes Yes Very good 8 No No No
14 No 28.15 No No No 7 0 Yes Female 80 or older White No No Good 7 No No No
15 No 29.29 Yes No No 0 30 Yes Female 60-64 White No No Good 5 No No No
16 No 29.18 No No No 1 0 No Female 50-54 White No Yes Very good 6 No No No
17 No 26.26 No No No 5 2 No Female 70-74 White No No Very good 10 No No No
18 No 22.59 Yes No No 0 30 Yes Male 70-74 White No, borderline diabetes Yes Good 8 No No No
20 No 18.13 No No No 0 0 No Male 80 or older White No Yes Excellent 8 No No Yes
21 No 21.16 No No No 0 0 No Female 80 or older Black No, borderline diabetes No Good 8 No No No

4.6.2 Datos de validación

Se muestran los primeros 20 registros de datos de validación . Son 63,959 observaciones en datos de validación que representa el 20% del total de los datos

paste("Registros en datos de validación: ", nrow(datos.validacion))
## [1] "Registros en datos de validación:  63958"
kable(head(datos.validacion, 20), caption = "Primeros 20 registros de datos de validación")
Primeros 20 registros de datos de validación
HeartDisease BMI Smoking AlcoholDrinking Stroke PhysicalHealth MentalHealth DiffWalking Sex AgeCategory Race Diabetic PhysicalActivity GenHealth SleepTime Asthma KidneyDisease SkinCancer
19 No 29.86 Yes No No 0 0 Yes Female 75-79 Black Yes No Fair 5 No Yes No
25 No 25.75 No No No 0 0 No Female 80 or older White No Yes Very good 6 No No Yes
27 No 34.34 Yes No No 21 8 Yes Female 65-69 White No Yes Fair 9 No No No
30 No 36.58 No No No 0 0 No Female 60-64 White Yes No Good 5 No No Yes
43 Yes 25.06 No No No 0 0 Yes Female 80 or older White Yes No Good 7 No No Yes
47 No 33.23 No No No 0 0 No Male 65-69 White Yes Yes Very good 8 No No No
48 No 25.11 No No No 5 5 No Female 65-69 Black No Yes Good 7 No No No
55 No 32.10 No No No 14 0 No Male 65-69 White Yes Yes Very good 9 No No No
60 No 27.20 Yes No Yes 0 0 No Male 80 or older White No No Very good 8 No No Yes
61 No 28.94 Yes No No 0 0 No Female 70-74 White Yes Yes Good 5 Yes No No
62 No 21.03 No No No 1 0 No Female 80 or older White No Yes Excellent 8 No No No
64 No 31.46 Yes No No 0 0 No Male 75-79 White No Yes Very good 8 No No No
72 No 27.76 Yes No No 15 0 Yes Female 80 or older White No No Good 8 Yes No No
74 No 30.23 No No No 0 5 No Female 65-69 White No Yes Good 6 No No No
79 Yes 28.29 Yes No No 30 30 No Female 70-74 White Yes Yes Poor 9 No Yes No
89 No 32.81 Yes No No 0 0 Yes Female 70-74 White Yes Yes Good 5 No No No
91 No 44.29 No No No 30 10 Yes Female 70-74 White No No Fair 7 No No Yes
93 No 21.80 Yes No No 0 0 No Female 75-79 White No Yes Very good 8 No No Yes
99 No 24.37 No No No 0 0 No Female 55-59 White No Yes Very good 7 Yes No No
111 No 26.63 No No No 0 0 No Female 75-79 Black Yes Yes Good 8 No No No

4.6.3 Tamaño de muestra

Dado que la estimación del costo consume recursos de procesamiento, sobre todo tiempo, se calcula una muestra estimada al 99% y 2% de margen de error, Siendo 255,836 registros en los datos de entrenamiento, la cantidad de muestra estimada debe ser 4,024 observaciones.

\[ n=\frac{Z^2_{_{\alpha/2}}Npq}{e^2(N-1)+Z^2_{_{\alpha/2}}pq} \]

set.seed(2020)
n <- 4096
muestra <- sample(x = 1:nrow(datos.entrenamiento), size = n, replace = FALSE)

4.7 Modelos de clasificación Random Forest (RF)

La expresión HeartDisease ~ . significa que la variable dependiente es HeartDsiease y que depende de todas las variables independientes.

Esto es similar a declarar la fórmula como HeartDsiease ~ BMI+ Smoking+ AlcoholDrinking+ Stroke+ PhysicalHealth+ MentalHealth+ DiffWalking+ Sex+ AgeCategory+ Race+ Diabetic+ PhysicalActivity+ GenHealth+ SleepTime+ Asthma+ KidneyDisease+ SkinCancer.

Se utiliza la muestra con 4096 registros para construir el modelo.

El modelo se construye con un valor de ntree igual a 1000 (se probó con 400, 500 y 1000) árboles,.

Se utiliza con valor igual mtry igual 4 que significa las variables que de manera aleatoria participan en las ramificaciones; este valor se determina conforme a la recomendación de la ayuda de la función de que sea aproximadamente la raíz cuadrada del número de columnas de los datos que participan en la construcción del modelo. Fueron 18 variables entonces aproximadamente y/o redondeado la raíz cuadrada es cuatro.

Se toma el tiempo para procesar la construcción de modelo.

set.seed(2020)
t_inicial <- proc.time()[3]

modelo_rf <- randomForest(HeartDisease ~ ., data=datos.entrenamiento[muestra, ], 
                      ntree=1000, mtry=4,
                      proximity=TRUE)

t_final <- proc.time()[3] - t_inicial

paste("Tiempo procesamiento con ", n, " registros, fue de:", round(t_final, 2), " segundos")
## [1] "Tiempo procesamiento con  4096  registros, fue de: 42.12  segundos"
modelo_rf
## 
## Call:
##  randomForest(formula = HeartDisease ~ ., data = datos.entrenamiento[muestra,      ], ntree = 1000, mtry = 4, proximity = TRUE) 
##                Type of random forest: classification
##                      Number of trees: 1000
## No. of variables tried at each split: 4
## 
##         OOB estimate of  error rate: 8.89%
## Confusion matrix:
##       No Yes class.error
## No  3701  33 0.008837708
## Yes  331  31 0.914364641

4.7.1 Predicciones random forest

predicciones <- predict(object = modelo_rf, datos.validacion)

4.7.2 Evaluación del modelo

4.7.2.1 Construir matriz de comparación

datos.comparar <- data.frame("real" = datos.validacion$HeartDisease, "predicho" = predicciones)

kable(head(datos.comparar, 20), caption = "Datos a comparar previo a matriz de confusión" )
Datos a comparar previo a matriz de confusión
real predicho
19 No No
25 No No
27 No No
30 No No
43 Yes No
47 No No
48 No No
55 No No
60 No No
61 No No
62 No No
64 No No
72 No No
74 No No
79 Yes No
89 No No
91 No No
93 No No
99 No No
111 No No

4.7.2.2 Matriz de confusión

matriz <- confusionMatrix(datos.comparar$real, datos.comparar$predicho)

matriz
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    No   Yes
##        No  57982   502
##        Yes  5007   467
##                                          
##                Accuracy : 0.9139         
##                  95% CI : (0.9117, 0.916)
##     No Information Rate : 0.9848         
##     P-Value [Acc > NIR] : 1              
##                                          
##                   Kappa : 0.1224         
##                                          
##  Mcnemar's Test P-Value : <2e-16         
##                                          
##             Sensitivity : 0.92051        
##             Specificity : 0.48194        
##          Pos Pred Value : 0.99142        
##          Neg Pred Value : 0.08531        
##              Prevalence : 0.98485        
##          Detection Rate : 0.90656        
##    Detection Prevalence : 0.91441        
##       Balanced Accuracy : 0.70123        
##                                          
##        'Positive' Class : No             
##

Se tiene un valor de accuracy = exactitud de 0.9139 o de \(91.39\%\) que significa que el modelo le atina en la predicción o clasificación aproximadamente al 91% de cada 100 casos procesados.

4.7.2.3 Predecir un caso nuevo

Se crea un registro de una persona con ciertas condiciones de salud.

# HeartDisease = 'No'
BMI <- 38
Smoking <- 'Yes'
AlcoholDrinking = 'Yes'
Stroke <- 'Yes'
PhysicalHealth <- 2
MentalHealth = 5
DiffWalking = 'Yes'
Sex = 'Male'
AgeCategory = '70-74'
Race = 'Black'
Diabetic <- 'Yes'
PhysicalActivity = "No"
GenHealth = "Fair"
SleepTime = 12
Asthma = "Yes"
KidneyDisease = "Yes"
SkinCancer = 'No'
persona <- data.frame(BMI,Smoking, AlcoholDrinking, Stroke, PhysicalHealth, MentalHealth, DiffWalking, Sex, AgeCategory, Race, Diabetic, PhysicalActivity, GenHealth, SleepTime, Asthma, KidneyDisease, SkinCancer)
persona
##   BMI Smoking AlcoholDrinking Stroke PhysicalHealth MentalHealth DiffWalking
## 1  38     Yes             Yes    Yes              2            5         Yes
##    Sex AgeCategory  Race Diabetic PhysicalActivity GenHealth SleepTime Asthma
## 1 Male       70-74 Black      Yes               No      Fair        12    Yes
##   KidneyDisease SkinCancer
## 1           Yes         No

Convertir a factores las variables tipo char para que el modelo entienda que precisamente son de tipo factor y tienen sus niveles. Se convierte al mismo tipo que los datos de validación para cada variable de tipo char de la persona.

persona$Smoking <- factor(persona$Smoking, levels = levels(datos.validacion$Smoking))

persona$AlcoholDrinking <- factor(persona$AlcoholDrinking, levels = levels(datos.validacion$AlcoholDrinking))

persona$Stroke <- factor(persona$Stroke, levels = levels(datos.validacion$Stroke))

persona$DiffWalking <- factor(persona$DiffWalking, levels = levels(datos.validacion$DiffWalking))

persona$Sex <- factor(persona$Sex, levels = levels(datos.validacion$Sex))

persona$AgeCategory <- factor(persona$AgeCategory, levels = levels(datos.validacion$AgeCategory))

persona$Race <- factor(persona$Race, levels = levels(datos.validacion$Race))

persona$Diabetic <- factor(persona$Diabetic, levels = levels(datos.validacion$Diabetic))

persona$PhysicalActivity <- factor(persona$PhysicalActivity, levels = levels(datos.validacion$PhysicalActivity))


persona$GenHealth <- factor(persona$GenHealth, levels = levels(datos.validacion$GenHealth))


persona$Asthma <- factor(persona$Asthma, levels = levels(datos.validacion$Asthma))

persona$KidneyDisease <- factor(persona$KidneyDisease, levels = levels(datos.validacion$KidneyDisease))

persona$SkinCancer <- factor(persona$SkinCancer, levels = levels(datos.validacion$SkinCancer))

Se hace la predicción con estos valores:

La predicción a la condición de la persona es:

prediccion <- predict(object = modelo_rf, newdata = persona, type = "class")
prediccion
##  1 
## No 
## Levels: No Yes

‘No’: No tiene daño al corazón

5 Interpretación

Se construyeron tres modelos de clasificación con el algoritmo de random forest o bosques aleatorios

Para construir los modelo se trabajó con una muestra al 99% de confianza con un margen de error del 2% de los datos de entrenamiento; esto se hizo porque el tiempo de procesamiento con todos los registros de los datos de entrenamiento era muy tardado, razón por la cual se utilizó una muestra de 4,024 registros en lugar de las 255,877 observaciones.

En valor de la exactitud accuracy y de acuerdo a la matriz de confusión fue de aproximadamente del 91.44% que significa que el modelo le atina aproximadamente a 91 de cada 100 registros.

Bibliografía

Hernández, Freddy. 2020. Modelos Predictivos. https://fhernanb.github.io/libro_mod_pred/.
———. 2021. Modelos Predictivos. https://fhernanb.github.io/libro_mod_pred/;