Análisis de datos para la gestión de citas médicas
EDA, probabilidad y estadística aplicada, modelo analítico y narrativa visual con RStudio
Nombres: Camilo Aponte y Andrea Camacho
24/10/2026
Presentación del informe
Problema de gestión. Un consultorio con agenda en franjas de 15 minutos atiende unas 43 citas diarias. Dos problemas afectan su desempeño: citas que se pierden (cancelaciones e inasistencias, es decir, capacidad instalada que no produce atención) y tiempos de espera altos (el principal indicador de calidad percibida por el paciente).
Objetivo general. Usar RStudio para pasar de la descripción de los datos a la toma de decisiones: describir el comportamiento de la agenda, medir la incertidumbre y comprobar estadísticamente las diferencias, y construir un modelo que prediga el tiempo de espera, y comunicar los hallazgos a la dirección con una narrativa visual y un tablero de control.
Estructura (cada capítulo responde una pregunta y alimenta el siguiente):
| Capítulo | Pregunta que responde | Resultado que pasa al siguiente capítulo |
|---|---|---|
| 1. EDA | ¿Qué pasa en la agenda? | Se pierde ~22 % de las citas y la espera es alta. |
| 2. Probabilidad y Estadística | ¿Esas diferencias son reales o azar? ¿De qué dependen? | La espera depende de la hora del día (no del paciente); las pérdidas no dependen de ningún grupo. |
| 3. Modelo analítico | ¿Se puede predecir la espera para actuar antes? | Un modelo con el “retraso acumulado” del día explica ~3/4 de la variación de la espera. |
| 4. Narrativa visual | ¿Cómo se comunica a la dirección para que decida? | Historia A³, tablero con indicadores y dos recomendaciones ejecutivas. |
El código de cada paso está oculto para facilitar la lectura; se despliega con el botón Code. Los gráficos con plotly son interactivos (pasar el mouse, zoom y doble clic para restablecer). Cada gráfico tiene una lectura para la gestión con tres preguntas: ¿qué muestra?, ¿es bueno o malo y por qué? y ¿qué hacer?
1 Análisis Exploratorio de Datos (EDA)
El EDA (Exploratory Data Analysis, o análisis exploratorio de datos) es la primera revisión de una base: qué variables tiene, cómo están organizadas, si hay datos faltantes o valores raros y qué patrones se ven en los gráficos.
1.1 Contexto, fuente y preparación de los datos
1.1.1 Fuente de información
- Notebook de referencia: EDA Medical Appointment System Dataset (Kaggle, Carolina González Galtier).
- Base de datos: Medical Appointment Scheduling System (Kaggle): registros simulados de un consultorio con el estado de cada cita, los tiempos de espera y la duración de la consulta.
- Archivo usado:
appointments.csv(una fila = una cita médica).
Para la gestión de recursos sanitarios, la base permite analizar la demanda (cuántas citas y cuándo), el aprovechamiento de la capacidad instalada (citas atendidas frente a perdidas) y la eficiencia operativa (tiempos de espera y de consulta).
1.1.2 Preparación del entorno
Se cargan todos los paquetes del informe. Los que no estén instalados se instalan automáticamente.
paquetes <- c("tidyverse", "skimr", "janitor", "plotly", "knitr", "ggpubr",
"rsample", "broom", "yardstick", "DiagrammeR", "ggrepel", "flexdashboard")
faltan <- paquetes[!sapply(paquetes, requireNamespace, quietly = TRUE)]
if (length(faltan) > 0) install.packages(faltan, repos = "https://cloud.r-project.org")
library(tidyverse) # manejo de datos (dplyr, tidyr) y gráficos (ggplot2)
library(skimr) # resumen rápido de la base
library(janitor) # limpieza de nombres y tablas de frecuencia
library(plotly) # gráficos interactivos
library(knitr) # tablas
library(ggpubr) # gráficos comparativos con pruebas estadísticas
library(rsample) # división entrenamiento / prueba
library(broom) # resultados de modelos en forma de tabla
library(yardstick) # métricas de desempeño (RMSE, MAE, R²)
library(ggrepel) # etiquetas que no se superponen
set.seed(2026) # semilla: las simulaciones y la división de datos dan siempre el mismo resultado
fp <- function(p) format.pval(p, digits = 3, eps = 0.001) # formato de valores p1.1.3 Importación de los datos
El archivo CSV (valores separados por comas) debe estar en
la misma carpeta que este .Rmd. Se traducen los estados de
la cita y el sexo al español y se crean variables de apoyo.
citas <- read_csv("appointments.csv") %>%
clean_names() %>%
mutate(
across(where(hms::is_hms), as.character), # horas como texto
status = fct_recode(factor(status),
"Atendida" = "attended", "Cancelada" = "cancelled",
"No asistió" = "did not attend", "Programada" = "scheduled",
"Desconocido" = "unknown"),
sex = factor(sex, levels = c("Female", "Male"), labels = c("Mujer", "Hombre")),
age_group = factor(age_group, levels = unique(age_group[order(age)])),
dia_semana = factor(weekdays(as.Date(appointment_date)),
levels = c("lunes", "martes", "miércoles", "jueves", "viernes", "sábado", "domingo",
"Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
"Saturday", "Sunday")) %>% droplevels(),
mes = format(as.Date(appointment_date), "%Y-%m"),
hora = as.integer(substr(appointment_time, 1, 2)), # hora programada
jornada = factor(ifelse(hora < 12, "Mañana", "Tarde")),
anio = as.integer(substr(as.character(appointment_date), 1, 4)),
periodo = factor(ifelse(anio <= 2019, "2015-2019", "2020-2024")),
banda_edad = cut(age, breaks = c(0, 29, 49, 69, Inf), labels = c("15-29", "30-49", "50-69", "70+"))
)
atendidas <- citas %>% filter(status == "Atendida") # citas con tiempos registrados
n_total <- nrow(citas)
dim(citas)## [1] 111488 23La base tiene 111.488 citas y 23 columnas (16 originales y las creadas en este informe), con fechas de cita entre 2015-01-01 y 2024-12-24.
1.2 Estructura y descripción de las variables
1.2.1 Estructura y
resumen: glimpse(), summary() y
skim()
glimpse() (equivalente a str()) muestra el
nombre, el tipo y los primeros valores de cada variable;
summary() da mínimos, máximos y valores centrales;
skim() agrega datos faltantes y un mini histograma.
glimpse(citas)## Rows: 111,488
## Columns: 23
## $ appointment_id <chr> "0000138", "0000146", "0000021", "0000233", "0000090", "0000180"…
## $ slot_id <chr> "0000001", "0000023", "0000024", "0000025", "0000026", "0000027"…
## $ scheduling_date <date> 2014-12-28, 2014-12-29, 2014-12-17, 2014-12-31, 2014-12-26, 201…
## $ appointment_date <date> 2015-01-01, 2015-01-01, 2015-01-01, 2015-01-01, 2015-01-01, 201…
## $ appointment_time <chr> "08:00:00", "13:30:00", "13:45:00", "14:00:00", "14:15:00", "14:…
## $ scheduling_interval <dbl> 4, 3, 15, 1, 6, 2, 2, 2, 4, 4, 4, 1, 1, 7, 3, 2, 5, 4, 11, 2, 4,…
## $ status <fct> No asistió, No asistió, Atendida, Atendida, Cancelada, Atendida,…
## $ check_in_time <chr> NA, NA, "13:36:45", "13:59:32", NA, "14:08:53", "14:22:59", "14:…
## $ appointment_duration <dbl> NA, NA, 5.2, 28.9, NA, 7.7, 4.2, 27.1, NA, 1.2, 7.2, 18.9, 20.8,…
## $ start_time <chr> NA, NA, "13:37:57", "14:00:40", NA, "14:30:38", "14:39:14", "15:…
## $ end_time <chr> NA, NA, "13:43:09", "14:29:34", NA, "14:38:20", "14:43:26", "15:…
## $ waiting_time <dbl> NA, NA, 1.2, 1.1, NA, 21.7, 16.2, 1.0, NA, 8.5, 28.3, 1.0, 1.3, …
## $ patient_id <chr> "08285", "05972", "06472", "05376", "08028", "04317", "07638", "…
## $ sex <fct> Hombre, Hombre, Hombre, Mujer, Hombre, Mujer, Hombre, Hombre, Mu…
## $ age <dbl> 37, 84, 77, 37, 72, 51, 28, 33, 29, 90, 66, 64, 34, 59, 58, 63, …
## $ age_group <fct> 35-39, 80-84, 75-79, 35-39, 70-74, 50-54, 25-29, 30-34, 25-29, 9…
## $ dia_semana <fct> jueves, jueves, jueves, jueves, jueves, jueves, jueves, jueves, …
## $ mes <chr> "2015-01", "2015-01", "2015-01", "2015-01", "2015-01", "2015-01"…
## $ hora <int> 8, 13, 13, 14, 14, 14, 14, 15, 15, 13, 15, 16, 16, 16, 16, 17, 1…
## $ jornada <fct> Mañana, Tarde, Tarde, Tarde, Tarde, Tarde, Tarde, Tarde, Tarde, …
## $ anio <int> 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015, 2015…
## $ periodo <fct> 2015-2019, 2015-2019, 2015-2019, 2015-2019, 2015-2019, 2015-2019…
## $ banda_edad <fct> 30-49, 70+, 70+, 30-49, 70+, 50-69, 15-29, 30-49, 15-29, 70+, 50…summary(citas %>% select(scheduling_interval, appointment_duration, waiting_time, age, status, sex))## scheduling_interval appointment_duration waiting_time age
## Min. : 1.00 Min. : 0.00 Min. : 0.60 Min. : 15.00
## 1st Qu.: 2.00 1st Qu.: 8.60 1st Qu.: 12.60 1st Qu.: 40.00
## Median : 5.00 Median :15.80 Median : 33.50 Median : 59.00
## Mean : 7.19 Mean :17.48 Mean : 44.09 Mean : 57.21
## 3rd Qu.:10.00 3rd Qu.:24.70 3rd Qu.: 64.60 3rd Qu.: 74.00
## Max. :30.00 Max. :58.70 Max. :297.30 Max. :100.00
## NAs :25456 NAs :25456
## status sex
## Atendida :86032 Mujer :66086
## Cancelada :18254 Hombre:45402
## No asistió : 6615
## Programada : 141
## Desconocido: 446
##
## skim(citas %>% select(scheduling_interval, appointment_duration, waiting_time, age, status, sex))| Name | %>%(…) |
| Number of rows | 111488 |
| Number of columns | 6 |
| _______________________ | |
| Column type frequency: | |
| factor | 2 |
| numeric | 4 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| status | 0 | 1 | FALSE | 5 | Ate: 86032, Can: 18254, No : 6615, Des: 446 |
| sex | 0 | 1 | FALSE | 2 | Muj: 66086, Hom: 45402 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| scheduling_interval | 0 | 1.00 | 7.19 | 6.15 | 1.0 | 2.0 | 5.0 | 10.0 | 30.0 | ▇▃▂▁▁ |
| appointment_duration | 25456 | 0.77 | 17.48 | 11.06 | 0.0 | 8.6 | 15.8 | 24.7 | 58.7 | ▇▇▅▂▁ |
| waiting_time | 25456 | 0.77 | 44.09 | 40.79 | 0.6 | 12.6 | 33.5 | 64.6 | 297.3 | ▇▂▁▁▁ |
| age | 0 | 1.00 | 57.21 | 20.16 | 15.0 | 40.0 | 59.0 | 74.0 | 100.0 | ▅▆▇▇▂ |
1.2.2 Diccionario de variables
| Variable | Tipo | Descripción |
|---|---|---|
| appointment_id / slot_id | Identificador | Código de la cita y de la franja de agenda |
| scheduling_date | Fecha | Día en que el paciente pidió la cita |
| appointment_date / appointment_time | Fecha / hora | Día y hora programados (franjas de 15 min) |
| scheduling_interval | Numérica | Días entre la solicitud y la cita (anticipación) |
| status | Categórica | Estado: Atendida, Cancelada, No asistió, Programada, Desconocido |
| check_in_time / start_time / end_time | Hora | Llegada del paciente, inicio y fin real de la consulta |
| appointment_duration | Numérica | Duración de la consulta (minutos) |
| waiting_time | Numérica | Minutos de espera antes de ser atendido |
| patient_id, sex, age, age_group | Paciente | Código, sexo, edad y grupo de edad |
| dia_semana, mes, hora, jornada, periodo, banda_edad | Derivadas | Creadas en este informe a partir de fecha, hora y edad |
1.2.3 Calidad de los datos: valores faltantes
citas %>%
summarise(across(everything(), ~ sum(is.na(.)))) %>%
pivot_longer(everything(), names_to = "variable", values_to = "n_faltantes") %>%
filter(n_faltantes > 0) %>%
mutate(porcentaje = round(100 * n_faltantes / n_total, 1)) %>%
kable()| variable | n_faltantes | porcentaje |
|---|---|---|
| check_in_time | 25456 | 22.8 |
| appointment_duration | 25456 | 22.8 |
| start_time | 25456 | 22.8 |
| end_time | 25456 | 22.8 |
| waiting_time | 25456 | 22.8 |
Lectura para la gestión. ¿Qué muestra? Los faltantes están solo en las variables de la atención (llegada, inicio, fin, duración y espera). ¿Es bueno o malo? Es lógico y no es un error: si la cita se canceló o el paciente no llegó, no hay hora de llegada ni duración. ¿Qué hacer? No rellenar esos datos; los análisis de tiempos se hacen solo con las citas atendidas.
1.3 Visualizaciones interactivas y comentarios
1.3.1 Gráfico 1. Frecuencia de citas según su estado (capacidad aprovechada)
estado <- citas %>% tabyl(status) %>% arrange(desc(n)) %>%
mutate(porcentaje = round(100 * percent, 1))
kable(estado %>% select(Estado = status, Citas = n, `%` = porcentaje))| Estado | Citas | % |
|---|---|---|
| Atendida | 86032 | 77.2 |
| Cancelada | 18254 | 16.4 |
| No asistió | 6615 | 5.9 |
| Desconocido | 446 | 0.4 |
| Programada | 141 | 0.1 |
g1 <- ggplot(estado, aes(x = reorder(status, n), y = n,
text = paste0("Estado: ", status, "<br>Citas: ", n, "<br>%: ", porcentaje))) +
geom_col(fill = "#2C7FB8") + coord_flip() +
labs(title = "Número de citas por estado", x = "Estado de la cita", y = "Número de citas") +
theme_minimal()
ggplotly(g1, tooltip = "text")pct <- function(x) estado$porcentaje[estado$status == x]
p_att <- pct("Atendida"); p_canc <- pct("Cancelada"); p_dna <- pct("No asistió")Lectura para la gestión. ¿Qué muestra? El 77.2 % de las citas se atiende, el 16.4 % se cancela y el 5.9 % corresponde a pacientes que no asisten. ¿Es bueno o malo? Malo: 22.3 % de la agenda se pierde; cada cita perdida es tiempo de médico y consultorio pagado que no produce atención. ¿Qué hacer? Recordatorios y confirmación previa de la cita, lista de espera para reasignar cupos liberados y, si la pérdida es estable, sobreagendamiento controlado (se cuantifica en el capítulo 2).
1.3.2 Gráfico 2. Demanda mensual de citas (uso de las instalaciones)
ultimo_mes <- max(citas$mes) # se excluye el último mes porque está incompleto
demanda_mes <- citas %>% filter(mes != ultimo_mes) %>% count(mes, status) %>%
mutate(fecha = as.Date(paste0(mes, "-01")))
g2 <- ggplot(demanda_mes, aes(x = fecha, y = n, color = status, group = status,
text = paste0("Mes: ", mes, "<br>Estado: ", status, "<br>Citas: ", n))) +
geom_line() +
labs(title = "Citas por mes según su estado", x = "Mes", y = "Número de citas", color = "Estado") +
scale_color_brewer(palette = "Set2") + theme_minimal()
ggplotly(g2, tooltip = "text")citas %>% count(dia_semana) %>% kable(col.names = c("Día", "Citas"))| Día | Citas |
|---|---|
| lunes | 22293 |
| martes | 22342 |
| miércoles | 22190 |
| jueves | 22313 |
| viernes | 22350 |
Lectura para la gestión. ¿Qué muestra? Diez años de demanda estable (entre unas 850 y 1.000 citas al mes), repartida casi por igual de lunes a viernes y sin atención los fines de semana; las cancelaciones e inasistencias también son estables. ¿Es bueno o malo? Bueno para planear: una demanda predecible permite fijar consultorios y turnos con una plantilla estable. Malo en un aspecto: las pérdidas no han mejorado solas con el tiempo. ¿Qué hacer? Planear la capacidad con base en el promedio mensual y concentrar los esfuerzos en reducir las pérdidas, no en buscar más demanda.
1.3.3 Gráfico 3. Distribución del tiempo de espera (variable numérica clave)
g3 <- ggplot(atendidas, aes(x = waiting_time)) +
geom_histogram(binwidth = 5, fill = "#41AB5D", color = "white") +
geom_vline(xintercept = 30, linetype = "dashed", color = "red") +
labs(title = "Distribución del tiempo de espera (citas atendidas); línea roja = meta de 30 min",
x = "Tiempo de espera (minutos)", y = "Número de citas") + theme_minimal()
ggplotly(g3)p_30 <- round(100 * mean(atendidas$waiting_time > 30), 1)Lectura para la gestión. ¿Qué muestra? La espera va de 0.6 a 297.3 minutos, con una “cola” larga a la derecha: la mayoría espera menos de una hora, pero algunos esperan varias. El 53.8 % espera más de 30 minutos. ¿Es bueno o malo? Malo: más de la mitad de los pacientes supera una meta razonable de 30 minutos; es el principal problema de calidad percibida. ¿Qué hacer? Identificar la causa antes de actuar: el capítulo 2 muestra que la espera crece con la hora del día y el capítulo 3 la explica con el retraso acumulado de la agenda.
1.3.4 Gráfico 4. Duración de la consulta por grupo de edad: valores atípicos (boxplot)
g4 <- ggplot(atendidas, aes(x = age_group, y = appointment_duration, fill = age_group)) +
geom_boxplot(outlier.colour = "red", show.legend = FALSE) +
geom_hline(yintercept = 15, linetype = "dashed") +
labs(title = "Duración de la consulta según grupo de edad (línea = franja de 15 min)",
x = "Grupo de edad", y = "Duración (minutos)") +
theme_minimal() + theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(g4)dur_med <- round(median(atendidas$appointment_duration), 1)
dur_mean <- round(mean(atendidas$appointment_duration), 1)Lectura para la gestión. ¿Qué muestra? El boxplot (diagrama de caja: la caja contiene la mitad central de los datos y los puntos rojos son valores atípicos) es casi igual en todas las edades: la consulta típica dura 15.8 minutos (promedio 17.5), con casos atípicos de hasta 58.7 minutos. ¿Es bueno o malo? La homogeneidad es buena (la edad no cambia el consumo de tiempo médico), pero hay un problema de diseño: la consulta promedio dura más que la franja de 15 minutos, así que la agenda nace con retraso y cada consulta larga empuja a las siguientes. ¿Qué hacer? Revisar la duración de la franja (o dejar cupos libres de amortiguación) y hacer seguimiento a las consultas que exceden ampliamente la franja.
1.3.5 Gráfico 5. Relación preliminar: anticipación del agendamiento vs. estado de la cita
g5 <- ggplot(citas, aes(x = status, y = scheduling_interval, fill = status)) +
geom_boxplot(show.legend = FALSE) +
labs(title = "Días de anticipación con que se pidió la cita, según su estado",
x = "Estado de la cita", y = "Días entre solicitud y cita") +
scale_fill_brewer(palette = "Set2") + theme_minimal()
ggplotly(g5)Lectura para la gestión. ¿Qué muestra? Las cajas de citas atendidas, canceladas y no asistidas son casi idénticas: la mayoría se pide con 2 a 10 días de anticipación, se cumpla o no. ¿Es bueno o malo? Es una pista útil: la anticipación no explica las pérdidas, así que limitar el horizonte de agendamiento no las reduciría. ¿Qué hacer? Buscar otras causas y validar estadísticamente (capítulo 2) antes de decidir.
1.4 Hallazgos del EDA y preguntas para el capítulo 2
- Calidad de la base: completa en el agendamiento; los faltantes se explican por el estado de la cita.
- Capacidad perdida: cerca del 22.3 % de la agenda; es el hallazgo con mayor impacto económico.
- Demanda estable: facilita planear capacidad y turnos.
- Espera prolongada: principal problema de calidad (53.8 % espera más de 30 min).
- Franja corta: la consulta promedio (17.5 min) supera la franja de 15 min.
Preguntas que pasan al capítulo 2: ¿las diferencias observadas son reales o azar?, ¿la espera depende del paciente (edad, sexo) o de la organización (hora, jornada)?, ¿las pérdidas se concentran en algún grupo?
2 Probabilidad y Estadística Aplicada
Se pasa de describir a medir la incertidumbre: se simulan escenarios con distribuciones de probabilidad y se aplican pruebas estadísticas para saber si las diferencias son reales o pueden deberse al azar. Referencia: Explorando medicaldata en R (RPubs).
2.1 Probabilidad
empírica: sample() y table()
2.1.1 Espacio muestral, eventos y probabilidad empírica
El espacio muestral es el conjunto de resultados posibles de una cita: Atendida, Cancelada, No asistió, Programada, Desconocido. Interesa el evento A = “cita perdida” (cancelada o no asistida).
p_real <- prop.table(table(citas$status)) # probabilidad real (base completa)
muestra <- citas[sample(1:n_total, size = 500), ] # sample(): 500 citas al azar de la base
p_muestra <- prop.table(table(muestra$status))
agenda_sim <- sample(names(p_real), size = 500, replace = TRUE, prob = p_real) # agenda simulada
p_sim <- prop.table(table(factor(agenda_sim, levels = names(p_real))))
tibble(Estado = names(p_real),
`P. real` = round(as.numeric(p_real), 3),
`P. empírica (muestra de 500)` = round(as.numeric(p_muestra[names(p_real)]), 3),
`P. empírica (agenda simulada)` = round(as.numeric(p_sim), 3)) %>% kable()| Estado | P. real | P. empírica (muestra de 500) | P. empírica (agenda simulada) |
|---|---|---|---|
| Atendida | 0.772 | 0.772 | 0.786 |
| Cancelada | 0.164 | 0.162 | 0.142 |
| No asistió | 0.059 | 0.062 | 0.070 |
| Programada | 0.001 | 0.002 | 0.002 |
| Desconocido | 0.004 | 0.002 | 0.000 |
p_perdida <- sum(p_real[c("Cancelada", "No asistió")])Lectura para la gestión. ¿Qué muestra? P(A) = 0.223: unas 22 de cada 100 citas se pierden. Las muestras de 500 dan valores cercanos pero no idénticos (variabilidad muestral). ¿Es bueno o malo? Malo en magnitud, pero útil: al ser una probabilidad estable, la pérdida se puede planear. ¿Qué hacer? Usar esta probabilidad para calcular cuántos cupos extra agendar (sección 2.2).
2.1.2 Ley de los grandes números: ¿cuántos datos se necesitan para medir bien?
sim_larga <- sample(c("Perdida", "Cumplida"), size = 5000, replace = TRUE, prob = c(p_perdida, 1 - p_perdida))
lgn <- tibble(n = 1:5000, prop = cumsum(sim_larga == "Perdida") / (1:5000))
g_lgn <- ggplot(lgn, aes(n, prop)) + geom_line(color = "#2C7FB8") +
geom_hline(yintercept = p_perdida, linetype = "dashed", color = "red") +
labs(title = "Proporción acumulada de citas perdidas (simulación)",
x = "Número de citas simuladas", y = "Proporción perdida") + theme_minimal()
ggplotly(g_lgn)Lectura para la gestión. ¿Qué muestra? Con pocas citas la proporción salta mucho; desde unas mil se estabiliza en el valor real (línea roja). ¿Es bueno o malo? Es una advertencia: un indicador calculado con una semana de datos (unas 200 citas) puede ser engañoso. ¿Qué hacer? Medir el % de pérdida con ventanas de al menos un mes antes de evaluar una intervención.
2.2 Distribuciones
discretas: runif(), rbinom() y
dpois()
por_dia <- citas %>% group_by(appointment_date) %>%
summarise(citas = n(), no_asiste = sum(status == "No asistió"))
n_dia <- round(mean(por_dia$citas)) # citas promedio por día
p_dna2 <- mean(citas$status == "No asistió") # probabilidad de no asistir
lambda <- mean(por_dia$no_asiste) # inasistencias promedio por díaCada día se programan en promedio 43 citas, la probabilidad de no asistir es p = 0.059 y hay λ = 2.54 inasistencias por día.
2.2.1 Simulación de
inasistencias en tres escenarios (runif() y
rbinom())
runif() asigna a cada paciente un número aleatorio entre
0 y 1 (si es menor que p, no asiste); rbinom() da
directamente el número de inasistencias de un día de 43 citas.
escenarios <- c("Con recordatorios (p = 3%)" = 0.03, "Situación actual" = p_dna2, "Sin control (p = 12%)" = 0.12)
inasist_runif <- sum(runif(n_dia) < p_dna2) # un día simulado paciente por paciente
sim_binom <- map_dfr(names(escenarios), function(e)
tibble(escenario = e, inasistencias = rbinom(1000, size = n_dia, prob = escenarios[e])))
sim_binom$escenario <- factor(sim_binom$escenario, levels = names(escenarios))
res_bin <- sim_binom %>% group_by(escenario) %>%
summarise(Promedio = round(mean(inasistencias), 2),
`P(5 o más por día)` = round(mean(inasistencias >= 5), 3), Máximo = max(inasistencias))
kable(res_bin)| escenario | Promedio | P(5 o más por día) | Máximo |
|---|---|---|---|
| Con recordatorios (p = 3%) | 1.37 | 0.011 | 6 |
| Situación actual | 2.63 | 0.119 | 8 |
| Sin control (p = 12%) | 5.15 | 0.590 | 13 |
g_bin <- ggplot(sim_binom, aes(inasistencias, fill = escenario)) + geom_bar(position = "dodge") +
labs(title = "Inasistencias por día en 1.000 días simulados (rbinom)",
x = "Inasistencias en el día", y = "Número de días", fill = "Escenario") +
scale_fill_brewer(palette = "Set2") + theme_minimal()
ggplotly(g_bin)Lectura para la gestión. ¿Qué muestra? El
día simulado con runif() tuvo 3 inasistencias. Con
rbinom(), la situación actual produce en promedio 2.63
inasistencias por día; con recordatorios bajaría a 1.37 y sin control
subiría a 5.15. ¿Es bueno o malo? La situación actual es
mejorable: los recordatorios reducirían las pérdidas casi a la mitad.
¿Qué hacer? Simular antes de invertir: si el costo de un
sistema de recordatorios es menor que el valor de ~1.3 consultas
recuperadas por día, la intervención se justifica.
2.2.2 Probabilidad exacta
del número de inasistencias (dpois())
k <- 0:10
pois <- tibble(k = k, teorica = dpois(k, lambda),
real = as.numeric(table(factor(pmin(por_dia$no_asiste, 10), levels = k))) / nrow(por_dia))
g_pois <- pois %>% pivot_longer(-k, names_to = "fuente", values_to = "prob") %>%
mutate(fuente = recode(fuente, teorica = "Poisson (dpois)", real = "Datos reales")) %>%
ggplot(aes(k, prob, fill = fuente)) + geom_col(position = "dodge") +
labs(title = "Inasistencias por día: modelo de Poisson vs. datos reales",
x = "Inasistencias en el día", y = "Probabilidad", fill = "") +
scale_x_continuous(breaks = k) + theme_minimal()
ggplotly(g_pois)p_cero <- dpois(0, lambda); p_5omas <- 1 - sum(dpois(0:4, lambda)); p_2omas <- 1 - sum(dpois(0:1, lambda))Lectura para la gestión. ¿Qué muestra? El modelo de Poisson (λ = 2.54) se ajusta muy bien a los datos reales. La probabilidad de un día sin inasistencias es solo 7.9 %, la de 2 o más es 72.1 % y la de 5 o más es 11.4 %. ¿Es bueno o malo? Bueno para planear: las inasistencias son predecibles. ¿Qué hacer? Agendar 2 cupos extra por día: en el 72 % de los días esos cupos se compensan con inasistencias y solo en pocos días habría sobrecupo.
2.3 Distribuciones
continuas: rnorm(), rexp() y
runif()
2.3.1 Simulación de datos continuos
mu_dur <- mean(atendidas$appointment_duration); sd_dur <- sd(atendidas$appointment_duration)
mu_esp <- mean(atendidas$waiting_time)
sim_cont <- tibble(`Duración - normal (rnorm)` = rnorm(5000, mu_dur, sd_dur),
`Espera - exponencial (rexp)` = rexp(5000, rate = 1 / mu_esp),
`Anticipación - uniforme (runif)` = runif(5000, 1, 30)) %>%
pivot_longer(everything(), names_to = "modelo", values_to = "valor")
g_cont <- ggplot(sim_cont, aes(valor)) +
geom_histogram(aes(y = after_stat(density)), bins = 40, fill = "#41AB5D", color = "white") +
facet_wrap(~ modelo, scales = "free") +
labs(title = "Datos simulados: normal, exponencial y uniforme", x = "Minutos / días", y = "Densidad") +
theme_minimal()
ggplotly(g_cont)2.3.2 Comparación con los
datos reales: dnorm(), pnorm(),
dexp() y pexp()
g_dnorm <- ggplot(atendidas, aes(appointment_duration)) +
geom_histogram(aes(y = after_stat(density)), binwidth = 2, fill = "grey80", color = "white") +
stat_function(fun = dnorm, args = list(mean = mu_dur, sd = sd_dur), color = "#2C7FB8", linewidth = 1) +
labs(title = "Duración real vs. normal (dnorm)", x = "Minutos", y = "Densidad") + theme_minimal()
g_dexp <- ggplot(atendidas, aes(waiting_time)) +
geom_histogram(aes(y = after_stat(density)), binwidth = 5, fill = "grey80", color = "white") +
stat_function(fun = dexp, args = list(rate = 1 / mu_esp), color = "red", linewidth = 1) +
labs(title = "Espera real vs. exponencial (dexp)", x = "Minutos", y = "Densidad") + theme_minimal()
subplot(ggplotly(g_dnorm), ggplotly(g_dexp), nrows = 1, titleX = TRUE, titleY = TRUE)tibble(Pregunta = c("P(consulta dure más de 15 min)", "P(consulta dure más de 30 min)",
"P(espera más de 30 min)", "P(espera más de 60 min)"),
`Modelo teórico` = c(1 - pnorm(15, mu_dur, sd_dur), 1 - pnorm(30, mu_dur, sd_dur),
1 - pexp(30, 1/mu_esp), 1 - pexp(60, 1/mu_esp)),
`Datos reales` = c(mean(atendidas$appointment_duration > 15), mean(atendidas$appointment_duration > 30),
mean(atendidas$waiting_time > 30), mean(atendidas$waiting_time > 60))) %>%
mutate(across(where(is.numeric), ~ round(.x, 3))) %>% kable()| Pregunta | Modelo teórico | Datos reales |
|---|---|---|
| P(consulta dure más de 15 min) | 0.589 | 0.523 |
| P(consulta dure más de 30 min) | 0.129 | 0.148 |
| P(espera más de 30 min) | 0.506 | 0.538 |
| P(espera más de 60 min) | 0.256 | 0.278 |
Lectura para la gestión. ¿Qué muestra? La
duración (media 17.5 min, desviación 11.1) se aproxima a una normal con
cola a la derecha; la espera se parece a una exponencial (muchas esperas
cortas, pocas muy largas). Con pnorm() se ve que
más de la mitad de las consultas excede la franja de 15
minutos; con pexp(), que cerca de la mitad de los
pacientes espera más de 30 minutos. La anticipación real no es uniforme:
se concentra en pocos días (mediana 5). ¿Es bueno o malo? Malo:
si la mayoría de las consultas no cabe en la franja, el retraso es
estructural y la espera larga es su consecuencia. ¿Qué hacer?
Usar estas probabilidades para rediseñar la agenda (franjas más largas o
cupos de amortiguación) y medir el efecto con el mismo cálculo.
2.4 Indicadores clave: estadística descriptiva
resumen_ind <- function(x) c(Media = mean(x), Mediana = median(x), `Desv. estándar` = sd(x),
Varianza = var(x), Mínimo = range(x)[1], Máximo = range(x)[2])
rbind(`Tiempo de espera (min)` = resumen_ind(atendidas$waiting_time),
`Duración consulta (min)` = resumen_ind(atendidas$appointment_duration),
`Anticipación (días)` = resumen_ind(citas$scheduling_interval),
`Citas por día` = resumen_ind(por_dia$citas)) %>% round(2) %>% kable()| Media | Mediana | Desv. estándar | Varianza | Mínimo | Máximo | |
|---|---|---|---|---|---|---|
| Tiempo de espera (min) | 44.09 | 33.5 | 40.79 | 1663.73 | 0.6 | 297.3 |
| Duración consulta (min) | 17.48 | 15.8 | 11.06 | 122.42 | 0.0 | 58.7 |
| Anticipación (días) | 7.19 | 5.0 | 6.15 | 37.78 | 1.0 | 30.0 |
| Citas por día | 42.81 | 43.0 | 3.28 | 10.78 | 1.0 | 52.0 |
summary(atendidas %>% select(waiting_time, appointment_duration, scheduling_interval, age))## waiting_time appointment_duration scheduling_interval age
## Min. : 0.60 Min. : 0.00 Min. : 1.000 Min. : 15.00
## 1st Qu.: 12.60 1st Qu.: 8.60 1st Qu.: 2.000 1st Qu.: 40.00
## Median : 33.50 Median :15.80 Median : 5.000 Median : 59.00
## Mean : 44.09 Mean :17.48 Mean : 7.198 Mean : 57.23
## 3rd Qu.: 64.60 3rd Qu.:24.70 3rd Qu.:10.000 3rd Qu.: 74.00
## Max. :297.30 Max. :58.70 Max. :30.000 Max. :100.00Lectura para la gestión. ¿Qué muestra? En la espera, la media (44.1 min) supera a la mediana (33.5 min) y la desviación estándar es casi igual a la media: la variable es muy dispersa. Las citas por día tienen poca variación. ¿Es bueno o malo? La dispersión de la espera es mala: el paciente no sabe si esperará 10 minutos o dos horas, lo que empeora su experiencia. La estabilidad de la demanda es buena. ¿Qué hacer? Reportar la espera con la mediana y el % sobre 30 minutos (no solo con el promedio) y buscar las variables que explican la dispersión (capítulo 3).
2.5 Pruebas de hipótesis
Se usa un nivel de significancia α = 0,05: si el valor p es menor que 0,05, la diferencia se considera estadísticamente significativa (poco probable que sea azar).
2.5.1 Comparación de
medias e intervalos de confianza: t.test()
t_meta <- t.test(atendidas$waiting_time, mu = 30) # media vs. meta de 30 min
t_jornada <- t.test(waiting_time ~ jornada, data = atendidas) # mañana vs. tarde
t_periodo <- t.test(waiting_time ~ periodo, data = atendidas) # 2015-2019 vs. 2020-2024
t_sexo <- t.test(waiting_time ~ sex, data = atendidas) # mujer vs. hombre
ic_esp <- t_meta$conf.int
res_t <- function(t, nombre) tibble(Comparación = nombre,
`Media grupo 1` = as.character(round(t$estimate[1], 1)),
`Media grupo 2` = ifelse(length(t$estimate) > 1, as.character(round(t$estimate[2], 1)), "—"),
`IC 95 %` = paste0("[", round(t$conf.int[1], 1), " ; ", round(t$conf.int[2], 1), "]"),
`valor p` = fp(t$p.value))
bind_rows(res_t(t_meta, "Espera media (IC de la media)"), res_t(t_jornada, "Mañana vs. Tarde"),
res_t(t_periodo, "2015-2019 vs. 2020-2024"), res_t(t_sexo, "Mujer vs. Hombre")) %>% kable()| Comparación | Media grupo 1 | Media grupo 2 | IC 95 % | valor p |
|---|---|---|---|---|
| Espera media (IC de la media) | 44.1 | — | [43.8 ; 44.4] | <0.001 |
| Mañana vs. Tarde | 27.2 | 55.3 | [-28.6 ; -27.7] | <0.001 |
| 2015-2019 vs. 2020-2024 | 43.2 | 45 | [-2.3 ; -1.2] | <0.001 |
| Mujer vs. Hombre | 44.1 | 44.1 | [-0.6 ; 0.6] | 0.992 |
Lectura para la gestión. ¿Qué muestra? Con 95 % de confianza la espera media está entre 43.8 y 44.4 minutos, por encima de la meta de 30. En la tarde se espera 55.3 min frente a 27.2 en la mañana (p <0.001). Entre periodos la diferencia es significativa pero de solo 1.8 minutos, y entre mujeres y hombres no hay diferencia (p = 0.992). ¿Es bueno o malo? Que la tarde duplique la espera es malo y revelador: el problema se acumula a lo largo del día. La equidad entre sexos es buena. La diferencia entre periodos recuerda que, con muchos datos, una diferencia pequeña sale significativa: hay que mirar también su tamaño. ¿Qué hacer? Priorizar intervenciones en la tarde (cupos de amortiguación al mediodía) y no invertir en estrategias diferenciadas por sexo.
2.5.2 Análisis de
varianza entre varios grupos: aov()
anova_edad <- aov(waiting_time ~ banda_edad, data = atendidas)
anova_dur <- aov(appointment_duration ~ banda_edad, data = atendidas)
anova_hora <- aov(waiting_time ~ factor(hora), data = atendidas)
p_aov <- function(m) summary(m)[[1]][["Pr(>F)"]][1]
f_aov <- function(m) summary(m)[[1]][["F value"]][1]
tibble(ANOVA = c("Espera según banda de edad", "Duración según banda de edad", "Espera según hora de la cita"),
F = round(c(f_aov(anova_edad), f_aov(anova_dur), f_aov(anova_hora)), 2),
`valor p` = fp(c(p_aov(anova_edad), p_aov(anova_dur), p_aov(anova_hora)))) %>% kable()| ANOVA | F | valor p |
|---|---|---|
| Espera según banda de edad | 0.63 | 0.598 |
| Duración según banda de edad | 1.11 | 0.345 |
| Espera según hora de la cita | 1710.12 | <0.001 |
Lectura para la gestión. ¿Qué muestra? La espera y la duración no cambian con la edad (p = 0.598 y p = 0.345), pero la espera sí cambia con la hora (p <0.001). ¿Es bueno o malo? Es una buena noticia para la gestión: la espera no depende del tipo de paciente (algo que no se controla), sino de la organización de la agenda (algo que sí se controla). ¿Qué hacer? Mantener la franja igual para todas las edades y actuar sobre la secuencia de la agenda.
2.5.3 Asociación entre
variables categóricas: chisq.test()
perdidas <- citas %>% filter(status %in% c("Atendida", "Cancelada", "No asistió")) %>%
mutate(status = droplevels(status))
tab_edad <- table(perdidas$banda_edad, perdidas$status); chi_edad <- chisq.test(tab_edad)
tab_jor <- table(perdidas$jornada, perdidas$status); chi_jor <- chisq.test(tab_jor)
kable(round(prop.table(tab_edad, 1) * 100, 1), caption = "% de cada estado por banda de edad")| Atendida | Cancelada | No asistió | |
|---|---|---|---|
| 15-29 | 77.3 | 16.7 | 5.9 |
| 30-49 | 77.4 | 16.6 | 5.9 |
| 50-69 | 77.7 | 16.3 | 6.0 |
| 70+ | 77.7 | 16.4 | 5.9 |
kable(round(prop.table(tab_jor, 1) * 100, 1), caption = "% de cada estado por jornada")| Atendida | Cancelada | No asistió | |
|---|---|---|---|
| Mañana | 77.4 | 16.6 | 6 |
| Tarde | 77.7 | 16.4 | 6 |
Lectura para la gestión. ¿Qué muestra? Ni la edad (χ² = 2.22, p = 0.898) ni la jornada (χ² = 1.23, p = 0.54) se asocian con que la cita se cumpla o se pierda. ¿Es bueno o malo? Significa que no hay un grupo “culpable”: las pérdidas son transversales. ¿Qué hacer? Aplicar recordatorios a todos los pacientes, sin segmentar por edad ni horario.
2.5.4 Comparación de
proporciones: prop.test()
inas <- citas %>% filter(status %in% c("Atendida", "No asistió")) %>% group_by(sex) %>%
summarise(x = sum(status == "No asistió"), n = n())
pt_sexo <- prop.test(inas$x, inas$n)
canc <- citas %>% group_by(periodo) %>% summarise(x = sum(status == "Cancelada"), n = n())
pt_periodo <- prop.test(canc$x, canc$n)
tibble(Comparación = c("Inasistencia: Mujer vs. Hombre", "Cancelación: 2015-2019 vs. 2020-2024"),
`Prop. grupo 1` = round(c(pt_sexo$estimate[1], pt_periodo$estimate[1]), 4),
`Prop. grupo 2` = round(c(pt_sexo$estimate[2], pt_periodo$estimate[2]), 4),
`valor p` = fp(c(pt_sexo$p.value, pt_periodo$p.value))) %>% kable()| Comparación | Prop. grupo 1 | Prop. grupo 2 | valor p |
|---|---|---|---|
| Inasistencia: Mujer vs. Hombre | 0.0709 | 0.0721 | 0.496 |
| Cancelación: 2015-2019 vs. 2020-2024 | 0.1649 | 0.1626 | 0.313 |
Lectura para la gestión. ¿Qué muestra? La inasistencia es igual en mujeres y hombres (p = 0.496) y la cancelación no cambió entre periodos (p = 0.313). ¿Es bueno o malo? Malo: en diez años la pérdida de capacidad no ha mejorado por sí sola; es un problema estructural. ¿Qué hacer? Una intervención activa (recordatorios y sobreagendamiento) con un indicador mensual para verificar su efecto.
2.6 Gráficos comparativos
con ggpubr
2.6.1 La espera según la jornada y la hora
g_a <- ggboxplot(atendidas, x = "jornada", y = "waiting_time", fill = "jornada",
palette = c("#66C2A5", "#FC8D62"), outlier.shape = NA,
xlab = "Jornada", ylab = "Espera (min)", title = "Espera: mañana vs. tarde") +
coord_cartesian(ylim = c(0, 200)) + stat_compare_means(method = "t.test", label.y = 190) +
theme(legend.position = "none")
g_b <- ggline(atendidas %>% mutate(hora = factor(hora)), x = "hora", y = "waiting_time",
add = "mean_ci", color = "#2C7FB8", xlab = "Hora programada",
ylab = "Espera media (min, IC 95 %)", title = "La espera crece con cada hora")
ggarrange(g_a, g_b, ncol = 2, labels = c("A", "B"))
esp_hora <- atendidas %>% group_by(hora) %>% summarise(m = mean(waiting_time))Lectura para la gestión. ¿Qué muestra? Panel A: toda la caja de la tarde está por encima de la de la mañana (prueba t significativa). Panel B: la espera media sube de forma casi lineal, de 16 min a las 8:00 a 66 min a las 17:00; cada hora agrega unos 6 minutos. ¿Es bueno o malo? Malo, y con una causa clara: es un efecto “bola de nieve”: cada consulta que excede su franja retrasa a todas las siguientes y la agenda nunca recupera el tiempo. El paciente de las 5 p. m. espera cuatro veces más que el de las 8 a. m. por la misma atención. ¿Qué hacer? Romper la acumulación: cupos libres a media mañana y al mediodía, franjas ajustadas a la duración real y control de las consultas que se extienden. El capítulo 3 cuantifica este efecto con un modelo.
2.6.2 Duración y pérdidas según la edad
g_c <- ggviolin(atendidas, x = "banda_edad", y = "appointment_duration", fill = "banda_edad",
palette = "Set2", add = "boxplot", add.params = list(fill = "white"),
xlab = "Banda de edad", ylab = "Duración (min)", title = "Duración de consulta por edad") +
stat_compare_means(method = "anova", label.y = 65) + theme(legend.position = "none")
prop_banda <- perdidas %>% group_by(banda_edad) %>% summarise(pct = round(100 * mean(status != "Atendida"), 1))
g_d <- ggbarplot(prop_banda, x = "banda_edad", y = "pct", fill = "#8DA0CB", label = TRUE,
xlab = "Banda de edad", ylab = "% de citas perdidas", title = "% de citas perdidas por edad") +
ylim(0, 30)
ggarrange(g_c, g_d, ncol = 2, labels = c("C", "D"))
Lectura para la gestión. ¿Qué muestra? Paneles C y D: la duración y el % de citas perdidas son prácticamente iguales en todas las edades (ANOVA no significativo). ¿Es bueno o malo? Bueno: confirma que no hace falta diferenciar la agenda por edad y que el problema no está en el perfil del paciente. ¿Qué hacer? Dirigir los recursos a la organización de la agenda, que es donde está la causa.
2.7 Síntesis del capítulo y preguntas para el capítulo 3
- Pérdidas predecibles y transversales: ~22 % de la agenda, con inasistencias diarias que siguen una Poisson (λ ≈ 2.5); no dependen de edad, sexo, jornada ni periodo. → Recordatorios universales y 2 cupos extra por día.
- La espera depende de la organización, no del paciente: crece hora a hora y se duplica en la tarde. → Cupos de amortiguación y franjas ajustadas.
- Lección metodológica: con bases grandes hay que mirar el tamaño del efecto, no solo el valor p.
Pregunta que pasa al capítulo 3: si la espera se acumula durante el día, ¿se puede predecir cuánto esperará cada paciente para actuar antes de que el retraso crezca?
3 Modelo Analítico
Se documenta el ciclo de conceptualización de un modelo: definir el problema, seleccionar variables, dividir los datos, ajustar, diagnosticar, evaluar y proponer mejoras. Referencia: regresión lineal múltiple de DavidGS (RPubs).
3.1 Contexto, objetivos y métricas de éxito
3.1.1 Problema y objetivo del modelo
Reto de gestión: reducir la espera y, mientras se reduce, informar a cada paciente cuánto esperará, para disminuir quejas y permitir que el consultorio active medidas (por ejemplo, abrir un cupo de amortiguación) cuando el retraso previsto sea alto.
Objetivo del modelo: predecir el tiempo de espera en minutos (variable continua) de cada cita atendida con una regresión lineal múltiple (modelo que estima una variable numérica como suma ponderada de varias variables explicativas).
3.1.2 Metas y métricas de éxito
sd_espera <- sd(atendidas$waiting_time)
tibble(Métrica = c("RMSE en prueba", "R² en prueba", "Diferencia RMSE entrenamiento vs. prueba"),
`Qué mide` = c("Error típico de la predicción, en minutos (raíz del error cuadrático medio)",
"Proporción de la variación de la espera que explica el modelo (0 a 1)",
"Si el modelo se ajusta solo a los datos de entrenamiento (sobreajuste)"),
`Meta` = c("≤ 25 minutos (error tolerable para informar al paciente)", "≥ 0,50", "< 10 %"),
`Referencia` = c(paste0("Sin modelo (predecir siempre el promedio) el error es ", round(sd_espera, 1), " min"),
"Sin modelo R² = 0", "—")) %>% kable()| Métrica | Qué mide | Meta | Referencia |
|---|---|---|---|
| RMSE en prueba | Error típico de la predicción, en minutos (raíz del error cuadrático medio) | ≤ 25 minutos (error tolerable para informar al paciente) | Sin modelo (predecir siempre el promedio) el error es 40.8 min |
| R² en prueba | Proporción de la variación de la espera que explica el modelo (0 a 1) | ≥ 0,50 | Sin modelo R² = 0 |
| Diferencia RMSE entrenamiento vs. prueba | Si el modelo se ajusta solo a los datos de entrenamiento (sobreajuste) | < 10 % | — |
3.2 Exploración y selección de variables
3.2.1 Descripción de las
variables del modelo: glimpse() y skim()
Se parte de las citas atendidas (las únicas con espera registrada). Además de las variables originales, se crea por ingeniería de variables (construir una variable nueva a partir de las existentes) el retraso acumulado: los minutos de consulta ya realizados ese día antes de la cita del paciente. Esta variable traduce en números el efecto “bola de nieve” del capítulo 2.
datos_modelo <- atendidas %>%
filter(!is.na(appointment_duration)) %>%
arrange(appointment_date, appointment_time) %>%
group_by(appointment_date) %>%
mutate(min_previos = cumsum(appointment_duration) - appointment_duration) %>% # retraso acumulado
ungroup() %>%
mutate(hora_dec = hora + as.integer(substr(appointment_time, 4, 5)) / 60) %>% # hora con minutos (8.25 = 8:15)
select(waiting_time, hora_dec, min_previos, scheduling_interval, age, sex) %>% # dplyr::select()
drop_na() # tidyr::drop_na()
glimpse(datos_modelo)## Rows: 86,032
## Columns: 6
## $ waiting_time <dbl> 1.1, 1.1, 4.7, 0.9, 11.3, 13.1, 19.1, 26.6, 30.8, 37.0, 20.0, 10.…
## $ hora_dec <dbl> 8.25, 8.50, 8.75, 9.00, 9.25, 9.50, 9.75, 10.00, 10.25, 10.50, 10…
## $ min_previos <dbl> 0.0, 2.6, 18.6, 36.3, 58.6, 77.8, 84.4, 117.5, 127.7, 144.4, 151.…
## $ scheduling_interval <dbl> 5, 1, 5, 6, 1, 4, 13, 16, 3, 1, 12, 10, 5, 2, 1, 9, 10, 18, 4, 4,…
## $ age <dbl> 65, 45, 40, 90, 25, 83, 78, 55, 37, 59, 90, 51, 53, 45, 71, 15, 8…
## $ sex <fct> Mujer, Mujer, Mujer, Hombre, Mujer, Hombre, Hombre, Mujer, Mujer,…skim(datos_modelo)| Name | datos_modelo |
| Number of rows | 86032 |
| Number of columns | 6 |
| _______________________ | |
| Column type frequency: | |
| factor | 1 |
| numeric | 5 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| sex | 0 | 1 | FALSE | 2 | Muj: 51096, Hom: 34936 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| waiting_time | 0 | 1 | 44.09 | 40.79 | 0.6 | 12.60 | 33.5 | 64.6 | 297.30 | ▇▂▁▁▁ |
| hora_dec | 0 | 1 | 12.88 | 2.89 | 8.0 | 10.50 | 13.0 | 15.5 | 17.75 | ▇▇▇▇▇ |
| min_previos | 0 | 1 | 283.55 | 176.08 | 0.0 | 133.28 | 278.4 | 424.5 | 821.00 | ▇▇▇▃▁ |
| scheduling_interval | 0 | 1 | 7.20 | 6.16 | 1.0 | 2.00 | 5.0 | 10.0 | 30.00 | ▇▃▂▁▁ |
| age | 0 | 1 | 57.23 | 20.15 | 15.0 | 40.00 | 59.0 | 74.0 | 100.00 | ▅▆▇▇▂ |
3.2.2 Variables candidatas y justificación
| Variable | Rol | Justificación |
|---|---|---|
| waiting_time | Respuesta (a predecir) | Indicador de calidad que se quiere anticipar. |
| hora_dec | Explicativa | El capítulo 2 mostró que la espera crece con la hora (ANOVA significativo). |
| min_previos | Explicativa (creada) | Mide la carga de consultas acumulada en el día: causa directa de la bola de nieve. |
| scheduling_interval | Explicativa (control) | Anticipación de la cita; se incluye para comprobar si aporta. |
| age, sex | Explicativas (control) | Perfil del paciente; el capítulo 2 sugiere que no aportan, se verifica en el modelo. |
| appointment_duration | Excluida | La duración de la propia consulta ocurre después de la espera: no sirve para predecirla. |
| start_time, end_time | Excluidas | Se conocen solo cuando el paciente ya fue atendido (fuga de información). |
3.3 Esquema conceptual del modelo
DiagrammeR::grViz("
digraph modelo {
graph [rankdir = LR, fontname = Helvetica]
node [shape = box, style = 'rounded,filled', fillcolor = '#EAF2F8', fontname = Helvetica, fontsize = 11]
hora [label = 'Hora de la cita']
minp [label = 'Retraso acumulado\\n(min de consulta previos)', fillcolor = '#FDEBD0']
ant [label = 'Días de anticipación']
edad [label = 'Edad']
sexo [label = 'Sexo']
lm [label = 'Regresión lineal múltiple\\nlm()', shape = ellipse, fillcolor = '#D6EAF8']
y [label = 'Tiempo de espera\\n(minutos)', fillcolor = '#D5F5E3']
{hora minp ant edad sexo} -> lm -> y
}")Pseudocódigo del ciclo:
1. Datos <- citas atendidas + variable creada "retraso acumulado"
2. Dividir <- 75 % entrenamiento / 25 % prueba (initial_split)
3. Modelo base : espera ~ hora + anticipación + edad + sexo
Modelo mejorado : espera ~ hora + retraso acumulado + anticipación + edad + sexo
4. Diagnóstico <- residuos (augment): homocedasticidad y normalidad aproximada
5. Evaluación <- RMSE, MAE y R² en entrenamiento y prueba (yardstick)
6. Decisión <- ¿cumple las metas? → proponer mejoras3.4 Implementación en RStudio
3.4.1 División en entrenamiento (75 %) y prueba (25 %)
El modelo se ajusta con el conjunto de entrenamiento y se evalúa con el de prueba, que el modelo no ha visto; así se comprueba que funciona con datos nuevos.
division <- initial_split(datos_modelo, prop = 0.75)
entreno <- training(division)
prueba <- testing(division)
tibble(Conjunto = c("Entrenamiento", "Prueba"), Citas = c(nrow(entreno), nrow(prueba))) %>% kable()| Conjunto | Citas |
|---|---|
| Entrenamiento | 64524 |
| Prueba | 21508 |
3.4.2 Ajuste del modelo
base y del modelo mejorado: lm()
m_base <- lm(waiting_time ~ hora_dec + scheduling_interval + age + sex, data = entreno)
m_mejor <- lm(waiting_time ~ hora_dec + min_previos + scheduling_interval + age + sex, data = entreno)
tidy(m_mejor) %>%
mutate(across(c(estimate, std.error, statistic), ~ round(.x, 3)), p.value = fp(p.value)) %>%
kable(col.names = c("Variable", "Coeficiente", "Error estándar", "t", "valor p"),
caption = "Coeficientes del modelo mejorado")| Variable | Coeficiente | Error estándar | t | valor p |
|---|---|---|---|---|
| (Intercept) | 252.093 | 0.808 | 312.130 | <0.001 |
| hora_dec | -29.346 | 0.089 | -328.085 | <0.001 |
| min_previos | 0.599 | 0.001 | 408.629 | <0.001 |
| scheduling_interval | 0.017 | 0.013 | 1.343 | 0.179 |
| age | -0.001 | 0.004 | -0.380 | 0.704 |
| sexHombre | -0.053 | 0.161 | -0.328 | 0.743 |
coef_m <- coef(m_mejor)Lectura de los coeficientes. Cada minuto de consulta acumulado antes del paciente suma 0.6 minutos a su espera, mientras que cada hora que pasa, a igual carga acumulada, resta 29.3 minutos (unos 0.49 por minuto transcurrido). En palabras sencillas: la espera ≈ minutos de consulta ya consumidos − minutos de agenda transcurridos. Si las consultas consumen más tiempo del que pasa en el reloj, el retraso crece. Edad, sexo y anticipación tienen coeficientes cercanos a cero, como anticipó el capítulo 2.
3.5 Diagnóstico preliminar de supuestos
3.5.1 Residuos frente a valores ajustados (homocedasticidad)
Un residuo es la diferencia entre la espera real y la predicha. Si el modelo es adecuado, los residuos deben verse como una nube sin forma alrededor de cero y con ancho parecido en todo el rango (homocedasticidad: varianza constante del error).
diag_m <- augment(m_mejor) %>% slice_sample(n = 5000) # muestra de 5.000 puntos para graficar
neg <- mean(fitted(m_mejor) < 0) # proporción de predicciones negativas
g_res <- ggplot(diag_m, aes(.fitted, .resid)) +
geom_point(alpha = 0.15, color = "#2C7FB8") +
geom_hline(yintercept = 0, color = "red") +
geom_smooth(se = FALSE, color = "black", linewidth = 0.8) +
labs(title = "Residuos vs. valores ajustados", x = "Espera predicha (min)", y = "Residuo (min)") +
theme_minimal()
g_res
3.5.2 Normalidad aproximada de los residuos
g_hist <- ggplot(diag_m, aes(.resid)) +
geom_histogram(aes(y = after_stat(density)), bins = 50, fill = "grey75", color = "white") +
stat_function(fun = dnorm, args = list(mean = 0, sd = sd(diag_m$.resid)), color = "red") +
labs(title = "Histograma de residuos", x = "Residuo (min)", y = "Densidad") + theme_minimal()
g_qq <- ggplot(diag_m, aes(sample = .resid)) + stat_qq(alpha = 0.2) + stat_qq_line(color = "red") +
labs(title = "Gráfico Q-Q de residuos", x = "Cuantiles teóricos", y = "Cuantiles observados") + theme_minimal()
ggarrange(g_hist, g_qq, ncol = 2)
Lectura del diagnóstico. ¿Qué muestra? Normalidad: los residuos se centran en cero y el histograma se parece a la curva normal; el gráfico Q-Q sigue la línea roja salvo en la cola derecha (algunas esperas mucho más largas que lo previsto). La normalidad se cumple de forma aproximada. Homocedasticidad y linealidad: la nube no es plana; la línea negra forma una “U”. El modelo se equivoca más en los extremos y el 6 % de sus predicciones son negativas (imposible para una espera), lo que crea el borde diagonal a la izquierda del gráfico. La varianza tampoco es constante. ¿Es bueno o malo? Para un modelo preliminar es aceptable (el error general es bajo, como se verá en 3.6), pero la “U” muestra que la relación real no es del todo lineal: cuando la agenda va al día la espera no baja de cero, y cuando va muy atrasada crece más rápido de lo que la recta supone. El modelo es menos preciso justo en los días más congestionados, donde más importa acertar. ¿Qué hacer? Incorporar esa no linealidad (sección 3.7): una variable de retraso neto que no pueda ser negativa, una transformación logarítmica de la espera o un algoritmo no lineal.
3.6 Evaluación del desempeño
3.6.1 Métricas en
entrenamiento y prueba: yardstick
evaluar <- function(modelo, datos, nombre_modelo, nombre_conjunto) {
pred <- predict(modelo, newdata = datos)
tibble(Modelo = nombre_modelo, Conjunto = nombre_conjunto,
RMSE = rmse_vec(datos$waiting_time, pred),
MAE = mae_vec(datos$waiting_time, pred),
R2 = rsq_vec(datos$waiting_time, pred))
}
tabla_met <- bind_rows(
evaluar(m_base, entreno, "Base", "Entrenamiento"), evaluar(m_base, prueba, "Base", "Prueba"),
evaluar(m_mejor, entreno, "Mejorado", "Entrenamiento"), evaluar(m_mejor, prueba, "Mejorado", "Prueba"))
kable(tabla_met %>% mutate(across(where(is.numeric), ~ round(.x, 3))),
col.names = c("Modelo", "Conjunto", "RMSE (min)", "MAE (min)", "R²"))| Modelo | Conjunto | RMSE (min) | MAE (min) | R² |
|---|---|---|---|---|
| Base | Entrenamiento | 37.616 | 28.614 | 0.151 |
| Base | Prueba | 37.490 | 28.498 | 0.152 |
| Mejorado | Entrenamiento | 19.858 | 15.311 | 0.763 |
| Mejorado | Prueba | 19.758 | 15.290 | 0.765 |
met <- function(m, c, v) tabla_met[[v]][tabla_met$Modelo == m & tabla_met$Conjunto == c]
dif_rmse <- 100 * abs(met("Mejorado", "Prueba", "RMSE") - met("Mejorado", "Entrenamiento", "RMSE")) /
met("Mejorado", "Entrenamiento", "RMSE")3.6.2 Interpretación de resultados frente a las metas
pred_prueba <- prueba %>% mutate(prediccion = predict(m_mejor, newdata = prueba)) %>% slice_sample(n = 3000)
g_pred <- ggplot(pred_prueba, aes(prediccion, waiting_time)) +
geom_point(alpha = 0.2, color = "#41AB5D") +
geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
labs(title = "Modelo mejorado: espera predicha vs. real (conjunto de prueba)",
x = "Espera predicha (min)", y = "Espera real (min)") + theme_minimal()
ggplotly(g_pred)Lectura para la gestión. ¿Qué muestra? El modelo base (hora, anticipación, edad y sexo) tiene un RMSE en prueba de 37.5 min y un R² de 0.15: apenas mejora a no usar modelo (40.8 min) y no cumple las metas. El modelo mejorado, al agregar el retraso acumulado, baja el error a 19.8 min (MAE 15.3 min) y explica el 76 % de la variación (R² = 0.76). La diferencia entre entrenamiento y prueba es de 0.5 %: no hay sobreajuste. En el gráfico, los puntos siguen la línea roja (predicción perfecta). ¿Es bueno o malo? Bueno: cumple las tres metas. Lo más importante para la gestión es lo que revela: la espera no depende de quién es el paciente sino de cuánto retraso trae la agenda. ¿Qué hacer? Usar el modelo durante la jornada: con las consultas ya realizadas se calcula la espera prevista de los siguientes pacientes; si supera 30 minutos, se informa al paciente y se activa un cupo de amortiguación. Limitación: el retraso acumulado se conoce durante el día, no al momento de agendar; sirve para gestionar en tiempo real, no para planear con semanas de anticipación.
3.7 Acciones de mejora propuestas
- Ingeniería de variables (ya aplicada y ampliable): crear el retraso acumulado mejoró el R² de 0.15 a 0.76. Se puede ampliar con el número de consultas atípicamente largas del día y la hora real de llegada del paciente frente a su hora asignada.
- Corregir la no linealidad y la heterocedasticidad (varianza
no constante): el diagnóstico mostró una “U” en los residuos y
predicciones negativas. Se propone (a) crear un retraso
neto = máximo entre 0 y (minutos de consulta previos − minutos
transcurridos desde las 8:00), que no puede ser negativo; (b) modelar el
logaritmo de la espera; o (c) usar bosques aleatorios
(
caret::train(method = "rf")), que captan relaciones no lineales sin exigir varianza constante. La alternativa elegida debe superar el RMSE de prueba del modelo actual. - Recolección de datos adicionales: registrar el médico o consultorio, el tipo de consulta (primera vez o control) y los motivos de cancelación. Esto permitiría modelar la duración de la consulta y, con ella, ajustar la franja de cada cita antes de que empiece el día.
Pregunta que pasa al capítulo 4: con la evidencia completa, ¿cómo se presenta a la dirección para que tome decisiones?
4 Narrativa Visual con RStudio (Storytelling)
Los capítulos anteriores produjeron la evidencia; este capítulo la
convierte en una historia para decidir. Se sigue el
modelo A³ (Atención – Análisis – Acción:
primero se capta la atención con el problema, luego se muestra la
evidencia y al final se propone la acción). Se aplican los principios de
la gramática de gráficos de ggplot2
(cada gráfico se construye por capas: datos, estética, geometría,
escalas y tema), como en la referencia Visualización para
humanos reales (Data4HR, RPubs).
4.1 Definición estratégica y audiencia (Fase de Atención)
4.1.1 Problema de gestión según el modelo A³
| Fase | Pregunta | Contenido en este caso |
|---|---|---|
| Atención | ¿Cuál es el problema y por qué importa ya? | Reducir la espera de los pacientes y recuperar la capacidad perdida en la consulta externa. Más de la mitad espera más de 30 minutos y se pierde ~1 de cada 5 citas. |
| Análisis | ¿Qué dicen los datos? | La consulta promedio no cabe en la franja de 15 minutos; los días que superan la capacidad de la jornada la espera se dispara (secciones 4.2 y 4.3). |
| Acción | ¿Qué se decide? | Rediseñar la agenda y monitorear tres indicadores en un tablero (secciones 4.4 y 4.5). |
4.1.2 Audiencia directiva y mensaje central
- Audiencia: Gerencia y Dirección Científica de la IPS, Coordinación de Consulta Externa y Oficina de Calidad y Atención al Usuario.
- Qué necesitan: pocos indicadores, causas claras y decisiones con metas medibles. No necesitan detalles técnicos ni código (el código queda oculto).
- Tiempo disponible: una reunión de comité de 10 minutos.
- Mensaje central (la gran idea): la espera no depende del paciente, sino de una agenda que se queda corta. La consulta dura más que la franja y, cada día que la carga supera la jornada, la espera se dispara. Ajustar la agenda es la decisión con mayor impacto.
4.2 Diseño visual estático (Fase de Análisis)
Los gráficos aplican “menos es más”: fondo limpio
(theme_minimal()), gris para el contexto, color solo para
el hallazgo, paletas de RColorBrewer
(scale_fill_brewer()), anotaciones
(annotate()) para señalar lo crítico y etiquetas sin
superposición (ggrepel::geom_text_repel()).
4.2.1 Tendencia temporal:
la pérdida de capacidad es constante (geom_line())
perd_mes <- citas %>% filter(mes != ultimo_mes) %>% group_by(mes) %>%
summarise(pct = 100 * mean(status %in% c("Cancelada", "No asistió"))) %>%
mutate(fecha = as.Date(paste0(mes, "-01")))
extremos <- perd_mes %>% filter(pct == max(pct) | pct == min(pct))
media_perd <- mean(perd_mes$pct)
ggplot(perd_mes, aes(fecha, pct)) +
geom_line(color = "grey65") +
geom_hline(yintercept = media_perd, linetype = "dashed", color = "#2C7FB8") +
geom_point(data = extremos, color = "#D7301F", size = 3) +
geom_text_repel(data = extremos, aes(label = paste0(mes, ": ", round(pct, 1), " %")),
color = "#D7301F", nudge_y = 1.2, size = 3.5) +
annotate("text", x = min(perd_mes$fecha), y = media_perd + 0.7, hjust = 0, color = "#2C7FB8",
label = paste0("Promedio: ", round(media_perd, 1), " % de la agenda perdida cada mes")) +
labs(title = "Cada mes se pierde más de 1 de cada 5 citas, y en diez años no ha mejorado",
subtitle = "% de citas canceladas o no asistidas por mes, 2015-2024",
x = NULL, y = "% de citas perdidas") +
theme_minimal()
¿Qué evidencia el gráfico? El % de citas perdidas oscila poco alrededor de 22.3 % durante diez años; el pico fue 2022-02 (26.8 %) y el mínimo 2021-12 (18.6 %). ¿Por qué es relevante para la gestión? Es capacidad instalada pagada que no produce atención, y su estabilidad muestra que no es un problema pasajero: sin intervención seguirá igual. ¿Qué ruta de acción sugiere? Intervenir de forma activa (recordatorios y sobreagendamiento controlado de 2 cupos, capítulo 2) y usar esta misma línea como indicador mensual para comprobar si baja.
4.2.2 Comparación
categórica: la espera supera la meta desde media mañana
(geom_col())
esp_h <- atendidas %>% group_by(hora) %>% summarise(espera = mean(waiting_time)) %>%
mutate(meta = factor(ifelse(espera > 30, "Supera la meta de 30 min", "Dentro de la meta"),
levels = c("Supera la meta de 30 min", "Dentro de la meta")))
hora_cruce <- min(esp_h$hora[esp_h$espera > 30])
pos_cruce <- hora_cruce - min(esp_h$hora) + 1 # posición de esa barra en el eje
esp_cruce <- esp_h$espera[esp_h$hora == hora_cruce]
ggplot(esp_h, aes(factor(hora), espera, fill = meta)) +
geom_col(width = 0.7) +
geom_hline(yintercept = 30, linetype = "dashed", color = "grey30") +
geom_text_repel(aes(label = round(espera)), direction = "y", nudge_y = 3, segment.color = NA, size = 3.5) +
annotate("text", x = 0.6, y = 33, hjust = 0, label = "Meta: 30 min", color = "grey30") +
annotate("segment", x = pos_cruce - 0.8, xend = pos_cruce, y = 58, yend = esp_cruce + 6,
arrow = arrow(length = unit(0.25, "cm")), color = "#D7301F") +
annotate("text", x = pos_cruce - 0.8, y = 62, color = "#D7301F",
label = paste0("Desde las ", hora_cruce, ":00 la espera supera la meta")) +
scale_fill_brewer(palette = "RdBu") +
labs(title = "Quien tiene cita en la tarde espera hasta cuatro veces más",
subtitle = "Espera media (minutos) según la hora programada de la cita",
x = "Hora de la cita", y = "Espera media (min)", fill = NULL) +
theme_minimal() + theme(legend.position = "top")
¿Qué evidencia el gráfico? La espera sube hora a hora: 16 min a las 8:00 y 66 min a las 17:00. Desde las 10:00 todas las horas superan la meta (barras en rojo). ¿Por qué es relevante para la gestión? El paciente de la tarde recibe la misma consulta con una experiencia mucho peor; esto genera quejas y afecta los indicadores de calidad. La causa es la acumulación de retrasos (capítulos 2 y 3), no el paciente. ¿Qué ruta de acción sugiere? Cortar la acumulación antes del cruce: dejar un cupo libre de amortiguación a media mañana (antes de las 10:00) y otro al inicio de la tarde, para que la agenda recupere el tiempo perdido.
4.2.3 Hallazgo crítico:
los días de sobrecarga disparan la espera
(geom_point())
Se suma la duración de todas las consultas atendidas de cada día y se compara con la capacidad de la jornada (8:00 a 18:00 = 600 minutos).
dia <- atendidas %>% group_by(appointment_date) %>%
summarise(min_consulta = sum(appointment_duration), espera = mean(waiting_time), citas = n()) %>%
mutate(estado = factor(ifelse(min_consulta > 600, "Sobrecarga (> 600 min)", "Dentro de la capacidad"),
levels = c("Sobrecarga (> 600 min)", "Dentro de la capacidad")))
peores <- dia %>% slice_max(espera, n = 5)
pct_sobre <- 100 * mean(dia$estado == "Sobrecarga (> 600 min)")
esp_sobre <- mean(dia$espera[dia$estado == "Sobrecarga (> 600 min)"])
esp_normal <- mean(dia$espera[dia$estado == "Dentro de la capacidad"])
ocupacion <- 100 * mean(dia$min_consulta) / 600
cor_dia <- cor(dia$min_consulta, dia$espera)
ggplot(dia, aes(min_consulta, espera, color = estado)) +
geom_point(alpha = 0.35, size = 1.3) +
geom_vline(xintercept = 600, linetype = "dashed", color = "grey30") +
geom_text_repel(data = peores, aes(label = format(as.Date(appointment_date), "%d/%m/%Y")),
color = "black", size = 3.2, box.padding = 0.5, min.segment.length = 0) +
annotate("text", x = 610, y = max(dia$espera) * 0.95, hjust = 0, color = "#D7301F",
label = paste0("Zona de sobrecarga\n", round(pct_sobre), " % de los días")) +
annotate("text", x = 595, y = max(dia$espera) * 0.95, hjust = 1, color = "grey30",
label = "Capacidad de la jornada\n(600 min)") +
scale_color_brewer(palette = "Set1") +
labs(title = "Cuando la carga del día supera la jornada, la espera se dispara",
subtitle = "Cada punto es un día: minutos totales de consulta vs. espera media (5 peores días etiquetados)",
x = "Minutos totales de consulta en el día", y = "Espera media del día (min)", color = NULL) +
theme_minimal() + theme(legend.position = "top")
¿Qué evidencia el gráfico? La relación es casi lineal (correlación de 0.84). El 40 % de los días supera los 600 minutos de consulta; en esos días la espera media es de 66 min, frente a 28 min en los demás. Los cinco peores días (etiquetados) superan las 2,5 horas de espera media. En promedio, la agenda usa el 96.9 % de la jornada. ¿Por qué es relevante para la gestión? Una ocupación tan cercana al 100 % no deja margen: cualquier consulta larga se convierte en retraso para todos los siguientes. Es el hallazgo crítico de la historia. ¿Qué ruta de acción sugiere? Fijar una ocupación objetivo de máximo 90 % (unos 540 minutos de consulta por día), con franjas ajustadas a la duración real o cupos de amortiguación, y revisar a diario la carga programada para redistribuir citas antes de que el día comience.
4.3 Integración de interactividad exploratoria
4.3.1 Exploración
autónoma de los días críticos con ggplotly()
Justificación: el gráfico de sobrecarga tiene 2587
días. La versión estática muestra el patrón; la interactiva permite al
directivo explorar por su cuenta: al pasar el mouse ve
la fecha, la carga, la espera y el número de citas de cada día
(tooltip); puede hacer zoom en la zona de
sobrecarga y desplazarse (paneo) para revisar
fechas concretas. (Las etiquetas de ggrepel no se trasladan
a plotly, por eso aquí se reemplazan por el tooltip).
g_int <- ggplot(dia, aes(min_consulta, espera, color = estado,
text = paste0("Fecha: ", appointment_date,
"<br>Minutos de consulta: ", round(min_consulta),
"<br>Espera media: ", round(espera, 1), " min",
"<br>Citas atendidas: ", citas))) +
geom_point(alpha = 0.4, size = 1.3) +
geom_vline(xintercept = 600, linetype = "dashed", color = "grey30") +
scale_color_brewer(palette = "Set1") +
labs(title = "Explore los días: carga de consulta vs. espera media",
x = "Minutos totales de consulta en el día", y = "Espera media del día (min)", color = NULL) +
theme_minimal()
ggplotly(g_int, tooltip = "text")¿Qué evidencia el gráfico? Al explorar la zona derecha se confirma que casi todos los días con espera media superior a una hora tienen más de 600 minutos de consulta. ¿Por qué es relevante para la gestión? Permite a la coordinación buscar fechas específicas y revisar qué pasó (personal, tipo de pacientes, consultas atípicas) sin depender del analista. ¿Qué ruta de acción sugiere? Usar esta vista en el comité mensual para auditar los días críticos y documentar sus causas.
4.3.2 Vista
tridimensional: hora y día de la semana (plotly 3D)
sup <- atendidas %>% group_by(dia_semana, hora) %>%
summarise(espera = mean(waiting_time), .groups = "drop") %>%
pivot_wider(names_from = hora, values_from = espera)
z <- as.matrix(sup[, -1])
plot_ly(x = as.numeric(colnames(z)), y = seq_len(nrow(z)), z = z,
type = "surface", colorscale = "YlOrRd", reversescale = FALSE) %>%
layout(title = "Espera media según hora y día de la semana",
scene = list(xaxis = list(title = "Hora de la cita"),
yaxis = list(title = "Día", tickvals = seq_len(nrow(z)),
ticktext = as.character(sup$dia_semana)),
zaxis = list(title = "Espera media (min)")))¿Qué evidencia el gráfico? La superficie (se puede girar con el mouse) sube con la hora y es casi plana entre los días de la semana: el lunes y el viernes se comportan igual que el resto. ¿Por qué es relevante para la gestión? Descarta que el problema sea un día específico; la causa es la secuencia de cada jornada. ¿Qué ruta de acción sugiere? Aplicar el rediseño de agenda todos los días, no solo en días “pico”.
4.4 Arquitectura del
tablero de control (flexdashboard)
4.4.1 Estructura del tablero
Para el seguimiento directivo se construyó un tablero independiente
con flexdashboard, publicado en: Tablero de
gestión de citas médicas (archivo
Tablero_Citas.Rmd). Su bloque YAML y estructura son:
---
title: "Tablero de gestión: espera y capacidad en consulta externa"
output:
flexdashboard::flex_dashboard:
orientation: rows # disposición por filas, se adapta a la pantalla
vertical_layout: fill
theme: flatly
---Página (=====) |
Fila (-----) |
Componentes |
|---|---|---|
| Panel de control | Fila 1: indicadores | 3 valueBox() (% citas perdidas, espera media, % espera
> 30 min) y 1 gauge() (ocupación de la agenda) |
| Fila 2: análisis | Espera por hora y tendencia de citas perdidas (interactivos) | |
| Días críticos | Columnas | Gráfico interactivo de sobrecarga y superficie 3D |
| Historia y decisiones | Texto | Modelo A³ y recomendaciones ejecutivas |
4.4.2 Indicadores críticos (KPI) para el monitoreo
kpi <- tibble(
Indicador = c("% de citas perdidas", "Espera media (min)", "% de pacientes con espera > 30 min", "Ocupación de la agenda (%)"),
`Valor actual` = round(c(100 * p_perdida, mean(atendidas$waiting_time), p_30, ocupacion), 1),
Meta = c("< 15 %", "< 30 min", "< 25 %", "≤ 90 %"),
Estado = c("Crítico", "Crítico", "Crítico", "Crítico"))
kable(kpi)| Indicador | Valor actual | Meta | Estado |
|---|---|---|---|
| % de citas perdidas | 22.3 | < 15 % | Crítico |
| Espera media (min) | 44.1 | < 30 min | Crítico |
| % de pacientes con espera > 30 min | 53.8 | < 25 % | Crítico |
| Ocupación de la agenda (%) | 96.9 | ≤ 90 % | Crítico |
flexdashboard::gauge(round(ocupacion, 1), min = 0, max = 100, symbol = "%", label = "Ocupación de la agenda",
sectors = flexdashboard::gaugeSectors(success = c(0, 85), warning = c(85, 90), danger = c(90, 100)))¿Qué evidencia? Los cuatro indicadores están en estado crítico; el medidor (gauge) de ocupación marca 96.9 %, en la zona roja. ¿Por qué es relevante para la gestión? Estos cuatro números resumen toda la historia y permiten a la dirección saber en segundos si la situación mejora o empeora. ¿Qué ruta de acción sugiere? Revisar el tablero cada mes en el comité de calidad, con responsables y metas definidas para cada indicador.
4.5 Recomendaciones ejecutivas (Fase de Acción)
- Rediseñar la agenda para bajar la ocupación al 90 %. Pasar de franjas de 15 a 20 minutos en las primeras horas, o mantener 15 minutos y bloquear dos cupos de amortiguación (uno a media mañana y otro al inicio de la tarde). El costo se compensa con el sobreagendamiento controlado de 2 cupos diarios, que aprovecha las inasistencias predecibles (capítulo 2). Meta: espera media menor de 30 minutos y menos del 25 % de pacientes esperando más de 30 minutos en seis meses. Responsable: Coordinación de Consulta Externa.
- Gobernar con datos: tablero mensual y alerta
diaria. Adoptar el tablero
flexdashboarden el comité mensual de calidad y usar el modelo del capítulo 3 durante la jornada: cuando la espera prevista supere 30 minutos, informar al paciente y activar el cupo de amortiguación. Complementar con recordatorios a todos los pacientes para bajar las citas perdidas por debajo del 15 %. Responsable: Oficina de Calidad, con apoyo del área de sistemas.
Conclusiones generales
El informe sigue una línea única: describir → comprobar → predecir → comunicar y decidir.
- EDA (¿qué pasa?): se pierde el 22.3 % de la agenda, el 53.8 % de los pacientes espera más de 30 minutos y la consulta promedio (17.5 min) no cabe en la franja de 15 minutos.
- Probabilidad y estadística (¿es real y de qué depende?): las pérdidas son estables, predecibles (Poisson) y no dependen de ningún grupo; la espera no depende del paciente sino de la hora, y crece unos 6 minutos por cada hora del día.
- Modelo analítico (¿se puede anticipar?): el retraso acumulado explica el 76 % de la variación de la espera, con un error típico de 19.8 minutos.
- Narrativa visual (¿cómo se decide?): la agenda opera al 96.9 % de su capacidad y, en el 40 % de los días que la superan, la espera media llega a 66 minutos. El tablero resume la situación en cuatro indicadores críticos.
Decisiones de gestión recomendadas:
- Recuperar capacidad: recordatorios universales y sobreagendamiento controlado de 2 cupos diarios, con seguimiento mensual del % de citas perdidas.
- Cortar la bola de nieve: ajustar la franja a la duración real de la consulta o dejar cupos libres a media mañana y al mediodía, y controlar las consultas que exceden la franja.
- Gestionar con datos en tiempo real: usar el modelo para estimar la espera durante la jornada, informar al paciente y activar medidas cuando la espera prevista supere 30 minutos.
Referencias
- González Galtier, C. Medical Appointment Scheduling System y EDA Medical Appointment System Dataset. Kaggle.
- Martínez Bautista, H. Explorando medicaldata en R. RPubs. https://rpubs.com/Humberto_Mtz_Bta/1229095
- DavidGS. Regresión lineal múltiple. RPubs. https://rpubs.com/DavidGS/rlm
- Data4HR. Visualización para humanos reales. RPubs. https://rpubs.com/Data4HR/visualizacion-humanos-reales
- R Core Team. R: A language and environment for statistical computing. Paquetes: tidyverse, skimr, janitor, plotly, ggpubr, rsample, broom, yardstick, DiagrammeR, ggrepel, flexdashboard.