HeatWave Analysis: Demand Forecasting & Inventory Control
if (!require("forecast")) install.packages("forecast")
library(forecast)
#1
# demand HeatWave (2019 - 2023)
demanda <- c(
3610, 3390, 3770, 4370, 5010, 5390, 5670, 5920, 5880, 5500, 4720, 3810,
3600, 3400, 3760, 4530, 5350, 5950, 6280, 6560, 6530, 6310, 5190, 4380,
4360, 3860, 4300, 5130, 5860, 6450, 6340, 6990, 7170, 7070, 5690, 4980,
4630, 4190, 4560, 5400, 6200, 6920, 7230, 7570, 7810, 7790, 6830, 5880,
5010, 5020, 5480, 6250, 7140, 7970, 7840, 7830, 7440, 6910, 5440, 4930
)
y <- ts(demanda, start = c(2019, 1), frequency = 12)
# models
m_ses <- ses(y) # Simple Exponential Smoothing
m_holt <- holt(y) # Holt's Linear Trend
m_trend <- tslm(y ~ trend) # Linear Trend Analysis
m_reg <- tslm(y ~ trend + season) # Regresión con Dummies estacionales
m_hw <- hw(y, seasonal = "multiplicative") # Holt-Winters Multiplicativo
#
fit_ma <- rep(NA, length(y))
for(i in 13:length(y)) fit_ma[i] <- mean(y[(i-12):(i-1)])
err_ma <- y - fit_ma
mape_ma <- mean(abs(err_ma / y)) * 100
mad_ma <- mean(abs(err_ma))
msd_ma <- mean(err_ma^2)
#
acc_ses <- accuracy(m_ses)
acc_holt <- accuracy(m_holt)
acc_trend <- accuracy(m_trend)
acc_reg <- accuracy(m_reg)
acc_hw <- accuracy(m_hw)
#
tabla_comparativa <- data.frame(
Method = c(
"Moving Average (N=12)",
"Simple Exp. Smoothing (SES)",
"Holt's Linear Trend",
"Linear Trend Analysis",
"Multiple Regression (Trend + Dummies)",
"Holt-Winters (Multiplicative)"
),
Seasonality = c("No", "No", "No", "No", "Yes", "Yes"),
MAPE = round(c(mape_ma, acc_ses[,"MAPE"], acc_holt[,"MAPE"], acc_trend[,"MAPE"], acc_reg[,"MAPE"], acc_hw[,"MAPE"]), 2),
MAD = round(c(mad_ma, acc_ses[,"MAE"], acc_holt[,"MAE"], acc_trend[,"MAE"], acc_reg[,"MAE"], acc_hw[,"MAE"]), 2),
MSD = round(c(msd_ma, acc_ses[,"RMSE"]^2, acc_holt[,"RMSE"]^2, acc_trend[,"RMSE"]^2, acc_reg[,"RMSE"]^2, acc_hw[,"RMSE"]^2), 2)
)
print(tabla_comparativa)
## Method Seasonality MAPE MAD MSD
## 1 Moving Average (N=12) No NA NA NA
## 2 Simple Exp. Smoothing (SES) No 9.33 501.04 367382.08
## 3 Holt's Linear Trend No 7.38 383.88 244085.08
## 4 Linear Trend Analysis No 17.93 946.59 1113028.08
## 5 Multiple Regression (Trend + Dummies) Yes 4.01 224.08 96343.54
## 6 Holt-Winters (Multiplicative) Yes 2.53 141.49 33154.61
checkresiduals(m_hw)
##
## Ljung-Box test
##
## data: Residuals from Holt-Winters' multiplicative method
## Q* = 5.2192, df = 12, p-value = 0.9503
##
## Model df: 0. Total lags used: 12
checkresiduals(m_reg)
##
## Breusch-Godfrey test for serial correlation of order up to 16
##
## data: Residuals from Linear regression model
## LM test = 44.864, df = 16, p-value = 0.0001456
#2
pronostico_2024 <- forecast(m_hw, h = 12)
tabla_2024 <- data.frame(
Month = c("Jan 2024", "Feb 2024", "Mar 2024", "Apr 2024", "May 2024", "Jun 2024",
"Jul 2024", "Aug 2024", "Sep 2024", "Oct 2024", "Nov 2024", "Dec 2024"),
Forecast = round(as.numeric(pronostico_2024$mean))
)
# Print table
print(tabla_2024)
## Month Forecast
## 1 Jan 2024 4512
## 2 Feb 2024 4203
## 3 Mar 2024 4598
## 4 Apr 2024 5368
## 5 May 2024 6169
## 6 Jun 2024 6841
## 7 Jul 2024 6967
## 8 Aug 2024 7268
## 9 Sep 2024 7260
## 10 Oct 2024 6998
## 11 Nov 2024 5819
## 12 Dec 2024 5008
plot(pronostico_2024,
PI = FALSE,
main = "HeatWave: Demand Forecast 2024 (Holt-Winters Multiplicative)",
xlab = "Year",
ylab = "Demand (Units)",
col = "black",
fcol = "pink",
flwd = 2)
lines(
x = c(time(pronostico_2024$x)[length(pronostico_2024$x)], time(pronostico_2024$mean)[1]),
y = c(tail(pronostico_2024$x, 1), pronostico_2024$mean[1]),
col = "black",
lwd = 2
)
#3
# HEATWAVE APPLIANCES
# FINISHED-GOODS INVENTORY POLICY
# ==========================================================
# ----------------------------------------------------------
# 1. EOQ FUNCTION
# ----------------------------------------------------------
EOQ <- function(D, S, H){
Q <- sqrt((2 * D * S) / H)
return(Q)
}
# ----------------------------------------------------------
# 2. 2024 FORECAST
# ----------------------------------------------------------
forecast_2024 <- c(
4512, # January
4203, # February
4598, # March
5368, # April
6169, # May
6841, # June
6967, # July
7268, # August
7260, # September
6998, # October
5819, # November
5008 # December
)
# ----------------------------------------------------------
# 3. INVENTORY PARAMETERS
# ----------------------------------------------------------
D <- sum(forecast_2024)
S <- 10000
C <- 5000
monthly_holding_rate <- 0.02
H <- C * monthly_holding_rate * 12
# ----------------------------------------------------------
# 4. DEMAND UNCERTAINTY
# ----------------------------------------------------------
MSD <- 33155
sigma_month <- sqrt(MSD)
# Assumption: one-month finished-goods lead time
L <- 1
sigma_LT <- sigma_month * sqrt(L)
# ----------------------------------------------------------
# 5. SAFETY STOCK
# ----------------------------------------------------------
z95 <- qnorm(0.95)
z99 <- qnorm(0.99)
SS95_exact <- z95 * sigma_LT
SS99_exact <- z99 * sigma_LT
SS95 <- ceiling(SS95_exact)
SS99 <- ceiling(SS99_exact)
additional_SS <- SS99 - SS95
# ----------------------------------------------------------
# 6. ECONOMIC ORDER QUANTITY
# ----------------------------------------------------------
EOQ_exact <- EOQ(D, S, H)
Q <- round(EOQ_exact)
# ----------------------------------------------------------
# 7. OPERATING METRICS
# ----------------------------------------------------------
orders_per_year <- D / Q
order_cycle_days <- 365 / orders_per_year
cycle_inventory <- Q / 2
# ----------------------------------------------------------
# 8. REORDER POINT
# ----------------------------------------------------------
ROP95 <- forecast_2024 + SS95
ROP99 <- forecast_2024 + SS99
ROP_table <- data.frame(
Month = month.name,
Forecast = forecast_2024,
ROP_95 = ROP95,
ROP_99 = ROP99
)
# ----------------------------------------------------------
# 9. ANNUAL INVENTORY COST
# ----------------------------------------------------------
annual_ordering_cost <- (D / Q) * S
cycle_holding_cost <- (Q / 2) * H
safety_holding_95 <- SS95 * H
safety_holding_99 <- SS99 * H
holding_cost_95 <- cycle_holding_cost + safety_holding_95
holding_cost_99 <- cycle_holding_cost + safety_holding_99
TRC95 <- annual_ordering_cost + holding_cost_95
TRC99 <- annual_ordering_cost + holding_cost_99
additional_annual_cost <- TRC99 - TRC95
additional_inventory_value <- additional_SS * C
# ----------------------------------------------------------
# 10. DISPLAY FINAL RESULTS
# ----------------------------------------------------------
cat("Annual demand:", D, "\n")
## Annual demand: 71011
cat("Annual holding cost/unit:", H, "\n")
## Annual holding cost/unit: 1200
cat("Forecast standard deviation:", sigma_month, "\n\n")
## Forecast standard deviation: 182.0851
cat("Safety stock 95%:", SS95, "\n")
## Safety stock 95%: 300
cat("Safety stock 99%:", SS99, "\n")
## Safety stock 99%: 424
cat("Additional safety stock:", additional_SS, "\n\n")
## Additional safety stock: 124
cat("Exact EOQ:", EOQ_exact, "\n")
## Exact EOQ: 1087.896
cat("Rounded EOQ:", Q, "\n")
## Rounded EOQ: 1088
cat("Orders per year:", orders_per_year, "\n")
## Orders per year: 65.26746
cat("Average order cycle:", order_cycle_days, "days\n")
## Average order cycle: 5.592373 days
cat("Cycle inventory:", cycle_inventory, "\n\n")
## Cycle inventory: 544
cat("TRC 95%:", TRC95, "\n")
## TRC 95%: 1665475
cat("TRC 99%:", TRC99, "\n")
## TRC 99%: 1814275
cat("Additional annual cost:", additional_annual_cost, "\n")
## Additional annual cost: 148800
cat("Additional inventory value:", additional_inventory_value, "\n\n")
## Additional inventory value: 620000
print(ROP_table)
## Month Forecast ROP_95 ROP_99
## 1 January 4512 4812 4936
## 2 February 4203 4503 4627
## 3 March 4598 4898 5022
## 4 April 5368 5668 5792
## 5 May 6169 6469 6593
## 6 June 6841 7141 7265
## 7 July 6967 7267 7391
## 8 August 7268 7568 7692
## 9 September 7260 7560 7684
## 10 October 6998 7298 7422
## 11 November 5819 6119 6243
## 12 December 5008 5308 5432
Quantity Discount Evaluation
# ==============================================================================
# HEATWAVE: QUANTITY DISCOUNT MODEL EVALUATION
# ==============================================================================
# 1. Base Parameters
D <- 71011
# 2. Magnetron Calculations
eoq_mag <- sqrt((2 * D * 10000) / (1150 * 0.24)) # EOQ Tier 2 = 2268
trc_mag_2268 <- (D * 1150) + (D / 2268) * 10000 + (2268 / 2) * 1150 * 0.24
trc_mag_2500 <- (D * 1130) + (D / 2500) * 10000 + (2500 / 2) * 1130 * 0.24
trc_mag_10k <- (D * 1110) + (D / 10000) * 10000 + (10000 / 2) * 1110 * 0.24
purch_mag <- c(D * 1150, D * 1130, D * 1110)
order_mag <- c((D / 2268) * 10000, (D / 2500) * 10000, (D / 10000) * 10000)
hold_mag <- c((2268 / 2) * 1150 * 0.24, (2500 / 2) * 1130 * 0.24, (10000 / 2) * 1110 * 0.24)
# 3. Transformer WCP Calculations
eoq_trans <- sqrt((2 * D * 15000) / (1660 * 0.24)) # EOQ Tier 3 = 2312
trc_trans_2312 <- (D * 1660) + (D / 2312) * 15000 + (2312 / 2) * 1660 * 0.24
purch_trans <- D * 1660
order_trans <- (D / 2312) * 15000
hold_trans <- (2312 / 2) * 1660 * 0.24
# 4. Cooking Cavity Calculations
trc_cavity_10k <- (D * 1280) + (D / 10000) * 2500 + (10000 / 2) * 1280 * 0.18
purch_cavity <- D * 1280
order_cavity <- (D / 10000) * 2500
hold_cavity <- (10000 / 2) * 1280 * 0.18
# 5. Consolidated Evaluation Table
resumen <- data.frame(
Component = c(
"Magnetron (EOQ)",
"Magnetron (Break Tier 3)",
"Magnetron (Break Tier 4)",
"Transformer WCP (EOQ)",
"Cooking Cavity (Break Tier 3)"
),
Order_Qty = c(round(eoq_mag), 2500, 10000, round(eoq_trans), 10000),
Unit_Price = c(1150, 1130, 1110, 1660, 1280),
Purchase_Cost = round(c(purch_mag, purch_trans, purch_cavity)),
Ordering_Cost = round(c(order_mag, order_trans, order_cavity)),
Holding_Cost = round(c(hold_mag, hold_trans, hold_cavity)),
TRC = round(c(trc_mag_2268, trc_mag_2500, trc_mag_10k, trc_trans_2312, trc_cavity_10k)),
Orders_Year = round(c(D / c(round(eoq_mag), 2500, 10000, round(eoq_trans), 10000)), 1),
Cycle_Days = round(365 / (D / c(round(eoq_mag), 2500, 10000, round(eoq_trans), 10000)), 1)
)
print(resumen)
## Component Order_Qty Unit_Price Purchase_Cost
## 1 Magnetron (EOQ) 2268 1150 81662650
## 2 Magnetron (Break Tier 3) 2500 1130 80242430
## 3 Magnetron (Break Tier 4) 10000 1110 78822210
## 4 Transformer WCP (EOQ) 2312 1660 117878260
## 5 Cooking Cavity (Break Tier 3) 10000 1280 90894080
## Ordering_Cost Holding_Cost TRC Orders_Year Cycle_Days
## 1 313100 312984 82288734 31.3 11.7
## 2 284044 339000 80865474 28.4 12.9
## 3 71011 1332000 80225221 7.1 51.4
## 4 460712 460550 118799522 30.7 11.9
## 5 17753 1152000 92063833 7.1 51.4
# 6. Managerial Decision & Annual Savings
savings_mag <- trc_mag_2268 - trc_mag_10k
cat("\n================ MANAGERIAL RECOMMENDATIONS ================\n")
##
## ================ MANAGERIAL RECOMMENDATIONS ================
cat("1. MAGNETRON:\n")
## 1. MAGNETRON:
cat(" - Optimal Order Quantity (Q*): 10,000 units (Tier 4 Price Break)\n")
## - Optimal Order Quantity (Q*): 10,000 units (Tier 4 Price Break)
cat(" - Annual Savings vs EOQ: $", format(round(savings_mag), big.mark = ","), "\n")
## - Annual Savings vs EOQ: $ 2,063,513
cat(" - Operational Cycle: ~7 orders/year (every ~51 days)\n\n")
## - Operational Cycle: ~7 orders/year (every ~51 days)
cat("2. TRANSFORMER WCP:\n")
## 2. TRANSFORMER WCP:
cat(" - Optimal Order Quantity (Q*):", round(eoq_trans), "units (Feasible EOQ)\n")
## - Optimal Order Quantity (Q*): 2312 units (Feasible EOQ)
cat(" - Operational Cycle: ~31 orders/year (every ~12 days)\n\n")
## - Operational Cycle: ~31 orders/year (every ~12 days)
cat("3. COOKING CAVITY:\n")
## 3. COOKING CAVITY:
cat(" - Evaluated Order Quantity: 10,000 units (Tier 3 Price Break)\n")
## - Evaluated Order Quantity: 10,000 units (Tier 3 Price Break)
cat(" - Total Relevant Cost (TRC): $", format(round(trc_cavity_10k), big.mark = ","), "\n")
## - Total Relevant Cost (TRC): $ 92,063,833
cat("============================================================\n")
## ============================================================