---
title: "Gestión de citas y recursos ambulatorios"
subtitle: "Informe interactivo de análisis exploratorio de datos | FUCS"
author: "Alexandra Cecilia Rivera Pardo"
date: "7 de octubre de 2026"
output:
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: scroll
    theme: cosmo
    source_code: embed
    self_contained: true
params:
  ruta_citas: "data/appointments.csv"
  ruta_cupos: "data/slots.csv"
---

```{r setup, include=FALSE}
# -----------------------------------------------------------------------------
# 0. PREPARACIÓN DEL ENTORNO
# -----------------------------------------------------------------------------
# Instalar una sola vez, desde la consola de RStudio:
# install.packages(c("tidyverse", "janitor", "skimr", "plotly", "DT",
#                    "flexdashboard", "scales", "htmltools", "rmarkdown"))

# Cargar paquetes para manipulación, depuración, gráficos e interactividad.
library(tidyverse)
library(janitor)
library(skimr)
library(plotly)
library(DT)
library(flexdashboard)
library(scales)
library(htmltools)

# Configuración general de los bloques de código.
knitr::opts_chunk$set(
  echo = FALSE,       # El código completo queda disponible en "Source Code".
  warning = FALSE,
  message = FALSE,
  fig.align = "center"
)

# -----------------------------------------------------------------------------
# 1. IMPORTACIÓN Y VALIDACIÓN DE LOS DATOS
# -----------------------------------------------------------------------------
# Verificar que los archivos estén disponibles antes de ejecutar el análisis.
if (!file.exists(params$ruta_citas) || !file.exists(params$ruta_cupos)) {
  stop("No se encuentran appointments.csv y/o slots.csv en la carpeta data/.")
}

# Importar los archivos originales suministrados para la actividad.
citas <- readr::read_csv(params$ruta_citas, show_col_types = FALSE) |>
  janitor::clean_names()

cupos <- readr::read_csv(params$ruta_cupos, show_col_types = FALSE) |>
  janitor::clean_names()

# Validar que existan las variables esenciales para el análisis.
variables_requeridas <- c(
  "appointment_id", "slot_id", "appointment_date", "appointment_time",
  "scheduling_interval", "status", "waiting_time", "appointment_duration",
  "patient_id", "sex", "age", "age_group"
)
stopifnot(length(setdiff(variables_requeridas, names(citas))) == 0)

# -----------------------------------------------------------------------------
# 2. LIMPIEZA Y TRANSFORMACIÓN
# -----------------------------------------------------------------------------
# Homogeneizar fechas, estados y variables numéricas; crear año y hora.
citas <- citas |>
  mutate(
    appointment_date = as.Date(appointment_date),
    year = lubridate::year(appointment_date),
    status = tolower(trimws(as.character(status))),
    scheduling_interval = as.numeric(scheduling_interval),
    waiting_time = as.numeric(waiting_time),
    appointment_duration = as.numeric(appointment_duration),
    hora = as.integer(substr(appointment_time, 1, 2)),
    sex = as.character(sex),
    age_group = as.character(age_group)
  )

cupos <- cupos |>
  mutate(is_available = as.logical(is_available))

# Definir subconjuntos con denominadores correctos.
# - Citas resueltas: atendidas + inasistencias.
# - Citas atendidas: permiten estudiar espera y duración de la consulta.
resueltas <- citas |>
  filter(status %in% c("attended", "did not attend"))

atendidas <- citas |>
  filter(status == "attended")

esperas_validas <- atendidas |>
  filter(is.finite(waiting_time), waiting_time >= 0)

# -----------------------------------------------------------------------------
# 3. INDICADORES GENERALES
# -----------------------------------------------------------------------------
n_citas <- nrow(citas)
n_cupos <- nrow(cupos)
n_atendidas <- sum(citas$status == "attended")
n_no_asisten <- sum(citas$status == "did not attend")
n_canceladas <- sum(citas$status == "cancelled")
n_pendientes <- sum(citas$status %in% c("scheduled", "unknown"))

tasa_ausencia <- 100 * n_no_asisten / nrow(resueltas)
tasa_cancelacion <- 100 * n_canceladas / n_citas
mediana_espera <- median(esperas_validas$waiting_time, na.rm = TRUE)
p90_espera <- quantile(esperas_validas$waiting_time, 0.90, na.rm = TRUE)

# Formatos de presentación.
f0 <- function(x) format(round(x, 0), big.mark = ".", decimal.mark = ",", trim = TRUE)
f1 <- function(x) format(round(x, 1), big.mark = ".", decimal.mark = ",", nsmall = 1, trim = TRUE)
f2 <- function(x) format(round(x, 2), big.mark = ".", decimal.mark = ",", nsmall = 2, trim = TRUE)

# -----------------------------------------------------------------------------
# 4. TABLAS ANALÍTICAS PARA VISUALIZACIONES
# -----------------------------------------------------------------------------
# Distribución general por estado.
por_estado <- citas |>
  count(status, name = "n") |>
  mutate(pct = 100 * n / sum(n))

# Evolución anual de cancelación e inasistencia, con denominadores separados.
por_anio <- citas |>
  group_by(year) |>
  summarise(
    citas = n(),
    canceladas = sum(status == "cancelled"),
    .groups = "drop"
  ) |>
  mutate(tasa_cancelacion = 100 * canceladas / citas) |>
  left_join(
    resueltas |>
      group_by(year) |>
      summarise(
        resueltas = n(),
        inasistencias = sum(status == "did not attend"),
        tasa_ausencia = 100 * inasistencias / resueltas,
        .groups = "drop"
      ),
    by = "year"
  )

# Inasistencia según anticipación de la reserva.
por_anticipacion <- resueltas |>
  mutate(
    tramo = cut(
      scheduling_interval,
      breaks = c(0, 2, 7, 14, 30, Inf),
      include.lowest = TRUE,
      labels = c("1-2", "3-7", "8-14", "15-30", ">30")
    )
  ) |>
  filter(!is.na(tramo)) |>
  group_by(tramo, .drop = TRUE) |>
  summarise(
    citas_resueltas = n(),
    inasistencias = sum(status == "did not attend"),
    tasa_ausencia = 100 * inasistencias / citas_resueltas,
    .groups = "drop"
  )

# Tiempos de espera por hora: mediana y percentil 90.
por_hora <- esperas_validas |>
  group_by(hora) |>
  summarise(
    n = n(),
    mediana = median(waiting_time),
    p90 = quantile(waiting_time, 0.90),
    .groups = "drop"
  )

# Matriz año-hora para visualizar acumulación de espera.
mapa_espera <- esperas_validas |>
  group_by(year, hora) |>
  summarise(
    n = n(),
    mediana_espera = median(waiting_time),
    .groups = "drop"
  )

# Segmentación demográfica exploratoria de inasistencia.
por_edad <- resueltas |>
  group_by(age_group) |>
  summarise(
    citas_resueltas = n(),
    inasistencias = sum(status == "did not attend"),
    tasa_ausencia = 100 * inasistencias / citas_resueltas,
    .groups = "drop"
  ) |>
  filter(!is.na(age_group), citas_resueltas > 0)

# Tabla interactiva de desempeño operativo año-hora.
tabla_exploracion <- esperas_validas |>
  group_by(year, hora) |>
  summarise(
    citas_atendidas = n(),
    espera_mediana = median(waiting_time),
    espera_p90 = quantile(waiting_time, 0.90),
    duracion_mediana = median(appointment_duration, na.rm = TRUE),
    .groups = "drop"
  ) |>
  arrange(year, hora)
```

