Teoría

La regresión logística en este contexto nos permite calcular la probabilidad de que un paciente tenga una enfermedad cardíaca (target = 1) basándose en indicadores clínicos como el colesterol, la presión arterial y el tipo de dolor en el pecho.

Instalar paquetes y llamar librerías

library(caret)
library(tidyverse)

Crear la base de datos

df_corazon <- read.csv("C:\\Users\\rrobl\\Downloads\\heart.csv")

Entender y limpiar la base de datos

summary(df_corazon)
##       age             sex               cp            trestbps    
##  Min.   :29.00   Min.   :0.0000   Min.   :0.0000   Min.   : 94.0  
##  1st Qu.:48.00   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:120.0  
##  Median :56.00   Median :1.0000   Median :1.0000   Median :130.0  
##  Mean   :54.43   Mean   :0.6956   Mean   :0.9424   Mean   :131.6  
##  3rd Qu.:61.00   3rd Qu.:1.0000   3rd Qu.:2.0000   3rd Qu.:140.0  
##  Max.   :77.00   Max.   :1.0000   Max.   :3.0000   Max.   :200.0  
##       chol          fbs            restecg          thalach     
##  Min.   :126   Min.   :0.0000   Min.   :0.0000   Min.   : 71.0  
##  1st Qu.:211   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:132.0  
##  Median :240   Median :0.0000   Median :1.0000   Median :152.0  
##  Mean   :246   Mean   :0.1493   Mean   :0.5298   Mean   :149.1  
##  3rd Qu.:275   3rd Qu.:0.0000   3rd Qu.:1.0000   3rd Qu.:166.0  
##  Max.   :564   Max.   :1.0000   Max.   :2.0000   Max.   :202.0  
##      exang           oldpeak          slope             ca        
##  Min.   :0.0000   Min.   :0.000   Min.   :0.000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.000   1st Qu.:1.000   1st Qu.:0.0000  
##  Median :0.0000   Median :0.800   Median :1.000   Median :0.0000  
##  Mean   :0.3366   Mean   :1.072   Mean   :1.385   Mean   :0.7541  
##  3rd Qu.:1.0000   3rd Qu.:1.800   3rd Qu.:2.000   3rd Qu.:1.0000  
##  Max.   :1.0000   Max.   :6.200   Max.   :2.000   Max.   :4.0000  
##       thal           target      
##  Min.   :0.000   Min.   :0.0000  
##  1st Qu.:2.000   1st Qu.:0.0000  
##  Median :2.000   Median :1.0000  
##  Mean   :2.324   Mean   :0.5132  
##  3rd Qu.:3.000   3rd Qu.:1.0000  
##  Max.   :3.000   Max.   :1.0000
str(df_corazon)
## 'data.frame':    1025 obs. of  14 variables:
##  $ age     : int  52 53 70 61 62 58 58 55 46 54 ...
##  $ sex     : int  1 1 1 1 0 0 1 1 1 1 ...
##  $ cp      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ trestbps: int  125 140 145 148 138 100 114 160 120 122 ...
##  $ chol    : int  212 203 174 203 294 248 318 289 249 286 ...
##  $ fbs     : int  0 1 0 0 1 0 0 0 0 0 ...
##  $ restecg : int  1 0 1 1 1 0 2 0 0 0 ...
##  $ thalach : int  168 155 125 161 106 122 140 145 144 116 ...
##  $ exang   : int  0 1 1 0 0 0 0 1 0 1 ...
##  $ oldpeak : num  1 3.1 2.6 0 1.9 1 4.4 0.8 0.8 3.2 ...
##  $ slope   : int  2 0 0 2 1 1 0 1 2 1 ...
##  $ ca      : int  2 0 0 1 3 0 3 1 0 2 ...
##  $ thal    : int  3 3 3 3 2 2 1 3 3 2 ...
##  $ target  : int  0 0 0 0 0 1 0 0 0 0 ...
# Convertimos a factor las variables que representan categorías para que el modelo funcione correctamente
df_corazon$target <- as.factor(df_corazon$target) # 1 = Enfermo, 0 = Sano
df_corazon$sex <- as.factor(df_corazon$sex)
df_corazon$cp <- as.factor(df_corazon$cp) # Tipo de dolor de pecho
df_corazon$fbs <- as.factor(df_corazon$fbs) # Azúcar en sangre
df_corazon$restecg <- as.factor(df_corazon$restecg)
df_corazon$exang <- as.factor(df_corazon$exang) # Angina por ejercicio
df_corazon$slope <- as.factor(df_corazon$slope)
df_corazon$ca <- as.factor(df_corazon$ca) # Vasos coloreados
df_corazon$thal <- as.factor(df_corazon$thal)

