La base Medical Appointment Scheduling System tiene 111.488 citas (2015-2024). Dos hechos afectan la calidad de la atención y el uso de recursos:
Se construyen dos modelos con el mismo flujo de trabajo:
waiting_time). Una regresión es un
modelo que predice un número continuo.status = "did not attend"). Una
clasificación predice una categoría (Sí/No).| Modelo | Objetivo de gestión | Métrica | Umbral propuesto |
|---|---|---|---|
| A. Tiempo de espera | Anticipar la espera para reorganizar agendas | RMSE (error típico de predicción, en minutos) | ≤ 20 min |
| A. Tiempo de espera | Explicar la variabilidad de la espera | R² (proporción de variación explicada) | ≥ 0,60 |
| B. Inasistencia | Identificar citas con alto riesgo de no-show | AUC (área bajo la curva ROC; 0,5 = azar, 1 = perfecto) | ≥ 0,70 |
Los umbrales son una propuesta para discutir con la dirección del servicio; no provienen de una norma.
| Variable | Uso | Justificación |
|---|---|---|
appointment_time → hora_dec |
A y B | La espera se acumula durante el día; la hora es un candidato natural. |
appointment_date → dia_sem |
A y B | Puede haber patrones por día de la semana. |
age → edad, sex →
sexo |
A y B | Características del paciente usadas habitualmente en gestión clínica. |
scheduling_interval → intervalo |
A y B | Días entre el agendamiento y la cita; a más días, mayor probabilidad teórica de olvido. |
carga_previa (nueva) |
A (mejora) | Minutos de consulta acumulados por los pacientes anteriores del mismo día. |
waiting_time |
Respuesta de A | Variable que se quiere predecir. |
status |
Respuesta de B | Se usa solo “attended” vs “did not attend”. |
Variables excluidas (para evitar fuga de
información, es decir, usar datos que solo se conocen después del
evento que se quiere predecir): check_in_time,
start_time, end_time y
appointment_duration del propio paciente. Tampoco se usan
los identificadores (appointment_id, slot_id,
patient_id) ni age_group, que repite
age. Las citas cancelled, unknown
y scheduled se excluyen del Modelo B porque su desenlace no
es una asistencia ni una inasistencia.
# El archivo appointments.csv debe estar en la misma carpeta que este .Rmd.
citas <- read_csv(
"appointments.csv",
col_types = cols(
appointment_id = col_character(),
slot_id = col_character(),
patient_id = col_character(),
appointment_time = col_time(),
check_in_time = col_time(),
start_time = col_time(),
end_time = col_time()
)
)
glimpse(citas)## 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-…skim(citas)| Name | citas |
| Number of rows | 111488 |
| Number of columns | 16 |
| _______________________ | |
| Column type frequency: | |
| character | 6 |
| Date | 2 |
| difftime | 4 |
| numeric | 4 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| appointment_id | 0 | 1 | 7 | 7 | 0 | 111488 | 0 |
| slot_id | 0 | 1 | 7 | 7 | 0 | 103646 | 0 |
| status | 0 | 1 | 7 | 14 | 0 | 5 | 0 |
| patient_id | 0 | 1 | 5 | 5 | 0 | 36697 | 0 |
| sex | 0 | 1 | 4 | 6 | 0 | 2 | 0 |
| age_group | 0 | 1 | 3 | 5 | 0 | 16 | 0 |
Variable type: Date
| skim_variable | n_missing | complete_rate | min | max | median | n_unique |
|---|---|---|---|---|---|---|
| scheduling_date | 0 | 1 | 2014-12-09 | 2024-12-01 | 2019-12-14 | 3642 |
| appointment_date | 0 | 1 | 2015-01-01 | 2024-12-24 | 2019-12-20 | 2604 |
Variable type: difftime
| skim_variable | n_missing | complete_rate | min | max | median | n_unique |
|---|---|---|---|---|---|---|
| appointment_time | 0 | 1.00 | 28800 secs | 63900 secs | 45900.0 secs | 40 |
| check_in_time | 25456 | 0.77 | 26191 secs | 65961 secs | 45778.5 secs | 33251 |
| start_time | 25456 | 0.77 | 28829 secs | 80236 secs | 48404.5 secs | 35984 |
| end_time | 25456 | 0.77 | 28860 secs | 81939 secs | 49446.0 secs | 36852 |
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 | ▅▆▇▇▂ |
Las columnas check_in_time, start_time,
end_time, appointment_duration y
waiting_time tienen 25.456 vacíos. Corresponden a las citas
que no se atendieron (canceladas, inasistencias, desconocidas o
programadas), por lo que son vacíos esperados y no errores de
captura.
Distribución de las citas según su estado:
citas %>%
count(status, sort = TRUE) %>%
mutate(porcentaje = round(100 * n / sum(n), 1)) %>%
kable()| status | n | porcentaje |
|---|---|---|
| attended | 86032 | 77.2 |
| cancelled | 18254 | 16.4 |
| did not attend | 6615 | 5.9 |
| unknown | 446 | 0.4 |
| scheduled | 141 | 0.1 |
Interpretación
unknown es un
problema de calidad del registro y scheduled son citas que
seguían pendientes al cierre de la base.Interpretación. La espera tiene una media de 44,1 minutos y una mediana de 33,5, con un máximo de 297,3: la distribución es asimétrica, con cola larga a la derecha. Las citas ocurren entre las 8:00 y las 17:45, la edad va de 15 a 100 años (media de 57) y el intervalo de agendamiento tiene una mediana de 5 días y un máximo de 30. Los 111.488 registros corresponden a 36.697 pacientes, es decir, unas tres citas por paciente.
citas <- citas %>%
mutate(
hora_dec = as.numeric(appointment_time) / 3600, # 8.5 = 8:30 a.m.
dia_sem = factor(wday(appointment_date, week_start = 1),
levels = 1:5, labels = c("Lun", "Mar", "Mie", "Jue", "Vie")),
edad = age,
sexo = factor(sex),
intervalo = scheduling_interval
)
# ---- Datos del Modelo A: solo pacientes atendidos (tienen tiempo de espera)
datos_reg <- citas %>%
filter(status == "attended") %>%
arrange(appointment_date, appointment_time) %>%
group_by(appointment_date) %>%
# minutos de consulta de los pacientes anteriores del mismo día
mutate(carga_previa = cumsum(appointment_duration) - appointment_duration) %>%
ungroup() %>%
select(waiting_time, hora_dec, dia_sem, edad, sexo, intervalo, carga_previa) %>%
drop_na()
# ---- Datos del Modelo B: asistió vs. no asistió
datos_cls <- citas %>%
filter(status %in% c("attended", "did not attend")) %>%
mutate(no_asiste = factor(if_else(status == "did not attend", "Si", "No"),
levels = c("Si", "No"))) %>% # "Si" = evento de interés
select(no_asiste, hora_dec, dia_sem, edad, sexo, intervalo) %>%
drop_na()
c(filas_modelo_A = nrow(datos_reg), filas_modelo_B = nrow(datos_cls))## filas_modelo_A filas_modelo_B
## 86032 92647prop.table(table(datos_cls$no_asiste)) # proporción de inasistencia##
## Si No
## 0.07140005 0.92859995Interpretación. Los 86.032 registros del Modelo A coinciden con el total de citas atendidas, y los 92.647 del Modelo B con atendidas más inasistencias (86.032 + 6.615): la limpieza no eliminó ninguna fila. La inasistencia es del 7,1 %, así que las clases están desbalanceadas: un modelo que siempre prediga “asiste” acertaría el 92,9 % de las veces sin detectar ningún no-show. Por eso el Modelo B se evalúa con el AUC y no con la exactitud.
1. Cargar datos y construir variables (hora decimal, día de la semana, carga previa)
2. Separar los datos: 75 % entrenamiento, 25 % prueba
3. Modelo A: espera ~ hora + día + edad + sexo + intervalo (lm)
Mejora: espera ~ ... + carga_previa
4. Modelo B: no_asiste ~ hora + día + edad + sexo + intervalo (glm y rf)
5. Diagnosticar residuos (diferencia entre lo observado y lo predicho)
6. Comparar métricas entre entrenamiento y prueba (RMSE / AUC)
7. Interpretar y proponer mejorasset.seed(2026) # semilla: permite repetir exactamente la misma partición
div_reg <- initial_split(datos_reg, prop = 0.75)
train_reg <- training(div_reg)
test_reg <- testing(div_reg)
div_cls <- initial_split(datos_cls, prop = 0.75, strata = no_asiste) # conserva la proporción de no-show
train_cls <- training(div_cls)
test_cls <- testing(div_cls)
levels(train_cls$no_asiste) # debe salir "Si" "No"## [1] "Si" "No"tibble(
conjunto = c("Entrenamiento A", "Prueba A", "Entrenamiento B", "Prueba B"),
filas = c(nrow(train_reg), nrow(test_reg), nrow(train_cls), nrow(test_cls))
) %>% kable()| conjunto | filas |
|---|---|
| Entrenamiento A | 64524 |
| Prueba A | 21508 |
| Entrenamiento B | 69485 |
| Prueba B | 23162 |
Interpretación. La partición 75/25 dejó 64.524 filas
de entrenamiento y 21.508 de prueba para el Modelo A, y 69.485 y 23.162
para el Modelo B. Las sumas coinciden con los datos de la sección 3.2.3
(86.032 y 92.647). Al estratificar por no_asiste, la
proporción de inasistencia se conserva en la prueba (7,2 %), y el evento
de interés “Si” es el primer nivel del factor.
Gráfico 3D 1: relación entre hora de la cita, edad del paciente y tiempo de espera (muestra de 3.000 pacientes para que el gráfico sea fluido).
muestra <- slice_sample(train_reg, n = 3000)
plot_ly(muestra, x = ~hora_dec, y = ~edad, z = ~waiting_time,
type = "scatter3d", mode = "markers",
marker = list(size = 2, color = ~waiting_time, colorscale = "Viridis",
showscale = TRUE, colorbar = list(title = "Espera (min)"))) %>%
layout(scene = list(xaxis = list(title = "Hora de la cita"),
yaxis = list(title = "Edad (años)"),
zaxis = list(title = "Espera (min)")))m_base <- lm(waiting_time ~ hora_dec + dia_sem + edad + sexo + intervalo,
data = train_reg)
tidy(m_base) %>%
mutate(across(where(is.numeric), ~ round(.x, 4))) %>%
kable(caption = "Coeficientes del modelo base")| term | estimate | std.error | statistic | p.value |
|---|---|---|---|---|
| (Intercept) | -25.7047 | 0.8682 | -29.6073 | 0.0000 |
| hora_dec | 5.4973 | 0.0512 | 107.3336 | 0.0000 |
| dia_semMar | -0.5317 | 0.4689 | -1.1340 | 0.2568 |
| dia_semMie | -0.5150 | 0.4689 | -1.0983 | 0.2721 |
| dia_semJue | -0.0518 | 0.4680 | -0.1107 | 0.9118 |
| dia_semVie | -2.9544 | 0.4674 | -6.3210 | 0.0000 |
| edad | -0.0080 | 0.0074 | -1.0787 | 0.2807 |
| sexoMale | -0.0043 | 0.3052 | -0.0141 | 0.9888 |
| intervalo | 0.0391 | 0.0241 | 1.6196 | 0.1053 |
Interpretación. Cada hora adicional del día suma en promedio 5,5 minutos de espera (p < 0,0001), y los viernes la espera es unos 3 minutos menor que los lunes (p < 0,0001). Edad, sexo, intervalo de agendamiento y los demás días de la semana no son significativos (p > 0,05). El intercepto no tiene lectura práctica, porque corresponde a la hora 0.
La función geom_residuals() no existe en
ggplot2; el equivalente es graficar la columna
.resid que entrega broom::augment() con
geom_point().
diag_base <- augment(m_base)
diag_muestra <- slice_sample(diag_base, n = 5000)
# Homocedasticidad: la dispersión de los residuos debe ser parecida en todo el rango de valores ajustados
g_res <- ggplot(diag_muestra, aes(x = .fitted, y = .resid)) +
geom_point(alpha = 0.25) +
geom_hline(yintercept = 0, colour = "red") +
geom_smooth(se = FALSE, colour = "blue") +
labs(title = "Residuos vs. valores ajustados",
x = "Espera predicha (min)", y = "Residuo (min)")
ggplotly(g_res)# Normalidad aproximada: los puntos deben seguir la línea roja.
# Los cuantiles se calculan a mano porque ggplotly() no admite stat_qq_line().
datos_qq <- diag_muestra %>%
arrange(.std.resid) %>%
mutate(teorico = qnorm(ppoints(n()))) # cuantiles de una distribución normal
g_qq <- ggplot(datos_qq, aes(x = teorico, y = .std.resid)) +
geom_point(alpha = 0.3) +
geom_line(aes(y = teorico), colour = "red") + # línea de referencia: normalidad perfecta
labs(title = "Gráfico cuantil-cuantil de los residuos",
x = "Cuantiles teóricos", y = "Residuos estandarizados")
ggplotly(g_qq)La ingeniería de variables consiste en crear variables nuevas a
partir de las existentes. Aquí se agrega carga_previa: los
minutos de consulta acumulados por los pacientes anteriores del mismo
día. Es información disponible en tiempo real cuando el paciente
llega.
m_mej <- lm(waiting_time ~ hora_dec + dia_sem + edad + sexo + intervalo + carga_previa,
data = train_reg)
pred_tr_base <- predict(m_base, train_reg)
pred_te_base <- predict(m_base, test_reg)
pred_tr_mej <- predict(m_mej, train_reg)
pred_te_mej <- predict(m_mej, test_reg)
media_tr <- mean(train_reg$waiting_time)
tabla_reg <- tibble(
Modelo = c("Referencia (promedio)", "A. Modelo base", "A. Modelo mejorado"),
RMSE_train = c(rmse_vec(train_reg$waiting_time, rep(media_tr, nrow(train_reg))),
rmse_vec(train_reg$waiting_time, pred_tr_base),
rmse_vec(train_reg$waiting_time, pred_tr_mej)),
RMSE_test = c(rmse_vec(test_reg$waiting_time, rep(media_tr, nrow(test_reg))),
rmse_vec(test_reg$waiting_time, pred_te_base),
rmse_vec(test_reg$waiting_time, pred_te_mej)),
R2_train = c(NA, rsq_vec(train_reg$waiting_time, pred_tr_base),
rsq_vec(train_reg$waiting_time, pred_tr_mej)),
R2_test = c(NA, rsq_vec(test_reg$waiting_time, pred_te_base),
rsq_vec(test_reg$waiting_time, pred_te_mej))
) %>% mutate(across(where(is.numeric), ~ round(.x, 3)))
kable(tabla_reg, caption = "Modelo A: métricas en entrenamiento y prueba (RMSE en minutos)")| Modelo | RMSE_train | RMSE_test | R2_train | R2_test |
|---|---|---|---|---|
| Referencia (promedio) | 40.828 | 40.670 | NA | NA |
| A. Modelo base | 37.594 | 37.494 | 0.152 | 0.150 |
| A. Modelo mejorado | 19.817 | 19.881 | 0.764 | 0.761 |
Gráfico 3D 2: superficie de espera predicha por el modelo mejorado según la hora y la carga previa (los demás factores se fijan en un paciente típico).
horas <- seq(8, 17.75, length.out = 30)
cargas <- seq(0, quantile(train_reg$carga_previa, 0.99), length.out = 30)
malla <- expand.grid(hora_dec = horas, carga_previa = cargas)
malla$dia_sem <- factor("Lun", levels = levels(train_reg$dia_sem))
malla$edad <- median(train_reg$edad)
malla$sexo <- factor("Female", levels = levels(train_reg$sexo))
malla$intervalo <- median(train_reg$intervalo)
malla$pred <- predict(m_mej, malla)
# filas = carga previa, columnas = hora
z <- matrix(malla$pred, nrow = length(cargas), ncol = length(horas), byrow = TRUE)
plot_ly(x = horas, y = cargas, z = z, type = "surface", colorscale = "Viridis") %>%
layout(scene = list(xaxis = list(title = "Hora de la cita"),
yaxis = list(title = "Carga previa del día (min)"),
zaxis = list(title = "Espera predicha (min)")))Interpretación. El modelo base mejora poco a la
referencia (RMSE de 37,5 frente a 40,7 minutos y R² de 0,15). Al agregar
carga_previa, el RMSE de prueba baja a 19,9 minutos y el R²
sube a 0,76, con lo que se cumplen las metas de la sección 3.1.2 (≤ 20
minutos y ≥ 0,60), aunque el RMSE queda muy cerca del límite. Las
métricas de entrenamiento y prueba son casi iguales (R² de 0,764 y
0,761), por lo que no hay sobreajuste.
library(caret)
library(ranger)
library(yardstick)
set.seed(2026)
ctrl <- trainControl(method = "cv", number = 5, classProbs = TRUE,
summaryFunction = twoClassSummary)
# Regresión logística con validación cruzada
m_glm <- train(no_asiste ~ ., data = train_cls, method = "glm",
family = "binomial", metric = "ROC", trControl = ctrl)
# Bosque aleatorio regularizado (nodos grandes = menos sobreajuste)
m_rf <- train(no_asiste ~ ., data = train_cls, method = "ranger",
metric = "ROC", trControl = ctrl, num.trees = 200,
tuneGrid = expand.grid(mtry = c(2, 4),
splitrule = "gini",
min.node.size = c(100, 300)))
m_rf$bestTune # parámetros elegidos## mtry splitrule min.node.size
## 2 2 gini 300# Probabilidad predicha de "no asiste" (columna Si)
p_glm_tr <- predict(m_glm, train_cls, type = "prob")$Si
p_glm_te <- predict(m_glm, test_cls, type = "prob")$Si
p_rf_tr <- predict(m_rf, train_cls, type = "prob")$Si
p_rf_te <- predict(m_rf, test_cls, type = "prob")$Si
tabla_cls <- tibble(
Modelo = c("B. Regresión logística (glm)", "B. Bosque aleatorio (rf)"),
AUC_train = c(roc_auc_vec(train_cls$no_asiste, p_glm_tr),
roc_auc_vec(train_cls$no_asiste, p_rf_tr)),
AUC_test = c(roc_auc_vec(test_cls$no_asiste, p_glm_te),
roc_auc_vec(test_cls$no_asiste, p_rf_te))
) %>% mutate(across(where(is.numeric), ~ round(.x, 3)))
kable(tabla_cls, caption = "Modelo B: AUC en entrenamiento y prueba (0,5 = azar)")| Modelo | AUC_train | AUC_test |
|---|---|---|
| B. Regresión logística (glm) | 0.509 | 0.484 |
| B. Bosque aleatorio (rf) | 0.719 | 0.490 |
roc_glm <- roc_curve(tibble(truth = test_cls$no_asiste, Si = p_glm_te), truth, Si)
roc_glm$modelo <- "glm"
roc_rf <- roc_curve(tibble(truth = test_cls$no_asiste, Si = p_rf_te), truth, Si)
roc_rf$modelo <- "rf"
curvas <- bind_rows(roc_glm, roc_rf)
curvas$falsos_pos <- 1 - curvas$specificity
plot_ly(curvas, x = ~falsos_pos, y = ~sensitivity, color = ~modelo,
type = "scatter", mode = "lines") %>%
layout(title = "Curva ROC en el conjunto de prueba (la diagonal equivale al azar)",
xaxis = list(title = "1 - Especificidad (falsos positivos)"),
yaxis = list(title = "Sensibilidad (verdaderos positivos)"))Modelo A (tiempo de espera). Con los datos de
prueba, el modelo base tiene un RMSE de 37,5 minutos frente a 40,7 de la
referencia (predecir siempre el promedio), y un R² de 0,15. Casi toda la
mejora proviene de hora_dec: la espera crece a lo largo de
la jornada porque los retrasos se acumulan. Edad, sexo, día de la semana
e intervalo de agendamiento aportan muy poco. El modelo base no
cumple los umbrales de la sección 3.1.2.
Al incorporar carga_previa, el RMSE de prueba baja a
19,9 minutos y el R² sube a 0,76. Esto sugiere que la espera depende
sobre todo de cuánto se han demorado las consultas anteriores del día y
no de las características del paciente. La superficie 3D lo muestra: la
espera predicha aumenta con ambas variables. El modelo mejorado
sí cumple los umbrales de la sección 3.1.2 (RMSE ≤ 20
minutos y R² ≥ 0,60), aunque el RMSE queda muy cerca del límite.
Diagnóstico. El gráfico de residuos contra valores ajustados muestra que la dispersión aumenta cuando la espera predicha es alta (falta de homocedasticidad), y el gráfico cuantil-cuantil se separa de la línea roja en los extremos (falta de normalidad). Las predicciones puntuales siguen siendo utilizables, pero los intervalos de confianza y los valores p del modelo deben leerse con cautela.
Comparación entrenamiento vs. prueba. En la regresión lineal las diferencias son mínimas (R² de 0,764 en entrenamiento y 0,761 en prueba), así que no hay sobreajuste. En el Modelo B, el bosque aleatorio alcanza un AUC de 0,72 en entrenamiento y 0,49 en prueba: aun con la regularización (nodos de al menos 300 observaciones y validación cruzada), memoriza parte de los datos de entrenamiento y no generaliza.
Tasa de inasistencia (%) según cada variable:
datos_cls %>%
mutate(grupo_edad = as.character(cut(edad, c(0, 40, 60, 75, 100))),
franja = as.character(cut(hora_dec, c(0, 10, 12, 14, 18), right = FALSE)),
grupo_int = as.character(cut(intervalo, c(0, 3, 7, 14, 30))),
dia_sem = as.character(dia_sem)) %>%
pivot_longer(c(grupo_edad, dia_sem, franja, grupo_int),
names_to = "variable", values_to = "grupo") %>%
group_by(variable, grupo) %>%
summarise(tasa_no_show = round(100 * mean(no_asiste == "Si"), 1),
citas = n(), .groups = "drop") %>%
kable(caption = "Tasa de inasistencia por grupo (%)")| variable | grupo | tasa_no_show | citas |
|---|---|---|---|
| dia_sem | Jue | 7.2 | 18503 |
| dia_sem | Lun | 7.1 | 18546 |
| dia_sem | Mar | 7.3 | 18507 |
| dia_sem | Mie | 7.2 | 18520 |
| dia_sem | Vie | 7.0 | 18571 |
| franja | [0,10) | 7.1 | 18511 |
| franja | [10,12) | 7.2 | 18523 |
| franja | [12,14) | 7.0 | 18474 |
| franja | [14,18) | 7.2 | 37139 |
| grupo_edad | (0,40] | 7.0 | 23649 |
| grupo_edad | (40,60] | 7.4 | 24656 |
| grupo_edad | (60,75] | 7.0 | 23697 |
| grupo_edad | (75,100] | 7.2 | 20645 |
| grupo_int | (0,3] | 7.1 | 32989 |
| grupo_int | (14,30] | 7.2 | 12166 |
| grupo_int | (3,7] | 7.2 | 25779 |
| grupo_int | (7,14] | 7.1 | 21713 |
Modelo B (inasistencia). El AUC de prueba es 0,48 para la regresión logística y 0,49 para el bosque aleatorio, es decir, cercano a 0,5 (equivale a clasificar al azar) y lejos del 0,70 propuesto. Con estas variables no es posible predecir quién faltará. La tasa de inasistencia ronda el 7 % en todas las edades, franjas horarias, días e intervalos de agendamiento (ver tabla anterior), así que no hay un patrón que los modelos puedan aprender. La matriz de confusión lo confirma: con el umbral de 0,5, el bosque aleatorio clasifica todas las citas como asistidas (sensibilidad de 0). Se trata de un resultado válido: indica que el problema requiere otra información, no otro algoritmo.
carga_previa redujo el error de forma sustancial. Se pueden
crear variables en la misma línea, como el retraso acumulado en la
última hora, el número de pacientes ya atendidos en el día o la duración
promedio de las últimas consultas. Para el Modelo B, se podría evaluar
el historial de inasistencias previas de cada paciente, si la base lo
permite. Una limitación: carga_previa suma la duración de
las consultas de los pacientes anteriores, y algunas pueden no haber
terminado cuando llega el paciente. Es probable que parte de su fuerte
capacidad predictiva se deba a eso. Para uso real habría que calcularla
solo con las consultas ya finalizadas en el momento de la llegada.log(waiting_time) puede corregir la asimetría y la
heterocedasticidad de los residuos. Para el Modelo B, con una clase
minoritaria de 7 %, las técnicas de balanceo o un umbral de decisión
menor a 0,5 harían que el modelo marque algunas citas como de riesgo,
pero con un AUC cercano a 0,5 no mejorarían su capacidad de distinguir
quién faltará. Primero hacen falta variables nuevas.