TAREA REVISIÓN

Libraries

library(ggplot2)
library(ggpubr) #ggarrange
library(factoextra) #fviz_pca_var
library(dplyr)  # %>%
library(lattice) # Caret is buld under this package
library(caret) # createDataPartition
library(randomForest)
library(ggplot2)
library(grid)
library(naniar)
library(ISLR)
library(car)
library(boot)
library(gridExtra)
library(grid)
library(corrplot)
library(VIM)
library(dplyr)
library(lubridate)
library(formattable)
library(knitr)
library(StatMatch) # Gower Distance
library(rpart)
library(missForest)
library(DT)

Functions

source("../functions/LIMPIAMOS_VARIABLES_TFG.R")
source('../functions/Columnas_No_Integer.R')
source('../functions/Nuevas_Filas.R')
source('../functions/PCA_TFG_ANALISIS.R')
source('../functions/PCA_TFG_ANALISIS_English.R')
source('../functions/PROC_1.r')
source('../functions/PROC_2.r')
source('../functions/PROC_3.r')
source('../functions/PROC_4.r')
source("../functions/RF_Final_MATRIX.r")
source("../functions/R_RF_Paper_MATRIX.R")
source('../functions/Input_Gower.r')

## DownLOAD INFORMATION
ModelAmarillo = readRDS("../app/final_model.rds")
v_best <- c(
  "Albumina", "Deposiciones_dia", "Cloro", "Urea", "AST", "ALT", "PCR", "Vomitos_dia", "Potasio",
  "Frecuencia_Cardiaca", "Exceso_bases", "Creatinina", "Plaquetas", "Linfocitos", "pH", "Bicarbonato", "Sodio",
  "Dias_Clinica_Hasta_Ingreso", "Neutrofilos"
)

Habría que:

En la ultima aportacion, que es lo de usar la distancia de Gower para poder clasificar pacientes a los que les faltan datos en “variables importantes”. Para presentar alguna alternativa a nuestra propuesta: imputar ahí de alguna manera naive, y comparar con nuestros resultados. Yo usaría el paquete “mice”, es el segundo de los que se describen aquí: https://www.appsilon.com/post/imputation-in-r#value-imputation
Otra opcion es de inicio y a lo bruto: imputar con ese paquete “mice”, y después RF sin más. 2b) variante de la anterior: de inicio y sin nada de importancia de variables etc… (igual que en 2a)) pero usar el paquete “missForest”.
Esta es la que creo que lleva más trabajo: ver cuántos pacientes estaban completos. De esos quitar valores y generar falsos faltantes (en porporciones similares a los faltantes que de verdad haya, por variables, o sea, si del peso faltan el 40%, creo 40% de huecos, si de la fiebre faltan el 20% quitar el 20% aleatoriamente etc). Y ver qué tal funciona nuestro procedimiento del paper tal y como estaba con todas sus etapas en esta “falsa base de datos con huecos”.
Pacientes de Etiología desconocida. Aplicar procedimiento y dar probabilidades de Vírico o Bacteriano. Se pueden tomar decisiones de los pacientes desconocido. Imputar también en estos pacientes

2.1 IMPUTANDO DATOS CON MISSFOREST MANTENIENDO LA PROPORCIÓN DE GOLDEN MODEL

#Imputación con MissForest
set.seed(123)
imputed_data <- missForest(datMISSRFByB)

vis_miss(dat_imputadoMISSFOREST, sort_miss = TRUE, show_perc = TRUE) + 
  theme(axis.text.x = element_text(angle = 90))

Creando la partición de datos para entrenar los 3 diferentes modelos:

RF
Regresión
Árboles de Decisión

set.seed(34)
train_value_p= 89/(89+101)
trainIndex <- createDataPartition(dat_imputadoMISSFOREST$Etiologia2, 
                                  p = train_value_p, 
                                  list = FALSE, 
                                  times = 1)
trainTRM1 <- dat_imputadoMISSFOREST[trainIndex, ]
testTRM1 <- dat_imputadoMISSFOREST[-trainIndex, ]

Clasificando con RF

set.seed(34)
trm1 = randomForest(Etiologia2~.,cp=.001,data =trainTRM1,ntree=500,
                   importance=TRUE)
trm1

## 
## Call:
##  randomForest(formula = Etiologia2 ~ ., data = trainTRM1, cp = 0.001,      ntree = 500, importance = TRUE) 
##                Type of random forest: classification
##                      Number of trees: 500
## No. of variables tried at each split: 6
## 
##         OOB estimate of  error rate: 10%
## Confusion matrix:
##           Bacterium Virus class.error
## Bacterium        30     6  0.16666667
## Virus             3    51  0.05555556

Errores de Preccción RF MissForest

set.seed(34)
ypred1 = predict(trm1,newdata = testTRM1)
Etiologia1p = ypred1
(tabla03=table(testTRM1$Etiologia2,Etiologia1p))

##            Etiologia1p
##             Bacterium Virus
##   Bacterium        31     9
##   Virus             2    58

Acierto: 89 %
- Acierto Bacterium: 77.5 %
- Acierto Virus: 96.7 %
Fallo: 11 %
- Fallo Bacterium: 23.7 %
- Fallo Virus: 3.3 %

Modelo de Regresión Logística

set.seed(34)
logit_model <- glm(Etiologia2 ~ ., data = trainTRM1, family = binomial)

pred_prob <- predict(logit_model, newdata = testTRM1, type = "response")
pred_class <- ifelse(pred_prob > 0.5, 1, 0)

Errores de Preccción Regresión Logística MissForest

conf_matrix <- table(Predicho = pred_class, Real = testTRM1$Etiologia2)
print(conf_matrix)

##         Real
## Predicho Bacterium Virus
##        0        26    19
##        1        14    41

Acierto: 67 %
- Acierto Bacterium: 57.78 %
- Acierto Virus: 74.55 %
Fallo: 33 %
- Fallo Bacterium: 74.55 %
- Fallo Virus: 25.45 %

Modelo de Árboles de Decisión

# Modelo de Árbol de Decisión
set.seed(34)
arbol_model <- rpart(Etiologia2 ~ ., data = trainTRM1, method = "class", cp = 0.001)

pred_arbol <- predict(arbol_model, newdata = testTRM1, type = "class")
conf_matrix_arbol <- table(Predicho = pred_arbol, Real = testTRM1$Etiologia2)

Errores de Preccción Árboles de Decisión

print(conf_matrix_arbol)

##            Real
## Predicho    Bacterium Virus
##   Bacterium        33     6
##   Virus             7    54

Acierto: 87 %
- Acierto Bacterium: 84.62 %
- Acierto Virus: 88.52 %
Fallo: 13 %
- Fallo Bacterium: 15.38 %
- Fallo Virus: 11.48 %

Comparación de Modelos de Clasificación manteniendo proporción 89/(101+89)
Modelo	Acierto_Global	Acierto_Bacterium	Acierto_Virus	Fallo_Global	Fallo_Bacterium	Fallo_Virus
Random Forest	89	77.50	96.70	11	23.70	3.30
Regresión Logística	67	57.78	74.55	33	74.55	25.45
Árboles de Decisión	87	84.62	88.52	13	15.38	11.48

2.2 IMPUTANDO DATOS CON MISSFOREST PROP 80/20

#Imputación con MissForest
set.seed(123)
imputed_data <- missForest(datMISSRFByB)

vis_miss(dat_imputadoMISSFOREST, sort_miss = TRUE, show_perc = TRUE) + 
  theme(axis.text.x = element_text(angle = 90))

Creando la partición de datos para entrenar los 3 diferentes modelos:

RF
Regresión
Árboles de Decisión

set.seed(34)
trainIndex <- createDataPartition(dat_imputadoMISSFOREST$Etiologia2, 
                                  p = .8, 
                                  list = FALSE, 
                                  times = 1)
