Paso 1. Instalar paquetes y llamar librerías

#install.packages("e1071")
library(e1071) 
#install.packages("caret") 
library(caret)
## Cargando paquete requerido: ggplot2
## Cargando paquete requerido: lattice

Paso 2. Crear la base de datos

# file.choose()
library(readr)
df <- read_csv("heart.csv")
## Rows: 1025 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (14): age, sex, cp, trestbps, chol, fbs, restecg, thalach, exang, oldpea...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#view(heart)

Paso 3. Análisis exploratorio

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)
## spc_tbl_ [1,025 × 14] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ age     : num [1:1025] 52 53 70 61 62 58 58 55 46 54 ...
##  $ sex     : num [1:1025] 1 1 1 1 0 0 1 1 1 1 ...
##  $ cp      : num [1:1025] 0 0 0 0 0 0 0 0 0 0 ...
##  $ trestbps: num [1:1025] 125 140 145 148 138 100 114 160 120 122 ...
##  $ chol    : num [1:1025] 212 203 174 203 294 248 318 289 249 286 ...
##  $ fbs     : num [1:1025] 0 1 0 0 1 0 0 0 0 0 ...
##  $ restecg : num [1:1025] 1 0 1 1 1 0 2 0 0 0 ...
##  $ thalach : num [1:1025] 168 155 125 161 106 122 140 145 144 116 ...
##  $ exang   : num [1:1025] 0 1 1 0 0 0 0 1 0 1 ...
##  $ oldpeak : num [1:1025] 1 3.1 2.6 0 1.9 1 4.4 0.8 0.8 3.2 ...
##  $ slope   : num [1:1025] 2 0 0 2 1 1 0 1 2 1 ...
##  $ ca      : num [1:1025] 2 0 0 1 3 0 3 1 0 2 ...
##  $ thal    : num [1:1025] 3 3 3 3 2 2 1 3 3 2 ...
##  $ target  : num [1:1025] 0 0 0 0 0 1 0 0 0 0 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   age = col_double(),
##   ..   sex = col_double(),
##   ..   cp = col_double(),
##   ..   trestbps = col_double(),
##   ..   chol = col_double(),
##   ..   fbs = col_double(),
##   ..   restecg = col_double(),
##   ..   thalach = col_double(),
##   ..   exang = col_double(),
##   ..   oldpeak = col_double(),
##   ..   slope = col_double(),
##   ..   ca = col_double(),
##   ..   thal = col_double(),
##   ..   target = col_double()
##   .. )
##  - attr(*, "problems")=<externalptr>
df$target <- as.factor(df$target)
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   0:499  
##  1st Qu.:2.000   1:526  
##  Median :2.000          
##  Mean   :2.324          
##  3rd Qu.:3.000          
##  Max.   :3.000
str(df)
## spc_tbl_ [1,025 × 14] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ age     : num [1:1025] 52 53 70 61 62 58 58 55 46 54 ...
##  $ sex     : num [1:1025] 1 1 1 1 0 0 1 1 1 1 ...
##  $ cp      : num [1:1025] 0 0 0 0 0 0 0 0 0 0 ...
##  $ trestbps: num [1:1025] 125 140 145 148 138 100 114 160 120 122 ...
##  $ chol    : num [1:1025] 212 203 174 203 294 248 318 289 249 286 ...
##  $ fbs     : num [1:1025] 0 1 0 0 1 0 0 0 0 0 ...
##  $ restecg : num [1:1025] 1 0 1 1 1 0 2 0 0 0 ...
##  $ thalach : num [1:1025] 168 155 125 161 106 122 140 145 144 116 ...
##  $ exang   : num [1:1025] 0 1 1 0 0 0 0 1 0 1 ...
##  $ oldpeak : num [1:1025] 1 3.1 2.6 0 1.9 1 4.4 0.8 0.8 3.2 ...
##  $ slope   : num [1:1025] 2 0 0 2 1 1 0 1 2 1 ...
##  $ ca      : num [1:1025] 2 0 0 1 3 0 3 1 0 2 ...
##  $ thal    : num [1:1025] 3 3 3 3 2 2 1 3 3 2 ...
##  $ target  : Factor w/ 2 levels "0","1": 1 1 1 1 1 2 1 1 1 1 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   age = col_double(),
##   ..   sex = col_double(),
##   ..   cp = col_double(),
##   ..   trestbps = col_double(),
##   ..   chol = col_double(),
##   ..   fbs = col_double(),
##   ..   restecg = col_double(),
##   ..   thalach = col_double(),
##   ..   exang = col_double(),
##   ..   oldpeak = col_double(),
##   ..   slope = col_double(),
##   ..   ca = col_double(),
##   ..   thal = col_double(),
##   ..   target = col_double()
##   .. )
##  - attr(*, "problems")=<externalptr>

Paso 4. Partir la base de datos

# Partir la base de datos
set.seed(123)
renglones_entrenamiento <- createDataPartition(df$target, p=0.8, list=FALSE)
entrenamiento <- df[renglones_entrenamiento, ]
prueba <- df[-renglones_entrenamiento, ]

