# Generación datos simulados
set.seed(123)
n_pacientes <- 120
pc_data <- data.frame(
PC1 = c(rnorm(115, 0, 1), rnorm(5, 3, 0.5)),
PC2 = c(rnorm(115, 0, 1), rnorm(5, -3, 0.5))
)
# 1. Cálculo de distancias k-vecinas para determinar epsilon
distancias <- kNNdist(pc_data, k = 4)
# Gráfica de la curva de distancias k-vecinas
distancias_ordenadas <- sort(distancias)
plot(distancias_ordenadas, type = "l",
main = "Curva de distancias k-vecinas (k=4)",
ylab = "Distancia al 4-ésimo vecino",
xlab = "Observaciones ordenadas")
# 2. Selección del valor de epsilon
abline(h = 0.45, col = "red", lty = 2)
text(80, 0.5, "epsilon = 0.45", col = "red")
# 3. Aplicación del modelo DBSCAN
modelo_db <- dbscan(pc_data, eps = 0.45, minPts = 4)
# 4. Visualización de resultados
plot(pc_data, col = modelo_db$cluster + 1, pch = 19,
main = "Clasificación de observaciones con DBSCAN",
xlab = "PC1", ylab = "PC2")
legend("topright",
legend = c("Ruido/Anómalos", "Cluster 1", "Cluster 2"),
col = c("blue", "red", "green"), pch = 19)
# Identificar observaciones anómalas (cluster = 0)
anomalos_dbscan <- which(modelo_db$cluster == 0)
cat("Observaciones anómalas detectadas por DBSCAN:", anomalos_dbscan, "\n")
## Observaciones anómalas detectadas por DBSCAN: 5 11 15 16 17 18 19 21 26 27 29 44 54 61 72 76 81 97 108 116 117 118 119 120
cat("Número de anomalías DBSCAN:", length(anomalos_dbscan), "\n")
## Número de anomalías DBSCAN: 24
Se seleccionó el valor del epsilon = 0.45 porque es donde se evidencia un cambio en la curvatura, se evidencia gráficamente la curva del codo.
Las Observaciones anómalas detectadas por DBSCAN son: 5 11 15 16 17 18 19 21 26 27 29 44 54 61 72 76 81 97 108 116 117 118 119 120
# Datos proporcionados de Hotelling T²
datos_hotelling <- data.frame(
ID = 1:10,
T2 = c(1.45, 10.87, 15.42, 3.51, 11.01, 13.78, 7.32, 2.18, 18.91, 4.09),
Umbral = 12.59
)
# Identificar anomalías con Hotelling
anomalos_hotelling <- which(datos_hotelling$T2 > datos_hotelling$Umbral)
cat("Observaciones anómalas detectadas por Hotelling T²:", anomalos_hotelling, "\n")
## Observaciones anómalas detectadas por Hotelling T²: 3 6 9
# Resultados Hotelling
cat("\n--- RESULTADOS HOTELLING T² ---\n")
##
## --- RESULTADOS HOTELLING T² ---
for(i in 1:nrow(datos_hotelling)) {
estado <- ifelse(datos_hotelling$T2[i] > datos_hotelling$Umbral[i], "ANÓMALO", "Normal")
cat(sprintf("Paciente %d: T² = %.2f, %s\n",
datos_hotelling$ID[i], datos_hotelling$T2[i], estado))
}
## Paciente 1: T² = 1.45, Normal
## Paciente 2: T² = 10.87, Normal
## Paciente 3: T² = 15.42, ANÓMALO
## Paciente 4: T² = 3.51, Normal
## Paciente 5: T² = 11.01, Normal
## Paciente 6: T² = 13.78, ANÓMALO
## Paciente 7: T² = 7.32, Normal
## Paciente 8: T² = 2.18, Normal
## Paciente 9: T² = 18.91, ANÓMALO
## Paciente 10: T² = 4.09, Normal
Las observaciones anómalas detectadas por Hotelling T² son: 3 6 9
Para realizar la comparación se tendrían que evaluar el total de los registros, no solo una muestra de 10 pacientes, por lo que se tienen algunas coincidencias.
Para los contextos clínicos el método de Hotelling T² se podría utilizar para enfoques paramétricos, por otro lado DBSCAN se podría usar para identificar pacientes con características similares pero diferentes de la mayoría.
datos <- datos[datos$Workout_Type == "Yoga", ]
# Función para detectar outliers en una columna
detectar_outliers <- function(columna) {
stats <- boxplot.stats(columna)
return(list(
valores_outliers = stats$out,
indices_outliers = which(columna %in% stats$out),
n_outliers = length(stats$out)
))
}
# Aplicar a columnas numéricas
columnas_numericas <- sapply(datos, is.numeric)
resultados_outliers <- lapply(datos[columnas_numericas], detectar_outliers)
# Mostrar resumen SOLO con cantidades
for(nombre_col in names(resultados_outliers)) {
cat(nombre_col, ":", resultados_outliers[[nombre_col]]$n_outliers, "outliers\n")
}
## Age : 0 outliers
## Weight (kg) : 42 outliers
## Height (m) : 0 outliers
## Max_BPM : 0 outliers
## Avg_BPM : 0 outliers
## Resting_BPM : 0 outliers
## Session_Duration (hours) : 0 outliers
## Calories_Burned : 265 outliers
## Fat_Percentage : 0 outliers
## Water_Intake (liters) : 0 outliers
## Workout_Frequency (days/week) : 0 outliers
## BMI : 140 outliers
## Daily meals frequency : 0 outliers
## Carbs : 111 outliers
## Proteins : 112 outliers
## Fats : 110 outliers
## Calories : 27 outliers
## sugar_g : 0 outliers
## sodium_mg : 0 outliers
## cholesterol_mg : 0 outliers
## serving_size_g : 0 outliers
## prep_time_min : 0 outliers
## cook_time_min : 0 outliers
## rating : 0 outliers
## Sets : 0 outliers
## Reps : 13 outliers
## Burns Calories (per 30 min) : 238 outliers
## BMI_calc : 140 outliers
## cal_from_macros : 110 outliers
## pct_carbs : 72 outliers
## protein_per_kg : 77 outliers
## pct_HRR : 0 outliers
## pct_maxHR : 0 outliers
## cal_balance : 161 outliers
## lean_mass_kg : 5 outliers
## expected_burn : 7 outliers
## Burns Calories (per 30 min)_bc : 0 outliers
# 1. Estandarizar las variables numéricas
columnas_numericas <- sapply(datos, is.numeric)
datos_estandarizados <- as.data.frame(scale(datos[, columnas_numericas]))
# 2. Ejecutar PCA y obtener los dos primeros componentes principales
pca_result <- PCA(datos_estandarizados, ncp = 2, graph = FALSE)
# Extraer las coordenadas de los componentes principales
componentes_principales <- as.data.frame(pca_result$ind$coord)
colnames(componentes_principales) <- c("PC1", "PC2")
# 3. Calcular el estadístico T² de Hotelling
n <- nrow(datos_estandarizados)
p <- 2 # número de componentes principales utilizados
# Calcular T² para cada observación
t2_scores <- apply(componentes_principales, 1, function(x) {
t(x) %*% solve(cov(componentes_principales)) %*% x
})
# Calcular el límite superior de control (LSC) al 95%
alpha <- 0.05
lsc <- (p * (n - 1) / (n - p)) * qf(1 - alpha, p, n - p)
# Crear dataframe con los resultados
resultados_t2 <- data.frame(
Observacion = 1:n,
T2 = t2_scores,
Es_Atipico = t2_scores > lsc
)
# 4. Graficar las observaciones con el límite de control
ggplot(resultados_t2, aes(x = Observacion, y = T2)) +
geom_point(aes(color = Es_Atipico), size = 2) +
geom_hline(yintercept = lsc, linetype = "dashed", color = "red", size = 2) +
labs(title = "Carta T² de Hotelling - Detección de Observaciones Atípicas",
subtitle = paste("Límite Superior de Control (95%):", round(lsc, 2)),
x = "Observación",
y = "Estadístico T²") +
scale_color_manual(values = c("FALSE" = "blue", "TRUE" = "green"),
labels = c("Normal", "Atípico")) +
theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
observaciones_atipicas_t2 <- which(resultados_t2$Es_Atipico)
# Observaciones atípicas detectadas por Hotelling T²
observaciones_atipicas_t2
## [1] 36 52 60 96 129 132 154 160 175 179 184 190 233 241 258
## [16] 260 272 278 328 329 339 343 345 358 364 369 371 388 402 420
## [31] 434 494 508 523 532 548 558 561 597 601 605 610 626 632 636
## [46] 642 647 689 694 699 701 719 781 794 799 803 822 874 891 918
## [61] 953 979 986 999 1006 1029 1035 1045 1053 1063 1079 1100 1103 1119 1138
## [76] 1197 1198 1211 1213 1217 1244 1277 1292 1301 1335 1340 1353 1417 1423 1436
## [91] 1458 1478 1511 1523 1538 1547 1581 1590 1600 1614 1643 1644 1660 1685 1696
## [106] 1710 1752 1780 1786 1800 1827 1828 1839 1844 1846 1847 1876 1913 1933 1956
## [121] 1962 2025 2047 2072 2074 2085 2086 2099 2110 2115 2152 2161 2169 2183 2194
## [136] 2230 2285 2307 2350 2384 2387 2419 2420 2425 2440 2462 2466 2482 2499 2509
## [151] 2520 2526 2535 2536 2594 2603 2605 2611 2619 2633 2640 2667 2715 2717 2740
## [166] 2777 2795 2824 2834 2862 2882 2901 3007 3010 3027 3039 3042 3050 3083 3106
## [181] 3107 3108 3140 3149 3152 3177 3247 3259 3279 3280 3312 3324 3342 3346 3349
## [196] 3357 3368 3373 3386 3399 3411 3444 3475 3482 3499 3509 3513 3517 3521 3524
## [211] 3528 3541 3573 3648 3657 3661 3670 3700 3721 3725 3745 3758 3775 3796 3821
## [226] 3837 3854 3862 3880 3888 3924 3964 3967 3991 4026 4044 4050 4077 4087 4090
## [241] 4091 4108 4113 4154 4187 4206 4223 4291 4316 4337 4343 4354 4408 4457 4471
## [256] 4474 4511 4528 4536 4573 4587 4621 4656 4709 4717 4722 4727 4744 4795 4819
## [271] 4860 4863 4869 4873 4876 4881 4895 4911 4929 4940 4944 4948 4985 4988 5005
## [286] 5021 5028
# Número de observaciones atípicas
length(observaciones_atipicas_t2)
## [1] 287
son consideradas atípicas porque su estadístico T² supera el límite de control de 6, lo que indica que estos pacientes tienen perfiles multivariados significativamente diferentes del patrón general. En total fueron 287 observaciones con valores atípicos por el método T².
# Cargar librería para DBSCAN
library(dbscan)
# 1. Aplicar DBSCAN sobre los componentes principales
# Primero determinamos el parámetro epsilon usando k-NN distance
knn_dist <- kNNdist(componentes_principales, k = 4)
knn_dist_sorted <- sort(knn_dist)
# Graficar para determinar epsilon
plot(knn_dist_sorted, type = "l", main = "Gráfica k-NN Distance para determinar epsilon",
xlab = "Puntos ordenados", ylab = "Distancia al 4º vecino más cercano")
# Seleccionar epsilon en el "codo" de la gráfica
epsilon <- quantile(knn_dist, 0.95) # Puedes ajustar este percentil según la gráfica
abline(h = epsilon, col = "red", lty = 2)
legend("topleft", legend = paste("epsilon =", round(epsilon, 3)), col = "red", lty = 2)
# Aplicar DBSCAN
dbscan_result <- dbscan(componentes_principales, eps = epsilon, minPts = 4)
# 2. Graficar los clusters y puntos atípicos
componentes_principales$Cluster <- as.factor(dbscan_result$cluster)
componentes_principales$Es_Atipico_DBSCAN <- dbscan_result$cluster == 0
ggplot(componentes_principales, aes(x = PC1, y = PC2, color = Cluster, shape = Es_Atipico_DBSCAN)) +
geom_point(size = 3, alpha = 0.7) +
scale_shape_manual(values = c("FALSE" = 16, "TRUE" = 4)) +
labs(title = "Resultados de DBSCAN en Componentes Principales",
subtitle = paste("Clusters detectados:", length(unique(dbscan_result$cluster)) -
as.numeric(any(dbscan_result$cluster == 0))),
x = "Primer Componente Principal (PC1)",
y = "Segundo Componente Principal (PC2)") +
theme_minimal()
# Observaciones de datos atípicos
observaciones_atipicas_dbscan <- which(dbscan_result$cluster == 0)
observaciones_atipicas_dbscan
## [1] 163 250 386 453 454 537 632 656 723 799 803 823 992 999 1119
## [16] 1226 1254 1546 1614 1729 1786 1962 2179 2244 2351 2462 2513 2624 2913 2919
## [31] 2985 3107 3151 3236 3246 3569 3721 3796 3857 3924 3997 4270 4384 4507 4578
## [46] 4668 4863 4900 4905
# Cantidad de observaciones de datos atípicos
length(observaciones_atipicas_dbscan)
## [1] 49
Por el método de DBSCAN se obtuvo 49 observaciones
Para concluir el DBSCAN con 49 outliers es probablemente más específico y clínicamente relevante, mientras que Hotelling T² con 287 outliers puede estar detectando demasiada variabilidad natural. Los pacientes en común entre ambos métodos son los que merecen mayor atención clínica.