El conjunto de datos trata con información relacionada con el sector salud, es información histórica de datos clínicos de pacientes que padecen daños al corazón.
Las variables independientes:
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’.
El caso de estudio se puede encontrar en el en la dirección url rpubs.com https://rpubs.com/rpizarrog/1437621
Los datos se pueden encontrar en el espacio del autor github.com https://raw.githubusercontent.com/rpizarrog/Libro-Aprendizaje-Automatico.-Casos-de-Estudio-con-R-y-Python/refs/heads/main/datos/muestra10000_danios_al_corazon2026.csv. Los datos son una muestra de 10000 registros y 18 variables.
Las funciones se pueden encontrar y reutilizar desde el espacio github.com en https://raw.githubusercontent.com/rpizarrog/Libro-Aprendizaje-Automatico.-Casos-de-Estudio-con-R-y-Python/refs/heads/main/R%20MarkDown/funciones/funciones%20para%20regresion%20logistica%20binomial%20y%20multinomial.R
Construir y evaluar modelos de regresión logística binaria para datos daños de corazón.
Para construir el modelo de regresión loística, los datos originales no se escalan ni se estandarizan, ni se transforman con variables dummys; para construir modelos con datos desbalanceados y usar técnicas como SMOTE los datos son transformados a variables dummys.
Las particiones serán aleatoriamente 70% para datos de entrenamiento y 30% para datos de validación.
Se presenta y describe la matriz de confusión para todos los modelos de regresión logística construídos
La evaluación se hace con las métricas de exactitud, precisión sensibilidad, F1 Scrore y el estadístico kappa que se extraen de la matriz de confusión.
Al final, se deberá interpretar los estadísticos de la evaluación de modelos creados e indicar y justificar el porqué un modelo tiene mejor rendimiento que otro en términos de calidad predictiva.
# install.packages("readr")
# install.packages("tidyverse")
# install.packages("psych")
# install.packages("dplyr")
# install.packages("ggplot2")
# install.packages("caret")
# install.packages("broom")
# install.packages("lmtest")
# install.packages("car")
# install.packages("stats")
# install.packages("flextable")
# install.packages("officer")
# install.packages("patchwork")
# install.packages("performance")
# install.packages("see")
# install.packages("car")
# install.packages("nortest")
# install.packages("lmtest")
# install,packages("e1071")
# install.packages("rpart")
# install.packages("randomForest")
# install.packages("smotefamily")
# install.packages("themis")
library(readr) # cargar datos datos
library(tidyverse) # Para manipular
library (psych) # Para descriobir datos
library(dplyr) # Manipulación de datos
library(ggplot2) # gráficos
library(caret) # partición de datos y matriz de confusión
library(broom) # tidy modelos
library(lmtest) # Durbin-Watson
library(car) # VIF y diagnóstico, entre otras
library(stats) # lm, shapiro.test
library(patchwork) # Graficos organizados en columnas renglones
# Tablas compatibles con Word
library(flextable)
library(officer)
library(performance) # Para evaluar postulados de modelos
library(see) # Para evaluar postulados de modelos dependencia de performance
library(car) # Para verificar postulados de los modelos
library(nortest) # Para pruebas de normalidad Anderson-Darling
library(lmtest) # Para pruebas de homocedasticidad Breusch–Pagan y prueba de White y otras pruebas
# library(glmnet) # Para modelos Lasso y Ridge
# library(e1071) # Para modelos SVR varios kernels
# library(rpart) #arboles de regresión
# library(randomForest) # randomForest
# library(rpart.plot) # Visualizar arboles de regresión
library(smotefamily)
library(themis)
# url <- "../funciones/funciones para regresion logistica binomial y multinomial.R" # local
url <- "https://raw.githubusercontent.com/rpizarrog/Libro-Aprendizaje-Automatico.-Casos-de-Estudio-con-R-y-Python/refs/heads/main/R%20MarkDown/funciones/funciones%20para%20regresion%20logistica%20binomial%20y%20multinomial.R" # WEB
source(url)
# url <- "../datos/muestra10000_danios_al_corazon2026.csv" # local
url <- "https://raw.githubusercontent.com/rpizarrog/Libro-Aprendizaje-Automatico.-Casos-de-Estudio-con-R-y-Python/refs/heads/main/datos/muestra10000_danios_al_corazon2026.csv" # WEB
datos <- f_cargar_datos(url)
Se presentan los primeros y últimos registros de los daos originales con las primeras y últimas cuatro variables.
f_visualizar_head_tail_reducido_word(datos)
BMI | Smoking | AlcoholDrinking | Stroke | ... | Asthma | KidneyDisease | SkinCancer | HeartDisease |
|---|---|---|---|---|---|---|---|---|
46.11 | Yes | No | No | ... | No | No | No | No |
28.29 | No | No | No | ... | No | No | No | No |
42.93 | No | No | No | ... | No | No | No | No |
26.61 | No | No | No | ... | No | No | No | No |
40.69 | No | No | No | ... | No | No | No | No |
23.11 | No | No | No | ... | No | No | No | No |
... | ... | ... | ... | ... | ... | ... | ... | ... |
35.28 | No | No | No | ... | No | No | No | No |
24.34 | No | No | No | ... | Yes | No | No | No |
19.94 | No | No | No | ... | No | No | No | No |
26.78 | Yes | Yes | No | ... | No | No | No | No |
25.06 | Yes | No | No | ... | No | No | No | No |
32.77 | No | No | No | ... | No | No | No | No |
Se ejecuta la función f_convertir_factor() para convertir las variables categóricas a tipo factor que principalmnent esirven para identificar frecuencias de clases.
datos <- f_convertir_factor(datos)
Se presentan los estadísticos de las variables numéricas; de las categóricas de tipo factor, se identifica la frecuencia de clase.
f_describir_datos(datos)
## $describe
## vars n mean sd median trimmed mad min max range
## BMI 1 10000 28.29 6.38 27.32 27.67 5.44 12.48 94.66 82.18
## Smoking* 2 10000 1.41 0.49 1.00 1.39 0.00 1.00 2.00 1.00
## AlcoholDrinking* 3 10000 1.07 0.25 1.00 1.00 0.00 1.00 2.00 1.00
## Stroke* 4 10000 1.04 0.19 1.00 1.00 0.00 1.00 2.00 1.00
## PhysicalHealth 5 10000 3.51 8.16 0.00 1.10 0.00 0.00 30.00 30.00
## MentalHealth 6 10000 4.01 8.12 0.00 1.79 0.00 0.00 30.00 30.00
## DiffWalking* 7 10000 1.14 0.35 1.00 1.05 0.00 1.00 2.00 1.00
## Sex* 8 10000 1.48 0.50 1.00 1.48 0.00 1.00 2.00 1.00
## AgeCategory* 9 10000 7.53 3.57 8.00 7.65 4.45 1.00 13.00 12.00
## Race* 10 10000 5.38 1.23 6.00 5.67 0.00 1.00 6.00 5.00
## Diabetic* 11 10000 1.29 0.71 1.00 1.11 0.00 1.00 4.00 3.00
## PhysicalActivity* 12 10000 1.77 0.42 2.00 1.84 0.00 1.00 2.00 1.00
## GenHealth* 13 10000 3.20 1.53 3.00 3.25 2.97 1.00 5.00 4.00
## SleepTime 14 10000 7.09 1.42 7.00 7.11 1.48 1.00 20.00 19.00
## Asthma* 15 10000 1.14 0.34 1.00 1.04 0.00 1.00 2.00 1.00
## KidneyDisease* 16 10000 1.04 0.19 1.00 1.00 0.00 1.00 2.00 1.00
## SkinCancer* 17 10000 1.10 0.29 1.00 1.00 0.00 1.00 2.00 1.00
## HeartDisease* 18 10000 1.09 0.29 1.00 1.00 0.00 1.00 2.00 1.00
## skew kurtosis se
## BMI 1.46 5.44 0.06
## Smoking* 0.35 -1.88 0.00
## AlcoholDrinking* 3.39 9.48 0.00
## Stroke* 4.81 21.14 0.00
## PhysicalHealth 2.51 4.99 0.08
## MentalHealth 2.29 4.15 0.08
## DiffWalking* 2.08 2.32 0.00
## Sex* 0.08 -1.99 0.00
## AgeCategory* -0.26 -1.02 0.04
## Race* -1.87 2.41 0.01
## Diabetic* 2.12 2.77 0.01
## PhysicalActivity* -1.30 -0.30 0.00
## GenHealth* -0.11 -1.39 0.02
## SleepTime 0.30 4.87 0.01
## Asthma* 2.13 2.56 0.00
## KidneyDisease* 4.93 22.28 0.00
## SkinCancer* 2.74 5.52 0.00
## HeartDisease* 2.87 6.26 0.00
##
## $structure
## [1] "'data.frame':\t10000 obs. of 18 variables:\n $ BMI : num 46.1 28.3 42.9 26.6 40.7 ...\n $ Smoking : Factor w/ 2 levels \"No\",\"Yes\": 2 1 1 1 1 1 2 1 2 2 ...\n $ AlcoholDrinking : Factor w/ 2 levels \"No\",\"Yes\": 1 1 1 1 1 1 1 2 1 1 ...\n $ Stroke : Factor w/ 2 levels \"No\",\"Yes\": 1 1 1 1 1 1 1 1 1 1 ...\n $ PhysicalHealth : num 0 5 0 0 0 0 0 0 2 0 ...\n $ MentalHealth : num 0 3 0 0 0 20 0 0 0 0 ...\n $ DiffWalking : Factor w/ 2 levels \"No\",\"Yes\": 1 1 1 1 1 1 1 1 1 1 ...\n $ Sex : Factor w/ 2 levels \"Female\",\"Male\": 2 2 2 2 2 2 1 2 2 2 ...\n $ AgeCategory : Factor w/ 13 levels \"18-24\",\"25-29\",..: 9 3 6 5 7 1 10 1 11 7 ...\n $ Race : Factor w/ 6 levels \"American Indian/Alaskan Native\",..: 6 4 1 6 6 3 6 6 6 6 ...\n $ Diabetic : Factor w/ 4 levels \"No\",\"No, borderline diabetes\",..: 1 1 1 1 1 1 1 1 1 1 ...\n $ PhysicalActivity: Factor w/ 2 levels \"No\",\"Yes\": 2 2 2 2 2 2 2 2 2 2 ...\n $ GenHealth : Factor w/ 5 levels \"Excellent\",\"Fair\",..: 3 3 5 1 3 5 1 1 2 3 ...\n $ SleepTime : num 8 7 6 6 7 3 8 5 8 6 ...\n $ Asthma : Factor w/ 2 levels \"No\",\"Yes\": 1 1 1 1 1 1 1 1 1 1 ...\n $ KidneyDisease : Factor w/ 2 levels \"No\",\"Yes\": 1 1 1 1 1 1 1 1 1 1 ...\n $ SkinCancer : Factor w/ 2 levels \"No\",\"Yes\": 1 1 1 1 1 1 1 1 2 1 ...\n $ HeartDisease : Factor w/ 2 levels \"No\",\"Yes\": 1 1 1 1 1 1 1 1 1 1 ..."
f_summary_factores(datos)
## Smoking AlcoholDrinking Stroke DiffWalking Sex
## No :5860 No :9306 No :9617 No :8603 Female:5189
## Yes:4140 Yes: 694 Yes: 383 Yes:1397 Male :4811
##
##
##
##
##
## AgeCategory Race
## 60-64 :1068 American Indian/Alaskan Native: 167
## 70-74 :1022 Asian : 263
## 65-69 :1020 Black : 769
## 55-59 : 911 Hispanic : 846
## 50-54 : 799 Other : 337
## 80 or older: 794 White :7618
## (Other) :4386
## Diabetic PhysicalActivity GenHealth Asthma
## No :8477 No :2268 Excellent:2100 No :8649
## No, borderline diabetes: 195 Yes:7732 Fair :1105 Yes:1351
## Yes :1265 Good :2941
## Yes (during pregnancy) : 63 Poor : 381
## Very good:3473
##
##
## KidneyDisease SkinCancer HeartDisease
## No :9633 No :9040 No :9104
## Yes: 367 Yes: 960 Yes: 896
##
##
##
##
##
Se ejecuta la función para observar la frecuencia de clase de la variable dependiente HeartDisease.
variable_dependiente <- "HeartDisease"
f_frecuencia_clase(datos, variable_dependiente)
Son 9104 pacientes que no están enfermos del corazón y 896 pacientes que si están enfermos, de inicio es un conjunto de datos con clase desbalanceada ya que el 91.04% son pacientes sin daño al corazón y el 8.95% si tiene daño del corazón, sin embargo le modelo se construirá aunque se pondrá atención a métricas además de exactitud a valoraciones tales como precisión, sensibilidad F1-Score y estadístico de kappa para enriquecer la interpretación.
Luego se construyen modelos de regresión logística pero con datos balanceados.
Con la función f_particionar_datos() se crean de manera aleatoria los datos de entrenamiento con el 70% y los datos de validación el 30%. Al ajecutar la función f_visualizar_head_tail_reducido_word(), se presentan los primeros registros de los datos de entrenamiento con las primeras y últimas cuatro variables, luego se observan los datos de validación. Ver tablas.
particiones <- f_particionar_datos(datos)
datos_entrenamiento <- particiones$datos_entrenamiento
datos_validacion <- particiones$datos_validacion
f_visualizar_head_tail_reducido_word(datos_entrenamiento)
## New names:
## New names:
## New names:
## • `...` -> `...5`
BMI | Smoking | AlcoholDrinking | Stroke | ... | Asthma | KidneyDisease | SkinCancer | HeartDisease |
|---|---|---|---|---|---|---|---|---|
31.74 | No | No | No | ... | No | No | No | No |
31.25 | Yes | No | Yes | ... | No | No | No | No |
24.3 | No | No | No | ... | No | No | No | No |
32.92 | No | No | No | ... | Yes | No | No | No |
29.21 | Yes | No | No | ... | Yes | No | No | Yes |
23.63 | Yes | Yes | No | ... | No | No | Yes | No |
... | ... | ... | ... | ... | ... | ... | ... | ... |
20.12 | No | No | No | ... | Yes | Yes | No | No |
27.34 | No | No | No | ... | Yes | No | No | No |
24.41 | Yes | No | No | ... | No | No | No | No |
25.5 | No | No | No | ... | No | No | No | No |
33.84 | No | No | No | ... | No | No | Yes | No |
31.8 | No | No | No | ... | No | No | No | No |
Datos de validación:
f_visualizar_head_tail_reducido_word(datos_validacion)
## New names:
## New names:
## New names:
## • `...` -> `...5`
BMI | Smoking | AlcoholDrinking | Stroke | ... | Asthma | KidneyDisease | SkinCancer | HeartDisease |
|---|---|---|---|---|---|---|---|---|
46.11 | Yes | No | No | ... | No | No | No | No |
28.29 | No | No | No | ... | No | No | No | No |
32.89 | Yes | No | No | ... | No | No | Yes | No |
24.14 | No | No | No | ... | No | No | No | No |
31.31 | Yes | Yes | No | ... | No | No | No | No |
40.45 | No | No | No | ... | No | No | No | No |
... | ... | ... | ... | ... | ... | ... | ... | ... |
33.78 | Yes | No | No | ... | Yes | No | No | No |
53.9 | Yes | No | No | ... | Yes | No | No | Yes |
22.15 | Yes | No | No | ... | No | No | No | No |
31.89 | No | No | No | ... | Yes | No | No | No |
19.94 | No | No | No | ... | No | No | No | No |
26.78 | Yes | Yes | No | ... | No | No | No | No |
Con los datos de entrenamiento, se crea el modelo de regresión logística binomial ejecutando la función f_crear_modelo_regresion_logistica() que recibe argumentos como los datos de entrenamiento, la variable dependiente, el tipo en este caso binomial si habrá balanceo de clase o no en este código “ninguno” que significa que no habrá balanceo de clases y la semilla de aleatoriedad 2026.
Los resultados del modelo Aparecen en modo consola, el tipo de modelo, la cantidad de observaciones que se usaron para construirlo, la fórmula que lo define, los coeficientes que construyen la ecuación que realiza las predicciones, y algunos estadísticos como desviación de residuos y valor AIC.
modelo_RLB <- f_crear_modelo_regresion_logistica(datos_entrenamiento,
variable_dependiente,
tipo = "binomial",
balanceo = "ninguno",
semilla = 2026)
##
## ====================================
## REGRESIÓN LOGÍSTICA
## ====================================
## Tipo : binomial
## Balanceo : ninguno
## Variable objetivo : HeartDisease
## Clases : 2
## Observaciones : 7000
## ====================================
modelo_RLB
##
## Call: glm(formula = formula_modelo, family = binomial("logit"), data = datos)
##
## Coefficients:
## (Intercept) BMI
## -5.9425930 0.0031536
## SmokingYes AlcoholDrinkingYes
## 0.3533547 -0.2993053
## StrokeYes PhysicalHealth
## 0.9936758 0.0007669
## MentalHealth DiffWalkingYes
## 0.0038536 0.2791952
## SexMale AgeCategory25-29
## 0.7311038 -0.2214137
## AgeCategory30-34 AgeCategory35-39
## 1.0540896 -0.6017661
## AgeCategory40-44 AgeCategory45-49
## 1.4450109 1.3535374
## AgeCategory50-54 AgeCategory55-59
## 1.8351140 2.1684471
## AgeCategory60-64 AgeCategory65-69
## 2.1926465 2.6565425
## AgeCategory70-74 AgeCategory75-79
## 2.9523485 2.9831130
## AgeCategory80 or older RaceAsian
## 3.1584826 -0.9567050
## RaceBlack RaceHispanic
## -0.1028571 0.0060290
## RaceOther RaceWhite
## -0.2824026 0.0220945
## DiabeticNo, borderline diabetes DiabeticYes
## -0.7675549 0.4323486
## DiabeticYes (during pregnancy) PhysicalActivityYes
## -0.7107660 -0.0252686
## GenHealthFair GenHealthGood
## 1.4052204 0.7912582
## GenHealthPoor GenHealthVery good
## 1.9739414 0.3197877
## SleepTime AsthmaYes
## -0.0387013 0.1912537
## KidneyDiseaseYes SkinCancerYes
## 0.7080044 0.0238138
##
## Degrees of Freedom: 6999 Total (i.e. Null); 6962 Residual
## Null Deviance: 4314
## Residual Deviance: 3332 AIC: 3408
Con el modelo se hacen predicciones usando los datos de validación con la función f_predicciones(), se muestran las predicciones y las probabilidad de cada una de ellas, luego e construye la matriz de confusión y se extraen los estadísticos de evaluación f_matriz_confusion().
predicciones <- f_predicciones(modelo_RLB, datos_validacion, variable_dependiente)
f_visualizar_head_tail_reducido_word(predicciones)
Real | Prediccion | Probabilidad | Porcentual |
|---|---|---|---|
No | No | 0.1149 | 11.49 % |
No | No | 0.0279 | 2.79 % |
No | No | 0.3353 | 33.53 % |
No | No | 0.0044 | 0.44 % |
No | No | 0.0145 | 1.45 % |
No | No | 0.0803 | 8.03 % |
... | ... | ... | ... |
No | No | 0.0072 | 0.72 % |
Yes | No | 0.0887 | 8.87 % |
No | No | 0.0892 | 8.92 % |
No | No | 0.0192 | 1.92 % |
No | No | 0.008 | 0.8 % |
No | No | 0.0301 | 3.01 % |
Se crea la matriz de confusión con la función f_matriz_confusion() que destaca un 91% de exactitud en las predicciones pero bajos valores de sensibilidad, kappa un desbalancedo de clases.
f_matriz_confusion(modelo_RLB, datos_validacion, variable_dependiente, "Yes" )
## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 2726 226
## Yes 25 23
##
## Accuracy : 0.9163
## 95% CI : (0.9058, 0.926)
## No Information Rate : 0.917
## P-Value [Acc > NIR] : 0.5692
##
## Kappa : 0.1316
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.092369
## Specificity : 0.990912
## Pos Pred Value : 0.479167
## Neg Pred Value : 0.923442
## Prevalence : 0.083000
## Detection Rate : 0.007667
## Detection Prevalence : 0.016000
## Balanced Accuracy : 0.541641
##
## 'Positive' Class : Yes
##
El valor de la métrica Accuracy del modelo de regresión logística bonomial RLB Accuracy de 0.91 parece excelente, pero Sensitivity es muy baja, Kappa es muy bajo, Balanced Accuracy apenas supera el 50%, lo cual indica que el modelo está aprendiendo principalmente de la clase mayoritaria (NO) y tiene muchas dificultades para detectar pacientes con enfermedad cardíaca (Yes). Este modelo es adecuado para decir que predice bien cerca del 91% pero no es tan real porque se le dificulta predecir realmente la variable de interés que es los pacientes que si están enfermos, la razón es por el desbalanceo de clase en los datos, como al principio se indicó.
Se ejecuta la función f_evaluar_modelos() para evaluar el modelos de regresión logística, recibe argumentos como el modelo mismo, los datos de validación, la variable dependiente “HeartDisease” el valor de interés de la variable objetivo en este caso “Yes” o los pacientes que están enfermos y el nombre del modelo.
f_evaluar_modelos(modelo_RLB, datos_validacion, variable_dependiente,"Yes", "Reg. Logística")
Dado que existe un desbalanceo de clases, se aplican las técnicas para reducir y se construyen modelos de regresión logística por cada técnica.
Se eliminan registros de la clase no dominante y se construye un modelo nuevo, se ejecuta la función f_crear_modelo_regresion_logistica(). Al eliminar registros quedaron 647 observaciones con valores ‘Yes’ y el mismo número de registros para valores ‘No’ en la variable dependiente, lo que permite crear un modelo equilibrado con la técnica unsersampling.
modelo_RLB_US <- f_crear_modelo_regresion_logistica(datos_entrenamiento,
variable_dependiente,
tipo = "binomial",
balanceo = "undersampling",
semilla = 2026)
##
## ====================================
## REGRESIÓN LOGÍSTICA
## ====================================
## Tipo : binomial
## Balanceo : undersampling
## Variable objetivo : HeartDisease
## Clases : 2
## Observaciones : 1294
## ====================================
modelo_RLB_US
##
## Call: glm(formula = formula_modelo, family = binomial("logit"), data = datos)
##
## Coefficients:
## (Intercept) BMI
## -3.8325189 0.0141677
## SmokingYes AlcoholDrinkingYes
## 0.4607388 -0.4637527
## StrokeYes PhysicalHealth
## 1.1081701 0.0019436
## MentalHealth DiffWalkingYes
## 0.0004391 0.4733384
## SexMale AgeCategory25-29
## 0.6563223 -0.1392112
## AgeCategory30-34 AgeCategory35-39
## 0.9472435 -0.7685318
## AgeCategory40-44 AgeCategory45-49
## 1.2332554 0.8690364
## AgeCategory50-54 AgeCategory55-59
## 1.5486816 1.8816963
## AgeCategory60-64 AgeCategory65-69
## 2.1997621 2.3935814
## AgeCategory70-74 AgeCategory75-79
## 2.9206686 2.9158015
## AgeCategory80 or older RaceAsian
## 3.1102427 -1.0390164
## RaceBlack RaceHispanic
## -0.0884798 0.1135712
## RaceOther RaceWhite
## 0.0972638 -0.0569186
## DiabeticNo, borderline diabetes DiabeticYes
## 0.0554486 0.5514086
## DiabeticYes (during pregnancy) PhysicalActivityYes
## -1.2410300 0.0569838
## GenHealthFair GenHealthGood
## 1.1319660 0.4634993
## GenHealthPoor GenHealthVery good
## 1.3847621 0.1217661
## SleepTime AsthmaYes
## -0.0139307 0.3816047
## KidneyDiseaseYes SkinCancerYes
## 0.1169965 -0.0481617
##
## Degrees of Freedom: 1293 Total (i.e. Null); 1256 Residual
## Null Deviance: 1794
## Residual Deviance: 1297 AIC: 1373
table(modelo_RLB_US$model$HeartDisease)
##
## No Yes
## 647 647
Al crear el modelo de regresión logística usando la técnica de oversampling, fueron 6353 observaciones de la clase ‘Yes’ y el mismo número de registros para la clase ‘No’.
modelo_RLB_OS <- f_crear_modelo_regresion_logistica(datos_entrenamiento,
variable_dependiente,
tipo = "binomial",
balanceo = "oversampling",
semilla = 2026)
##
## ====================================
## REGRESIÓN LOGÍSTICA
## ====================================
## Tipo : binomial
## Balanceo : oversampling
## Variable objetivo : HeartDisease
## Clases : 2
## Observaciones : 12706
## ====================================
modelo_RLB_OS
##
## Call: glm(formula = formula_modelo, family = binomial("logit"), data = datos)
##
## Coefficients:
## (Intercept) BMI
## -3.5159633 0.0058615
## SmokingYes AlcoholDrinkingYes
## 0.3599609 -0.2734578
## StrokeYes PhysicalHealth
## 0.9678778 0.0003221
## MentalHealth DiffWalkingYes
## 0.0068212 0.4103364
## SexMale AgeCategory25-29
## 0.7851323 0.2577350
## AgeCategory30-34 AgeCategory35-39
## 1.1568893 -0.2777434
## AgeCategory40-44 AgeCategory45-49
## 1.7006774 1.2780657
## AgeCategory50-54 AgeCategory55-59
## 1.9220847 2.3296056
## AgeCategory60-64 AgeCategory65-69
## 2.4169637 2.7607724
## AgeCategory70-74 AgeCategory75-79
## 3.2580642 3.2762039
## AgeCategory80 or older RaceAsian
## 3.4954079 -1.0473015
## RaceBlack RaceHispanic
## -0.4454884 -0.2467786
## RaceOther RaceWhite
## -0.4364221 -0.3318826
## DiabeticNo, borderline diabetes DiabeticYes
## -0.8149370 0.4809842
## DiabeticYes (during pregnancy) PhysicalActivityYes
## -0.5921457 0.0328703
## GenHealthFair GenHealthGood
## 1.3780003 0.6879223
## GenHealthPoor GenHealthVery good
## 1.8003289 0.2200833
## SleepTime AsthmaYes
## -0.0578304 0.1959716
## KidneyDiseaseYes SkinCancerYes
## 0.5857116 0.0033626
##
## Degrees of Freedom: 12705 Total (i.e. Null); 12668 Residual
## Null Deviance: 17610
## Residual Deviance: 12590 AIC: 12660
table(modelo_RLB_OS$model$HeartDisease)
##
## No Yes
## 6353 6353
Para trabajar con SMOTE es necesario transformar a variable DUMMYS las variables categóricas.
Se ejecuta la función f_convertir_dummys() para convertir a variables dummys tanto los datos de entrenamiento como los datos de validación; se muestran los datos de entrenamiento y los datos de validación con valores dummys.
datos_entrenamiento_dummys <- f_convertir_dummys(datos_entrenamiento, "HeartDisease")
##
## ====================================
## CONVERSIÓN A VARIABLES DUMMY
## ====================================
## Variables originales : 18
## Variables finales : 38
## Observaciones : 7000
## ====================================
datos_validacion_dummys <- f_convertir_dummys(datos_validacion, "HeartDisease" )
##
## ====================================
## CONVERSIÓN A VARIABLES DUMMY
## ====================================
## Variables originales : 18
## Variables finales : 38
## Observaciones : 3000
## ====================================
f_visualizar_head_tail_reducido_word(datos_entrenamiento_dummys)
## New names:
## New names:
## New names:
## • `...` -> `...5`
BMI | SmokingYes | AlcoholDrinkingYes | StrokeYes | ... | AsthmaYes | KidneyDiseaseYes | SkinCancerYes | HeartDisease |
|---|---|---|---|---|---|---|---|---|
31.74 | 0 | 0 | 0 | ... | 0 | 0 | 0 | No |
31.25 | 1 | 0 | 1 | ... | 0 | 0 | 0 | No |
24.3 | 0 | 0 | 0 | ... | 0 | 0 | 0 | No |
32.92 | 0 | 0 | 0 | ... | 1 | 0 | 0 | No |
29.21 | 1 | 0 | 0 | ... | 1 | 0 | 0 | Yes |
23.63 | 1 | 1 | 0 | ... | 0 | 0 | 1 | No |
... | ... | ... | ... | ... | ... | ... | ... | ... |
20.12 | 0 | 0 | 0 | ... | 1 | 1 | 0 | No |
27.34 | 0 | 0 | 0 | ... | 1 | 0 | 0 | No |
24.41 | 1 | 0 | 0 | ... | 0 | 0 | 0 | No |
25.5 | 0 | 0 | 0 | ... | 0 | 0 | 0 | No |
33.84 | 0 | 0 | 0 | ... | 0 | 0 | 1 | No |
31.8 | 0 | 0 | 0 | ... | 0 | 0 | 0 | No |
f_visualizar_head_tail_reducido_word(datos_validacion_dummys)
## New names:
## New names:
## New names:
## • `...` -> `...5`
BMI | SmokingYes | AlcoholDrinkingYes | StrokeYes | ... | AsthmaYes | KidneyDiseaseYes | SkinCancerYes | HeartDisease |
|---|---|---|---|---|---|---|---|---|
46.11 | 1 | 0 | 0 | ... | 0 | 0 | 0 | No |
28.29 | 0 | 0 | 0 | ... | 0 | 0 | 0 | No |
32.89 | 1 | 0 | 0 | ... | 0 | 0 | 1 | No |
24.14 | 0 | 0 | 0 | ... | 0 | 0 | 0 | No |
31.31 | 1 | 1 | 0 | ... | 0 | 0 | 0 | No |
40.45 | 0 | 0 | 0 | ... | 0 | 0 | 0 | No |
... | ... | ... | ... | ... | ... | ... | ... | ... |
33.78 | 1 | 0 | 0 | ... | 1 | 0 | 0 | No |
53.9 | 1 | 0 | 0 | ... | 1 | 0 | 0 | Yes |
22.15 | 1 | 0 | 0 | ... | 0 | 0 | 0 | No |
31.89 | 0 | 0 | 0 | ... | 1 | 0 | 0 | No |
19.94 | 0 | 0 | 0 | ... | 0 | 0 | 0 | No |
26.78 | 1 | 1 | 0 | ... | 0 | 0 | 0 | No |
Al aplicar la técnica SMOTE se creó el modelo con 6353 personas que no están enfermos y 5823 que si lo están, con esto, los datos presentan una condición de equilibro en la clases de la variables dependiente.
modelo_RLB_SMOTE <- f_crear_modelo_regresion_logistica(datos_entrenamiento_dummys,
variable_dependiente,
tipo = "binomial",
balanceo = "SMOTE",
semilla = 2026)
##
## ====================================
## REGRESIÓN LOGÍSTICA
## ====================================
## Tipo : binomial
## Balanceo : SMOTE
## Variable objetivo : HeartDisease
## Clases : 2
## Observaciones : 12176
## ====================================
modelo_RLB_SMOTE
##
## Call: glm(formula = formula_modelo, family = binomial("logit"), data = datos)
##
## Coefficients:
## (Intercept) BMI
## -3.986135 0.010231
## SmokingYes AlcoholDrinkingYes
## 0.420571 -0.513348
## StrokeYes PhysicalHealth
## 1.178099 -0.005364
## MentalHealth DiffWalkingYes
## 0.006782 0.389034
## SexMale AgeCategory25.29
## 0.950320 -0.586207
## AgeCategory30.34 AgeCategory35.39
## 0.554181 -1.599592
## AgeCategory40.44 AgeCategory45.49
## 0.837102 0.929622
## AgeCategory50.54 AgeCategory55.59
## 1.418069 1.815008
## AgeCategory60.64 AgeCategory65.69
## 2.054747 2.396029
## AgeCategory70.74 AgeCategory75.79
## 2.930205 2.968737
## AgeCategory80.or.older RaceAsian
## 3.244774 -0.837515
## RaceBlack RaceHispanic
## -0.257815 0.159502
## RaceOther RaceWhite
## -0.405076 0.130843
## DiabeticNo..borderline.diabetes DiabeticYes
## -1.159669 0.458263
## DiabeticYes..during.pregnancy. PhysicalActivityYes
## -1.142791 0.088748
## GenHealthFair GenHealthGood
## 1.532215 0.758584
## GenHealthPoor GenHealthVery.good
## 2.244279 0.237623
## SleepTime AsthmaYes
## -0.052210 0.141810
## KidneyDiseaseYes SkinCancerYes
## 0.651001 -0.089910
##
## Degrees of Freedom: 12175 Total (i.e. Null); 12138 Residual
## Null Deviance: 16860
## Residual Deviance: 11680 AIC: 11760
table(modelo_RLB_SMOTE$model$HeartDisease)
##
## No Yes
## 6353 5823
Se construye un modelo con la técnica de ponderación con 6353 para ‘No’ y 647 para ‘Si’, con ello el modelo penaliza en la clase dominante.
modelo_RLB_PONDERA <- f_crear_modelo_regresion_logistica(datos_entrenamiento,
variable_dependiente,
tipo = "binomial",
balanceo = "ponderacion",
semilla = 2026)
## Warning in eval(family$initialize): non-integer #successes in a binomial glm!
##
## ====================================
## REGRESIÓN LOGÍSTICA
## ====================================
## Tipo : binomial
## Balanceo : ponderacion
## Variable objetivo : HeartDisease
## Clases : 2
## Observaciones : 7000
## ====================================
table(modelo_RLB_PONDERA$model$HeartDisease)
##
## No Yes
## 6353 647
Se ejecuta la función f_evaluar_modelos() para evaluar todos los modelos de de regresión logística y técnicas de balanceo de clases construidos.
## Evaluación todos los modelos
modelos <- list(
modelo_RLB,
modelo_RLB_US,
modelo_RLB_OS,
modelo_RLB_SMOTE,
modelo_RLB_PONDERA
)
nombres <- c(
"Original",
"Undersampling",
"Oversampling",
"SMOTE",
"Ponderado"
)
evaluacion <- f_evaluar_modelos(
modelos,
list(datos_validacion, datos_validacion, datos_validacion, datos_validacion_dummys, datos_validacion),
"HeartDisease",
"Yes",
nombres
)
evaluacion
Al aplicar técnicas de balanceo de clases, la sensibilidad aumenta hasta valores aproximados de 75%, lo que indica una mejora en la capacidad del modelo para detectar pacientes enfermos que serían del interés para la investigación. La exactitud global disminuye respecto al modelo original, las métricas Kappa, F1 y Balanced Accuracy muestran una mejora importante, reflejando un desempeño más equilibrado entre ambas clases.
De las técnicas evaluadas, SMOTE presenta el mejor desempeño general al alcanzar los mayores valores de Accuracy (75.50%), Kappa (0.2300) y F1 (0.3288), mientras que Undersampling obtiene el mayor valor de Balanced Accuracy (0.7423).
Para este conjunto de datos se recomienda utilizar modelos balanceados, especialmente SMOTE, debido a que ofrecen una capacidad significativamente superior para identificar correctamente pacientes con enfermedad cardíaca.
Como otra alternativa, se construyen modelos usando paquetes como caret, smotefamily , themis que permiten crear directamente en los modelos de regresión logística directamente sin balancear anticipadamente los datos sino que el trabajo de balanceo se hace directamente al construir el modelo. Se manda llamar la función f_crear_modelo_RL_balanceada() y se contruye cada modelos.
modelo_RLB_US_2 <- f_crear_modelo_RL_balanceada(
datos_entrenamiento,
"HeartDisease",
tecnica = "undersampling"
)
##
## ====================================
## REGRESIÓN LOGÍSTICA BALANCEADA
## ====================================
## Técnica : undersampling
## Variable objetivo : HeartDisease
## Observaciones : 7000
## ====================================
modelo_RLB_OS_2 <- f_crear_modelo_RL_balanceada(
datos_entrenamiento,
"HeartDisease",
tecnica = "oversampling"
)
##
## ====================================
## REGRESIÓN LOGÍSTICA BALANCEADA
## ====================================
## Técnica : oversampling
## Variable objetivo : HeartDisease
## Observaciones : 7000
## ====================================
modelo_RLB_SMOTE_2 <- f_crear_modelo_RL_balanceada(
datos_entrenamiento_dummys,
"HeartDisease",
tecnica = "smote"
)
##
## ====================================
## REGRESIÓN LOGÍSTICA BALANCEADA
## ====================================
## Técnica : smote
## Variable objetivo : HeartDisease
## Observaciones : 7000
## ====================================
Se evalúan todos los modelos; se observa que los modelos de regresión logística que se balancearon manualmente y los que utilizan el paquete caret ofrecen resultados similares en los estadísticos.
evaluacion <- f_evaluar_modelos(
modelos = list(
modelo_RLB,
modelo_RLB_US,
modelo_RLB_OS,
modelo_RLB_SMOTE,
modelo_RLB_PONDERA,
modelo_RLB_US_2,
modelo_RLB_OS_2,
modelo_RLB_SMOTE_2
),
datos_validacion = list(
datos_validacion,
datos_validacion,
datos_validacion,
datos_validacion_dummys,
datos_validacion,
datos_validacion,
datos_validacion,
datos_validacion_dummys
),
variable_dependiente = "HeartDisease",
clase_interes = "Yes",
nombres_modelos = c(
"Original",
"US Manual",
"OS Manual",
"SMOTE Manual",
"Ponderado",
"US Caret",
"OS Caret",
"SMOTE Caret"
)
)
evaluacion
Este caso de estudio cumple con el objetivo de crear, evaluar y comparar modelos de regresión logística. Los datos son de un contexto de la condición de salud de personas en lo relacionado a daños al corazón con una muestra de 10000 observaciones.
Se encontró que los datos de origen tienen una condición de falta de equilibro en los valores de la clase de la variable dependiente “HeartDisease”; 91.04% son pacientes sin daño al corazón y el 8.95% si tiene daño del corazón con lo que es un escenario de desbalanceo de clases.
Al construir y evaluar el modelo de clasificación con el algoritmo de regresión logística y con datos originales se encontró que el modelo es muy bueno en acertar predicciones cerca del 91% en accuracy; sin embargo, por la condición del desbalance de clases, este estadístico es engamoso, ya que otras métricas como sensibilidad o F1 Score se presentan valores bajos lo que indica que la exactitud es buena para atinar a personas no enfermas y tal vez dejando de lado predicciones a personas enfermas.
Con el propósito de atender esta problemática en el desbalance de clases, se construyeron modelos de regresión logística usando técnicas de unsersamplig, oversamplig, SMOTE y ponderación.
Al evaluar modelos que usando estas técnicas se detectó una disminucuón en el valor de exactitud pero un incremento en los valores de los estadísticos como sensibilidad, F1-Score y el estadístico que mide el balanceo de clase. Estos resultados y evaluaciones, sugieren que los modelos balanceados poseen una mayor capacidad para identificar correctamente a los pacientes con enfermedad cardíaca, objetivo que que hay que destacar como importante en aplicaciones médicas donde los falsos negativos pueden tener consecuencias relevantes.
Luego se construyeron modelos que aplican técnicas de balanceo de clases haciendo uso del paquete caret y se encontraron resultados similares.
El modelo SMOTE fue el que obtuvo simultáneamente los mejores valores de Kappa (0.2300), F1-Score (0.3288) y una de las mejores Balanced Accuracy (~0.74). Por ello, podría cerrar el caso de estudio indicando que, para este conjunto de datos, SMOTE fue la técnica que mostró el mejor equilibrio general entre detección de pacientes enfermos y desempeño global del modelo de clasificación, lo que perite concluir que es el modelo con mejor calidad predictiva.
La utilidad de este caso de estudio es que ofrece una alternativa en la construcción y evaluación de modelos de regresión logística además de presentar un escenario de falta de balance en las clases que con la ayuda de técnicas para el balaneo de clases, se puede subsanar esta deficiencia en los datos.