Tema 1. Exploración Analítica de Datos

El presente apartado tiene como propósito realizar una exploración inicial de la base de datos de citas médicas. La exploración se centra en reconocer la estructura de los datos, identificar las variables disponibles, revisar los tipos de información, verificar la presencia de datos faltantes y realizar visualizaciones exploratorias.

1.1. Importación y reconocimiento de la base de datos

# Cargar paquetes
library(readxl)
library(tidyverse)
library(plotly)

# Importar el archivo Excel
appointment <- read_excel(
  "Appointment . Proyecto.xlsx",
  sheet = "Appointment (1)"
)

# Mostrar las primeras filas
head(appointment)

# Mostrar los archivos disponibles en la carpeta de trabajo
list.files()

##  [1] "~$Appointment . Proyecto.xlsx"         
##  [2] "Analitica de datos.Rproj"              
##  [3] "Appointment . Proyecto.xlsx"           
##  [4] "appointments final.xlsx"               
##  [5] "EncuestaBrfss2020-selected-columns.csv"
##  [6] "Practica de R mack.Rmd"                
##  [7] "R-Marckdown---Proyecto-1.html"         
##  [8] "R-Marckdown---Proyecto-1.Rmd"          
##  [9] "R-Marckdown--clase.html"               
## [10] "R Marckdown-  Proyecto 1.Rmd"          
## [11] "R Marckdown- clase.Rmd"                
## [12] "RD202401.csv.crdownload"               
## [13] "rsconnect"

Appointment . Proyecto.xlsx

1.2. Identificación del número de filas y columnas

# Número de filas
nrow(appointment)

## [1] 1000

# Número de columnas
ncol(appointment)

## [1] 5

# Dimensiones completas
dim(appointment)

## [1] 1000    5

1.3. Identificación de las variables

# Mostrar los nombres de las variables
names(appointment)

## [1] "AppointmentID" "Date"          "Time"          "PatientID"    
## [5] "DoctorID"

Las variables disponibles son:

AppointmentID: identificador de cada cita.
Date: fecha asociada al registro de la cita.
Time: información temporal registrada en la base.
PatientID: identificador del paciente.
DoctorID: identificador del médico.

1.4. Reconocimiento de los tipos de variables

# Revisar la estructura de la base
str(appointment)

## tibble [1,000 × 5] (S3: tbl_df/tbl/data.frame)
##  $ AppointmentID: num [1:1000] 639 404 281 628 889 551 769 385 813 986 ...
##  $ Date         : POSIXct[1:1000], format: "2022-04-08" "2023-04-10" ...
##  $ Time         : chr [1:1000] "2023-12-23T14:33:46.406Z" "2023-12-23T14:33:46.407Z" "2023-12-23T14:33:46.407Z" "2023-12-23T14:33:46.407Z" ...
##  $ PatientID    : num [1:1000] 109 823 465 443 852 160 886 480 634 898 ...
##  $ DoctorID     : num [1:1000] 462 774 226 656 262 748 580 438 662 653 ...

# Tipo de cada variable
sapply(appointment, class)

## $AppointmentID
## [1] "numeric"
## 
## $Date
## [1] "POSIXct" "POSIXt" 
## 
## $Time
## [1] "character"
## 
## $PatientID
## [1] "numeric"
## 
## $DoctorID
## [1] "numeric"

1.5. Exploración inicial de los registros

# Primeros 10 registros
head(appointment, 10)

# Últimos 10 registros
tail(appointment, 10)

1.6. Reconocimiento de valores diferentes

# Cantidad de valores diferentes por variable
sapply(appointment, n_distinct)

## AppointmentID          Date          Time     PatientID      DoctorID 
##           602           721            12           610           611

1.7. Revisión de datos faltantes

# Cantidad de datos faltantes por variable
colSums(is.na(appointment))

## AppointmentID          Date          Time     PatientID      DoctorID 
##             0             0             0             0             0

# Comprobar si existe algún dato faltante
any(is.na(appointment))

## [1] FALSE

1.8. Preparación básica de las fechas

# Convertir Date a formato de fecha
appointment$Date <- as.Date(appointment$Date)

# Revisar la variable
class(appointment$Date)

## [1] "Date"

# Fecha más antigua registrada
min(appointment$Date)

## [1] "2020-01-01"

# Fecha más reciente registrada
max(appointment$Date)

## [1] "2023-12-31"

1.9. Visualización exploratoria mediante gráficos interactivos

Se utilizará el paquete plotly, que permite generar gráficos interactivos en el documento HTML de R Markdown.

1.9.1. Registros de citas según fecha

# Contar registros por fecha
citas_fecha <- appointment %>%
  count(Date)

# Crear gráfico interactivo
plot_ly(
  data = citas_fecha,
  x = ~Date,
  y = ~n,
  type = "scatter",
  mode = "lines+markers"
) %>%
  layout(
    title = "Registros de citas según fecha",
    xaxis = list(title = "Fecha"),
    yaxis = list(title = "Número de registros")
  )

Esta visualización permite reconocer cómo se distribuyen los registros de citas a lo largo del periodo cubierto por la base de datos. Al representar las fechas en el eje horizontal y el número de registros en el eje vertical, es posible identificar visualmente las fechas con mayor o menor presencia de registros y observar variaciones aparentes a lo largo del tiempo. Desde la gestión sanitaria, esta exploración puede servir como punto de partida para conocer la organización temporal de los registros de atención. Sin embargo, por sí sola no permite determinar la demanda real de servicios, la disponibilidad de citas ni las causas de las variaciones observadas.

1.9.2. Registros de citas por DoctorID

# Contar registros por médico
citas_doctor <- appointment %>%
  count(DoctorID, sort = TRUE)

# Seleccionar los 10 DoctorID con mayor cantidad de registros
citas_doctor_10 <- citas_doctor %>%
  slice_head(n = 10)

# Crear gráfico interactivo
plot_ly(
  data = citas_doctor_10,
  x = ~DoctorID,
  y = ~n,
  type = "bar",
  text = ~n,
  textposition = "auto"
) %>%
  layout(
    title = "Registros de citas por DoctorID",
    xaxis = list(title = "DoctorID"),
    yaxis = list(title = "Número de registros")
  )

El gráfico de barras presenta los diez identificadores de médicos con mayor cantidad de registros en la base. La altura de cada barra representa el número de registros asociados a cada DoctorID. Esto permite comparar visualmente la presencia de los distintos identificadores en los datos y reconocer si algunos concentran más registros que otros. En el contexto de la administración de recursos sanitarios, esta información constituye una aproximación inicial a la distribución de los registros por médico. No obstante, no debe interpretarse directamente como productividad, desempeño laboral o carga asistencial, ya que la base explorada no aporta por sí sola información suficiente sobre jornadas, horas trabajadas, complejidad de los pacientes o tipo de atención.

1.9.3. Registros asociados a PatientID

# Contar registros por paciente
citas_paciente <- appointment %>%
  count(PatientID, sort = TRUE)

# Seleccionar los 10 PatientID con mayor cantidad de registros
citas_paciente_10 <- citas_paciente %>%
  slice_head(n = 10)

# Crear gráfico interactivo
plot_ly(
  data = citas_paciente_10,
  x = ~PatientID,
  y = ~n,
  type = "bar",
  text = ~n,
  textposition = "auto"
) %>%
  layout(
    title = "Registros asociados a PatientID",
    xaxis = list(title = "PatientID"),
    yaxis = list(title = "Número de registros")
  )

