Solución Paso a Paso:

Paso 1: Preparación inicial y limpieza de los datos:

1. Cargar librerias:

# Librerías necesarias:

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(caret)

## Loading required package: lattice
## 
## Attaching package: 'caret'
## 
## The following object is masked from 'package:purrr':
## 
##     lift

library(kknn)

## 
## Attaching package: 'kknn'
## 
## The following object is masked from 'package:caret':
## 
##     contr.dummy

library(scales)

## 
## Attaching package: 'scales'
## 
## The following object is masked from 'package:purrr':
## 
##     discard
## 
## The following object is masked from 'package:readr':
## 
##     col_factor

library(class)
library(janitor)

## 
## Attaching package: 'janitor'
## 
## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test

library(dplyr)

2. Cargar datos:

# Cargar los datos 
Heart_Failure_Records <- read.csv("heart_failure_clinical_records_dataset.csv")

3. Limpieza de datos:

# Observar primeras filas
head(Heart_Failure_Records)

##   age anaemia creatinine_phosphokinase diabetes ejection_fraction
## 1  75       0                      582        0                20
## 2  55       0                     7861        0                38
## 3  65       0                      146        0                20
## 4  50       1                      111        0                20
## 5  65       1                      160        1                20
## 6  90       1                       47        0                40
##   high_blood_pressure platelets serum_creatinine serum_sodium sex smoking time
## 1                   1    265000              1.9          130   1       0    4
## 2                   0    263358              1.1          136   1       0    6
## 3                   0    162000              1.3          129   1       1    7
## 4                   0    210000              1.9          137   1       0    7
## 5                   0    327000              2.7          116   0       0    8
## 6                   1    204000              2.1          132   1       1    8
##   DEATH_EVENT
## 1           1
## 2           1
## 3           1
## 4           1
## 5           1
## 6           1

# Observar caracteristicas de variables
glimpse(Heart_Failure_Records)

## Rows: 299
## Columns: 13
## $ age                      <dbl> 75, 55, 65, 50, 65, 90, 75, 60, 65, 80, 75, 6…
## $ anaemia                  <int> 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, …
## $ creatinine_phosphokinase <int> 582, 7861, 146, 111, 160, 47, 246, 315, 157, …
## $ diabetes                 <int> 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, …
## $ ejection_fraction        <int> 20, 38, 20, 20, 20, 40, 15, 60, 65, 35, 38, 2…
## $ high_blood_pressure      <int> 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, …
## $ platelets                <dbl> 265000, 263358, 162000, 210000, 327000, 20400…
## $ serum_creatinine         <dbl> 1.90, 1.10, 1.30, 1.90, 2.70, 2.10, 1.20, 1.1…
## $ serum_sodium             <int> 130, 136, 129, 137, 116, 132, 137, 131, 138, …
## $ sex                      <int> 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, …
## $ smoking                  <int> 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, …
## $ time                     <int> 4, 6, 7, 7, 8, 8, 10, 10, 10, 10, 10, 10, 11,…
## $ DEATH_EVENT              <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, …

# Revisar los datos detalladamente
skimr::skim(Heart_Failure_Records)

Data summary
Name	Heart_Failure_Records
Number of rows	299
Number of columns	13
_______________________
Column type frequency:
numeric	13
________________________
Group variables	None

Variable type: numeric

skim_variable	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
age	1	60.83	11.89	40.0	51.0	60.0	70.0	95.0	▆▇▇▂▁
anaemia	1	0.43	0.50	0.0	0.0	0.0	1.0	1.0	▇▁▁▁▆
creatinine_phosphokinase	1	581.84	970.29	23.0	116.5	250.0	582.0	7861.0	▇▁▁▁▁
diabetes	1	0.42	0.49	0.0	0.0	0.0	1.0	1.0	▇▁▁▁▆
ejection_fraction	1	38.08	11.83	14.0	30.0	38.0	45.0	80.0	▃▇▂▂▁
high_blood_pressure	1	0.35	0.48	0.0	0.0	0.0	1.0	1.0	▇▁▁▁▅
platelets	1	263358.03	97804.24	25100.0	212500.0	262000.0	303500.0	850000.0	▂▇▂▁▁
serum_creatinine	1	1.39	1.03	0.5	0.9	1.1	1.4	9.4	▇▁▁▁▁
serum_sodium	1	136.63	4.41	113.0	134.0	137.0	140.0	148.0	▁▁▃▇▁
sex	1	0.65	0.48	0.0	0.0	1.0	1.0	1.0	▅▁▁▁▇
smoking	1	0.32	0.47	0.0	0.0	0.0	1.0	1.0	▇▁▁▁▃
time	1	130.26	77.61	4.0	73.0	115.0	203.0	285.0	▆▇▃▆▃
DEATH_EVENT	1	0.32	0.47	0.0	0.0	0.0	1.0	1.0	▇▁▁▁▃