Resumen ejecutivo
=====================================

Row {data-height=120}
-------------------------------------

### Citas registradas

```{r valor_citas}
# Indicador principal del volumen de registros analizados.
flexdashboard::valueBox(
  value = f0(n_citas),
  caption = "registros de citas",
  icon = "fa-calendar"
)
```

### Inasistencia

```{r valor_ausencia}
# La tasa se calcula únicamente sobre citas con resultado asistencial conocido.
flexdashboard::valueBox(
  value = paste0(f2(tasa_ausencia), "%"),
  caption = "de citas resueltas",
  icon = "fa-user"
)
```

### Cancelación

```{r valor_cancelacion}
# La cancelación se expresa sobre el total de citas registradas.
flexdashboard::valueBox(
  value = paste0(f2(tasa_cancelacion), "%"),
  caption = "del total de citas",
  icon = "fa-ban"
)
```

### Espera mediana

```{r valor_espera}
# La espera se analiza solo para consultas efectivamente atendidas.
flexdashboard::valueBox(
  value = paste0(f1(mediana_espera), " min"),
  caption = paste0("P90: ", f1(p90_espera), " min"),
  icon = "fa-clock-o"
)
```

Row {data-height=430}
-------------------------------------

### ¿Qué ocurrió con las citas?

```{r grafico_estado}
# Gráfico interactivo: al pasar el cursor se muestran frecuencia y porcentaje.
g_estado <- ggplot(
  por_estado,
  aes(
    x = reorder(status, n), y = n,
    text = paste0(
      "Estado: ", status,
      "<br>Citas: ", scales::comma(n),
      "<br>Participación: ", round(pct, 2), "%"
    )
  )
) +
  geom_col(fill = "#4C78A8") +
  coord_flip() +
  labs(x = NULL, y = "Número de citas") +
  theme_minimal(base_size = 12)

plotly::ggplotly(g_estado, tooltip = "text") |>
  layout(hovermode = "closest")
```

