# install.packages("caret")
library(caret)
## Warning: package 'caret' was built under R version 4.4.3
## Cargando paquete requerido: ggplot2
## Warning: package 'ggplot2' was built under R version 4.4.3
## Cargando paquete requerido: lattice
## Warning: package 'lattice' was built under R version 4.4.3
# install.packages("tidyverse")
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.4.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ lubridate 1.9.4     ✔ tibble    3.2.1
## ✔ purrr     1.0.4     ✔ tidyr     1.3.1
## ── 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
df <- read.csv("C:\\Users\\anton\\Downloads\\heart.csv")
# Explorar 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 ...
df <- df[, c("target","age","sex","cp","thalach","oldpeak")]

# Eliminar valores faltantes
df <- na.omit(df)

# Convertir variable objetivo a factor
df$target <- as.factor(df$target)

# Convertir variables categóricas
df$sex <- as.factor(df$sex)
df$cp <- as.factor(df$cp)

str(df)
## 'data.frame':    1025 obs. of  6 variables:
##  $ target : Factor w/ 2 levels "0","1": 1 1 1 1 1 2 1 1 1 1 ...
##  $ age    : int  52 53 70 61 62 58 58 55 46 54 ...
##  $ sex    : Factor w/ 2 levels "0","1": 2 2 2 2 1 1 2 2 2 2 ...
##  $ cp     : Factor w/ 4 levels "0","1","2","3": 1 1 1 1 1 1 1 1 1 1 ...
##  $ thalach: int  168 155 125 161 106 122 140 145 144 116 ...
##  $ oldpeak: num  1 3.1 2.6 0 1.9 1 4.4 0.8 0.8 3.2 ...
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.359747   1.056669  -0.340 0.733515    
## age         -0.039298   0.010644  -3.692 0.000222 ***
## sex1        -1.844887   0.208584  -8.845  < 2e-16 ***
## cp1          1.732941   0.256082   6.767 1.31e-11 ***
## cp2          2.204962   0.212669  10.368  < 2e-16 ***
## cp3          2.288578   0.314506   7.277 3.42e-13 ***
## thalach      0.023697   0.004608   5.143 2.71e-07 ***
## oldpeak     -0.754388   0.092440  -8.161 3.33e-16 ***
## ---
## 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:  856.15  on 1017  degrees of freedom
## AIC: 872.15
## 
## Number of Fisher Scoring iterations: 5
prueba <- data.frame(
  age = 50,
  sex = as.factor(1),
  cp = as.factor(2),
  thalach = 150,
  oldpeak = 2.3
)

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

cbind(prueba, Probabilidad_Enfermedad = probabilidad)
##   age sex cp thalach oldpeak Probabilidad_Enfermedad
## 1  50   1  2     150     2.3               0.4638056

Conclusión

Con base en los resultados que obtuve, puedo concluir que el modelo de regresión logística sí logra explicar de manera importante la presencia de enfermedad cardíaca, ya que la mayoría de las variables resultaron estadísticamente significativas. En especial, el tipo de dolor de pecho, el sexo y el oldpeak muestran un impacto fuerte en la probabilidad estimada. También se observa una reducción considerable entre la desviación nula y la residual, lo que indica que el modelo mejora frente a uno sin predictores. El AIC sugiere que el ajuste es adecuado. En el caso de prueba que evalué, la probabilidad fue de 46.38%, lo que representa un riesgo moderado. En general, considero que el modelo es útil como herramienta para estimar el riesgo y apoyar la toma de decisiones.