El gráfico permite identificar visualmente los PatientID que presentan una mayor cantidad de registros dentro de la base de datos.

1.9.4. Registros según Time

# Contar los registros de cada valor de Time
citas_time <- appointment %>%
  count(Time)

# Crear gráfico interactivo
plot_ly(
  data = citas_time,
  x = ~Time,
  y = ~n,
  type = "bar",
  text = ~n,
  textposition = "auto"
) %>%
  layout(
    title = "Registros según Time",
    xaxis = list(title = "Time"),
    yaxis = list(title = "Número de registros")
  )

El gráfico permite observar cómo están distribuidos los registros entre los diferentes valores presentes en la variable Time.

Interpretación de la exploración

La exploración inicial permitió reconocer una base de datos de 1.000 registros y 5 variables: AppointmentID, Date, Time, PatientID y DoctorID. Se identificó la función de cada variable, se revisó la estructura de la información y se verificó la presencia de datos faltantes.

Las visualizaciones permiten explorar la distribución de los registros según fecha, médico, paciente y tiempo. Esta primera aproximación se limita al reconocimiento y visualización de los datos y no incorpora procedimientos de estadística descriptiva o inferencial.

En conjunto, el ejercicio permitió conocer la estructura de la base de datos, identificar sus variables, revisar sus formatos, comprobar la presencia de datos faltantes y elaborar visualizaciones interactivas para explorar los registros de citas desde diferentes perspectivas: temporal, por médico y por paciente. Los gráficos facilitan la identificación visual de categorías, frecuencias de registro y patrones aparentes que pueden resultar relevantes para la administración de servicios de salud. Sin embargo, los resultados deben entenderse como una exploración inicial de los datos disponibles, no como una evaluación del funcionamiento de la institución ni de la calidad de la atención

Tema 2. Probabilidad y Estadística Aplicada”

datos <- read_excel(
  "Appointment . Proyecto.xlsx",
  sheet = 1
)

dim(datos)

## [1] 1000    5

names(datos)

## [1] "AppointmentID" "Date"          "Time"          "PatientID"    
## [5] "DoctorID"

head(datos)

# Asegurar que Date tenga formato de fecha
if (inherits(datos$Date, "POSIXt")) {
  datos$Date <- as.Date(datos$Date)
} else if (is.numeric(datos$Date)) {
  datos$Date <- as.Date(
    datos$Date,
    origin = "1899-12-30"
  )
} else {
  datos$Date <- as.Date(as.character(datos$Date))
}

# Tratar los identificadores como códigos
datos$AppointmentID <- as.character(datos$AppointmentID)
datos$PatientID <- as.character(datos$PatientID)
datos$DoctorID <- as.character(datos$DoctorID)

# Crear variables de día y mes en español
dias <- c(
  "domingo", "lunes", "martes", "miércoles",
  "jueves", "viernes", "sábado"
)

orden_dias <- c(
  "lunes", "martes", "miércoles", "jueves",
  "viernes", "sábado", "domingo"
)

meses <- c(
  "enero", "febrero", "marzo", "abril",
  "mayo", "junio", "julio", "agosto",
  "septiembre", "octubre", "noviembre", "diciembre"
)

datos$DiaSemana <- factor(
  dias[as.POSIXlt(datos$Date)$wday + 1],
  levels = orden_dias
)

datos$Mes <- factor(
  meses[as.POSIXlt(datos$Date)$mon + 1],
  levels = meses
)

head(datos)

set.seed(123)

# Seleccionar hasta 30 citas sin repetir registros
numero_muestra <- min(30, nrow(datos))

indices_muestra <- sample(
  seq_len(nrow(datos)),
  size = numero_muestra,
  replace = FALSE
)

muestra_citas <- datos[indices_muestra, ]

# Mostrar los primeros registros seleccionados
knitr::kable(
  head(muestra_citas, 10),
  caption = "Registros seleccionados aleatoriamente"
)

Registros seleccionados aleatoriamente
AppointmentID	Date	Time	PatientID	DoctorID	DiaSemana	Mes
114	2023-10-08	2023-12-23T14:33:46.412Z	214	714	domingo	octubre
488	2023-11-10	2023-12-23T14:33:46.412Z	590	370	viernes	noviembre
311	2023-07-06	2023-12-23T14:33:46.410Z	468	617	jueves	julio
807	2022-04-04	2023-12-23T14:33:46.413Z	372	630	lunes	abril
974	2021-02-03	2023-12-23T14:33:46.410Z	802	546	miércoles	febrero
237	2020-10-30	2023-12-23T14:33:46.417Z	281	522	viernes	octubre
863	2022-11-10	2023-12-23T14:33:46.415Z	448	112	jueves	noviembre
315	2022-03-26	2023-12-23T14:33:46.408Z	616	185	sábado	marzo
398	2023-07-08	2023-12-23T14:33:46.411Z	336	406	sábado	julio
423	2021-09-29	2023-12-23T14:33:46.410Z	168	919	miércoles	septiembre

# Excluir fechas que no pudieron interpretarse
dias_validos <- datos$DiaSemana[!is.na(datos$DiaSemana)]

# Frecuencias observadas
frecuencia_dias <- table(dias_validos)
frecuencia_dias

## dias_validos
##     lunes    martes miércoles    jueves   viernes    sábado   domingo 
##       146       146       145       137       157       134       135

# Probabilidades empíricas
probabilidad_dias <- prop.table(frecuencia_dias)
round(probabilidad_dias, 3)

## dias_validos
##     lunes    martes miércoles    jueves   viernes    sábado   domingo 
##     0.146     0.146     0.145     0.137     0.157     0.134     0.135

# Probabilidad empírica de una cita registrada el viernes
prob_viernes <- mean(
  datos$DiaSemana == "viernes",
  na.rm = TRUE
)

prob_viernes

## [1] 0.157

prob_viernes_base <- mean(
  datos$DiaSemana == "viernes",
  na.rm = TRUE
)

prob_viernes_muestra <- mean(
  muestra_citas$DiaSemana == "viernes",
  na.rm = TRUE
)

prob_viernes_base

## [1] 0.157

prob_viernes_muestra

## [1] 0.1666667

Interpretación: la primera cifra corresponde a toda la base y la segunda a la muestra seleccionada. Si difieren, esa diferencia ilustra el efecto de la selección aleatoria. Una muestra pequeña puede representar de manera imperfecta la distribución completa.

2.1.2. Simulación de variables aleatorias discretas y continuas

set.seed(123)

conteos_simulados <- floor(
  runif(100, min = 0, max = 11)
)

table(conteos_simulados)

## conteos_simulados
##  0  1  2  3  4  5  6  7  8  9 10 
##  5 13  9  8 13  8  6 11 12  9  6

Interpretación: la tabla presenta cuántas veces aparece cada conteo generado. Se trata de datos simulados, no de citas efectivamente registradas. El ejemplo permite comprender la variación que introduce un proceso aleatorio.

set.seed(123)

confirmacion_simulada <- rbinom(
  n = 100,
  size = 1,
  prob = 0.90
)

table(confirmacion_simulada)

## confirmacion_simulada
##  0  1 
##  7 93

# Proporción simulada de resultados favorables
mean(confirmacion_simulada)

## [1] 0.93

