1. Coding

state_day_sales <- state_day_sales %>%
  mutate(
    
    # Weekday dummies - Sunday is reference
    weekday_Monday = if_else(weekday == "Monday", 1, 0),
    weekday_Tuesday = if_else(weekday == "Tuesday", 1, 0),
    weekday_Wednesday = if_else(weekday == "Wednesday", 1, 0),
    weekday_Thursday = if_else(weekday == "Thursday", 1, 0),
    weekday_Friday = if_else(weekday == "Friday", 1, 0),
    weekday_Saturday = if_else(weekday == "Saturday", 1, 0),
    
    # Month dummies - January is reference
    month_Feb = if_else(month == 2, 1, 0),
    month_Mar = if_else(month == 3, 1, 0),
    month_Apr = if_else(month == 4, 1, 0),
    month_May = if_else(month == 5, 1, 0),
    month_Jun = if_else(month == 6, 1, 0),
    month_Jul = if_else(month == 7, 1, 0),
    month_Aug = if_else(month == 8, 1, 0),
    month_Sep = if_else(month == 9, 1, 0),
    month_Oct = if_else(month == 10, 1, 0),
    month_Nov = if_else(month == 11, 1, 0),
    month_Dec = if_else(month == 12, 1, 0),
    
    # Event dummies - non-event day is reference
    event_NewYear = if_else(
      event_name_1 == "NewYear" | event_name_2 == "NewYear",
      1, 0, missing = 0
    ),
    
    event_MLK = if_else(
      event_name_1 == "MartinLutherKingDay" |
        event_name_2 == "MartinLutherKingDay",
      1, 0, missing = 0
    ),
    
    event_SuperBowl = if_else(
      event_name_1 == "SuperBowl" | event_name_2 == "SuperBowl",
      1, 0, missing = 0
    ),
    
    event_ValentinesDay = if_else(
      event_name_1 == "ValentinesDay" |
        event_name_2 == "ValentinesDay",
      1, 0, missing = 0
    ),
    
    event_LentStart = if_else(
      event_name_1 == "LentStart" | event_name_2 == "LentStart",
      1, 0, missing = 0
    ),
    
    event_LentWeek2 = if_else(
      event_name_1 == "LentWeek2" | event_name_2 == "LentWeek2",
      1, 0, missing = 0
    ),
    
    event_Easter = if_else(
      event_name_1 == "Easter" | event_name_2 == "Easter",
      1, 0, missing = 0
    ),
    
    event_OrthodoxEaster = if_else(
      event_name_1 == "OrthodoxEaster" |
        event_name_2 == "OrthodoxEaster",
      1, 0, missing = 0
    ),
    
    event_MemorialDay = if_else(
      event_name_1 == "MemorialDay" |
        event_name_2 == "MemorialDay",
      1, 0, missing = 0
    ),
    
    event_NBAFinalsStart = if_else(
      event_name_1 == "NBAFinalsStart" |
        event_name_2 == "NBAFinalsStart",
      1, 0, missing = 0
    ),
    
    event_FathersDay = if_else(
      event_name_1 == "Father's day" |
        event_name_2 == "Father's day",
      1, 0, missing = 0
    ),
    
    event_IndependenceDay = if_else(
      event_name_1 == "IndependenceDay" |
        event_name_2 == "IndependenceDay",
      1, 0, missing = 0
    ),
    
    event_LaborDay = if_else(
      event_name_1 == "LaborDay" | event_name_2 == "LaborDay",
      1, 0, missing = 0
    ),
    
    event_Halloween = if_else(
      event_name_1 == "Halloween" | event_name_2 == "Halloween",
      1, 0, missing = 0
    ),
    
    event_Thanksgiving = if_else(
      event_name_1 == "Thanksgiving" |
        event_name_2 == "Thanksgiving",
      1, 0, missing = 0
    ),
    
    event_Christmas = if_else(
      event_name_1 == "Christmas" | event_name_2 == "Christmas",
      1, 0, missing = 0
    )
  )

unique_dates <- sort(
  unique(state_day_sales$date)
)