Paso 5. Construir modelo SVM Linear

modelo <- svm(target ~ ., data = entrenamiento, kernel = "linear")
resultado_entrenamiento <- predict(modelo,entrenamiento)
resultado_prueba <- predict(modelo,prueba)

Paso 6. Matriz de Confusión

mcre <- confusionMatrix(resultado_entrenamiento, entrenamiento$target) # matriz de confusión del resultado del entrenamiento
mcre
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 301  37
##          1  99 384
##                                           
##                Accuracy : 0.8343          
##                  95% CI : (0.8071, 0.8592)
##     No Information Rate : 0.5128          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.6672          
##                                           
##  Mcnemar's Test P-Value : 1.689e-07       
##                                           
##             Sensitivity : 0.7525          
##             Specificity : 0.9121          
##          Pos Pred Value : 0.8905          
##          Neg Pred Value : 0.7950          
##              Prevalence : 0.4872          
##          Detection Rate : 0.3666          
##    Detection Prevalence : 0.4117          
##       Balanced Accuracy : 0.8323          
##                                           
##        'Positive' Class : 0               
## 
mcrp <- confusionMatrix(resultado_prueba,prueba$target) # matriz de confusión del resultado de la prueba
mcrp
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 78 10
##          1 21 95
##                                           
##                Accuracy : 0.848           
##                  95% CI : (0.7913, 0.8944)
##     No Information Rate : 0.5147          
##     P-Value [Acc > NIR] : < 2e-16         
##                                           
##                   Kappa : 0.6948          
##                                           
##  Mcnemar's Test P-Value : 0.07249         
##                                           
##             Sensitivity : 0.7879          
##             Specificity : 0.9048          
##          Pos Pred Value : 0.8864          
##          Neg Pred Value : 0.8190          
##              Prevalence : 0.4853          
##          Detection Rate : 0.3824          
##    Detection Prevalence : 0.4314          
##       Balanced Accuracy : 0.8463          
##                                           
##        'Positive' Class : 0               
## 
resultados <- data.frame("svm lineal" = c(mcre$overall["Accuracy"], mcrp$overall["Accuracy"]))
rownames(resultados) <- c("Precision de entrenamiento", "Precision de prueba")
resultados
##                            svm.lineal
## Precision de entrenamiento  0.8343484
## Precision de prueba         0.8480392

Paso 7. Obtener predicción

paciente <- data.frame(
  age = 58,
  sex = 0,
  cp = 0,
  trestbps = 100,
  chol = 248,
  fbs = 0,
  restecg = 0,
  thalach = 122,
  exang = 0,
  oldpeak = 1,
  slope = 1,
  ca = 0,
  thal = 2
)

Paso 8. Hacer la predicción

prediccion <- predict(modelo, paciente)

if(prediccion == 1) {
  print("Tiene enfermedad cardíaca")
} else {
  print("No tiene enfermedad cardíaca")
}
## [1] "Tiene enfermedad cardíaca"

Conclusión

En conclusión, la Máquina de Vectores de Soporte es una herramienta robusta para la predicción de diagnóstico en enfermedad cardiaca.