Interpretación: 1 representa el resultado favorable supuesto y 0 representa el otro resultado. La media de la variable indica la proporción de resultados favorables en la simulación. No debe reportarse como la tasa real de confirmación o asistencia de los pacientes.

fecha_minima <- min(datos$Date, na.rm = TRUE)
fecha_maxima <- max(datos$Date, na.rm = TRUE)

calendario <- data.frame(
  Date = seq(fecha_minima, fecha_maxima, by = "day")
)

resumen_diario <- calendario %>%
  left_join(
    datos %>%
      filter(!is.na(Date)) %>%
      count(Date, name = "citas"),
    by = "Date"
  ) %>%
  mutate(citas = tidyr::replace_na(citas, 0L))

# Calcular el promedio de citas por día calendario
lambda <- mean(resumen_diario$citas)

# Probabilidad teórica de distintos conteos diarios
max_citas <- max(resumen_diario$citas)

prob_poisson <- data.frame(
  citas = 0:max_citas,
  probabilidad = dpois(
    0:max_citas,
    lambda = lambda
  )
)

lambda

## [1] 0.6844627

prob_poisson

Interpretación: lambda es el promedio observado de citas por día calendario. dpois() calcula la probabilidad teórica de registrar exactamente cero, una, dos o más citas durante un día, según una distribución de Poisson (modelo probabilístico para contar eventos en un intervalo). Esta distribución es una aproximación para practicar probabilidad; no se puede afirmar que describa perfectamente la demanda real sin evaluar sus supuestos.

set.seed(123)

citas_simuladas_poisson <- rpois(
  n = 100,
  lambda = lambda
)

table(citas_simuladas_poisson)

## citas_simuladas_poisson
##  0  1  2  3 
## 53 32 13  2

Interpretación: la tabla muestra los conteos que produjo la simulación. Sirve para visualizar la variabilidad que podría aparecer bajo el supuesto de Poisson, pero no equivale a una predicción validada de citas futuras.

set.seed(123)

# Simulación normal: media de 30 minutos, desviación de 5
tiempo_normal <- rnorm(
  1000,
  mean = 30,
  sd = 5
)

# Simulación exponencial: media teórica de 15 minutos
tiempo_exponencial <- rexp(
  1000,
  rate = 1 / 15
)

# Simulación uniforme: tiempos entre 10 y 30 minutos
tiempo_uniforme <- runif(
  1000,
  min = 10,
  max = 30
)

simulaciones <- data.frame(
  Normal = tiempo_normal,
  Exponencial = tiempo_exponencial,
  Uniforme = tiempo_uniforme
)

simulaciones_largas <- tidyr::pivot_longer(
  simulaciones,
  cols = everything(),
  names_to = "Distribucion",
  values_to = "Minutos"
)

head(simulaciones_largas)

Interpretación: los datos simulados presentan tres comportamientos diferentes. La normal concentra valores cerca de una media, la exponencial genera tiempos positivos con frecuencia alta de valores pequeños y la uniforme distribuye los valores dentro de un intervalo definido. Todos los resultados dependen de los parámetros elegidos para el ejercicio.

# Distribución normal
dnorm(35, mean = 30, sd = 5)

## [1] 0.04839414

pnorm(35, mean = 30, sd = 5)

## [1] 0.8413447

# Distribución exponencial
dexp(10, rate = 1 / 15)

## [1] 0.03422781

pexp(10, rate = 1 / 15)

## [1] 0.4865829

# Probabilidad acumulada para una uniforme
punif(20, min = 10, max = 30)

## [1] 0.5

Interpretación: pnorm() y pexp() calculan probabilidades acumuladas hasta un valor específico. Por ejemplo, pnorm(35, …) calcula la probabilidad de obtener 35 minutos o menos según el escenario normal propuesto. dnorm() y dexp() devuelven densidades, que no son directamente probabilidades de obtener exactamente un valor continuo.

grafico_distribuciones <- ggplot(
  simulaciones_largas,
  aes(x = Minutos)
) +
  geom_histogram(
    bins = 30,
    fill = "steelblue",
    color = "white"
  ) +
  facet_wrap(
    ~ Distribucion,
    scales = "free_y"
  ) +
  labs(
    title = "Distribuciones de tiempos hipotéticos",
    x = "Tiempo simulado en minutos",
    y = "Frecuencia"
  ) +
  theme_minimal()

ggplotly(grafico_distribuciones)

Comentario analítico: cada histograma representa la frecuencia de los tiempos generados bajo un supuesto diferente. La comparación ayuda a entender cómo cambia la variabilidad entre distribuciones. No permite concluir que los tiempos reales del servicio sanitario sigan alguno de esos patrones.

2.2 Estadística descriptiva y visualización de datos

2.2.1. Medidas descriptivas de la actividad de citas

# Medidas del número de citas por día
media_citas <- mean(resumen_diario$citas)
mediana_citas <- median(resumen_diario$citas)
desviacion_citas <- sd(resumen_diario$citas)
varianza_citas <- var(resumen_diario$citas)
rango_citas <- range(resumen_diario$citas)

media_citas

## [1] 0.6844627

mediana_citas

## [1] 0

desviacion_citas

## [1] 0.8199304

varianza_citas

## [1] 0.6722858

rango_citas

## [1] 0 4

summary(datos)

##    AppointmentID       Date                   Time          PatientID   
##  Length   :1000   Min.   :2020-01-01   Length   :1000   Length   :1000  
##  N.unique : 602   1st Qu.:2020-12-19   N.unique :  12   N.unique : 610  
##  N.blank  :   0   Median :2021-12-20   N.blank  :   0   N.blank  :   0  
##  Min.nchar:   3   Mean   :2021-12-22   Min.nchar:  24   Min.nchar:   3  
##  Max.nchar:   3   3rd Qu.:2023-01-05   Max.nchar:  24   Max.nchar:   4  
##                   Max.   :2023-12-31                                    
##                                                                         
##       DoctorID        DiaSemana           Mes     
##  Length   :1000   lunes    :146   enero     : 97  
##  N.unique : 611   martes   :146   abril     : 96  
##  N.blank  :   0   miércoles:145   junio     : 87  
##  Min.nchar:   3   jueves   :137   diciembre : 87  
##  Max.nchar:   4   viernes  :157   noviembre : 82  
##                   sábado   :134   septiembre: 81  
##                   domingo  :135   (Other)   :470

summary(resumen_diario$citas)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.0000  0.6845  1.0000  4.0000

2.2.2. Gráficos interactivos y comparativos para la gestión sanitaria

citas_dia <- datos %>%
  count(DiaSemana, name = "total_citas", .drop = FALSE)

grafico_dias <- ggplot(
  citas_dia,
  aes(
    x = DiaSemana,
    y = total_citas,
    text = paste(
      "Día:", DiaSemana,
      "<br>Citas:", total_citas
    )
  )
) +
  geom_col(fill = "steelblue") +
  labs(
    title = "Distribución de citas por día de la semana",
    x = "Día de la semana",
    y = "Número de citas"
  ) +
  theme_minimal()

ggplotly(grafico_dias, tooltip = "text")

Comentario analítico: el gráfico permite identificar los días con mayor y menor cantidad de citas registradas. La distribución indica que la demanda de citas médicas es relativamente constante durante la semana, con un pico los viernes y una reducción durante el fin de semana. Esta información puede ayudar a las instituciones de salud a planificar los horarios del personal médico, asignar recursos y organizar la disponibilidad de consultorios según la demanda de cada día.

