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.[@hernandez_modelos_2020] [@hernández2021]

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(1307)
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
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
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
19 No 29.86 Yes No No 0 0 Yes Female 75-79 Black Yes No Fair 5 No Yes 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
23 No 26.17 Yes No No 0 15 No Female 45-49 White No Yes Very good 6 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
3 No 26.58 Yes No No 20 30 No Male 65-69 White Yes Yes Fair 8 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
22 No 28.90 No No No 2 5 No Female 70-74 White Yes No Very good 7 No No No
24 No 25.82 Yes No No 0 30 No Male 80 or older White Yes Yes Fair 8 No No No
29 No 24.89 No No No 1 0 No Female 55-59 White No Yes Very good 7 No No No
32 No 30.67 No No No 4 4 Yes Female 80 or older White No Yes Fair 8 Yes No No
37 No 24.62 No No No 5 0 No Female 80 or older White No Yes Good 6 No No No
38 No 20.43 Yes No No 3 3 No Female 65-69 White No Yes Fair 5 Yes No Yes
39 No 27.37 Yes No No 0 0 No Female 80 or older White No No Very good 8 No No No
45 No 30.34 Yes No No 30 10 Yes Male 55-59 White No, borderline diabetes No Fair 6 No No No
54 No 32.61 Yes No No 0 0 No Female 65-69 White No Yes Very good 7 No No No
57 No 32.55 Yes No No 0 0 No Male 75-79 White No No Very good 8 No No No
59 No 29.55 No No No 0 0 No Male 70-74 White Yes Yes Good 7 No No No
62 No 21.03 No No No 1 0 No Female 80 or older White No Yes Excellent 8 No No No
68 No 22.04 No No No 0 0 No Male 65-69 White No Yes Very good 8 No No No
73 No 33.75 No No No 0 5 No Male 50-54 White Yes Yes Good 10 Yes No No
78 Yes 34.33 No No No 0 0 No Female 55-59 White No Yes Good 8 No No No
84 No 28.25 No No No 0 3 Yes Male 75-79 White No Yes Good 8 No No No
86 No 23.78 No No No 0 5 No Female 70-74 White No Yes Excellent 8 No No No
89 No 32.81 Yes No No 0 0 Yes Female 70-74 White Yes Yes Good 5 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: 53.97  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: 9.35%
## Confusion matrix:
##       No Yes class.error
## No  3696  29 0.007785235
## Yes  354  17 0.954177898

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
3 No No
9 No No
22 No No
24 No No
29 No No
32 No No
37 No No
38 No No
39 No No
45 No No
54 No No
57 No No
59 No No
62 No No
68 No No
73 No No
78 Yes No
84 No No
86 No No
89 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  58123   361
##        Yes  5153   321
##                                          
##                Accuracy : 0.9138         
##                  95% CI : (0.9116, 0.916)
##     No Information Rate : 0.9893         
##     P-Value [Acc > NIR] : 1              
##                                          
##                   Kappa : 0.087          
##                                          
##  Mcnemar's Test P-Value : <2e-16         
##                                          
##             Sensitivity : 0.91856        
##             Specificity : 0.47067        
##          Pos Pred Value : 0.99383        
##          Neg Pred Value : 0.05864        
##              Prevalence : 0.98934        
##          Detection Rate : 0.90877        
##    Detection Prevalence : 0.91441        
##       Balanced Accuracy : 0.69462        
##                                          
##        '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 realiza el caso con una semilla de 1307, y se emplea el modelo de bosques aleatorios con una division de 80/20.

El valor de precision es de 91.38% algo que sigue estando acorde con el resto de modelos probados con los casos anteriores.

Tiene 5153 falsos positivos y 361 falsos negativos, este modelo mantiene la tendencia de tener mas falsos positivos que negativos algo que ya se ha visto en casos pasados. De igual manera, el modelo sigue superando el nivel de 70% establecido para definirlo como valido.

Este modelo en mi opinion se puede considerar rapido en comparacion de los otros mostrados en casos anteriores.

6 Bibliografía