trainTRM1 <- dat_imputadoMISSFOREST[trainIndex, ]
testTRM1 <- dat_imputadoMISSFOREST[-trainIndex, ]

Clasificando con RF

set.seed(34)
trm1 = randomForest(Etiologia2~.,cp=.001,data =trainTRM1,ntree=500,
                   importance=TRUE)
trm1

## 
## Call:
##  randomForest(formula = Etiologia2 ~ ., data = trainTRM1, cp = 0.001,      ntree = 500, importance = TRUE) 
##                Type of random forest: classification
##                      Number of trees: 500
## No. of variables tried at each split: 6
## 
##         OOB estimate of  error rate: 8.5%
## Confusion matrix:
##           Bacterium Virus class.error
## Bacterium        53     8  0.13114754
## Virus             5    87  0.05434783

Errores de Preccción RF MissForest

set.seed(34)
ypred1 = predict(trm1,newdata = testTRM1)
Etiologia1p = ypred1
(tabla03=table(testTRM1$Etiologia2,Etiologia1p))

##            Etiologia1p
##             Bacterium Virus
##   Bacterium        11     4
##   Virus             2    20

Acierto: 83.78 %
- Acierto Bacterium: 73.3 %
- Acierto Virus: 90.90 %
Fallo: 16.22 %
- Fallo Bacterium: 27.7 %
- Fallo Virus: 9.10 %

Modelo de Regresión Logística

set.seed(34)
logit_model <- glm(Etiologia2 ~ ., data = trainTRM1, family = binomial)

pred_prob <- predict(logit_model, newdata = testTRM1, type = "response")
pred_class <- ifelse(pred_prob > 0.5, 1, 0)

Errores de Preccción Regresión Logística MissForest

conf_matrix <- table(Predicho = pred_class, Real = testTRM1$Etiologia2)
print(conf_matrix)

##         Real
## Predicho Bacterium Virus
##        0        11     5
##        1         4    17

Acierto: 78.38 %
- Acierto Bacterium: 73.3 %
- Acierto Virus: 81.82 %
Fallo: 21.62 %
- Fallo Bacterium: 26.7 %
- Fallo Virus: 18.18 %

Modelo de Árboles de Decisión

# Modelo de Árbol de Decisión
set.seed(34)
arbol_model <- rpart(Etiologia2 ~ ., data = trainTRM1, method = "class", cp = 0.001)

pred_arbol <- predict(arbol_model, newdata = testTRM1, type = "class")
conf_matrix_arbol <- table(Predicho = pred_arbol, Real = testTRM1$Etiologia2)

Errores de Preccción Árboles de Decisión

print(conf_matrix_arbol)

##            Real
## Predicho    Bacterium Virus
##   Bacterium        12     3
##   Virus             3    19

Acierto: 72.97 %
- Acierto Bacterium: 69.23 %
- Acierto Virus: 75.00 %
Fallo: 27.03 %
- Fallo Bacterium: 30.77 %
- Fallo Virus: 25.00 %

2.2.1 Mejor Modelo Inluído en la APP en comparación con punto 2.2

En total existen 190 pacientes catalogados como víricos y bacterianos. De estos pacientes son 111 lo que no muestran faltantes en las variables seleccionadas:

Sexo
AP
Edad_meses
Ambiente_Epidemico
Alimento_Sospechoso
Desnutricion
Motivo_Ingreso
TAS
TAD
Fiebre
Fiebre_max
Vomitos
Diarrea
Productos_Patologicos
Sangre_Heces
Deshidratacion
Grado_Deshidratacion
RiV_rap
Acidosis
Hiponatremia
Insuficiencia_Renal_KDiGO
Hemoglobina
Leucocitos
Etiologia2

Si quitamos de estos 190 pacientes los 89 utilizados para entrenar el modelo queda un total de 101 pacientes, los cuales serán usados para validarlo en modo ´test´. De estos 101 pacientes 22 tienen los datos completos y habrá que inputar datos a 79 con aquellos 22 pacientes que tienen datos completos.