citas_mes <- datos %>%
  count(Mes, name = "total_citas", .drop = FALSE)

grafico_meses <- ggplot(
  citas_mes,
  aes(
    x = Mes,
    y = total_citas,
    text = paste(
      "Mes:", Mes,
      "<br>Citas:", total_citas
    )
  )
) +
  geom_col(fill = "darkcyan") +
  labs(
    title = "Distribución de las citas por mes",
    x = "Mes",
    y = "Número de citas"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 45,
      hjust = 1
    )
  )

ggplotly(grafico_meses, tooltip = "text")

Comentario analítico: el gráfico muestra que la demanda de citas médicas no es uniforme a lo largo del año. Los meses de enero y abril presentan los niveles más altos, mientras que marzo y mayo registran los más bajos. Durante la segunda mitad del año, la cantidad de citas se mantiene relativamente estable, con un aumento en diciembre.

resumen_diario$DiaSemana <- factor(
  dias[as.POSIXlt(resumen_diario$Date)$wday + 1],
  levels = orden_dias
)

grafico_comparativo <- ggpubr::ggboxplot(
  resumen_diario,
  x = "DiaSemana",
  y = "citas",
  color = "DiaSemana",
  add = "jitter"
) +
  labs(
    title = "Variabilidad de las citas diarias por día semanal",
    x = "Día de la semana",
    y = "Citas por día calendario"
  ) +
  theme_minimal()

ggplotly(grafico_comparativo)

Comentario analítico: En términos generales, el número de citas médicas presenta una variabilidad considerable según la fecha, aunque la mayoría de los registros se mantiene en niveles bajos. Los viernes y domingos destacan por presentar algunos de los valores máximos más altos, mientras que el comportamiento central parece relativamente similar durante toda la semana.

resumen_diario$TipoDia <- ifelse(
  resumen_diario$DiaSemana %in% c("sábado", "domingo"),
  "Fin de semana",
  "Entre semana"
)

resumen_diario$TipoDia <- factor(
  resumen_diario$TipoDia,
  levels = c("Entre semana", "Fin de semana")
)

prueba_t <- t.test(
  citas ~ TipoDia,
  data = resumen_diario
)

prueba_t

## 
##  Welch Two Sample t-test
## 
## data:  citas by TipoDia
## t = 1.2162, df = 780.07, p-value = 0.2243
## alternative hypothesis: true difference in means between group Entre semana and group Fin de semana is not equal to 0
## 95 percent confidence interval:
##  -0.0352005  0.1498450
## sample estimates:
##  mean in group Entre semana mean in group Fin de semana 
##                   0.7008629                   0.6435407

Interpretación: el resultado compara los promedios de citas por día calendario en los dos grupos y presenta un intervalo de confianza para la diferencia de medias. Si p < 0.05, existe evidencia estadística de una diferencia entre los promedios, bajo los supuestos de la prueba. Si p ≥ 0.05, no hay evidencia suficiente para concluir que los promedios sean diferentes. Esto no demuestra que sean idénticos. Desde la gestión sanitaria, la comparación puede ayudar a describir cómo cambia la actividad registrada entre días laborales y fines de semana. Como las fechas consecutivas pueden compartir condiciones, el resultado debe considerarse exploratorio y no una prueba definitiva de una diferencia estructural.

modelo_anova <- aov(
  citas ~ DiaSemana,
  data = resumen_diario
)

summary(modelo_anova)

##               Df Sum Sq Mean Sq F value Pr(>F)
## DiaSemana      6    2.0  0.3256   0.483  0.821
## Residuals   1454  979.6  0.6737

Interpretación: el ANOVA evalúa si las medias del número diario de citas pueden considerarse iguales entre los días de la semana. Si el valor p < 0.05, hay evidencia de que al menos una media difiere, aunque el resultado general no señala por sí solo cuáles días son diferentes.

TukeyHSD(modelo_anova)

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = citas ~ DiaSemana, data = resumen_diario)
## 
## $DiaSemana
##                            diff        lwr       upr     p adj
## martes-lunes      -1.110223e-16 -0.2376330 0.2376330 1.0000000
## miércoles-lunes   -8.143173e-03 -0.2454917 0.2292054 0.9999999
## jueves-lunes      -4.642068e-02 -0.2837692 0.1909279 0.9974324
## viernes-lunes      4.927310e-02 -0.1880755 0.2866216 0.9964242
## sábado-lunes      -6.077475e-02 -0.2981233 0.1765738 0.9888592
## domingo-lunes     -5.599006e-02 -0.2933386 0.1813585 0.9928120
## miércoles-martes  -8.143173e-03 -0.2454917 0.2292054 0.9999999
## jueves-martes     -4.642068e-02 -0.2837692 0.1909279 0.9974324
## viernes-martes     4.927310e-02 -0.1880755 0.2866216 0.9964242
## sábado-martes     -6.077475e-02 -0.2981233 0.1765738 0.9888592
## domingo-martes    -5.599006e-02 -0.2933386 0.1813585 0.9928120
## jueves-miércoles  -3.827751e-02 -0.2753413 0.1987863 0.9991305
## viernes-miércoles  5.741627e-02 -0.1796475 0.2944801 0.9917174
## sábado-miércoles  -5.263158e-02 -0.2896954 0.1844322 0.9948287
## domingo-miércoles -4.784689e-02 -0.2849107 0.1892169 0.9969409
## viernes-jueves     9.569378e-02 -0.1413700 0.3327576 0.8974050
## sábado-jueves     -1.435407e-02 -0.2514179 0.2227097 0.9999973
## domingo-jueves    -9.569378e-03 -0.2466332 0.2274944 0.9999998
## sábado-viernes    -1.100478e-01 -0.3471116 0.1270159 0.8175309
## domingo-viernes   -1.052632e-01 -0.3423269 0.1318006 0.8469878
## domingo-sábado     4.784689e-03 -0.2322791 0.2418485 1.0000000

datos$TipoDia <- factor(
  ifelse(
    datos$DiaSemana %in% c("sábado", "domingo"),
    "Fin de semana",
    "Entre semana"
  ),
  levels = c("Entre semana", "Fin de semana")
)

tabla_mes_dia <- table(
  datos$Mes,
  datos$TipoDia
)

tabla_mes_dia

##             
##              Entre semana Fin de semana
##   enero                73            24
##   febrero              55            23
##   marzo                60            17
##   abril                74            22
##   mayo                 52            25
##   junio                67            20
##   julio                57            23
##   agosto               56            24
##   septiembre           61            20
##   octubre              56            22
##   noviembre            56            26
##   diciembre            64            23

prueba_chi <- chisq.test(tabla_mes_dia)

prueba_chi

## 
##  Pearson's Chi-squared test
## 
## data:  tabla_mes_dia
## X-squared = 5.843, df = 11, p-value = 0.8836

# Verificar las frecuencias esperadas
min(prueba_chi$expected)

## [1] 20.713

Interpretación: la prueba examina si el mes y el tipo de día aparecen asociados en los registros. Si p < 0.05, existe evidencia estadística de una asociación, pero eso no significa que el mes cause el patrón observado.

corte <- fecha_minima +
  floor(as.numeric(fecha_maxima - fecha_minima) / 2)

datos_periodo <- datos %>%
  filter(!is.na(Date), !is.na(DiaSemana)) %>%
  mutate(
    Periodo = factor(
      ifelse(
        Date <= corte,
        "Primera mitad",
        "Segunda mitad"
      ),
      levels = c("Primera mitad", "Segunda mitad")
    ),
    FinSemana = DiaSemana %in% c("sábado", "domingo")
  )

