SVM (Lineal) - Enfermedad Cardíaca
Naila Salinas - A00832702
2024-08-22
Teoría
El paquete caret (Clasification And Regression Training) es un paquete integral con una amplia variedad de algoritmos para el aprendizaje automático.
Instalar paquetes y llamar librerías
#install.packages("caret")
library(caret)## Warning: package 'caret' was built under R version 4.3.3## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.3.3## Loading required package: lattice## Warning: package 'lattice' was built under R version 4.3.3#install.packages("e1071")
library(e1071)## Warning: package 'e1071' was built under R version 4.3.1#Crear base de datos
df<-read.csv("C:\\Users\\naila\\OneDrive\\Documentos\\1 TEC\\7MO SEMESTRE\\M2\\heart.csv")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.0000str(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$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.000str(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 : Factor w/ 2 levels "0","1": 1 1 1 1 1 2 1 1 1 1 ...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, ]Construir el modelo svm
modelo <- svm(target ~ ., data = entrenamiento, kernel = "linear")
resultado_entrenamiento <- predict(modelo,entrenamiento)
resultado_prueba <- predict(modelo,prueba)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.8480392Obtener 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
)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 cardíaca.
LS0tDQp0aXRsZTogIlNWTSAoTGluZWFsKSAtIEVuZmVybWVkYWQgQ2FyZMOtYWNhIg0KYXV0aG9yOiAiTmFpbGEgU2FsaW5hcyAtIEEwMDgzMjcwMiINCmRhdGU6ICIyMDI0LTA4LTIyIg0Kb3V0cHV0OiANCiBodG1sX2RvY3VtZW50Og0KICAgIHRvYzogdHJ1ZQ0KICAgIHRvY19mbG9hdDogdHJ1ZQ0KICAgIGNvZGVfZG93bmxvYWQ6IHRydWUNCiAgICB0aGVtZTogZmxhdGx5IA0KLS0tDQoNCiFbXShDOlxcVXNlcnNcXG5haWxhXFxPbmVEcml2ZVxcRG9jdW1lbnRvc1xcMSBURUNcXDdNTyBTRU1FU1RSRVxcTTJcXGhlYXJ0Mi5naWYpDQoNCiMgVGVvcsOtYQ0KDQpFbCBwYXF1ZXRlIGNhcmV0IChDbGFzaWZpY2F0aW9uIEFuZCBSZWdyZXNzaW9uIFRyYWluaW5nKSBlcyB1biBwYXF1ZXRlIGludGVncmFsIGNvbiB1bmEgYW1wbGlhIHZhcmllZGFkIGRlIGFsZ29yaXRtb3MgcGFyYSBlbCBhcHJlbmRpemFqZSBhdXRvbcOhdGljby4NCg0KIyBJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXLDrWFzDQpgYGB7cn0NCiNpbnN0YWxsLnBhY2thZ2VzKCJjYXJldCIpDQpsaWJyYXJ5KGNhcmV0KQ0KI2luc3RhbGwucGFja2FnZXMoImUxMDcxIikNCmxpYnJhcnkoZTEwNzEpDQpgYGANCg0KDQojQ3JlYXIgYmFzZSBkZSBkYXRvcw0KYGBge3J9DQpkZjwtcmVhZC5jc3YoIkM6XFxVc2Vyc1xcbmFpbGFcXE9uZURyaXZlXFxEb2N1bWVudG9zXFwxIFRFQ1xcN01PIFNFTUVTVFJFXFxNMlxcaGVhcnQuY3N2IikNCmBgYA0KDQoNCiMgQW7DoWxpc2lzIGV4cGxvcmF0b3Jpbw0KYGBge3J9DQpzdW1tYXJ5KGRmKQ0Kc3RyKGRmKQ0KZGYkdGFyZ2V0IDwtIGFzLmZhY3RvcihkZiR0YXJnZXQpDQpzdW1tYXJ5KGRmKQ0Kc3RyKGRmKQ0KYGBgDQoNCg0KIyBQYXJ0aXIgbGEgYmFzZSBkZSBkYXRvcw0KYGBge3J9DQpzZXQuc2VlZCgxMjMpDQpyZW5nbG9uZXNfZW50cmVuYW1pZW50byA8LSBjcmVhdGVEYXRhUGFydGl0aW9uKGRmJHRhcmdldCwgcD0wLjgsIGxpc3Q9RkFMU0UpDQplbnRyZW5hbWllbnRvIDwtIGRmW3Jlbmdsb25lc19lbnRyZW5hbWllbnRvLCBdDQpwcnVlYmEgPC0gZGZbLXJlbmdsb25lc19lbnRyZW5hbWllbnRvLCBdDQpgYGANCg0KDQoNCiMgQ29uc3RydWlyIGVsIG1vZGVsbyBzdm0NCg0KYGBge3J9DQptb2RlbG8gPC0gc3ZtKHRhcmdldCB+IC4sIGRhdGEgPSBlbnRyZW5hbWllbnRvLCBrZXJuZWwgPSAibGluZWFyIikNCnJlc3VsdGFkb19lbnRyZW5hbWllbnRvIDwtIHByZWRpY3QobW9kZWxvLGVudHJlbmFtaWVudG8pDQpyZXN1bHRhZG9fcHJ1ZWJhIDwtIHByZWRpY3QobW9kZWxvLHBydWViYSkNCmBgYA0KDQoNCiMgTWF0cml6IGRlIENvbmZ1c2nDs24NCmBgYHtyfQ0KbWNyZSA8LSBjb25mdXNpb25NYXRyaXgocmVzdWx0YWRvX2VudHJlbmFtaWVudG8sIGVudHJlbmFtaWVudG8kdGFyZ2V0KSAjIG1hdHJpeiBkZSBjb25mdXNpw7NuIGRlbCByZXN1bHRhZG8gZGVsIGVudHJlbmFtaWVudG8NCm1jcmUNCm1jcnAgPC0gY29uZnVzaW9uTWF0cml4KHJlc3VsdGFkb19wcnVlYmEscHJ1ZWJhJHRhcmdldCkgIyBtYXRyaXogZGUgY29uZnVzacOzbiBkZWwgcmVzdWx0YWRvIGRlIGxhIHBydWViYQ0KbWNycA0KYGBgDQoNCg0KYGBge3J9DQpyZXN1bHRhZG9zIDwtIGRhdGEuZnJhbWUoInN2bSBsaW5lYWwiID0gYyhtY3JlJG92ZXJhbGxbIkFjY3VyYWN5Il0sIG1jcnAkb3ZlcmFsbFsiQWNjdXJhY3kiXSkpDQpyb3duYW1lcyhyZXN1bHRhZG9zKSA8LSBjKCJQcmVjaXNpb24gZGUgZW50cmVuYW1pZW50byIsICJQcmVjaXNpb24gZGUgcHJ1ZWJhIikNCnJlc3VsdGFkb3MNCg0KYGBgDQoNCg0KDQojIE9idGVuZXIgcHJlZGljY2nDs24NCmBgYHtyfQ0KcGFjaWVudGUgPC0gZGF0YS5mcmFtZSgNCiAgYWdlID0gNTgsDQogIHNleCA9IDAsDQogIGNwID0gMCwNCiAgdHJlc3RicHMgPSAxMDAsDQogIGNob2wgPSAyNDgsDQogIGZicyA9IDAsDQogIHJlc3RlY2cgPSAwLA0KICB0aGFsYWNoID0gMTIyLA0KICBleGFuZyA9IDAsDQogIG9sZHBlYWsgPSAxLA0KICBzbG9wZSA9IDEsDQogIGNhID0gMCwNCiAgdGhhbCA9IDINCikNCmBgYA0KDQoNCg0KIyBIYWNlciBsYSBwcmVkaWNjacOzbg0KYGBge3J9DQpwcmVkaWNjaW9uIDwtIHByZWRpY3QobW9kZWxvLCBwYWNpZW50ZSkNCg0KaWYocHJlZGljY2lvbiA9PSAxKSB7DQogIHByaW50KCJUaWVuZSBlbmZlcm1lZGFkIGNhcmTDrWFjYSIpDQp9IGVsc2Ugew0KICBwcmludCgiTm8gdGllbmUgZW5mZXJtZWRhZCBjYXJkw61hY2EiKQ0KfQ0KYGBgDQoNCiMgQ29uY2x1c2nDs24NCg0KRW4gY29uY2x1c2nDs24sIGxhIE3DoXF1aW5hIGRlIFZlY3RvcmVzIGRlIFNvcG9ydGUgZXMgdW5hIGhlcnJhbWllbnRhIHJvYnVzdGEgcGFyYSBsYSBwcmVkaWNjacOzbiBkZSBkaWFnbsOzc3RpY28gZW4gZW5mZXJtZWRhZCBjYXJkw61hY2Eu