The data could be found here:http://archive.ics.uci.edu/ml/datasets/Wine+Quality and the goal of such a data is to model wine, red wine particualrly,quality based on physicochemical tests. and In my analysis, I have choosen to build related models with one of the elements ,fixed acidity.
library(fpp2)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## ── Attaching packages ────────────────────────────────────────────────────── fpp2 2.4 ──
## ✓ ggplot2 3.3.2 ✓ fma 2.4
## ✓ forecast 8.13 ✓ expsmooth 2.3
##
wine =read.csv("~/Desktop/winequality-red.csv", sep=";", stringsAsFactors=TRUE)
wine_ts = ts(wine[,1], start=c(1990,1), end=c(2020,1), frequency = 12)
wine_ts
## Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
## 1990 7.4 7.8 7.8 11.2 7.4 7.4 7.9 7.3 7.8 7.5 6.7 7.5
## 1991 5.6 7.8 8.9 8.9 8.5 8.1 7.4 7.9 8.9 7.6 7.9 8.5
## 1992 6.9 6.3 7.6 7.9 7.1 7.8 6.7 6.9 8.3 6.9 5.2 7.8
## 1993 7.8 8.1 5.7 7.3 7.3 8.8 7.5 8.1 6.8 4.6 7.7 8.7
## 1994 6.4 5.6 8.8 6.6 6.6 8.6 7.6 7.7 10.2 7.5 7.8 7.3
## 1995 8.8 7.7 7.5 7.0 7.2 7.2 7.5 6.6 9.3 8.0 7.7 7.7
## 1996 7.7 8.3 9.7 8.8 8.8 6.8 6.7 8.3 6.2 7.8 7.4 7.3
## 1997 6.3 6.9 8.6 7.7 9.3 7.0 7.9 8.6 8.6 7.7 5.0 4.7
## 1998 6.8 7.0 7.6 8.1 8.3 7.8 8.1 8.1 7.2 8.1 7.8 6.2
## 1999 8.0 8.1 7.8 8.4 8.4 10.1 7.8 9.4 8.3 7.8 8.8 7.0
## 2000 7.3 8.8 7.3 8.0 7.8 9.0 8.2 8.1 8.0 6.1 8.0 5.6
## 2001 5.6 6.6 7.9 8.4 8.3 7.2 7.8 7.8 8.4 8.3 5.2 6.3
## 2002 5.2 8.1 5.8 7.6 6.9 8.2 7.3 9.2 7.5 7.5 7.1 7.1
## 2003 7.1 7.1 7.1 6.8 7.6 7.6 7.8 7.4 7.3 7.8 6.8 7.3
## 2004 6.8 7.5 7.9 8.0 8.0 7.4 7.3 6.9 7.3 7.5 7.0 8.8
## 2005 8.8 8.9 7.2 6.8 6.7 8.9 7.4 7.7 7.9 7.9 8.2 6.4
## 2006 6.8 7.6 7.6 7.8 7.3 11.5 5.4 6.9 9.6 8.8 6.8 7.0
## 2007 7.0 12.8 12.8 7.8 7.8 11.0 9.7 8.0 11.6 8.2 7.8 7.0
## 2008 8.7 8.1 7.5 7.8 7.8 7.4 6.8 8.6 8.4 7.7 8.9 9.0
## 2009 7.7 6.9 5.2 8.0 8.5 6.9 8.2 7.2 7.2 7.2 7.2 8.2
## 2010 8.9 12.0 7.7 15.0 15.0 7.3 7.1 8.2 7.7 7.3 10.8 7.1
## 2011 11.1 7.7 7.1 8.0 9.4 6.6 7.7 10.0 7.9 7.0 8.0 7.9
## 2012 12.5 11.8 8.1 7.9 6.9 11.5 7.9 11.5 10.9 8.4 7.5 7.9
## 2013 6.9 11.5 10.3 8.9 11.4 7.7 7.6 8.9 9.9 9.9 12.0 7.5
## 2014 8.7 11.6 8.7 11.0 10.4 6.9 13.3 10.8 10.6 7.1 7.2 6.9
## 2015 7.5 11.1 8.3 7.4 8.4 10.3 7.6 10.3 10.3 7.4 10.3 7.9
## 2016 9.0 8.6 7.4 7.1 9.6 9.6 9.8 9.6 9.8 9.3 7.8 10.3
## 2017 10.0 10.0 11.6 10.3 13.4 10.7 10.2 10.2 8.0 8.4 7.9 11.9
## 2018 8.9 7.8 12.4 12.5 12.2 10.6 10.9 10.9 11.9 7.0 6.6 13.8
## 2019 9.6 9.1 10.7 9.1 7.7 13.5 6.1 6.7 11.5 10.5 11.9 12.6
## 2020 8.2
summary(wine_ts)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 4.600 7.300 7.800 8.279 8.800 15.000
autoplot(wine_ts) + ggtitle("Wine(Red) Quality ") +xlab("Year")+ylab("Fixed.acidity")
wine_ts_stl = stl(wine_ts,s.window = "periodic")
wine_seasonal = seasadj(wine_ts_stl)
ggseasonplot(wine_seasonal)
#ETS Model1
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(knitr)
wine_etsmodel1 =ets(wine_seasonal,model="MNN")
summary(wine_etsmodel1)
## ETS(M,N,N)
##
## Call:
## ets(y = wine_seasonal, model = "MNN")
##
## Smoothing parameters:
## alpha = 0.0835
##
## Initial states:
## l = 7.6557
##
## sigma: 0.1721
##
## AIC AICc BIC
## 2375.112 2375.179 2386.778
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 0.0804494 1.457263 1.080397 -1.730018 12.94536 0.7530627 0.0759201
etsmodel1.fc = forecast(wine_etsmodel1,h = 60)
kable(accuracy(etsmodel1.fc))
| Training set |
0.0804494 |
1.457263 |
1.080397 |
-1.730018 |
12.94536 |
0.7530627 |
0.0759201 |
#ETS model2
wine_etsmodel2 =ets(wine_seasonal,model="MAA")
summary(wine_etsmodel2)
## ETS(M,A,A)
##
## Call:
## ets(y = wine_seasonal, model = "MAA")
##
## Smoothing parameters:
## alpha = 0.0464
## beta = 7e-04
## gamma = 1e-04
##
## Initial states:
## l = 7.7944
## b = -0.0065
## s = -0.0799 -0.0668 0.0136 -0.0487 0.0236 0.0551
## 0.0577 0.0067 0.001 -0.0163 0.166 -0.1121
##
## sigma: 0.1754
##
## AIC AICc BIC
## 2401.590 2403.374 2467.701
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 0.08681254 1.454124 1.068754 -1.597455 12.81579 0.7449472 0.100776
etsmodel2.fc = forecast(wine_etsmodel2,h = 60)
kable(accuracy(etsmodel2.fc))
| Training set |
0.0868125 |
1.454124 |
1.068754 |
-1.597455 |
12.81579 |
0.7449472 |
0.100776 |
#ETS model3
wine_etsmodel3 =ets(wine_seasonal,model="MAA")
summary(wine_etsmodel3)
## ETS(M,A,A)
##
## Call:
## ets(y = wine_seasonal, model = "MAA")
##
## Smoothing parameters:
## alpha = 0.0464
## beta = 7e-04
## gamma = 1e-04
##
## Initial states:
## l = 7.7944
## b = -0.0065
## s = -0.0799 -0.0668 0.0136 -0.0487 0.0236 0.0551
## 0.0577 0.0067 0.001 -0.0163 0.166 -0.1121
##
## sigma: 0.1754
##
## AIC AICc BIC
## 2401.590 2403.374 2467.701
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 0.08681254 1.454124 1.068754 -1.597455 12.81579 0.7449472 0.100776
etsmodel3.fc = forecast(wine_etsmodel3,h = 60)
kable(accuracy(etsmodel3.fc))
| Training set |
0.0868125 |
1.454124 |
1.068754 |
-1.597455 |
12.81579 |
0.7449472 |
0.100776 |
#Comparing Models
par(mfrow = c(1,3))
plot(etsmodel1.fc, main = "ETSModel1")
plot(etsmodel2.fc, main = "ETSModel2")
plot(etsmodel3.fc, main = "ETSModel3")
kable(accuracy(etsmodel1.fc))
| Training set |
0.0804494 |
1.457263 |
1.080397 |
-1.730018 |
12.94536 |
0.7530627 |
0.0759201 |
kable(accuracy(etsmodel2.fc))
| Training set |
0.0868125 |
1.454124 |
1.068754 |
-1.597455 |
12.81579 |
0.7449472 |
0.100776 |
kable(accuracy(etsmodel3.fc))
| Training set |
0.0868125 |
1.454124 |
1.068754 |
-1.597455 |
12.81579 |
0.7449472 |
0.100776 |
#It's very interesting to see that among all three models, they all ended with pretty similar values of MAPE, therefore, I concluded that all three models could be picked for forecasting in this case