No hay datos faltantes.

# Revisar nombres de columnas
names(Heart_Failure_Records)

##  [1] "age"                      "anaemia"                 
##  [3] "creatinine_phosphokinase" "diabetes"                
##  [5] "ejection_fraction"        "high_blood_pressure"     
##  [7] "platelets"                "serum_creatinine"        
##  [9] "serum_sodium"             "sex"                     
## [11] "smoking"                  "time"                    
## [13] "DEATH_EVENT"

La variable DEATH_EVENT está en mayúsculas. Por lo tanto, utilizamos la función de rename para que siga el mismo estilo que las otras variables.

# Renombrar columnas 
Heart_Failure_Records <- Heart_Failure_Records %>% 
  janitor::clean_names() 
names(Heart_Failure_Records)

##  [1] "age"                      "anaemia"                 
##  [3] "creatinine_phosphokinase" "diabetes"                
##  [5] "ejection_fraction"        "high_blood_pressure"     
##  [7] "platelets"                "serum_creatinine"        
##  [9] "serum_sodium"             "sex"                     
## [11] "smoking"                  "time"                    
## [13] "death_event"

# Verificar por datos duplicados
Heart_Failure_Records %>%
  janitor::get_dupes()

## No variable names specified - using all columns.

## No duplicate combinations found of: age, anaemia, creatinine_phosphokinase, diabetes, ejection_fraction, high_blood_pressure, platelets, serum_creatinine, serum_sodium, ... and 4 other variables

##  [1] age                      anaemia                  creatinine_phosphokinase
##  [4] diabetes                 ejection_fraction        high_blood_pressure     
##  [7] platelets                serum_creatinine         serum_sodium            
## [10] sex                      smoking                  time                    
## [13] death_event              dupe_count              
## <0 rows> (or 0-length row.names)

No existen datos duplicados.

En conclusión, nuestro proceso de limpieza consistió en renombrar la variable de death_event para que siga el mismo estilo que las otras variables y confirmar que no existen datos duplicados ni datos faltantes.

4. Normalización de datos:

Algunas variables numericas tienen escalas muy diferentes. Por lo tanto, reescalamos todas las variables a un rango estándar de valores. Para esto usamos la función de rescale().

Primero, convertimos en factor la variable objetivo death_event. Después, normalizamos las variables númericas y no consideramos death_event en el conjunto de datos normalizado ya que es una variable categórica. Las demás variables fueron consideradas como predictoras, por lo que se mantuvieron en la base de datos normalizada.

# Convertir en factor la variable de death_event
Heart_Failure_Records <- Heart_Failure_Records %>%
  mutate(death_event = factor(death_event))
  class(Heart_Failure_Records$death_event)

## [1] "factor"

# Normalizar variables numericas y eliminar death_event
Heart_Failure_Records_Norm <- Heart_Failure_Records %>%
  select(-death_event) %>%
  mutate(
    age = rescale(age),
    creatinine_phosphokinase = rescale(creatinine_phosphokinase),
    ejection_fraction = rescale(ejection_fraction),
    platelets = rescale(platelets),
    serum_creatinine = rescale(serum_creatinine),
    serum_sodium = rescale(serum_sodium),
    time = rescale(time)
  )

# Resultado de la normalización en la base de datos. 
head(Heart_Failure_Records_Norm)

##         age anaemia creatinine_phosphokinase diabetes ejection_fraction
## 1 0.6363636       0              0.071319214        0        0.09090909
## 2 0.2727273       0              1.000000000        0        0.36363636
## 3 0.4545455       0              0.015692779        0        0.09090909
## 4 0.1818182       1              0.011227354        0        0.09090909
## 5 0.4545455       1              0.017478949        1        0.09090909
## 6 0.9090909       1              0.003062006        0        0.39393939
##   high_blood_pressure platelets serum_creatinine serum_sodium sex smoking
## 1                   1 0.2908231       0.15730337   0.48571429   1       0
## 2                   0 0.2888326       0.06741573   0.65714286   1       0
## 3                   0 0.1659595       0.08988764   0.45714286   1       1
## 4                   0 0.2241484       0.15730337   0.68571429   1       0
## 5                   0 0.3659838       0.24719101   0.08571429   0       0
## 6                   1 0.2168748       0.17977528   0.54285714   1       1
##          time
## 1 0.000000000
## 2 0.007117438
## 3 0.010676157
## 4 0.010676157
## 5 0.014234875
## 6 0.014234875

