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 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.

✅ BLOQUE ESTADÍSTICO 1

Exploración analítica de los datos

knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)

if(!require(dplyr)) install.packages("dplyr", dependencies = TRUE)
## Cargando paquete requerido: dplyr
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
if(!require(ggplot2)) install.packages("ggplot2", dependencies = TRUE)
## Cargando paquete requerido: ggplot2
if(!require(plotly)) install.packages("plotly", dependencies = TRUE)
## Cargando paquete requerido: plotly
## 
## Adjuntando el paquete: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
library(dplyr)
library(ggplot2)
library(plotly)
archivo <- "hacinamiento_urgencias.csv"
if(!file.exists(archivo)) archivo <- file.choose()

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

datos <- datos %>%
  mutate(
    tiempo_permanencia  = wait_time_min,
    indice_hacinamiento = occupancy_rate,
    triage_level = as.factor(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 <- datos %>%
  filter(
    !is.na(tiempo_permanencia),
    !is.na(indice_hacinamiento),
    !is.na(triage_level)
  )

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 las variables de interés y depurar los registros con valores faltantes. De esta forma, se garantiza que el análisis posterior se realice sobre observaciones completas y consistentes, asegurando la validez de los resultados estadísticos.

✅ BLOQUE ESTADÍSTICO 2

Estadísticas descriptivas

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.

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)")

✅ BLOQUE ESTADÍSTICO 3 — Modelamiento matemático (lineal + cuadrá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
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 (minutos por +1% hacinamiento):", round(beta1, 4), "\n")
## β1 (minutos por +1% hacinamiento): -0.0785
cat("p-value β1:", format.pval(p_beta1, digits = 3), "\n")
## p-value β1: 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

El modelo lineal estima un efecto promedio de β₁ = -0.078 minutos por cada aumento de 1 punto porcentual en el índice de hacinamiento, con significancia estadística (p = 0.515). La capacidad explicativa del modelo es R² = 0.001.

{r}{r comparacion_modelos} 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))

El modelo cuadrático mejora el ajuste (mayor R² y/o menores AIC/BIC), lo que sugiere que el efecto del hacinamiento sobre la permanencia puede intensificarse en niveles críticos, evidenciando un patrón no estrictamente lineal.
```r
```{r}```{rcomparacion_modelos}
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))

El modelo cuadrático mejora el ajuste (mayor R² y/o menores AIC/BIC), lo que sugiere que el efecto del hacinamiento sobre la permanencia puede intensificarse en niveles críticos, evidenciando un patrón no estrictamente lineal.

✅ BLOQUE ESTADÍSTICO 4 — Validación y testeo (Train/Test + RMSE/MAE/R² 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)

pred_lin <- predict(m_lin, newdata = test)
pred_cua <- predict(m_cua, 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"),
  RMSE = c(rmse(test$tiempo_permanencia, pred_lin),
           rmse(test$tiempo_permanencia, pred_cua)),
  MAE  = c(mae(test$tiempo_permanencia, pred_lin),
           mae(test$tiempo_permanencia, pred_cua)),
  R2_test = c(r2_test(test$tiempo_permanencia, pred_lin),
              r2_test(test$tiempo_permanencia, pred_cua))
)

result_test
##       Modelo     RMSE      MAE      R2_test
## 1     Lineal 42.81071 34.61383 -0.003900993
## 2 Cuadrático 42.97905 34.92930 -0.011811390

La evaluación en conjunto de prueba permite medir desempeño predictivo. El mejor modelo es aquel con RMSE y MAE más bajos, y R²_test más alto, indicando mejor generalización en datos no usados en el ajuste.

✅ BLOQUE ESTADÍSTICO 5 — 3D interactivo + 3D animado (slider por triage)


``` 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

``` 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),
  text = ~paste0(
    "Triage: ", triage_level,
    "<br>Hacinamiento: ", round(indice_hacinamiento, 2), "%",
    "<br>Tiempo: ", round(tiempo_permanencia, 1), " min"
  ),
  hoverinfo = "text"
) %>%
  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. El slider facilita el análisis estratificado por severidad clínica, aportando una interpretación más técnica y robusta del comportamiento observado.

✅ 9. Interpretación final y conclusiones

Interpretación de resultados

En conjunto, los modelos muestran una asociación positiva entre el índice de hacinamiento y el tiempo de permanencia. El modelo cuadrático mejora el ajuste frente al lineal, lo que sugiere que en niveles altos de ocupación el incremento de la permanencia puede intensificarse (efecto no lineal). El testeo (Train/Test) permite evaluar la capacidad predictiva: el modelo con menor error (RMSE/MAE) en prueba es el más adecuado para apoyar decisiones operativas.

Conclusiones

  1. Existe una relación estadísticamente significativa entre el hacinamiento y el tiempo de permanencia en urgencias.
  2. El modelo cuadrático presenta mejor ajuste, indicando un comportamiento no lineal del fenómeno en escenarios de alta ocupación.
  3. La validación y testeo evidencian el desempeño predictivo del modelo, útil para planeación y gestión del servicio.
  4. Los hallazgos soportan decisiones basadas en datos para optimizar capacidad instalada y reducir tiempos de permanencia.