Forecasting Compras

library(readxl)
library(dplyr)
library(ggplot2)
library(forecast)

install.packages("forecast")

install.packages("dplyr")

install.packages("ggplot2")

install.packages("dplyr")

install.packages("lubridate")

install.packages("tidyr")
install.packages("purrr")

install.packages("writexl")

head(Historial_2020_al_2024)

names(Historial_2020_al_2024)

 [1] "Producto"        "Nombre"          "BienServicio"    "Validacion"      "Fecha"           "Proveedor"       "NombreProveedor" "Marca"          
 [9] "NombreMarca"     "Cantidad"        "Unidadcompra"    "CostoBruto"      "Monto"           "Bodegadestino"   "Bodega"          "Orden"          
[17] "Usuario"         "Factura"         "FechaFactura"    "Estadoorden"    

str(Historial_2020_al_2024)

tibble [54,651 × 20] (S3: tbl_df/tbl/data.frame)
 $ Producto       : num [1:54651] 221064 221063 221062 221103 221072 ...
 $ Nombre         : chr [1:54651] "LECHE ENTERA" "LECHE DESLACTOSADA" "LECHE DESCREMADA" "QUESO PARMESANO" ...
 $ BienServicio   : chr [1:54651] "B" "B" "B" "B" ...
 $ Validacion     : num [1:54651] 22351 22351 22351 22351 22351 ...
 $ Fecha          : POSIXct[1:54651], format: "2020-01-04" "2020-01-04" "2020-01-04" "2020-01-04" ...
 $ Proveedor      : chr [1:54651] "26157020" "26157020" "26157020" "26157020" ...
 $ NombreProveedor: chr [1:54651] "OPCIONES SALUDABLES, S.A" "OPCIONES SALUDABLES, S.A" "OPCIONES SALUDABLES, S.A" "OPCIONES SALUDABLES, S.A" ...
 $ Marca          : num [1:54651] NA NA NA NA NA NA NA 358 54 30 ...
 $ NombreMarca    : chr [1:54651] NA NA NA NA ...
 $ Cantidad       : num [1:54651] 72 3 3 2 3 1 1 1 5 4 ...
 $ Unidadcompra   : chr [1:54651] "UNIDAD" "UNIDAD" "UNIDAD" "UNIDAD" ...
 $ CostoBruto     : num [1:54651] 9.45 9.45 9.45 140 98 95 75 1200 125 55.7 ...
 $ Monto          : num [1:54651] 680.4 28.4 28.4 280 294 ...
 $ Bodegadestino  : num [1:54651] 206 206 206 206 206 206 206 101 101 101 ...
 $ Bodega         : chr [1:54651] "Cafeteria" "Cafeteria" "Cafeteria" "Cafeteria" ...
 $ Orden          : num [1:54651] 23569 23569 23569 23569 23569 ...
 $ Usuario        : chr [1:54651] "KAREN" "KAREN" "KAREN" "KAREN" ...
 $ Factura        : chr [1:54651] "B-140991" "B-140991" "B-140991" "B-140991" ...
 $ FechaFactura   : POSIXct[1:54651], format: "2020-01-04" "2020-01-04" "2020-01-04" "2020-01-04" ...
 $ Estadoorden    : chr [1:54651] "S" "S" "S" "S" ...

