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

Crear la base de datos

heart <- read.csv("C:\\Users\\evely\\Downloads\\heart.csv")

Entender la base de datos

summary(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(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 ...
# Seleccionar variables 
heart <- heart[, c("target", "age", "sex", "cp")]
heart <- na.omit(heart)

heart$target <- as.factor(heart$target)
heart$sex <- as.factor(heart$sex)
heart$cp <- as.factor(heart$cp)
# Crear el modelo
modelo <- glm(target ~ ., data=heart, family=binomial)
summary(modelo)
## 
## Call:
## glm(formula = target ~ ., family = binomial, data = heart)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  3.739627   0.573892   6.516 7.21e-11 ***
## age         -0.066961   0.009559  -7.005 2.47e-12 ***
## sex1        -1.791697   0.189715  -9.444  < 2e-16 ***
## cp1          2.561954   0.239299  10.706  < 2e-16 ***
## cp2          2.411452   0.192865  12.503  < 2e-16 ***
## cp3          2.274265   0.287080   7.922 2.34e-15 ***
## ---
## 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:  989.79  on 1019  degrees of freedom
## AIC: 1001.8
## 
## Number of Fisher Scoring iterations: 5
# Probar el modelo
prueba <- data.frame(
  age = c(40, 60),
  sex = as.factor(c(0,1)),
  cp = as.factor(c(1,3))
)

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

cbind(prueba, Probabilidad_Enfermedad=probabilidad)
##   age sex cp Probabilidad_Enfermedad
## 1  40   0  1               0.9739959
## 2  60   1  3               0.5509605

Conclusiones: El modelo estima la probabilidad de padecer enfermedad cardiaca según edad, sexo y tipo de dolor de pecho, y muestra que el riesgo depende de la combinación de factores más que de uno solo, esto indica que variables clínicas como el tipo de dolor y el sexo pueden influir más que la edad en la predicción, por lo que el riesgo no aumenta simplemente por ser mayor, sino por el perfil completo del paciente.

LS0tDQp0aXRsZTogIlJlZ3Jlc2nDs24gTG9nw61zdGljYSAtIEhlYXJ0Ig0KYXV0aG9yOiAiUmViZWNhIFJlY2lvIEEwMTM4NTUyMCINCmRhdGU6ICIyMDI2LTAyLTE5Ig0Kb3V0cHV0OiANCiAgaHRtbF9kb2N1bWVudDoNCiAgICB0b2M6IFRSVUUNCiAgICB0b2NfZmxvYXQ6IFRSVUUNCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFIA0KICAgIHRoZW1lOiBjb3Ntbw0KLS0tDQoNCiFbXShoZWFydC5wbmcpDQpgYGB7cn0NCiMgaW5zdGFsbC5wYWNrYWdlcygiY2FyZXQiKQ0KbGlicmFyeShjYXJldCkNCmBgYA0KDQpgYGB7cn0NCiMgaW5zdGFsbC5wYWNrYWdlcygidGlkeXZlcnNlIikNCmxpYnJhcnkodGlkeXZlcnNlKQ0KYGBgDQoNCiMgQ3JlYXIgbGEgYmFzZSBkZSBkYXRvcw0KYGBge3J9DQpoZWFydCA8LSByZWFkLmNzdigiQzpcXFVzZXJzXFxldmVseVxcRG93bmxvYWRzXFxoZWFydC5jc3YiKQ0KYGBgDQoNCiMgRW50ZW5kZXIgbGEgYmFzZSBkZSBkYXRvcw0KYGBge3J9DQpzdW1tYXJ5KGhlYXJ0KQ0Kc3RyKGhlYXJ0KQ0KYGBgDQpgYGB7cn0NCiMgU2VsZWNjaW9uYXIgdmFyaWFibGVzIA0KaGVhcnQgPC0gaGVhcnRbLCBjKCJ0YXJnZXQiLCAiYWdlIiwgInNleCIsICJjcCIpXQ0KaGVhcnQgPC0gbmEub21pdChoZWFydCkNCg0KaGVhcnQkdGFyZ2V0IDwtIGFzLmZhY3RvcihoZWFydCR0YXJnZXQpDQpoZWFydCRzZXggPC0gYXMuZmFjdG9yKGhlYXJ0JHNleCkNCmhlYXJ0JGNwIDwtIGFzLmZhY3RvcihoZWFydCRjcCkNCmBgYA0KDQpgYGB7cn0NCiMgQ3JlYXIgZWwgbW9kZWxvDQptb2RlbG8gPC0gZ2xtKHRhcmdldCB+IC4sIGRhdGE9aGVhcnQsIGZhbWlseT1iaW5vbWlhbCkNCnN1bW1hcnkobW9kZWxvKQ0KYGBgDQpgYGB7cn0NCiMgUHJvYmFyIGVsIG1vZGVsbw0KcHJ1ZWJhIDwtIGRhdGEuZnJhbWUoDQogIGFnZSA9IGMoNDAsIDYwKSwNCiAgc2V4ID0gYXMuZmFjdG9yKGMoMCwxKSksDQogIGNwID0gYXMuZmFjdG9yKGMoMSwzKSkNCikNCg0KcHJvYmFiaWxpZGFkIDwtIHByZWRpY3QobW9kZWxvLCBuZXdkYXRhPXBydWViYSwgdHlwZT0icmVzcG9uc2UiKQ0KDQpjYmluZChwcnVlYmEsIFByb2JhYmlsaWRhZF9FbmZlcm1lZGFkPXByb2JhYmlsaWRhZCkNCmBgYA0KIyBDb25jbHVzaW9uZXM6IEVsIG1vZGVsbyBlc3RpbWEgbGEgcHJvYmFiaWxpZGFkIGRlIHBhZGVjZXIgZW5mZXJtZWRhZCBjYXJkaWFjYSBzZWfDum4gZWRhZCwgc2V4byB5IHRpcG8gZGUgZG9sb3IgZGUgcGVjaG8sIHkgbXVlc3RyYSBxdWUgZWwgcmllc2dvIGRlcGVuZGUgZGUgbGEgY29tYmluYWNpw7NuIGRlIGZhY3RvcmVzIG3DoXMgcXVlIGRlIHVubyBzb2xvLCBlc3RvIGluZGljYSBxdWUgdmFyaWFibGVzIGNsw61uaWNhcyBjb21vIGVsIHRpcG8gZGUgZG9sb3IgeSBlbCBzZXhvIHB1ZWRlbiBpbmZsdWlyIG3DoXMgcXVlIGxhIGVkYWQgZW4gbGEgcHJlZGljY2nDs24sIHBvciBsbyBxdWUgZWwgcmllc2dvIG5vIGF1bWVudGEgc2ltcGxlbWVudGUgcG9yIHNlciBtYXlvciwgc2lubyBwb3IgZWwgcGVyZmlsIGNvbXBsZXRvIGRlbCBwYWNpZW50ZS4NCg0KDQoNCg0KDQoNCg0KDQoNCg0K