### Interpretación ejecutiva

El conjunto contiene **`r f0(n_citas)` registros entre 2015 y 2024**. Entre las citas con resultado asistencial conocido, la inasistencia es **`r f2(tasa_ausencia)` %**; adicionalmente, las cancelaciones representan **`r f2(tasa_cancelacion)` % del total**. Son fenómenos distintos y requieren respuestas diferentes: la inasistencia se gestiona con confirmación y recordatorios, mientras que la cancelación exige liberar y reasignar cupos con rapidez.

**Decisión que soporta:** priorizar un piloto de confirmación y lista de espera, midiendo cuántos cupos cancelados logran recuperarse y cuántas inasistencias se evitan. Los **`r f0(n_pendientes)` registros con estado pendiente o desconocido** deben auditarse antes de usarlos como indicador de desempeño.

Agenda e inasistencia
=====================================

Row {data-height=420}
-------------------------------------

### Evolución anual de cancelación e inasistencia

```{r grafico_anual}
# Construir dos series con denominadores diferentes y permitir activar/desactivar
# cada indicador desde la leyenda del gráfico.
plot_ly() |>
  add_lines(
    data = por_anio,
    x = ~year, y = ~tasa_ausencia,
    name = "Inasistencia / resueltas",
    line = list(width = 3),
    text = ~paste0("Año: ", year,
                   "<br>Inasistencia: ", round(tasa_ausencia, 2), "%"),
    hoverinfo = "text"
  ) |>
  add_lines(
    data = por_anio,
    x = ~year, y = ~tasa_cancelacion,
    name = "Cancelación / total",
    line = list(width = 3, dash = "dash"),
    text = ~paste0("Año: ", year,
                   "<br>Cancelación: ", round(tasa_cancelacion, 2), "%"),
    hoverinfo = "text"
  ) |>
  layout(
    xaxis = list(title = "Año", dtick = 1),
    yaxis = list(title = "Tasa (%)"),
    legend = list(orientation = "h", x = 0, y = 1.12),
    hovermode = "x unified"
  )
```

### Lectura gerencial

Las tasas se mantienen relativamente estables durante la década, lo que sugiere que el problema **no corresponde a un episodio aislado de un solo año**. La estabilidad refuerza la conveniencia de intervenir el proceso de agenda como problema estructural y evaluar la intervención con indicadores antes/después.

Row {data-height=430}
-------------------------------------

### ¿La anticipación de la reserva explica la inasistencia?