summary(Historial_2020_al_2024)

    Producto         Nombre          BienServicio         Validacion        Fecha                        Proveedor         NombreProveedor        Marca      
 Min.   :110002   Length:54651       Length:54651       Min.   :    0   Min.   :2020-01-04 00:00:00.0   Length:54651       Length:54651       Min.   :  1.0  
 1st Qu.:112773   Class :character   Class :character   1st Qu.:36117   1st Qu.:2021-05-20 00:00:00.0   Class :character   Class :character   1st Qu.: 34.0  
 Median :211023   Mode  :character   Mode  :character   Median :50763   Median :2022-08-03 00:00:00.0   Mode  :character   Mode  :character   Median :130.0  
 Mean   :184299                                         Mean   :49468   Mean   :2022-07-29 06:10:50.5                                         Mean   :194.8  
 3rd Qu.:220447                                         3rd Qu.:62942   3rd Qu.:2023-11-07 00:00:00.0                                         3rd Qu.:262.0  
 Max.   :330015                                         Max.   :75396   Max.   :2024-12-30 00:00:00.0                                         Max.   :784.0  
                                                                        NA's   :4544                                                          NA's   :10956  
 NombreMarca           Cantidad       Unidadcompra         CostoBruto            Monto         Bodegadestino      Bodega              Orden      
 Length:54651       Min.   :    1.0   Length:54651       Min.   :      0.0   Min.   :      0   Min.   :101.0   Length:54651       Min.   :23516  
 Class :character   1st Qu.:    2.0   Class :character   1st Qu.:     14.0   1st Qu.:    146   1st Qu.:101.0   Class :character   1st Qu.:32956  
 Mode  :character   Median :    6.0   Mode  :character   Median :     54.9   Median :    455   Median :101.0   Mode  :character   Median :42258  
                    Mean   :  139.5                      Mean   :    624.8   Mean   :   2345   Mean   :134.3                      Mean   :41852  
                    3rd Qu.:   30.0                      3rd Qu.:    247.5   3rd Qu.:   1600   3rd Qu.:201.0                      3rd Qu.:50607  
                    Max.   :50000.0                      Max.   :1721216.0   Max.   :1721216   Max.   :208.0                      Max.   :59699  
                                                                                                                                                 
   Usuario            Factura           FechaFactura                   Estadoorden       
 Length:54651       Length:54651       Min.   :2020-01-04 00:00:00.0   Length:54651      
 Class :character   Class :character   1st Qu.:2021-06-17 00:00:00.0   Class :character  
 Mode  :character   Mode  :character   Median :2022-09-02 00:00:00.0   Mode  :character  
                                       Mean   :2022-08-19 13:29:59.7                     
                                       3rd Qu.:2023-11-10 00:00:00.0                     
                                       Max.   :2024-12-30 00:00:00.0                     
                                                                                         

library(dplyr)
library(lubridate)

Aviso: package ‘lubridate’ was built under R version 4.4.3
Adjuntando el paquete: ‘lubridate’

The following objects are masked from ‘package:base’:

    date, intersect, setdiff, union

# Creamos columna Año-Mes
Historial_mensual <- Historial_2020_al_2024 %>%
  mutate(AnioMes = floor_date(Fecha, unit = "month")) %>% 
  group_by(AnioMes, Nombre, Bodega) %>%
  summarise(Compras = sum(Cantidad), .groups = "drop")

# Ver ejemplo de los datos resumidos
head(Historial_mensual)

NA
NA

library(dplyr)
library(purrr)
library(lubridate)
library(forecast)
library(tibble)

# Suponemos que esta es tu tabla resumida mensual por ítem y bodega:
# Historial_mensual

# Paso clave: dividir en una lista por grupo antes del map
lista_por_grupo <- Historial_mensual %>%
  group_by(Nombre, Bodega) %>%
  group_split()

# Aplicar modelo ARIMA por grupo
proyecciones <- map_df(lista_por_grupo, function(df) {
  if (nrow(df) < 2 || any(is.na(df$AnioMes)) || any(is.na(df$Compras))) {
    return(NULL)
  }

  nombre_item <- unique(df$Nombre)
  bodega_id <- unique(df$Bodega)

  ts_data <- ts(df$Compras, start = c(year(min(df$AnioMes)), month(min(df$AnioMes))), frequency = 12)

  modelo <- auto.arima(ts_data)
  forecast_2025 <- forecast(modelo, h = 12)

  fechas_proj <- seq(from = as.Date("2025-01-01"), by = "month", length.out = 12)

  tibble(
    Nombre = nombre_item,
    Bodega = bodega_id,
    Mes = fechas_proj,
    Compra_Prevista = as.numeric(forecast_2025$mean)
  )
})

head(proyecciones)

NA

proyecciones_limpias <- proyecciones %>%
  distinct(Nombre, Bodega, Mes, .keep_all = TRUE)

nrow(proyecciones_limpias)

[1] 28284

View(proyecciones_limpias)        # Abre la tabla completa en pestaña

# Cambia los valores por el código o nombre del ítem que quieres ver
proyecciones_limpias %>%
  filter(Nombre == "ROCEPHIN IV 1G LIOFILIZADO VIAL",
         Bodega == "FARMACIA")

library(ggplot2)
library(dplyr)

# 1. Datos históricos del producto
historico <- Historial_mensual %>%
  filter(Nombre == "ROCEPHIN IV 1G LIOFILIZADO VIAL", Bodega == "FARMACIA") %>%
  mutate(Tipo = "Histórico", Fecha = AnioMes) %>%
  select(Fecha, Compras, Tipo)