Paso 2. Dividir los datos en conjunto de entrenamiento y prueba

Dividimos la muestra en dos conjuntos, uno para entrenamiento y otro para prueba. Para ello, Utilizaremos createFolds() de caret para garantizar balance de clases en ambos conjuntos.

# Separar los datos en 5 grupos, 4 para entrenamiento y 1 para prueba

set.seed(2025)
folds <- createFolds(Heart_Failure_Records$death_event, k = 5)
entrenamiento <- Heart_Failure_Records_Norm[-folds[[5]],]
prueba <- Heart_Failure_Records_Norm[folds[[5]],]

Ver cantidad de datos en cada conjunto.

dim(entrenamiento)[1]

## [1] 239

dim(prueba)[1]

## [1] 60

Guardar las etiquetas de los conjuntos:

# Etiquetas
entrenamiento_labels <- Heart_Failure_Records$death_event[-folds[[5]]]
prueba_labels        <- Heart_Failure_Records$death_event[folds[[5]]]

Paso 3. Aplicar el metodo K-NN

Construimos el modelo ajustado con los datos de entrenamiento. Para este ejemplo utilizaremos la libreria kknn . En esta paquetería se usa la función train.kknn(), a la cual se le debe indicar el valor máximo de k y ella determina el valor óptimo.

# Entrenar el modelo 
train.kknn(entrenamiento_labels ~ ., data = entrenamiento, kmax = 20)

## 
## Call:
## train.kknn(formula = entrenamiento_labels ~ ., data = entrenamiento,     kmax = 20)
## 
## Type of response variable: nominal
## Minimal misclassification: 0.2761506
## Best kernel: optimal
## Best k: 15

Encontramos que el valor óptimo de k = 15. Entonces, la predicción sería:

pred <- knn(entrenamiento,prueba, cl = entrenamiento_labels, k = 15)

confusionMatrix(data = pred, reference = prueba_labels)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 39 14
##          1  2  5
##                                           
##                Accuracy : 0.7333          
##                  95% CI : (0.6034, 0.8393)
##     No Information Rate : 0.6833          
##     P-Value [Acc > NIR] : 0.24687         
##                                           
##                   Kappa : 0.2581          
##                                           
##  Mcnemar's Test P-Value : 0.00596         
##                                           
##             Sensitivity : 0.9512          
##             Specificity : 0.2632          
##          Pos Pred Value : 0.7358          
##          Neg Pred Value : 0.7143          
##              Prevalence : 0.6833          
##          Detection Rate : 0.6500          
##    Detection Prevalence : 0.8833          
##       Balanced Accuracy : 0.6072          
##                                           
##        'Positive' Class : 0               
##

Con este modelo, hemos obtenido una exactitud de 73%. Ahora vamos a intentar reescalando los valores con la funcion scale() la cual convierte las variables en normales estándar, y quizás nos pueda ayudar a mejorar la clasificación.

# Normalizar las variables numéricas y eliminar death_event
Heart_Failure_Records_Z <- Heart_Failure_Records %>%
  select(-death_event) %>%  # Eliminar la variable objetivo de la normalización
  mutate(
    age = scale(age),
    creatinine_phosphokinase = scale(creatinine_phosphokinase),
    ejection_fraction = scale(ejection_fraction),
    platelets = scale(platelets),
    serum_creatinine = scale(serum_creatinine),
    serum_sodium = scale(serum_sodium),
    time = scale(time)
  )

# Dividir los datos en conjunto de entrenamiento y prueba (5-folds)
set.seed(2025)
folds <- createFolds(Heart_Failure_Records$death_event, k = 5)
entrenamiento_z <- Heart_Failure_Records_Z[-folds[[5]],]
prueba_z <- Heart_Failure_Records_Z[folds[[5]],]

# Guardar las etiquetas de los conjuntos 
entrenamiento_labels <- Heart_Failure_Records$death_event[-folds[[5]]]
prueba_labels <- Heart_Failure_Records$death_event[folds[[5]]]

# Aplicar el método K-NN sobre los datos normalizados
pred_z <- knn(entrenamiento_z, prueba_z, cl = entrenamiento_labels, k = 15)

