Regresion Logistica - Heart
Emilio Ciuffardi A01612569
2026-02-19
Instalar paquetes y llamar librerías
# install.packages("titanic")
library(titanic)
# 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.1.4 ✔ readr 2.1.6
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ lubridate 1.9.4 ✔ tibble 3.3.0
## ✔ purrr 1.2.0 ✔ 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 errorslibrary(dplyr)Crear la base de datos
heart <- read.csv("C:\\Users\\Emili\\OneDrive\\Desktop\\TEC\\Tec 6to Semestre Concentracion\\Modulo 2\\Archivos CSV\\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.0000str(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 ...Limpiar la base de datos
heart <- heart %>% select(-slope, -fbs)
heart <- na.omit(heart)
heart$sex <- as.factor(heart$sex)
heart$cp <- as.factor(heart$cp)
heart$restecg <- as.factor(heart$restecg)
heart$exang <- as.factor(heart$exang)
heart$ca <- as.factor(heart$ca)
heart$thal <- as.factor(heart$thal)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) -0.725058 1.717509 -0.422 0.672910
## age 0.020809 0.013851 1.502 0.132996
## sex1 -1.684486 0.296195 -5.687 1.29e-08 ***
## cp1 0.983753 0.301704 3.261 0.001112 **
## cp2 1.902427 0.270775 7.026 2.13e-12 ***
## cp3 2.102385 0.368328 5.708 1.14e-08 ***
## trestbps -0.021882 0.006284 -3.482 0.000498 ***
## chol -0.005749 0.002230 -2.578 0.009947 **
## restecg1 0.478813 0.213759 2.240 0.025093 *
## restecg2 -0.702944 1.599559 -0.439 0.660327
## thalach 0.028230 0.006228 4.532 5.83e-06 ***
## exang1 -0.790824 0.244171 -3.239 0.001200 **
## oldpeak -0.617427 0.121957 -5.063 4.13e-07 ***
## ca1 -2.009666 0.264895 -7.587 3.28e-14 ***
## ca2 -3.002481 0.397583 -7.552 4.29e-14 ***
## ca3 -1.962875 0.483527 -4.059 4.92e-05 ***
## ca4 0.971714 0.935472 1.039 0.298925
## thal1 2.260062 1.129027 2.002 0.045309 *
## thal2 2.112730 1.068003 1.978 0.047905 *
## thal3 0.580400 1.069570 0.543 0.587372
## ---
## 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: 635.44 on 1005 degrees of freedom
## AIC: 675.44
##
## Number of Fisher Scoring iterations: 6Probar el modelo
prueba <- data.frame(cp=as.factor(c(0,0)),
sex=as.factor(c(1,1)),
age=c(52,53),
trestbps=c(125,140),
chol=c(212,203),
restecg=as.factor(c(1,0)),
thalach=c(168,155),
exang=as.factor(c(0,1)),
oldpeak=c(1,3.1),
ca=as.factor(c(2,0)),
thal=as.factor(c(3,3))
)
probabilidad <- predict(modelo, newdata=prueba, type="response")
cbind(prueba, Probabilidad_con_Enfermedad=probabilidad)## cp sex age trestbps chol restecg thalach exang oldpeak ca thal
## 1 0 1 52 125 212 1 168 0 1.0 2 3
## 2 0 1 53 140 203 0 155 1 3.1 0 3
## Probabilidad_con_Enfermedad
## 1 0.04312255
## 2 0.03605279Conclusiones
Primero que nada cabe mencionar que: Las variables slope y fbs
fueron removidas del modelo, ya que no demostraban niguna significancia
para la prediccion.
Al hacer la prediccion con los dos primeros renglones, los
resultados nos dieron cercanos a 0 (0.04 y 0.03), los datos actuales son
0, lo cual indica que el modelo tiene una prediccion correcta.