LS0tDQp0aXRsZTogIkhlYXJ0Ig0KYXV0aG9yOiAiQW50b25pbyBHYXJjw61hIEFjb3N0YSBBMDE2MjExMzkiDQpkYXRlOiAiYHIgU3lzLkRhdGUoKWAiDQpvdXRwdXQ6IA0KICBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICB0aGVtZTogY29zbW8NCi0tLQ0KDQo8Y2VudGVyPg0KIVtdKGh0dHBzOi8vd3d3LnRleGFzaGVhcnQub3JnL2hlYXJ0LWhlYWx0aC9oZWFydC1pbmZvcm1hdGlvbi1jZW50ZXIvdG9waWNzL2FuYXRvbWlhLWRlbC1jb3Jhem9uLykNCjwvY2VudGVyPg0KDQpgYGB7cn0NCiMgaW5zdGFsbC5wYWNrYWdlcygiY2FyZXQiKQ0KbGlicmFyeShjYXJldCkNCiMgaW5zdGFsbC5wYWNrYWdlcygidGlkeXZlcnNlIikNCmxpYnJhcnkodGlkeXZlcnNlKQ0KYGBgDQoNCmBgYHtyfQ0KZGYgPC0gcmVhZC5jc3YoIkM6XFxVc2Vyc1xcYW50b25cXERvd25sb2Fkc1xcaGVhcnQuY3N2IikNCmBgYA0KDQpgYGB7cn0NCiMgRXhwbG9yYXIgZGF0b3MNCnN1bW1hcnkoZGYpDQpzdHIoZGYpDQpgYGANCg0KYGBge3J9DQpkZiA8LSBkZlssIGMoInRhcmdldCIsImFnZSIsInNleCIsImNwIiwidGhhbGFjaCIsIm9sZHBlYWsiKV0NCg0KIyBFbGltaW5hciB2YWxvcmVzIGZhbHRhbnRlcw0KZGYgPC0gbmEub21pdChkZikNCg0KIyBDb252ZXJ0aXIgdmFyaWFibGUgb2JqZXRpdm8gYSBmYWN0b3INCmRmJHRhcmdldCA8LSBhcy5mYWN0b3IoZGYkdGFyZ2V0KQ0KDQojIENvbnZlcnRpciB2YXJpYWJsZXMgY2F0ZWfDs3JpY2FzDQpkZiRzZXggPC0gYXMuZmFjdG9yKGRmJHNleCkNCmRmJGNwIDwtIGFzLmZhY3RvcihkZiRjcCkNCg0Kc3RyKGRmKQ0KYGBgDQoNCmBgYHtyfQ0KbW9kZWxvIDwtIGdsbSh0YXJnZXQgfiAuLCBkYXRhPWRmLCBmYW1pbHk9Ymlub21pYWwpDQoNCnN1bW1hcnkobW9kZWxvKQ0KYGBgDQoNCmBgYHtyfQ0KcHJ1ZWJhIDwtIGRhdGEuZnJhbWUoDQogIGFnZSA9IDUwLA0KICBzZXggPSBhcy5mYWN0b3IoMSksDQogIGNwID0gYXMuZmFjdG9yKDIpLA0KICB0aGFsYWNoID0gMTUwLA0KICBvbGRwZWFrID0gMi4zDQopDQoNCnByb2JhYmlsaWRhZCA8LSBwcmVkaWN0KG1vZGVsbywgbmV3ZGF0YT1wcnVlYmEsIHR5cGU9InJlc3BvbnNlIikNCg0KY2JpbmQocHJ1ZWJhLCBQcm9iYWJpbGlkYWRfRW5mZXJtZWRhZCA9IHByb2JhYmlsaWRhZCkNCmBgYA0KIyBDb25jbHVzacOzbg0KDQpDb24gYmFzZSBlbiBsb3MgcmVzdWx0YWRvcyBxdWUgb2J0dXZlLCBwdWVkbyBjb25jbHVpciBxdWUgZWwgbW9kZWxvIGRlIHJlZ3Jlc2nDs24gbG9nw61zdGljYSBzw60gbG9ncmEgZXhwbGljYXIgZGUgbWFuZXJhIGltcG9ydGFudGUgbGEgcHJlc2VuY2lhIGRlIGVuZmVybWVkYWQgY2FyZMOtYWNhLCB5YSBxdWUgbGEgbWF5b3LDrWEgZGUgbGFzIHZhcmlhYmxlcyByZXN1bHRhcm9uIGVzdGFkw61zdGljYW1lbnRlIHNpZ25pZmljYXRpdmFzLiBFbiBlc3BlY2lhbCwgZWwgdGlwbyBkZSBkb2xvciBkZSBwZWNobywgZWwgc2V4byB5IGVsIG9sZHBlYWsgbXVlc3RyYW4gdW4gaW1wYWN0byBmdWVydGUgZW4gbGEgcHJvYmFiaWxpZGFkIGVzdGltYWRhLiBUYW1iacOpbiBzZSBvYnNlcnZhIHVuYSByZWR1Y2Npw7NuIGNvbnNpZGVyYWJsZSBlbnRyZSBsYSBkZXN2aWFjacOzbiBudWxhIHkgbGEgcmVzaWR1YWwsIGxvIHF1ZSBpbmRpY2EgcXVlIGVsIG1vZGVsbyBtZWpvcmEgZnJlbnRlIGEgdW5vIHNpbiBwcmVkaWN0b3Jlcy4gRWwgQUlDIHN1Z2llcmUgcXVlIGVsIGFqdXN0ZSBlcyBhZGVjdWFkby4gRW4gZWwgY2FzbyBkZSBwcnVlYmEgcXVlIGV2YWx1w6ksIGxhIHByb2JhYmlsaWRhZCBmdWUgZGUgNDYuMzglLCBsbyBxdWUgcmVwcmVzZW50YSB1biByaWVzZ28gbW9kZXJhZG8uIEVuIGdlbmVyYWwsIGNvbnNpZGVybyBxdWUgZWwgbW9kZWxvIGVzIMO6dGlsIGNvbW8gaGVycmFtaWVudGEgcGFyYSBlc3RpbWFyIGVsIHJpZXNnbyB5IGFwb3lhciBsYSB0b21hIGRlIGRlY2lzaW9uZXMuDQo=