# 2. Proyección del mismo producto
futuro <- proyecciones_limpias %>%
  filter(Nombre == "ROCEPHIN IV 1G LIOFILIZADO VIAL", Bodega == "FARMACIA") %>%
  mutate(Tipo = "Proyección", Fecha = Mes) %>%
  rename(Compras = Compra_Prevista) %>%
  select(Fecha, Compras, Tipo)

# 3. Unir ambos datasets
todo <- bind_rows(historico, futuro)

# 4. Graficar
ggplot(todo, aes(x = Fecha, y = Compras, color = Tipo)) +
  geom_line(size = 1.2) +
  geom_point(size = 2) +
  labs(
    title = "Compras históricas + proyección mensual (2025)",
    subtitle = "Producto: ROCEPHIN IV 1G LIOFILIZADO VIAL | Bodega: FARMACIA",
    x = "Mes",
    y = "Cantidad comprada / proyectada",
    color = "Serie"
  ) +
  theme_minimal()

Aviso: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
Please use `linewidth` instead.

facet_wrap

top5_productos <- Historial_mensual %>%
  group_by(Nombre) %>%
  summarise(Total = sum(Compras), .groups = "drop") %>%
  arrange(desc(Total)) %>%
  slice_head(n = 5) %>%
  pull(Nombre)

# HISTÓRICO (solo para los top 5)
historico <- Historial_mensual %>%
  filter(Nombre %in% top5_productos, Bodega == "FARMACIA") %>%
  mutate(Tipo = "Histórico", Fecha = AnioMes) %>%
  select(Nombre, Fecha, Compras, Tipo)

# PROYECCIÓN
futuro <- proyecciones_limpias %>%
  filter(Nombre %in% top5_productos, Bodega == "FARMACIA") %>%
  mutate(Tipo = "Proyección", Fecha = Mes) %>%
  rename(Compras = Compra_Prevista) %>%
  select(Nombre, Fecha, Compras, Tipo)

# COMBINAR TODO
todo <- bind_rows(historico, futuro)

# Recalcular los 5 productos más comprados
top5_productos <- Historial_mensual %>%
  group_by(Nombre) %>%
  summarise(Total = sum(Compras), .groups = "drop") %>%
  arrange(desc(Total)) %>%
  slice_head(n = 5) %>%
  pull(Nombre)

# Datos históricos
historico <- Historial_mensual %>%
  filter(Nombre %in% top5_productos, Bodega == "FARMACIA") %>%
  mutate(Tipo = "Histórico", Fecha = AnioMes) %>%
  select(Nombre, Fecha, Compras, Tipo)

# Proyecciones
futuro <- proyecciones_limpias %>%
  filter(Nombre %in% top5_productos, Bodega == "FARMACIA") %>%
  mutate(Tipo = "Proyección", Fecha = Mes) %>%
  rename(Compras = Compra_Prevista) %>%
  select(Nombre, Fecha, Compras, Tipo)

# Unir todo
todo <- bind_rows(historico, futuro)

# Filtrar datos válidos
todo_filtrado <- todo %>%
  filter(!is.na(Compras))

# Verificar productos con proyección
table(todo_filtrado$Tipo, todo_filtrado$Nombre)

           
            GUANTE NITRILO MEDIANO NO ESTERIL MASCARILLA QUIRURGICA CON ELASTICO
  Histórico                                39                                 42

#RETOMANDo

producto_datos <- Historial_mensual %>%
  filter(Nombre == "PERENTEROL 250 MG SOBRE", Bodega == "FARMACIA")

library(forecast)

# Verificamos si hay suficientes datos
if (nrow(producto_datos) >= 2) {
  ts_perenterol <- ts(producto_datos$Compras,
                      start = c(year(min(producto_datos$AnioMes)), month(min(producto_datos$AnioMes))),
                      frequency = 12)

  modelo <- auto.arima(ts_perenterol)
  proyeccion <- forecast(modelo, h = 12)

  fechas_2025 <- seq(as.Date("2025-01-01"), by = "month", length.out = 12)

  proyeccion_perenterol <- tibble(
    Mes = fechas_2025,
    Compra_Prevista = as.numeric(proyeccion$mean)
  )
  
  print(proyeccion_perenterol)
} else {
  print("No hay suficientes datos históricos para proyectar este producto.")
}

Error en if (start > end) stop("'start' cannot be after 'end'"): 
  valor ausente donde TRUE/FALSE es necesario

summary(producto_datos$AnioMes)

                      Min.                    1st Qu.                     Median                       Mean                    3rd Qu. 
"2021-06-01 00:00:00.0000" "2023-03-31 12:00:00.0000" "2023-12-01 00:00:00.0000" "2023-09-18 11:22:06.3157" "2024-05-16 12:00:00.0000" 
                      Max.                       NA's 
