1 Problemática de investigación

El hacinamiento en los servicios de urgencias constituye un problema crítico para los sistemas de salud, dado que incrementa los tiempos de atención, afecta la calidad del servicio y aumenta el riesgo clínico. Desde la gestión sanitaria, resulta fundamental cuantificar cómo el nivel de ocupación del servicio se relaciona con el tiempo de permanencia de los pacientes, con el fin de respaldar decisiones operativas basadas en evidencia.

2 Planteamiento del problema

Pregunta de investigación
¿Existe una relación estadísticamente significativa entre el índice de hacinamiento del servicio de urgencias y el tiempo de permanencia de los pacientes, y qué tan adecuada es la capacidad explicativa o predictiva de un modelo estadístico para describir esta relación?

Hipótesis
A mayor índice de hacinamiento, mayor será el tiempo de permanencia de los pacientes en urgencias, con un posible comportamiento no lineal en niveles críticos de ocupación.

3 BLOQUE ESTADÍSTICO 1 — Exploración analítica de los datos

En este bloque se realiza la carga, transformación y exploración inicial de la base de datos para preparar el análisis estadístico y la modelación.

archivo <- "hacinamiento_urgencias.csv"
if (!file.exists(archivo)) archivo <- file.choose()

datos <- read.csv(archivo, header = TRUE, sep = ",", dec = ".")

datos$tiempo_permanencia  <- datos$wait_time_min
datos$indice_hacinamiento <- datos$occupancy_rate
datos$triage_level <- as.factor(datos$triage_level)

str(datos)
## 'data.frame':    300 obs. of  14 variables:
##  $ wait_time_min         : num  47 130 101 30 67 156 7 73 141 55 ...
##  $ boarding_time_hr      : num  10.3 5.5 6 9.8 7.6 11.9 5.9 10.3 9 7.6 ...
##  $ arrival_to_triage_min : num  36 17 28 21 37 28 45 14 29 25 ...
##  $ occupancy_rate        : num  121 118 146 105 104 ...
##  $ patients_per_doctor   : num  25 19 26 24 14 11 20 14 20 14 ...
##  $ ed_hospital_admissions: int  3 3 2 4 5 1 3 5 7 3 ...
##  $ age                   : num  43 27 16 56 17 0 62 77 46 57 ...
##  $ severity_score        : int  2 2 1 2 4 1 1 2 3 2 ...
##  $ triage_level          : Factor w/ 4 levels "I","II","III",..: 1 4 3 1 4 3 2 4 3 4 ...
##  $ arrival_mode          : chr  "Ambulance" "Ambulance" "Referral" "Ambulance" ...
##  $ diagnosis_group       : chr  "Gastrointestinal" "Cardiac" "Gastrointestinal" "Gastrointestinal" ...
##  $ disposition           : chr  "Hospitalized" "Discharged" "Transferred" "Transferred" ...
##  $ tiempo_permanencia    : num  47 130 101 30 67 156 7 73 141 55 ...
##  $ indice_hacinamiento   : num  121 118 146 105 104 ...
head(datos)
##   wait_time_min boarding_time_hr arrival_to_triage_min occupancy_rate
## 1            47             10.3                    36          121.0
## 2           130              5.5                    17          118.4
## 3           101              6.0                    28          146.3
## 4            30              9.8                    21          104.9
## 5            67              7.6                    37          104.2
## 6           156             11.9                    28          107.7
##   patients_per_doctor ed_hospital_admissions age severity_score triage_level
## 1                  25                      3  43              2            I
## 2                  19                      3  27              2           IV
## 3                  26                      2  16              1          III
## 4                  24                      4  56              2            I
## 5                  14                      5  17              4           IV
## 6                  11                      1   0              1          III
##   arrival_mode  diagnosis_group  disposition tiempo_permanencia
## 1    Ambulance Gastrointestinal Hospitalized                 47
## 2    Ambulance          Cardiac   Discharged                130
## 3     Referral Gastrointestinal  Transferred                101
## 4    Ambulance Gastrointestinal  Transferred                 30
## 5      Walk-in          Cardiac   Discharged                 67
## 6    Ambulance           Trauma Hospitalized                156
##   indice_hacinamiento
## 1               121.0
## 2               118.4
## 3               146.3
## 4               104.9
## 5               104.2
## 6               107.7
datos_limpios <- subset(
  datos,
  !is.na(tiempo_permanencia) &
  !is.na(indice_hacinamiento) &
  !is.na(triage_level) &
  !is.na(boarding_time_hr) &
  !is.na(patients_per_doctor) &
  !is.na(arrival_to_triage_min)
)

