Naive Forecasts for Wine Sales
BL
11/4/2016
********************************************************************
Problem Description
********************************************************************
You are hired to obtain short-term forecasts (2-months ahead) for each of the six series, and this task will be repeated every month, as new data arrive. Download the data from www.forecastingbook.com/mooc. Generate naive forecasts for January and February, 1995, for each of the six wine types. These will serve as our benchmarks.
********************************************************************
Load Libraries
********************************************************************
# install.packages("data.table")
library(data.table)
library(forecast)
library(knitr) # for kable table formatting********************************************************************
Get data
********************************************************************
aussieWines = fread("http://www.forecastingbook.com/mooc/AustralianWines.csv?attredirects=0&d=1")
aussieWines = data.frame(aussieWines[1:180,]) # Fread gets confused at end of file and adds some NA's
colnames(aussieWines)[5] = "Sparkling" # Capitalize Sparking wine column name
summary(aussieWines)## Month Fortified Red Rose
## Length:180 Min. :1154 Min. : 464 Length:180
## Class :character 1st Qu.:2377 1st Qu.:1123 Class :character
## Mode :character Median :2894 Median :1559 Mode :character
## Mean :2999 Mean :1630
## 3rd Qu.:3527 3rd Qu.:2106
## Max. :5618 Max. :3670
## Sparkling Sweet.white Dry.white
## Min. :1170 Min. : 85.0 Min. :1954
## 1st Qu.:1605 1st Qu.:141.5 1st Qu.:2736
## Median :1896 Median :223.5 Median :3090
## Mean :2431 Mean :247.1 Mean :3240
## 3rd Qu.:2599 3rd Qu.:319.2 3rd Qu.:3685
## Max. :7242 Max. :662.0 Max. :5725********************************************************************
Create TS objects
********************************************************************
fortified.ts = ts(aussieWines$Fortified, start=c(1980,1), end = c(1994, 12), freq=12)
red.ts = ts(aussieWines$Red, start=c(1980,1), end = c(1994, 12), freq=12)
sparkling.ts = ts(aussieWines$Sparkling, start=c(1980,1), end = c(1994, 12), freq=12)
sweetwine.ts = ts(aussieWines$Sweet.white, start=c(1980,1), end = c(1994, 12), freq=12)
drywhite.ts = ts(aussieWines$Dry.white, start=c(1980,1), end = c(1994, 12), freq=12)
aussieWines$Rose = as.numeric(aussieWines$Rose) # make Rose a numeric variables and introduce NA's at "*"s## Warning: NAs introduced by coercionrose.ts = ts(aussieWines$Rose, start=c(1980,1), end = c(1994, 12), freq=12)
# Impute by interpolation missing values in rose.ts
# install.packages("imputeTS")
library(imputeTS)
rose.ts = na.interpolation(rose.ts)********************************************************************
Plot Wines: Data, Trend, Seasonality
********************************************************************
#install.packages("forecast")
# library(forecast)
par(mfrow = c(1, 3))
plot(fortified.ts, bty="l", main="Fortified Wine")
abline(reg=lm(fortified.ts~time(fortified.ts)))
plot(aggregate(fortified.ts,FUN=mean), main="Fortified Trend")
boxplot(fortified.ts~cycle(fortified.ts), xlab="Months", main="Seasonality of Fortified Wine")
plot(red.ts, bty="l", main= "Red Wine")
abline(reg=lm(red.ts~time(red.ts)))
plot(aggregate(red.ts,FUN=mean), main="Red Wine Trend")
boxplot(red.ts~cycle(red.ts), xlab="Months", main="Seasonality of Red Wine")
plot(rose.ts, bty="l", main = "Rose Wine")
abline(reg=lm(rose.ts~time(rose.ts)))
plot(aggregate(rose.ts,FUN=mean), main="Rose Wine Trend")
boxplot(rose.ts~cycle(rose.ts), xlab="Months", main="Seasonality of Rose Wine")
plot(sparkling.ts, bty="l", main = "Sparkling Wine")
abline(reg=lm(sparkling.ts~time(sparkling.ts)))
plot(aggregate(sparkling.ts,FUN=mean), main="Sparkling Wine Trend")
boxplot(sparkling.ts~cycle(sparkling.ts), xlab="Months", main="Seasonality of Sparkling Wine")
plot(sweetwine.ts, bty="l", main="Sweet Wine")
abline(reg=lm(sweetwine.ts~time(sweetwine.ts)))
plot(aggregate(sweetwine.ts,FUN=mean), main="Sweet Wine Trend")
boxplot(sweetwine.ts~cycle(sweetwine.ts), xlab="Months", main="Seasonality of Sweet Wine")
plot(drywhite.ts, bty="l", main = "Dry White Wines")
abline(reg=lm(drywhite.ts~time(drywhite.ts)))
plot(aggregate(drywhite.ts,FUN=mean), main="Dry White Wine Trend")
boxplot(drywhite.ts~cycle(drywhite.ts), xlab="Months", main="Seasonality of Dry White Wine")
********************************************************************
Generate Naive Forecasts for each of the six wines
********************************************************************
# library(forecast)
# Fortified Wine Naive FCs
naiveFortified.pred = naive(fortified.ts, h = 2)
naiveFortified.fc = naiveFortified.pred$mean
snaiveFortified.pred = snaive(fortified.ts, h = 2) # Seasonal Naive
snaiveFortified.fc = snaiveFortified.pred$mean
# Red Wine Naive FCs
naiveRed.pred = naive(red.ts, h = 2)
naiveRed.fc = naiveRed.pred$mean
snaiveRed.pred = snaive(red.ts, h = 2) # Seasonal Naive
snaiveRed.fc = snaiveRed.pred$mean
# Sparkling Wine Naive FCs
naiveSparkling.pred = naive(sparkling.ts, h = 2)
naiveSparkling.fc = naiveSparkling.pred$mean
snaiveSparkling.pred = snaive(sparkling.ts, h = 2) # Seasonal Naive
snaiveSparkling.fc = snaiveSparkling.pred$mean
# Sweet Wine Naive FCs
naiveSweet.pred = naive(sweetwine.ts, h = 2)
naiveSweet.fc = naiveSweet.pred$mean
snaiveSweet.pred = snaive(sweetwine.ts, h = 2) # Seasonal Naive
snaiveSweet.fc = snaiveSweet.pred$mean
# Dry White Wine Naive FCs
naiveDryWhite.pred = naive(drywhite.ts, h = 2)
naiveDryWhite.fc = naiveDryWhite.pred$mean
snaiveDryWhite.pred = snaive(drywhite.ts, h = 2) # Seasonal Naive
snaiveDryWhite.fc = snaiveDryWhite.pred$mean
# Rose Wine Naive FCs
naiveRose.pred = naive(rose.ts, h = 2)
naiveRose.fc = naiveRose.pred$mean #
snaiveRose.pred = snaive(rose.ts, h = 2) # Seasonal Naive
snaiveRose.fc = snaiveRose.pred$mean********************************************************************
Table of Naive Forecasts
********************************************************************
wineNaive.db = data.frame(Wines = colnames(aussieWines)[2:7],
NaiveFC_Jan95 = c(naiveFortified.fc[1], naiveRed.fc[1], naiveRose.fc[1], naiveSparkling.fc[1], naiveSweet.fc[1], naiveDryWhite.fc[1]),
NaiveFC_Feb95 = c(naiveFortified.fc[2], naiveRed.fc[2], naiveRose.fc[2], naiveSparkling.fc[2], naiveSweet.fc[2], naiveDryWhite.fc[2]),
Seasonal_NaiveFC_Jan95 = c(snaiveFortified.fc[1], snaiveRed.fc[1], snaiveRose.fc[1], snaiveSparkling.fc[1], snaiveSweet.fc[1], snaiveDryWhite.fc[1]),
Seasonal_NaiveFC_Feb95 = c(snaiveFortified.fc[2], snaiveRed.fc[2], snaiveRose.fc[2], snaiveSparkling.fc[2], snaiveSweet.fc[2], snaiveDryWhite.fc[2])
)
kable(wineNaive.db, caption = "Naive Forecasts For Wines Sales")| Wines | NaiveFC_Jan95 | NaiveFC_Feb95 | Seasonal_NaiveFC_Jan95 | Seasonal_NaiveFC_Feb95 |
|---|---|---|---|---|
| Fortified | 2467 | 2467 | 1154 | 1568 |
| Red | 2684 | 2684 | 1041 | 1728 |
| Rose | 84 | 84 | 30 | 35 |
| Sparkling | 5999 | 5999 | 1197 | 1968 |
| Sweet.white | 394 | 394 | 150 | 280 |
| Dry.white | 5725 | 5725 | 2265 | 3685 |
********************************************************************
Plot Naive Forecasts
********************************************************************
par(mfrow = c(1, 2))
# Plot Fortified Wine naive FCs
plot(naiveFortified.pred, main = 'Fortified Wine Naive FC')
plot(snaiveFortified.pred, main = "Fortified Seasonal Naive FC")
# Plot Red Wine Naive FCs
plot(naiveRed.pred, main = "Red Wine Naive FC")
plot(snaiveRed.pred, main = "Seasonal Red Wine Naive FC")
# Plot Sparkling Wine Naive FCs
plot(naiveSparkling.pred, main = "Sparkling Wine Naive FC")
plot(snaiveSparkling.pred, main = "Seasonal Sparkling Wine Naive FC")
# Plot Sweet Wine Naive FCs
plot(naiveSweet.pred, main = "Sweet Wine Naive FC")
plot(snaiveSweet.pred, main = "Seasonal Sweet Wine Naive FC")
# Plot Dry White Wine Naive FCs
plot(naiveDryWhite.pred, main = "Dry White Wine Naive FC")
plot(snaiveDryWhite.pred, main = "Seasonal Dry White Wine Naive FC" )
# Plot Rose Wine Naive FCs
plot(naiveRose.pred, main = "Rose Wine Naive FC")
plot(snaiveRose.pred, main = "Seasonal Rose Wine Naive FC")