RegresiónLogistica-Heart

Importar la base de datos

heart <- read.csv("/Users/samanthagarcia/Desktop/heart.csv")

Teoría

La regresión logística es un modelo estadístico de clasificación binaria, que estima la probabilidad de que ocurra un evento (valor 1) frente a que no ocurra (valor 0), en función de variables independientes.

Instalar paquetes y llamar librerías

# install.packages("caret")
library(caret)

## Loading required package: ggplot2

## Loading required package: lattice

# install.packages("tidyverse")
library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.0     ✔ readr     2.1.6
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ lubridate 1.9.5     ✔ tibble    3.3.1
## ✔ purrr     1.2.1     ✔ tidyr     1.3.2

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ✖ purrr::lift()   masks caret::lift()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

Crear la base de datos

df <- heart

Entender la base de datos

summary(df)

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

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

Preparar variables

df$target <- as.factor(df$target)

cat_cols <- c("sex","cp","fbs","restecg","exang","slope","ca","thal")
cat_cols <- cat_cols[cat_cols %in% names(df)]
df[cat_cols] <- lapply(df[cat_cols], as.factor)

df <- na.omit(df)

Crear el modelo

modelo <- glm(target ~ ., data=df, family=binomial)
summary(modelo)

## 
## Call:
## glm(formula = target ~ ., family = binomial, data = df)
## 
## 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

Probar el modelo

prueba <- df[1:2, ]
prueba$target <- NULL  # quitamos target para predecir

probabilidad <- predict(modelo, newdata=prueba, type="response")
cbind(prueba, Probabilidad_Target_1 = probabilidad)

##   age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal
## 1  52   1  0      125  212   0       1     168     0     1.0     2  2    3
## 2  53   1  0      140  203   1       0     155     1     3.1     0  0    3
##   Probabilidad_Target_1
## 1            0.04202510
## 2            0.07415506

Predicciones

Al probar el modelo con dos pacientes del conjunto de datos, ambos presentaron una probabilidad baja de enfermedad cardíaca (4.2% y 7.4%). Esto indica que, según sus características clínicas, el modelo estima un riesgo reducido de padecer la condición (target = 1).

Conclusiones

El modelo de regresión logística permitió estimar la probabilidad de presencia de enfermedad cardíaca en función de variables clínicas. Los resultados muestran que factores como el sexo, el tipo de dolor de pecho (cp), la presión arterial, el colesterol, la frecuencia cardíaca máxima (thalach), el ejercicio inducido (exang), el oldpeak y el número de vasos principales (ca) influyen significativamente en el riesgo.