La inputación de datos será llevada a cabo por el método Gower ed la siguiente forma: [https://rpubs.com/garisj98/DataInputGowerDistance]

La matriz de confusión generada utilizando el modelo AMARILLO que se entrena con 89 pacientes es:

Acierto: 94.05 %
- Acierto Bacterium: 90.62 %
- Acierto Virus: 95.7 %
Fallo: 5.95 %
- Fallo Bacterium: 9.38 %
- Fallo Virus: 4.3 %

Comparación de Modelos de Clasificación
Modelo	Acierto_Global	Acierto_Bacterium	Acierto_Virus	Fallo_Global	Fallo_Bacterium	Fallo_Virus
Random Forest	83.78	73.30	90.90	16.22	27.70	9.10
Regresión Logística	78.38	73.30	81.82	21.62	26.70	18.18
Árboles de Decisión	72.97	69.23	75.00	27.03	30.77	25.00
Modelo Amarillo	94.05	90.62	95.70	5.95	9.38	4.30

2.2.1.1 Clasificar solo en los datos completos con el GOLDEN MODEL

En este caso estamos clasificando a los pacientes con los que hemos entrenado el modelo y además a los test reservados. 111 pacientes en TOTAL SIN DATOS FALTANTES EN LAS VARIABLES DESIGNADAS

## IMPORTANDO DATA SET
dat_RF = read.table("../data/TFG_PEDIATRIA_1_PaperENG.txt", header=T, sep=";",na.strings="")

# Convertir Etiologia2 en factor con niveles y etiquetas correctas
dat_RF$Etiologia2 <- factor(dat_RF$Etiologia2, 
                            levels = c("Bacterium", "Negative", "Unknown", "Virus"), 
                            labels = c("Bacteria", "Unknown", "Unknown", "Virus"))


#Solo selecciono Bacterias & Virus
dat_RF_GOLDEN <- dat_RF %>%
  filter(Etiologia2 %in% c("Bacteria", "Virus")) %>%
  droplevels()

#Elimo los factores "RAROS"
dat_RF_GOLDEN <- subset(dat_RF_GOLDEN,select=-c(Lactancia_Materna,ID,Vacuna_Rotavirus,F_Ingreso,Etiologia,F_Alta, Antiemeticos,Complicaciones,F_Nacimiento,Etiologia3))

#Elimino las varibales que le he pasado#
n_long=matrix(nrow = length(v_best))
for(i in 1:length(n_long)){
  n_long[i,]=which(names(dat_RF_GOLDEN) == v_best[i])
}
dat_RF_GOLDEN<-subset(dat_RF_GOLDEN,select=-n_long)


datosNONA_GOLDEN <- dat_RF_GOLDEN[complete.cases(dat_RF_GOLDEN), ] # Data frame sin NA
datosNA_GOLDEN <- dat_RF_GOLDEN[!complete.cases(dat_RF_GOLDEN), ]  # Data frame con NA
datosNONA_GOLDEN_pred <- subset(datosNONA_GOLDEN, select = -Etiologia2)
datosNONA_GOLDEN_pred <- datosNONA_GOLDEN_pred %>% mutate_if(is.factor, droplevels)

ypred3 <- predict(ModelAmarillo, newdata = datosNONA_GOLDEN_pred)
Etiologia3p = ypred3
(tabla03p=table(datosNONA_GOLDEN$Etiologia2,Etiologia3p))

##           Etiologia3p
##            Bacteria Virus
##   Bacteria       55     0
##   Virus           0    56

Acierto 100 %

2.2.1.2 Reentrenar el GOLDEN MODEL B veces y clasificar

dat_RF = read.table("../data/TFG_PEDIATRIA_1_PaperENG.txt", header=T, sep=";",na.strings="")

# Convertir Etiologia2 en factor con niveles y etiquetas correctas
dat_RF$Etiologia2 <- factor(dat_RF$Etiologia2, 
                            levels = c("Bacterium", "Negative", "Unknown", "Virus"), 
                            labels = c("Bacteria", "Unknown", "Unknown", "Virus"))


#Solo selecciono Bacterias & Virus
dat_RF_GOLDEN <- dat_RF %>%
  filter(Etiologia2 %in% c("Bacteria", "Virus")) %>%
  droplevels()

#Elimo los factores "RAROS"
dat_RF_GOLDEN <- subset(dat_RF_GOLDEN,select=-c(Lactancia_Materna,ID,Vacuna_Rotavirus,F_Ingreso,Etiologia,F_Alta, Antiemeticos,Complicaciones,F_Nacimiento,Etiologia3))

#Elimino las varibales que le he pasado#
n_long=matrix(nrow = length(v_best))
for(i in 1:length(n_long)){
  n_long[i,]=which(names(dat_RF_GOLDEN) == v_best[i])
}
dat_RF_GOLDEN<-subset(dat_RF_GOLDEN,select=-n_long)
datosNONA_GOLDEN <- dat_RF_GOLDEN[complete.cases(dat_RF_GOLDEN), ] # Data frame sin NA
datosNA_GOLDEN <- dat_RF_GOLDEN[!complete.cases(dat_RF_GOLDEN), ]  # Data frame con NA

library(randomForest)
library(caret)

# Define the number of iterations
iterations <- 10

# Matrices to store results
resultados_GOLDEN <- matrix(NA, nrow = iterations, ncol = 3)
resultados_GOLDEN_GOWER <- matrix(NA, nrow = iterations, ncol = 3)
resultados_GOLDEN_GOWER_T <- matrix(NA, nrow = iterations, ncol = 3)
resultados_GOLDEN_MISS <- matrix(NA, nrow = iterations, ncol = 3)

for (i in 1:iterations) {
  
  set.seed(34 + i)  
  # Partition data
  trainIndex <- createDataPartition(datosNONA_GOLDEN$Etiologia2, 
                                    p = 0.8, 
                                    list = FALSE, 
                                    times = 1)
  trainTRM1 <- datosNONA_GOLDEN[trainIndex, ]
  testTRM1 <- datosNONA_GOLDEN[-trainIndex, ]

  ## Random Forest on Training Data
  trm1_GOLDEN <- randomForest(Etiologia2 ~ ., data = trainTRM1, ntree = 500, importance = TRUE)
  ypred1_GOLDEN <- predict(trm1_GOLDEN, newdata = testTRM1)
  tabla_GOLDEN <- table(testTRM1$Etiologia2, ypred1_GOLDEN)

  # Ensure table has correct structure to avoid indexing errors
  porcentaje_total_GOLDEN <- (sum(diag(tabla_GOLDEN)) / sum(tabla_GOLDEN)) * 100
  porcentaje_bacteria_GOLDEN <- ifelse("Bacteria" %in% rownames(tabla_GOLDEN), 
                                       (tabla_GOLDEN["Bacteria", "Bacteria"] / sum(tabla_GOLDEN["Bacteria", ])) * 100, NA)
  porcentaje_virus_GOLDEN <- ifelse("Virus" %in% rownames(tabla_GOLDEN), 
                                    (tabla_GOLDEN["Virus", "Virus"] / sum(tabla_GOLDEN["Virus", ])) * 100, NA)
  resultados_GOLDEN[i, ] <- c(porcentaje_total_GOLDEN, porcentaje_bacteria_GOLDEN, porcentaje_virus_GOLDEN)

  ## RF WITH TEST AND GOWER IMPUTATION
  dat_or_input_1 <- rbind(testTRM1, datosNA_GOLDEN)
  n_primeros <- 7
  datInput <- testTRM1

  for (j in 1:nrow(dat_or_input_1)) {  # Fix: Avoid overwriting 'i'
    dat_or_input_1[j, ] <- Input_Gower(datInput, dat_or_input_1[j, ], n_primeros)
  }

  ypred1_GOLDEN_GOWER <- predict(trm1_GOLDEN, newdata = dat_or_input_1)
  tabla_GOLDEN_GOWER <- table(dat_or_input_1$Etiologia2, ypred1_GOLDEN_GOWER)

  porcentaje_total_GOLDEN_GOWER <- (sum(diag(tabla_GOLDEN_GOWER)) / sum(tabla_GOLDEN_GOWER)) * 100
  porcentaje_bacteria_GOLDEN_GOWER <- ifelse("Bacteria" %in% rownames(tabla_GOLDEN_GOWER), 
                                             (tabla_GOLDEN_GOWER["Bacteria", "Bacteria"] / sum(tabla_GOLDEN_GOWER["Bacteria", ])) * 100, NA)
  porcentaje_virus_GOLDEN_GOWER <- ifelse("Virus" %in% rownames(tabla_GOLDEN_GOWER), 
                                          (tabla_GOLDEN_GOWER["Virus", "Virus"] / sum(tabla_GOLDEN_GOWER["Virus", ])) * 100, NA)
  resultados_GOLDEN_GOWER[i, ] <- c(porcentaje_total_GOLDEN_GOWER, porcentaje_bacteria_GOLDEN_GOWER, porcentaje_virus_GOLDEN_GOWER)
  
  ## RF WITH TEST AND GOWER IMPUTATION WITH TRAINING DATA
  dat_or_input_11 <- rbind(testTRM1, datosNA_GOLDEN)
  n_primeros <- 7
  datInput <- datosNONA_GOLDEN
  for (j in 1:nrow(dat_or_input_11)) {  # Fix: Avoid overwriting 'i'
    dat_or_input_11[j, ] <- Input_Gower(datInput, dat_or_input_11[j, ], n_primeros)
  }

  ypred1_GOLDEN_GOWER_T <- predict(trm1_GOLDEN, newdata = dat_or_input_11)
  tabla_GOLDEN_GOWER_T <- table(dat_or_input_11$Etiologia2, ypred1_GOLDEN_GOWER_T)

  porcentaje_total_GOLDEN_GOWER_T <- (sum(diag(tabla_GOLDEN_GOWER_T)) / sum(tabla_GOLDEN_GOWER_T)) * 100
  porcentaje_bacteria_GOLDEN_GOWER_T <- ifelse("Bacteria" %in% rownames(tabla_GOLDEN_GOWER_T), 
                                             (tabla_GOLDEN_GOWER_T["Bacteria", "Bacteria"] / sum(tabla_GOLDEN_GOWER_T["Bacteria", ])) * 100, NA)
  porcentaje_virus_GOLDEN_GOWER_T <- ifelse("Virus" %in% rownames(tabla_GOLDEN_GOWER_T), 
                                          (tabla_GOLDEN_GOWER_T["Virus", "Virus"] / sum(tabla_GOLDEN_GOWER_T["Virus", ])) * 100, NA)
  
  resultados_GOLDEN_GOWER_T[i, ] <- c(porcentaje_total_GOLDEN_GOWER_T, porcentaje_bacteria_GOLDEN_GOWER_T, porcentaje_virus_GOLDEN_GOWER_T)
  
  
  ## RF WITH TEST AND MISSFOREST
datMISSRFByB <- datosNA_GOLDEN %>% mutate_if(is.character, as.factor)
datMISSRFByB$Etiologia2 <- droplevels(datMISSRFByB$Etiologia2)
dat_or_input_2 <- missForest(datMISSRFByB)
dat_or_input_2 <- rbind(data.frame(dat_or_input_2$ximp), testTRM1)
dat_or_input_2 <- dat_or_input_2 %>% mutate_if(is.factor, as.character)

ypred1_GOLDEN_MISS <- predict(trm1_GOLDEN, newdata = dat_or_input_2)
tabla_GOLDEN_MISS <- table(dat_or_input_2$Etiologia2, ypred1_GOLDEN_MISS)
 
 porcentaje_total_GOLDEN_MISS <- (sum(diag(tabla_GOLDEN_MISS)) / sum(tabla_GOLDEN_MISS)) * 100
  porcentaje_bacteria_GOLDEN_MISS <- ifelse("Bacteria" %in% rownames(tabla_GOLDEN_MISS), 
                                             (tabla_GOLDEN_MISS["Bacteria", "Bacteria"] / sum(tabla_GOLDEN_MISS["Bacteria", ])) * 100, NA)
  porcentaje_virus_GOLDEN_MISS <- ifelse("Virus" %in% rownames(tabla_GOLDEN_MISS), 
                                          (tabla_GOLDEN_MISS["Virus", "Virus"] / sum(tabla_GOLDEN_MISS["Virus", ])) * 100, NA)
  resultados_GOLDEN_MISS[i, ] <- c(porcentaje_total_GOLDEN_MISS, porcentaje_bacteria_GOLDEN_MISS, porcentaje_virus_GOLDEN_MISS)
}

# Cálculo de promedios de todas las iteraciones
media_GOLDEN <- colMeans(resultados_GOLDEN, na.rm = TRUE)
media_GOLDEN_GOWER <- colMeans(resultados_GOLDEN_GOWER, na.rm = TRUE)
media_GOLDEN_GOWER_T <- colMeans(resultados_GOLDEN_GOWER_T, na.rm = TRUE)
media_GOLDEN_MISS <- colMeans(resultados_GOLDEN_MISS, na.rm = TRUE)

# Función para definir el color en función de la cercanía a 100
color_gradient <- function(value) {
  formattable::color_tile("lightgreen", "darkgreen")(value)
}


resultados_finales <- data.frame(
  Num_Pacientes_Classification = c(22, 111, 111, 111),  
  Acierto_Total = c(media_GOLDEN[1], media_GOLDEN_GOWER[1], media_GOLDEN_GOWER_T[1], media_GOLDEN_MISS[1]),
  Acierto_Bacterias = c(media_GOLDEN[2], media_GOLDEN_GOWER[2], media_GOLDEN_GOWER_T[2], media_GOLDEN_MISS[2]),
  Acierto_Virus = c(media_GOLDEN[3], media_GOLDEN_GOWER[3], media_GOLDEN_GOWER_T[3], media_GOLDEN_MISS[3])
)

rownames(resultados_finales) <- c("Test", "Test and Gower only with test", "Test and Gower with train and test", "Test and MissForest")

color_gradient <- function(value) {
  formattable::color_tile("#FFDDDD", "#70AD47")(value)  # Verde más claro (#70AD47) en lugar del verde oscuro anterior
}

formattable(resultados_finales, list(
  Num_Pacientes_Classification = formatter("span", style = ~ style(color = "black", font.weight = "bold")),
  Acierto_Total = color_gradient,
  Acierto_Bacterias = color_gradient,
  Acierto_Virus = color_gradient
))

	Num_Pacientes_Classification	Acierto_Total	Acierto_Bacterias	Acierto_Virus
Test	22	84.54545	81.81818	87.27273
Test and Gower only with test	111	89.00990	84.37500	91.15942
Test and Gower with train and test	111	89.70297	85.00000	91.88406
Test and MissForest	111	89.70297	85.00000	91.88406

2.2.1.3. Validar metodología sin Gower y sin reentrenar el Modelo

num_reps <- 500

errores <- numeric(num_reps)  # Vector para almacenar errores
acierto_total <- numeric(num_reps)  # Vector para almacenar aciertos totales
acierto_bacterias <- numeric(num_reps)  # Vector para almacenar aciertos en bacterias
acierto_virus <- numeric(num_reps)  # Vector para almacenar aciertos en virus

for (i in 1:num_reps) {
  set.seed(1234 + i)  
  # Tomar el 80% de los datos de forma aleatoria
  trainIndex <- createDataPartition(datosNONA_GOLDEN$Etiologia2, p = 0.8, list = FALSE)
  datos_train <- datosNONA_GOLDEN[trainIndex, ]
  datos_test <- datosNONA_GOLDEN[-trainIndex, ]
  
  # Predicciones en el conjunto de prueba
  ypred3 <- predict(ModelAmarillo, newdata = datos_test)
  
  # Matriz de confusión
tabla03p <- table(datos_test$Etiologia2, ypred3)
  
  # Extraer valores de la tabla de confusión
  aciertos_bacteria <- ifelse("Bacteria" %in% rownames(tabla03p) & "Bacteria" %in% colnames(tabla03p), tabla03p["Bacteria", "Bacteria"], 0)
  errores_bacteria <- ifelse("Virus" %in% rownames(tabla03p) & "Bacteria" %in% colnames(tabla03p), tabla03p["Virus", "Bacteria"], 0)
  aciertos_virus <- ifelse("Virus" %in% rownames(tabla03p) & "Virus" %in% colnames(tabla03p), tabla03p["Virus", "Virus"], 0)
  errores_virus <- ifelse("Bacteria" %in% rownames(tabla03p) & "Virus" %in% colnames(tabla03p), tabla03p["Bacteria", "Virus"], 0)
  
  total_casos <- sum(tabla03p)

  # Calcular métricas
  acierto_total[i] <- (aciertos_bacteria + aciertos_virus) / total_casos * 100
  acierto_bacterias[i] <- ifelse((aciertos_bacteria + errores_virus) > 0, aciertos_bacteria / (aciertos_bacteria + errores_virus) * 100, NA)
  acierto_virus[i] <- ifelse((aciertos_virus + errores_bacteria) > 0, aciertos_virus / (aciertos_virus + errores_bacteria) * 100, NA)

  # Calcular error de clasificación
  error <- 1 - sum(diag(tabla03p)) / total_casos  
  errores[i] <- error
}

# Mostrar los resultados finales
cat("Promedio del error en 500 iteracioness:", mean(errores, na.rm = TRUE), "\n")

## Promedio del error en 500 iteracioness: 0

cat("Desviación estándar del error:", sd(errores, na.rm = TRUE), "\n")

## Desviación estándar del error: 0

cat("Promedio de acierto total en 500 iteracioness:", mean(acierto_total, na.rm = TRUE), "%\n")

## Promedio de acierto total en 500 iteracioness: 100 %

cat("Promedio de acierto en bacterias en 500 iteracioness:", mean(acierto_bacterias, na.rm = TRUE), "%\n")

## Promedio de acierto en bacterias en 500 iteracioness: 100 %

cat("Promedio de acierto en virus en 500 iteracioness:", mean(acierto_virus, na.rm = TRUE), "%\n")

## Promedio de acierto en virus en 500 iteracioness: 100 %

2.2.1 1000 Iteracciones

#dat_imputadoMISSFOREST 
dat_imputadoMISSFOREST$Insuficiencia_Renal_KDiGO[dat_imputadoMISSFOREST$Insuficiencia_Renal_KDiGO %in% c("Si(1)", "Si(2)", "Si(3)")] <- "Si"

iteractions <- 500

#Vectores para almacenar resultados
resultados_RF <- matrix(NA, nrow = iteractions, ncol = 3)
resultados_Logit <- matrix(NA, nrow = iteractions, ncol = 3)
resultados_Arbol <- matrix(NA, nrow = iteractions, ncol = 3)


for (i in 1:iteractions) {
  
  set.seed(34 + i)  
  # cat("Iteración:", i, "\n")

  trainIndex <- createDataPartition(dat_imputadoMISSFOREST$Etiologia2, 
                                    p = .8, 
                                    list = FALSE, 
                                    times = 1)
  trainTRM1 <- dat_imputadoMISSFOREST[trainIndex, ]
  testTRM1 <- dat_imputadoMISSFOREST[-trainIndex, ]

  ## RF
  trm1 <- randomForest(Etiologia2 ~ ., data = trainTRM1, ntree = 500, importance = TRUE)
  ypred1 <- predict(trm1, newdata = testTRM1)
  tabla_RF <- table(testTRM1$Etiologia2, ypred1)


  porcentaje_total_RF <- (sum(diag(tabla_RF)) / sum(tabla_RF)) * 100
  porcentaje_bacteria_RF <- (tabla_RF[1,1] / sum(tabla_RF[1,])) * 100
  porcentaje_virus_RF <- (tabla_RF[2,2] / sum(tabla_RF[2,])) * 100
  resultados_RF[i, ] <- c(porcentaje_total_RF, porcentaje_bacteria_RF, porcentaje_virus_RF)

  ## LOGIT
  trainTRM1_scaled <- trainTRM1
  testTRM1_scaled <- testTRM1
  num_cols <- sapply(trainTRM1, is.numeric)
  trainTRM1_scaled[, num_cols] <- scale(trainTRM1[, num_cols])
  testTRM1_scaled[, num_cols] <- scale(testTRM1[, num_cols])

  logit_model <- glm(Etiologia2 ~ ., data = trainTRM1, family = binomial)
  pred_prob <- predict(logit_model, newdata = testTRM1, type = "response")
  pred_class <- ifelse(pred_prob > 0.5, 1, 0)
  tabla_Logit <- table(testTRM1$Etiologia2, pred_class)

  porcentaje_total_Logit <- (sum(diag(tabla_Logit)) / sum(tabla_Logit)) * 100
  porcentaje_bacteria_Logit <- (tabla_Logit[1,1] / sum(tabla_Logit[1,])) * 100
  porcentaje_virus_Logit <- (tabla_Logit[2,2] / sum(tabla_Logit[2,])) * 100
  resultados_Logit[i, ] <- c(porcentaje_total_Logit, porcentaje_bacteria_Logit, porcentaje_virus_Logit)

  ## ÁRBOLES 
  arbol_model <- rpart(Etiologia2 ~ ., data = trainTRM1, method = "class", cp = 0.001)
  pred_arbol <- predict(arbol_model, newdata = testTRM1, type = "class")
  tabla_Arbol <- table(testTRM1$Etiologia2, pred_arbol)

  porcentaje_total_Arbol <- (sum(diag(tabla_Arbol)) / sum(tabla_Arbol)) * 100
  porcentaje_bacteria_Arbol <- (tabla_Arbol[1,1] / sum(tabla_Arbol[1,])) * 100
  porcentaje_virus_Arbol <- (tabla_Arbol[2,2] / sum(tabla_Arbol[2,])) * 100
  resultados_Arbol[i, ] <- c(porcentaje_total_Arbol, porcentaje_bacteria_Arbol, porcentaje_virus_Arbol)
}

media_RF <- colMeans(resultados_RF, na.rm = TRUE)
media_Logit <- colMeans(resultados_Logit, na.rm = TRUE)
media_Arbol <- colMeans(resultados_Arbol, na.rm = TRUE)

resultados_finales <- data.frame(
  Acierto_Total = c(media_RF[1], media_Logit[1], media_Arbol[1]),
  Acierto_Bacterias = c(media_RF[2], media_Logit[2], media_Arbol[2]),
  Acierto_Virus = c(media_RF[3], media_Logit[3], media_Arbol[3])
)

rownames(resultados_finales) <- c("RF", "Logit", "Árboles")
# Mostrar resultados finales
print(resultados_finales)

##         Acierto_Total Acierto_Bacterias Acierto_Virus
## RF           90.47568          85.65333      93.76364
## Logit        78.17297          74.44000      80.71818
## Árboles      85.15676          82.54667      86.93636

3 General Falsos Faltantes y Clasificar

ModelAmarillo

## 
## Call:
##  randomForest(formula = Etiologia2 ~ ., data = train, cp = 0.001,      ntree = ntre_ee, importance = TRUE) 
##                Type of random forest: classification
##                      Number of trees: 500
## No. of variables tried at each split: 4
## 
##         OOB estimate of  error rate: 12.36%
## Confusion matrix:
##          Bacteria Virus class.error
## Bacteria       36     8  0.18181818
## Virus           3    42  0.06666667

La idea es de la totalidad de pacientes quedarnos solo con las columnas incluídas en el modelo de clasificación. De los 309 pacientes nos quedamos solo con 24 columas y los pacientes víricos y bacterianos es decir unos 190. Las 23 variables elegidas según el mejor procedimiento usado y la clasificatoria.

Dividimos en dos el dataset, uno que contenga pacientes con valores faltantes y otro no.

Pacientes Víricos o Bacterianos con valores faltantes: 79
Pacientes Víricos o Bacterianos sin valores faltantes: 111

En el que no tiene valores faltantes generamos valores faltantes en idéntica proporción:

## Crear nuevo data set sin valores faltantes
datosNONA <- datos[complete.cases(datos), ]
datosNA <- datos[!complete.cases(datos), ]

vis_miss(datos, sort_miss = TRUE, show_perc = TRUE) + 
  theme(axis.text.x = element_text(angle = 90))

vis_miss(datosNONA_mod, sort_miss = TRUE, show_perc = TRUE) + 
  theme(axis.text.x = element_text(angle = 90))

datosNONA_mod que son pacientes con datos completos. Se generan en misma proporción faltantes y se su datos mediante el algoritmo creado de la distancia de Gower. Se imputan los datos considerando TODOS los pacientes, no solo los víricos o bacterianos.

datInput <- subset(dat,select=-c(Lactancia_Materna,ID,Vacuna_Rotavirus,F_Ingreso,Etiologia,F_Alta,
                              Antiemeticos,Complicaciones,F_Nacimiento,Etiologia3))

n_long=matrix(nrow = length(v_best))
for(i in 1:length(n_long)){
  n_long[i,]=which(names(datInput) == v_best[i])
}
datInput<-subset(datInput,select=-n_long)
datInput <- datInput[complete.cases(datInput), ]

Se clasifican todos los pacientes una vez se han imputado datos y se valida con su Etiología real en cada caso:

ypred3 = predict(ModelAmarillo, newdata = dat_or_input)
Etiologia3p = ypred3
dat_or_input$Etiologia2 <- droplevels(dat_or_input$Etiologia2,"Desconocido")
(tabla03=table(dat_or_input$Etiologia2,Etiologia3p))
##            Etiologia3p
##             Bacteria Virus
##   Bacterium       51     4
##   Virus            0    56

## Porcentaje de acierto total: 96.4 %

## Porcentaje de fallo total: 3.6 %

## Porcentaje de acierto en bacterias: 92.73 %

## Porcentaje de fallo en bacterias: 7.27 %

## Porcentaje de acierto en virus: 100 %

## Porcentaje de fallo en virus: 0 %

Hacer este punto B veces para varias estrucutras de faltantes. Imputar y ver cómo clasifica:

# Número de iteraciones
iteractions <- 500

# Vectores para guardar los resultados en cada iteración
acierto_total <- numeric(iteractions)
fallo_total <- numeric(iteractions)
acierto_bacteria <- numeric(iteractions)
fallo_bacteria <- numeric(iteractions)
acierto_virus <- numeric(iteractions)
fallo_virus <- numeric(iteractions)

for (iter in 1:iteractions) {
  
  set.seed(123 + iter)  # Cambiar semilla en cada iteración
  
  # Generar valores faltantes en la misma proporción
  datosNONA_mod <- datosNONA  
  porcentaje_NA <- colMeans(is.na(datos))  
  
  for (col in names(datosNONA)) {
    num_filas <- nrow(datosNONA)  
    num_NA <- round(porcentaje_NA[col] * num_filas)  
    
    if (num_NA > 0) {
      filas_NA <- sample(1:num_filas, num_NA)  
      datosNONA_mod[filas_NA, col] <- NA  
    }
  }
  
  dat_or_input <- datosNONA_mod
  for (i in 1:nrow(datosNONA_mod)) {
      datInput <- rbind(datosNONA_mod[complete.cases(datosNONA_mod), ],datosNA)
    dat_or_input[i, ] <- Input_Gower(datInput, datosNONA_mod[i, ], 7)
  }

  ypred3 <- predict(ModelAmarillo, newdata = dat_or_input)
  Etiologia3p <- ypred3
  
  dat_or_input$Etiologia2 <- droplevels(dat_or_input$Etiologia2, "Unknown")
  tabla03 <- table(dat_or_input$Etiologia2, Etiologia3p)

  total_aciertos <- sum(diag(tabla03))  
  total_fallos <- sum(tabla03) - total_aciertos  

  total_bacteria <- sum(tabla03["Bacterium", ])
  aciertos_bacteria <- tabla03["Bacterium", "Bacteria"]
  
  total_virus <- sum(tabla03["Virus", ])
  aciertos_virus <- tabla03["Virus", "Virus"]
  
  acierto_total[iter] <- (total_aciertos / sum(tabla03)) * 100
  fallo_total[iter] <- (total_fallos / sum(tabla03)) * 100
  acierto_bacteria[iter] <- (aciertos_bacteria / total_bacteria) * 100
  fallo_bacteria[iter] <- 100 - acierto_bacteria[iter]
  acierto_virus[iter] <- (aciertos_virus / total_virus) * 100
  fallo_virus[iter] <- 100 - acierto_virus[iter]
}

acierto_total_medio <- mean(acierto_total, na.rm = TRUE)
fallo_total_medio <- mean(fallo_total, na.rm = TRUE)
acierto_bacteria_medio <- mean(acierto_bacteria, na.rm = TRUE)
fallo_bacteria_medio <- mean(fallo_bacteria, na.rm = TRUE)
acierto_virus_medio <- mean(acierto_virus, na.rm = TRUE)
fallo_virus_medio <- mean(fallo_virus, na.rm = TRUE)

cat("Promedio de acierto total:", round(acierto_total_medio, 2), "%\n")

## Promedio de acierto total: 94.15 %

cat("Promedio de fallo total:", round(fallo_total_medio, 2), "%\n")

## Promedio de fallo total: 5.85 %

cat("Promedio de acierto en bacterias:", round(acierto_bacteria_medio, 2), "%\n")

## Promedio de acierto en bacterias: 93.7 %

cat("Promedio de fallo en bacterias:", round(fallo_bacteria_medio, 2), "%\n")

## Promedio de fallo en bacterias: 6.3 %

cat("Promedio de acierto en virus:", round(acierto_virus_medio, 2), "%\n")

## Promedio de acierto en virus: 99.59 %

cat("Promedio de fallo en virus:", round(fallo_virus_medio, 2), "%\n")

## Promedio de fallo en virus: 0.41 %

3.1 Comparar métodos de imputación

3.1.1 GOWER

MAPE_i <- c()
VAR_de_las_cuantitativas <-c()
precision_total <- c()
iteractions <- 500
library(ggplot2)

# Calcular los valores faltantes por fila
faltantes_por_fila <- rowSums(is.na(datosNA))

# Crear un data frame para ggplot
df_faltantes <- data.frame(fila = seq_along(faltantes_por_fila), faltantes = faltantes_por_fila)

# Graficar
ggplot(df_faltantes, aes(x = fila, y = faltantes)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  labs(title = "Valores Faltantes por Fila", x = "Fila", y = "Cantidad de Faltantes") +
  theme_minimal()

# Generar DataFrames con valores faltantes
datosNONA_1 <- datos[complete.cases(datos), ] # Data frame sin NA
datosNA_1 <- datos[!complete.cases(datos), ]  # Data frame con NA

for (iter in 1:iteractions) {
  
  set.seed(13 + iter) 
  
  
  porcentaje_NA_1 <- colMeans(is.na(datos)) 
  
  datosNONA_mod_1 <- datosNONA_1  
  
  for (col in names(datosNONA_1)) {
    num_filas_1 <- nrow(datosNONA_1)
    num_NA_1 <- round(porcentaje_NA_1[col] * num_filas_1)
    
    if (num_NA_1 > 0) {
      filas_NA_1 <- sample(1:num_filas_1, num_NA_1)
      datosNONA_mod_1[filas_NA_1, col] <- NA
    }
  }
  
  dat_or_input_1 <- datosNONA_mod_1
  n_primeros <- 7
  
  datInput <- rbind(datosNONA_mod_1[complete.cases(datosNONA_mod_1), ],datosNA_1)
  
  for (i in 1:nrow(datosNONA_mod_1)) {
    dat_or_input_1[i, ] <- Input_Gower(datInput, datosNONA_mod_1[i, ], n_primeros)
  }
  
  error_relativo <- c()
  precision_score <- c()
  

  for (col in names(datosNONA_1)) {
    
    valores_imputados <- dat_or_input_1[[col]]
    valores_reales <- datosNONA_1[[col]]
    valores_con_NA <- datosNONA_mod_1[[col]]
    
    indices_NA <- which(is.na(valores_con_NA))
    
    valores_imputados <- valores_imputados[indices_NA]
    valores_reales <- valores_reales[indices_NA]
    
    if (is.numeric(valores_reales)) {
      error <- abs(valores_imputados - valores_reales) / abs(valores_reales)
      error_relativo <- c(error_relativo, error)
    } else {
      precision <- as.numeric(valores_imputados == valores_reales)
      precision_score <- c(precision_score, precision)
    }
  }

# Calcular métricas de la iteración actual
  error_relativo_promedio <- mean(error_relativo, na.rm = TRUE)
  precision_promedio <- mean(precision_score, na.rm = TRUE) * 100
  
  # Guardar los resultados en los vectores
  MAPE_i <- c(MAPE_i, error_relativo_promedio)
  precision_total <- c(precision_total, precision_promedio)
}

MAPEs <- mean(MAPE_i, na.rm = TRUE)
MAPE2s <- median(MAPE_i, na.rm = TRUE)
#MEAN_VAR_de_las_cuantitativas <- mean(VAR_de_las_cuantitativas, na.rm = TRUE)
MEAN_precision_total <- mean(precision_total, na.rm = TRUE)

# Mostrar resultados
cat("MAPE medio:", MAPEs, "\n")

## MAPE medio: 0.2269777

cat("MAPE mediana:", MAPE2s, "\n")

## MAPE mediana: 0.2067294

cat("Media de la precisión total media:", MEAN_precision_total, "% \n")

## Media de la precisión total media: 66.55833 %

MAPE10 <- quantile(MAPE_i, probs = 0.10, na.rm = TRUE)
MAPE25 <- quantile(MAPE_i, probs = 0.25, na.rm = TRUE)
MAPE50 <- quantile(MAPE_i, probs = 0.50, na.rm = TRUE)  # Equivalente a la mediana
MAPE75 <- quantile(MAPE_i, probs = 0.75, na.rm = TRUE)
MAPE90 <- quantile(MAPE_i, probs = 0.90, na.rm = TRUE)

tabla_MAPE <- data.frame(
  Percentil = c("10%", "25%", "50% (Mediana)", "75%", "90%"),
  Valor = round(c(MAPE10, MAPE25, MAPE50, MAPE75, MAPE90), 4)  # Redondeo a 4 decimales
)

kable(tabla_MAPE, caption = "Percentiles de los Errores Relativos (MAPE)")

Percentiles de los Errores Relativos (MAPE)
	Percentil	Valor
10%	10%	0.1279
25%	25%	0.1581
50%	50% (Mediana)	0.2067
75%	75%	0.2640
90%	90%	0.3640

Boxplot Error Relativo Total

# Crear un data frame con los datos del error relativo
df_error <- data.frame(Error_Relativo = MAPE_i)

# Crear el boxplot con puntos de dispersión
P1 <- ggplot(df_error, aes(x = "", y = Error_Relativo)) + 
  geom_boxplot(fill = "lightblue", color = "black", outlier.shape = NA) +  
  geom_jitter(width = 0.2, alpha = 0.5, color = "black") +  
  labs(title = "Boxplot del Error Relativo con Dispersión Gower",
       y = "Error Relativo", x = "") +
  theme_minimal()

P1

#### Boxplot Precision Total

df_precision <- data.frame(Precision_Total = precision_total)

# Crear el boxplot con puntos de dispersión
P2 <- ggplot(df_precision, aes(x = "", y = Precision_Total)) +  
  geom_boxplot(fill = "lightgreen", color = "black", outlier.shape = NA) +  
  geom_jitter(width = 0.2, alpha = 0.5, color = "black") +  
  labs(title = "Boxplot de Precisión Total con Dispersión Gower",
       y = "Precisión Total", x = "") + 
  theme_minimal()

P2

3.1.2 MISSSforest

MAPE_i <- c()
VAR_de_las_cuantitativas <-c()
precision_total <- c()

iteractions <- 500

for (iter in 1:iteractions) {
  
  set.seed(13 + iter) 
  
  # Generar DataFrames con valores faltantes
  datosNONA_1 <- datos[complete.cases(datos), ] # Data frame sin NA
  datosNA_1 <- datos[!complete.cases(datos), ]  # Data frame con NA
  
  porcentaje_NA_1 <- colMeans(is.na(datos)) 
  
  datosNONA_mod_1 <- datosNONA_1  
  
  for (col in names(datosNONA_1)) {
    num_filas_1 <- nrow(datosNONA_1)
    num_NA_1 <- round(porcentaje_NA_1[col] * num_filas_1)
    
    if (num_NA_1 > 0) {
      filas_NA_1 <- sample(1:num_filas_1, num_NA_1)
      datosNONA_mod_1[filas_NA_1, col] <- NA
    }
  }
  
  datosNONA_mod_1 <- datosNONA_mod_1 %>%
  mutate_if(is.character, as.factor)
  dat_imputadoMISSFOREST <- missForest(datosNONA_mod_1)
  dat_or_input_1 <- data.frame(dat_imputadoMISSFOREST$ximp)
  
  error_relativo <- c()
  precision_score <- c()
  
  for (col in names(datosNONA_1)) {
    
    valores_imputados <- dat_or_input_1[[col]]
    valores_reales <- datosNONA_1[[col]]
    valores_con_NA <- datosNONA_mod_1[[col]]
    
    indices_NA <- which(is.na(valores_con_NA))
    
    valores_imputados <- valores_imputados[indices_NA]
    valores_reales <- valores_reales[indices_NA]
    
    if (is.numeric(valores_reales)) {
      error <- abs(valores_imputados - valores_reales) / abs(valores_reales)
      error_relativo <- c(error_relativo, error)
    } else {
      precision <- as.numeric(valores_imputados == valores_reales)
      precision_score <- c(precision_score, precision)
    }
  }

# Calcular métricas de la iteración actual
  error_relativo_promedio <- mean(error_relativo, na.rm = TRUE)
  precision_promedio <- mean(precision_score, na.rm = TRUE) * 100
  
  # Guardar los resultados en los vectores
  MAPE_i <- c(MAPE_i, error_relativo_promedio)
  precision_total <- c(precision_total, precision_promedio)
}

MAPEs <- mean(MAPE_i, na.rm = TRUE)
MAPE2s <- median(MAPE_i, na.rm = TRUE)
#MEAN_VAR_de_las_cuantitativas <- mean(VAR_de_las_cuantitativas, na.rm = TRUE)
MEAN_precision_total <- mean(precision_total, na.rm = TRUE)

# Mostrar resultados
cat("MAPE medio:", MAPEs, "\n")

## MAPE medio: 0.1774245

cat("MAPE mediana:", MAPE2s, "\n")

## MAPE mediana: 0.1521602

cat("Media de la precisión total media:", MEAN_precision_total, "% \n")

## Media de la precisión total media: 71.78333 %

MAPE10 <- quantile(MAPE_i, probs = 0.10, na.rm = TRUE)
MAPE25 <- quantile(MAPE_i, probs = 0.25, na.rm = TRUE)
MAPE50 <- quantile(MAPE_i, probs = 0.50, na.rm = TRUE)  # Equivalente a la mediana
MAPE75 <- quantile(MAPE_i, probs = 0.75, na.rm = TRUE)
MAPE90 <- quantile(MAPE_i, probs = 0.90, na.rm = TRUE)

tabla_MAPE <- data.frame(
  Percentil = c("10%", "25%", "50% (Mediana)", "75%", "90%"),
  Valor = round(c(MAPE10, MAPE25, MAPE50, MAPE75, MAPE90), 4)  # Redondeo a 4 decimales
)

kable(tabla_MAPE, caption = "Percentiles de los Errores Relativos (MAPE)")

Percentiles de los Errores Relativos (MAPE)
	Percentil	Valor
10%	10%	0.1224
25%	25%	0.1360
50%	50% (Mediana)	0.1522
75%	75%	0.2388
90%	90%	0.2770

Boxplot Error Relativo Total

# Crear un data frame con los datos del error relativo
df_error <- data.frame(Error_Relativo = MAPE_i)

# Crear el boxplot con puntos de dispersión
P1 <- ggplot(df_error, aes(x = "", y = Error_Relativo)) + 
  geom_boxplot(fill = "lightblue", color = "black", outlier.shape = NA) +  
  geom_jitter(width = 0.2, alpha = 0.5, color = "black") +  
  labs(title = "Boxplot del Error Relativo con Dispersión MissForest",
       y = "Error Relativo", x = "") +
  theme_minimal()

P1

#### Boxplot Precision Total

df_precision <- data.frame(Precision_Total = precision_total)

# Crear el boxplot con puntos de dispersión
P2 <- ggplot(df_precision, aes(x = "", y = Precision_Total)) +  
  geom_boxplot(fill = "lightgreen", color = "black", outlier.shape = NA) +  
  geom_jitter(width = 0.2, alpha = 0.5, color = "black") +  
  labs(title = "Boxplot de Precisión Total con Dispersión MissForest",
       y = "Precisión Total", x = "") + 
  theme_minimal()

P2

resultados <- list(Gower = list(), MissForest = list())

metodos <- c("Gower", "MissForest")

for (metodo in metodos) {
  
  MAPE_i <- c()
  precision_total <- c()
  iteractions <- 500

  for (iter in 1:iteractions) {
    
    set.seed(13 + iter) 
    
    # Generar DataFrames con valores faltantes
    datosNONA_1 <- datos[complete.cases(datos), ] 
    datosNA_1 <- datos[!complete.cases(datos), ]  
    
    porcentaje_NA_1 <- colMeans(is.na(datos)) 
    datosNONA_mod_1 <- datosNONA_1  
    
    for (col in names(datosNONA_1)) {
      num_filas_1 <- nrow(datosNONA_1)
      num_NA_1 <- round(porcentaje_NA_1[col] * num_filas_1)
      
      if (num_NA_1 > 0) {
        filas_NA_1 <- sample(1:num_filas_1, num_NA_1)
        datosNONA_mod_1[filas_NA_1, col] <- NA
      }
    }

    # Aplicar el método de imputación
    if (metodo == "Gower") {
      dat_or_input_1 <- datosNONA_mod_1
      datInput <- rbind(datosNONA_mod_1[complete.cases(datosNONA_mod_1), ],datosNA_1)
      for (i in 1:nrow(datosNONA_mod_1)) {
        dat_or_input_1[i, ] <- Input_Gower(datInput, datosNONA_mod_1[i, ], 7)
      }
      
    } else if (metodo == "MissForest") {
      datosNONA_mod_1 <- datosNONA_mod_1 %>% mutate_if(is.character, as.factor)
      dat_imputadoMISSFOREST <- missForest(datosNONA_mod_1)
      dat_or_input_1 <- data.frame(dat_imputadoMISSFOREST$ximp)
    }

    # Evaluar la imputación
    error_relativo <- c()
    precision_score <- c()
    
    for (col in names(datosNONA_1)) {
      
      valores_imputados <- dat_or_input_1[[col]]
      valores_reales <- datosNONA_1[[col]]
      valores_con_NA <- datosNONA_mod_1[[col]]
      
      indices_NA <- which(is.na(valores_con_NA))
      
      valores_imputados <- valores_imputados[indices_NA]
      valores_reales <- valores_reales[indices_NA]
      
      if (is.numeric(valores_reales)) {
        error <- abs(valores_imputados - valores_reales) / abs(valores_reales)
        error_relativo <- c(error_relativo, error)
      } else {
        precision <- as.numeric(valores_imputados == valores_reales)
        precision_score <- c(precision_score, precision)
      }
    }

    # Guardar métricas
    MAPE_i <- c(MAPE_i, mean(error_relativo, na.rm = TRUE))
    precision_total <- c(precision_total, mean(precision_score, na.rm = TRUE) * 100)
  }
  
  # Guardar resultados en la lista
  resultados[[metodo]] <- list(
    MAPE_medio = mean(MAPE_i, na.rm = TRUE),
    MAPE_mediana = median(MAPE_i, na.rm = TRUE),
    precision_media = mean(precision_total, na.rm = TRUE),
    percentiles = quantile(MAPE_i, probs = c(0.10, 0.25, 0.50, 0.75, 0.90), na.rm = TRUE),
    errores = MAPE_i,
    precision = precision_total
  )
}

# Crear tabla de comparación
tabla_comparacion <- data.frame(
  Métrica = c("MAPE Medio", "MAPE Mediana", "Precisión Media"),
  Gower = c(resultados$Gower$MAPE_medio, resultados$Gower$MAPE_mediana, resultados$Gower$precision_media),
  MissForest = c(resultados$MissForest$MAPE_medio, resultados$MissForest$MAPE_mediana, resultados$MissForest$precision_media)
)

# Mostrar tabla
kable(tabla_comparacion, caption = "Comparación de Métodos de Imputación")

Comparación de Métodos de Imputación
Métrica	Gower	MissForest
MAPE Medio	0.2269777	0.1774245
MAPE Mediana	0.2067294	0.1521602
Precisión Media	66.5583333	71.7833333

# Boxplot de Error Relativo Total
P1 <- ggplot(df_error_combined, aes(x = Método, y = Error_Relativo, fill = Método)) + 
  geom_boxplot(outlier.shape = NA) +  
  geom_jitter(width = 0.2, alpha = 0.5, color = "black") +  
  scale_fill_manual(values = c("Gower" = "lightblue", "MissForest" = "lightcoral")) +
  labs(title = "Comparación del Error Relativo entre Métodos",
       y = "Error Relativo", x = "Método") +
  theme_minimal()

# Boxplot de Precisión Total
P2 <- ggplot(df_precision_combined, aes(x = Método, y = Precision_Total, fill = Método)) +  
  geom_boxplot(outlier.shape = NA) +  
  geom_jitter(width = 0.2, alpha = 0.5, color = "black") +  
  scale_fill_manual(values = c("Gower" = "lightgreen", "MissForest" = "orange")) +
  labs(title = "Comparación de la Precisión Total entre Métodos",
       y = "Precisión Total", x = "Método") + 
  theme_minimal()

# Combinar ambos gráficos en una sola visualización
grid.arrange(P1, P2, ncol = 2)

4. Clasificar los pacientes Desconocidos

datosUNK <- dat_RF %>% 
  filter(Etiologia2 == "Bacterium" | Etiologia2 == "Virus")

Pacientes de Etiología desconocida. Aplicar procedimiento y dar probabilidades de Vírico o Bacteriano. Se pueden tomar decisiones de los pacientes desconocido. Imputar también en estos pacientes

datosUNK <- dat_RF %>% 
  filter(Etiologia2 == "Unknown")

Selecciono solo las 24 columnas que considera el mejor modelo de clasificación y completo los valores faltantes

datosUNK<-subset(datosUNK,select=-c(Lactancia_Materna,ID,Vacuna_Rotavirus,F_Ingreso,Etiologia,F_Alta,
                              Antiemeticos,Complicaciones,F_Nacimiento,Etiologia3))
n_long=matrix(nrow = length(v_best))
for(i in 1:length(n_long)){
  n_long[i,]=which(names(datosUNK) == v_best[i])
}
datosUNK<-subset(datosUNK,select=-n_long)

Clasifico Para Ver Cómo se Porta el Modelo antes imputando datos a los faltantes

#-----ERORES DE PREDICCION --------#
ypred4_probs <- predict(ModelAmarillo, newdata = datosUNKFILL, type = "prob")
str(ypred4_probs)  # Muestra la estructura del objeto

##  'matrix' num [1:119, 1:2] NA NA NA NA NA NA NA NA NA NA ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : chr [1:119] "1" "2" "3" "9" ...
##   ..$ : chr [1:2] "Bacteria" "Virus"

tabla3 <- datosUNKFILL
tabla3$Prob_Virus <- ypred4_probs[, "Virus"]
tabla3$Prob_Bacteria <- ypred4_probs[, "Bacteria"]

TABLA CON PACIENTES DESCONOCIDOS VALORES DE PORCENTAJE

# Mostrar la tabla con DataTable, incluyendo las probabilidades
library(DT)
datatable(tabla3, 
          options = list(scrollX = TRUE,  
                         scrollY = "400px",  
                         pageLength = 10),  
          rownames = FALSE)

TAREA REVISIÓN

Gonzalo Aris 16021

2025 02 14

2.1 IMPUTANDO DATOS CON MISSFOREST MANTENIENDO LA PROPORCIÓN DE GOLDEN MODEL

Clasificando con RF

Errores de Preccción RF MissForest

Modelo de Regresión Logística

Errores de Preccción Regresión Logística MissForest

Modelo de Árboles de Decisión

Errores de Preccción Árboles de Decisión

2.2 IMPUTANDO DATOS CON MISSFOREST PROP 80/20

Clasificando con RF

Errores de Preccción RF MissForest

Modelo de Regresión Logística

Errores de Preccción Regresión Logística MissForest

Modelo de Árboles de Decisión

Errores de Preccción Árboles de Decisión

2.2.1 Mejor Modelo Inluído en la APP en comparación con punto 2.2

2.2.1.1 Clasificar solo en los datos completos con el GOLDEN MODEL

2.2.1.2 Reentrenar el GOLDEN MODEL B veces y clasificar

2.2.1.3. Validar metodología sin Gower y sin reentrenar el Modelo

2.2.1 1000 Iteracciones

3 General Falsos Faltantes y Clasificar

3.1 Comparar métodos de imputación

3.1.1 GOWER

Boxplot Error Relativo Total

3.1.2 MISSSforest

Boxplot Error Relativo Total

4. Clasificar los pacientes Desconocidos

TABLA CON PACIENTES DESCONOCIDOS VALORES DE PORCENTAJE