Actividad 2: Modelos de pronósticos en series de tiempo

Teoría

Una serie de tiempo son las observaciones de una variable ordenadas en el tiempo. En estos ejercicios trabajo con series mensuales que tienen tendencia y estacionalidad, y uso dos métodos para pronosticar:

• Descomposición multiplicativa: separo la serie en tendencia, estacionalidad e irregular (\(Y_t = T_t \times S_t \times I_t\)). Para estimar el índice estacional de cada mes divido el dato real entre un promedio móvil centrado de orden 12, luego desestacionalizo, le ajusto una tendencia lineal y el pronóstico es \((b_0 + b_1 t)\) por el índice del mes.
• Regresión con variables ficticias: ajusto \(Y_t = \beta_0 + \beta_1 t + \sum \gamma_m D_m\), donde \(t\) es la tendencia y las 11 dummies capturan el mes.

Para ver qué tan bueno es un pronóstico comparo el valor real contra el pronosticado.

# Descomposición multiplicativa clásica
descomp_mult <- function(y, mes_inicio) {
  n   <- length(y)
  mes <- ((mes_inicio - 1 + 0:(n - 1)) %% 12) + 1   # mes calendario de cada t
  # Promedio móvil centrado de orden 12
  cma <- rep(NA, n)
  for (i in 7:(n - 6)) {
    cma[i] <- (0.5*y[i-6] + sum(y[(i-5):(i+5)]) + 0.5*y[i+6]) / 12
  }
  razon  <- y / cma
  crudo  <- tapply(razon, mes, mean, na.rm = TRUE)   # promedio de razones por mes
  IE     <- crudo * 12 / sum(crudo)                  # que sumen 12
  desest <- y / IE[as.character(mes)]
  t <- 1:n
  tend <- lm(desest ~ t)
  list(mes = mes, IE = IE, desest = desest, tend = tend)
}

# Pronóstico por descomposición
pron_descomp <- function(t_fut, mes_inicio, tend, IE) {
  b       <- coef(tend)
  mes_fut <- ((mes_inicio - 1 + (t_fut - 1)) %% 12) + 1
  (b[1] + b[2]*t_fut) * IE[as.character(mes_fut)]
}

Ejercicio 3. Vintage Restaurant

Karen necesita pronosticar las ventas mensuales del restaurante con un año de anticipación. Tengo las ventas mensuales (miles de $) de los tres primeros años.

# Tabla 18.26 – ventas mensuales (miles $), enero a diciembre por año
vintage <- c(242,235,232,178,184,140,145,152,110,130,152,206,  # Año 1
             263,238,247,193,193,149,157,161,122,130,167,230,  # Año 2
             282,255,265,205,210,160,166,174,126,148,173,235)  # Año 3
n   <- length(vintage)
t   <- 1:n
mes <- rep(1:12, times = 3)

1. Gráfica de la serie de tiempo

plot(t, vintage, type = "o", pch = 16, col = "steelblue",
     xlab = "Mes (t)", ylab = "Ventas (miles $)",
     main = "Vintage Restaurant: ventas mensuales (3 años)")
grid()

Se nota un patrón que se repite cada año (picos en enero y diciembre, caídas fuertes en verano) y una tendencia que sube poco a poco de un año al otro.

2. Índices estacionales

d  <- descomp_mult(vintage, mes_inicio = 1)
IE <- d$IE
tabla_ie <- data.frame(Mes = month.name, Indice = round(as.numeric(IE), 4))
knitr::kable(tabla_ie, caption = "Índices estacionales")

Índices estacionales

Mes	Indice
January	1.4436
February	1.2997
March	1.3441
April	1.0412
May	1.0494
June	0.8004
July	0.8283
August	0.8530
September	0.6280
October	0.7003
November	0.8528
December	1.1593

La temporada alta es de enero a marzo y diciembre (índices por arriba de 1; enero ≈ 1.44, o sea 44% arriba del promedio) y la baja es en verano, con septiembre como el mes más flojo (≈ 0.63). Sí tiene sentido: es un restaurante en una isla turística de Florida, y en invierno llega más gente.

3. Serie desestacionalizada y tendencia

