---
title: "ECOBICI CDMX · 2025"
subtitle: "Patrones horarios, perfiles de estaciones y presión operativa"
output:
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: scroll
    theme: flatly
    source_code: embed
    self_contained: true
---

```{r setup, include=FALSE}
# Instalar una vez en consola:
# install.packages(c("flexdashboard", "data.table", "dplyr", "tidyr", "lubridate",
#   "ggplot2", "stringr", "scales", "cluster", "DT", "plotly", "leaflet", "broom"))
library(flexdashboard)
library(data.table)
library(dplyr)
library(tidyr)
library(lubridate)
library(ggplot2)
library(stringr)
library(scales)
library(cluster)
library(DT)
library(plotly)
library(leaflet)
library(broom)
knitr::opts_chunk$set(echo=FALSE, message=FALSE, warning=FALSE)
options(scipen=999)
niveles_dias <- c("lunes", "martes", "miércoles", "jueves", "viernes", "sábado", "domingo")
meses_es <- c("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre")
verde <- "#2E9E4F"; azul <- "#174A5B"; coral <- "#E76F51"
paleta <- c(verde,"#3274A1","#F4A261","#7A5195",coral,"#2A9D8F","#A67C00","#66757F")
tema <- theme_minimal(base_size=11) + theme(legend.position="bottom",
 panel.grid.minor=element_blank(), plot.title=element_text(color=azul,face="bold"),
 plot.margin=margin(10,12,8,8))
# Márgenes automáticos y espacio para etiquetas en gráficas interactivas.
widget <- function(p) {
  ggplotly(p + tema, height=420, width=NULL) %>%
    layout(autosize=TRUE, margin=list(l=95,r=45,t=60,b=95),
      xaxis=list(automargin=TRUE),yaxis=list(automargin=TRUE),
      legend=list(orientation="h",x=0,y=-.22,xanchor="left",yanchor="top",font=list(size=11)),
      hoverlabel=list(font=list(size=12))) %>%
    config(displayModeBar=FALSE,responsive=TRUE)
}
tabla <- function(x) datatable(x, rownames=FALSE, class="compact stripe",
 options=list(pageLength=8,scrollX=TRUE,autoWidth=TRUE,dom="ftip",
  language=list(search="Buscar:",lengthMenu="Mostrar _MENU_ filas",
    info="_START_–_END_ de _TOTAL_",infoEmpty="Sin filas",zeroRecords="Sin coincidencias",
    paginate=list(previous="Anterior",`next`="Siguiente"))))

# Estructura esperada: data/viajes_limpios_2025.rds, data/Catálogo Ecobici.csv,
# data/raw/2025-01.csv ... 2025-12.csv. El notebook se conserva en la raíz.
# TRUE fuerza reconstrucción desde CSV. FALSE prefiere el RDS existente.
reconstruir_desde_csv <- FALSE
ruta_rds <- "data/viajes_limpios_2025.rds"
ruta_raw <- "data/raw"
candidatos <- c("data/Catálogo Ecobici.csv", "data/Catálogo_Ecobici.csv")
existen <- candidatos[file.exists(candidatos)]
if (length(existen) != 1) stop("Deja exactamente un catálogo: data/Catálogo Ecobici.csv o data/Catálogo_Ecobici.csv.")
archivo_catalogo <- existen[1]
normalizar <- function(x) gsub("[^a-z0-9]", "", tolower(iconv(x,to="ASCII//TRANSLIT")))
columna <- function(df, nombre, requerida=TRUE) {
 i <- which(normalizar(names(df)) == normalizar(nombre))
 if(length(i)) return(df[[i[1]]])
 if(requerida) stop("Falta columna ", nombre, ". Disponibles: ", paste(names(df),collapse=", "))
 rep(NA_character_,nrow(df))
}
# Se recortan espacios igual que en el notebook; no se fusionan IDs compuestos.
id <- function(x) na_if(str_trim(as.character(x)), "")
cat_raw <- fread(archivo_catalogo, encoding="UTF-8", colClasses="character")
catalogo_estaciones <- tibble(num_cicloe=id(columna(cat_raw,"num_cicloe")),
 colonia=columna(cat_raw,"colonia"), alcaldia=columna(cat_raw,"alcaldia"),
 latitud=suppressWarnings(as.numeric(columna(cat_raw,"latitud"))),
 longitud=suppressWarnings(as.numeric(columna(cat_raw,"longitud")))) %>% filter(!is.na(num_cicloe))
# El notebook conserva el primer registro de cada ID: no ocultar inconsistencias.
if(anyDuplicated(catalogo_estaciones$num_cicloe)) stop("El catálogo tiene IDs duplicados. Revisa sus atributos antes de unirlo.")
rm(cat_raw)
calidad_cruda <- NULL
if(file.exists(ruta_rds) && !reconstruir_desde_csv) {
 viajes <- readRDS(ruta_rds)
 if(!inherits(viajes,"data.frame")) stop("El RDS debe contener el objeto viajes del notebook (data.frame/data.table).")
 viajes <- as_tibble(viajes)
 origen <- "RDS del equipo; limpieza original no reestimada"
} else {
 archivos <- file.path(ruta_raw, sprintf("2025-%02d.csv",1:12))
 if(any(!file.exists(archivos))) stop("Faltan CSV: ", paste(basename(archivos[!file.exists(archivos)]),collapse=", "))
 # Cada archivo normaliza sus nombres antes de unir. La limpieza global respeta el notebook.
 lista <- lapply(archivos, function(f) {
  x <- fread(f, encoding="UTF-8",colClasses="character",showProgress=FALSE)
  tibble(Edad_Usuario=columna(x,"Edad_Usuario"), Bici=columna(x,"Bici"),
   Fecha_Retiro=columna(x,"Fecha_Retiro"), Hora_Retiro=columna(x,"Hora_Retiro"),
   Fecha_Arribo=columna(x,"Fecha_Arribo"), Hora_Arribo=columna(x,"Hora_Arribo"),
   Genero_Usuario=columna(x,"Genero_Usuario"),
   Ciclo_Estacion_Retiro=columna(x,"Ciclo_Estacion_Retiro"),
   Ciclo_EstacionArribo=columna(x,"Ciclo_EstacionArribo"))
 })
 viajes_raw <- bind_rows(lista); rm(lista); invisible(gc())
 viajes_raw <- viajes_raw %>% mutate(Edad_Usuario=suppressWarnings(as.numeric(Edad_Usuario)),Bici=as.character(Bici))
 n_inicial <- nrow(viajes_raw)
 viajes <- distinct(viajes_raw); n_dup <- n_inicial-nrow(viajes); rm(viajes_raw); invisible(gc())
 viajes <- viajes %>% mutate(
  fecha_hora_retiro=parse_date_time(paste(Fecha_Retiro,Hora_Retiro),orders=c("dmy HMS","dmy HM"),quiet=TRUE),
  fecha_hora_arribo=parse_date_time(paste(Fecha_Arribo,Hora_Arribo),orders=c("dmy HMS","dmy HM"),quiet=TRUE))
 n_fecha_na <- sum(is.na(viajes$fecha_hora_retiro)|is.na(viajes$fecha_hora_arribo))
 viajes <- viajes %>% filter(!is.na(fecha_hora_retiro),!is.na(fecha_hora_arribo)) %>%
  mutate(fecha_retiro=as.Date(fecha_hora_retiro),
   duracion_min=as.numeric(difftime(fecha_hora_arribo,fecha_hora_retiro,units="mins")))
 n_fuera <- sum(year(viajes$fecha_retiro)!=2025)
 viajes <- filter(viajes,year(fecha_retiro)==2025)
 calidad_cruda <- tibble(Control=c("Registros originales","Duplicados exactos","Fecha/hora no interpretable","Fuera de 2025","Finales para demanda"),
  Registros=c(n_inicial,n_dup,n_fecha_na,n_fuera,nrow(viajes)))
 origen <- "CSV 2025; limpieza reconstruida"
}

# Columnas verificadas en el head() compartido por el equipo.
# El dashboard carga la base limpia directamente; no requiere adjuntar el RDS.
# Los IDs se conservan como texto (ejemplo: 004, 001).
# Las clases POSIXt y la cobertura anual se comprueban al ejecutar Knit.
viajes$Ciclo_Estacion_Retiro <- id(columna(viajes,"Ciclo_Estacion_Retiro"))
viajes$Ciclo_EstacionArribo <- id(columna(viajes,"Ciclo_EstacionArribo"))
if(!all(c("fecha_hora_retiro","fecha_hora_arribo","Edad_Usuario","Genero_Usuario") %in% names(viajes)))
 stop("El RDS no contiene las columnas procesadas del notebook. Adjunta su estructura o usa reconstruir_desde_csv <- TRUE.")
if(!inherits(viajes$fecha_hora_retiro,"POSIXt") || !inherits(viajes$fecha_hora_arribo,"POSIXt"))
 stop("Las fechas del RDS deben ser POSIXct/POSIXlt como en el notebook.")
viajes <- viajes %>% mutate(fecha_retiro=as.Date(fecha_hora_retiro),
 hora_retiro_num=hour(fecha_hora_retiro),hora_arribo_num=hour(fecha_hora_arribo),
 dia_semana=factor(wday(fecha_retiro,week_start=1),levels=1:7,labels=niveles_dias),
 mes=floor_date(fecha_retiro,"month"),fin_semana=dia_semana %in% c("sábado","domingo"),
 duracion_min=as.numeric(difftime(fecha_hora_arribo,fecha_hora_retiro,units="mins")),
 Edad_Usuario=suppressWarnings(as.numeric(Edad_Usuario)))
if(anyNA(viajes$fecha_hora_retiro)||anyNA(viajes$fecha_hora_arribo)||any(year(viajes$fecha_retiro)!=2025))
 stop("El RDS tiene fechas inválidas o viajes fuera de 2025. Revisa su limpieza; no se eliminan silenciosamente.")
viajes <- viajes %>% mutate(
 duracion_analitica=if_else(duracion_min>=1 & duracion_min<=180,duracion_min,NA_real_),
 edad_analitica=if_else(Edad_Usuario>=12 & Edad_Usuario<=90,Edad_Usuario,NA_real_),
 Genero_Usuario=case_when(Genero_Usuario %in% c("M","F","O") ~ Genero_Usuario,TRUE ~ "No especificado")) %>%
 select(-any_of(c("colonia","alcaldia","latitud","longitud"))) %>%
 left_join(catalogo_estaciones,by=c("Ciclo_Estacion_Retiro"="num_cicloe"))
if(n_distinct(viajes$mes)!=12) stop("La base no contiene viajes de los 12 meses de 2025.")
if(!file.exists(ruta_rds)||reconstruir_desde_csv) {
 dir.create("data",showWarnings=FALSE); saveRDS(viajes,ruta_rds)
}
n_final <- nrow(viajes)

# 4.1 Demanda por hora del día
demanda_hora <- viajes %>%
  count(hora_retiro_num, name = "n") %>%
  arrange(hora_retiro_num)

hora_pico <- demanda_hora %>%
  slice_max(n, n = 1, with_ties = FALSE)

ggplot(demanda_hora, aes(hora_retiro_num, n)) +
  geom_col(fill = "steelblue") +
  scale_x_continuous(breaks = 0:23) +
  scale_y_continuous(labels = label_number(big.mark = ",")) +
  labs(
    title = "Viajes totales por hora del día",
    x = "Hora de retiro",
    y = "Número de viajes"
  )

# 4.2 Demanda por día de la semana
demanda_dia <- viajes %>%
  count(dia_semana, name = "n")

dia_max <- demanda_dia %>%
  slice_max(n, n = 1, with_ties = FALSE)

dia_min <- demanda_dia %>%
  slice_min(n, n = 1, with_ties = FALSE)

ggplot(demanda_dia, aes(dia_semana, n)) +
  geom_col(fill = "darkorange") +
  scale_y_continuous(labels = label_number(big.mark = ",")) +
  labs(
    title = "Viajes por día de la semana",
    x = NULL,
    y = "Número de viajes"
  ) +
  theme(axis.text.x = element_text(angle = 30, hjust = 1))

# 4.3 Estacionalidad mensual
demanda_mes <- viajes %>%
  count(mes, name = "n") %>%
  arrange(mes)

mes_max <- demanda_mes %>%
  slice_max(n, n = 1, with_ties = FALSE)

mes_min <- demanda_mes %>%
  slice_min(n, n = 1, with_ties = FALSE)

ggplot(demanda_mes, aes(mes, n)) +
  geom_line(linewidth = 1, color = "steelblue") +
  geom_point() +
  scale_x_date(date_breaks = "1 month", date_labels = "%b") +
  scale_y_continuous(labels = label_number(big.mark = ",")) +
  labs(
    title = "Viajes por mes",
    x = NULL,
    y = "Número de viajes"
  )

# 4.4 Top-20 estaciones por retiros
top_estaciones <- viajes %>%
  count(Ciclo_Estacion_Retiro, colonia, sort = TRUE, name = "n") %>%
  slice_head(n = 20)

estacion_top <- top_estaciones %>%
  slice_head(n = 1)

ggplot(
  top_estaciones,
  aes(reorder(paste(Ciclo_Estacion_Retiro, colonia), n), n)
) +
  geom_col(fill = "seagreen") +
  coord_flip() +
  scale_y_continuous(labels = label_number(big.mark = ",")) +
  labs(
    title = "Top estaciones por retiros",
    x = NULL,
    y = "Viajes"
  )

# 4.5 Demanda por alcaldía
demanda_alcaldia <- viajes %>%
  filter(!is.na(alcaldia), str_trim(alcaldia) != "") %>%
  count(alcaldia, sort = TRUE, name = "n")

alcaldia_top <- demanda_alcaldia %>%
  slice_head(n = 1)

ggplot(demanda_alcaldia, aes(reorder(alcaldia, n), n)) +
  geom_col(fill = "purple") +
  coord_flip() +
  scale_y_continuous(labels = label_number(big.mark = ",")) +
  labs(
    title = "Viajes por alcaldía (estación de retiro)",
    x = NULL,
    y = "Viajes"
  )

# 4.6 Balance retiros vs. arribos
retiros <- viajes %>%
  count(estacion = Ciclo_Estacion_Retiro, name = "retiros")

arribos <- viajes %>%
  count(estacion = Ciclo_EstacionArribo, name = "arribos")

balance <- full_join(retiros, arribos, by = "estacion") %>%
  mutate(
    retiros = replace_na(retiros, 0L),
    arribos = replace_na(arribos, 0L),
    balance_neto = arribos - retiros,
    abs_balance = abs(balance_neto)
  )

mayor_deficit <- balance %>%
  slice_min(balance_neto, n = 1, with_ties = FALSE)

mayor_superavit <- balance %>%
  slice_max(balance_neto, n = 1, with_ties = FALSE)

balance %>%
  slice_max(abs_balance, n = 20, with_ties = FALSE) %>%
  ggplot(
    aes(
      reorder(estacion, balance_neto),
      balance_neto,
      fill = balance_neto > 0
    )
  ) +
  geom_col() +
  coord_flip() +
  geom_hline(yintercept = 0, linetype = "dashed") +
  scale_y_continuous(labels = label_number(big.mark = ",")) +
  scale_fill_manual(
    values = c("firebrick", "steelblue"),
    guide = "none"
  ) +
  labs(
    title = "Estaciones con mayor desbalance (arribos - retiros)",
    x = "Estación",
    y = "Balance neto"
  )

# 4.7 Duración de viajes
ggplot(
  viajes %>% filter(!is.na(duracion_analitica)),
  aes(duracion_analitica)
) +
  geom_histogram(binwidth = 5, fill = "tomato") +
  labs(
    title = "Distribución de duración de viajes",
    subtitle = "Duraciones entre 1 y 180 minutos",
    x = "Minutos",
    y = "Frecuencia"
  )

# 4.8 Demografía
ggplot(
  viajes %>% filter(!is.na(edad_analitica)),
  aes(edad_analitica, fill = Genero_Usuario)
) +
  geom_histogram(binwidth = 5, position = "identity", alpha = 0.5) +
  labs(
    title = "Distribución de edad por género",
    x = "Edad",
    y = "Frecuencia",
    fill = "Género"
  )

# 4.9 Heatmap estación x hora
top_est_ids <- viajes %>%
  count(Ciclo_Estacion_Retiro, sort = TRUE) %>%
  slice_head(n = 25) %>%
  pull(Ciclo_Estacion_Retiro)

conteos_heatmap <- viajes %>%
  filter(Ciclo_Estacion_Retiro %in% top_est_ids) %>%
  count(Ciclo_Estacion_Retiro, hora_retiro_num, name = "n")

heatmap_datos <- expand_grid(
  Ciclo_Estacion_Retiro = top_est_ids,
  hora_retiro_num = 0:23
) %>%
  left_join(
    conteos_heatmap,
    by = c("Ciclo_Estacion_Retiro", "hora_retiro_num")
  ) %>%
  mutate(n = replace_na(n, 0L)) %>%
  group_by(Ciclo_Estacion_Retiro) %>%
  mutate(prop = n / sum(n)) %>%
  ungroup() %>%
  mutate(
    Ciclo_Estacion_Retiro = factor(
      Ciclo_Estacion_Retiro,
      levels = rev(top_est_ids)
    )
  )

picos_estaciones <- heatmap_datos %>%
  group_by(Ciclo_Estacion_Retiro) %>%
  slice_max(prop, n = 1, with_ties = FALSE) %>%
  ungroup()

hora_pico_comun <- picos_estaciones %>%
  count(hora_retiro_num, sort = TRUE) %>%
  slice_head(n = 1)

ggplot(
  heatmap_datos,
  aes(hora_retiro_num, Ciclo_Estacion_Retiro, fill = prop)
) +
  geom_tile() +
  scale_x_continuous(breaks = seq(0, 23, 2)) +
  scale_fill_viridis_c(
    name = "% viajes\nde la estación",
    labels = label_percent(accuracy = 0.1)
  ) +
  labs(
    title = "Distribución horaria de retiros por estación (top estaciones)",
    subtitle = "Cada estación se normaliza respecto a su propio volumen",
    x = "Hora del día",
    y = "Estación"
  )
# Matriz estación x hora
estaciones_validas <- viajes %>%
  count(Ciclo_Estacion_Retiro, name = "total") %>%
  filter(!is.na(Ciclo_Estacion_Retiro), Ciclo_Estacion_Retiro != "", total >= 50) %>%
  pull(Ciclo_Estacion_Retiro)

perfil_horario_long <- expand_grid(
  Ciclo_Estacion_Retiro = estaciones_validas,
  hora_retiro_num = 0:23
) %>%
  left_join(
    viajes %>%
      filter(Ciclo_Estacion_Retiro %in% estaciones_validas) %>%
      count(Ciclo_Estacion_Retiro, hora_retiro_num, name = "n"),
    by = c("Ciclo_Estacion_Retiro", "hora_retiro_num")
  ) %>%
  mutate(n = replace_na(n, 0L)) %>%
  group_by(Ciclo_Estacion_Retiro) %>%
  mutate(prop = n / sum(n)) %>%
  ungroup()

perfil_horario <- perfil_horario_long %>%
  select(Ciclo_Estacion_Retiro, hora_retiro_num, prop) %>%
  pivot_wider(
    names_from = hora_retiro_num,
    values_from = prop,
    values_fill = 0,
    names_prefix = "h"
  )

mat_cluster <- perfil_horario %>%
  select(-Ciclo_Estacion_Retiro) %>%
  as.matrix()

rownames(mat_cluster) <- perfil_horario$Ciclo_Estacion_Retiro

# Las columnas sin variación no aportan distancia entre estaciones y
# producen problemas al proyectar los clusters mediante componentes principales.
desv_columnas <- apply(mat_cluster, 2, sd, na.rm = TRUE)
columnas_utiles <- is.finite(desv_columnas) & desv_columnas > 0
columnas_constantes <- colnames(mat_cluster)[!columnas_utiles]
mat_cluster <- mat_cluster[, columnas_utiles, drop = FALSE]

if (ncol(mat_cluster) < 2) {
  stop("No hay suficientes horas con variación para realizar el clustering.")
}

if (nrow(mat_cluster) < 3) {
  stop("No hay suficientes estaciones para realizar el clustering.")
}

cat("Estaciones incluidas en el clustering:", nrow(mat_cluster), "\n")
cat("Variables horarias utilizadas:", ncol(mat_cluster), "\n")
if (length(columnas_constantes) > 0) {
  cat(
    "Horas sin variación excluidas de la matriz:",
    paste(columnas_constantes, collapse = ", "), "\n"
  )
}

# Evaluación del número de clusters
k_max <- min(8, nrow(mat_cluster) - 1, nrow(unique(as.data.frame(mat_cluster))) - 1)
if (k_max < 2) stop("No hay suficientes perfiles distintos para evaluar clustering.")
distancias <- dist(mat_cluster)

set.seed(123)
evaluacion_k <- bind_rows(lapply(2:k_max, function(k) {
  ajuste <- kmeans(mat_cluster, centers = k, nstart = 25, iter.max = 100)
  sil <- silhouette(ajuste$cluster, distancias)

  tibble(
    k = k,
    WSS = ajuste$tot.withinss,
    silueta = mean(sil[, 3])
  )
}))

k_elegido <- evaluacion_k$k[which.max(evaluacion_k$silueta)]
silueta_elegida <- max(evaluacion_k$silueta)



# Ajuste final
set.seed(123)
km <- kmeans(
  mat_cluster,
  centers = k_elegido,
  nstart = 50,
  iter.max = 100
)

perfil_horario$cluster <- factor(km$cluster)
silueta_final <- mean(silhouette(km$cluster, distancias)[, 3])


# Perfil horario promedio por cluster
perfil_cluster <- perfil_horario_long %>%
  left_join(
    perfil_horario %>%
      select(Ciclo_Estacion_Retiro, cluster),
    by = "Ciclo_Estacion_Retiro"
  ) %>%
  group_by(cluster, hora_retiro_num) %>%
  summarise(prop_media = mean(prop), .groups = "drop")

resumen_clusters <- perfil_cluster %>%
  group_by(cluster) %>%
  summarise(
    hora_pico = hora_retiro_num[which.max(prop_media)],
    proporcion_pico = max(prop_media),
    .groups = "drop"
  ) %>%
  left_join(
    perfil_horario %>% count(cluster, name = "n_estaciones"),
    by = "cluster"
  )

perfil_cluster %>%
  ggplot(aes(hora_retiro_num, prop_media, color = cluster)) +
  geom_line(linewidth = 1) +
  scale_x_continuous(breaks = 0:23) +
  scale_y_continuous(labels = label_percent(accuracy = 0.1)) +
  labs(
    title = "Perfil horario promedio por cluster",
    x = "Hora del día",
    y = "Proporción media de viajes",
    color = "Cluster"
  )

# Composición territorial de los clusters
clusters_alcaldia <- perfil_horario %>%
  left_join(
    catalogo_estaciones %>% select(num_cicloe, alcaldia),
    by = c("Ciclo_Estacion_Retiro" = "num_cicloe")
  ) %>%
  filter(!is.na(alcaldia), str_trim(alcaldia) != "") %>%
  count(cluster, alcaldia)

clusters_alcaldia %>%
  ggplot(aes(alcaldia, n, fill = cluster)) +
  geom_col(position = "fill") +
  coord_flip() +
  scale_y_continuous(labels = label_percent(accuracy = 1)) +
  labs(
    title = "Composición de clusters por alcaldía",
    y = "Proporción",
    x = NULL,
    fill = "Cluster"
  )

knitr::kable(
  resumen_clusters,
  digits = 3,
  col.names = c(
    "Cluster",
    "Hora pico",
    "Proporción en hora pico",
    "Número de estaciones"
  )
)

# Complementos para comunicación y mapas.
diario <- tibble(fecha_retiro=seq(as.Date("2025-01-01"),as.Date("2025-12-31"),by="day")) %>%
 left_join(count(viajes,fecha_retiro,name="n"),by="fecha_retiro") %>%
 mutate(dia_semana=factor(wday(fecha_retiro,week_start=1),levels=1:7,labels=niveles_dias),mes=floor_date(fecha_retiro,"month"))
mensual <- demanda_mes %>% mutate(promedio_diario=n/days_in_month(mes))
dia_promedio <- diario %>% group_by(dia_semana) %>% summarise(promedio=mean(n,na.rm=TRUE),.groups="drop")
heat_dia <- viajes %>% count(dia_semana,hora_retiro_num,name="n") %>%
 complete(dia_semana,hora_retiro_num=0:23,fill=list(n=0))
demanda_estacion <- viajes %>% filter(!is.na(Ciclo_Estacion_Retiro)) %>%
 count(Ciclo_Estacion_Retiro,name="n") %>% left_join(catalogo_estaciones,by=c("Ciclo_Estacion_Retiro"="num_cicloe"))
mapa_demanda <- demanda_estacion %>% filter(between(latitud,19,20),between(longitud,-100,-98))
mapa_cluster <- perfil_horario %>% select(Ciclo_Estacion_Retiro,cluster) %>%
 left_join(catalogo_estaciones,by=c("Ciclo_Estacion_Retiro"="num_cicloe")) %>%
 filter(between(latitud,19,20),between(longitud,-100,-98))
pct_sin_catalogo <- mean(is.na(viajes$alcaldia))
mediana_duracion <- median(viajes$duracion_analitica,na.rm=TRUE)
# PCA es únicamente una proyección visual; distancias del modelo permanecen sin escalar.
pca <- prcomp(mat_cluster,center=TRUE,scale.=FALSE)
pca_df <- tibble(PC1=pca$x[,1],PC2=pca$x[,2],cluster=factor(km$cluster))
var_pca <- sum(pca$sdev[1:2]^2)/sum(pca$sdev^2)

# Regresión complementaria: reproduce la versión del notebook del equipo.
# Selección retrospectiva: estación con más retiros en TODO 2025.
top_estacion <- viajes %>% filter(!is.na(Ciclo_Estacion_Retiro)) %>%
 count(Ciclo_Estacion_Retiro,sort=TRUE) %>% slice_head(n=1) %>% pull(Ciclo_Estacion_Retiro)
serie_observada <- viajes %>% filter(Ciclo_Estacion_Retiro==top_estacion) %>%
 count(fecha_retiro,hora_retiro_num,name="viajes")
serie_top <- expand_grid(fecha_retiro=seq(min(serie_observada$fecha_retiro),
 max(serie_observada$fecha_retiro),by="day"),hora_retiro_num=0:23) %>%
 left_join(serie_observada,by=c("fecha_retiro","hora_retiro_num")) %>%
 mutate(viajes=replace_na(viajes,0L),
 dia_semana=factor(wday(fecha_retiro,week_start=1),levels=1:7,labels=niveles_dias))
fechas_disponibles <- sort(unique(serie_top$fecha_retiro))
indice_corte <- floor(.80*length(fechas_disponibles))
if(indice_corte<7 || indice_corte>=length(fechas_disponibles)) stop("No hay fechas suficientes para train/test.")
fecha_corte <- fechas_disponibles[indice_corte]
train <- filter(serie_top,fecha_retiro<=fecha_corte); test <- filter(serie_top,fecha_retiro>fecha_corte)
modelo_hora_lineal <- lm(viajes~hora_retiro_num+dia_semana,data=train)
modelo_baseline <- lm(viajes~factor(hora_retiro_num)+dia_semana,data=train)
pred_lineal <- pmax(predict(modelo_hora_lineal,newdata=test),0)
pred_categoria <- pmax(predict(modelo_baseline,newdata=test),0)
metricas <- function(real,pred) {
 sst <- sum((real-mean(real))^2)
 tibble(RMSE=sqrt(mean((real-pred)^2)),MAE=mean(abs(real-pred)),
 R2_test=if(sst>0) 1-sum((real-pred)^2)/sst else NA_real_)
}
metricas_modelos <- bind_rows(metricas(test$viajes,pred_lineal) %>% mutate(Modelo="Hora lineal"),
 metricas(test$viajes,pred_categoria) %>% mutate(Modelo="Hora categórica")) %>% select(Modelo,everything())
test <- mutate(test,pred=pred_categoria,residual=viajes-pred)
pred_diaria <- test %>% group_by(fecha_retiro) %>% summarise(Observado=sum(viajes),Predicho=sum(pred),.groups="drop") %>%
 pivot_longer(-fecha_retiro,names_to="Serie",values_to="Viajes")
coefs_hora <- broom::tidy(modelo_baseline) %>% filter(str_detect(term,"factor\\(hora_retiro_num\\)")) %>%
 mutate(hora=as.integer(str_extract(term,"\\d+$")))
# Resultados de comunicación; todos se calculan desde la base del equipo.
rmse_lineal <- metricas_modelos$RMSE[metricas_modelos$Modelo=="Hora lineal"]
rmse_categoria <- metricas_modelos$RMSE[metricas_modelos$Modelo=="Hora categórica"]
mae_categoria <- metricas_modelos$MAE[metricas_modelos$Modelo=="Hora categórica"]
r2_categoria <- metricas_modelos$R2_test[metricas_modelos$Modelo=="Hora categórica"]
mejora_rmse <- if(rmse_lineal>0) 100*(rmse_lineal-rmse_categoria)/rmse_lineal else NA_real_
porcentaje_top20 <- sum(top_estaciones$n)/n_final
pct_hora_pico <- hora_pico$n/n_final
balance <- balance %>% mutate(movimientos=retiros+arribos,
 desequilibrio_relativo=if_else(movimientos>0,balance_neto/movimientos,NA_real_))
cluster_descripcion <- perfil_cluster %>% group_by(cluster) %>% summarise(
 manana_6_10=sum(prop_media[hora_retiro_num %in% 6:10]),
 tarde_16_20=sum(prop_media[hora_retiro_num %in% 16:20]),.groups="drop") %>%
 left_join(resumen_clusters,by="cluster")
calidad_mensual <- diario %>% group_by(mes) %>% summarise(
 dias_calendario=n(),dias_con_registro=sum(!is.na(n)),
 cobertura=dias_con_registro/dias_calendario,.groups="drop")
# Enlaces editoriales: completar cuando se publique y se cree el repositorio.
url_visualizacion <- ""
url_repositorio <- ""
integrantes <- "Completar nombres de integrantes antes de publicar"
# Cache ligero para compartir resultados SIN viajes individuales: no se lee en este dashboard.
dir.create("output",showWarnings=FALSE)
saveRDS(list(evaluacion_k=evaluacion_k,perfil_horario=perfil_horario,
 resumen_clusters=resumen_clusters,km=km,modelo_baseline=modelo_baseline,
 metricas_modelos=metricas_modelos,fecha_corte=fecha_corte,top_estacion=top_estacion),
 "output/resultados_dashboard_2025.rds")
invisible(gc())
```