# Matriz de confusión para evaluar el modelo
confusionMatrix(data = pred_z, reference = prueba_labels)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 41 12
##          1  0  7
##                                           
##                Accuracy : 0.8             
##                  95% CI : (0.6767, 0.8922)
##     No Information Rate : 0.6833          
##     P-Value [Acc > NIR] : 0.031910        
##                                           
##                   Kappa : 0.4436          
##                                           
##  Mcnemar's Test P-Value : 0.001496        
##                                           
##             Sensitivity : 1.0000          
##             Specificity : 0.3684          
##          Pos Pred Value : 0.7736          
##          Neg Pred Value : 1.0000          
##              Prevalence : 0.6833          
##          Detection Rate : 0.6833          
##    Detection Prevalence : 0.8833          
##       Balanced Accuracy : 0.6842          
##                                           
##        'Positive' Class : 0               
##

En este caso podemos ver que nuestra exactitud aumentó a 80%, por lo que hemos conseguido mejorarla con respecto a la normalización min-max.

Paso 4. Validar la estabilidad del modelo:

Aplicar validación cruzada para validar la estabilidad del modelo de forma manual.

# Guardar la exactitud de cada fold
exactitud <- numeric(length = 5)

for(i in 1:5){
  # Definir conjuntos entrenamiento y prueba según el fold actual
  prueba        <- Heart_Failure_Records_Norm[folds[[i]],]
  entrenamiento <- Heart_Failure_Records_Norm[-folds[[i]],]
  
  # Etiquetas
  entrenamiento_labels <- Heart_Failure_Records$death_event[-folds[[i]]]
  prueba_labels        <- Heart_Failure_Records$death_event[folds[[i]]]
  
  # Asegurarnos de que las etiquetas sean factores
  entrenamiento_labels <- factor(entrenamiento_labels)
  prueba_labels <- factor(prueba_labels)
  
  pred_knn <- knn(entrenamiento,prueba, cl= entrenamiento_labels, k = 15)
  
  # Evaluar exactitud del modelo en cada fold
  cm <- confusionMatrix(pred_knn, prueba_labels)
  exactitud[i] <- cm$overall["Accuracy"]
  
  # Mostrar resultado del fold
  cat("Fold", i, "- Exactitud:", exactitud[i], "\n")
}

## Fold 1 - Exactitud: 0.7118644 
## Fold 2 - Exactitud: 0.75 
## Fold 3 - Exactitud: 0.7 
## Fold 4 - Exactitud: 0.6666667 
## Fold 5 - Exactitud: 0.7333333

# Exactitud promedio de validación cruzada
Exactitud_promedio <- round(mean(exactitud),4)*100
paste("Exactitud_promedio: ",Exactitud_promedio,"%",sep="")

## [1] "Exactitud_promedio: 71.24%"

Paso 5. Interpretación de los resultados finales

Validación cruzada de forma automática:

set.seed(2025)
train_control <- trainControl(method="cv",number=10,savePredictions = TRUE)

#Asegurarnos que prueba labels este en factor
prueba_labels <- as.factor(prueba_labels)

# Combinar los datos de prueba y las etiquetas
knn_cv <- train(death_event ~ ., 
                data = cbind(prueba, death_event = prueba_labels), 
                method = "knn", 
                trControl = train_control, 
                tuneGrid = data.frame(k = 15))

# Resultados de validación cruzada
knn_cv

## k-Nearest Neighbors 
## 
## 60 samples
## 12 predictors
##  2 classes: '0', '1' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 54, 54, 53, 55, 54, 54, ... 
## Resampling results:
## 
##   Accuracy   Kappa    
##   0.7847619  0.3142857
## 
## Tuning parameter 'k' was held constant at a value of 15

# Matriz de confusión usando predicciones guardadas por caret
confusionMatrix(knn_cv$pred$pred, knn_cv$pred$obs)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 41 13
##          1  0  6
##                                          
##                Accuracy : 0.7833         
##                  95% CI : (0.658, 0.8793)
##     No Information Rate : 0.6833         
##     P-Value [Acc > NIR] : 0.0600157      
##                                          
##                   Kappa : 0.3868         
##                                          
##  Mcnemar's Test P-Value : 0.0008741      
##                                          
##             Sensitivity : 1.0000         
##             Specificity : 0.3158         
##          Pos Pred Value : 0.7593         
##          Neg Pred Value : 1.0000         
##              Prevalence : 0.6833         
##          Detection Rate : 0.6833         
##    Detection Prevalence : 0.9000         
##       Balanced Accuracy : 0.6579         
##                                          
##        'Positive' Class : 0              
##

Ahora con este proceso, tenemos una exactitud de 78%.

Problema 1: Historiales clínicos de insuficiencia cardíaca.

Adalberto Quiñones Tirado

March 21 2025

Introducción