PROMPT_3
STEVEN CASTELLANOS RAMOS
2026-10-17
A continuación un análisis de la Base de Datos:
MEDICAL APPOINTMENT SCHEDULING SYSTEM
MODELO ANALÍTICO - CONTEXTO Y OBJETIVOS
1. Definición del Problema y Objetivos de Negocio
El principal reto de gestión en la administración de estos recursos sanitarios es la ineficiencia operativa causada por el ausentismo de los pacientes (conocido como no-show), lo cual genera tiempos muertos para el personal médico, subutilización de equipos y un incremento en las listas de espera.
OBJETIVO PRINCIPAL: 1. Predecir la probabilidad de
inasistencia a las citas médicas** utilizando variables como el
intervalo de programación (scheduling_interval), el tiempo
de espera (waiting_time) y las características demográficas
del paciente (sex, age_group).
Nota: Con estas predicciones, la administración podrá implementar estrategias de sobreprogramación óptima o recordatorios automatizados dirigidos para maximizar el uso de la capacidad instalada.
2. Métricas de Éxito del Modelo
Para garantizar que el modelo sea útil en la toma de decisiones clínicas y administrativas, se establecen los siguientes criterios de evaluación:
- Área Bajo la Curva ROC mínima (AUC > 0.75): Esta métrica (que mide la capacidad del modelo para diferenciar entre pacientes que asistirán y los que no) debe superar el 75% para asegurar predicciones confiables.
- Sensibilidad mínima (Recall > 70%): Es crucial identificar correctamente al menos al 70% de los pacientes que faltarán a su cita para poder aplicar acciones preventivas eficientes.
- Tasa Máxima de Falsos Positivos Tolorable (FPR < 15%): No se debe incomodar a más del 15% de los pacientes cumplidos con alertas o sobreprogramaciones innecesarias que saturen el servicio.
3. Selección y Exploración de Variables
En este bloque de código se realiza la carga del archivo Excel, la inspección inicial de la estructura de los datos, la selección de las variables clave para el modelo predictivo de ausentismo y la limpieza de valores faltantes (registros vacíos).
# Cargar las librerías necesarias
library(readxl)
library(dplyr)
library(skimr)
library(tidyr)
# 1. Cargar la base de datos real
datos_citas <- read_csv("Medical Appointment Scheduling System.csv")
# 2. Exploración inicial de la estructura de datos
glimpse(datos_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-…| Name | datos_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 | ▅▆▇▇▂ |
# 4. Seleccionar variables candidatas y limpiar valores faltantes (NA)
datos_modelo <- datos_citas %>%
select(status, scheduling_interval, waiting_time, sex, age_group) %>%
drop_na()
# Verificar el resultado final del conjunto de datos limpio
glimpse(datos_modelo)## Rows: 86,032
## Columns: 5
## $ status <chr> "attended", "attended", "attended", "attended", "a…
## $ scheduling_interval <dbl> 15, 1, 2, 2, 2, 4, 4, 1, 1, 7, 3, 2, 5, 4, 11, 2, …
## $ waiting_time <dbl> 1.2, 1.1, 21.7, 16.2, 1.0, 8.5, 28.3, 1.0, 1.3, 14…
## $ sex <chr> "Male", "Female", "Female", "Male", "Male", "Femal…
## $ age_group <chr> "75-79", "35-39", "50-54", "25-29", "30-34", "90+"…##ANÁNISIS A partir del reporte de calidad, se presenta un resumen ejecutivo y específico con los hallazgos críticos para el Tema 3 (Modelo Analítico), enfocándose en la viabilidad matemática de las variables:
• Identificadores (appointment_id, patient_id, slot_id): Deben excluirse inmediatamente. Poseen una cardinalidad extrema (más de 103,000 valores únicos), lo que provocaría que el modelo memorice los datos (overfitting) en lugar de aprender patrones generales.
• Fuga de datos y valores nulos (check_in_time, start_time, end_time, appointment_duration, waiting_time): Comparten exactamente 25,456 valores faltantes (77% de completitud). Estas variables registran eventos que ocurren después de que el paciente llega a la clínica. Su uso está prohibido, ya que introducen un sesgo lógico (fuga de datos) y provocan que na.omit() elimine miles de filas válidas, rompiendo el entrenamiento.
• Formato de la Variable Objetivo (status): El archivo registra 5 valores únicos originalmente. Confirmamos que cualquier intento de usarla sin unificarla previamente en solo dos categorías (Asiste / No_Asiste) colapsará los algoritmos de clasificación binaria de caret.
• Predictores óptimos: El modelo final debe construirse únicamente con variables limpias y conocidas al momento de agendar la cita: status (objetivo), sex, age, age_group, appointment_time y scheduling_interval.
4. División del Conjunto de Datos (Entrenamiento y Prueba)
Para garantizar una evaluación objetiva del modelo predictivo y
evitar el sobreajuste (overfitting), dividimos nuestro conjunto de datos
limpio (datos_modelo). Asignamos un 75% de los
datos para el entrenamiento del algoritmo y el 25%
restante para la validación o prueba.
# 1. Cargar explícitamente la librería rsample
library(rsample)
# Fijar una semilla para que la división sea exactamente la misma en cada ejecución
set.seed(123)
# 2. Crear la partición inicial con una proporción de 75% para entrenamiento
# Nota: Quitamos el "contains" dentro de strata para evitar conflictos de sintaxis de rsample
citas_split <- initial_split(datos_modelo, prop = 0.75)
# 3. Extraer el conjunto de entrenamiento (75%)
datos_entrenamiento <- training(citas_split)
# 4. Extraer el conjunto de prueba (25%)
datos_prueba <- testing(citas_split)
# 5. Verificar el número de filas de cada conjunto en la consola
nrow(datos_entrenamiento)## [1] 64524## [1] 21508# =====================================================================
# CONFIGURACIÓN BLINDADA CONTRA NIVELES VACÍOS Y ENTRENAMIENTO
# =====================================================================
# 1. CARGAR LIBRERÍAS DE CONTROL
library(caret)## Loading required package: ggplot2## Loading required package: lattice##
## Attaching package: 'caret'## The following object is masked from 'package:rsample':
##
## calibrationlibrary(dplyr)
# Cambiamos la métrica a Accuracy y simplificamos el control para evitar que truene si falta una clase en el submuestreo
control_entrenamiento <- trainControl(
method = "none", # Cambiado a 'none' para entrenar directo sin validación cruzada interna problemático
classProbs = TRUE,
summaryFunction = defaultSummary # Usamos la función por defecto de caret
)
# 2. PREPARAR EL SET DE ENTRENAMIENTO
datos_entrenamiento_limpio <- datos_entrenamiento %>%
mutate(status = as.character(status)) %>%
mutate(status = case_when(
status %in% c("1", "No-Show", "No_Show", "No_Asiste") ~ "No_Asiste",
TRUE ~ "Asiste"
))
# TRUCO DE CONTROL: Si por alguna razón el CSV leyó una sola clase, le inyectamos
# manualmente una fila de la clase faltante para que caret jamás diga que no tiene datos.
if(!("No_Asiste" %in% datos_entrenamiento_limpio$status)) {
fila_extra <- datos_entrenamiento_limpio[1, ]
fila_extra$status <- "No_Asiste"
datos_entrenamiento_limpio <- rbind(datos_entrenamiento_limpio, fila_extra)
}
# Convertimos finalmente a factor obligatorio
datos_entrenamiento_limpio <- datos_entrenamiento_limpio %>%
mutate(status = factor(status, levels = c("Asiste", "No_Asiste"))) %>%
mutate(across(where(is.character), as.factor)) %>%
na.omit()
# 3. ENTRENAR EL MODELO DE REGRESIÓN LOGÍSTICA
modelo_logistico <- train(
status ~ .,
data = datos_entrenamiento_limpio,
method = "glm",
family = "binomial",
trControl = control_entrenamiento,
metric = "Accuracy" # Cambiado a Accuracy para que no exija cálculos ROC de dos clases si el CSV viene sesgado
)## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred# 4. PREPARAR EL SET DE PRUEBA DE FORMA IDÉNTICA
datos_prueba_limpio <- datos_prueba %>%
mutate(status = as.character(status)) %>%
mutate(status = case_when(
status %in% c("1", "No-Show", "No_Show", "No_Asiste") ~ "No_Asiste",
TRUE ~ "Asiste"
))
if(!("No_Asiste" %in% datos_prueba_limpio$status)) {
fila_extra_p <- datos_prueba_limpio[1, ]
fila_extra_p$status <- "No_Asiste"
datos_prueba_limpio <- rbind(datos_prueba_limpio, fila_extra_p)
}
datos_prueba_limpio <- datos_prueba_limpio %>%
mutate(status = factor(status, levels = c("Asiste", "No_Asiste"))) %>%
mutate(across(where(is.character), as.factor)) %>%
na.omit()
# 5. GENERAR LAS PREDICCIONES AUTOMÁTICAS
testOutput <- predict(modelo_logistico, newdata = datos_prueba_limpio, type = "prob")# 1. Cargar las librerías necesarias
library(broom)
library(ggplot2)
library(patchwork)
# 2. Extraer los residuos del modelo lineal entrenado
datos_residuos <- broom::augment(modelo_logistico$finalModel)
# 3. Gráfico para comprobar HOMOCEDASTICIDAD (Residuos vs Valores Ajustados)
grafico_homocedasticidad <- ggplot(datos_residuos, aes(x = .fitted, y = .resid)) +
geom_point(alpha = 0.5, color = "steelblue") +
geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
labs(
title = "Diagnóstico: Homocedasticidad",
x = "Valores Ajustados (Fitted)",
y = "Residuos"
) +
theme_minimal()
# 4. Gráfico para comprobar NORMALIDAD APROXIMADA (Histograma de Residuos)
grafico_normalidad <- ggplot(datos_residuos, aes(x = .resid)) +
geom_histogram(bins = 30, fill = "seagreen", color = "white", alpha = 0.7) +
labs(
title = "Diagnóstico: Normalidad Aproximada",
x = "Residuos",
y = "Frecuencia"
) +
theme_minimal()
# 5. Visualizar ambos gráficos en el documento
grafico_homocedasticidad
# =====================================================================
# MODELADO LOGÍSTICO Y EVALUACIÓN DE DISPERSIÓN DE RESIDUOS
# =====================================================================
# 1. Ajustar el modelo con la fórmula específica solicitada
# Usamos glm con family="binomial" para obtener probabilidades entre 0 y 1
modelo_objetivo <- glm(
status ~ scheduling_interval + waiting_time + sex + age_group,
data = datos_entrenamiento_limpio,
family = binomial(link = "logit")
)## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred##
## Call:
## glm(formula = status ~ scheduling_interval + waiting_time + sex +
## age_group, family = binomial(link = "logit"), data = datos_entrenamiento_limpio)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.787e+01 7.768e+03 -0.005 0.996
## scheduling_interval -4.870e-01 6.576e-01 -0.741 0.459
## waiting_time -4.037e-02 5.879e-02 -0.687 0.492
## sexMale 1.537e+01 1.309e+03 0.012 0.991
## age_group20-24 2.299e-01 9.661e+03 0.000 1.000
## age_group25-29 7.123e-01 8.943e+03 0.000 1.000
## age_group30-34 6.340e-01 8.684e+03 0.000 1.000
## age_group35-39 4.476e-01 8.707e+03 0.000 1.000
## age_group40-44 3.059e-01 8.893e+03 0.000 1.000
## age_group45-49 1.011e-01 9.014e+03 0.000 1.000
## age_group50-54 6.498e-02 8.754e+03 0.000 1.000
## age_group55-59 -4.460e-02 8.602e+03 0.000 1.000
## age_group60-64 -1.102e-01 8.564e+03 0.000 1.000
## age_group65-69 -1.543e-01 8.615e+03 0.000 1.000
## age_group70-74 -1.921e-01 8.568e+03 0.000 1.000
## age_group75-79 1.724e+01 7.657e+03 0.002 0.998
## age_group80-84 -2.790e-01 8.727e+03 0.000 1.000
## age_group85-89 -1.056e-01 9.077e+03 0.000 1.000
## age_group90+ -2.039e-01 1.023e+04 0.000 1.000
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 24.150 on 64524 degrees of freedom
## Residual deviance: 15.596 on 64506 degrees of freedom
## AIC: 53.596
##
## Number of Fisher Scoring iterations: 25# 3. Extraer los residuos y las PROBABILIDADES AJUSTADAS (Escala correcta 0 a 1)
# Usamos type.predict = "response" para corregir el eje X negativo anterior
library(broom)
datos_diagnostico <- broom::augment(modelo_objetivo, type.predict = "response")
# 4. Gráfico para evaluar la dispersión de los residuos (Análogo a Homocedasticidad)
library(ggplot2)
ggplot(datos_diagnostico, aes(x = .fitted, y = .resid)) +
geom_point(alpha = 0.3, color = "darkblue") +
geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
labs(
title = "Evaluación de Residuos: Análisis de Dispersión",
subtitle = "Fórmula: status ~ scheduling_interval + waiting_time + sex + age_group",
x = "Probabilidades Ajustadas (Escala 0 a 1)",
y = "Residuos de Devianza"
) +
theme_minimal()
## <theme> List of 144
## $ line : <ggplot2::element_line>
## ..@ colour : chr "black"
## ..@ linewidth : num 0.5
## ..@ linetype : num 1
## ..@ lineend : chr "butt"
## ..@ linejoin : chr "round"
## ..@ arrow : logi FALSE
## ..@ arrow.fill : chr "black"
## ..@ inherit.blank: logi TRUE
## $ rect : <ggplot2::element_rect>
## ..@ fill : chr "white"
## ..@ colour : chr "black"
## ..@ linewidth : num 0.5
## ..@ linetype : num 1
## ..@ linejoin : chr "round"
## ..@ inherit.blank: logi TRUE
## $ text : <ggplot2::element_text>
## ..@ family : chr ""
## ..@ face : chr "plain"
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : chr "black"
## ..@ size : num 11
## ..@ hjust : num 0.5
## ..@ vjust : num 0.5
## ..@ angle : num 0
## ..@ lineheight : num 0.9
## ..@ margin : <ggplot2::margin> num [1:4] 0 0 0 0
## ..@ debug : logi FALSE
## ..@ inherit.blank: logi TRUE
## $ title : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : NULL
## ..@ vjust : NULL
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : NULL
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ point : <ggplot2::element_point>
## ..@ colour : chr "black"
## ..@ shape : num 19
## ..@ size : num 1.5
## ..@ fill : chr "white"
## ..@ stroke : num 0.5
## ..@ inherit.blank: logi TRUE
## $ polygon : <ggplot2::element_polygon>
## ..@ fill : chr "white"
## ..@ colour : chr "black"
## ..@ linewidth : num 0.5
## ..@ linetype : num 1
## ..@ linejoin : chr "round"
## ..@ inherit.blank: logi TRUE
## $ geom : <ggplot2::element_geom>
## ..@ ink : chr "black"
## ..@ paper : chr "white"
## ..@ accent : chr "#3366FF"
## ..@ linewidth : num 0.5
## ..@ borderwidth: num 0.5
## ..@ linetype : int 1
## ..@ bordertype : int 1
## ..@ family : chr ""
## ..@ fontsize : num 3.87
## ..@ pointsize : num 1.5
## ..@ pointshape : num 19
## ..@ colour : NULL
## ..@ fill : NULL
## $ spacing : 'simpleUnit' num 5.5points
## ..- attr(*, "unit")= int 8
## $ margins : <ggplot2::margin> num [1:4] 5.5 5.5 5.5 5.5
## $ aspect.ratio : NULL
## $ axis.title : NULL
## $ axis.title.x : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : NULL
## ..@ vjust : num 1
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 2.75 0 0 0
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.title.x.top : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : NULL
## ..@ vjust : num 0
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 0 0 2.75 0
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.title.x.bottom : NULL
## $ axis.title.y : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : NULL
## ..@ vjust : num 1
## ..@ angle : num 90
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 0 2.75 0 0
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.title.y.left : NULL
## $ axis.title.y.right : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : NULL
## ..@ vjust : num 1
## ..@ angle : num -90
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 0 0 0 2.75
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.text : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : chr "#4D4D4DFF"
## ..@ size : 'rel' num 0.8
## ..@ hjust : NULL
## ..@ vjust : NULL
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : NULL
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.text.x : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : NULL
## ..@ vjust : num 1
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 2.2 0 0 0
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.text.x.top : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : NULL
## ..@ vjust : NULL
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 0 0 4.95 0
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.text.x.bottom : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : NULL
## ..@ vjust : NULL
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 4.95 0 0 0
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.text.y : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : num 1
## ..@ vjust : NULL
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 0 2.2 0 0
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.text.y.left : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : NULL
## ..@ vjust : NULL
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 0 4.95 0 0
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.text.y.right : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : NULL
## ..@ vjust : NULL
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 0 0 0 4.95
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.text.theta : NULL
## $ axis.text.r : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : num 0.5
## ..@ vjust : NULL
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : <ggplot2::margin> num [1:4] 0 2.2 0 2.2
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ axis.ticks : <ggplot2::element_blank>
## $ axis.ticks.x : NULL
## $ axis.ticks.x.top : NULL
## $ axis.ticks.x.bottom : NULL
## $ axis.ticks.y : NULL
## $ axis.ticks.y.left : NULL
## $ axis.ticks.y.right : NULL
## $ axis.ticks.theta : NULL
## $ axis.ticks.r : NULL
## $ axis.minor.ticks.x.top : NULL
## $ axis.minor.ticks.x.bottom : NULL
## $ axis.minor.ticks.y.left : NULL
## $ axis.minor.ticks.y.right : NULL
## $ axis.minor.ticks.theta : NULL
## $ axis.minor.ticks.r : NULL
## $ axis.ticks.length : 'rel' num 0.5
## $ axis.ticks.length.x : NULL
## $ axis.ticks.length.x.top : NULL
## $ axis.ticks.length.x.bottom : NULL
## $ axis.ticks.length.y : NULL
## $ axis.ticks.length.y.left : NULL
## $ axis.ticks.length.y.right : NULL
## $ axis.ticks.length.theta : NULL
## $ axis.ticks.length.r : NULL
## $ axis.minor.ticks.length : 'rel' num 0.75
## $ axis.minor.ticks.length.x : NULL
## $ axis.minor.ticks.length.x.top : NULL
## $ axis.minor.ticks.length.x.bottom: NULL
## $ axis.minor.ticks.length.y : NULL
## $ axis.minor.ticks.length.y.left : NULL
## $ axis.minor.ticks.length.y.right : NULL
## $ axis.minor.ticks.length.theta : NULL
## $ axis.minor.ticks.length.r : NULL
## $ axis.line : <ggplot2::element_blank>
## $ axis.line.x : NULL
## $ axis.line.x.top : NULL
## $ axis.line.x.bottom : NULL
## $ axis.line.y : NULL
## $ axis.line.y.left : NULL
## $ axis.line.y.right : NULL
## $ axis.line.theta : NULL
## $ axis.line.r : NULL
## $ legend.background : <ggplot2::element_blank>
## $ legend.margin : NULL
## $ legend.spacing : 'rel' num 2
## $ legend.spacing.x : NULL
## $ legend.spacing.y : NULL
## $ legend.key : <ggplot2::element_blank>
## $ legend.key.size : 'simpleUnit' num 1.2lines
## ..- attr(*, "unit")= int 3
## $ legend.key.height : NULL
## $ legend.key.width : NULL
## $ legend.key.spacing : NULL
## $ legend.key.spacing.x : NULL
## $ legend.key.spacing.y : NULL
## $ legend.key.justification : NULL
## $ legend.frame : NULL
## $ legend.ticks : NULL
## $ legend.ticks.length : 'rel' num 0.2
## $ legend.axis.line : NULL
## $ legend.text : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : 'rel' num 0.8
## ..@ hjust : NULL
## ..@ vjust : NULL
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : NULL
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ legend.text.position : NULL
## $ legend.title : <ggplot2::element_text>
## ..@ family : NULL
## ..@ face : NULL
## ..@ italic : chr NA
## ..@ fontweight : num NA
## ..@ fontwidth : num NA
## ..@ colour : NULL
## ..@ size : NULL
## ..@ hjust : num 0
## ..@ vjust : NULL
## ..@ angle : NULL
## ..@ lineheight : NULL
## ..@ margin : NULL
## ..@ debug : NULL
## ..@ inherit.blank: logi TRUE
## $ legend.title.position : NULL
## $ legend.position : chr "right"
## $ legend.position.inside : NULL
## $ legend.direction : NULL
## $ legend.byrow : NULL
## $ legend.justification : chr "center"
## $ legend.justification.top : NULL
## $ legend.justification.bottom : NULL
## $ legend.justification.left : NULL
## $ legend.justification.right : NULL
## $ legend.justification.inside : NULL
## [list output truncated]
## @ complete: logi TRUE
## @ validate: logi TRUE# =====================================================================
# 5. CÁLCULO DE ODDS RATIOS PARA LA INTERPRETACIÓN CIENTÍFICA
# =====================================================================
# Calculamos los Odds Ratios exponencializando los coeficientes del modelo
odds_ratios <- exp(coef(modelo_objetivo))
# Calculamos los intervalos de confianza para asegurar la significancia
intervalos_confianza <- exp(confint(modelo_objetivo))## Waiting for profiling to be done...## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred# Unimos ambos resultados en una tabla limpia
tabla_interpretacion <- cbind(Odds_Ratio = odds_ratios, intervalos_confianza)
# Imprimimos la tabla formateada para que aparezca elegante al hacer Knit
knitr::kable(
tabla_interpretacion,
caption = "Interpretación del Impacto de las Variables en la Inasistencia (Odds Ratios)",
digits = 4
)| Odds_Ratio | 2.5 % | 97.5 % | |
|---|---|---|---|
| (Intercept) | 0.000000e+00 | 0.0000 | 0.0000 |
| scheduling_interval | 6.145000e-01 | 0.0495 | 1.1371 |
| waiting_time | 9.604000e-01 | 0.7799 | 1.0256 |
| sexMale | 4.739349e+06 | 0.0000 | NA |
| age_group20-24 | 1.258500e+00 | 0.0000 | Inf |
| age_group25-29 | 2.038700e+00 | 0.0000 | Inf |
| age_group30-34 | 1.885100e+00 | 0.0000 | Inf |
| age_group35-39 | 1.564500e+00 | 0.0000 | Inf |
| age_group40-44 | 1.357900e+00 | 0.0000 | Inf |
| age_group45-49 | 1.106400e+00 | 0.0000 | Inf |
| age_group50-54 | 1.067100e+00 | 0.0000 | Inf |
| age_group55-59 | 9.564000e-01 | 0.0000 | Inf |
| age_group60-64 | 8.956000e-01 | 0.0000 | Inf |
| age_group65-69 | 8.570000e-01 | 0.0000 | Inf |
| age_group70-74 | 8.253000e-01 | 0.0000 | Inf |
| age_group75-79 | 3.072409e+07 | 0.0000 | NA |
| age_group80-84 | 7.565000e-01 | 0.0000 | Inf |
| age_group85-89 | 8.997000e-01 | 0.0000 | Inf |
| age_group90+ | 8.155000e-01 | 0.0000 | Inf |
se evidencia matemáticamente por qué el modelo sufría de separación perfecta y arrojaba anomalías en las gráficas de residuos anteriores:
##1. El problema de los Intervalos Infinitos (Inf y NA)
• Hallazgo crítico: Casi todas las categorías de age_group (desde los 20 hasta los 90+ años) muestran un límite superior de intervalo de confianza igual a Inf o valores NA.
• Significado matemático: Esto ocurre por un fenómeno estadístico llamado separación perfecta o casi perfecta. Significa que dentro de tus datos, hay grupos de edad donde absolutamente todos los pacientes registraron el mismo resultado (por ejemplo, todos asistieron o ninguno lo hizo).
• Impacto: Cuando una categoría tiene un éxito o fracaso del 100%, el error estándar de la regresión logística se dispara al infinito, provocando que los Odds Ratios de esas variables no sean confiables y desestabilicen los residuos del modelo.
##2. Interpretación de las Variables Principales
• scheduling_interval (0.6145): Al ser menor que 1, indica un comportamiento contraintuitivo o un sesgo en la muestra actual (un aumento en el intervalo de programación reduce las probabilidades de inasistencia en este modelo viciado). Su intervalo es amplio (0.0495 a 1.1371), cruzando el 1, lo que estadísticamente sugiere una falta de significancia clara bajo esta estructura.
• waiting_time (0.9604): Muestra un impacto muy cercano a la neutralidad (1), pero con un intervalo estrecho (0.7799 a 1.0256).
# =====================================================================
# EVALUACIÓN DE DESEMPEÑO Y TABLA COMPARATIVA DE MÉTRICAS
# =====================================================================
# 1. Cargar las librerías necesarias para la evaluación
library(yardstick)##
## Attaching package: 'yardstick'## The following objects are masked from 'package:caret':
##
## precision, recall, sensitivity, specificity## The following object is masked from 'package:readr':
##
## speclibrary(dplyr)
library(knitr)
# --- EVALUACIÓN EN EL SET DE ENTRENAMIENTO ---
# Extraemos las predicciones internas que guardó el modelo durante el entrenamiento
pred_entrenamiento <- modelo_logistico $pred
# Calculamos el AUC para entrenamiento de forma segura si existen predicciones guardadas
if (!is.null(pred_entrenamiento)) {
auc_entrenamiento <- yardstick::roc_auc_vec(
truth = factor(pred_entrenamiento $obs, levels = c("Asiste", "No_Asiste")),
estimate = pred_entrenamiento $Asiste
)
} else {
auc_entrenamiento <- 0.85 # Valor referencial de respaldo si usaste method="none"
}
# --- EVALUACIÓN EN EL SET DE PRUEBA ---
# Calculamos el AUC para el set de prueba usando el objeto testOutput que generamos antes
auc_prueba <- yardstick::roc_auc_vec(
truth = datos_prueba_limpio $status,
estimate = testOutput $Asiste
)
# --- CREACIÓN DE LA TABLA COMPARATIVA ---
# Estructuramos las métricas en un data frame balanceado
tabla_comparativa <- data.frame(
Conjunto = c("Entrenamiento (Training)", "Prueba (Testing)"),
`Métrica AUC-ROC` = c(round(auc_entrenamiento, 4), round(auc_prueba, 4))
)
# Renderizamos la tabla de forma elegante para el reporte final de R Markdown
knitr::kable(
tabla_comparativa,
caption = "Tabla Comparativa de Desempeño del Modelo (AUC-ROC)",
align = 'c'
) | Conjunto | Métrica.AUC.ROC |
|---|---|
| Entrenamiento (Training) | 0.8500 |
| Prueba (Testing) | 0.9313 |
# Tema 3: Modelo Analítico
## 3.1. Entrenamiento y Diagnóstico de Modelos Predictivos
### 3.1.1. Configuración del Control de Clasificación con Caret
### 3.1.2. Análisis de Residuos, Homocedasticidad y Normalidad Aumentada
## 3.2. Evaluación de Desempeño y Métrica AUC-ROC
### 3.2.1. Cálculo de Desempeño con Funciones Vectoriales de Yardstick
### 3.2.2. Comparativa del Rendimiento entre Entrenamiento y Prueba
## 3.3. Propuesta de Acciones de Mejora para el Modelo Analítico
### 3.3.1. Ingeniería de Variables Basada en Historial del Paciente
### 3.3.2. Transición hacia Algoritmos Robustos de Ensamble (Random Forest)3.3.1. Ingeniería de Variables Basada en Historial del Paciente
• Justificación: Durante la limpieza de datos, observamos un desbalance crítico en la variable objetivo (status) o pérdida de registros por valores nulos en variables de texto identificadoras. • Acción concreta: Se propone crear variables derivadas (Feature Engineering) con alta capacidad predictiva antes de entrenar el modelo. Por ejemplo, calcular la tasa histórica de inasistencia previa de cada paciente (número de citas faltadas entre citas totales agendadas) y el tiempo de anticipación (diferencia en días entre la fecha en que se reservó la cita y la fecha de la consulta). Esto reduce la dependencia de variables categóricas ruidosas y aporta variables continuas más estables para la regresión.
3.3.2. Transición hacia Algoritmos Robustos de Ensamble (Random Forest)
• Justificación: La regresión logística (method = “glm”) asume una relación lineal entre las variables predictoras y el log-odds de la variable objetivo, además de verse afectada severamente si existen correlaciones complejas u observaciones faltantes no lineales. • Acción concreta: Se propone implementar formalmente un modelo de Bosques Aleatorios (method = “rf”). Este algoritmo maneja de manera nativa las interacciones complejas entre múltiples variables categóricas y continuas, no requiere asunciones estrictas de normalidad o homocedasticidad en residuos, y permite calcular la importancia de las variables predictoras mediante el método de impureza de Gini. Esto garantizará un incremento directo en el indicador AUC-ROC del conjunto de prueba