Implementar el modelo de árbol de clasificación con datos relacionados a una condición de salud de las personas para predecir anomalías de corazón y evaluar la exactitud del modelo mediante la matriz de confusió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 numéricos de varias variables que caracterizan el estado de salud de 319,795 personas.
Se construye un modelo supervisado basado en el algoritmo de árbol de clasificación 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 desarrollan los modelos de:
Regresión Logística binaria
Árbol de Clasificación tipo class
K Means
SVM Lineal
SVM Polinomial
SVM Radial
Los modelo se aceptan si tienen un valor de exactitud por encima del 70%..
library(readr)
library(dplyr)
library(caret)
library(rpart)
library(rpart.plot)
library(knitr)
library(e1071) # Vectores de Soporte SVM
library(rpart) # Arboles de clasificación
Cargar datos de manera local.
datos <- read.csv("https://raw.githubusercontent.com/rpizarrog/Machine-Learning-con-R/main/datos/heart_2020_cleaned.csv")
str(datos)
## 'data.frame': 319795 obs. of 18 variables:
## $ HeartDisease : chr "No" "No" "No" "No" ...
## $ BMI : num 16.6 20.3 26.6 24.2 23.7 ...
## $ Smoking : chr "Yes" "No" "Yes" "No" ...
## $ AlcoholDrinking : chr "No" "No" "No" "No" ...
## $ Stroke : chr "No" "Yes" "No" "No" ...
## $ 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 : chr "No" "No" "No" "No" ...
## $ Sex : chr "Female" "Female" "Male" "Female" ...
## $ AgeCategory : chr "55-59" "80 or older" "65-69" "75-79" ...
## $ Race : chr "White" "White" "White" "White" ...
## $ Diabetic : chr "Yes" "No" "Yes" "No" ...
## $ PhysicalActivity: chr "Yes" "Yes" "Yes" "No" ...
## $ GenHealth : chr "Very good" "Very good" "Fair" "Good" ...
## $ SleepTime : num 5 7 8 6 8 12 4 9 5 10 ...
## $ Asthma : chr "Yes" "No" "Yes" "No" ...
## $ KidneyDisease : chr "No" "No" "No" "No" ...
## $ SkinCancer : chr "Yes" "No" "No" "Yes" ...
summary(datos)
## HeartDisease BMI Smoking AlcoholDrinking
## Length:319795 Min. :12.02 Length:319795 Length:319795
## Class :character 1st Qu.:24.03 Class :character Class :character
## Mode :character Median :27.34 Mode :character Mode :character
## Mean :28.33
## 3rd Qu.:31.42
## Max. :94.85
## Stroke PhysicalHealth MentalHealth DiffWalking
## Length:319795 Min. : 0.000 Min. : 0.000 Length:319795
## Class :character 1st Qu.: 0.000 1st Qu.: 0.000 Class :character
## Mode :character Median : 0.000 Median : 0.000 Mode :character
## Mean : 3.372 Mean : 3.898
## 3rd Qu.: 2.000 3rd Qu.: 3.000
## Max. :30.000 Max. :30.000
## Sex AgeCategory Race Diabetic
## Length:319795 Length:319795 Length:319795 Length:319795
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## PhysicalActivity GenHealth SleepTime Asthma
## Length:319795 Length:319795 Min. : 1.000 Length:319795
## Class :character Class :character 1st Qu.: 6.000 Class :character
## Mode :character Mode :character Median : 7.000 Mode :character
## Mean : 7.097
## 3rd Qu.: 8.000
## Max. :24.000
## KidneyDisease SkinCancer
## Length:319795 Length:319795
## Class :character Class :character
## Mode :character Mode :character
##
##
##
No es necesario alguna transformación
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’.
“AlcoholDrinking” : Si consume alcohol o no, con valores categóricos de ‘Yes’ o ‘No’.
“Stroke”: Si padece alguna anomalía cerebrovascular, apoplejia o algo similar, con valores categóricos de ‘Yes’ o ‘No’.
“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’.
“Sex”: Género de la persona, con valores de ‘Female’ y ‘Male’ para distinguir al género femenino y masculino respectivamente.
“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.
“Race”. Raza u origen de la persona con valores categóricos de ‘American Indian/Alaskan Native’, ’Asian’,’Black’, ’Hispanic’, ’Other’ y’White’.
“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.
“PhysicalActivity” que si realiza actividad física, con valores categóricos de ‘Yes’ o ‘No’.
“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.
“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’.
“KidneyDisease”: si tiene algún padecimiento en los riñones, con valores categóricos de ‘Yes’ o ‘No’.
“SkinCancer”: si padece algún tipo de cáncer de piel, con valores categóricos de ‘Yes’ o ‘No’.
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’.
Se parten los datos en en datos de entrenamiento con el 80% y datos de validación con el 20%.
set.seed(1270)
entrena <- createDataPartition(y = datos$HeartDisease,
p = 0.8,
list = FALSE,
times = 1)
# Datos entrenamiento
datos.entrenamiento <- datos[entrena, ] # [renglones, columna]
# Datos validación
datos.validacion <- datos[-entrena, ]
Se muestran los primeros 20 registros datos de entrenamiento
kable(head(datos.entrenamiento, 20), caption = "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 |
| 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 |
| 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 |
| 22 | No | 28.90 | No | No | No | 2 | 5 | No | Female | 70-74 | White | Yes | No | Very good | 7 | No | No | No |
Se muestran los primeros 20 registros de datos de validación .
kable(head(datos.validacion, 20), caption = "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 | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 10 | No | 40.69 | No | No | No | 0 | 0 | Yes | Male | 65-69 | White | No | Yes | Good | 10 | 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 |
| 23 | No | 26.17 | Yes | No | No | 0 | 15 | No | Female | 45-49 | White | No | Yes | Very good | 6 | No | No | No |
| 26 | No | 29.18 | Yes | No | No | 30 | 30 | Yes | Female | 60-64 | White | No | No | Poor | 6 | Yes | No | No |
| 33 | No | 45.35 | No | No | No | 30 | 0 | Yes | Male | 70-74 | White | Yes | No | Good | 8 | No | No | No |
| 39 | No | 27.37 | Yes | No | No | 0 | 0 | No | Female | 80 or older | White | No | No | Very good | 8 | No | No | No |
| 44 | Yes | 30.23 | Yes | No | No | 6 | 2 | Yes | Female | 75-79 | White | Yes | Yes | Fair | 8 | No | Yes | No |
| 45 | No | 30.34 | Yes | No | No | 30 | 10 | Yes | Male | 55-59 | White | No, borderline diabetes | No | Fair | 6 | No | No | No |
| 49 | No | 20.12 | No | No | No | 0 | 0 | Yes | Female | 80 or older | White | No | No | Fair | 7 | No | No | Yes |
| 52 | No | 31.09 | No | No | No | 2 | 0 | No | Female | 65-69 | White | No | Yes | Very good | 7 | No | No | No |
| 59 | No | 29.55 | No | No | No | 0 | 0 | No | Male | 70-74 | White | Yes | Yes | Good | 7 | No | No | No |
| 67 | No | 34.01 | Yes | No | No | 14 | 0 | No | Female | 80 or older | White | No | No | Good | 7 | Yes | Yes | Yes |
| 70 | No | 40.00 | No | No | No | 0 | 0 | No | Male | 60-64 | Asian | Yes | No | Good | 6 | 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 |
| 84 | No | 28.25 | No | No | No | 0 | 3 | Yes | Male | 75-79 | White | No | Yes | Good | 8 | No | No | No |
| 95 | No | 23.96 | Yes | No | No | 0 | 0 | No | Female | 60-64 | Black | No | Yes | Excellent | 5 | No | No | No |
| 106 | No | 58.54 | No | No | No | 30 | 0 | Yes | Male | 65-69 | Other | No, borderline diabetes | Yes | Poor | 3 | Yes | No | No |
| 107 | No | 24.13 | No | No | No | 6 | 15 | No | Female | 60-64 | White | No | No | Fair | 10 | Yes | No | No |
| 114 | No | 34.46 | No | No | No | 0 | 0 | No | Female | 65-69 | White | Yes | Yes | Good | 7 | No | No | No |
| 116 | No | 34.41 | No | No | No | 0 | 30 | No | Female | 55-59 | White | No | Yes | Good | 9 | No | No | No |
Se construye el modelo con los datos de entrenamiento mediante la función rpart().
El árbol no se puede visualizar cn todos los registros de los datos de entrenamiento, se hicieron las pruebas y se logra visualizar aproximadamente con 2000 registros de una muestra a partir de los datos de entrenamiento.
Si se construye el modelo con todos los registros de los datos de entrenamiento, pero no se puede observar la visualización del árbol y sus ramificaciones, razón por la cual se hace con una muestra de los datos de entrenamiento.
muestra <- sample(x = 1:nrow(datos.entrenamiento), size = 2000, replace = FALSE)
modelo.ac = rpart(data = datos.entrenamiento[muestra,],formula = HeartDisease ~ .)
El resumen del modelo muestra algunos estadísticos importantes:
summary(modelo.ac)
## Call:
## rpart(formula = HeartDisease ~ ., data = datos.entrenamiento[muestra,
## ])
## n= 2000
##
## CP nsplit rel error xerror xstd
## 1 0 0 1 0 0
##
## Node number 1: 2000 observations
## predicted class=No expected loss=0.0895 P(node) =1
## class counts: 1821 179
## probabilities: 0.910 0.089
Entonces una posible predicción sería siguiendo las reglas de asociación y condicionales del modelo.
prp(modelo.ac, main = "Arbol de Clasificación")
Se generan predicciones con datos de validación con el argumento class de clasificación, es decir, Yes o No.
prediciones_ac = predict(object = modelo.ac,newdata = datos.validacion, type = "class")
Head(predicciones, 20) los primeros 20 predicciones
head(prediciones_ac, 20)
## [1] No No No No No No No No No No No No No No No No No No No No
## Levels: No Yes
Se construye una tabla comparativa con los valores de interés
t_comparativa = data.frame("real" = datos.validacion[,c('HeartDisease')],"prediccion"= prediciones_ac)
# t_comparativa <- t_comparativa %>%
# mutate(heartDiseasePred =
top20 = head(t_comparativa,20)
kable(top20,caption = 'Primeros 20 registros')
| real | prediccion |
|---|---|
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| Yes | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
Una matriz de confusión es una herramienta que permite evaluación de un modelo de clasificación
Cada columna de la matriz representa el número de predicciones de cada clase, mientras que cada fila representa a las instancias en la clase real.
Uno de los beneficios de las matrices de confusión es que facilitan ver si el sistema está confundiendo las diferentes clases o resultados.
Hay que encontrar a cuantos casos se le atinaron utilizando los datos de validación y con ello encontrar el porcentaje de aciertos.

Se puede evaluar el modelo con la matriz de confusión interpretando algunos estadísticos:
Se evalúa el modelo de acuerdo a estas condiciones:
Accuracy o exactitud \[ accuracy = \frac{VP + VN}{VP+FP+FN+VN} \\ n = VP+FP+FN+VN \]
Precision o precisión
\[ precision = \frac{VP}{VP + FP} \]
Recall o recuperación \[ recall = \frac{VP}{VP + FN} \]
Especificity o especificidad (tasa de verdaderos negativos)
\[ especificity = \frac{VN}{VN + FP} \]
Factorizar las columnas
Factorizar en R significa categorizar con la función “as.factor” o “factor”
Se muestra a tabla con las columnas de interés para interpretar las predicciones.
t_comparativa$real = as.factor(t_comparativa$real)
t_comparativa$prediccion = as.factor(t_comparativa$prediccion)
kable(head(t_comparativa, 20), caption = "Tabla comparativa, primeros 20 registros")
| real | prediccion |
|---|---|
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| Yes | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
| No | No |
Creando de la matriz de confusión con la función confusionMatrix() de la librería caret con las variables de interés: “real” y “prediccion”, que representan los valores reales y las predicciones respectivamente.
matrixConfusion <- confusionMatrix(t_comparativa$real,t_comparativa$prediccion)
matrixConfusion
## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 58484 0
## Yes 5474 0
##
## Accuracy : 0.9144
## 95% CI : (0.9122, 0.9166)
## No Information Rate : 1
## P-Value [Acc > NIR] : 1
##
## Kappa : 0
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.9144
## Specificity : NA
## Pos Pred Value : NA
## Neg Pred Value : NA
## Prevalence : 1.0000
## Detection Rate : 0.9144
## Detection Prevalence : 0.9144
## Balanced Accuracy : NA
##
## 'Positive' Class : No
##
El valor estadístico de Accuracy = Exactitud igual a 0.9069 significa un valor aproximado del 90.69; se interpreta que de cada 100 el modelo acierta en la predicción el 90.69% de las ocasiones.
El modelo se construyó solo con una muestra de 2000 registros de los datos de entrenamiento.
Si la métrica era que debiera tener un valor por encima del 70% el modelo se acepta pero debe compararse contra otro modelo de clasificación para ver cual es más eficiente en relación tan solo en el estadístico de exactitud.
Este valor de Accuracy = Exactitud deberá compararse contra otros modelos.
Se crea un registro de una persona con ciertas condiciones de salud.
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
Se hace la predicción con estos valores:
prediccion <- predict(object = modelo.ac, newdata = persona, type = "class")
prediccion
## [1] No
## Levels: No Yes
# prediccion <- prediccion$fit
# prediccion
Entonces la predicción es:
Si la predicción es ‘No’ entonces no tienen afección del corazón, en caso contrario de ‘Yes’ entonces implica que si tiene daño del corazón.