plot(t, d$desest, type = "o", pch = 16, col = "darkgreen",
     xlab = "Mes (t)", ylab = "Ventas desestacionalizadas",
     main = "Serie desestacionalizada y tendencia")
abline(d$tend, col = "red", lwd = 2)
grid()

coef(d$tend)

## (Intercept)           t 
##  169.349401    1.021297

Al quitar la estacionalidad sí queda una tendencia creciente, con una pendiente de aprox. 1.021 miles por mes.

4. Pronóstico Año 4 – método de descomposición

t_fut <- 37:48
pron_desc <- as.numeric(pron_descomp(t_fut, mes_inicio = 1, tend = d$tend, IE = IE))

5. Pronóstico Año 4 – regresión con variables ficticias

mesf    <- factor(mes, levels = 1:12, labels = month.abb)
mod_reg <- lm(vintage ~ t + mesf)
nuevos  <- data.frame(t = 37:48, mesf = factor(1:12, levels = 1:12, labels = month.abb))
pron_reg <- as.numeric(predict(mod_reg, newdata = nuevos))

6. Tablas resumen y gráficas

resumen <- data.frame(
  Mes            = month.name,
  Descomposicion = round(pron_desc, 2),
  Regresion      = round(pron_reg, 2)
)
knitr::kable(resumen, caption = "Pronóstico de ventas Año 4 (miles $)")

Pronóstico de ventas Año 4 (miles $)

Mes	Descomposicion	Regresion
January	299.02	286.75
February	270.54	267.08
March	281.16	272.42
April	218.86	216.42
May	221.65	220.08
June	169.88	174.08
July	176.65	180.42
August	182.78	186.75
September	135.21	143.75
October	151.50	160.42
November	185.35	188.42
December	253.15	248.08

plot(1:48, c(vintage, rep(NA, 12)), type = "o", pch = 16, col = "gray40",
     xlab = "Mes (t)", ylab = "Ventas (miles $)", ylim = c(100, 320),
     main = "Histórico y pronósticos del Año 4")
lines(37:48, pron_desc, type = "o", pch = 17, col = "blue")
lines(37:48, pron_reg,  type = "o", pch = 15, col = "red")
legend("topright", c("Histórico", "Descomposición", "Regresión"),
       col = c("gray40", "blue", "red"), pch = c(16, 17, 15), bty = "n")
grid()

Error de pronóstico de enero. Si en enero del Año 4 las ventas reales fueron $295,000 (295 miles):

real_ene <- 295
data.frame(Metodo = c("Descomposición", "Regresión"),
           Pronostico = round(c(pron_desc[1], pron_reg[1]), 2),
           Error = round(c(real_ene - pron_desc[1], real_ene - pron_reg[1]), 2))

##           Metodo Pronostico Error
## 1 Descomposición     299.02 -4.02
## 2      Regresión     286.75  8.25

El error de la descomposición es de solo -4.02 miles (alrededor de 1.4%), así que es chico y no debería confundir a Karen. Para manejar mejor la incertidumbre se puede calcular medidas de error como MAD, MSE o MAPE, usar intervalos de confianza en vez de un solo número, y reestimar el modelo conforme llegan datos nuevos.

Conclusión

Las ventas de Vintage tienen una estacionalidad fuerte (alta en invierno, baja en verano) sobre una tendencia creciente. Los dos métodos dan pronósticos muy parecidos y el de enero prácticamente coincide con el real ($299 mil vs $295 mil), así que el procedimiento es confiable. La recomendación para Karen es planear personal e inventario según los índices: reforzar de diciembre a marzo y aligerar en verano.

Ejercicio 4. Carlson Department Store

Un huracán azotó el 21 de agosto y Carlson cerró de septiembre a diciembre. Hay que estimar cuánto habría vendido la tienda y el condado sin el huracán, la pérdida de Carlson, y si hubo un exceso de ventas por el huracán. Tengo 48 meses previos al cierre (de septiembre del Año 1 a agosto del Año 5).