cat("Número de observaciones analizadas:", nrow(datos_limpios))
## Número de observaciones analizadas: 300

La exploración analítica permitió verificar la estructura de la base de datos, identificar variables clave y depurar registros con valores faltantes, garantizando consistencia para la modelación.

4 BLOQUE ESTADÍSTICO 2 — Estadísticas descriptivas


``` r
descriptivos <- datos_limpios %>%
  summarise(
    N = n(),
    Hacinamiento_promedio = mean(indice_hacinamiento),
    Hacinamiento_sd = sd(indice_hacinamiento),
    Permanencia_promedio = mean(tiempo_permanencia),
    Permanencia_sd = sd(tiempo_permanencia),
    Permanencia_min = min(tiempo_permanencia),
    Permanencia_max = max(tiempo_permanencia)
  )

descriptivos
##     N Hacinamiento_promedio Hacinamiento_sd Permanencia_promedio Permanencia_sd
## 1 300              109.1547        19.21553             89.37333       39.94278
##   Permanencia_min Permanencia_max
## 1               4             208

Los estadísticos descriptivos evidencian variabilidad en el índice de hacinamiento y en el tiempo de permanencia. En promedio, el hacinamiento es de 109.2% (DE: 19.2), mientras que el tiempo de permanencia promedio es 89.4 minutos (DE: 39.9), con valores entre 4 y 208 minutos.


``` r
ggplot(datos_limpios, aes(indice_hacinamiento, tiempo_permanencia)) +
  geom_point(alpha = 0.4) +
  geom_smooth(method = "lm", se = TRUE) +
  labs(
    title = "Relación entre hacinamiento y tiempo de permanencia",
    x = "Índice de hacinamiento (%)",
    y = "Tiempo de permanencia (min)"
  )

5 BLOQUE ESTADÍSTICO 3 — Modelamiento matemático



``` r
modelo_lineal <- lm(tiempo_permanencia ~ indice_hacinamiento, data = datos_limpios)
res_lineal <- summary(modelo_lineal)
res_lineal
## 
## Call:
## lm(formula = tiempo_permanencia ~ indice_hacinamiento, data = datos_limpios)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -86.123 -28.904   0.727  28.359 119.062 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)         97.94137   13.33570   7.344 1.99e-12 ***
## indice_hacinamiento -0.07849    0.12033  -0.652    0.515    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 39.98 on 298 degrees of freedom
## Multiple R-squared:  0.001426,   Adjusted R-squared:  -0.001925 
## F-statistic: 0.4255 on 1 and 298 DF,  p-value: 0.5147

``` r
beta1 <- coef(modelo_lineal)[2]
p_beta1 <- res_lineal$coefficients[2,4]
r2_lineal <- res_lineal$r.squared
aic_lineal <- AIC(modelo_lineal)
bic_lineal <- BIC(modelo_lineal)

cat("β1:", round(beta1, 4), "\n")
## β1: -0.0785
cat("p-value:", format.pval(p_beta1, digits = 3), "\n")
## p-value: 0.515
cat("R²:", round(r2_lineal, 3), "\n")
## R²: 0.001
cat("AIC:", round(aic_lineal, 1), "| BIC:", round(bic_lineal, 1), "\n")
## AIC: 3068.4 | BIC: 3079.5

En el modelo lineal simple, el efecto estimado del hacinamiento es β₁ = -0.0785 con p = 0.515 y R² = 0.001. Esto indica que, en este dataset, el hacinamiento por sí solo tiene baja capacidad explicativa sobre la permanencia.


