1 Generación y Preparación de Datos

set.seed(2024)

# Parámetros del dataset
n_pedidos <- 500
fecha_inicio <- as.Date("2023-01-01")
fecha_fin <- as.Date("2024-10-01")

# Generar datos de supply chain
supply_data <- tibble(
  pedido_id = paste0("PED-", str_pad(1:n_pedidos, 5, pad = "0")),
  fecha_pedido = sample(seq(fecha_inicio, fecha_fin, by = "day"), n_pedidos, replace = TRUE),
  proveedor = sample(c("Proveedor A", "Proveedor B", "Proveedor C", "Proveedor D", "Proveedor E"), 
                     n_pedidos, replace = TRUE, prob = c(0.25, 0.20, 0.20, 0.20, 0.15)),
  categoria = sample(c("Materias Primas", "Componentes", "Productos Terminados", "Embalaje"), 
                     n_pedidos, replace = TRUE, prob = c(0.35, 0.30, 0.25, 0.10)),
  cantidad = round(rnorm(n_pedidos, mean = 100, sd = 40)),
  precio_unitario = round(runif(n_pedidos, 10, 500), 2),
  metodo_envio = sample(c("Terrestre", "Aéreo", "Marítimo"), n_pedidos, 
                        replace = TRUE, prob = c(0.55, 0.25, 0.20)),
  ubicacion_origen = sample(c("México", "Colombia", "Brasil", "Chile", "Perú"), 
                           n_pedidos, replace = TRUE),
  lead_time_dias = round(rnorm(n_pedidos, mean = 12, sd = 5))
) %>%
  mutate(
    cantidad = pmax(cantidad, 10),  # Mínimo 10 unidades
    lead_time_dias = pmax(lead_time_dias, 1),  # Mínimo 1 día
    valor_total = cantidad * precio_unitario,
    fecha_entrega_estimada = fecha_pedido + days(lead_time_dias),
    retraso_dias = rpois(n_pedidos, lambda = 2),
    fecha_entrega_real = fecha_entrega_estimada + days(retraso_dias),
    estado = case_when(
      retraso_dias == 0 ~ "A Tiempo",
      retraso_dias <= 3 ~ "Retraso Menor",
      TRUE ~ "Retraso Significativo"
    ),
    mes = floor_date(fecha_pedido, "month"),
    trimestre = quarter(fecha_pedido, with_year = TRUE),
    tiene_retraso = as.factor(ifelse(retraso_dias > 0, 1, 0))  # Variable añadida aquí
  )

# Vista previa de los datos
head(supply_data, 10) %>%
  select(pedido_id, fecha_pedido, proveedor, categoria, cantidad, valor_total, lead_time_dias) %>%
  kable(caption = "Muestra de Datos de la Cadena de Abastecimiento", 
        format.args = list(big.mark = ",", decimal.mark = ".")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE, font_size = 11)
Muestra de Datos de la Cadena de Abastecimiento
pedido_id fecha_pedido proveedor categoria cantidad valor_total lead_time_dias
PED-00001 2024-07-31 Proveedor A Materias Primas 94 12,658.04 19
PED-00002 2024-07-02 Proveedor E Productos Terminados 147 30,471.63 14
PED-00003 2024-07-10 Proveedor A Materias Primas 87 20,790.39 11
PED-00004 2023-09-12 Proveedor B Materias Primas 77 32,922.12 11
PED-00005 2024-09-12 Proveedor A Embalaje 34 2,028.78 10
PED-00006 2024-02-20 Proveedor D Materias Primas 115 16,696.85 9
PED-00007 2023-04-15 Proveedor D Componentes 110 50,010.40 13
PED-00008 2024-09-25 Proveedor A Componentes 82 1,125.86 15
PED-00009 2023-01-29 Proveedor C Componentes 85 33,507.85 6
PED-00010 2023-01-11 Proveedor B Productos Terminados 149 63,557.44 6

2 Análisis de Series de Tiempo

# Descomposición de serie temporal
ts_diaria <- supply_data %>%
  count(fecha_pedido) %>%
  complete(fecha_pedido = seq(min(fecha_pedido), max(fecha_pedido), by = "day"),
           fill = list(n = 0))

# Promedio móvil
ts_diaria <- ts_diaria %>%
  mutate(
    ma_7dias = zoo::rollmean(n, k = 7, fill = NA, align = "center"),
    ma_30dias = zoo::rollmean(n, k = 30, fill = NA, align = "center")
  )

p1 <- ggplot(ts_diaria, aes(x = fecha_pedido)) +
  geom_line(aes(y = n), color = "gray70", alpha = 0.5) +
  geom_line(aes(y = ma_7dias, color = "Promedio 7 días"), size = 1) +
  geom_line(aes(y = ma_30dias, color = "Promedio 30 días"), size = 1) +
  scale_color_manual(values = c("#2E86AB", "#F18F01"), name = "") +
  labs(title = "Serie Temporal de Pedidos Diarios",
       subtitle = "Valores observados con promedios móviles",
       x = "Fecha", y = "Número de Pedidos") +
  tema_supply +
  theme(legend.position = "top")

# Análisis de estacionalidad por día de semana - CÓDIGO CORREGIDO
p2 <- supply_data %>%
  mutate(dia_semana = factor(weekdays(fecha_pedido),
                            levels = c("Domingo", "Lunes", "Martes", "Miércoles", 
                                     "Jueves", "Viernes", "Sábado"))) %>%
  count(dia_semana) %>%
  ggplot(aes(x = dia_semana, y = n, fill = dia_semana)) +
  geom_col(show.legend = FALSE) +
  geom_text(aes(label = n), vjust = -0.5, size = 4, fontface = "bold") +
  scale_fill_viridis_d(option = "D") +
  labs(title = "Distribución de Pedidos por Día de la Semana",
       x = NULL, y = "Número de Pedidos") +
  tema_supply