# Eliminamos cualquier valor nulo
df_corazon <- na.omit(df_corazon)

Crear el modelo de Regresión Logística

# Entrenamos el modelo con todas las variables de la base de datos
modelo_logit <- glm(target ~ ., data = df_corazon, family = "binomial")

# Ver el resumen estadístico del modelo
summary(modelo_logit)
## 
## Call:
## glm(formula = target ~ ., family = "binomial", data = df_corazon)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -0.081901   2.028691  -0.040 0.967797    
## age          0.026846   0.013950   1.924 0.054297 .  
## sex1        -1.992347   0.314204  -6.341 2.28e-10 ***
## cp1          0.886380   0.308803   2.870 0.004100 ** 
## cp2          2.006394   0.286281   7.008 2.41e-12 ***
## cp3          2.409722   0.391965   6.148 7.86e-10 ***
## trestbps    -0.024979   0.006537  -3.821 0.000133 ***
## chol        -0.005462   0.002307  -2.367 0.017914 *  
## fbs1         0.380096   0.319620   1.189 0.234356    
## restecg1     0.397268   0.217975   1.823 0.068374 .  
## restecg2    -0.800417   1.536998  -0.521 0.602530    
## thalach      0.021692   0.006525   3.324 0.000886 ***
## exang1      -0.750331   0.248746  -3.016 0.002557 ** 
## oldpeak     -0.403411   0.132156  -3.053 0.002269 ** 
## slope1      -0.595618   0.472076  -1.262 0.207057    
## slope2       0.799689   0.504500   1.585 0.112941    
## ca1         -2.334076   0.286781  -8.139 3.99e-16 ***
## ca2         -3.597039   0.444870  -8.086 6.19e-16 ***
## ca3         -2.288131   0.532138  -4.300 1.71e-05 ***
## ca4          1.565677   0.930256   1.683 0.092363 .  
## thal1        2.796813   1.466219   1.908 0.056456 .  
## thal2        2.404646   1.421542   1.692 0.090727 .  
## thal3        0.991243   1.423972   0.696 0.486359    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1420.24  on 1024  degrees of freedom
## Residual deviance:  606.82  on 1002  degrees of freedom
## AIC: 652.82
## 
## Number of Fisher Scoring iterations: 6

Predicciones con datos nuevos

# Definimos dos perfiles de pacientes para poner a prueba el modelo
nuevos_pacientes <- data.frame(
  age = c(55, 45),
  sex = as.factor(c(1, 0)),
  cp = as.factor(c(0, 2)),
  trestbps = c(140, 120),
  chol = c(250, 200),
  fbs = as.factor(c(1, 0)),
  restecg = as.factor(c(1, 1)),
  thalach = c(110, 160),
  exang = as.factor(c(1, 0)),
  oldpeak = c(2.5, 0.0),
  slope = as.factor(c(1, 2)),
  ca = as.factor(c(2, 0)),
  thal = as.factor(c(3, 2))
)

# Calculamos la probabilidad de enfermedad (0 a 1)
probabilidades <- predict(modelo_logit, newdata = nuevos_pacientes, type = "response")

# Mostramos la tabla de resultados
resultados <- cbind(nuevos_pacientes, Probabilidad_Riesgo = probabilidades)
print(resultados)
##   age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal
## 1  55   1  0      140  250   1       1     110     1     2.5     1  2    3
## 2  45   0  2      120  200   0       1     160     0     0.0     2  0    2
##   Probabilidad_Riesgo
## 1        0.0007047047
## 2        0.9977954377

Conclusiones

El estudio basado en regresión logística aplicado a 1,025 expedientes clínicos permite obtener varias conclusiones relevantes

En cuanto a la presencia de la enfermedad se observa una distribución prácticamente equilibrada ya que el 51.3% de los pacientes analizados presenta afección cardíaca mientras que el 48.7% no muestra indicios de ella

Respecto a las variables más influyentes el modelo señala que el tipo de dolor torácico (cp) y la frecuencia cardíaca máxima alcanzada (thalach) son los factores con mayor capacidad para predecir la aparición del problema de salud

Desde una perspectiva preventiva el uso de regresión logística resulta útil porque genera probabilidades individuales de riesgo lo que permite clasificar a los pacientes según su nivel de atención requerida y apoyar decisiones médicas oportunas antes de complicaciones mayores

Finalmente el perfil con mayor probabilidad de padecimiento se asocia a personas de mayor edad con dolor de pecho tipo 0 y con menor tolerancia al esfuerzo físico lo que incrementa de manera importante su nivel de riesgo según el análisis realizado