resumen_proporciones <- datos_periodo %>%
  group_by(Periodo) %>%
  summarise(
    citas_fin_semana = sum(FinSemana),
    total_citas = n(),
    proporcion = citas_fin_semana / total_citas,
    .groups = "drop"
  )

resumen_proporciones

prueba_prop <- prop.test(
  x = resumen_proporciones$citas_fin_semana,
  n = resumen_proporciones$total_citas
)

prueba_prop

## 
##  2-sample test for equality of proportions with continuity correction
## 
## data:  resumen_proporciones$citas_fin_semana out of resumen_proporciones$total_citas
## X-squared = 0.069487, df = 1, p-value = 0.7921
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.04756873  0.06635754
## sample estimates:
##    prop 1    prop 2 
## 0.2736220 0.2642276

Interpretación: la prueba compara la proporción de registros correspondientes a sábados y domingos entre los dos periodos. El valor p y el intervalo de confianza ayudan a evaluar si existe evidencia de una diferencia en esas proporciones.

install.packages(c(“ggpubr”, “plotly”, “dplyr”, “tidyr”))

library(ggpubr)
library(plotly)
library(dplyr)
library(tidyr)

# Asegurar que Date tenga formato de fecha
if (!inherits(datos$Date, "Date")) {
  if (inherits(datos$Date, "POSIXt")) {
    datos$Date <- as.Date(datos$Date)
  } else if (is.numeric(datos$Date)) {
    datos$Date <- as.Date(
      datos$Date,
      origin = "1899-12-30"
    )
  } else {
    datos$Date <- as.Date(as.character(datos$Date))
  }
}

# Crear un calendario diario dentro del periodo observado
fecha_inicial <- min(datos$Date, na.rm = TRUE)
fecha_final <- max(datos$Date, na.rm = TRUE)

calendario <- data.frame(
  Date = seq(fecha_inicial, fecha_final, by = "day")
)

# Contar las citas registradas por fecha
conteo_diario <- datos %>%
  filter(!is.na(Date)) %>%
  count(Date, name = "citas")

# Incorporar fechas sin registros en la base
resumen_diario <- calendario %>%
  left_join(conteo_diario, by = "Date") %>%
  mutate(citas = tidyr::replace_na(citas, 0L))

# Identificar el día de la semana
dias <- c(
  "domingo", "lunes", "martes", "miércoles",
  "jueves", "viernes", "sábado"
)

orden_dias <- c(
  "lunes", "martes", "miércoles", "jueves",
  "viernes", "sábado", "domingo"
)

resumen_diario$DiaSemana <- factor(
  dias[as.POSIXlt(resumen_diario$Date)$wday + 1],
  levels = orden_dias
)

head(resumen_diario)

grafico_dias <- ggpubr::ggboxplot(
  resumen_diario,
  x = "DiaSemana",
  y = "citas",
  color = "DiaSemana",
  palette = "jco",
  add = "jitter"
) +
  labs(
    title = "Variabilidad de las citas por día de la semana",
    x = "Día de la semana",
    y = "Citas registradas por día"
  ) +
  theme_minimal() +
  theme(legend.position = "none")

ggplotly(grafico_dias)

El gráfico permite comparar la distribución y la variabilidad del número de citas entre los días de la semana. La línea central de cada caja representa la mediana, mientras que la caja resume la parte central de los datos y los puntos muestran observaciones individuales.

# Construir el primer día de cada mes
conteo_mensual <- datos %>%
  filter(!is.na(Date)) %>%
  mutate(
    MesInicio = as.Date(format(Date, "%Y-%m-01"))
  ) %>%
  count(MesInicio, name = "total_citas")

# Completar los meses del periodo observado
calendario_meses <- data.frame(
  MesInicio = seq(
    as.Date(format(fecha_inicial, "%Y-%m-01")),
    as.Date(format(fecha_final, "%Y-%m-01")),
    by = "month"
  )
)

citas_mes <- calendario_meses %>%
  left_join(conteo_mensual, by = "MesInicio") %>%
  mutate(
    total_citas = tidyr::replace_na(total_citas, 0L),
    Periodo = format(MesInicio, "%Y-%m")
  )

# Mantener el orden cronológico
citas_mes$Periodo <- factor(
  citas_mes$Periodo,
  levels = citas_mes$Periodo
)

# Crear gráfico con ggpubr
grafico_meses <- ggpubr::ggline(
  citas_mes,
  x = "Periodo",
  y = "total_citas",
  color = "steelblue",
  size = 0.8
) +
  geom_point(size = 2) +
  labs(
    title = "Evolución mensual de las citas registradas",
    x = "Mes y año",
    y = "Número de citas"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 60,
      hjust = 1
    )
  )

## Warning in .resolve_linewidth_args(size = size, linewidth = linewidth,
## default_linewidth = 0.5): The 'size' parameter for lines is deprecated in
## ggplot2 3.4.0+. Please use 'linewidth' instead to avoid this warning in future
## versions.

ggplotly(grafico_meses)

La gráfica demuestra la cantidad de citas registradas presenta un comportamiento variable durante los cuatro años analizados. El mayor número de citas se registra en abril de 2020, mientras que los valores mínimos se presentan en septiembre y octubre de 2020 y en agosto de 2023.

top_medicos <- datos %>%
  filter(!is.na(DoctorID)) %>%
  count(DoctorID, name = "total_citas", sort = TRUE) %>%
  slice_head(n = 10)

grafico_medicos <- ggpubr::ggbarplot(
  top_medicos,
  x = "DoctorID",
  y = "total_citas",
  fill = "DoctorID",
  palette = "jco",
  sort.val = "desc",
  rotate = TRUE
) +
  labs(
    title = "Diez identificadores con más citas registradas",
    x = "Identificador del médico",
    y = "Número de citas"
  ) +
  theme_minimal() +
  theme(legend.position = "none")

ggplotly(grafico_medicos)

La gráfica evidencia que los identificadores 170, 254 y 637 presentan la mayor cantidad de citas registradas, con cinco citas cada uno. Los otros siete identificadores cuentan con cuatro citas, por lo que la distribución es relativamente homogénea y no se observan diferencias pronunciadas entre los médicos incluidos en el análisis.

resumen_diario$TipoDia <- factor(
  ifelse(
    resumen_diario$DiaSemana %in% c("sábado", "domingo"),
    "Fin de semana",
    "Entre semana"
  ),
  levels = c("Entre semana", "Fin de semana")
)

grafico_tipo_dia <- ggpubr::ggboxplot(
  resumen_diario,
  x = "TipoDia",
  y = "citas",
  color = "TipoDia",
  palette = "jco",
  add = "jitter"
) +
  labs(
    title = "Comparación de citas entre semana y fin de semana",
    x = "Tipo de día",
    y = "Citas registradas por día"
  ) +
  theme_minimal() +
  theme(legend.position = "none")

ggplotly(grafico_tipo_dia)

La gráfica demuestra que las citas se concentran principalmente en valores bajos tanto entre semana como durante los fines de semana, aunque existen días con una cantidad considerablemente mayor de registros. Ambos grupos presentan variabilidad y valores atípicos, lo que refleja diferencias en la actividad diaria. Para determinar si el tipo de día influye significativamente en el número de citas registradas.