split_date <- unique_dates[
  floor(length(unique_dates) * 0.80)
]

in_sample <- state_day_sales %>%
  filter(date <= split_date)

out_sample <- state_day_sales %>%
  filter(date > split_date)

split_date

range(in_sample$date)

range(out_sample$date)

nrow(in_sample)

nrow(out_sample)


ols_model <- lm(
  total_sales ~
    weighted_sell_price +
    
    weekday_Monday +
    weekday_Tuesday +
    weekday_Wednesday +
    weekday_Thursday +
    weekday_Friday +
    weekday_Saturday +
    
    month_Feb +
    month_Mar +
    month_Apr +
    month_May +
    month_Jun +
    month_Jul +
    month_Aug +
    month_Sep +
    month_Oct +
    month_Nov +
    month_Dec +
    
    event_NewYear +
    event_MLK +
    event_SuperBowl +
    event_ValentinesDay +
    event_LentStart +
    event_LentWeek2 +
    event_Easter +
    event_OrthodoxEaster +
    event_MemorialDay +
    event_NBAFinalsStart +
    event_FathersDay +
    event_IndependenceDay +
    event_LaborDay +
    event_Halloween +
    event_Thanksgiving +
    event_Christmas,
  
  data = in_sample
)

stargazer(
  ols_model,
  type = "text",
  title = "OLS Sales Forecasting Model",
  dep.var.labels = "Units Sold"
)

out_sample$predicted <- predict(
  ols_model,
  newdata = out_sample
)

rmse_ols <- sqrt(
  mean(
    (out_sample$predicted - out_sample$total_sales)^2,
    na.rm = TRUE
  )
)

cat(
  "OLS Model RMSE (out-of-sample):",
  rmse_ols,
  "\n"
)

ggplot(
  out_sample,
  aes(x = date)
) +
  geom_line(
    aes(
      y = total_sales,
      color = "Actual"
    )
  ) +
  geom_line(
    aes(
      y = predicted,
      color = "Predicted"
    )
  ) +
  facet_wrap(
    ~state_id,
    scales = "free_y"
  ) +
  labs(
    title = "OLS Model: Predicted vs. Actual Sales (Out-of-Sample)",
    x = NULL,
    y = "Units Sold",
    color = NULL
  ) +
  theme_minimal()

2. Regression Equation

coefs <- coef(ols_model)

terms <- paste0(
  ifelse(coefs[-1] >= 0, " + ", " - "),
  abs(round(coefs[-1], 3)),
  "(",
  names(coefs[-1]),
  ")"
)

equation <- paste0(
  "Predicted Sales = ",
  round(coefs[1], 3),
  paste(terms, collapse = "")
)

cat(equation, "\n\n")

Predicted Sales = -12677.512 + 9268.167(weighted_sell_price) - 2823.067(weekday_Monday) - 3487.242(weekday_Tuesday) - 3606.499(weekday_Wednesday) - 3511.508(weekday_Thursday) - 2236.264(weekday_Friday) + 98.612(weekday_Saturday) + 36.19(month_Feb) - 305.791(month_Mar) - 172.267(month_Apr) - 226.647(month_May) + 1201.876(month_Jun) + 1107.055(month_Jul) + 1495.416(month_Aug) + 880.285(month_Sep) + 300.751(month_Oct) - 132.96(month_Nov) - 107.578(month_Dec) - 2557.864(event_NewYear) + 91.838(event_MLK) + 367.921(event_SuperBowl) - 1091.6(event_ValentinesDay) - 134.435(event_LentStart) - 204.022(event_LentWeek2) - 1447.337(event_Easter) - 153.147(event_OrthodoxEaster) + 574.959(event_MemorialDay) + 489.863(event_NBAFinalsStart) - 1191.278(event_FathersDay) + 707.781(event_IndependenceDay) + 3256.494(event_LaborDay) - 1519.319(event_Halloween) - 2658.008(event_Thanksgiving) - 10597.179(event_Christmas)

Reference categories: Sunday for weekday, January for month, and non-event days for events.

3. Results of Linear Regression