grid.arrange(p1, p2, ncol = 1, heights = c(1.5, 1))

3 Análisis Estadístico Avanzado

# Modelo de regresión logística para predicción de retrasos
modelo_logit <- glm(tiene_retraso ~ lead_time_dias + valor_total + 
                    metodo_envio + categoria,
                    data = supply_data,
                    family = binomial(link = "logit"))

# Visualización de coeficientes
coef_df <- tidy(modelo_logit) %>%
  filter(term != "(Intercept)") %>%
  mutate(
    OR = exp(estimate),
    term = str_replace_all(term, c("metodo_envio" = "", "categoria" = "Cat: "))
  )

ggplot(coef_df, aes(x = reorder(term, estimate), y = estimate)) +
  geom_point(size = 3, color = "#2E86AB") +
  geom_errorbar(aes(ymin = estimate - 1.96*std.error, 
                    ymax = estimate + 1.96*std.error), 
                width = 0.2) +
  coord_flip() +
  labs(title = "Coeficientes del Modelo de Predicción de Retrasos",
       x = NULL, y = "Coeficiente") +
  tema_supply

4 Visualización Interactiva

plot_interactivo <- supply_data %>%
  plot_ly(x = ~lead_time_dias, 
          y = ~valor_total,
          color = ~proveedor,
          size = ~cantidad,
          text = ~paste("Pedido:", pedido_id,
                       "<br>Proveedor:", proveedor,
                       "<br>Categoría:", categoria,
                       "<br>Valor: $", comma(valor_total),
                       "<br>Lead Time:", lead_time_dias, "días"),
          type = "scatter",
          mode = "markers") %>%
  layout(title = "Explorador Interactivo de Pedidos",
         xaxis = list(title = "Lead Time (días)"),
         yaxis = list(title = "Valor Total ($)"))

plot_interactivo

5 Conclusiones y Recomendaciones

Las principales conclusiones de este análisis son:

  1. La tasa de puntualidad general es del 65%, con oportunidad de mejora
  2. Los envíos aéreos muestran mejor desempeño en puntualidad
  3. Existe una marcada estacionalidad en los pedidos
  4. Los proveedores B y D muestran el mejor balance de desempeño

Recomendaciones:

  1. Implementar sistema de alertas tempranas
  2. Optimizar la mezcla de métodos de envío
  3. Ajustar inventarios según estacionalidad
  4. Desarrollar KPIs específicos por proveedor

Información de la Sesión: - Fecha y hora de análisis (UTC): 2025-10-20 16:53:36 - Usuario: TheMaorba

sessionInfo()
## R version 4.5.1 (2025-06-13 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 10 x64 (build 19045)
## 
## Matrix products: default
##   LAPACK version 3.12.1
## 
## locale:
## [1] LC_COLLATE=Spanish_Colombia.utf8  LC_CTYPE=Spanish_Colombia.utf8   
## [3] LC_MONETARY=Spanish_Colombia.utf8 LC_NUMERIC=C                     
## [5] LC_TIME=Spanish_Colombia.utf8    
## 
## time zone: America/Bogota
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] corrplot_0.95      broom_1.0.10       viridis_0.6.5      viridisLite_0.4.2 
##  [5] RColorBrewer_1.1-3 treemapify_2.5.6   kableExtra_1.4.0   knitr_1.50        
##  [9] plotly_4.11.0      gridExtra_2.3      scales_1.4.0       lubridate_1.9.4   
## [13] forcats_1.0.1      stringr_1.5.2      dplyr_1.1.4        purrr_1.1.0       
## [17] readr_2.1.5        tidyr_1.3.1        tibble_3.3.0       ggplot2_4.0.0     
## [21] tidyverse_2.0.0   
## 
## loaded via a namespace (and not attached):
##  [1] sass_0.4.10       generics_0.1.4    xml2_1.4.0        lattice_0.22-7   
##  [5] stringi_1.8.7     hms_1.1.4         digest_0.6.37     magrittr_2.0.4   
##  [9] evaluate_1.0.5    grid_4.5.1        timechange_0.3.0  fastmap_1.2.0    
## [13] jsonlite_2.0.0    backports_1.5.0   httr_1.4.7        crosstalk_1.2.2  
## [17] textshaping_1.0.4 lazyeval_0.2.2    jquerylib_0.1.4   cli_3.6.5        
## [21] rlang_1.1.6       withr_3.0.2       cachem_1.1.0      yaml_2.3.10      
## [25] tools_4.5.1       tzdb_0.5.0        vctrs_0.6.5       R6_2.6.1         
## [29] zoo_1.8-14        lifecycle_1.0.4   htmlwidgets_1.6.4 pkgconfig_2.0.3  
## [33] pillar_1.11.1     bslib_0.9.0       gtable_0.3.6      glue_1.8.0       
## [37] data.table_1.17.8 ggfittext_0.10.2  systemfonts_1.3.1 xfun_0.53        
## [41] tidyselect_1.2.1  rstudioapi_0.17.1 farver_2.1.2      htmltools_0.5.8.1
## [45] labeling_0.4.3    rmarkdown_2.30    svglite_2.2.1     compiler_4.5.1   
## [49] S7_0.2.0