"2024-11-01 00:00:00.0000"                        "1" 

if (nrow(producto_datos) >= 2 && !any(is.na(producto_datos$AnioMes))) {
  
  ts_perenterol <- ts(producto_datos$Compras,
                      start = c(year(min(producto_datos$AnioMes)),
                                month(min(producto_datos$AnioMes))),
                      frequency = 12)

  modelo <- auto.arima(ts_perenterol)
  proyeccion <- forecast(modelo, h = 12)

  fechas_2025 <- seq(as.Date("2025-01-01"), by = "month", length.out = 12)

  proyeccion_perenterol <- tibble(
    Mes = fechas_2025,
    Compra_Prevista = as.numeric(proyeccion$mean)
  )

  print(proyeccion_perenterol)

} else {
  print("⚠️ No hay suficientes datos históricos o las fechas están incompletas.")
}

[1] "⚠️ No hay suficientes datos históricos o las fechas están incompletas."

Historial_mensual <- Historial_2020_al_2024 %>%
  mutate(AnioMes = lubridate::floor_date(FechaFactura, unit = "month")) %>%
  group_by(Nombre, Bodega, AnioMes) %>%
  summarise(Compras = sum(Cantidad), .groups = "drop")

summary(Historial_mensual$AnioMes)

                      Min.                    1st Qu.                     Median                       Mean                    3rd Qu. 
"2020-01-01 00:00:00.0000" "2021-06-01 00:00:00.0000" "2022-09-01 00:00:00.0000" "2022-08-20 03:57:35.5056" "2023-11-01 00:00:00.0000" 
                      Max. 
"2024-12-01 00:00:00.0000" 

any(is.na(Historial_mensual$AnioMes))  # Debe dar FALSE

[1] FALSE

library(dplyr)
library(lubridate)

Historial_mensual <- Historial_2020_al_2024 %>%
  mutate(AnioMes = floor_date(FechaFactura, unit = "month")) %>%
  group_by(Nombre, Bodega, AnioMes) %>%
  summarise(Compras = sum(Cantidad), .groups = "drop")

producto_datos <- Historial_mensual %>%
  filter(Nombre == "PERENTEROL 250 MG SOBRE", Bodega == "FARMACIA")

library(ggplot2)

# Crear el histórico en formato gráfico
historico <- producto_datos %>%
  mutate(Fecha = AnioMes, Tipo = "Histórico") %>%
  select(Fecha, Compras, Tipo)

# Crear la proyección
futuro <- proyeccion_perenterol %>%
  mutate(Fecha = Mes, Tipo = "Proyección") %>%
  rename(Compras = Compra_Prevista) %>%
  select(Fecha, Compras, Tipo)

# Unir ambos
todo_perenterol <- bind_rows(historico, futuro)

# Graficar
ggplot(todo_perenterol, aes(x = Fecha, y = Compras, color = Tipo)) +
  geom_line(size = 1.2) +
  geom_point(size = 2) +
  labs(
    title = "Histórico + Proyección 2025",
    subtitle = "Producto: PERENTEROL 250 MG SOBRE | Bodega: FARMACIA",
    x = "Mes",
    y = "Cantidad"
  ) +
  scale_color_manual(values = c("Histórico" = "firebrick", "Proyección" = "steelblue")) +
  theme_minimal(base_size = 12) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

#Hay más factores que pueden intervenir, estas compras muchas veces son ejecutadas en farmacias externas en lugar de mantener un estiado de 1 a 2 cajas mensuales en stock.

PARA PAPEL MIXTO

Historial_mensual <- Historial_2020_al_2024 %>%
  mutate(AnioMes = floor_date(FechaFactura, unit = "month")) %>%
  group_by(Nombre, Bodega, AnioMes) %>%
  summarise(Compras = sum(Cantidad), .groups = "drop")

producto_datos <- Historial_mensual %>%
  filter(Nombre == "PAPEL MIXTO ROLLO DE 15 X 200 MTS", Bodega == "FARMACIA")

ggplot(producto_datos, aes(x = AnioMes, y = Compras)) +
  geom_line(color = "firebrick", size = 1.2) +
  geom_point(color = "firebrick", size = 2) +
  labs(
    title = "Histórico de compras mensuales",
    subtitle = "PAPEL MIXTO ROLLO DE 15 X 200 MTS | Bodega: FARMACIA",
    x = "Mes", y = "Cantidad"
  ) +
  theme_minimal()

