Informe Final Estadística Descriptiva
Stiben Rosas - Hugo Alejandro Millan
`2026-08-04
1. Carga de librerías y datos
library(here)## Warning: package 'here' was built under R version 4.5.3## here() starts at C:/Users/USER/Downloads/Estadístco/Trabajo final Estadística Descriptiva unlibrary(readxl)
library(e1071)
library(ggplot2)##
## Adjuntando el paquete: 'ggplot2'## The following object is masked from 'package:e1071':
##
## elementlibrary(car)## Cargando paquete requerido: carDatalibrary(scatterplot3d)
library(corrplot)## Warning: package 'corrplot' was built under R version 4.5.3## corrplot 0.95 loadedlibrary(aplpack)## Warning: package 'aplpack' was built under R version 4.5.3library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following object is masked from 'package:car':
##
## recode## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# Ajusta la ruta si el archivo no está en la raíz del proyecto
ruta <- here("DATOSEST.xlsx")
DATATEST <- read_excel(ruta)
head(DATATEST)## # A tibble: 6 × 13
## Individuo Edad Genero Severidad_de_Síntomas Hospitalizado
## <chr> <dbl> <chr> <chr> <chr>
## 1 #1 56 Femenino Leve No
## 2 #2 69 Femenino Severo No
## 3 #3 46 Femenino Leve Sí
## 4 #4 32 Femenino Leve No
## 5 #5 60 Masculino Moderado No
## 6 #6 25 Masculino Leve No
## # ℹ 8 more variables: Dias_para_la_recuperacion <dbl>, Nivel_de_fatiga <dbl>,
## # Problemas_respiratorios <chr>, Niebla_mental <chr>,
## # Pérdida_del_gusto_y_el_olfato <chr>, Nivel_de_actividad_física <chr>,
## # Impacto_en_la_salud_mental <dbl>, Riesgo_de_covid_prolongado <chr>summary(DATATEST)## Individuo Edad Genero Severidad_de_Síntomas
## Length:201 Min. :18.00 Length:201 Length:201
## Class :character 1st Qu.:31.00 Class :character Class :character
## Mode :character Median :43.00 Mode :character Mode :character
## Mean :43.32
## 3rd Qu.:56.00
## Max. :69.00
## Hospitalizado Dias_para_la_recuperacion Nivel_de_fatiga
## Length:201 Min. : 8.00 Min. :1.00
## Class :character 1st Qu.: 50.00 1st Qu.:1.00
## Mode :character Median :107.00 Median :3.00
## Mean : 95.86 Mean :3.01
## 3rd Qu.:142.00 3rd Qu.:4.00
## Max. :179.00 Max. :5.00
## Problemas_respiratorios Niebla_mental Pérdida_del_gusto_y_el_olfato
## Length:201 Length:201 Length:201
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## Nivel_de_actividad_física Impacto_en_la_salud_mental
## Length:201 Min. :1.000
## Class :character 1st Qu.:2.000
## Mode :character Median :3.000
## Mean :2.935
## 3rd Qu.:4.000
## Max. :5.000
## Riesgo_de_covid_prolongado
## Length:201
## Class :character
## Mode :character
##
##
## 2. Preparación de variables derivadas
Estas tablas se usan en varias secciones posteriores (correlaciones, gráfico 3D, Chernoff, similaridad binaria), por eso se crean aquí, al inicio.
# Variable de riesgo como factor ordenado
DATATEST$Riesgo_de_covid_prolongado <- factor(
DATATEST$Riesgo_de_covid_prolongado,
levels = c("Bajo", "Medio", "Alto")
)
# Variables cuantitativas
DATATEST_cuant <- data.frame(
Edad = DATATEST$Edad,
Dias_Recuperacion = DATATEST$Dias_para_la_recuperacion,
Fatiga = DATATEST$Nivel_de_fatiga,
Salud_Mental = DATATEST$Impacto_en_la_salud_mental
)
# Variable de riesgo aparte (para colorear el gráfico 3D)
DATATEST_riesgo <- data.frame(
Riesgo = factor(DATATEST$Riesgo_de_covid_prolongado,
levels = c("Bajo", "Medio", "Alto"))
)
# Variables categóricas binarias (Sí/No) recodificadas a 0/1
DATATEST_binarias <- data.frame(
Hospitalizado = as.integer(DATATEST$Hospitalizado == "Sí"),
Problemas_Respirator = as.integer(DATATEST$Problemas_respiratorios == "Sí"),
Niebla_Mental = as.integer(DATATEST$Niebla_mental == "Sí"),
Perdida_Gusto_Olfato = as.integer(DATATEST$`Pérdida_del_gusto_y_el_olfato` == "Sí")
)3. Estadísticos univariados
3.1 Edad
stats_univariado <- data.frame(
Variable = "Edad",
Media = mean(DATATEST$Edad, na.rm = TRUE),
Mediana = median(DATATEST$Edad, na.rm = TRUE),
Desv_Std = sd(DATATEST$Edad, na.rm = TRUE),
Varianza = var(DATATEST$Edad, na.rm = TRUE),
CV = sd(DATATEST$Edad, na.rm = TRUE) / mean(DATATEST$Edad, na.rm = TRUE),
MEDA = median(abs(DATATEST$Edad - median(DATATEST$Edad, na.rm = TRUE)), na.rm = TRUE),
Asimetria = skewness(DATATEST$Edad, na.rm = TRUE),
Curtosis = kurtosis(DATATEST$Edad, na.rm = TRUE)
)
print(stats_univariado)## Variable Media Mediana Desv_Std Varianza CV MEDA Asimetria
## 1 Edad 43.32338 43 14.97397 224.2199 0.3456326 13 -0.04373587
## Curtosis
## 1 -1.195051Medias recortadas (para evaluar sensibilidad a valores extremos):
mean(DATATEST$Edad, na.rm = TRUE)## [1] 43.32338mean(DATATEST$Edad, trim = 0.02, na.rm = TRUE)## [1] 43.31606mean(DATATEST$Edad, trim = 0.05, na.rm = TRUE)## [1] 43.31492mean(DATATEST$Edad, trim = 0.10, na.rm = TRUE)## [1] 43.37267ggplot(DATATEST, aes(x = Edad)) +
geom_histogram(bins = 15, fill = "skyblue", color = "black", alpha = 0.7) +
labs(title = "Distribución de la Edad", x = "Edad", y = "Frecuencia") +
theme_light()
3.2 Días para la recuperación
stats_dias <- data.frame(
Variable = "Días Recuperación",
Media = round(mean(DATATEST$Dias_para_la_recuperacion, na.rm = TRUE), 2),
Mediana = round(median(DATATEST$Dias_para_la_recuperacion, na.rm = TRUE), 2),
Desv_Std = round(sd(DATATEST$Dias_para_la_recuperacion, na.rm = TRUE), 2),
Varianza = var(DATATEST$Dias_para_la_recuperacion, na.rm = TRUE),
CV = sd(DATATEST$Dias_para_la_recuperacion, na.rm = TRUE) / mean(DATATEST$Dias_para_la_recuperacion, na.rm = TRUE),
MEDA = median(abs(DATATEST$Dias_para_la_recuperacion - median(DATATEST$Dias_para_la_recuperacion, na.rm = TRUE)), na.rm = TRUE),
Asimetria = round(skewness(DATATEST$Dias_para_la_recuperacion, na.rm = TRUE), 2),
Curtosis = round(kurtosis(DATATEST$Dias_para_la_recuperacion, na.rm = TRUE), 2)
)
print(stats_dias)## Variable Media Mediana Desv_Std Varianza CV MEDA Asimetria
## 1 Días Recuperación 95.86 107 52.32 2737.694 0.5458514 45 -0.19
## Curtosis
## 1 -1.32Medias recortadas:
mean(DATATEST$Dias_para_la_recuperacion, na.rm = TRUE)## [1] 95.85572mean(DATATEST$Dias_para_la_recuperacion, trim = 0.02, na.rm = TRUE)## [1] 95.95855mean(DATATEST$Dias_para_la_recuperacion, trim = 0.05, na.rm = TRUE)## [1] 96.27624mean(DATATEST$Dias_para_la_recuperacion, trim = 0.10, na.rm = TRUE)## [1] 96.87578ggplot(DATATEST, aes(x = Dias_para_la_recuperacion)) +
geom_histogram(bins = 20, fill = "salmon", color = "darkred", alpha = 0.6) +
labs(title = "Distribución de Días para la Recuperación",
x = "Días", y = "Cantidad de Personas") +
theme_classic()
3.3 Nivel de fatiga
stats_fatiga <- data.frame(
Variable = "Nivel_de_fatiga",
Mediana = round(median(DATATEST$Nivel_de_fatiga, na.rm = TRUE), 2),
MEDA = round(median(abs(DATATEST$Nivel_de_fatiga - median(DATATEST$Nivel_de_fatiga, na.rm = TRUE)), na.rm = TRUE), 2),
CV = round(median(abs(DATATEST$Nivel_de_fatiga - median(DATATEST$Nivel_de_fatiga, na.rm = TRUE)), na.rm = TRUE) /
median(DATATEST$Nivel_de_fatiga, na.rm = TRUE), 4),
Asimetria = round(skewness(DATATEST$Nivel_de_fatiga, na.rm = TRUE), 2),
Curtosis = round(kurtosis(DATATEST$Nivel_de_fatiga, na.rm = TRUE), 2)
)
print(stats_fatiga)## Variable Mediana MEDA CV Asimetria Curtosis
## 1 Nivel_de_fatiga 3 1 0.3333 -0.11 -1.37frec_fatiga <- table(DATATEST$Nivel_de_fatiga)
barplot(frec_fatiga,
main = "Distribución del Nivel de Fatiga",
xlab = "Nivel (Escala 1-5)",
ylab = "Frecuencia de Pacientes",
col = "lightblue",
border = "white",
ylim = c(0, max(frec_fatiga) + 10))
print(frec_fatiga)##
## 1 2 3 4 5
## 51 22 43 44 413.4 Impacto en la salud mental
stats_salud_mental <- data.frame(
Variable = "Salud Mental",
Media = round(mean(DATATEST$Impacto_en_la_salud_mental, na.rm = TRUE), 2),
Mediana = round(median(DATATEST$Impacto_en_la_salud_mental, na.rm = TRUE), 2),
Desv_Std = round(sd(DATATEST$Impacto_en_la_salud_mental, na.rm = TRUE), 2),
MEDA = round(median(abs(DATATEST$Impacto_en_la_salud_mental - median(DATATEST$Impacto_en_la_salud_mental, na.rm = TRUE)), na.rm = TRUE), 2),
CV = round(median(abs(DATATEST$Impacto_en_la_salud_mental - median(DATATEST$Impacto_en_la_salud_mental, na.rm = TRUE)), na.rm = TRUE) /
median(DATATEST$Impacto_en_la_salud_mental, na.rm = TRUE), 4),
Asimetria = round(skewness(DATATEST$Impacto_en_la_salud_mental, na.rm = TRUE), 2),
Curtosis = round(kurtosis(DATATEST$Impacto_en_la_salud_mental, na.rm = TRUE), 2)
)
print(stats_salud_mental)## Variable Media Mediana Desv_Std MEDA CV Asimetria Curtosis
## 1 Salud Mental 2.94 3 1.43 1 0.3333 0.09 -1.3frec_saludm <- table(DATATEST$Impacto_en_la_salud_mental)
barplot(frec_saludm,
main = "Impacto en la Salud Mental",
xlab = "Nivel (1 al 5)",
ylab = "Frecuencia",
col = "lightblue")
print(frec_saludm)##
## 1 2 3 4 5
## 43 41 44 32 414. Tablas de frecuencia — Variables cualitativas
4.1 Nivel de fatiga (frecuencia y porcentaje)
prop_fatiga <- round(prop.table(frec_fatiga) * 100, 2)
tabla_fatiga <- cbind(Frecuencia = frec_fatiga, Porcentaje = prop_fatiga)
print(tabla_fatiga)## Frecuencia Porcentaje
## 1 51 25.37
## 2 22 10.95
## 3 43 21.39
## 4 44 21.89
## 5 41 20.404.2 Impacto en la salud mental (frecuencia y porcentaje)
prop_saludm <- round(prop.table(frec_saludm) * 100, 2)
tabla_saludm <- cbind(Frecuencia = frec_saludm, Porcentaje = prop_saludm)
print(tabla_saludm)## Frecuencia Porcentaje
## 1 43 21.39
## 2 41 20.40
## 3 44 21.89
## 4 32 15.92
## 5 41 20.404.3 Género
frec_genero <- table(DATATEST$Genero)
prop_genero <- round(prop.table(frec_genero) * 100, 2)
tabla_genero <- cbind(Frecuencia = frec_genero, Porcentaje = prop_genero)
print(tabla_genero)## Frecuencia Porcentaje
## Femenino 97 48.26
## Masculino 91 45.27
## Otro 13 6.47mis_colores <- c("pink", "blue", "green")
pie(frec_genero,
main = "Distribución por Género",
col = mis_colores,
labels = paste0(names(frec_genero), " (",
round(prop.table(frec_genero) * 100, 1), "%)"),
border = "black")
4.4 Severidad de síntomas
frec_severidad <- table(DATATEST$Severidad_de_Síntomas)
prop_severidad <- round(prop.table(frec_severidad) * 100, 2)
tabla_severidad <- cbind(Frecuencia = frec_severidad, Porcentaje = prop_severidad)
print(tabla_severidad)## Frecuencia Porcentaje
## Leve 130 64.68
## Moderado 51 25.37
## Severo 20 9.95pie(frec_severidad,
main = "Distribución de Severidad de Síntomas",
col = mis_colores,
labels = paste0(names(frec_severidad), " (",
round(prop.table(frec_severidad) * 100, 1), "%)"))
4.5 Hospitalizado
frec_hosp <- table(DATATEST$Hospitalizado)
prop_hosp <- round(prop.table(frec_hosp) * 100, 2)
tabla_hosp <- cbind(Frecuencia = frec_hosp, Porcentaje = prop_hosp)
print(tabla_hosp)## Frecuencia Porcentaje
## No 151 75.12
## Sí 50 24.88barplot(frec_hosp,
main = "Distribución de Hospitalización",
xlab = "¿Fue Hospitalizado?",
ylab = "Número de Pacientes",
col = "lightblue",
border = "black")
4.6 Riesgo de COVID prolongado
frec_riesgo <- table(DATATEST$Riesgo_de_covid_prolongado)
prop_riesgo <- round(prop.table(frec_riesgo) * 100, 2)
tabla_riesgo <- cbind(Frecuencia = frec_riesgo, Porcentaje = prop_riesgo)
print(tabla_riesgo)## Frecuencia Porcentaje
## Bajo 107 53.23
## Medio 71 35.32
## Alto 23 11.44barplot(frec_riesgo,
main = "Riesgo de COVID Prolongado",
col = "lightblue")
5. Análisis bivariado
5.1 Riesgo vs Género
tabla_gen <- table(DATATEST$Riesgo_de_covid_prolongado, DATATEST$Genero)
frecuencia_genero <- addmargins(tabla_gen)
print("Tabla de Frecuencia: Riesgo vs Género")## [1] "Tabla de Frecuencia: Riesgo vs Género"print(frecuencia_genero)##
## Femenino Masculino Otro Sum
## Bajo 49 53 5 107
## Medio 37 30 4 71
## Alto 11 8 4 23
## Sum 97 91 13 201prop_gen <- prop.table(tabla_gen) * 100
print("Frecuencia Relativa (%) Riesgo vs Género")## [1] "Frecuencia Relativa (%) Riesgo vs Género"print(addmargins(round(prop_gen, 2)))##
## Femenino Masculino Otro Sum
## Bajo 24.38 26.37 2.49 53.24
## Medio 18.41 14.93 1.99 35.33
## Alto 5.47 3.98 1.99 11.44
## Sum 48.26 45.28 6.47 100.01ggplot(DATATEST, aes(x = Genero, fill = Riesgo_de_covid_prolongado)) +
geom_bar(position = "stack") +
labs(title = "Riesgo de COVID Prolongado según Género",
x = "Género", y = "Cantidad de Pacientes",
fill = "Nivel de Riesgo") +
theme_minimal()
5.2 Riesgo vs Hospitalización
tabla_hosp2 <- table(DATATEST$Riesgo_de_covid_prolongado, DATATEST$Hospitalizado)
frecuencia_hosp <- addmargins(tabla_hosp2)
print("Tabla de Frecuencia: Riesgo vs Hospitalización")## [1] "Tabla de Frecuencia: Riesgo vs Hospitalización"print(frecuencia_hosp)##
## No Sí Sum
## Bajo 80 27 107
## Medio 57 14 71
## Alto 14 9 23
## Sum 151 50 201prop_hosp2 <- prop.table(tabla_hosp2) * 100
print("Frecuencia Relativa (%) Riesgo vs Hospitalizado")## [1] "Frecuencia Relativa (%) Riesgo vs Hospitalizado"print(addmargins(round(prop_hosp2, 2)))##
## No Sí Sum
## Bajo 39.80 13.43 53.23
## Medio 28.36 6.97 35.33
## Alto 6.97 4.48 11.45
## Sum 75.13 24.88 100.01ggplot(DATATEST, aes(x = Hospitalizado, fill = Riesgo_de_covid_prolongado)) +
geom_bar(position = "dodge", color = "white") +
scale_fill_brewer(palette = "Set2") +
labs(title = "Relación entre Hospitalización y Riesgo de COVID",
x = "¿Fue Hospitalizado?", y = "Número de Pacientes",
fill = "Nivel de Riesgo") +
theme_minimal()
5.3 Severidad vs Niebla mental
tabla_niebla <- table(DATATEST$Severidad_de_Síntomas, DATATEST$Niebla_mental)
frecuencia_niebla <- addmargins(tabla_niebla)
print("Tabla de Frecuencia Absoluta: Severidad vs Niebla Mental")## [1] "Tabla de Frecuencia Absoluta: Severidad vs Niebla Mental"print(frecuencia_niebla)##
## No Sí Sum
## Leve 98 32 130
## Moderado 40 11 51
## Severo 15 5 20
## Sum 153 48 201prop_niebla_fila <- prop.table(tabla_niebla, margin = 1) * 100
print("Frecuencia Relativa por Fila (%): Severidad vs Niebla Mental")## [1] "Frecuencia Relativa por Fila (%): Severidad vs Niebla Mental"print(round(prop_niebla_fila, 2))##
## No Sí
## Leve 75.38 24.62
## Moderado 78.43 21.57
## Severo 75.00 25.005.4 Riesgo vs Problemas respiratorios
tabla_resp <- table(DATATEST$Riesgo_de_covid_prolongado, DATATEST$Problemas_respiratorios)
prop_resp_total <- prop.table(tabla_resp) * 100
print("Frecuencia Relativa (%) respecto al total: Riesgo vs Problemas Respiratorios")## [1] "Frecuencia Relativa (%) respecto al total: Riesgo vs Problemas Respiratorios"print(addmargins(round(prop_resp_total, 2)))##
## No Sí Sum
## Bajo 36.82 16.42 53.24
## Medio 24.88 10.45 35.33
## Alto 9.45 1.99 11.44
## Sum 71.15 28.86 100.01prop_resp_col <- prop.table(tabla_resp, margin = 2) * 100
print("Frecuencia Relativa por Columna (%): Riesgo vs Problemas Respiratorios")## [1] "Frecuencia Relativa por Columna (%): Riesgo vs Problemas Respiratorios"print(round(prop_resp_col, 2))##
## No Sí
## Bajo 51.75 56.90
## Medio 34.97 36.21
## Alto 13.29 6.905.5 Boxplots bivariados
boxplot(Dias_para_la_recuperacion ~ Severidad_de_Síntomas, data = DATATEST,
id = list(method = "y"), xlab = "Severidad de los Síntomas",
ylab = "Días para la recuperación",
main = "Comparativa de Recuperación por Severidad")
boxplot(Edad ~ Hospitalizado, data = DATATEST, id = list(method = "y"),
xlab = "¿Hospitalizado?", ylab = "Edad del Paciente",
main = "Edad según Hospitalización")
5.6 Matrices de dispersión
scatterplotMatrix(~ Impacto_en_la_salud_mental + Edad,
regLine = TRUE, smooth = FALSE,
diagonal = list(method = "histogram"),
data = DATATEST)
scatterplotMatrix(~ Dias_para_la_recuperacion + Edad + Nivel_de_fatiga,
regLine = TRUE, smooth = FALSE,
diagonal = list(method = "boxplot"),
data = DATATEST)
6. Matrices de covarianza y correlación
6.1 Correlación de Pearson
cat("=== MATRIZ DE CORRELACION DE PEARSON ===\n")## === MATRIZ DE CORRELACION DE PEARSON ===print(round(cor(DATATEST_cuant, method = "pearson", use = "complete.obs"), 4))## Edad Dias_Recuperacion Fatiga Salud_Mental
## Edad 1.0000 -0.0232 -0.0752 0.0734
## Dias_Recuperacion -0.0232 1.0000 0.0007 -0.1051
## Fatiga -0.0752 0.0007 1.0000 0.0573
## Salud_Mental 0.0734 -0.1051 0.0573 1.00006.2 Covarianza
cov(DATATEST[, c("Edad", "Dias_para_la_recuperacion", "Nivel_de_fatiga",
"Impacto_en_la_salud_mental")], use = "complete.obs")## Edad Dias_para_la_recuperacion Nivel_de_fatiga
## Edad 224.219900 -18.13810945 -1.65823383
## Dias_para_la_recuperacion -18.138109 2737.69407960 0.05644279
## Nivel_de_fatiga -1.658234 0.05644279 2.16990050
## Impacto_en_la_salud_mental 1.571020 -7.85937811 0.12064677
## Impacto_en_la_salud_mental
## Edad 1.5710199
## Dias_para_la_recuperacion -7.8593781
## Nivel_de_fatiga 0.1206468
## Impacto_en_la_salud_mental 2.04079606.3 Correlación de Spearman
matriz_spearman <- round(cor(DATATEST_cuant, method = "spearman", use = "complete.obs"), 3)
print(matriz_spearman)## Edad Dias_Recuperacion Fatiga Salud_Mental
## Edad 1.000 -0.017 -0.084 0.069
## Dias_Recuperacion -0.017 1.000 -0.011 -0.106
## Fatiga -0.084 -0.011 1.000 0.053
## Salud_Mental 0.069 -0.106 0.053 1.000corrplot(matriz_spearman, method = "circle", type = "upper",
tl.col = "black", tl.srt = 45, addCoef.col = "black",
number.cex = 0.9, title = "Matriz de Spearman",
mar = c(0, 0, 2, 0))
6.4 Correlación Tau de Kendall
matriz_kendall <- round(cor(DATATEST_cuant, method = "kendall", use = "complete.obs"), 3)
print(matriz_kendall)## Edad Dias_Recuperacion Fatiga Salud_Mental
## Edad 1.000 -0.013 -0.061 0.051
## Dias_Recuperacion -0.013 1.000 -0.007 -0.078
## Fatiga -0.061 -0.007 1.000 0.042
## Salud_Mental 0.051 -0.078 0.042 1.000corrplot(matriz_kendall, method = "color", type = "upper",
addCoef.col = "black", number.cex = 1.15,
tl.col = "black", tl.cex = 1.10, tl.srt = 45,
cl.cex = 1.0, cl.lim = c(-1, 1), col = COL2("RdBu", 200),
title = "Matriz de Correlacion Kendall",
mar = c(0, 0, 2, 0))## Warning in text.default(pos.xlabel[, 1], pos.xlabel[, 2], newcolnames, srt =
## tl.srt, : "cl.lim" es un parámetro gráfico inválido## Warning in text.default(pos.ylabel[, 1], pos.ylabel[, 2], newrownames, col =
## tl.col, : "cl.lim" es un parámetro gráfico inválido## Warning in title(title, ...): "cl.lim" es un parámetro gráfico inválido
7. Gráfico en tercera dimensión (3D)
colores_riesgo <- c("Bajo" = "#2ecc71", "Medio" = "#e67e22", "Alto" = "#e74c3c")
col_puntos <- colores_riesgo[as.character(DATATEST_riesgo$Riesgo)]
grafico_3d <- scatterplot3d(
x = DATATEST_cuant$Salud_Mental,
y = DATATEST_cuant$Dias_Recuperacion,
z = DATATEST_cuant$Edad,
color = col_puntos, pch = 16, cex.symbols = 1.2,
xlab = "Salud Mental", ylab = "Dias de Recuperacion", zlab = "Edad (Anos)",
main = "Grafico 3D: Salud Mental vs Dias Recuperacion vs Edad",
angle = 55, grid = TRUE, box = TRUE
)
legend(grafico_3d$xyz.convert(4.5, 160, 65),
legend = levels(DATATEST_riesgo$Riesgo),
col = c("#2ecc71", "#e67e22", "#e74c3c"),
pch = 16, title = "Nivel de Riesgo", bg = "white")
8. Rostros de Chernoff por grupo
Se agrupan los pacientes por similaridad (distancia euclídea + Ward) y se representa el perfil promedio de cada grupo como un rostro de Chernoff.
DATATEST_z <- scale(DATATEST_cuant)
matriz_distancias <- dist(DATATEST_z, method = "euclidean")
modelo_jerarquico <- hclust(matriz_distancias, method = "ward.D2")
grupos_distancia <- cutree(modelo_jerarquico, k = 3)
DATATEST_cuant_grupos <- DATATEST_cuant
DATATEST_cuant_grupos$Grupo <- factor(grupos_distancia, labels = c("G1", "G2", "G3"))
promedios_grupos <- aggregate(. ~ Grupo, data = DATATEST_cuant_grupos, FUN = mean)
print(promedios_grupos)## Grupo Edad Dias_Recuperacion Fatiga Salud_Mental
## 1 G1 53.20000 78.81429 3.500000 4.157143
## 2 G2 40.54023 112.49425 1.896552 2.402299
## 3 G3 33.11364 90.06818 4.431818 2.045455matriz_datos <- as.matrix(promedios_grupos[, -1])
rownames(matriz_datos) <- paste0(
"Grupo ", promedios_grupos$Grupo,
" (n=", table(DATATEST_cuant_grupos$Grupo), ")"
)
par(mar = c(1, 1, 3, 1))
faces(matriz_datos,
main = "Rostros de Chernoff - Perfil Promedio de Pacientes",
col.face = c("#ffcccc", "#cce5ff", "#d4edda"))
## effect of variables:
## modified item Var
## "height of face " "Edad"
## "width of face " "Dias_Recuperacion"
## "structure of face" "Fatiga"
## "height of mouth " "Salud_Mental"
## "width of mouth " "Edad"
## "smiling " "Dias_Recuperacion"
## "height of eyes " "Fatiga"
## "width of eyes " "Salud_Mental"
## "height of hair " "Edad"
## "width of hair " "Dias_Recuperacion"
## "style of hair " "Fatiga"
## "height of nose " "Salud_Mental"
## "width of nose " "Edad"
## "width of ear " "Dias_Recuperacion"
## "height of ear " "Fatiga"for (i in 1:nrow(promedios_grupos)) {
fila <- promedios_grupos[i, ]
cat("\n---", rownames(matriz_datos)[i], "---\n")
cat("Edad:", round(fila$Edad, 1),
"| Dias recuperacion:", round(fila$Dias_Recuperacion, 1),
"| Fatiga:", round(fila$Fatiga, 1),
"| Salud mental:", round(fila$Salud_Mental, 1), "\n")
}##
## --- Grupo G1 (n=70) ---
## Edad: 53.2 | Dias recuperacion: 78.8 | Fatiga: 3.5 | Salud mental: 4.2
##
## --- Grupo G2 (n=87) ---
## Edad: 40.5 | Dias recuperacion: 112.5 | Fatiga: 1.9 | Salud mental: 2.4
##
## --- Grupo G3 (n=44) ---
## Edad: 33.1 | Dias recuperacion: 90.1 | Fatiga: 4.4 | Salud mental: 29. Medidas de similaridad binaria (Jaccard, SMC, Dice)
calcular_similaridades_binarias <- function(x, y) {
a <- sum(x == 1 & y == 1) # Ambos presentan la condición
b <- sum(x == 1 & y == 0) # El paciente 1 la presenta, el 2 no
c <- sum(x == 0 & y == 1) # El paciente 1 no la presenta, el 2 sí
d <- sum(x == 0 & y == 0) # Ninguno presenta la condición
s_jaccard <- a / (a + b + c)
s_smc <- (a + d) / (a + b + c + d)
s_dice <- (2 * a) / (2 * a + b + c)
cat("--- FRECUENCIAS DE CONTINGENCIA ---\n")
cat("a (Presencia conjunta):", a, "\n")
cat("b (Solo paciente 1): ", b, "\n")
cat("c (Solo paciente 2): ", c, "\n")
cat("d (Ausencia conjunta): ", d, "\n\n")
return(data.frame(
Medida = c("Jaccard", "Coincidencia Simple (SMC)", "Dice"),
Valor = round(c(s_jaccard, s_smc, s_dice), 4)
))
}
# Ejemplo: comparación entre el Paciente 1 y el Paciente 2 (variables binarias)
paciente_1 <- as.numeric(DATATEST_binarias[1, ])
paciente_2 <- as.numeric(DATATEST_binarias[2, ])
resultado_comparacion <- calcular_similaridades_binarias(paciente_1, paciente_2)## --- FRECUENCIAS DE CONTINGENCIA ---
## a (Presencia conjunta): 0
## b (Solo paciente 1): 0
## c (Solo paciente 2): 1
## d (Ausencia conjunta): 3print(resultado_comparacion)## Medida Valor
## 1 Jaccard 0.00
## 2 Coincidencia Simple (SMC) 0.75
## 3 Dice 0.0010. Estimación de densidad kernel
Variable analizada: días para la recuperación.
10.1 Kernel gaussiano variando el ancho de banda (h)
variable_analisis <- DATATEST_cuant$Dias_Recuperacion
d_sub <- density(variable_analisis, kernel = "gaussian", bw = 3)
d_opt <- density(variable_analisis, kernel = "gaussian", bw = "nrd0") # Óptimo
d_sobre <- density(variable_analisis, kernel = "gaussian", bw = 40)
hist_prev <- hist(variable_analisis, breaks = 20, plot = FALSE)
ylim_max <- max(hist_prev$density, d_sub$y, d_opt$y, d_sobre$y) * 1.15
hist(variable_analisis, breaks = 20, probability = TRUE, col = "gray92", border = "white",
main = "Densidad Kernel Gaussiano variando Anchos de Banda (h)",
xlab = "Dias de Recuperacion", ylab = "Densidad", ylim = c(0, ylim_max))
lines(d_sub, col = "#e74c3c", lwd = 2, lty = 2)
lines(d_opt, col = "#2ecc71", lwd = 3)
lines(d_sobre, col = "#2980b9", lwd = 2, lty = 4)
legend("topright",
legend = c("Histograma", "h = 3 (Subestimado)",
paste0("h = ", round(d_opt$bw, 2), " (Optimo)"),
"h = 40 (Sobreestimado)"),
col = c("gray92", "#e74c3c", "#2ecc71", "#2980b9"),
lwd = c(10, 2, 3, 2), lty = c(1, 2, 1, 4), bty = "n")
10.2 Ancho de banda fijo variando la función kernel
h_fijo <- d_opt$bw
k_gauss <- density(variable_analisis, kernel = "gaussian", bw = h_fijo)
k_epan <- density(variable_analisis, kernel = "epanechnikov", bw = h_fijo)
k_rect <- density(variable_analisis, kernel = "rectangular", bw = h_fijo)
k_triag <- density(variable_analisis, kernel = "triangular", bw = h_fijo)
ylim_max2 <- max(hist_prev$density, k_gauss$y, k_epan$y, k_rect$y, k_triag$y) * 1.15
hist(variable_analisis, breaks = 20, probability = TRUE, col = "gray92", border = "white",
main = "Ancho de Banda Fijo variando Funciones Kernel",
xlab = "Dias de Recuperacion", ylab = "Densidad", ylim = c(0, ylim_max2))
lines(k_gauss, col = "#8e44ad", lwd = 2)
lines(k_epan, col = "#e67e22", lwd = 2)
lines(k_rect, col = "#c0392b", lwd = 2)
lines(k_triag, col = "#16a085", lwd = 2)
legend("topright",
legend = c("Histograma", "Kernel Gaussiano", "Kernel Epanechnikov",
"Kernel Rectangular", "Kernel Triangular"),
col = c("gray92", "#8e44ad", "#e67e22", "#c0392b", "#16a085"),
lwd = c(10, 2, 2, 2, 2), bty = "n")
11. Modelos no lineales por grupo (Severidad × Riesgo)
Para cada combinación de severidad y riesgo, se ajustan tres modelos no lineales (cuadrático, logarítmico y raíz cuadrada) que explican los días de recuperación en función de la edad, y se elige el de menor AIC.
datos <- DATATEST
datos$Grupo <- paste(datos$Severidad_de_Síntomas, datos$Riesgo_de_covid_prolongado, sep = "-")
analizar_grupo <- function(data, nombre) {
if (nrow(data) < 5) {
cat("⚠️", nombre, "- pocos datos\n")
return(invisible(NULL))
}
m1 <- lm(Dias_para_la_recuperacion ~ poly(Edad, 2), data) # Curva cuadrática
m2 <- lm(Dias_para_la_recuperacion ~ log(Edad), data) # Logarítmica
m3 <- lm(Dias_para_la_recuperacion ~ sqrt(Edad), data) # Raíz cuadrada
aic <- c(AIC(m1), AIC(m2), AIC(m3))
mejor <- which.min(aic)
nombres <- c("Cuadrática", "Logarítmica", "Raíz")
cat("\n📊", nombre, "\n")
cat("Mejor función:", nombres[mejor], "(AIC =", round(min(aic), 1), ")\n")
edad_seq <- seq(min(data$Edad), max(data$Edad), length.out = 50)
pred <- predict(list(m1, m2, m3)[[mejor]],
newdata = data.frame(Edad = edad_seq))
print(
ggplot(data, aes(Edad, Dias_para_la_recuperacion)) +
geom_point(alpha = 0.4) +
geom_line(data = data.frame(Edad = edad_seq, Pred = pred),
aes(Edad, Pred), color = "red", linewidth = 1.2) +
labs(title = paste(nombre, "-", nombres[mejor]),
x = "Edad", y = "Días para la recuperación") +
theme_minimal()
)
}
for (g in unique(datos$Grupo)) {
analizar_grupo(datos[datos$Grupo == g, ], g)
}##
## 📊 Leve-Alto
## Mejor función: Raíz (AIC = 147.7 )
##
## 📊 Severo-Medio
## Mejor función: Cuadrática (AIC = 100.8 )
##
## 📊 Leve-Bajo
## Mejor función: Cuadrática (AIC = 781.6 )
##
## 📊 Moderado-Bajo
## Mejor función: Logarítmica (AIC = 321.3 )
##
## 📊 Leve-Medio
## Mejor función: Logarítmica (AIC = 477 )
##
## 📊 Severo-Alto
## Mejor función: Raíz (AIC = 55.3 )
##
## 📊 Moderado-Medio
## Mejor función: Cuadrática (AIC = 182.2 )
##
## 📊 Moderado-Alto
## Mejor función: Cuadrática (AIC = 40.6 )
##
## 📊 Severo-Bajo
## Mejor función: Logarítmica (AIC = 59.7 )