Interpretación de datos Desde la perspectiva de la administración de recursos sanitarios, estos gráficos constituyen herramientas de apoyo para identificar patrones de programación y formular preguntas sobre la distribución de agendas, la planificación del personal y la organización temporal de los servicios. No obstante, las visualizaciones describen los registros disponibles y no permiten, por sí solas, concluir que exista sobrecarga, baja productividad o deficiencias en la atención.

Interpretación del informe:

El presente informe tiene como propósito analizar la base de datos Appointment, correspondiente al registro de citas de un servicio de salud, mediante herramientas de probabilidad, estadística descriptiva e inferencial desarrolladas en RStudio a través de R Markdown. El análisis se orienta a comprender la distribución de la actividad registrada y a identificar oportunidades de mejora en la planificación administrativa de los servicios sanitarios.

La base de datos contiene cinco variables principales: AppointmentID, que identifica cada registro de cita; Date, que representa la fecha programada; Time, que corresponde al campo de hora y requiere validación de su formato; PatientID, que identifica al paciente, y DoctorID, que identifica al médico asociado con el registro. Estas variables permiten explorar aspectos relacionados con la distribución temporal de las citas y su asignación entre médicos, aunque no proporcionan información directa sobre la duración de la consulta, los tiempos de espera, las inasistencias, los costos ni los resultados clínicos.

3. Modelo Analítico

3.1. Definición del problema y preparación de los datos

3.1.1. Contexto, objetivos y selección de variables

Problema de gestión: una institución sanitaria necesita comprender cómo varía el número de citas registradas a lo largo del calendario, con el fin de explorar patrones temporales que puedan apoyar la planificación preliminar de agendas y recursos.

Objetivo general: construir un modelo de regresión que estime el número de registros de citas por día a partir del tiempo transcurrido, el mes y el día de la semana. Objetivos específicos: preparar los registros de citas, seleccionar variables pertinentes, dividir los datos en entrenamiento y prueba, ajustar un modelo, evaluar sus errores y presentar los resultados mediante gráficos interactivos, incluidos dos gráficos tridimensionales.

Métricas de éxito: se utilizarán RMSE (raíz del error cuadrático medio, que penaliza más los errores grandes) y MAE (error absoluto medio, que representa el error absoluto promedio). Como criterio inicial, el modelo deberá mostrar un RMSE menor que una referencia sencilla que siempre predice el promedio observado en los datos de entrenamiento. El error máximo aceptable para decisiones operativas deberá acordarlo la institución; no se fijará arbitrariamente. AUC no corresponde en este ejercicio porque la variable que se estima es numérica, no una categoría.

library(readxl)
library(dplyr)
library(tidyr)
library(skimr)
library(rsample)
library(broom)
library(yardstick)

## 
## Adjuntando el paquete: 'yardstick'

## The following object is masked from 'package:readr':
## 
##     spec

library(ggplot2)
library(plotly)
library(knitr)

appointment <- read_excel(
  "Appointment . Proyecto.xlsx",
  sheet = 1
)

# Comprobar las variables y los primeros registros
names(appointment)

## [1] "AppointmentID" "Date"          "Time"          "PatientID"    
## [5] "DoctorID"

head(appointment)

dim(appointment)

## [1] 1000    5

dplyr::glimpse(appointment)

## Rows: 1,000
## Columns: 5
## $ AppointmentID <dbl> 639, 404, 281, 628, 889, 551, 769, 385, 813, 986, 943, 9…
## $ Date          <dttm> 2022-04-08, 2023-04-10, 2022-12-09, 2020-01-08, 2023-08…
## $ Time          <chr> "2023-12-23T14:33:46.406Z", "2023-12-23T14:33:46.407Z", …
## $ PatientID     <dbl> 109, 823, 465, 443, 852, 160, 886, 480, 634, 898, 116, 2…
## $ DoctorID      <dbl> 462, 774, 226, 656, 262, 748, 580, 438, 662, 653, 889, 4…

skimr::skim(appointment)

Data summary
Name	appointment
Number of rows	1000
Number of columns	5
_______________________
Column type frequency:
character	1
numeric	3
POSIXct	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
Time	0	1	24	24	0	12	0

Variable type: numeric

skim_variable	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
AppointmentID	1	560.19	259.17	101	345.50	546	785	999	▇▇▇▇▇
PatientID	1	546.07	262.00	101	319.00	550	783	1000	▇▇▇▇▇
DoctorID	1	537.78	255.38	100	318.25	542	750	1000	▇▇▇▇▆

Variable type: POSIXct

skim_variable	n_missing	complete_rate	min	max	median	n_unique
Date	0	1	2020-01-01	2023-12-31	2021-12-20	721

datos_seleccionados <- appointment %>%
  select(Date) %>%
  mutate(Date = as.Date(Date)) %>%
  drop_na(Date)

# Verificar la fecha inicial, la fecha final y el número de registros
min(datos_seleccionados$Date)

## [1] "2020-01-01"

max(datos_seleccionados$Date)

## [1] "2023-12-31"

nrow(datos_seleccionados)

## [1] 1000

# Contar las citas registradas por fecha
conteo_diario <- datos_seleccionados %>%
  count(Date, name = "citas")

# Crear calendario completo del periodo observado
calendario <- data.frame(
  Date = seq(
    min(datos_seleccionados$Date),
    max(datos_seleccionados$Date),
    by = "day"
  )
)

# Incorporar el conteo diario al calendario
datos_modelo <- calendario %>%
  left_join(conteo_diario, by = "Date") %>%
  mutate(
    citas = tidyr::replace_na(citas, 0L)
  )

# Calcular variables temporales
orden_dias <- c(
  "lunes", "martes", "miércoles", "jueves",
  "viernes", "sábado", "domingo"
)

nombres_dias <- c(
  "domingo", "lunes", "martes", "miércoles",
  "jueves", "viernes", "sábado"
)

datos_modelo <- datos_modelo %>%
  mutate(
    tendencia = as.numeric(
      Date - min(Date)
    ),
    mes_num = as.integer(
      format(Date, "%m")
    ),
    mes = factor(
      format(Date, "%m"),
      levels = sprintf("%02d", 1:12)
    ),
    dia_semana = factor(
      nombres_dias[as.POSIXlt(Date)$wday + 1],
      levels = orden_dias
    )
  ) %>%
  arrange(Date)

# Revisar los datos que entrarán al modelo
head(datos_modelo)

summary(datos_modelo$citas)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.0000  0.6845  1.0000  4.0000

3.2. Construcción y ajuste del modelo

3.2.1. División de datos, entrenamiento y predicción

# Separar cronológicamente: 75 % para entrenamiento y 25 % para prueba
set.seed(123)

particion <- rsample::initial_time_split(
  datos_modelo,
  prop = 0.75
)

entrenamiento <- rsample::training(particion)
prueba <- rsample::testing(particion)

# Comprobar el tamaño de los grupos
nrow(entrenamiento)

## [1] 1095

nrow(prueba)

## [1] 366

# Revisar el intervalo temporal de cada conjunto
range(entrenamiento$Date)

## [1] "2020-01-01" "2022-12-30"

range(prueba$Date)

## [1] "2022-12-31" "2023-12-31"

Interpretación: el conjunto de entrenamiento se utiliza para estimar el modelo y el de prueba permite evaluar qué tan bien funciona en fechas que no se utilizaron para ajustarlo. Esta separación temporal resulta más cercana al escenario de utilizar información histórica para estimar periodos posteriores.

