Heart

# Regresión Lineal
# Importar la base de datos de csv
df <- read.csv("/Users/edu_sssedu/Desktop/Concentración/heart.csv")

Entender la base de 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$sex <- as.factor(df$sex)
df$cp <- as.factor(df$cp)
df$fbs <- as.factor(df$fbs)
df$restecg <- as.factor(df$restecg)
df$exang <- as.factor(df$exang)
df$slope <- as.factor(df$slope)
df$thal <- as.factor(df$thal)
df$target <- as.factor(df$target)

Crear el modelo

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.974938   1.843806   0.529 0.596969    
## age         -0.004314   0.012820  -0.337 0.736479    
## sex1        -1.610703   0.283425  -5.683 1.32e-08 ***
## cp1          1.061225   0.301235   3.523 0.000427 ***
## cp2          1.963836   0.257085   7.639 2.19e-14 ***
## cp3          1.989568   0.352181   5.649 1.61e-08 ***
## trestbps    -0.014901   0.005819  -2.561 0.010443 *  
## chol        -0.005541   0.002130  -2.602 0.009277 ** 
## fbs1         0.048261   0.304550   0.158 0.874090    
## restecg1     0.511138   0.202653   2.522 0.011661 *  
## restecg2    -0.402546   1.224640  -0.329 0.742378    
## thalach      0.018227   0.005859   3.111 0.001865 ** 
## exang1      -0.751473   0.233353  -3.220 0.001280 ** 
## oldpeak     -0.506650   0.122129  -4.148 3.35e-05 ***
## slope1      -0.540297   0.456438  -1.184 0.236522    
## slope2       0.269358   0.492490   0.547 0.584427    
## ca          -0.813103   0.109901  -7.399 1.38e-13 ***
## thal1        1.918293   1.306918   1.468 0.142159    
## thal2        1.855539   1.263123   1.469 0.141831    
## thal3        0.523928   1.268851   0.413 0.679668    
## ---
## 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:  688.48  on 1005  degrees of freedom
## AIC: 728.48
## 
## Number of Fisher Scoring iterations: 6

Probar el modelo

prueba <- data.frame(
  age      = c(57, 65),
  sex      = factor(c(1, 0), levels = levels(df$sex)),
  cp       = factor(c(2, 2), levels = levels(df$cp)),
  trestbps = c(128, 160),
  chol     = c(229, 360),
  fbs      = factor(c(0, 0), levels = levels(df$fbs)),
  restecg  = factor(c(0, 0), levels = levels(df$restecg)),
  thalach  = c(150, 151),
  exang    = factor(c(0, 0), levels = levels(df$exang)),
  oldpeak  = c(0.4, 0.8),
  slope    = factor(c(1, 1), levels = levels(df$slope)),
  ca       = c(0, 0),
  thal     = factor(c(2, 2), levels = levels(df$thal))
)

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

##   age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal
## 1  57   1  2      128  229   0       0     150     0     0.4     1  0    2
## 2  65   0  2      160  360   0       0     151     0     0.8     1  0    2
##   Probabilidad_Target1
## 1            0.8522842
## 2            0.8745388

Conclusiones

Para ambos pacientes, el modelo predice una alta probabilidad de pertenecer a la clase objetivo (target=1), con 0.85 y 0.87 respectivamente. El segundo perfil presenta una probabilidad ligeramente mayor, por lo que, según el modelo, se asocia más fuertemente con la clase target=1.