```{r grafico_anticipacion}
# Comparar tasas, no conteos absolutos, para evitar que los tramos con más citas
# dominen visualmente el análisis.
g_ant <- ggplot(
  por_anticipacion,
  aes(
    x = tramo, y = tasa_ausencia,
    text = paste0(
      "Anticipación: ", tramo, " días",
      "<br>Citas resueltas: ", scales::comma(citas_resueltas),
      "<br>Inasistencias: ", scales::comma(inasistencias),
      "<br>Tasa: ", round(tasa_ausencia, 2), "%"
    )
  )
) +
  geom_col(fill = "#72B7B2") +
  labs(x = "Días entre reserva y atención", y = "Inasistencia (%)") +
  theme_minimal(base_size = 12)

plotly::ggplotly(g_ant, tooltip = "text")
```

### Interpretación y decisión

La variación entre tramos es reducida. Por ello, **no sería técnicamente sólido concentrar recordatorios únicamente en citas agendadas con mayor anticipación**. La prueba de gestión debería combinar plazo de reserva con otras variables —edad, historial de citas, hora y comportamiento previo— y comparar resultados de distintos esquemas de recordatorio.

Oportunidad y capacidad
=====================================

Row {data-height=430}
-------------------------------------

### Espera por hora programada: mediana y P90

```{r grafico_espera_hora}
# Mostrar simultáneamente un indicador típico (mediana) y uno de cola (P90).
plot_ly(por_hora, x = ~hora) |>
  add_lines(
    y = ~mediana,
    name = "Mediana",
    line = list(width = 3),
    text = ~paste0("Hora: ", hora, ":00",
                   "<br>Mediana: ", round(mediana, 1), " min",
                   "<br>Citas: ", scales::comma(n)),
    hoverinfo = "text"
  ) |>
  add_lines(
    y = ~p90,
    name = "Percentil 90",
    line = list(width = 3, dash = "dash"),
    text = ~paste0("Hora: ", hora, ":00",
                   "<br>P90: ", round(p90, 1), " min"),
    hoverinfo = "text"
  ) |>
  layout(
    xaxis = list(title = "Hora programada", dtick = 1),
    yaxis = list(title = "Minutos de espera"),
    legend = list(orientation = "h", x = 0, y = 1.12),
    hovermode = "x unified"
  )
```

### Interpretación nítida

La espera aumenta de forma progresiva a lo largo del día: la mediana pasa de **12,8 minutos a las 8:00 a. m.** a **56,5 minutos a las 5:00 p. m.**; el P90 pasa de **35,6 a 136,6 minutos**. El patrón es compatible con acumulación de retrasos y congestión operativa durante la jornada.

**Decisión que soporta:** antes de aumentar personal, conviene revisar puntualidad de inicio, secuencia de turnos, pausas, sobreposición de actividades y recuperación de retrasos entre consultas. La intervención debe monitorear mediana y P90 por franja horaria.

Row {data-height=470}
-------------------------------------

### Mapa dinámico de espera por año y hora

```{r mapa_calor}
# El mapa de calor permite identificar si la acumulación de espera se repite
# sistemáticamente por hora y a lo largo de los años.
plot_ly(
  data = mapa_espera,
  x = ~hora,
  y = ~year,
  z = ~mediana_espera,
  type = "heatmap",
  colorscale = "Blues",
  text = ~paste0(
    "Año: ", year,
    "<br>Hora: ", hora, ":00",
    "<br>Mediana: ", round(mediana_espera, 1), " min",
    "<br>Citas: ", scales::comma(n)
  ),
  hoverinfo = "text",
  colorbar = list(title = "Min")
) |>
  layout(
    xaxis = list(title = "Hora programada", dtick = 1),
    yaxis = list(title = "Año", dtick = 1)
  )
```

### ¿Qué agrega este gráfico?

El mapa aprovecha simultáneamente las dimensiones de **tiempo calendario y hora del día**. Si la acumulación vespertina aparece de manera recurrente en diferentes años, la hipótesis de un problema estructural del flujo operativo gana fuerza y debe contrastarse con datos de talento humano, especialidad y duración programada de los turnos.

