Instalar paquetes y llamar librerías

# install.packages("randomForest")
library(randomForest)
## randomForest 4.7-1.1
## Type rfNews() to see new features/changes/bug fixes.
# install.packages("caret") 
library(caret)
## Cargando paquete requerido: ggplot2
## 
## Adjuntando el paquete: 'ggplot2'
## The following object is masked from 'package:randomForest':
## 
##     margin
## Cargando paquete requerido: lattice

Crear la base de datos

df <- read.csv("C:\\Users\\sebas\\OneDrive\\Escritorio\\Inteligencia de Negocios\\Modulo 2\\22 08 2024\\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.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$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)
## '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 Random Forest

modelo <- randomForest(target ~ ., data = entrenamiento)


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 400   0
##          1   0 421
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9955, 1)
##     No Information Rate : 0.5128     
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.0000     
##             Specificity : 1.0000     
##          Pos Pred Value : 1.0000     
##          Neg Pred Value : 1.0000     
##              Prevalence : 0.4872     
##          Detection Rate : 0.4872     
##    Detection Prevalence : 0.4872     
##       Balanced Accuracy : 1.0000     
##                                      
##        '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  99   0
##          1   0 105
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9821, 1)
##     No Information Rate : 0.5147     
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
##                                      
##             Sensitivity : 1.0000     
##             Specificity : 1.0000     
##          Pos Pred Value : 1.0000     
##          Neg Pred Value : 1.0000     
##              Prevalence : 0.4853     
##          Detection Rate : 0.4853     
##    Detection Prevalence : 0.4853     
##       Balanced Accuracy : 1.0000     
##                                      
##        'Positive' Class : 0          
## 
resultados <- data.frame("rf" = c(mcre$overall["Accuracy"], mcrp$overall["Accuracy"]))
rownames(resultados) <- c("Precision de entrenamiento", "Precision de prueba")
resultados
##                            rf
## Precision de entrenamiento  1
## Precision de prueba         1

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
)

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

Los bosques aleatoreos es una herramienta para la predicción de datos de diagnostico, en este caso de si el paciente tiene una enfermedad cardíaca.

