library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
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 <- read.csv("C:\\Users\\Emili\\Downloads\\heart.csv")

Entender la base de datos

summary(df_heart)
##       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_heart)
## '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_heart <- df_heart[, c("target", "age", "sex", "cp", "trestbps")]

df_heart <- na.omit(df_heart)
df_heart$target <- as.factor(df_heart$target)
df_heart$sex <- as.factor(df_heart$sex)
df_heart$cp <- as.factor(df_heart$cp)

Crear el modelo

modelo_heart <- glm(target ~ ., data = df_heart, family = binomial)
summary(modelo_heart)
## 
## Call:
## glm(formula = target ~ ., family = binomial, data = df_heart)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  5.597948   0.771247   7.258 3.92e-13 ***
## age         -0.058606   0.009789  -5.987 2.13e-09 ***
## sex1        -1.876644   0.194347  -9.656  < 2e-16 ***
## cp1          2.559724   0.241903  10.582  < 2e-16 ***
## cp2          2.427250   0.195103  12.441  < 2e-16 ***
## cp3          2.452060   0.296854   8.260  < 2e-16 ***
## trestbps    -0.017126   0.004637  -3.693 0.000222 ***
## ---
## 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:  975.64  on 1018  degrees of freedom
## AIC: 989.64
## 
## Number of Fisher Scoring iterations: 5

Probar el modelo

prueba_heart <- data.frame(
  age = c(55, 40),
  sex = as.factor(c(1, 0)),
  cp = as.factor(c(0, 2)),
  trestbps = c(140, 120)
)

probabilidad_heart <- predict(modelo_heart, newdata = prueba_heart, type = "response")

cbind(prueba_heart, Probabilidad_Enfermedad = probabilidad_heart)
##   age sex cp trestbps Probabilidad_Enfermedad
## 1  55   1  0      140               0.1301523
## 2  40   0  2      120               0.9740650

Conclusiones:

El modelo no solo te dice “quién está enfermo”, sino que te da una probabilidad (0 a 1). Esto es mucho más útil para la prevención médica que un simple “sí” o “no”.

Probablemente notarás que el tipo de dolor de pecho (cp) y la edad son los predictores más potentes. Esto confirma que los síntomas clínicos inmediatos suelen ser más informativos que una sola medida de presión arterial.

Gracias a la tabla final de probabilidad_heart, podemos concluir que individuos con mayor edad y síntomas de dolor de pecho tipo “asintomático” o “angina atípica” deben tener un seguimiento más riguroso.

