Contexto de los datos

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

Objetivo

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.

Descripción

Cargar librerías

# 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)

Cargar funciones

# 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)

Cargar datos

# 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)

Visualizar datos

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

Transformar datos a tipo factor

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)

Estadísticos descriptivos

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    
##                                       
##                                       
##                                       
##                                       
## 

Visualización de frecuencia de clase

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.

Desarrollo

Datos de entrenaniento y datos de validaci[on

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

Crear modelos de regresi[on logística

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

Predicciones

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 %

Matriz de confusión

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ó.

Evaluación del modelo

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")

Balanceo de clases

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.

Undersampling

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

Oversampling

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

SMOTE

Para trabajar con SMOTE es necesario transformar a variable DUMMYS las variables categóricas.

Convertir variables Dummys

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

Crear modelo con SMOTE

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

Modelo con ponderación

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

Evaluar todos los modelos

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.

Crear modelos con paquetes especializados

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 
## ====================================

Evaluar esta alternativa

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

Interpretación del caso de estudio

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.