LS0tDQp0aXRsZTogIk3DoXF1aW5hIGRlIFZlY3RvcmVzIGRlIFNvcG9ydGUiDQphdXRob3I6ICJMaWxpdEhfQ3VldmFzX0EwMTQyMjc0OSINCmRhdGU6ICIyMDI1LTAyLTI3Ig0Kb3V0cHV0Og0KIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2F0OiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KICAgIHRoZW1lOiBjb3Ntbw0KLS0tDQoNCiFbXShHSUYpDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+UGFzbyAxLiBJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXLDrWFzPC9zcGFuPiANCmBgYHtyfQ0KI2luc3RhbGwucGFja2FnZXMoImUxMDcxIikNCmxpYnJhcnkoZTEwNzEpIA0KI2luc3RhbGwucGFja2FnZXMoImNhcmV0IikgDQpsaWJyYXJ5KGNhcmV0KQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+UGFzbyAyLiBDcmVhciBsYSBiYXNlIGRlIGRhdG9zPC9zcGFuPiANCg0KYGBge3J9DQojIGZpbGUuY2hvb3NlKCkNCmxpYnJhcnkocmVhZHIpDQpkZiA8LSByZWFkX2NzdigiaGVhcnQuY3N2IikNCiN2aWV3KGhlYXJ0KQ0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+UGFzbyAzLiBBbsOhbGlzaXMgZXhwbG9yYXRvcmlvPC9zcGFuPiANCmBgYHtyfQ0Kc3VtbWFyeShkZikNCnN0cihkZikNCmRmJHRhcmdldCA8LSBhcy5mYWN0b3IoZGYkdGFyZ2V0KQ0Kc3VtbWFyeShkZikNCnN0cihkZikNCmBgYA0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiPlBhc28gNC4gUGFydGlyIGxhIGJhc2UgZGUgZGF0b3M8L3NwYW4+IA0KYGBge3J9DQojIFBhcnRpciBsYSBiYXNlIGRlIGRhdG9zDQpzZXQuc2VlZCgxMjMpDQpyZW5nbG9uZXNfZW50cmVuYW1pZW50byA8LSBjcmVhdGVEYXRhUGFydGl0aW9uKGRmJHRhcmdldCwgcD0wLjgsIGxpc3Q9RkFMU0UpDQplbnRyZW5hbWllbnRvIDwtIGRmW3Jlbmdsb25lc19lbnRyZW5hbWllbnRvLCBdDQpwcnVlYmEgPC0gZGZbLXJlbmdsb25lc19lbnRyZW5hbWllbnRvLCBdDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij5QYXNvIDUuIENvbnN0cnVpciBtb2RlbG8gU1ZNIExpbmVhcjwvc3Bhbj4NCmBgYHtyfQ0KbW9kZWxvIDwtIHN2bSh0YXJnZXQgfiAuLCBkYXRhID0gZW50cmVuYW1pZW50bywga2VybmVsID0gImxpbmVhciIpDQpyZXN1bHRhZG9fZW50cmVuYW1pZW50byA8LSBwcmVkaWN0KG1vZGVsbyxlbnRyZW5hbWllbnRvKQ0KcmVzdWx0YWRvX3BydWViYSA8LSBwcmVkaWN0KG1vZGVsbyxwcnVlYmEpDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij5QYXNvIDYuIE1hdHJpeiBkZSBDb25mdXNpw7NuPC9zcGFuPiANCmBgYHtyfQ0KbWNyZSA8LSBjb25mdXNpb25NYXRyaXgocmVzdWx0YWRvX2VudHJlbmFtaWVudG8sIGVudHJlbmFtaWVudG8kdGFyZ2V0KSAjIG1hdHJpeiBkZSBjb25mdXNpw7NuIGRlbCByZXN1bHRhZG8gZGVsIGVudHJlbmFtaWVudG8NCm1jcmUNCm1jcnAgPC0gY29uZnVzaW9uTWF0cml4KHJlc3VsdGFkb19wcnVlYmEscHJ1ZWJhJHRhcmdldCkgIyBtYXRyaXogZGUgY29uZnVzacOzbiBkZWwgcmVzdWx0YWRvIGRlIGxhIHBydWViYQ0KbWNycA0KYGBgDQoNCmBgYHtyfQ0KcmVzdWx0YWRvcyA8LSBkYXRhLmZyYW1lKCJzdm0gbGluZWFsIiA9IGMobWNyZSRvdmVyYWxsWyJBY2N1cmFjeSJdLCBtY3JwJG92ZXJhbGxbIkFjY3VyYWN5Il0pKQ0Kcm93bmFtZXMocmVzdWx0YWRvcykgPC0gYygiUHJlY2lzaW9uIGRlIGVudHJlbmFtaWVudG8iLCAiUHJlY2lzaW9uIGRlIHBydWViYSIpDQpyZXN1bHRhZG9zDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij5QYXNvIDcuIE9idGVuZXIgcHJlZGljY2nDs248L3NwYW4+IA0KYGBge3J9DQoNCnBhY2llbnRlIDwtIGRhdGEuZnJhbWUoDQogIGFnZSA9IDU4LA0KICBzZXggPSAwLA0KICBjcCA9IDAsDQogIHRyZXN0YnBzID0gMTAwLA0KICBjaG9sID0gMjQ4LA0KICBmYnMgPSAwLA0KICByZXN0ZWNnID0gMCwNCiAgdGhhbGFjaCA9IDEyMiwNCiAgZXhhbmcgPSAwLA0KICBvbGRwZWFrID0gMSwNCiAgc2xvcGUgPSAxLA0KICBjYSA9IDAsDQogIHRoYWwgPSAyDQopDQpgYGANCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij5QYXNvIDguIEhhY2VyIGxhIHByZWRpY2Npw7NuPC9zcGFuPiANCmBgYHtyfQ0KcHJlZGljY2lvbiA8LSBwcmVkaWN0KG1vZGVsbywgcGFjaWVudGUpDQoNCmlmKHByZWRpY2Npb24gPT0gMSkgew0KICBwcmludCgiVGllbmUgZW5mZXJtZWRhZCBjYXJkw61hY2EiKQ0KfSBlbHNlIHsNCiAgcHJpbnQoIk5vIHRpZW5lIGVuZmVybWVkYWQgY2FyZMOtYWNhIikNCn0NCg0KYGBgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+Q29uY2x1c2nDs248L3NwYW4+IA0KDQpFbiBjb25jbHVzacOzbiwgbGEgTcOhcXVpbmEgZGUgVmVjdG9yZXMgZGUgU29wb3J0ZSBlcyB1bmEgaGVycmFtaWVudGEgcm9idXN0YSBwYXJhIGxhIHByZWRpY2Npw7NuIGRlIGRpYWduw7NzdGljbyBlbiBlbmZlcm1lZGFkIGNhcmRpYWNhLg0KDQo=