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