LS0tDQp0aXRsZTogIkhlYXJ0IERlc2Vhc2UiDQphdXRob3I6ICJFbWlsaW8gVmlsbGFudWV2YSAtIEEwMTI4NTkxMCINCmRhdGU6ICIyMDI2LTAyLTE5Ig0Kb3V0cHV0OiANCiAgaHRtbF9kb2N1bWVudDogIA0KICAgIHRvYzogVFJVRQ0KICAgIHRvY19mbG9hdDogVFJVRQ0KICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUNCiAgICB0aGVtZTogY29zbW8NCi0tLQ0KDQo8Y2VudGVyPg0KIVtdKGh0dHBzOi8vc3RhdGljLndpeHN0YXRpYy5jb20vbWVkaWEvN2FmZDRiXzY1OGRlZWFlYmY4NzRhNDA5ZGJjZDk1ZGJlNDdkODczfm12Mi5naWYpDQpgYGB7cn0NCmxpYnJhcnkoY2FyZXQpDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmBgYA0KDQojIFsgQ3JlYXIgbGEgYmFzZSBkZSBkYXRvcyBde3N0eWxlPSJjb2xvcjpibHVlIn0NCg0KYGBge3J9DQpkZl9oZWFydCA8LSByZWFkLmNzdigiQzpcXFVzZXJzXFxFbWlsaVxcRG93bmxvYWRzXFxoZWFydC5jc3YiKQ0KYGBgDQoNCiMgWyBFbnRlbmRlciBsYSBiYXNlIGRlIGRhdG9zIF17c3R5bGU9ImNvbG9yOmJsdWUifQ0KDQpgYGB7cn0NCnN1bW1hcnkoZGZfaGVhcnQpDQpzdHIoZGZfaGVhcnQpDQoNCmRmX2hlYXJ0IDwtIGRmX2hlYXJ0WywgYygidGFyZ2V0IiwgImFnZSIsICJzZXgiLCAiY3AiLCAidHJlc3RicHMiKV0NCg0KZGZfaGVhcnQgPC0gbmEub21pdChkZl9oZWFydCkNCmRmX2hlYXJ0JHRhcmdldCA8LSBhcy5mYWN0b3IoZGZfaGVhcnQkdGFyZ2V0KQ0KZGZfaGVhcnQkc2V4IDwtIGFzLmZhY3RvcihkZl9oZWFydCRzZXgpDQpkZl9oZWFydCRjcCA8LSBhcy5mYWN0b3IoZGZfaGVhcnQkY3ApDQpgYGANCg0KIyBbIENyZWFyIGVsIG1vZGVsbyBde3N0eWxlPSJjb2xvcjpibHVlIn0NCg0KYGBge3J9DQptb2RlbG9faGVhcnQgPC0gZ2xtKHRhcmdldCB+IC4sIGRhdGEgPSBkZl9oZWFydCwgZmFtaWx5ID0gYmlub21pYWwpDQpzdW1tYXJ5KG1vZGVsb19oZWFydCkNCmBgYA0KDQojIFsgUHJvYmFyIGVsIG1vZGVsbyBde3N0eWxlPSJjb2xvcjpibHVlIn0NCg0KYGBge3J9DQpwcnVlYmFfaGVhcnQgPC0gZGF0YS5mcmFtZSgNCiAgYWdlID0gYyg1NSwgNDApLA0KICBzZXggPSBhcy5mYWN0b3IoYygxLCAwKSksDQogIGNwID0gYXMuZmFjdG9yKGMoMCwgMikpLA0KICB0cmVzdGJwcyA9IGMoMTQwLCAxMjApDQopDQoNCnByb2JhYmlsaWRhZF9oZWFydCA8LSBwcmVkaWN0KG1vZGVsb19oZWFydCwgbmV3ZGF0YSA9IHBydWViYV9oZWFydCwgdHlwZSA9ICJyZXNwb25zZSIpDQoNCmNiaW5kKHBydWViYV9oZWFydCwgUHJvYmFiaWxpZGFkX0VuZmVybWVkYWQgPSBwcm9iYWJpbGlkYWRfaGVhcnQpDQpgYGANCg0KQ29uY2x1c2lvbmVzOg0KDQpFbCBtb2RlbG8gbm8gc29sbyB0ZSBkaWNlICJxdWnDqW4gZXN0w6EgZW5mZXJtbyIsIHNpbm8gcXVlIHRlIGRhIHVuYSBwcm9iYWJpbGlkYWQgKDAgYSAxKS4gRXN0byBlcyBtdWNobyBtw6FzIMO6dGlsIHBhcmEgbGEgcHJldmVuY2nDs24gbcOpZGljYSBxdWUgdW4gc2ltcGxlICJzw60iIG8gIm5vIi4NCg0KUHJvYmFibGVtZW50ZSBub3RhcsOhcyBxdWUgZWwgdGlwbyBkZSBkb2xvciBkZSBwZWNobyAoY3ApIHkgbGEgZWRhZCBzb24gbG9zIHByZWRpY3RvcmVzIG3DoXMgcG90ZW50ZXMuIEVzdG8gY29uZmlybWEgcXVlIGxvcyBzw61udG9tYXMgY2zDrW5pY29zIGlubWVkaWF0b3Mgc3VlbGVuIHNlciBtw6FzIGluZm9ybWF0aXZvcyBxdWUgdW5hIHNvbGEgbWVkaWRhIGRlIHByZXNpw7NuIGFydGVyaWFsLg0KDQpHcmFjaWFzIGEgbGEgdGFibGEgZmluYWwgZGUgcHJvYmFiaWxpZGFkX2hlYXJ0LCBwb2RlbW9zIGNvbmNsdWlyIHF1ZSBpbmRpdmlkdW9zIGNvbiBtYXlvciBlZGFkIHkgc8OtbnRvbWFzIGRlIGRvbG9yIGRlIHBlY2hvIHRpcG8gImFzaW50b23DoXRpY28iIG8gImFuZ2luYSBhdMOtcGljYSIgZGViZW4gdGVuZXIgdW4gc2VndWltaWVudG8gbcOhcyByaWd1cm9zby4NCg==