# Tabla 18.27 – ventas Carlson ($ millones), desde Sep Año1
carlson <- c(1.71,1.90,2.74,4.20,                                             # Año1 Sep-Dic
             1.45,1.80,2.03,1.99,2.32,2.20,2.13,2.43,1.90,2.13,2.56,4.16,     # Año2
             2.31,1.89,2.02,2.23,2.39,2.14,2.27,2.21,1.89,2.29,2.83,4.04,     # Año3
             2.31,1.99,2.42,2.45,2.57,2.42,2.40,2.50,2.09,2.54,2.97,4.35,     # Año4
             2.56,2.28,2.69,2.48,2.73,2.37,2.31,2.23)                         # Año5 Ene-Ago

# Tabla 18.28 – ventas del condado ($ millones), mismos 48 meses
condado <- c(55.80,56.40,71.40,117.60,
             46.80,48.00,60.00,57.60,61.80,58.20,56.40,63.00,57.60,53.40,71.40,114.00,
             46.80,48.60,59.40,58.20,60.60,55.20,51.00,58.80,49.80,54.60,65.40,102.00,
             43.80,45.60,57.60,53.40,56.40,52.80,54.00,60.60,47.40,54.60,67.80,100.20,
             48.00,51.60,57.60,58.20,60.00,57.00,57.60,61.80)

# Ventas reales del condado durante el cierre (Sep-Dic Año5)
condado_real <- c(69.00, 75.00, 85.20, 121.80)

1 y 2. Ventas estimadas sin huracán

dC <- descomp_mult(carlson, mes_inicio = 9)   # empieza en septiembre
dK <- descomp_mult(condado, mes_inicio = 9)

t_cierre     <- 49:52                          # Sep, Oct, Nov, Dic del Año 5
pron_carlson <- as.numeric(pron_descomp(t_cierre, 9, dC$tend, dC$IE))
pron_condado <- as.numeric(pron_descomp(t_cierre, 9, dK$tend, dK$IE))

tabla_c <- data.frame(
  Mes              = c("Septiembre","Octubre","Noviembre","Diciembre"),
  Carlson_estimado = round(pron_carlson, 3),
  Condado_estimado = round(pron_condado, 2),
  Condado_real     = condado_real
)
knitr::kable(tabla_c, caption = "Estimado sin huracán vs real del condado ($ millones)")

Estimado sin huracán vs real del condado ($ millones)

Mes	Carlson_estimado	Condado_estimado	Condado_real
Septiembre	2.158	50.55	69.0
Octubre	2.544	53.20	75.0
Noviembre	3.056	66.78	85.2
Diciembre	4.600	103.11	121.8

3. Pérdida de ventas de Carlson

perdida <- sum(pron_carlson)
perdida

## [1] 12.3579

La pérdida de ventas de Carlson de septiembre a diciembre es de aprox. $12.36 millones.

4. Exceso de ventas por el huracán

exceso_condado <- sum(condado_real) - sum(pron_condado)
particip       <- mean(carlson / condado)
exceso_carlson <- particip * exceso_condado

data.frame(
  Condado_estimado = round(sum(pron_condado), 2),
  Condado_real     = sum(condado_real),
  Exceso_condado   = round(exceso_condado, 2),
  Particip_Carlson = round(particip, 4),
  Exceso_Carlson   = round(exceso_carlson, 3)
)

##   Condado_estimado Condado_real Exceso_condado Particip_Carlson Exceso_Carlson
## 1           273.64          351          77.36           0.0405          3.135

Las ventas reales del condado durante el cierre ($351 millones) son mucho mayores que las esperadas sin huracán ($273.64 millones), un exceso de aprox. $77.36 millones por la ayuda federal y los seguros. Como Carlson representa en promedio el 4.05% del condado, le habría tocado una parte de ese exceso: alrededor de $3.135 millones.

Conclusión

Con los 48 meses previos estimo que Carlson perdió cerca de $12.4 millones durante el cierre. Además, el condado vendió alrededor de $77 millones por encima de lo normal después del huracán, y como Carlson participaba con ~4% del condado, tiene bases para reclamar unos $3.1 millones más por el exceso que habría capturado si hubiera estado abierta. Le conviene sustentar ambas cifras ante la aseguradora.