Importar la base de datos

heart <- read.csv("/Users/paolasalas/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

# La variable objetivo normalmente es "target" (0/1)
# Convertimos a factor para clasificación
df$target <- as.factor(df$target)

# Convertimos variables categóricas típicas a factor (si existen)
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)

# Quitamos NAs si hubiera
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

# Crear un ejemplo con 2 pacientes (ajusta si te marca error por niveles)
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

Conclusiones

Se utilizó un modelo de regresión logística para estimar si una persona tiene enfermedad del corazón usando datos como edad, sexo y otras mediciones médicas. El análisis muestra que algunas variables del corazón y la condición física influyen en el resultado.

En general, el modelo permite calcular la probabilidad de enfermedad según los datos del paciente y ayuda a identificar qué factores son más importantes para el diagnóstico.

LS0tCnRpdGxlOiAiUmVncmVzacOzbiBMb2fDrXN0aWNhIC0gSGVhcnQgLSBBMDEyODYzMDAiCmF1dGhvcjogIlBhb2xhIFNhbGFzIgpkYXRlOiAiMjAyNi0wMi0xOSIKb3V0cHV0OgogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IFRSVUUKICAgIHRvY19mbG9hdDogVFJVRQogICAgY29kZV9kb3dubG9hZDogVFJVRQogICAgdGhlbWU6IGJvb3RzdHJhcAotLS0KCiFbXShodHRwczovL2kwLndwLmNvbS9zb2NsYWxsdW5hLmNvbS93cC1jb250ZW50L3VwbG9hZHMvMjAxOC8wOC9jb3JhemFuaW1hLmdpZj9yZXNpemU9NjY1JTJDNTI0JnNzbD0xKQoKIyBJbXBvcnRhciBsYSBiYXNlIGRlIGRhdG9zIHtzdHlsZT0iY29sb3I6cGluayJ9CgpgYGB7cn0KaGVhcnQgPC0gcmVhZC5jc3YoIi9Vc2Vycy9wYW9sYXNhbGFzL0Rlc2t0b3AvaGVhcnQuY3N2IikKYGBgCgojIFtUZW9yw61hXXtzdHlsZT0iY29sb3I6Ymx1ZSJ9CgpMYSAqKnJlZ3Jlc2nDs24gbG9nw61zdGljYSoqIGVzIHVuIG1vZGVsbyBlc3RhZMOtc3RpY28gZGUgY2xhc2lmaWNhY2nDs24gYmluYXJpYSwgcXVlIGVzdGltYSBsYSBwcm9iYWJpbGlkYWQgZGUgcXVlIG9jdXJyYSB1biBldmVudG8gKHZhbG9yIDEpIGZyZW50ZSBhIHF1ZSBubyBvY3VycmEgKHZhbG9yIDApLCBlbiBmdW5jacOzbiBkZSB2YXJpYWJsZXMgaW5kZXBlbmRpZW50ZXMuCgojIFtJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXLDrWFzXXtzdHlsZT0iY29sb3I6cGluayJ9CgpgYGB7cn0KIyBpbnN0YWxsLnBhY2thZ2VzKCJjYXJldCIpCmxpYnJhcnkoY2FyZXQpCiMgaW5zdGFsbC5wYWNrYWdlcygidGlkeXZlcnNlIikKbGlicmFyeSh0aWR5dmVyc2UpCmBgYAoKIyBbQ3JlYXIgbGEgYmFzZSBkZSBkYXRvc117c3R5bGU9ImNvbG9yOnBpbmsifQoKYGBge3J9CmRmIDwtIGhlYXJ0CmBgYAoKIyBbRW50ZW5kZXIgbGEgYmFzZSBkZSBkYXRvc117c3R5bGU9ImNvbG9yOnBpbmsifQoKYGBge3J9CnN1bW1hcnkoZGYpCnN0cihkZikKYGBgCgojIFtQcmVwYXJhciB2YXJpYWJsZXNde3N0eWxlPSJjb2xvcjpwaW5rIn0KCmBgYHtyfQojIExhIHZhcmlhYmxlIG9iamV0aXZvIG5vcm1hbG1lbnRlIGVzICJ0YXJnZXQiICgwLzEpCiMgQ29udmVydGltb3MgYSBmYWN0b3IgcGFyYSBjbGFzaWZpY2FjacOzbgpkZiR0YXJnZXQgPC0gYXMuZmFjdG9yKGRmJHRhcmdldCkKCiMgQ29udmVydGltb3MgdmFyaWFibGVzIGNhdGVnw7NyaWNhcyB0w61waWNhcyBhIGZhY3RvciAoc2kgZXhpc3RlbikKY2F0X2NvbHMgPC0gYygic2V4IiwiY3AiLCJmYnMiLCJyZXN0ZWNnIiwiZXhhbmciLCJzbG9wZSIsImNhIiwidGhhbCIpCmNhdF9jb2xzIDwtIGNhdF9jb2xzW2NhdF9jb2xzICVpbiUgbmFtZXMoZGYpXQpkZltjYXRfY29sc10gPC0gbGFwcGx5KGRmW2NhdF9jb2xzXSwgYXMuZmFjdG9yKQoKIyBRdWl0YW1vcyBOQXMgc2kgaHViaWVyYQpkZiA8LSBuYS5vbWl0KGRmKQpgYGAKCiMgW0NyZWFyIGVsIG1vZGVsb117c3R5bGU9ImNvbG9yOnBpbmsifQoKYGBge3J9Cm1vZGVsbyA8LSBnbG0odGFyZ2V0IH4gLiwgZGF0YT1kZiwgZmFtaWx5PWJpbm9taWFsKQpzdW1tYXJ5KG1vZGVsbykKYGBgCgojIFtQcm9iYXIgZWwgbW9kZWxvXXtzdHlsZT0iY29sb3I6cGluayJ9CgpgYGB7cn0KIyBDcmVhciB1biBlamVtcGxvIGNvbiAyIHBhY2llbnRlcyAoYWp1c3RhIHNpIHRlIG1hcmNhIGVycm9yIHBvciBuaXZlbGVzKQpwcnVlYmEgPC0gZGZbMToyLCBdCnBydWViYSR0YXJnZXQgPC0gTlVMTCAgIyBxdWl0YW1vcyB0YXJnZXQgcGFyYSBwcmVkZWNpcgoKcHJvYmFiaWxpZGFkIDwtIHByZWRpY3QobW9kZWxvLCBuZXdkYXRhPXBydWViYSwgdHlwZT0icmVzcG9uc2UiKQpjYmluZChwcnVlYmEsIFByb2JhYmlsaWRhZF9UYXJnZXRfMSA9IHByb2JhYmlsaWRhZCkKYGBgCgojIFtDb25jbHVzaW9uZXNde3N0eWxlPSJjb2xvcjpwaW5rIn0KClNlIHV0aWxpesOzIHVuIG1vZGVsbyBkZSByZWdyZXNpw7NuIGxvZ8Otc3RpY2EgcGFyYSBlc3RpbWFyIHNpIHVuYSBwZXJzb25hIHRpZW5lIGVuZmVybWVkYWQgZGVsIGNvcmF6w7NuIHVzYW5kbyBkYXRvcyBjb21vIGVkYWQsIHNleG8geSBvdHJhcyBtZWRpY2lvbmVzIG3DqWRpY2FzLiBFbCBhbsOhbGlzaXMgbXVlc3RyYSBxdWUgYWxndW5hcyB2YXJpYWJsZXMgZGVsIGNvcmF6w7NuIHkgbGEgY29uZGljacOzbiBmw61zaWNhIGluZmx1eWVuIGVuIGVsIHJlc3VsdGFkby4KCkVuIGdlbmVyYWwsIGVsIG1vZGVsbyBwZXJtaXRlIGNhbGN1bGFyIGxhIHByb2JhYmlsaWRhZCBkZSBlbmZlcm1lZGFkIHNlZ8O6biBsb3MgZGF0b3MgZGVsIHBhY2llbnRlIHkgYXl1ZGEgYSBpZGVudGlmaWNhciBxdcOpIGZhY3RvcmVzIHNvbiBtw6FzIGltcG9ydGFudGVzIHBhcmEgZWwgZGlhZ27Ds3N0aWNvLgo=