LS0tDQp0aXRsZTogIlJhbmRvbSBGb3Jlc3QiDQphdXRob3I6ICJQYWJsbyBTZWJhc3RpYW4iDQpkYXRlOiAiMjAyNC0wOC0yMiINCm91dHB1dDogDQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2F0OiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KICAgIHRoZW1lOiAic3BhY2VsYWIiDQogICAgaGlnaGxpZ2h0OiAia2F0ZSINCi0tLQ0KDQojIEluc3RhbGFyIHBhcXVldGVzIHkgbGxhbWFyIGxpYnJlcsOtYXMNCg0KYGBge3J9DQojIGluc3RhbGwucGFja2FnZXMoInJhbmRvbUZvcmVzdCIpDQpsaWJyYXJ5KHJhbmRvbUZvcmVzdCkNCiMgaW5zdGFsbC5wYWNrYWdlcygiY2FyZXQiKSANCmxpYnJhcnkoY2FyZXQpDQpgYGANCg0KIyBDcmVhciBsYSBiYXNlIGRlIGRhdG9zDQoNCmBgYHtyfQ0KZGYgPC0gcmVhZC5jc3YoIkM6XFxVc2Vyc1xcc2ViYXNcXE9uZURyaXZlXFxFc2NyaXRvcmlvXFxJbnRlbGlnZW5jaWEgZGUgTmVnb2Npb3NcXE1vZHVsbyAyXFwyMiAwOCAyMDI0XFxoZWFydC5jc3YiKQ0KYGBgDQoNCiMgQW7DoWxpc2lzIGV4cGxvcmF0b3Jpbw0KDQpgYGB7cn0NCnN1bW1hcnkoZGYpDQpzdHIoZGYpDQpkZiR0YXJnZXQgPC0gYXMuZmFjdG9yKGRmJHRhcmdldCkNCnN1bW1hcnkoZGYpDQpzdHIoZGYpDQpgYGANCg0KIyBQYXJ0aXIgbGEgYmFzZSBkZSBkYXRvcw0KDQpgYGB7cn0NCnNldC5zZWVkKDEyMykNCnJlbmdsb25lc19lbnRyZW5hbWllbnRvIDwtIGNyZWF0ZURhdGFQYXJ0aXRpb24oZGYkdGFyZ2V0LCBwPTAuOCwgbGlzdD1GQUxTRSkNCmVudHJlbmFtaWVudG8gPC0gZGZbcmVuZ2xvbmVzX2VudHJlbmFtaWVudG8sIF0NCnBydWViYSA8LSBkZlstcmVuZ2xvbmVzX2VudHJlbmFtaWVudG8sIF0NCmBgYA0KDQojIENvbnN0cnVpciBlbCBtb2RlbG8gUmFuZG9tIEZvcmVzdA0KDQpgYGB7cn0NCm1vZGVsbyA8LSByYW5kb21Gb3Jlc3QodGFyZ2V0IH4gLiwgZGF0YSA9IGVudHJlbmFtaWVudG8pDQoNCg0KcmVzdWx0YWRvX2VudHJlbmFtaWVudG8gPC0gcHJlZGljdChtb2RlbG8sZW50cmVuYW1pZW50bykNCnJlc3VsdGFkb19wcnVlYmEgPC0gcHJlZGljdChtb2RlbG8scHJ1ZWJhKQ0KYGBgDQoNCiMgTWF0cml6IGRlIENvbmZ1c2nDs24NCg0KYGBge3J9DQptY3JlIDwtIGNvbmZ1c2lvbk1hdHJpeChyZXN1bHRhZG9fZW50cmVuYW1pZW50bywgZW50cmVuYW1pZW50byR0YXJnZXQpICMgbWF0cml6IGRlIGNvbmZ1c2nDs24gZGVsIHJlc3VsdGFkbyBkZWwgZW50cmVuYW1pZW50bw0KbWNyZQ0KbWNycCA8LSBjb25mdXNpb25NYXRyaXgocmVzdWx0YWRvX3BydWViYSxwcnVlYmEkdGFyZ2V0KSAjIG1hdHJpeiBkZSBjb25mdXNpw7NuIGRlbCByZXN1bHRhZG8gZGUgbGEgcHJ1ZWJhDQptY3JwDQoNCg0KcmVzdWx0YWRvcyA8LSBkYXRhLmZyYW1lKCJyZiIgPSBjKG1jcmUkb3ZlcmFsbFsiQWNjdXJhY3kiXSwgbWNycCRvdmVyYWxsWyJBY2N1cmFjeSJdKSkNCnJvd25hbWVzKHJlc3VsdGFkb3MpIDwtIGMoIlByZWNpc2lvbiBkZSBlbnRyZW5hbWllbnRvIiwgIlByZWNpc2lvbiBkZSBwcnVlYmEiKQ0KcmVzdWx0YWRvcw0KYGBgDQoNCiMgT2J0ZW5lciBwcmVkaWNjacOzbg0KDQpgYGB7cn0NCnBhY2llbnRlIDwtIGRhdGEuZnJhbWUoDQogIGFnZSA9IDU4LA0KICBzZXggPSAwLA0KICBjcCA9IDAsDQogIHRyZXN0YnBzID0gMTAwLA0KICBjaG9sID0gMjQ4LA0KICBmYnMgPSAwLA0KICByZXN0ZWNnID0gMCwNCiAgdGhhbGFjaCA9IDEyMiwNCiAgZXhhbmcgPSAwLA0KICBvbGRwZWFrID0gMSwNCiAgc2xvcGUgPSAxLA0KICBjYSA9IDAsDQogIHRoYWwgPSAyDQopDQpgYGANCg0KIyBIYWNlciBsYSBwcmVkaWNjacOzbg0KDQpgYGB7cn0NCnByZWRpY2Npb24gPC0gcHJlZGljdChtb2RlbG8sIHBhY2llbnRlKQ0KDQppZihwcmVkaWNjaW9uID09IDEpIHsNCiAgcHJpbnQoIlRpZW5lIGVuZmVybWVkYWQgY2FyZMOtYWNhIikNCn0gZWxzZSB7DQogIHByaW50KCJObyB0aWVuZSBlbmZlcm1lZGFkIGNhcmTDrWFjYSIpDQp9DQpgYGANCg0KIyBDb25jbHVzacOzbg0KDQpMb3MgYm9zcXVlcyBhbGVhdG9yZW9zIGVzIHVuYSBoZXJyYW1pZW50YSBwYXJhIGxhIHByZWRpY2Npw7NuIGRlIGRhdG9zIGRlIGRpYWdub3N0aWNvLCBlbiBlc3RlIGNhc28gZGUgc2kgZWwgcGFjaWVudGUgdGllbmUgdW5hIGVuZmVybWVkYWQgY2FyZMOtYWNhLg0KDQoNCg0K