Gestión, calidad y exploración
=====================================

Row {data-height=390}
-------------------------------------

### Inasistencia por grupo de edad

```{r grafico_edad}
# Explorar heterogeneidad demográfica sin asumir causalidad.
g_edad <- ggplot(
  por_edad,
  aes(
    x = reorder(age_group, tasa_ausencia),
    y = tasa_ausencia,
    text = paste0(
      "Edad: ", age_group,
      "<br>Citas resueltas: ", scales::comma(citas_resueltas),
      "<br>Inasistencia: ", round(tasa_ausencia, 2), "%"
    )
  )
) +
  geom_col(fill = "#F58518") +
  coord_flip() +
  labs(x = "Grupo de edad", y = "Inasistencia (%)") +
  theme_minimal(base_size = 11)

plotly::ggplotly(g_edad, tooltip = "text")
```

### Interpretación

Las diferencias por edad son acotadas y no justifican, por sí solas, una política diferenciada. Este resultado es útil porque evita sobrerreaccionar a segmentos demográficos sin evidencia suficiente. Un modelo predictivo posterior debería validar si edad agrega capacidad explicativa cuando se incorpora junto con historial, anticipación, hora y otras características.

Row {data-height=520}
-------------------------------------

### Explorador dinámico de desempeño año-hora

```{r tabla_dinamica}
# Tabla filtrable y ordenable. El usuario puede escribir valores en los filtros
# superiores para explorar años u horas específicas y ordenar por P90 o mediana.
DT::datatable(
  tabla_exploracion,
  filter = "top",
  rownames = FALSE,
  extensions = c("Buttons"),
  options = list(
    pageLength = 12,
    scrollX = TRUE,
    dom = "Bfrtip",
    buttons = c("copy", "csv"),
    language = list(
      search = "Buscar:",
      lengthMenu = "Mostrar _MENU_ registros",
      info = "Mostrando _START_ a _END_ de _TOTAL_ registros",
      paginate = list(previous = "Anterior", `next` = "Siguiente")
    )
  ),
  caption = htmltools::tags$caption(
    style = "caption-side: top; text-align: left; font-weight: bold;",
    "Tabla interactiva. Filtre por año u hora y exporte los resultados si lo requiere."
  )
) |>
  formatRound(c("espera_mediana", "espera_p90", "duracion_mediana"), 1)
```

### Recomendaciones para la gestión de recursos

1. **Agenda:** implementar un piloto de reconfirmación, cancelación anticipada y lista de espera. Medir cupos recuperados, citas efectivamente atendidas y costo por cita recuperada.
2. **Oportunidad:** gestionar la acumulación vespertina con indicadores por franja —mediana y P90— y no únicamente con un promedio diario.
3. **Talento humano:** integrar posteriormente dotación real, especialidad, profesional, pausas y duración programada. Sin esas variables, estos datos no permiten concluir que la solución sea aumentar personal.
4. **Calidad de información:** auditar los **`r f0(n_pendientes)` estados pendientes o desconocidos**, estandarizar catálogos y diferenciar citas, reprogramaciones y cupos únicos.
5. **Análisis adicional:** modelar probabilidad de inasistencia, medir tiempo entre cancelación y reocupación, y evaluar pilotos con comparación antes/después y, de ser posible, grupo de control.

### Alcance del análisis

El informe es **exploratorio y descriptivo**. No demuestra causalidad ni permite estimar costos institucionales reales porque los archivos no incorporan costos unitarios, especialidad, profesional, dotación de personal ni características organizacionales de un prestador colombiano. Las recomendaciones deben validarse con información local antes de convertirse en decisiones presupuestales.

### Fuente

FUCS (2026), *Actividad Semana 1*; conjunto *Medical Appointment Scheduling System* suministrado para la actividad; análisis desarrollado en R Markdown con `tidyverse`, `plotly`, `DT` y `flexdashboard`.