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.
library(caret)
library(tidyverse)
df_corazon <- read_csv("C:/Users/robie/Downloads/heart.csv")
## Rows: 1025 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (14): age, sex, cp, trestbps, chol, fbs, restecg, thalach, exang, oldpea...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
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)
## spc_tbl_ [1,025 × 14] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ age : num [1:1025] 52 53 70 61 62 58 58 55 46 54 ...
## $ sex : num [1:1025] 1 1 1 1 0 0 1 1 1 1 ...
## $ cp : num [1:1025] 0 0 0 0 0 0 0 0 0 0 ...
## $ trestbps: num [1:1025] 125 140 145 148 138 100 114 160 120 122 ...
## $ chol : num [1:1025] 212 203 174 203 294 248 318 289 249 286 ...
## $ fbs : num [1:1025] 0 1 0 0 1 0 0 0 0 0 ...
## $ restecg : num [1:1025] 1 0 1 1 1 0 2 0 0 0 ...
## $ thalach : num [1:1025] 168 155 125 161 106 122 140 145 144 116 ...
## $ exang : num [1:1025] 0 1 1 0 0 0 0 1 0 1 ...
## $ oldpeak : num [1:1025] 1 3.1 2.6 0 1.9 1 4.4 0.8 0.8 3.2 ...
## $ slope : num [1:1025] 2 0 0 2 1 1 0 1 2 1 ...
## $ ca : num [1:1025] 2 0 0 1 3 0 3 1 0 2 ...
## $ thal : num [1:1025] 3 3 3 3 2 2 1 3 3 2 ...
## $ target : num [1:1025] 0 0 0 0 0 1 0 0 0 0 ...
## - attr(*, "spec")=
## .. cols(
## .. age = col_double(),
## .. sex = col_double(),
## .. cp = col_double(),
## .. trestbps = col_double(),
## .. chol = col_double(),
## .. fbs = col_double(),
## .. restecg = col_double(),
## .. thalach = col_double(),
## .. exang = col_double(),
## .. oldpeak = col_double(),
## .. slope = col_double(),
## .. ca = col_double(),
## .. thal = col_double(),
## .. target = col_double()
## .. )
## - attr(*, "problems")=<externalptr>
# 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)
# 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
# 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
Este análisis de regresión logística sobre 1,025 registros médicos nos permite concluir lo siguiente:
Distribución del riesgo: El 51.3% de los pacientes en este estudio presentan una condición cardíaca (target = 1), mientras que el 48.7% se consideran sanos.
Indicadores críticos: El modelo identifica que el tipo de dolor de pecho (cp) y la frecuencia cardíaca máxima (thalach) son los predictores más potentes para anticipar una afección.
Detección preventiva: La capacidad de la regresión logística para arrojar una probabilidad exacta permite clasificar a los pacientes según su nivel de urgencia, facilitando la toma de decisiones clínicas antes de que ocurra un evento grave.
Perfil de riesgo: Pacientes con mayor edad, dolor de pecho tipo 0 y baja tolerancia al ejercicio presentan una probabilidad de riesgo significativamente más elevada según los datos procesados.