modelo_citas <- lm(
  citas ~ tendencia + mes + dia_semana,
  data = entrenamiento
)

summary(modelo_citas)

## 
## Call:
## lm(formula = citas ~ tendencia + mes + dia_semana, data = entrenamiento)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -0.9062 -0.6591 -0.5204  0.3790  3.3518 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          8.489e-01  1.083e-01   7.841 1.07e-14 ***
## tendencia           -7.859e-05  8.227e-05  -0.955   0.3397    
## mes02               -8.690e-02  1.218e-01  -0.713   0.4758    
## mes03               -2.012e-01  1.192e-01  -1.688   0.0917 .  
## mes04                3.236e-02  1.203e-01   0.269   0.7879    
## mes05               -1.828e-01  1.195e-01  -1.530   0.1263    
## mes06               -5.210e-02  1.207e-01  -0.432   0.6661    
## mes07               -1.909e-01  1.200e-01  -1.591   0.1118    
## mes08               -8.010e-02  1.203e-01  -0.666   0.5058    
## mes09               -1.452e-01  1.217e-01  -1.193   0.2333    
## mes10               -1.818e-01  1.212e-01  -1.500   0.1338    
## mes11               -1.503e-01  1.226e-01  -1.225   0.2207    
## mes12               -1.093e-01  1.225e-01  -0.892   0.3725    
## dia_semanamartes    -5.928e-03  9.193e-02  -0.064   0.9486    
## dia_semanamiércoles  3.208e-02  9.180e-02   0.349   0.7268    
## dia_semanajueves    -1.264e-02  9.183e-02  -0.138   0.8906    
## dia_semanaviernes    3.233e-02  9.183e-02   0.352   0.7249    
## dia_semanasábado    -6.500e-02  9.195e-02  -0.707   0.4798    
## dia_semanadomingo   -6.372e-02  9.193e-02  -0.693   0.4884    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8118 on 1076 degrees of freedom
## Multiple R-squared:  0.01212,    Adjusted R-squared:  -0.004405 
## F-statistic: 0.7334 on 18 and 1076 DF,  p-value: 0.7784

Interpretación:

Se demostraron valores no significativos en los meses y días por semanas en la mayoria de datos de la base de datos. Los datos con mayor concordancia al 10% o cercanos se determinan en el dia-semana sábado y en el mes 03 correspondiente a marzo.

3.3. Evaluación e interpretación de resultados

3.3.1. Diagnóstico, métricas, gráficos interactivos y acciones de mejora

# Predicciones en entrenamiento
pred_entrenamiento <- as.numeric(
  predict(modelo_citas, newdata = entrenamiento)
)

# Predicciones en prueba
pred_prueba <- as.numeric(
  predict(modelo_citas, newdata = prueba)
)

# Revisar algunos valores observados y estimados
comparacion_prueba <- prueba %>%
  mutate(
    prediccion = pred_prueba,
    error = citas - prediccion
  )

head(
  comparacion_prueba[
    , c("Date", "citas", "prediccion", "error")
  ]
)

# Métricas del modelo en entrenamiento
rmse_ent <- yardstick::rmse_vec(
  truth = entrenamiento$citas,
  estimate = pred_entrenamiento
)

mae_ent <- yardstick::mae_vec(
  truth = entrenamiento$citas,
  estimate = pred_entrenamiento
)

# Métricas del modelo en prueba
rmse_prueba <- yardstick::rmse_vec(
  truth = prueba$citas,
  estimate = pred_prueba
)

mae_prueba <- yardstick::mae_vec(
  truth = prueba$citas,
  estimate = pred_prueba
)

# Referencia simple: el promedio del entrenamiento
pred_base <- rep(
  mean(entrenamiento$citas),
  nrow(prueba)
)

rmse_base <- yardstick::rmse_vec(
  truth = prueba$citas,
  estimate = pred_base
)

mae_base <- yardstick::mae_vec(
  truth = prueba$citas,
  estimate = pred_base
)

# Tabla comparativa
metricas <- data.frame(
  Conjunto = c(
    "Entrenamiento: modelo",
    "Prueba: modelo",
    "Prueba: referencia simple"
  ),
  RMSE = round(
    c(rmse_ent, rmse_prueba, rmse_base),
    3
  ),
  MAE = round(
    c(mae_ent, mae_prueba, mae_base),
    3
  )
)

knitr::kable(
  metricas,
  caption = "Comparación de métricas del modelo de citas"
)

Comparación de métricas del modelo de citas
Conjunto	RMSE	MAE
Entrenamiento: modelo	0.805	0.679
Prueba: modelo	0.858	0.707
Prueba: referencia simple	0.849	0.709

Interpretación: RMSE y MAE expresan el tamaño promedio de los errores en unidades de citas por día; en ambas métricas, un valor más bajo indica una estimación más cercana a los registros observados. El modelo demuestra una mejora inicial si su RMSE de prueba es menor que el RMSE de la referencia simple. Si el error es igual o mayor, no hay evidencia de que esta regresión aporte una mejora respecto de la referencia. El umbral máximo aceptable para una decisión real deberá definirse con los responsables de la gestión.

if (rmse_prueba < rmse_base) {
  cat(
    "El modelo presenta un RMSE menor que la referencia simple ",
    "en el conjunto de prueba."
  )
} else {
  cat(
    "El modelo no mejora el RMSE de la referencia simple ",
    "en el conjunto de prueba."
  )
}

## El modelo no mejora el RMSE de la referencia simple  en el conjunto de prueba.

diagnostico <- broom::augment(modelo_citas)

grafico_residuos <- ggplot(
  diagnostico,
  aes(x = .fitted, y = .resid)
) +
  geom_point(
    alpha = 0.6,
    color = "#2471A3"
  ) +
  geom_hline(
    yintercept = 0,
    linetype = "dashed",
    color = "#C0392B"
  ) +
  labs(
    title = "Diagnóstico de residuos del modelo",
    x = "Valores estimados",
    y = "Residuos"
  ) +
  theme_minimal()

plotly::ggplotly(grafico_residuos)

Interpretación: Los residuos presentan patrones definidos y valores alejados de cero, en lugar de distribuirse aleatoriamente alrededor de la línea de referencia. Esto sugiere posibles limitaciones en el ajuste del modelo y presencia de observaciones que no logra explicar adecuadamente.

# Extraer los residuos estandarizados del modelo
residuos <- diagnostico$.std.resid

# Eliminar valores no válidos
residuos <- residuos[is.finite(residuos)]
residuos <- sort(residuos)

# Calcular los cuantiles teóricos y observados
qq_datos <- data.frame(
  teoricos = qnorm(ppoints(length(residuos))),
  observados = residuos
)

# Calcular una línea de referencia usando los cuartiles
cuantiles_obs <- quantile(
  residuos,
  c(0.25, 0.75),
  names = FALSE
)

cuantiles_teo <- qnorm(c(0.25, 0.75))

pendiente <- (
  cuantiles_obs[2] - cuantiles_obs[1]
) / (
  cuantiles_teo[2] - cuantiles_teo[1]
)

intercepto <- cuantiles_obs[1] -
  pendiente * cuantiles_teo[1]

linea_ref <- data.frame(
  teoricos = range(qq_datos$teoricos)
)

linea_ref$observados <- intercepto +
  pendiente * linea_ref$teoricos

