This analysis will be performed using a time series data set consisting of the total reported sales (in U.S. dollars) by new car dealers in the U.S. for each month from January of 2000 to August of 2023. This data is collected by the U.S. Census Bureau and is publicly available on their website.
The objective of this analysis is to compare the performance of four different baseline forecasting methods in predicting car sales totals for future months. To achieve this, the four different forecasting models will be constructed using all but the most recent ten observations from the data set.These final ten observations will then be compared to the values predicted by the models to evaluate each model’s accuracy in predicting future monthly totals for new car sales.
A time series plot can be generated to get a general picture of the trend in new car sales from 2000 to 2023.
library(forecast)
NewCarSales <- read.csv("C:\\Users\\eh738\\OneDrive\\Documents\\STA321\\NewCarSales.csv")[8:291,2]
NewCarSales.vec <- as.numeric(gsub(",", "", NewCarSales))
NewCarSales.ts <- ts(NewCarSales.vec, start = 2000, end = 2023, frequency = 12)
plot(NewCarSales.ts, ylab = "Total Monthly Sales", main = "Monthly New Car Dealer Sales (in Millions of Dollars), 2000-2023")
The plot exhibits a general upward trend in monthly new car dealer sales from 2000 to 2023, with the exception of some dramatic dips around 2008 and 2020. Also, the plot seems to suggest that since about 2010 (with the exception of the atypical event around 2020), monthly new car dealer sales have been rising at a much steeper rate than prior to 2010. This steep rise is roughly linear in appearance. It also appears that a seasonal pattern may be present within the larger trend.
In order to both construct the forecasting models and evaluate the accuracy of each, the observations in the data set must be broken up into a training set and a testing set. For this analysis, the first 274 months will be used as the training set upon which each model will be constructed, and the last 10 months will be used as the testing set to compare the predicted sales values of each model to the observed values to evaluate how well each model forecasts future sales amounts. A new time series will be created based only on the training set.
training = NewCarSales.vec[1:274]
testing = NewCarSales.vec[275:284]
training.ts <- ts(training, frequency = 12, start = c(2000, 1))
The four baselines methods which will be used to construct unique models are the moving average method, the naive method, the seasonal naive method, and the drift method. Each method has its respective advantages and drawbacks and is better suited for some types of time series than for others. Each of the corresponding forecasting models will now be constructed using the training time series created above.
pred.mv = meanf(training.ts, h=10)$mean
pred.naive = naive(training.ts, h=10)$mean
pred.snaive = snaive(training.ts, h=10)$mean
pred.rwf = rwf(training.ts, h=10, drift = TRUE)$mean
pred.table = cbind( Mov.Avg = pred.mv,
Naive = pred.naive,
Seas.Naive = pred.snaive,
Drift = pred.rwf)
kable(pred.table, caption = "Forecasting Table")
| Mov.Avg | Naive | Seas.Naive | Drift |
|---|---|---|---|
| 62690.75 | 94566 | 85780 | 94740.12 |
| 62690.75 | 94566 | 92751 | 94914.23 |
| 62690.75 | 94566 | 84871 | 95088.35 |
| 62690.75 | 94566 | 86629 | 95262.47 |
| 62690.75 | 94566 | 101645 | 95436.59 |
| 62690.75 | 94566 | 100395 | 95610.70 |
| 62690.75 | 94566 | 95901 | 95784.82 |
| 62690.75 | 94566 | 95625 | 95958.94 |
| 62690.75 | 94566 | 92334 | 96133.05 |
| 62690.75 | 94566 | 99421 | 96307.17 |
The above table displays the forecasted values for the final 10 months in the data set predicted by each of the four baseline models. One immediate difference to be noticed in these sets of forecasted values is that the predicted values of the moving average and naive models are constant, while those of the seasonal naive and drift models vary across the successive months. Based on this observation, it would seem that either the seasonal naive or drift models are more appropriate fits for this particular time series, considering the consistent fluctuations visible in the initial time series plot.
A graphical comparison of each model’s predictions versus the actual values for the most recent 10 months can provide even clearer insight into how well (or poorly) each model fits the data.
plot(264:284, NewCarSales.vec[264:284], type="l", xlim=c(264,284), ylim=c(62500, 106500),
xlab = "Observation Sequence",
ylab = "Monthly New Car Dealer Sales",
main = "Monthly New Car Dealer Sales and Forecasting")
points(264:284, NewCarSales.vec[264:284], pch=20)
##
points(275:284, pred.mv, pch=15, col = "lightgoldenrod")
points(275:284, pred.naive, pch=16, col = "darkturquoise")
points(275:284, pred.rwf, pch=18, col = "darkorchid2")
points(275:284, pred.snaive, pch=17, col = "springgreen3")
##
lines(275:284, pred.mv, lty=2, col = "lightgoldenrod")
lines(275:284, pred.snaive, lty=2, col = "springgreen3")
lines(275:284, pred.naive, lty=2, col = "darkturquoise")
lines(275:284, pred.rwf, lty=2, col = "darkorchid2")
##
legend("bottomleft", c("Moving Average", "Naive", "Drift", "Seasonal Naive"),
col=c("lightgoldenrod", "darkturquoise", "darkorchid2", "springgreen3"), pch=15:18, lty=rep(2,4),
bty="n", cex = 0.8)
From this graph it appears that the seasonal naive model clearly fits the data best, particularly over the first six observations of the testing set. This makes sense given a seasonal pattern was suspected based on the initial time series plot. The forecasted values of this model do however begin to deviate a bit more from the actual values over the last few observations, suggesting that this method may still fail to account for certain aspects of the true trend.
The moving average model, on the other hand, does an exceptionally poor job of forecasting the values of the testing set, its predicted values lying well below the actual trend line and failing to reflect its pattern even remotely. The constant nature of this model’s forecasted values fails to account for the generally rising trend of the time series as well as its apparent seasonal pattern.
Finally, the naive and drift models both appear to furnish somewhat reasonable forecasted values, though their strictly linear trajectories fail to reflect the regular fluctuations of the time series nearly as well as the seasonal naive model does. Also, neither appears to effectively account for the steep rise of the overall trend, as they begin to consistently underestimate the monthly sales value beginning with the fifth observation in the testing set. That said, the drift model does at least exhibit a more gradual rising pattern, whereas the naive model manifests as a horizontal line with a constant forecasted value that will deviate more and more from the actual monthly sales values assuming the general upward trend persists.
One final method of evaluating the quality of each forecasting model is the calculation of a few different quantitative measures of how accurately each predicted the “future” values of the testing set. In particular, the MAPE (Mean Absolute Percentage Error), MAD (Mean Absolute Deviation), and MSE (Mean Squared Error) of each model will be calculated and compared to determine which model exhibits the greatest overall accuracy.
true.value = NewCarSales.vec[275:284]
PE.mv = 100*(true.value - pred.mv)/true.value
PE.naive = 100*(true.value - pred.naive)/true.value
PE.snaive = 100*(true.value - pred.snaive)/true.value
PE.rwf = 100*(true.value - pred.rwf)/true.value
##
MAPE.mv = mean(abs(PE.mv))
MAPE.naive = mean(abs(PE.naive))
MAPE.snaive = mean(abs(PE.snaive))
MAPE.rwf = mean(abs(PE.rwf))
##
MAPE = c(MAPE.mv, MAPE.naive, MAPE.snaive, MAPE.rwf)
## residual-based Error
e.mv = true.value - pred.mv
e.naive = true.value - pred.naive
e.snaive = true.value - pred.snaive
e.rwf = true.value - pred.rwf
## MAD
MAD.mv = sum(abs(e.mv))
MAD.naive = sum(abs(e.naive))
MAD.snaive = sum(abs(e.snaive))
MAD.rwf = sum(abs(e.rwf))
MAD = c(MAD.mv, MAD.naive, MAD.snaive, MAD.rwf)
## MSE
MSE.mv = mean((e.mv)^2)
MSE.naive = mean((e.naive)^2)
MSE.snaive = mean((e.snaive)^2)
MSE.rwf = mean((e.rwf)^2)
MSE = c(MSE.mv, MSE.naive, MSE.snaive, MSE.rwf)
##
accuracy.table = cbind(MAPE = MAPE, MAD = MAD, MSE = MSE)
row.names(accuracy.table) = c("Moving Average", "Naive", "Seasonal Naive", "Drift")
kable(accuracy.table, caption ="Overall Accuracy of the Four Forecasting Methods")
| MAPE | MAD | MSE | |
|---|---|---|---|
| Moving Average | 35.450494 | 348807.48 | 1259549463 |
| Naive | 6.672377 | 65847.00 | 51915900 |
| Seasonal Naive | 4.564200 | 45371.00 | 27317513 |
| Drift | 6.029392 | 59056.43 | 42109777 |
These quantitative accuracy measures generally confirm the inferences drawn from the graphical comparison of the models. Based on all three metrics, the seasonal naive model unequivocally performed the best, the naive and drift models slightly worse but still somewhat reasonably, and the moving average model the worst (by a wide margin).