``` r
modelo_cuad <- lm(tiempo_permanencia ~ indice_hacinamiento + I(indice_hacinamiento^2),
                  data = datos_limpios)
res_cuad <- summary(modelo_cuad)
res_cuad
## 
## Call:
## lm(formula = tiempo_permanencia ~ indice_hacinamiento + I(indice_hacinamiento^2), 
##     data = datos_limpios)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -86.595 -28.741   0.341  27.996 118.563 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)
## (Intercept)              80.507156  52.754953   1.526    0.128
## indice_hacinamiento       0.255821   0.986056   0.259    0.795
## I(indice_hacinamiento^2) -0.001552   0.004542  -0.342    0.733
## 
## Residual standard error: 40.04 on 297 degrees of freedom
## Multiple R-squared:  0.001818,   Adjusted R-squared:  -0.004904 
## F-statistic: 0.2705 on 2 and 297 DF,  p-value: 0.7632

``` r
r2_cuad <- res_cuad$r.squared
aic_cuad <- AIC(modelo_cuad)
bic_cuad <- BIC(modelo_cuad)

data.frame(
  Modelo = c("Lineal", "Cuadrático"),
  R2 = c(r2_lineal, r2_cuad),
  AIC = c(aic_lineal, aic_cuad),
  BIC = c(bic_lineal, bic_cuad)
)
##       Modelo          R2      AIC      BIC
## 1     Lineal 0.001425956 3068.402 3079.513
## 2 Cuadrático 0.001818147 3070.284 3085.099

Dado que el flujo de urgencias es multifactorial, se ajusta un modelo multivariado incorporando variables operativas y clínicas (boarding time, carga por médico, tiempo a triage y triage), con el fin de aumentar la explicación/predicción del tiempo de permanencia.


``` r
modelo_multi <- lm(
  tiempo_permanencia ~ indice_hacinamiento + boarding_time_hr +
    patients_per_doctor + arrival_to_triage_min + triage_level,
  data = datos_limpios
)
res_multi <- summary(modelo_multi)
res_multi
## 
## Call:
## lm(formula = tiempo_permanencia ~ indice_hacinamiento + boarding_time_hr + 
##     patients_per_doctor + arrival_to_triage_min + triage_level, 
##     data = datos_limpios)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -93.966 -28.173  -0.246  26.295 122.028 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)           96.83263   18.96247   5.107 5.93e-07 ***
## indice_hacinamiento   -0.07207    0.12120  -0.595    0.553    
## boarding_time_hr      -1.09233    0.79296  -1.378    0.169    
## patients_per_doctor    0.17133    0.44450   0.385    0.700    
## arrival_to_triage_min  0.04750    0.23180   0.205    0.838    
## triage_levelII         3.21302    6.59948   0.487    0.627    
## triage_levelIII       10.08254    6.32722   1.594    0.112    
## triage_levelIV         4.51179    7.04453   0.640    0.522    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 40.06 on 292 degrees of freedom
## Multiple R-squared:  0.01776,    Adjusted R-squared:  -0.005784 
## F-statistic: 0.7544 on 7 and 292 DF,  p-value: 0.6261

``` r
r2_multi <- res_multi$r.squared
aic_multi <- AIC(modelo_multi)
bic_multi <- BIC(modelo_multi)

data.frame(
  Modelo = c("Lineal", "Cuadrático", "Multivariado"),
  R2 = c(r2_lineal, r2_cuad, r2_multi),
  AIC = c(aic_lineal, aic_cuad, aic_multi),
  BIC = c(bic_lineal, bic_cuad, bic_multi)
)
##         Modelo          R2      AIC      BIC
## 1       Lineal 0.001425956 3068.402 3079.513
## 2   Cuadrático 0.001818147 3070.284 3085.099
## 3 Multivariado 0.017763209 3075.453 3108.787

6 BLOQUE ESTADÍSTICO 4 — Validación y testeo (Train/Test)


