En los servicios de salud, la no asistencia de los pacientes a sus citas médicas programadas genera problemas de congestión, pérdida de recursos y retrasos en la atención. Cuando un paciente no asiste, el espacio de consulta se desperdicia, se afectan las listas de espera y se deteriora la eficiencia del sistema.
En este contexto, resulta relevante comprender qué factores se asocian a la inasistencia a las citas: características sociodemográficas del paciente (por ejemplo, edad y sexo), aspectos relacionados con la programación de la cita (tiempo de espera entre la programación y la atención), entre otros.
¿Qué factores se asocian con la probabilidad de que un paciente no asista a su cita médica programada?
En esta sección se describe la base de datos utilizada y la forma en que se realizará el análisis cuantitativo.
La base de datos corresponde a registros de citas médicas programadas, e incluye información sobre:
La variable de interés (dependiente) será una medida binaria de no asistencia a la cita.
rm(list = ls())
paquetes <- c(
"tidyverse", # dplyr, ggplot2, readr, etc.
"lubridate", # manejo de fechas
"skimr", # resúmenes descriptivos rápidos
"janitor", # tablas de frecuencia limpias
"pROC" # curva ROC y AUC
)
instalar <- paquetes[!(paquetes %in% installed.packages()[, "Package"])]
if (length(instalar) > 0) install.packages(instalar)
invisible(lapply(paquetes, library, character.only = TRUE))
Nota: este script asume que el archivo
appointments.csvse encuentra en la misma carpeta que este.Rmd.
appointments_raw <- readr::read_csv("appointments.csv")
# Vista general de la estructura
dplyr::glimpse(appointments_raw)
## Rows: 111,488
## Columns: 16
## $ appointment_id <chr> "0000138", "0000146", "0000021", "0000233", "0000…
## $ slot_id <chr> "0000001", "0000023", "0000024", "0000025", "0000…
## $ scheduling_date <date> 2014-12-28, 2014-12-29, 2014-12-17, 2014-12-31, …
## $ appointment_date <date> 2015-01-01, 2015-01-01, 2015-01-01, 2015-01-01, …
## $ appointment_time <time> 08:00:00, 13:30:00, 13:45:00, 14:00:00, 14:15:00…
## $ scheduling_interval <dbl> 4, 3, 15, 1, 6, 2, 2, 2, 4, 4, 4, 1, 1, 7, 3, 2, …
## $ status <chr> "did not attend", "did not attend", "attended", "…
## $ check_in_time <time> NA, NA, 13:36:45, 13:59:32, NA…
## $ appointment_duration <dbl> NA, NA, 5.2, 28.9, NA, 7.7, 4.2, 27.1, NA, 1.2, 7…
## $ start_time <time> NA, NA, 13:37:57, 14:00:40, NA…
## $ end_time <time> NA, NA, 13:43:09, 14:29:34, NA…
## $ waiting_time <dbl> NA, NA, 1.2, 1.1, NA, 21.7, 16.2, 1.0, NA, 8.5, 2…
## $ patient_id <chr> "08285", "05972", "06472", "05376", "08028", "043…
## $ sex <chr> "Male", "Male", "Male", "Female", "Male", "Female…
## $ age <dbl> 37, 84, 77, 37, 72, 51, 28, 33, 29, 90, 66, 64, 3…
## $ age_group <chr> "35-39", "80-84", "75-79", "35-39", "70-74", "50-…
# Primeras filas
head(appointments_raw)
## # A tibble: 6 × 16
## appointment_id slot_id scheduling_date appointment_date appointment_time
## <chr> <chr> <date> <date> <time>
## 1 0000138 0000001 2014-12-28 2015-01-01 08:00
## 2 0000146 0000023 2014-12-29 2015-01-01 13:30
## 3 0000021 0000024 2014-12-17 2015-01-01 13:45
## 4 0000233 0000025 2014-12-31 2015-01-01 14:00
## 5 0000090 0000026 2014-12-26 2015-01-01 14:15
## 6 0000180 0000027 2014-12-30 2015-01-01 14:30
## # ℹ 11 more variables: scheduling_interval <dbl>, status <chr>,
## # check_in_time <time>, appointment_duration <dbl>, start_time <time>,
## # end_time <time>, waiting_time <dbl>, patient_id <chr>, sex <chr>,
## # age <dbl>, age_group <chr>
En esta sección se construye la variable binaria de no asistencia y se realizan transformaciones básicas.
Se asume que la base cuenta con:
status: estado de la cita (por ejemplo, “attended”,
“did not attend”).sex: sexo del paciente.age: edad del paciente.scheduling_date: fecha en que se programó la cita.appointment_date: fecha de la cita.Si alguna de estas variables tiene otro nombre en tu base, deberás ajustar el código.
appointments <- appointments_raw %>%
# Conversión de fechas (si ya son Date, ymd simplemente las deja iguales)
mutate(
scheduling_date = lubridate::ymd(scheduling_date),
appointment_date = lubridate::ymd(appointment_date)
) %>%
# Construcción de intervalo de programación (en días)
mutate(
scheduling_interval = as.numeric(appointment_date - scheduling_date)
)
# Construimos el subconjunto para el modelo:
# Solo citas atendidas o no atendidas
appointments_model <- appointments %>%
filter(status %in% c("attended", "did not attend")) %>%
mutate(
# Variable binaria: 1 = no asistió, 0 = asistió
no_show = if_else(status == "did not attend", 1, 0),
# Variables explicativas
sex = factor(sex),
age = as.numeric(age),
# Agrupamos edad en rangos, útil para explorar descriptivos
age_group = cut(
age,
breaks = c(0, 18, 30, 45, 60, Inf),
labels = c("0-18", "19-30", "31-45", "46-60", "60+"),
right = TRUE
)
)
# Comprobamos estructura del subconjunto para el modelo
glimpse(appointments_model)
## Rows: 92,647
## Columns: 17
## $ appointment_id <chr> "0000138", "0000146", "0000021", "0000233", "0000…
## $ slot_id <chr> "0000001", "0000023", "0000024", "0000025", "0000…
## $ scheduling_date <date> 2014-12-28, 2014-12-29, 2014-12-17, 2014-12-31, …
## $ appointment_date <date> 2015-01-01, 2015-01-01, 2015-01-01, 2015-01-01, …
## $ appointment_time <time> 08:00:00, 13:30:00, 13:45:00, 14:00:00, 14:30:00…
## $ scheduling_interval <dbl> 4, 3, 15, 1, 2, 2, 2, 4, 4, 1, 1, 7, 3, 2, 5, 4, …
## $ status <chr> "did not attend", "did not attend", "attended", "…
## $ check_in_time <time> NA, NA, 13:36:45, 13:59:32, 14:08:53…
## $ appointment_duration <dbl> NA, NA, 5.2, 28.9, 7.7, 4.2, 27.1, 1.2, 7.2, 18.9…
## $ start_time <time> NA, NA, 13:37:57, 14:00:40, 14:30:38…
## $ end_time <time> NA, NA, 13:43:09, 14:29:34, 14:38:20…
## $ waiting_time <dbl> NA, NA, 1.2, 1.1, 21.7, 16.2, 1.0, 8.5, 28.3, 1.0…
## $ patient_id <chr> "08285", "05972", "06472", "05376", "04317", "076…
## $ sex <fct> Male, Male, Male, Female, Female, Male, Male, Fem…
## $ age <dbl> 37, 84, 77, 37, 51, 28, 33, 90, 66, 64, 34, 59, 5…
## $ age_group <fct> 31-45, 60+, 60+, 31-45, 46-60, 19-30, 31-45, 60+,…
## $ no_show <dbl> 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
# Tabla de la variable objetivo
table(appointments_model$no_show)
##
## 0 1
## 86032 6615
prop.table(table(appointments_model$no_show))
##
## 0 1
## 0.92859995 0.07140005
En esta sección se realiza una exploración inicial de las variables de interés, tanto numéricas como categóricas.
appointments_model %>%
select(no_show, age, scheduling_interval) %>%
skimr::skim()
| Name | Piped data |
| Number of rows | 92647 |
| Number of columns | 3 |
| _______________________ | |
| Column type frequency: | |
| numeric | 3 |
| ________________________ | |
| Group variables | None |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| no_show | 0 | 1 | 0.07 | 0.26 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| age | 0 | 1 | 57.23 | 20.15 | 15 | 40 | 59 | 74 | 100 | ▅▆▇▇▂ |
| scheduling_interval | 0 | 1 | 7.20 | 6.16 | 1 | 2 | 5 | 10 | 30 | ▇▃▂▁▁ |
# Estado de la cita
tab_status <- table(appointments_model$status)
tab_status
##
## attended did not attend
## 86032 6615
prop.table(tab_status)
##
## attended did not attend
## 0.92859995 0.07140005
# Sexo
tab_sex <- table(appointments_model$sex)
tab_sex
##
## Female Male
## 54996 37651
prop.table(tab_sex)
##
## Female Male
## 0.593608 0.406392
# Cruce sexo x estado
tab_sex_status <- janitor::tabyl(appointments_model, sex, status)
tab_sex_status
## sex attended did not attend
## Female 51096 3900
## Male 34936 2715
janitor::adorn_percentages(tab_sex_status, "row") %>%
janitor::adorn_pct_formatting(digits = 1)
## sex attended did not attend
## Female 92.9% 7.1%
## Male 92.8% 7.2%
Estos gráficos permiten observar visualmente la relación entre la no asistencia y algunas variables explicativas.
# Proporción de no asistencia por sexo
appointments_model %>%
group_by(sex) %>%
summarise(
tasa_no_show = mean(no_show),
n = n()
) %>%
ggplot(aes(x = sex, y = tasa_no_show)) +
geom_col() +
geom_text(aes(label = round(tasa_no_show, 3)), vjust = -0.5) +
labs(
title = "Tasa de no asistencia por sexo",
x = "Sexo",
y = "Proporción de no asistencia"
)
# Distribución de la edad según asistencia
ggplot(appointments_model, aes(x = factor(no_show), y = age)) +
geom_boxplot() +
labs(
title = "Distribución de la edad según asistencia",
x = "No show (0 = asistió, 1 = no asistió)",
y = "Edad"
)
# Distribución del intervalo de programación según asistencia
ggplot(appointments_model, aes(x = factor(no_show), y = scheduling_interval)) +
geom_boxplot() +
labs(
title = "Intervalo de programación según asistencia",
x = "No show (0 = asistió, 1 = no asistió)",
y = "Intervalo de programación (días)"
)
En primer lugar, se observa que la proporción global de no asistencia en la base de datos es relativamente baja, alrededor del 7 % de las citas, lo que indica que la mayoría de los pacientes sí acuden a sus consultas. Aun así, este porcentaje de inasistencia puede considerarse relevante para la gestión del servicio, dado el volumen total de citas analizadas.
Al desagregar por sexo, la distribución de pacientes es ligeramente mayor en mujeres que en hombres, pero las tasas de no asistencia son muy similares en ambos grupos (en torno al 7 %). Esto sugiere que, de manera descriptiva, el sexo del paciente no parece ser un factor fuertemente diferenciador en la probabilidad de no asistir a la cita.
En cuanto a la edad, los boxplots muestran que la distribución es muy parecida entre quienes asisten y quienes no asisten: la edad media se sitúa alrededor de los 57 años y la mayoría de pacientes, en ambos grupos, se concentra aproximadamente entre los 40 y los 74 años. Es decir, no se observan diferencias claras en la edad entre los dos grupos a nivel descriptivo.
Por último, el intervalo de programación (días entre la fecha en que se agenda la cita y la fecha de atención) presenta medianas y rangos intercuartílicos prácticamente iguales para quienes asisten y quienes no. Esto indica que, al menos desde una mirada exploratoria, tener más o menos días de espera no muestra una relación evidente con la no asistencia. Debido a que las diferencias descriptivas son pequeñas, resulta pertinente utilizar el modelo de regresión logística para evaluar de forma conjunta y más rigurosa la asociación entre estas variables y la probabilidad de no show.
En este estudio se propone un modelo de regresión
logística para estimar la probabilidad de que un paciente
no asista a su cita. La variable dependiente es
no_show (1 = no asiste, 0 = asiste), y se consideran como
variables explicativas:
age).sex).scheduling_interval).set.seed(123) # para reproducibilidad
n_total <- nrow(appointments_model)
id_train <- sample(1:n_total, size = round(0.7 * n_total))
datos_train <- appointments_model[id_train, ]
datos_test <- appointments_model[-id_train, ]
nrow(datos_train); nrow(datos_test)
## [1] 64853
## [1] 27794
modelo_logit <- glm(
no_show ~ age + sex + scheduling_interval,
data = datos_train,
family = binomial(link = "logit")
)
summary(modelo_logit)
##
## Call:
## glm(formula = no_show ~ age + sex + scheduling_interval, family = binomial(link = "logit"),
## data = datos_train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.580e+00 4.963e-02 -51.991 <2e-16 ***
## age 8.752e-05 7.670e-04 0.114 0.909
## sexMale 4.071e-02 3.133e-02 1.299 0.194
## scheduling_interval -5.004e-04 2.479e-03 -0.202 0.840
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 33435 on 64852 degrees of freedom
## Residual deviance: 33434 on 64849 degrees of freedom
## AIC: 33442
##
## Number of Fisher Scoring iterations: 5
En la salida de summary(modelo_logit) se pueden
observar:
En términos generales:
datos_test <- datos_test %>%
mutate(
prob_no_show = predict(
modelo_logit,
newdata = datos_test,
type = "response"
)
)
summary(datos_test$prob_no_show)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.06954 0.07048 0.07071 0.07159 0.07321 0.07368
head(datos_test$prob_no_show)
## 1 2 3 4 5 6
## 0.07058673 0.07328688 0.07064167 0.07342539 0.07332759 0.07063268
Se utilizará un umbral de 0.5 para clasificar a los pacientes:
datos_test <- datos_test %>%
mutate(
pred_no_show = if_else(prob_no_show >= 0.5, 1, 0)
)
# Forzamos que la tabla tenga siempre niveles 0 y 1
matriz_conf <- table(
Real = factor(datos_test$no_show, levels = c(0, 1)),
Predicho = factor(datos_test$pred_no_show, levels = c(0, 1))
)
matriz_conf
## Predicho
## Real 0 1
## 0 25823 0
## 1 1971 0
A partir de la matriz de confusión, se calculan algunas métricas:
# Extraemos los cuatro elementos de la matriz de confusión
tn <- matriz_conf["0", "0"] # verdaderos negativos
fp <- matriz_conf["0", "1"] # falsos positivos
fn <- matriz_conf["1", "0"] # falsos negativos
tp <- matriz_conf["1", "1"] # verdaderos positivos
# Exactitud global
accuracy <- (tp + tn) / (tp + tn + fp + fn)
# Sensibilidad (recall de la clase 1 = no_show)
sensibilidad <- if ((tp + fn) > 0) tp / (tp + fn) else NA
# Especificidad (para la clase 0 = asistió)
especificidad <- if ((tn + fp) > 0) tn / (tn + fp) else NA
accuracy
## [1] 0.9290854
sensibilidad
## [1] 0
especificidad
## [1] 1
if (length(unique(datos_test$no_show)) < 2) {
auc_valor <- NA
cat("No es posible calcular la curva ROC porque en el conjunto de prueba solo hay una clase de no_show.\n")
} else {
roc_obj <- pROC::roc(
response = datos_test$no_show,
predictor = datos_test$prob_no_show
)
auc_valor <- pROC::auc(roc_obj)
auc_valor
plot(
roc_obj,
main = paste("Curva ROC - AUC =", round(auc_valor, 3))
)
}
El valor del AUC (Área Bajo la Curva ROC) resume la capacidad discriminativa del modelo:
En esta sección se evalúa qué tan bien el modelo:
Aspectos a considerar en el texto:
summary(modelo_logit)).Por ejemplo, si el modelo presenta un AUC moderado y una exactitud aceptable, se puede decir que la capacidad predictiva es razonable, pero con espacio para mejorar.
En esta sección se presentan las conclusiones principales del estudio a partir de todo el análisis cuantitativo realizado. Por ejemplo:
La proporción global de no asistencia fue aproximadamente 0.071, lo que indica que la inasistencia es un fenómeno relevante en el servicio de salud analizado.
Se identificó que ciertas características del paciente (por ejemplo, edad o sexo) se asocian de manera significativa con la probabilidad de no asistir.
El intervalo de programación mostró una relación con la no asistencia, sugiriendo que tiempos de espera más prolongados pueden aumentar la probabilidad de que el paciente no acuda a la cita.
El modelo de regresión logística presenta una capacidad explicativa y predictiva razonable (según las métricas obtenidas), por lo que puede ser una herramienta de apoyo para la toma de decisiones y la gestión de citas.