<style>
body {background:#F3F6F5;color:#263238;font-family:"Segoe UI",Arial,sans-serif;}
.navbar {background:#174A5B;border-color:#174A5B;}
.navbar-brand {font-size:17px;}
.navbar-nav>li>a {font-size:12px;padding-left:11px;padding-right:11px;white-space:normal;}
.chart-wrapper {border-radius:10px;border:1px solid #DFE7E3;box-shadow:0 3px 10px rgba(23,74,91,.05);margin-bottom:18px;}
.chart-title {color:#174A5B;font-weight:600;font-size:15px;white-space:normal;overflow:visible;line-height:1.4;height:auto;}
.chart-stage {padding:18px 22px;}
.chart-stage p,.chart-stage li {font-size:14px;line-height:1.75;overflow-wrap:anywhere;}
.chart-stage h4 {color:#174A5B;margin-top:18px;}
.chart-stage table {width:100%;}
.chart-stage th,.chart-stage td {padding:9px;vertical-align:top;}
table.dataTable thead th {background:#174A5B;color:white;white-space:normal;}
.chart-stage .html-widget {max-width:100%;}
.chart-stage a {color:#176B3A;}
@media(max-width:768px){.chart-stage{padding:12px}.chart-stage p{font-size:13px}.navbar-nav>li>a{font-size:13px}}
</style>

# Proyecto

## Row

### Problema, contexto y objetivo
ECOBICI conecta estaciones mediante viajes que cambian de intensidad según la hora y el territorio. Conocer esas diferencias permite organizar el seguimiento de la operación y distinguir patrones que se pierden al observar únicamente el total anual.

Este proyecto estudia **viajes registrados entre enero y diciembre de 2025**. Su objetivo es describir cuándo y dónde se concentran los retiros, identificar perfiles horarios de estaciones mediante K-Means y evaluar una regresión sencilla de demanda horaria para una estación de alta actividad.

### Pregunta principal e hipótesis
**¿Cómo varía la demanda de ECOBICI por estación y hora del día durante 2025, y pueden agruparse las estaciones en perfiles de uso similares que ayuden a identificar periodos de mayor presión operativa?**

La hipótesis de trabajo es que los retiros no se distribuyen homogéneamente entre estaciones ni horas. Se examina mediante distribuciones de demanda y agrupaciones; no se presenta como una hipótesis causal ni como una prueba formal de significancia.

## Row

### Alcance y unidades de análisis

| Elemento | Definición |
|---|---|
| Población observada | Viajes registrados en ECOBICI durante 2025 |
| Registro original | Viaje con estación y fecha/hora de retiro y arribo |
| Clustering | Estación, representada por proporciones en las 24 horas |
| Regresión | Número de retiros por fecha y hora de una estación |
| Variables | Hora, día de semana, mes, estación y atributos territoriales |
| Territorio | Estaciones incluidas en los viajes y catálogo disponible |

### Cómo leer el dashboard
**Demanda** describe el ritmo temporal; **Territorio** identifica concentración; **Balance** describe diferencias de flujos. **Clustering** y **Predicción** muestran qué aportan los modelos y cómo se evalúan. **Conclusiones** reúne la respuesta y sus límites; **Calidad** y **Método** documentan el proceso.

Aquí “demanda” significa viajes efectivamente realizados. No incluye solicitudes que no pudieron atenderse. Edad y género describen viajes por características reportadas, no una muestra de usuarios únicos.

# Resumen
## Row {data-height=140}
### Viajes registrados
```{r}
valueBox(comma(n_final),caption="Viajes de 2025",icon="fa-bicycle",color=verde)
```
### Estaciones observadas
```{r}
valueBox(comma(nrow(demanda_estacion)),caption="IDs con al menos un retiro",icon="fa-map-marker",color=azul)
```
### Duración mediana
```{r}
valueBox(paste0(round(mediana_duracion,1)," min"),caption="Solo duraciones de 1–180 min",icon="fa-clock",color=coral)
```
### Clusters seleccionados
```{r}
valueBox(k_elegido,caption="Perfiles horarios · silhouette",icon="fa-layer-group",color="#7A5195")
```
## Row {data-height=520}
### Demanda horaria
```{r}
widget(ggplot(demanda_hora,aes(hora_retiro_num,n))+geom_col(fill=verde)+
 scale_x_continuous(breaks=seq(0,23,2))+scale_y_continuous(labels=comma)+labs(x="Hora",y="Retiros"))
```
### Estaciones con más retiros
```{r}
widget(ggplot(filter(top_estaciones,!is.na(Ciclo_Estacion_Retiro)) %>% slice_head(n=10),
 aes(reorder(Ciclo_Estacion_Retiro,n),n))+geom_col(fill=azul)+coord_flip()+
 scale_y_continuous(labels=comma)+labs(x="Estación",y="Retiros"))
```
## Row
### Pregunta y lectura principal
¿Cómo varía la demanda de ECOBICI por estación y hora durante 2025, y pueden agruparse las estaciones en perfiles de uso similares que ayuden a identificar periodos de mayor presión operativa?

La hora de mayor retiro global es `r sprintf('%02d:00',hora_pico$hora_retiro_num)`. El modelo identifica `r k_elegido` grupos; su silhouette final es `r round(silueta_final,3)`. La fuerza de esta evidencia debe valorarse junto con los perfiles y la proyección, sin asumir que cualquier partición demuestra grupos naturales.

Los viajes realizados permiten describir patrones y desequilibrios de flujo. No miden personas únicas, disponibilidad instantánea ni demanda no atendida.

# Demanda
## Row {data-height=520}
### Evolución mensual
```{r}
widget(ggplot(mensual,aes(mes,n))+geom_line(color=azul,linewidth=1)+geom_point(color=verde)+
 scale_x_date(breaks=mensual$mes,labels=substr(meses_es,1,3))+scale_y_continuous(labels=comma)+labs(x=NULL,y="Viajes"))
```
### Promedio diario por mes
```{r}
widget(ggplot(mensual,aes(factor(month(mes),levels=1:12,labels=substr(meses_es,1,3)),promedio_diario))+
 geom_col(fill=verde)+scale_y_continuous(labels=comma)+labs(x=NULL,y="Viajes / días calendario"))
```
## Row {data-height=520}
### Promedio por día de semana
```{r}
widget(ggplot(dia_promedio,aes(dia_semana,promedio))+geom_col(fill=azul)+
 scale_y_continuous(labels=comma)+labs(x=NULL,y="Viajes / día con registros")+theme(axis.text.x=element_text(angle=25,hjust=1)))
```
### Día × hora
```{r}
widget(ggplot(heat_dia,aes(hora_retiro_num,dia_semana,fill=n))+geom_tile(color="white")+
 scale_fill_gradient(low="#D8F3DC",high=azul,labels=comma)+labs(x="Hora",y=NULL,fill="Viajes"))
```
## Row
### Interpretación temporal
El mes de mayor volumen es `r meses_es[month(mes_max$mes)]` y el de menor volumen es `r meses_es[month(mes_min$mes)]`. Esto describe variación dentro de 2025; un solo año no permite establecer que exista estacionalidad recurrente entre años.

Hay `r sum(is.na(diario$n))` días sin registros en la base. No se imputan como cero en la comparación diaria. El promedio mensual divide por días calendario y puede subestimar utilización si faltan datos.

## Row

### Qué aporta esta comparación
El gráfico mensual de volumen muestra actividad registrada. El promedio por día corrige la distinta duración de los meses; no corrige clima, vacaciones o cambios en la red. El promedio por día de semana evita atribuir mayor uso únicamente a que un día aparece más veces en el calendario.

El heatmap día × hora muestra conteos acumulados: sus celdas identifican franjas de concentración. Se interpreta junto al promedio diario, porque los totales también dependen del número de días observados.

# Territorio
## Row {data-height=520}
### Mapa de demanda
```{r}
if(nrow(mapa_demanda)) {
 pal <- colorNumeric(c("#A8DDB5",verde,azul),mapa_demanda$n)
 leaflet(mapa_demanda) %>% addProviderTiles(providers$CartoDB.Positron) %>% setView(-99.16,19.40,12) %>%
 addCircleMarkers(lng=~longitud,lat=~latitud,radius=~rescale(n,c(4,15)),color=~pal(n),
 stroke=FALSE,fillOpacity=.8,label=~paste0("Estación ",Ciclo_Estacion_Retiro," · ",comma(n)," retiros")) %>%
 addLegend("bottomright",pal=pal,values=~n,title="Retiros")
} else cat("No hay coordenadas válidas.")
```
### Ranking de estaciones
```{r}
tabla(demanda_estacion %>% arrange(desc(n)) %>% select(Ciclo_Estacion_Retiro,colonia,alcaldia,n) %>% slice_head(n=30))
```
## Row {data-height=520}
### Retiros por alcaldía
```{r}
widget(ggplot(demanda_alcaldia,aes(reorder(str_wrap(alcaldia,20),n),n))+geom_col(fill=azul)+coord_flip()+
 scale_y_continuous(labels=comma)+labs(x=NULL,y="Retiros vinculados al catálogo"))
```
### Perfiles horarios · top 25 estaciones
```{r}
widget(ggplot(heatmap_datos,aes(hora_retiro_num,Ciclo_Estacion_Retiro,fill=prop))+geom_tile()+
 scale_fill_gradient(low="#D8F3DC",high=azul,labels=percent)+labs(x="Hora",y="Estación",fill="Proporción"))
```
## Row
### Cobertura territorial
El `r percent(pct_sin_catalogo,accuracy=.1)` de los viajes no tiene alcaldía asignada. Las ubicaciones provienen del catálogo disponible y no reconstruyen cambios históricos. Los IDs sin correspondencia se conservan en los conteos temporales y, si son válidos, en clustering; se omiten del mapa.

## Row

### Concentración y comparabilidad espacial
Las veinte estaciones con más retiros reúnen el `r percent(porcentaje_top20,accuracy=.1)` de los viajes analizados. El ranking muestra volumen; el heatmap muestra la **forma del perfil horario** de cada estación, normalizada por sus propios retiros. Una celda intensa significa una proporción alta de viajes de esa estación, no necesariamente un volumen superior al de otra.

La comparación entre alcaldías refleja viajes vinculados al catálogo. No está ajustada por población, cantidad de estaciones, capacidad ni extensión territorial y no permite afirmar que una alcaldía tenga mayor propensión individual al uso.

# Balance
## Row {data-height=520}
### Principales desequilibrios
```{r}
widget(ggplot(filter(balance,!is.na(estacion)) %>% slice_max(abs_balance,n=20,with_ties=FALSE),
 aes(reorder(estacion,balance_neto),balance_neto,fill=balance_neto>0))+geom_col()+coord_flip()+
 scale_fill_manual(values=c(coral,verde),guide="none")+labs(x="Estación",y="Arribos − retiros"))
```
### Detalle de flujos
```{r}
tabla(balance %>% filter(!is.na(estacion)) %>% arrange(desc(abs_balance)) %>% select(estacion,retiros,arribos,balance_neto))
```
## Row
### Interpretación operativa
Balance neto = arribos − retiros. Un valor negativo es compatible con presión hacia déficit; uno positivo, con acumulación. No demuestra que una estación estuviera vacía o llena.

Se cuentan los arribos de viajes iniciados en 2025, aunque terminen después de su cierre. No se incluyen inventario inicial, anclajes disponibles ni redistribución del operador. Los balances acumulados pueden ocultar presiones opuestas a diferentes horas.

## Row

### Volumen y desequilibrio relativo
```{r}
tabla(balance %>% filter(!is.na(estacion),movimientos>0) %>% arrange(desc(movimientos)) %>%
 select(estacion,movimientos,balance_neto,desequilibrio_relativo) %>%
 mutate(desequilibrio_relativo=percent(desequilibrio_relativo,accuracy=.1)))
```

### Por qué se muestran dos indicadores
El balance absoluto identifica magnitudes de diferencia entre entradas y salidas. El relativo divide esa diferencia por todos los movimientos de la estación y ayuda a contextualizarla según su actividad. En estaciones con pocos viajes puede ser extremo; debe revisarse junto al volumen, sin interpretarlo automáticamente como prioridad de redistribución.

# Viajes
## Row {data-height=520}
### Duración
```{r}
duracion_tab <- viajes %>% filter(!is.na(duracion_analitica)) %>% mutate(inicio=floor(duracion_analitica/5)*5) %>% count(inicio,name="n")
widget(ggplot(duracion_tab,aes(inicio,n))+geom_col(width=4.8,fill=verde)+
 scale_y_continuous(labels=comma)+labs(x="Inicio de intervalo de 5 minutos",y="Viajes"))
```
### Edad y código de género
```{r}
edad_tab <- viajes %>% filter(!is.na(edad_analitica)) %>% mutate(inicio=floor(edad_analitica/5)*5) %>% count(inicio,Genero_Usuario,name="n")
widget(ggplot(edad_tab,aes(inicio,n,fill=Genero_Usuario))+geom_col(width=4.8)+
 scale_y_continuous(labels=comma)+labs(x="Inicio de intervalo de 5 años",y="Viajes",fill="Código reportado"))
```
## Row
### Alcance
La edad y duración atípicas no eliminan viajes del análisis de demanda: solo se excluyen de estas distribuciones. Las frecuencias corresponden a viajes, no a usuarios únicos. Los códigos de género se mantienen como aparecen en la fuente.

# Clustering
## Row {data-height=520}
### Codo
```{r}
widget(ggplot(evaluacion_k,aes(k,WSS))+geom_line(color=azul)+geom_point(color=verde)+
 geom_vline(xintercept=k_elegido,linetype="dashed",color=coral)+scale_x_continuous(breaks=evaluacion_k$k)+labs(x="k",y="Variación intragrupo"))
```
### Silhouette
```{r}
widget(ggplot(evaluacion_k,aes(k,silueta))+geom_line(color=azul)+geom_point(color=verde)+
 geom_vline(xintercept=k_elegido,linetype="dashed",color=coral)+scale_x_continuous(breaks=evaluacion_k$k)+labs(x="k",y="Silhouette promedio"))
```
## Row {data-height=520}
### Perfiles medios
```{r}
widget(ggplot(perfil_cluster,aes(hora_retiro_num,prop_media,color=cluster))+geom_line(linewidth=1)+
 scale_color_manual(values=paleta)+scale_y_continuous(labels=percent)+labs(x="Hora",y="Proporción media",color="Grupo"))
```
### Proyección de perfiles en dos componentes
```{r}
widget(ggplot(pca_df,aes(PC1,PC2,color=cluster))+geom_point(alpha=.7)+
 scale_color_manual(values=paleta)+labs(color="Grupo",subtitle=paste("Variación representada:",percent(var_pca,accuracy=.1))))
```
## Row {data-height=520}
### Resumen de grupos
```{r}
tabla(resumen_clusters %>% mutate(proporcion_pico=percent(proporcion_pico,accuracy=.1)))
```
### Composición de grupos por alcaldía
```{r}
widget(ggplot(clusters_alcaldia,aes(str_wrap(alcaldia,20),n,fill=cluster))+geom_col(position="fill")+coord_flip()+
 scale_fill_manual(values=paleta)+scale_y_continuous(labels=percent)+labs(x=NULL,y="Proporción de estaciones",fill="Grupo"))
```
## Row
### Qué aporta el modelo
K-Means agrupa estaciones con al menos 50 retiros según 24 proporciones horarias; no agrupa directamente por volumen. Se excluyen horas sin variación y no se estandarizan las restantes. Se comparan soluciones de 2 a `r k_max` grupos por silhouette y se contrasta con el codo.

El ajuste final utiliza 50 inicializaciones. La silhouette del ajuste final es `r round(silueta_final,3)`; puede diferir de la utilizada para seleccionar k porque el ajuste se repite. La PCA es una proyección descriptiva. No asignamos motivos laborales, escolares o recreativos sin variables externas.

## Row

### Lectura detallada de los grupos
```{r}
tabla(cluster_descripcion %>% select(cluster,n_estaciones,hora_pico,proporcion_pico,manana_6_10,tarde_16_20) %>%
 mutate(across(c(proporcion_pico,manana_6_10,tarde_16_20),~percent(.x,accuracy=.1))))
```

### Cómo interpretar la agrupación
Cada curva es el promedio de las proporciones de las estaciones de un grupo: todas pesan igual, independientemente de su volumen. La concentración entre 06:00–10:59 y 16:00–20:59 ayuda a comparar franjas amplias, además de una hora pico aislada.

Silhouette cercana a cero indica perfiles fronterizos o poca separación; valores negativos indican asignaciones que pueden ser más próximas a otro grupo. Elegir el máximo entre las opciones no garantiza una separación fuerte. La composición territorial describe asociaciones; no identifica por sí sola causas urbanas ni motivos de viaje.

# Mapa de grupos
## Row {data-height=520}
### Distribución geográfica de perfiles
```{r}
if(nrow(mapa_cluster)) {
 pal_c <- colorFactor(paleta[seq_len(k_elegido)],levels=levels(perfil_horario$cluster))
 leaflet(mapa_cluster) %>% addProviderTiles(providers$CartoDB.Positron) %>% setView(-99.16,19.40,12) %>%
 addCircleMarkers(lng=~longitud,lat=~latitud,radius=6,color=~pal_c(cluster),stroke=FALSE,fillOpacity=.8,
 label=~paste0("Estación ",Ciclo_Estacion_Retiro," · Grupo ",cluster)) %>%
 addLegend("bottomright",pal=pal_c,values=~cluster,title="Grupo")
} else cat("No hay coordenadas válidas para los grupos.")
```

# Predicción
## Row {data-height=520}
### Comparación fuera de muestra
```{r}
tabla(metricas_modelos %>% mutate(across(where(is.numeric),~round(.x,3))))
```
### Demanda diaria observada y predicha en prueba
```{r}
widget(ggplot(pred_diaria,aes(fecha_retiro,Viajes,color=Serie))+geom_line()+labs(x=NULL,y="Suma diaria de predicciones horarias",color=NULL))
```
## Row {data-height=520}
### Real frente a predicho por hora
```{r}
widget(ggplot(test,aes(viajes,pred))+geom_point(alpha=.25,color=azul)+
 geom_abline(slope=1,intercept=0,color=coral,linetype="dashed")+labs(x="Viajes observados",y="Viajes predichos"))
```
### Errores por hora
```{r}
widget(ggplot(test,aes(factor(hora_retiro_num),residual))+geom_boxplot(fill="#A8DDB5",outlier.alpha=.2)+
 geom_hline(yintercept=0,color=coral)+labs(x="Hora",y="Observado − predicho"))
```
## Row {data-height=520}
### Diferencias estimadas respecto a las 00:00
```{r}
widget(ggplot(coefs_hora,aes(hora,estimate))+geom_col(fill=azul)+
 geom_errorbar(aes(ymin=estimate-std.error,ymax=estimate+std.error),width=.2)+
 labs(x="Hora",y="Diferencia estimada de viajes",subtitle="Barras: ±1 error estándar; asociación, no efecto causal"))
```
### Diseño de evaluación
Se modela la estación `r top_estacion`, seleccionada por el mayor número de retiros de 2025, igual que en el notebook. El corte utiliza el 80% inicial de las fechas de la serie: entrenamiento hasta `r format(fecha_corte,"%d/%m/%Y")` y prueba desde `r format(min(test$fecha_retiro),"%d/%m/%Y")`. Se comparan hora lineal + día de semana y hora categórica + día de semana. Las predicciones negativas se truncan a cero y las métricas se calculan después de ese truncamiento.

MAE y RMSE se expresan en viajes por hora. R² de prueba puede ser negativo: significaría que el error supera el de usar la media observada de prueba como referencia retrospectiva.

Como en el notebook, las combinaciones fecha–hora sin viajes se completan con cero entre el primer y último registro de la estación. Esto presupone cobertura continua y no distingue cierre, falta de datos o falta de bicicletas. La selección de estación usa el año completo: aunque los coeficientes se ajustan solo con entrenamiento, la selección es retrospectiva. Una evaluación operativa futura debería seleccionar la estación solo con datos previos y verificar cobertura.

## Row

### Resultado comparativo del modelo
La especificación categórica obtiene **RMSE = `r round(rmse_categoria,2)`** y **MAE = `r round(mae_categoria,2)` viajes por hora**, con **R² en prueba = `r round(r2_categoria,3)`**. Frente a la hora lineal, el cambio relativo de RMSE es `r if(is.finite(mejora_rmse)) paste0(round(mejora_rmse,1),"%") else "no calculable"`; un valor positivo representa reducción del error y uno negativo, aumento.

El gráfico diario suma predicciones horarias para facilitar su lectura. Las métricas se calculan a nivel horario: no deben confundirse con errores diarios. Los coeficientes comparan cada hora con las 00:00, manteniendo el día de semana; expresan asociación ajustada, no efecto causal. Sus barras son ±1 error estándar, no intervalos de confianza del 95%.

### Qué queda fuera del modelo
La regresión aditiva permite un patrón horario y diferencias de nivel por día de semana, pero no una curva horaria distinta para cada día. No incorpora tendencia, clima, festivos ni disponibilidad. Los errores pueden estar correlacionados en el tiempo y el modelo lineal no representa explícitamente una distribución de conteos.

Una continuación útil sería comparar interacciones hora × día, un modelo de conteo y validación temporal con varios cortes. El periodo de prueba debe mantenerse fuera de las decisiones de ajuste si se busca una evaluación final independiente.

# Conclusiones

## Row

### Respuesta a la pregunta principal
En 2025 el máximo acumulado de retiros ocurre a las **`r sprintf('%02d:00',hora_pico$hora_retiro_num)`**, que concentra el **`r percent(pct_hora_pico,accuracy=.1)`** del total. La estación **`r estacion_top$Ciclo_Estacion_Retiro`** encabeza los retiros. Estos resultados responden a cuándo y dónde se observa mayor actividad, sin medir viajes que no pudieron realizarse.

K-Means sintetiza las estaciones elegibles en **`r k_elegido` perfiles**, con silhouette final **`r round(silueta_final,3)`**. Su aporte es comparar formas horarias independientemente del volumen. La interpretación sustantiva depende de las curvas, la separación y la composición de los grupos, no únicamente del número seleccionado.

### Aporte predictivo y utilidad operativa
La regresión categórica establece una referencia cuantitativa para la estación **`r top_estacion`**. Su MAE fuera de muestra es **`r round(mae_categoria,2)` viajes por hora**. La comparación con la especificación lineal permite valorar si representar cada hora por separado mejora la aproximación de los picos.

Los perfiles pueden orientar qué franjas conviene vigilar en diferentes estaciones. Los balances pueden apoyar una revisión de flujos. Para proponer redistribución efectiva se necesitarían inventario, anclajes, movimientos del operador y costos; este proyecto no calcula una asignación óptima de bicicletas.

## Row

### Limitaciones y extensiones prioritarias
**Cobertura:** los viajes observados pueden omitir periodos por fallas de captura; el catálogo puede ser posterior a los viajes. **Alcance:** un año describe variación mensual, sin establecer estacionalidad entre años. **Operación:** no hay inventario instantáneo ni demanda no atendida.

**Modelos:** K-Means favorece grupos compactos y los perfiles no son categorías permanentes. La regresión se evalúa con un solo corte y la selección de estación es retrospectiva. Los ceros completados requieren revisar cobertura real.

Las extensiones prioritarias son: verificar operación y capacidad por estación, incorporar clima y festivos, evaluar estabilidad del clustering por subperiodos y comparar modelos mediante validación temporal. Deben añadirse porque resuelvan una pregunta, no solo para ampliar el número de técnicas.

# Calidad
## Row {data-height=520}
### Controles de la base analítica
```{r}
controles <- tibble(Control=c("Viajes analíticos","Duración sin dato válido (1–180 min)",
 "Edad sin dato válido (12–90 años)","Retiro sin ID","Arribo sin ID","Viajes sin alcaldía","Días sin registros"),
 Cantidad=c(n_final,sum(is.na(viajes$duracion_analitica)),sum(is.na(viajes$edad_analitica)),
 sum(is.na(viajes$Ciclo_Estacion_Retiro)),sum(is.na(viajes$Ciclo_EstacionArribo)),
 sum(is.na(viajes$alcaldia)),sum(is.na(diario$n))))
tabla(controles)
```
### Trazabilidad de limpieza
```{r}
if(!is.null(calidad_cruda)) tabla(calidad_cruda) else cat(
 "Se cargó el RDS. Los conteos originales de duplicados y exclusiones no se pueden reconstruir desde una base ya limpia. Consulta la auditoría del notebook o reconstruye desde CSV.")
```
## Row
### Respuesta y límites
El análisis describe cómo se distribuyen los retiros en tiempo y territorio. El clustering resume perfiles de estaciones; la regresión establece una referencia de demanda horaria para una estación de alta actividad y mide su error fuera de muestra.

Las conclusiones finales deben valorar las métricas y perfiles obtenidos: la presencia de grupos o un R² alto dentro de entrenamiento no garantizan separación sólida ni precisión futura. El balance aporta señales de desequilibrio, sin demostrar desabasto o saturación.

Un año permite describir variación mensual, pero no confirmar patrones recurrentes entre años. Faltan inventario, capacidad, clima, festivos, uso de suelo y movimientos de redistribución. La población observada son viajes realizados; no mide viajes que se intentaron pero no pudieron efectuarse.

# Método
## Row {data-height=520}
### Datos y pregunta
Fuente de trabajo: doce CSV mensuales de 2025 y catálogo ECOBICI; o el objeto `viajes` guardado por el notebook del equipo como `viajes_limpios_2025.rds`. Ruta activa: `r origen`.

Hipótesis: existen perfiles horarios diferenciados entre estaciones. La unidad original es el viaje. El clustering usa estación × proporción horaria; la regresión usa estación × fecha × hora. En clustering no existe una etiqueta objetivo conocida; en regresión la variable objetivo es el número de retiros.

### Preparación y reproducción
Se conserva la metodología central del notebook: duplicados exactos, fechas válidas, periodo 2025, atributos demográficos y duración tratados solo en análisis específicos. El RDS existente se valida, pero no permite comprobar qué filas se descartaron anteriormente. Para reproducir su limpieza desde los doce CSV, usa `reconstruir_desde_csv <- TRUE`.

El archivo funciona sin CSS externo. Los mapas base requieren conexión a internet. Los resultados de modelos se guardan en `output/resultados_dashboard_2025.rds`. Publicar el HTML mediante URL y acompañarlo con reporte y repositorio sigue siendo necesario para la entrega final.


## Row

### Procedencia y decisiones de preparación
Fuentes principales: [ECOBICI — Datos abiertos](https://ecobici.cdmx.gob.mx/datos-abiertos/) y catálogo de estaciones utilizado por el equipo. La descarga manual comprende los doce CSV de 2025. La fecha de descarga y versión del catálogo deben registrarse en el reporte y repositorio: esos datos no pueden recuperarse a partir del RDS.

La preparación del notebook convierte edad a numérico y bicicleta a texto antes de eliminar duplicados exactos; interpreta fechas con formatos día–mes–año; elimina fechas inválidas y retiros fuera de 2025. Duraciones fuera de 1–180 minutos y edades fuera de 12–90 años se vuelven faltantes solo para el análisis de esas variables.

Los rangos son reglas analíticas adoptadas por el equipo, no límites oficiales de operación. Conviene explicar su justificación y examinar cuánto cambian las distribuciones con otros umbrales. Los IDs se conservan como texto, incluidos los ceros iniciales; las uniones al catálogo no deben multiplicar filas.

### Correspondencia con el notebook
La lectura preferida usa `data/viajes_limpios_2025.rds`; no repite la eliminación de duplicados sobre una base ya procesada. Recalcula variables derivadas y vuelve a vincular el catálogo. La auditoría original debe obtenerse del notebook: una base limpia no contiene los registros eliminados.

El clustering usa las proporciones y umbral de 50 retiros del notebook; excluye IDs faltantes y limita k a perfiles distintos como controles adicionales. La evaluación predictiva reproduce la selección retrospectiva de la estación de mayor volumen, completa horas y usa el 80% inicial de fechas como entrenamiento. Se muestran explícitamente las limitaciones de estas decisiones.

## Row

### Reproducibilidad y entrega

| Entregable | Función |
|---|---|
| Notebook del equipo | Documenta obtención, exploración y limpieza |
| Dashboard HTML | Comunica resultados, modelos y límites |
| Doce CSV + catálogo | Permiten reconstruir el análisis |
| RDS limpio | Facilita ejecutar la visualización |
| Repositorio con README | Documenta rutas, dependencias y pasos |
| Reporte breve | Explica problema, decisiones, hallazgos y conclusiones |

```{r enlaces, results='asis'}
if(nzchar(url_visualizacion)) cat("Visualización: ",htmltools::htmlEscape(url_visualizacion),"

") else cat("**Publicación:** URL pendiente de registrar.

")
if(nzchar(url_repositorio)) cat("Repositorio: ",htmltools::htmlEscape(url_repositorio),"

") else cat("**Repositorio:** URL pendiente de registrar.

")
cat("**Integrantes:** ",htmltools::htmlEscape(integrantes))
```

### Guion para la defensa oral
En cinco minutos, explicar: el problema y la pregunta; los doce meses de datos y decisiones de limpieza; la evidencia temporal y territorial; cómo se construyen y evalúan ambos modelos; y la conclusión con sus límites.

Todos los integrantes deben poder explicar por qué se normalizan perfiles, cómo se selecciona k, por qué se separan fechas para entrenamiento y prueba, qué significan MAE/RMSE/R² y por qué balance no equivale a disponibilidad. La URL publicada, el reporte y el repositorio completan la entrega: el archivo local no los sustituye.