# Construir el gráfico Q-Q
grafico_normalidad <- ggplot(
  qq_datos,
  aes(x = teoricos, y = observados)
) +
  geom_point(
    color = "#2471A3",
    alpha = 0.65,
    size = 2
  ) +
  geom_line(
    data = linea_ref,
    aes(x = teoricos, y = observados),
    inherit.aes = FALSE,
    color = "#C0392B",
    linewidth = 1
  ) +
  labs(
    title = "Gráfico Q-Q de los residuos del modelo",
    subtitle = "Evaluación visual de la normalidad aproximada",
    x = "Cuantiles teóricos normales",
    y = "Cuantiles observados de los residuos"
  ) +
  theme_minimal()

# Mostrar el gráfico interactivo
plotly::ggplotly(
  grafico_normalidad,
  tooltip = c("x", "y")
)

Interpretación: Los puntos se apartan considerablemente de la línea de referencia, especialmente en los extremos. Esto indica que los residuos no siguen aproximadamente una distribución normal, por lo que uno de los supuestos de la regresión lineal no se cumple adecuadamente.

grafico_3d_citas <- plotly::plot_ly(
  data = datos_modelo,
  x = ~tendencia,
  y = ~mes_num,
  z = ~citas,
  type = "scatter3d",
  mode = "markers",
  color = ~dia_semana,
  text = ~paste0(
    "Fecha: ", Date,
    "<br>Día: ", dia_semana,
    "<br>Mes: ", mes_num,
    "<br>Citas registradas: ", citas
  ),
  hoverinfo = "text",
  marker = list(
    size = 4,
    opacity = 0.75
  )
) %>%
  layout(
    title = "Gráfico 3D: distribución temporal de las citas",
    scene = list(
      xaxis = list(
        title = "Días desde el inicio del periodo"
      ),
      yaxis = list(
        title = "Mes del año"
      ),
      zaxis = list(
        title = "Citas registradas por día"
      )
    )
  )

grafico_3d_citas

Interpretación: La distribución evidencia variaciones en las citas a lo largo del tiempo, entre meses y días de la semana, con concentraciones en valores bajos y algunas observaciones superiores. Sin embargo, la visualización no demuestra por sí sola que marzo o el sábado sean los factores de mayor impacto.

predicciones_completas <- dplyr::bind_rows(
  entrenamiento %>%
    mutate(
      prediccion = pred_entrenamiento,
      conjunto = "Entrenamiento"
    ),
  prueba %>%
    mutate(
      prediccion = pred_prueba,
      conjunto = "Prueba"
    )
) %>%
  mutate(
    residuo = citas - prediccion
  )

head(
  predicciones_completas[
    , c(
      "Date", "citas", "prediccion",
      "residuo", "conjunto"
    )
  ]
)

grafico_3d_predicciones <- plotly::plot_ly(
  data = predicciones_completas,
  x = ~tendencia,
  y = ~citas,
  z = ~prediccion,
  type = "scatter3d",
  mode = "markers",
  color = ~conjunto,
  text = ~paste0(
    "Fecha: ", Date,
    "<br>Conjunto: ", conjunto,
    "<br>Citas observadas: ", citas,
    "<br>Citas estimadas: ",
    round(prediccion, 2),
    "<br>Error: ", round(residuo, 2)
  ),
  hoverinfo = "text",
  marker = list(
    size = 4,
    opacity = 0.75
  )
) %>%
  layout(
    title = "Gráfico 3D: citas observadas frente a estimaciones",
    scene = list(
      xaxis = list(
        title = "Días desde el inicio del periodo"
      ),
      yaxis = list(
        title = "Citas observadas"
      ),
      zaxis = list(
        title = "Citas estimadas por el modelo"
      )
    )
  )

grafico_3d_predicciones

Interpretación: Las predicciones del modelo se concentran en un intervalo estrecho, mientras que las citas observadas presentan mayor variabilidad. Esto sugiere que el modelo no representa adecuadamente los días con demanda elevada ni distingue con precisión las diferencias entre jornadas.

grafico_real_estimado <- ggplot(
  comparacion_prueba,
  aes(
    x = citas,
    y = prediccion,
    text = paste0(
      "Fecha: ", Date,
      "<br>Observado: ", citas,
      "<br>Estimado: ", round(prediccion, 2)
    )
  )
) +
  geom_point(
    color = "#2471A3",
    alpha = 0.7,
    size = 2
  ) +
  geom_abline(
    intercept = 0,
    slope = 1,
    linetype = "dashed",
    color = "#C0392B"
  ) +
  labs(
    title = "Citas observadas frente a citas estimadas",
    x = "Citas registradas realmente",
    y = "Citas estimadas por el modelo"
  ) +
  theme_minimal()

plotly::ggplotly(
  grafico_real_estimado,
  tooltip = "text"
)

Interpretación: Las estimaciones permanecen concentradas aproximadamente entre 0,5 y 0,8, aunque las citas observadas varían entre 0 y 4. La escasa correspondencia visual evidencia una capacidad limitada para reproducir los valores reales: el modelo tiende a estimar valores similares para jornadas con demandas diferentes.

3.3.2. Acciones de mejora para la gestión sanitaria

Acción 1. Mejorar la calidad y la disponibilidad de los datos. Validar el significado de Time e incorporar, cuando sea posible, información sobre citas realizadas, cancelaciones, inasistencias, duración de las consultas, horarios operativos y demanda no atendida. Esto permitiría distinguir los registros administrativos de las atenciones efectivas.

Acción 2. Incorporar nuevas variables y comparar modelos. Después de validar los datos, se podrían considerar festivos, vacaciones, disponibilidad de profesionales y otras variables relevantes. También sería conveniente comparar la regresión lineal con una regresión de Poisson, que está diseñada para analizar conteos. La comparación debe realizarse con datos no usados durante el ajuste.

Acción 3. Hacer seguimiento del error. Comparar periódicamente las estimaciones con los registros observados y establecer, junto con los responsables de la gestión, un nivel de error aceptable. Si el desempeño empeora, se deben revisar los datos y evaluar si es necesario ajustar el modelo.

Conclusión analítica tema #3

Desde la perspectiva operativa, el análisis muestra que la actividad registrada no se distribuye de manera uniforme a lo largo del calendario. Se identifican fechas con diferentes cantidades de citas y días sin registros dentro del periodo analizado. En el calendario completo de 1.461 días, 740 no presentan citas registradas en la base. Entre las fechas con registros, el máximo observado es de cuatro citas en un día. Estos resultados permiten describir la distribución temporal de la información, pero los días sin registros no deben interpretarse automáticamente como días sin demanda, dado que no se dispone de información sobre los horarios de funcionamiento ni sobre las solicitudes de atención que no terminaron en una cita.

En relación con el modelo analítico, se planteó estimar el número de registros de citas por día utilizando variables temporales como la tendencia, el mes y el día de la semana. El proceso incluye la preparación de los datos, la selección de variables, la división en conjuntos de entrenamiento y prueba, el ajuste de una regresión lineal, la generación de predicciones y la evaluación mediante RMSE y MAE. Asimismo, los gráficos de diagnóstico y las visualizaciones interactivas bidimensionales y tridimensionales permiten explorar las diferencias entre los valores observados y los estimados, facilitando la comunicación de los resultados a los responsables de la gestión.

R Markdown- Healthcare Management System

Laura Catalina Ortegate Perez

2026-10-16