stargazer(
  ols_model,
  type = "html",
  title = "OLS Sales Forecasting Model",
  dep.var.labels = "Units Sold"
)
OLS Sales Forecasting Model
Dependent variable:
Units Sold
weighted_sell_price 9,268.167***
(247.401)
weekday_Monday -2,823.067***
(154.526)
weekday_Tuesday -3,487.242***
(152.335)
weekday_Wednesday -3,606.499***
(153.994)
weekday_Thursday -3,511.508***
(153.300)
weekday_Friday -2,236.264***
(152.524)
weekday_Saturday 98.612
(152.263)
month_Feb 36.190
(200.478)
month_Mar -305.791
(192.352)
month_Apr -172.267
(194.758)
month_May -226.647
(203.630)
month_Jun 1,201.876***
(207.140)
month_Jul 1,107.055***
(204.212)
month_Aug 1,495.416***
(202.830)
month_Sep 880.285***
(205.402)
month_Oct 300.751
(203.353)
month_Nov -132.960
(205.120)
month_Dec -107.578
(203.475)
event_NewYear -2,557.864***
(799.650)
event_MLK 91.838
(805.596)
event_SuperBowl 367.921
(724.106)
event_ValentinesDay -1,091.600
(716.895)
event_LentStart -134.435
(717.154)
event_LentWeek2 -204.022
(717.145)
event_Easter -1,447.337*
(774.835)
event_OrthodoxEaster -153.147
(775.119)
event_MemorialDay 574.959
(805.613)
event_NBAFinalsStart 489.863
(797.026)
event_FathersDay -1,191.278
(806.179)
event_IndependenceDay 707.781
(799.681)
event_LaborDay 3,256.494***
(805.875)
event_Halloween -1,519.319*
(799.586)
event_Thanksgiving -2,658.008***
(805.800)
event_Christmas -10,597.180***
(799.647)
Constant -12,677.510***
(711.577)
Observations 4,656
R2 0.404
Adjusted R2 0.399
Residual Std. Error 2,722.102 (df = 4621)
F Statistic 91.953*** (df = 34; 4621)
Note: p<0.1; p<0.05; p<0.01

Key Results

The model contains 4,656 observations and has an R-squared of 0.404 and an adjusted R-squared of 0.399. The F-statistic is 91.953 and the residual standard error is 2,722.102.

Several variables were statistically significant. Monday through Friday had significantly lower sales compared with Sunday. June through September had significantly higher sales compared with January.

Among the event variables, Labor Day had a significant positive effect of approximately 3,256 units. New Year, Thanksgiving, and Christmas had significant negative effects. Christmas had the largest estimated effect, decreasing predicted sales by approximately 10,597 units.

Some events that appeared important in our initial event analysis, such as the Super Bowl, were no longer statistically significant after controlling for weekday, month, and weighted sell price.

Significance levels: * p < 0.10, ** p < 0.05, *** p < 0.01.

4. Predicted vs. Actual Sales

The following graph compares the model’s out-of-sample predicted sales with the actual sales for California, Texas, and Wisconsin.

prediction_plot <- ggplot(
  out_sample,
  aes(x = date)
) +
  geom_line(
    aes(
      y = total_sales,
      color = "Actual",
      group = state_id
    )
  ) +
  geom_line(
    aes(
      y = predicted,
      color = "Predicted",
      group = state_id
    )
  ) +
  facet_wrap(
    ~state_id,
    scales = "free_y"
  ) +
  labs(
    title = "OLS Model: Predicted vs. Actual Sales (Out-of-Sample)",
    x = "Date",
    y = "Units Sold",
    color = NULL
  ) +
  theme_minimal()

ggplotly(prediction_plot)

5. RMSE

rmse_ols <- sqrt(
  mean(
    (out_sample$predicted - out_sample$total_sales)^2,
    na.rm = TRUE
  )
)

rmse_ols
## [1] 3260.106

The model produced an out-of-sample RMSE of 3,260.106 units. This means the model’s predicted daily sales typically differed from actual sales by several thousand units, with larger prediction errors receiving more weight in the RMSE calculation.