``` r
set.seed(123)

n <- nrow(datos_limpios)
idx_train <- sample(1:n, size = round(0.7*n))

train <- datos_limpios[idx_train, ]
test  <- datos_limpios[-idx_train, ]

m_lin <- lm(tiempo_permanencia ~ indice_hacinamiento, data = train)
m_cua <- lm(tiempo_permanencia ~ indice_hacinamiento + I(indice_hacinamiento^2), data = train)
m_mul <- lm(tiempo_permanencia ~ indice_hacinamiento + boarding_time_hr +
              patients_per_doctor + arrival_to_triage_min + triage_level, data = train)

pred_lin <- predict(m_lin, newdata = test)
pred_cua <- predict(m_cua, newdata = test)
pred_mul <- predict(m_mul, newdata = test)

rmse <- function(y, yhat) sqrt(mean((y - yhat)^2))
mae  <- function(y, yhat) mean(abs(y - yhat))
r2_test <- function(y, yhat){
  ss_res <- sum((y - yhat)^2)
  ss_tot <- sum((y - mean(y))^2)
  1 - ss_res/ss_tot
}

result_test <- data.frame(
  Modelo = c("Lineal", "Cuadrático", "Multivariado"),
  RMSE = c(rmse(test$tiempo_permanencia, pred_lin),
           rmse(test$tiempo_permanencia, pred_cua),
           rmse(test$tiempo_permanencia, pred_mul)),
  MAE  = c(mae(test$tiempo_permanencia, pred_lin),
           mae(test$tiempo_permanencia, pred_cua),
           mae(test$tiempo_permanencia, pred_mul)),
  R2_test = c(r2_test(test$tiempo_permanencia, pred_lin),
              r2_test(test$tiempo_permanencia, pred_cua),
              r2_test(test$tiempo_permanencia, pred_mul))
)

result_test
##         Modelo     RMSE      MAE      R2_test
## 1       Lineal 42.81071 34.61383 -0.003900993
## 2   Cuadrático 42.97905 34.92930 -0.011811390
## 3 Multivariado 43.48338 35.24860 -0.035696577

La evaluación en conjunto de prueba permite medir el desempeño predictivo. El mejor modelo es aquel con RMSE/MAE más bajos y R²_test más alto, lo que indica mejor generalización.

7 BLOQUE ESTADÍSTICO 5 — Visualización 3D (interactiva + animada)


``` r
df3d <- datos_limpios %>% mutate(triage_num = as.numeric(triage_level))

p1 <- plot_ly(
  data = df3d,
  x = ~indice_hacinamiento,
  y = ~triage_num,
  z = ~tiempo_permanencia,
  type = "scatter3d",
  mode = "markers",
  color = ~triage_level,
  marker = list(size = 3, opacity = 0.7),
  text = ~paste0(
    "Triage: ", triage_level,
    "<br>Hacinamiento: ", round(indice_hacinamiento, 2), "%",
    "<br>Tiempo: ", round(tiempo_permanencia, 1), " min"
  ),
  hoverinfo = "text"
) %>%
  layout(
    title = "3D interactivo: Hacinamiento vs Permanencia (por Triage)",
    scene = list(
      xaxis = list(title = "Índice de hacinamiento (%)"),
      yaxis = list(title = "Triage (nivel)"),
      zaxis = list(title = "Tiempo de permanencia (min)")
    )
  )

p1

``` r
p2 <- plot_ly(
  data = df3d,
  x = ~indice_hacinamiento,
  y = ~triage_num,
  z = ~tiempo_permanencia,
  frame = ~triage_level,
  type = "scatter3d",
  mode = "markers",
  color = ~triage_level,
  marker = list(size = 3, opacity = 0.8)
) %>%
  layout(
    title = "3D animado por Triage (slider)",
    scene = list(
      xaxis = list(title = "Índice de hacinamiento (%)"),
      yaxis = list(title = "Triage (nivel)"),
      zaxis = list(title = "Tiempo de permanencia (min)")
    )
  ) %>%
  animation_opts(frame = 850, transition = 0, easing = "linear", redraw = FALSE) %>%
  animation_slider(currentvalue = list(prefix = "Triage: "))

p2

Las visualizaciones 3D permiten explorar de forma dinámica la relación entre hacinamiento, permanencia y triage, facilitando el análisis estratificado por severidad clínica.

8 Interpretación final y conclusiones

Interpretación:
En general, el modelo lineal simple muestra baja capacidad explicativa del hacinamiento por sí solo (R² bajo). El enfoque multivariado permite capturar factores operativos y clínicos relevantes para explicar/predicción del tiempo de permanencia y se valida con desempeño en el conjunto de prueba.

Conclusiones:
1. El hacinamiento aislado presenta baja capacidad explicativa del tiempo de permanencia en este dataset.
2. La permanencia en urgencias es multifactorial; por ello, el modelo multivariado es más adecuado.
3. La validación Train/Test permite comparar modelos y seleccionar el de mejor generalización.
4. Las visualizaciones 3D aportan una exploración dinámica por triage útil para gestión operativa.