if (nrow(producto_datos) >= 2 && !any(is.na(producto_datos$AnioMes))) {
  
  ts_data <- ts(producto_datos$Compras,
                start = c(year(min(producto_datos$AnioMes)), month(min(producto_datos$AnioMes))),
                frequency = 12)

  modelo <- auto.arima(ts_data)
  proyeccion <- forecast(modelo, h = 12)

  fechas_2025 <- seq(as.Date("2025-01-01"), by = "month", length.out = 12)

  proyeccion_papel <- tibble(
    Mes = fechas_2025,
    Compra_Prevista = as.numeric(proyeccion$mean)
  )

  print(proyeccion_papel)

} else {
  print("⚠️ No hay suficientes datos para proyectar.")
}

NA

# Preparar histórico
historico <- producto_datos %>%
  mutate(Fecha = AnioMes, Tipo = "Histórico") %>%
  select(Fecha, Compras, Tipo)

# Preparar proyección
futuro <- proyeccion_papel %>%
  mutate(Fecha = Mes, Tipo = "Proyección") %>%
  rename(Compras = Compra_Prevista) %>%
  select(Fecha, Compras, Tipo)

# Unir
todo <- bind_rows(historico, futuro)

# Graficar
ggplot(todo, aes(x = Fecha, y = Compras, color = Tipo)) +
  geom_line(size = 1.2) +
  geom_point(size = 2) +
  scale_color_manual(values = c("Histórico" = "firebrick", "Proyección" = "steelblue")) +
  labs(
    title = "Histórico + Proyección 2025",
    subtitle = "PAPEL MIXTO ROLLO DE 15 X 200 MTS | Bodega: FARMACIA",
    x = "Mes", y = "Cantidad"
  ) +
  theme_minimal(base_size = 12) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

library(dplyr)
library(lubridate)
library(forecast)
library(ggplot2)
library(purrr)
library(writexl)

# Paso 1: Crear historial mensual confiable
Historial_mensual <- Historial_2020_al_2024 %>%
  mutate(AnioMes = floor_date(FechaFactura, unit = "month")) %>%
  group_by(Nombre, Bodega, AnioMes) %>%
  summarise(Compras = sum(Cantidad), .groups = "drop")

# Paso 2 al 5: Automatizar todo por producto y bodega
proyecciones_completas <- Historial_mensual %>%
  group_by(Nombre, Bodega) %>%
  group_split() %>%
  map_df(function(df) {
    nombre_item <- unique(df$Nombre)
    bodega <- unique(df$Bodega)

    if (nrow(df) < 2 || any(is.na(df$AnioMes))) return(NULL)

    # Serie temporal
    ts_data <- ts(df$Compras,
                  start = c(year(min(df$AnioMes)), month(min(df$AnioMes))),
                  frequency = 12)

    modelo <- tryCatch(auto.arima(ts_data), error = function(e) return(NULL))
    if (is.null(modelo)) return(NULL)

    forecast_result <- forecast(modelo, h = 12)
    fechas_proj <- seq(as.Date("2025-01-01"), by = "month", length.out = 12)

    tibble(
      Nombre = nombre_item,
      Bodega = bodega,
      Mes = fechas_proj,
      Compra_Prevista = as.numeric(forecast_result$mean)
    )
  })

# Crear carpeta si no existe
if (!dir.exists("graficos_productos")) dir.create("graficos_productos")

# Crear gráfico por producto
productos_unicos <- unique(proyecciones_completas$Nombre)

walk(productos_unicos, function(producto) {
  historial <- Historial_mensual %>%
    filter(Nombre == producto) %>%
    mutate(Tipo = "Histórico", Fecha = AnioMes)

  proy <- proyecciones_completas %>%
    filter(Nombre == producto) %>%
    mutate(Tipo = "Proyección", Fecha = Mes) %>%
    rename(Compras = Compra_Prevista)

  todo <- bind_rows(historial, proy)

  grafico <- ggplot(todo, aes(x = Fecha, y = Compras, color = Tipo)) +
    geom_line(size = 1.2) +
    geom_point(size = 2) +
    labs(
      title = paste("Histórico + Proyección 2025\nProducto:", producto),
      x = "Mes", y = "Cantidad"
    ) +
    scale_color_manual(values = c("Histórico" = "firebrick", "Proyección" = "steelblue")) +
    theme_minimal(base_size = 11) +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))

  ggsave(filename = paste0("graficos_productos/", gsub("[^a-zA-Z0-9]", "_", producto), ".png"),
         plot = grafico, width = 9, height = 5)
})