Forecasting with exponential smoothing Methods
Nana Boateng
We explore various exponential smoothing methods for modeling and forecasting time series data including the Holt Winters smoothing and several other various others. We attempt to forecast the number of vehicles that are brought to a vehicle proving grounds for testing. The old model used overpredicted the actual number of vehicles by a very high margin. The planning to hire drivers for vehicle testing takes at least 8 weeks and as such our forecast should on the minimum be able to accurately predict the number of future vehicles in at least 8 weeks.
setwd("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/time series")load the packages required for this analysis at this step.
library(sweep) #similar to broom for time series data. Broom tidiers for forecast pkg
library(tseries)
library(lubridate)
library(tidyverse)
library(timetk)
library(readxl) #read excel data
library(tidyquant)
library(scales)
library(forecast) # forecasting pkg
library(DT) #creating a java based table
library(timekit)
library(stringr) #working with text objects
library(plotly) #for visualizing interactive graphics
library(broom)
library(tibble)
library(gam) #general additive models package.
library(viridis)
library(RColorBrewer)read the data.
modeldat=read_excel("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actvsfcdatajuly311.xlsx",sheet = "Sheet1")%>%na.omit()%>%dplyr::rename(Date=Week)
modeldat%>%head()dim(modeldat)[1]## [1] 86modeldat[dim(modeldat)[1],1]Hmisc::Cs(modeldat[dim(modeldat)[1],1]) ## [1] "modeldat[dim(modeldat)[1], 1]"paste(modeldat[dim(modeldat)[1],1])## [1] "1505692800"Take a glimpse of the data including summary.
modeldat[61,]dim(modeldat)## [1] 86 2glimpse(modeldat)## Observations: 86
## Variables: 2
## $ Date <dttm> 2016-01-11, 2016-01-18, 2016-01-25, 2016-02-01, 2016-0...
## $ Actual <dbl> 26, 27, 28, 22, 27, 31, 26, 27, 21, 23, 25, 23, 23, 23,...modeldat%>%mutate(Date=as.Date(Date))%>%summary()%>%tk_tbl()## Warning in tk_tbl.data.frame(as.data.frame(data), preserve_index,
## rename_index, : Warning: No index to preserve. Object otherwise converted
## to tibble successfully.tail(modeldat)%>%knitr::kable()| Date | Actual |
|---|---|
| 2017-08-14 | 32 |
| 2017-08-21 | 30 |
| 2017-08-28 | 27 |
| 2017-09-04 | 32 |
| 2017-09-11 | 32 |
| 2017-09-18 | 36 |
Split into training(first 60) and test sets(last 21)
#
modeldat=modeldat%>%mutate(Date=as.Date(Date))
train <- modeldat %>%
dplyr::filter(Date < ymd("2017-03-27"))
test <- modeldat %>%
dplyr:: filter(Date >= ymd("2017-03-27"))# Training set
train%>%head()test%>%head()%>%knitr::kable()| Date | Actual |
|---|---|
| 2017-03-27 | 29 |
| 2017-04-03 | 30 |
| 2017-04-10 | 32 |
| 2017-04-17 | 36 |
| 2017-04-24 | 32 |
| 2017-05-01 | 27 |
First step in the analysis is to visualize the data to look out for periods of extreme high frequency and low frequency,presence of seasonality and trends in the data. The graph shows there is usually high volume of vehicles in the summer and low numbers in the fall seasons.
modeldat%>%ggplot(aes(Date,Actual))+geom_line()+
geom_point(alpha = 0.5, color = palette_light()[[1]], shape=20,size=2) +
labs(title = "Durability Vehicles Forecasting", x = "Time", y = "Number of \n Durability Vehicles",
subtitle = "data from 2016 & 2017") +
theme_tq()
modeldat%>%
ggplot(aes(x = Date, y = Actual)) +
geom_rect(xmin = as.numeric(ymd("2017-03-27")),
xmax = as.numeric(ymd("2017-10-21")),
ymin = 20, ymax = 50,
fill = palette_light()[[3]], alpha = 0.01) +
ggplot2::annotate("text", x = ymd("2016-03-17"), y = 45,
color = palette_light()[[1]], label = "Train Region")+
ggplot2::annotate("text", x = ymd("2017-07-17"), y = 45,
color = palette_light()[[1]], label = "Test Region")+
geom_point(alpha = 0.5, color = palette_light()[[1]], shape=20,size=2) +
labs(title = "Durability Vehicles Forecasting", x = "Time", y = "Number of \n Durability Vehicles",
subtitle = "data from 2016 & 2017") +
theme_tq()
Holt-Winters Exponential Smoothing
Triple Exponential Smoothing, also known as the Holt-Winters method, is one of the many methods or algorithms that can be used to forecast data points in a series, provided that the series is “seasonal”, i.e. repetitive over some period.
Naive Method
This is the most primitive forecasting method. The premise of the naive method is that the expected point is equal to the last observed point:
\(\hat{y}_{x}=\frac{1}{x}\sum\limits_{i=1}^{x}y_{i}\)
Simple Average
A less primitive method is the arithmetic average of all the previously observed data points. We take all the values we know, calculate the average and bet that that’s going to be the next value. Of course it won’t be it exactly, but it probably will be somewhere in the ballpark, hopefully you can see the reasoning behind this simplistic approach.
\(\hat{y}_{x+1}=y_{x}\)
Single Exponential Smoothing
\(\hat{y}_{x}=\alpha y_{x}+(1-\alpha)\hat{y}_{x-1}\)
convert the data into a time series object.
modelseries=modeldat%>%tk_xts()
modelseries%>%timetk::tk_tbl()%>%head()autoplot(modelseries)+ labs(title = "Durability Vehicles Forecasting", x = "Time", y = "Number of \n Durability Vehicles",
subtitle = "data from 2016 & 2017") 
Holt-Winters exponential smoothing with trend and without seasonal component.
l.start can be chosen as the first observation and b.start can be chosen as the difference between the first to observations.
modelseriesforecasts<-HoltWinters(modelseries, gamma=FALSE, l.start=26, b.start=1)
sweep::sw_tidy(modelseriesforecasts)%>%knitr::kable()| term | estimate |
|---|---|
| alpha | 0.7550822 |
| beta | 0.0347653 |
| gamma | 0.0000000 |
| a | 34.9938320 |
| b | 0.2240450 |
Examine the model by exploring the fitted values and observed values, SSE and coefficients of the model.
modelseriesforecasts$seasonal%>%tk_tbl()%>%knitr::kable()| data |
|---|
| additive |
modelseriesforecasts$x%>%tk_tbl()%>%knitr::kable()| index | value |
|---|---|
| 1 | 26 |
| 8 | 27 |
| 15 | 28 |
| 22 | 22 |
| 29 | 27 |
| 36 | 31 |
| 43 | 26 |
| 50 | 27 |
| 57 | 21 |
| 64 | 23 |
| 71 | 25 |
| 78 | 23 |
| 85 | 23 |
| 92 | 23 |
| 99 | 23 |
| 106 | 27 |
| 113 | 31 |
| 120 | 30 |
| 127 | 33 |
| 134 | 29 |
| 141 | 29 |
| 148 | 32 |
| 155 | 31 |
| 162 | 36 |
| 169 | 37 |
| 176 | 38 |
| 183 | 39 |
| 190 | 40 |
| 197 | 35 |
| 204 | 38 |
| 211 | 32 |
| 218 | 33 |
| 225 | 29 |
| 232 | 29 |
| 239 | 27 |
| 246 | 24 |
| 253 | 23 |
| 260 | 31 |
| 267 | 32 |
| 274 | 33 |
| 281 | 30 |
| 288 | 32 |
| 295 | 33 |
| 302 | 35 |
| 309 | 32 |
| 316 | 30 |
| 323 | 29 |
| 330 | 27 |
| 337 | 27 |
| 344 | 26 |
| 351 | 26 |
| 358 | 25 |
| 365 | 25 |
| 372 | 22 |
| 379 | 25 |
| 386 | 26 |
| 393 | 23 |
| 400 | 25 |
| 407 | 28 |
| 414 | 28 |
| 421 | 29 |
| 428 | 30 |
| 435 | 32 |
| 442 | 36 |
| 449 | 32 |
| 456 | 27 |
| 463 | 32 |
| 470 | 28 |
| 477 | 28 |
| 484 | 30 |
| 491 | 34 |
| 498 | 32 |
| 505 | 28 |
| 512 | 34 |
| 519 | 32 |
| 526 | 35 |
| 533 | 32 |
| 540 | 30 |
| 547 | 33 |
| 554 | 33 |
| 561 | 32 |
| 568 | 30 |
| 575 | 27 |
| 582 | 32 |
| 589 | 32 |
| 596 | 36 |
modelseriesforecasts$SSE%>%tk_tbl()%>%knitr::kable()| data |
|---|
| 754.9157 |
length(modelseriesforecasts$x)%>%tk_tbl()%>%knitr::kable()| data |
|---|
| 86 |
sum(is.na(modeldat))%>%tk_tbl()%>%knitr::kable()| data |
|---|
| 0 |
modelseriesforecasts$fitted%>%tk_tbl()%>%knitr::kable()| index | xhat | level | trend |
|---|---|---|---|
| 15 | 27.00000 | 26.00000 | 1.0000000 |
| 22 | 28.78133 | 27.75508 | 1.0262507 |
| 29 | 24.50911 | 23.66087 | 0.8482362 |
| 36 | 27.30356 | 26.38994 | 0.9136239 |
| 43 | 31.10533 | 30.09468 | 1.0106578 |
| 50 | 28.12703 | 27.25039 | 0.8766395 |
| 57 | 28.12308 | 27.27603 | 0.8470543 |
| 64 | 23.40464 | 22.74457 | 0.6600687 |
| 71 | 23.74855 | 23.09910 | 0.6494467 |
| 78 | 25.37580 | 24.69350 | 0.6822981 |
| 85 | 24.20181 | 23.58187 | 0.6199319 |
| 92 | 23.88273 | 23.29434 | 0.5883837 |
| 99 | 23.78141 | 23.21620 | 0.5652115 |
| 106 | 23.73608 | 23.19138 | 0.5446991 |
| 113 | 26.83099 | 26.20061 | 0.6303791 |
| 120 | 30.71875 | 29.97893 | 0.7398184 |
| 127 | 30.89699 | 30.17604 | 0.7209507 |
| 134 | 33.26109 | 32.48493 | 0.7761562 |
| 141 | 30.70792 | 30.04362 | 0.6642998 |
| 148 | 30.03777 | 29.41830 | 0.6194658 |
| 155 | 32.19039 | 31.51941 | 0.6709758 |
| 162 | 31.93127 | 31.29155 | 0.6397273 |
| 169 | 35.75003 | 35.00350 | 0.7465340 |
| 176 | 37.47321 | 36.69386 | 0.7793465 |
| 183 | 38.66415 | 37.87098 | 0.7931751 |
| 190 | 39.71974 | 38.91775 | 0.8019913 |
| 197 | 40.74071 | 39.93136 | 0.8093484 |
| 204 | 37.06465 | 36.40600 | 0.6586511 |
| 211 | 38.45412 | 37.77092 | 0.6832046 |
| 218 | 34.09451 | 33.58073 | 0.5137797 |
| 225 | 33.75311 | 33.26806 | 0.4850481 |
| 232 | 30.52440 | 30.16412 | 0.3602758 |
| 239 | 29.69361 | 29.37335 | 0.3202594 |
| 246 | 27.90926 | 27.65971 | 0.2495503 |
| 253 | 25.10438 | 24.95745 | 0.1469296 |
| 260 | 23.60709 | 23.51540 | 0.0916883 |
| 267 | 29.47510 | 29.18934 | 0.2857571 |
| 274 | 31.73364 | 31.38161 | 0.3520373 |
| 281 | 33.07513 | 32.68985 | 0.3852800 |
| 288 | 31.05771 | 30.75315 | 0.3045559 |
| 295 | 32.09851 | 31.76922 | 0.3292916 |
| 302 | 33.13216 | 32.77921 | 0.3529564 |
| 309 | 34.94452 | 34.54253 | 0.4019883 |
| 316 | 33.04586 | 32.72117 | 0.3246927 |
| 323 | 30.99072 | 30.74598 | 0.2447369 |
| 330 | 29.68004 | 29.48756 | 0.1924791 |
| 337 | 27.77852 | 27.65639 | 0.1221263 |
| 344 | 27.29236 | 27.19067 | 0.1016897 |
| 351 | 26.38429 | 26.31652 | 0.0677644 |
| 358 | 26.15180 | 26.09412 | 0.0576766 |
| 365 | 25.30954 | 25.28210 | 0.0274412 |
| 372 | 25.09513 | 25.07581 | 0.0193157 |
| 379 | 22.69612 | 22.75805 | -0.0619334 |
| 386 | 24.43428 | 24.43574 | -0.0014550 |
| 393 | 25.65617 | 25.61653 | 0.0396461 |
| 400 | 23.62046 | 23.65054 | -0.0300802 |
| 407 | 24.66826 | 24.66213 | 0.0061335 |
| 414 | 27.27759 | 27.18400 | 0.0935938 |
| 421 | 27.93563 | 27.82307 | 0.1125575 |
| 428 | 28.87981 | 28.73932 | 0.1404980 |
| 435 | 29.89555 | 29.72565 | 0.1699036 |
| 442 | 31.70973 | 31.48458 | 0.2251468 |
| 449 | 35.28701 | 34.94924 | 0.3377692 |
| 456 | 33.05653 | 32.80505 | 0.2514831 |
| 463 | 28.57585 | 28.48335 | 0.0924953 |
| 470 | 31.34375 | 31.16136 | 0.1823815 |
| 477 | 28.91355 | 28.81894 | 0.0946060 |
| 484 | 28.29437 | 28.22374 | 0.0706248 |
| 491 | 29.69766 | 29.58226 | 0.1153987 |
| 498 | 33.17462 | 32.94628 | 0.2283380 |
| 505 | 32.48519 | 32.28768 | 0.1975035 |
| 512 | 29.17827 | 29.09850 | 0.0797643 |
| 519 | 33.02541 | 32.81907 | 0.2063380 |
| 526 | 32.43056 | 32.25114 | 0.1794203 |
| 533 | 34.61757 | 34.37070 | 0.2468698 |
| 540 | 32.81925 | 32.64109 | 0.1781569 |
| 547 | 30.79463 | 30.69048 | 0.1041498 |
| 554 | 32.62191 | 32.45987 | 0.1620421 |
| 561 | 33.07937 | 32.90740 | 0.1719673 |
| 568 | 32.40799 | 32.26436 | 0.1436332 |
| 575 | 30.67018 | 30.58976 | 0.0804219 |
| 582 | 27.88297 | 27.89889 | -0.0159227 |
| 589 | 31.08382 | 30.99167 | 0.0921520 |
| 596 | 31.89181 | 31.77561 | 0.1162024 |
modelseriesforecasts$coefficients%>%tk_tbl()%>%head()%>%knitr::kable()| index | data |
|---|---|
| a | 34.993832 |
| b | 0.224045 |
Graph the observed data versus the model fit to the data.
#autoplot(modelseriesforecasts)+labs(title="predicted versus observed values of \n drivers hired",y="Actual Hires",x="Time Index")
require(graphics)
#plot(na.omit(modelseriesforecasts))
#autoplot.zoo(modelseriesforecasts)
na.omit(modelseriesforecasts)%>%plot() 
When \(gamma\) is set to TRUE to model seasonal time series, The following error shows up Error in decompose(ts(x[1L:wind], start = start(x), frequency = f), seasonal) : time series has no or less than 2 periods. The series appears to be non seasonal The first value in the time series is usually chosen as the initial value for the level.
#simple exponential smoothing
H1=HoltWinters(modelseries, beta=FALSE, gamma=FALSE)
H2= HoltWinters(modelseries, beta=FALSE, gamma=FALSE, l.start=23.56)
sweep::sw_tidy(H2)%>%knitr::kable() | term | estimate |
|---|---|
| alpha | 0.7201469 |
| beta | 0.0000000 |
| gamma | 0.0000000 |
| a | 34.7932292 |
#H3=HoltWinters(log(modelseries))Holt-Winters exponential smoothing with trend and without seasonal component.
modelseriesforecast<-HoltWinters(modelseries,gamma =FALSE)
sweep::sw_tidy(modelseriesforecast)%>%knitr::kable()| term | estimate |
|---|---|
| alpha | 0.7597851 |
| beta | 0.0344831 |
| gamma | 0.0000000 |
| a | 35.0148929 |
| b | 0.2231579 |
sweep::sw_augment(modelseriesforecast)%>%head()%>%knitr::kable()| index | .actual | .fitted | .resid |
|---|---|---|---|
| 1 | 26 | NA | NA |
| 8 | 27 | NA | NA |
| 15 | 28 | 28.00000 | 0.000000 |
| 22 | 22 | 29.00000 | -7.000000 |
| 29 | 27 | 24.49811 | 2.501894 |
| 36 | 31 | 27.28116 | 3.718842 |
sweep::sw_augment(modelseriesforecast)%>%tail()%>%knitr::kable()| index | .actual | .fitted | .resid |
|---|---|---|---|
| 561 | 32 | 33.08112 | -1.0811235 |
| 568 | 30 | 32.40211 | -2.4021056 |
| 575 | 27 | 30.65649 | -3.6564905 |
| 582 | 32 | 27.86201 | 4.1379867 |
| 589 | 32 | 31.09808 | 0.9019221 |
| 596 | 36 | 31.89906 | 4.1009409 |
sweep::sw_glance(modelseriesforecast)# modelseriesforecastError in decompose(ts(x[1L:wind], start = start(x), frequency = f), seasonal) : time series has no or less than 2 periods
Simple Exponential smoothing forecasts
ses(y=modelseries, h = 12, level = c(90, 95), fan = FALSE, initial = "optimal",
alpha = NULL, lambda = NULL, biasadj =TRUE)%>%tk_tbl()%>%knitr::kable()| index | Point Forecast | Lo 90 | Hi 90 | Lo 95 | Hi 95 |
|---|---|---|---|---|---|
| 603 | 34.78607 | 30.04913 | 39.52300 | 29.14166 | 40.43047 |
| 610 | 34.78607 | 28.95274 | 40.61939 | 27.83523 | 41.73690 |
| 617 | 34.78607 | 28.03204 | 41.54009 | 26.73815 | 42.83399 |
| 624 | 34.78607 | 27.22260 | 42.34953 | 25.77364 | 43.79849 |
| 631 | 34.78607 | 26.49178 | 43.08035 | 24.90281 | 44.66932 |
| 638 | 34.78607 | 25.82033 | 43.75180 | 24.10274 | 45.46940 |
| 645 | 34.78607 | 25.19578 | 44.37635 | 23.35854 | 46.21359 |
| 652 | 34.78607 | 24.60949 | 44.96264 | 22.65993 | 46.91220 |
| 659 | 34.78607 | 24.05518 | 45.51695 | 21.99943 | 47.57270 |
| 666 | 34.78607 | 23.52813 | 46.04400 | 21.37141 | 48.20072 |
| 673 | 34.78607 | 23.02468 | 46.54745 | 20.77151 | 48.80062 |
| 680 | 34.78607 | 22.54191 | 47.03022 | 20.19625 | 49.37588 |
Holts local Trend Method
holt(y=modelseries, h = 12, level = c(90, 95),
initial = "optimal", alpha = NULL,
beta = NULL, phi = NULL, lambda = NULL, biasadj = TRUE)%>%tk_tbl()%>%knitr::kable()| index | Point Forecast | Lo 90 | Hi 90 | Lo 95 | Hi 95 |
|---|---|---|---|---|---|
| 603 | 34.88269 | 30.13738 | 39.62799 | 29.22830 | 40.53707 |
| 610 | 34.97532 | 29.15031 | 40.80032 | 28.03440 | 41.91624 |
| 617 | 35.06795 | 28.33396 | 41.80194 | 27.04390 | 43.09199 |
| 624 | 35.16058 | 27.62627 | 42.69488 | 26.18290 | 44.13826 |
| 631 | 35.25321 | 26.99560 | 43.51082 | 25.41366 | 45.09276 |
| 638 | 35.34584 | 26.42319 | 44.26849 | 24.71385 | 45.97783 |
| 645 | 35.43847 | 25.89686 | 44.98009 | 24.06894 | 46.80801 |
| 652 | 35.53110 | 25.40814 | 45.65407 | 23.46885 | 47.59336 |
| 659 | 35.62373 | 24.95089 | 46.29658 | 22.90626 | 48.34121 |
| 666 | 35.71637 | 24.52047 | 46.91226 | 22.37564 | 49.05709 |
| 673 | 35.80900 | 24.11329 | 47.50471 | 21.87270 | 49.74529 |
| 680 | 35.90163 | 23.72647 | 48.07678 | 21.39403 | 50.40922 |
Exponential trend method
holt(y=modelseries, h = 12, level = c(90, 95),
initial = "optimal", exponential = TRUE, alpha = NULL,
beta = NULL, phi = NULL, lambda = NULL, biasadj = TRUE)%>%tk_tbl()%>%knitr::kable()| index | Point Forecast | Lo 90 | Hi 90 | Lo 95 | Hi 95 |
|---|---|---|---|---|---|
| 603 | 34.86407 | 28.94756 | 40.63893 | 27.86504 | 41.85805 |
| 610 | 34.89444 | 28.08646 | 42.36135 | 26.83621 | 44.23528 |
| 617 | 34.92484 | 26.97294 | 44.02242 | 25.79441 | 46.05971 |
| 624 | 34.95527 | 26.20447 | 44.94803 | 24.93923 | 46.99426 |
| 631 | 34.98572 | 25.60234 | 46.13345 | 24.04444 | 48.47926 |
| 638 | 35.01619 | 25.03872 | 47.48212 | 23.39345 | 50.23781 |
| 645 | 35.04670 | 24.35352 | 48.11552 | 22.90957 | 51.02012 |
| 652 | 35.07723 | 24.01021 | 49.19562 | 22.05304 | 52.65075 |
| 659 | 35.10778 | 23.43628 | 50.36512 | 21.72297 | 53.61278 |
| 666 | 35.13837 | 22.83291 | 50.45473 | 21.08103 | 54.06041 |
| 673 | 35.16898 | 22.27847 | 51.97503 | 20.33394 | 55.87071 |
| 680 | 35.19961 | 21.66666 | 52.74988 | 19.86693 | 56.67702 |
Additive damped trend
holt(y=modelseries, h = 12, damped = TRUE, level = c(90, 95),
initial = "optimal", alpha = NULL,
beta = NULL, phi = NULL, lambda = NULL, biasadj = TRUE)%>%sweep::sw_tidy()%>%knitr::kable()## Warning in tidy.default(x, ...): No method for tidying an S3 object of
## class forecast , using as.data.frame| Point Forecast | Lo 90 | Hi 90 | Lo 95 | Hi 95 | |
|---|---|---|---|---|---|
| 603 | 34.78625 | 30.04925 | 39.52324 | 29.14177 | 40.43072 |
| 610 | 34.78658 | 28.95309 | 40.62006 | 27.83555 | 41.73760 |
| 617 | 34.78685 | 28.03243 | 41.54126 | 26.73847 | 42.83522 |
| 624 | 34.78706 | 27.22292 | 42.35121 | 25.77383 | 43.80030 |
| 631 | 34.78724 | 26.49194 | 43.08253 | 24.90278 | 44.67169 |
| 638 | 34.78738 | 25.82029 | 43.75447 | 24.10243 | 45.47232 |
| 645 | 34.78749 | 25.19550 | 44.37949 | 23.35793 | 46.21706 |
| 652 | 34.78759 | 24.60895 | 44.96622 | 22.65899 | 46.91618 |
| 659 | 34.78766 | 24.05437 | 45.52095 | 21.99815 | 47.57717 |
| 666 | 34.78772 | 23.52704 | 46.04841 | 21.36979 | 48.20565 |
| 673 | 34.78777 | 23.02330 | 46.55224 | 20.76954 | 48.80600 |
| 680 | 34.78781 | 22.54024 | 47.03538 | 20.19393 | 49.38169 |
mdfit=modelseriesforecasts$fitted%>%timetk::tk_tbl()
mdfit%>%head()%>%knitr::kable()| index | xhat | level | trend |
|---|---|---|---|
| 15 | 27.00000 | 26.00000 | 1.0000000 |
| 22 | 28.78133 | 27.75508 | 1.0262507 |
| 29 | 24.50911 | 23.66087 | 0.8482362 |
| 36 | 27.30356 | 26.38994 | 0.9136239 |
| 43 | 31.10533 | 30.09468 | 1.0106578 |
| 50 | 28.12703 | 27.25039 | 0.8766395 |
select=dplyr::select
Date=modeldat%>%select(Date)%>%slice(-c(1,2))
mdfit1=add_column(Date,fit=mdfit$xhat)
mdfit1%>%head()%>%knitr::kable()| Date | fit |
|---|---|
| 2016-01-25 | 27.00000 |
| 2016-02-01 | 28.78133 |
| 2016-02-08 | 24.50911 |
| 2016-02-15 | 27.30356 |
| 2016-02-22 | 31.10533 |
| 2016-02-29 | 28.12703 |
length(mdfit$xhat)## [1] 84dim(Date)## [1] 84 1mdfit$xhat## [1] 27.00000 28.78133 24.50911 27.30356 31.10533 28.12703 28.12308
## [8] 23.40464 23.74855 25.37580 24.20181 23.88273 23.78141 23.73608
## [15] 26.83099 30.71875 30.89699 33.26109 30.70792 30.03776 32.19039
## [22] 31.93127 35.75003 37.47321 38.66415 39.71974 40.74071 37.06465
## [29] 38.45412 34.09451 33.75311 30.52440 29.69361 27.90926 25.10438
## [36] 23.60709 29.47510 31.73364 33.07513 31.05771 32.09851 33.13216
## [43] 34.94452 33.04586 30.99072 29.68004 27.77852 27.29236 26.38429
## [50] 26.15180 25.30954 25.09513 22.69612 24.43428 25.65617 23.62046
## [57] 24.66826 27.27759 27.93563 28.87981 29.89555 31.70973 35.28701
## [64] 33.05653 28.57585 31.34375 28.91355 28.29437 29.69766 33.17462
## [71] 32.48519 29.17827 33.02541 32.43056 34.61757 32.81925 30.79463
## [78] 32.62191 33.07937 32.40799 30.67018 27.88297 31.08382 31.89181mdfit1%>%tail()%>%knitr::kable()| Date | fit |
|---|---|
| 2017-08-14 | 33.07937 |
| 2017-08-21 | 32.40799 |
| 2017-08-28 | 30.67018 |
| 2017-09-04 | 27.88297 |
| 2017-09-11 | 31.08382 |
| 2017-09-18 | 31.89181 |
modeldat%>%ggplot(aes(Date,Actual))+geom_line(aes(Date,Actual,color="Observed"), size=1.5, linetype=1)+
# remove legend title
theme(legend.title = element_blank()) +
#geom_point(alpha = 0.5, shape=20,size=2) +
#geom_point(aes(x=Date,y=fit),data=mdfit1)+
geom_line(aes(x=Date,y=fit,color="predicted"),data=mdfit1, size=1.5, linetype=1)+
# change legend title
# guides(fill=guide_legend(title="Key")) +
labs(title = "Predicted Values vs Observed values", x = "Time",y=" Durability Vehicles")+
theme_tq()
p=modeldat%>%ggplot(aes(Date,Actual))+geom_line(aes(Date,Actual,color="Observed"), size=1.5, linetype=1)+
#geom_point(alpha = 0.5, shape=20,size=2) +
# geom_point(aes(x=Date,y=fit),data=mdfit1)+
geom_line(aes(x=Date,y=fit,color="predicted"),data=mdfit1, size=1.5, linetype=1)+
# change legend title
# guides(fill=guide_legend(title="Key")) +
labs(title = "Predicted Values vs Observed values", x = "Time",y=" Durability Vehicles")+
# remove legend title
theme(legend.title = element_blank()) +
theme_tq()
ggplotly()Plotting on plotly
#plot_ly(data=modeldat,x=~Date,y=~Actual,mode='lines')%>%
plot_ly(data=modeldat,x=~Date)%>%
add_trace(y=~Actual,mode='lines',name="observed")%>%
add_trace(data=mdfit1,x=~Date,y=~fit,mode='lines',name="predicted",text=paste(Date, 'Time', Sys.timezone()))%>%
layout(title="Predicted Values vs Observed values",
scene=list(
xaxis=list(title="Time"),
yaxis=list(title="Number of \n Durability Vehicles")
)) modeldat%>%ggplot(aes(x=Date,y=Actual))+geom_line(aes(color="Observed"), size=1.5, linetype=1)+geom_line(aes(x=Date,y=fit,color="Predicted"),data=mdfit1, show.legend=TRUE, size=1.5, linetype=1)+
labs(title = "Predicted Values vs Observed values", x = "Time",y=" Durability Vehicles")+
theme_bw() +
# define a custom background theme
#theme(panel.background = element_rect(fill = 'grey75')) +
scale_colour_manual(name='Holtwinters Exponential\n Smoothing Method',values=c("Predicted"="red","Observed"='black'))+
#Make title bold and add a little space at the baseline (face, vjust)
theme(plot.title = element_text(size=14, face="bold", vjust=2))+
#change the position of the legend
theme(legend.position="top") +
# Change the color of the title of the legend (name)
theme(legend.title = element_text(colour="chocolate", size=14, face="bold"))
dim(modelseriesforecasts$fitted)## [1] 84 3sweep::sw_tidy(modelseriesforecasts)%>%knitr::kable()| term | estimate |
|---|---|
| alpha | 0.7550822 |
| beta | 0.0347653 |
| gamma | 0.0000000 |
| a | 34.9938320 |
| b | 0.2240450 |
modelseriesforecasts$fitted%>%sweep::sw_tidy()%>%knitr::kable()| xhat | level | trend |
|---|---|---|
| 27.00000 | 26.00000 | 1.0000000 |
| 28.78133 | 27.75508 | 1.0262507 |
| 24.50911 | 23.66087 | 0.8482362 |
| 27.30356 | 26.38994 | 0.9136239 |
| 31.10533 | 30.09468 | 1.0106578 |
| 28.12703 | 27.25039 | 0.8766395 |
| 28.12308 | 27.27603 | 0.8470543 |
| 23.40464 | 22.74457 | 0.6600687 |
| 23.74855 | 23.09910 | 0.6494467 |
| 25.37580 | 24.69350 | 0.6822981 |
| 24.20181 | 23.58187 | 0.6199319 |
| 23.88273 | 23.29434 | 0.5883837 |
| 23.78141 | 23.21620 | 0.5652115 |
| 23.73608 | 23.19138 | 0.5446991 |
| 26.83099 | 26.20061 | 0.6303791 |
| 30.71875 | 29.97893 | 0.7398184 |
| 30.89699 | 30.17604 | 0.7209507 |
| 33.26109 | 32.48493 | 0.7761562 |
| 30.70792 | 30.04362 | 0.6642998 |
| 30.03777 | 29.41830 | 0.6194658 |
| 32.19039 | 31.51941 | 0.6709758 |
| 31.93127 | 31.29155 | 0.6397273 |
| 35.75003 | 35.00350 | 0.7465340 |
| 37.47321 | 36.69386 | 0.7793465 |
| 38.66415 | 37.87098 | 0.7931751 |
| 39.71974 | 38.91775 | 0.8019913 |
| 40.74071 | 39.93136 | 0.8093484 |
| 37.06465 | 36.40600 | 0.6586511 |
| 38.45412 | 37.77092 | 0.6832046 |
| 34.09451 | 33.58073 | 0.5137797 |
| 33.75311 | 33.26806 | 0.4850481 |
| 30.52440 | 30.16412 | 0.3602758 |
| 29.69361 | 29.37335 | 0.3202594 |
| 27.90926 | 27.65971 | 0.2495503 |
| 25.10438 | 24.95745 | 0.1469296 |
| 23.60709 | 23.51540 | 0.0916883 |
| 29.47510 | 29.18934 | 0.2857571 |
| 31.73364 | 31.38161 | 0.3520373 |
| 33.07513 | 32.68985 | 0.3852800 |
| 31.05771 | 30.75315 | 0.3045559 |
| 32.09851 | 31.76922 | 0.3292916 |
| 33.13216 | 32.77921 | 0.3529564 |
| 34.94452 | 34.54253 | 0.4019883 |
| 33.04586 | 32.72117 | 0.3246927 |
| 30.99072 | 30.74598 | 0.2447369 |
| 29.68004 | 29.48756 | 0.1924791 |
| 27.77852 | 27.65639 | 0.1221263 |
| 27.29236 | 27.19067 | 0.1016897 |
| 26.38429 | 26.31652 | 0.0677644 |
| 26.15180 | 26.09412 | 0.0576766 |
| 25.30954 | 25.28210 | 0.0274412 |
| 25.09513 | 25.07581 | 0.0193157 |
| 22.69612 | 22.75805 | -0.0619334 |
| 24.43428 | 24.43574 | -0.0014550 |
| 25.65617 | 25.61653 | 0.0396461 |
| 23.62046 | 23.65054 | -0.0300802 |
| 24.66826 | 24.66213 | 0.0061335 |
| 27.27759 | 27.18400 | 0.0935938 |
| 27.93563 | 27.82307 | 0.1125575 |
| 28.87981 | 28.73932 | 0.1404980 |
| 29.89555 | 29.72565 | 0.1699036 |
| 31.70973 | 31.48458 | 0.2251468 |
| 35.28701 | 34.94924 | 0.3377692 |
| 33.05653 | 32.80505 | 0.2514831 |
| 28.57585 | 28.48335 | 0.0924953 |
| 31.34375 | 31.16136 | 0.1823815 |
| 28.91355 | 28.81894 | 0.0946060 |
| 28.29437 | 28.22374 | 0.0706248 |
| 29.69766 | 29.58226 | 0.1153987 |
| 33.17462 | 32.94628 | 0.2283380 |
| 32.48519 | 32.28768 | 0.1975035 |
| 29.17827 | 29.09850 | 0.0797643 |
| 33.02541 | 32.81907 | 0.2063380 |
| 32.43056 | 32.25114 | 0.1794203 |
| 34.61757 | 34.37070 | 0.2468698 |
| 32.81925 | 32.64109 | 0.1781569 |
| 30.79463 | 30.69048 | 0.1041498 |
| 32.62191 | 32.45987 | 0.1620421 |
| 33.07937 | 32.90740 | 0.1719673 |
| 32.40799 | 32.26436 | 0.1436332 |
| 30.67018 | 30.58976 | 0.0804219 |
| 27.88297 | 27.89889 | -0.0159227 |
| 31.08382 | 30.99167 | 0.0921520 |
| 31.89181 | 31.77561 | 0.1162024 |
modelseriesforecasts$fitted%>%timetk::tk_tbl()%>%dplyr::select(xhat)modelseriesfitted=modelseriesforecasts$fitted%>%timetk::tk_tbl()%>%dplyr::select(index,xhat)
plot(modelseriesfitted$index,modelseriesfitted$xhat,type="l")
modelseriesforecasts2<-forecast(modelseriesforecasts, h=12)
autoplot(modelseriesforecasts2)+labs(y="Durability")+
labs(title = "Observed values and Forecast Values", x = "Time",y=" Durability Vehicles")
HoltWinters_mod=modelseriesforecasts2%>%timetk::tk_tbl()
# replace white spaces in column names with _
names(HoltWinters_mod)<-gsub("\\s", "_", names(HoltWinters_mod))
HoltWinters_mod%>%knitr::kable()| index | Point_Forecast | Lo_80 | Hi_80 | Lo_95 | Hi_95 |
|---|---|---|---|---|---|
| 603 | 35.21788 | 31.37963 | 39.05613 | 29.34778 | 41.08798 |
| 610 | 35.44192 | 30.57100 | 40.31284 | 27.99249 | 42.89136 |
| 617 | 35.66597 | 29.89240 | 41.43953 | 26.83606 | 44.49588 |
| 624 | 35.89001 | 29.28872 | 42.49130 | 25.79421 | 45.98582 |
| 631 | 36.11406 | 28.73333 | 43.49478 | 24.82621 | 47.40190 |
| 638 | 36.33810 | 28.21107 | 44.46513 | 23.90889 | 48.76732 |
| 645 | 36.56215 | 27.71242 | 45.41188 | 23.02765 | 50.09664 |
| 652 | 36.78619 | 27.23094 | 46.34145 | 22.17269 | 51.39969 |
| 659 | 37.01024 | 26.76210 | 47.25837 | 21.33706 | 52.68341 |
| 666 | 37.23428 | 26.30257 | 48.16600 | 20.51567 | 53.95290 |
| 673 | 37.45833 | 25.84982 | 49.06683 | 19.70465 | 55.21200 |
| 680 | 37.68237 | 25.40192 | 49.96283 | 18.90104 | 56.46371 |
sweep::sw_tidy(modelseriesforecasts2)%>%knitr::kable()## Warning in tidy.default(x, ...): No method for tidying an S3 object of
## class forecast , using as.data.frame| Point Forecast | Lo 80 | Hi 80 | Lo 95 | Hi 95 | |
|---|---|---|---|---|---|
| 603 | 35.21788 | 31.37963 | 39.05613 | 29.34778 | 41.08798 |
| 610 | 35.44192 | 30.57100 | 40.31284 | 27.99249 | 42.89136 |
| 617 | 35.66597 | 29.89240 | 41.43953 | 26.83606 | 44.49588 |
| 624 | 35.89001 | 29.28872 | 42.49130 | 25.79421 | 45.98582 |
| 631 | 36.11406 | 28.73333 | 43.49478 | 24.82621 | 47.40190 |
| 638 | 36.33810 | 28.21107 | 44.46513 | 23.90889 | 48.76732 |
| 645 | 36.56215 | 27.71242 | 45.41188 | 23.02765 | 50.09664 |
| 652 | 36.78619 | 27.23094 | 46.34145 | 22.17269 | 51.39969 |
| 659 | 37.01024 | 26.76210 | 47.25837 | 21.33706 | 52.68341 |
| 666 | 37.23428 | 26.30257 | 48.16600 | 20.51567 | 53.95290 |
| 673 | 37.45833 | 25.84982 | 49.06683 | 19.70465 | 55.21200 |
| 680 | 37.68237 | 25.40192 | 49.96283 | 18.90104 | 56.46371 |
HoltWinters_mod1=forecast(modelseriesforecasts,level = c(90,95,99), h=12)%>%timetk::tk_tbl()
#HoltWinters_mod1=HoltWinters_mod1%>%timetk::tk_tbl()
# replace white spaces in column names with _
names(HoltWinters_mod1)<-gsub("\\s", "_", names(HoltWinters_mod1))
HoltWinters_mod1%>%knitr::kable()| index | Point_Forecast | Lo_90 | Hi_90 | Lo_95 | Hi_95 | Lo_99 | Hi_99 |
|---|---|---|---|---|---|---|---|
| 603 | 35.21788 | 30.29153 | 40.14422 | 29.34778 | 41.08798 | 27.50326 | 42.93249 |
| 610 | 35.44192 | 29.19016 | 41.69368 | 27.99249 | 42.89136 | 25.65171 | 45.23214 |
| 617 | 35.66597 | 28.25567 | 43.07626 | 26.83606 | 44.49588 | 24.06150 | 47.27043 |
| 624 | 35.89001 | 27.41735 | 44.36268 | 25.79421 | 45.98582 | 22.62188 | 49.15815 |
| 631 | 36.11406 | 26.64100 | 45.58712 | 24.82621 | 47.40190 | 21.27931 | 50.94880 |
| 638 | 36.33810 | 25.90717 | 46.76903 | 23.90889 | 48.76732 | 20.00334 | 52.67286 |
| 645 | 36.56215 | 25.20364 | 47.92065 | 23.02765 | 50.09664 | 18.77481 | 54.34949 |
| 652 | 36.78619 | 24.52216 | 49.05023 | 22.17269 | 51.39969 | 17.58080 | 55.99159 |
| 659 | 37.01024 | 23.85689 | 50.16358 | 21.33706 | 52.68341 | 16.41219 | 57.60828 |
| 666 | 37.23428 | 23.20358 | 51.26499 | 20.51567 | 53.95290 | 15.26230 | 59.20627 |
| 673 | 37.45833 | 22.55897 | 52.35768 | 19.70465 | 55.21200 | 14.12604 | 60.79061 |
| 680 | 37.68237 | 21.92058 | 53.44416 | 18.90104 | 56.46371 | 12.99951 | 62.36523 |
Future_Date=modelseries%>% tk_index()%>%tk_make_future_timeseries(n_future = 12)
HoltWinters_mod1%>%add_column(Future_Date)pred=cbind.data.frame(Future_Date,HoltWinters_mod1)
pred%>%knitr::kable()| Future_Date | index | Point_Forecast | Lo_90 | Hi_90 | Lo_95 | Hi_95 | Lo_99 | Hi_99 |
|---|---|---|---|---|---|---|---|---|
| 2017-09-25 | 603 | 35.21788 | 30.29153 | 40.14422 | 29.34778 | 41.08798 | 27.50326 | 42.93249 |
| 2017-10-02 | 610 | 35.44192 | 29.19016 | 41.69368 | 27.99249 | 42.89136 | 25.65171 | 45.23214 |
| 2017-10-09 | 617 | 35.66597 | 28.25567 | 43.07626 | 26.83606 | 44.49588 | 24.06150 | 47.27043 |
| 2017-10-16 | 624 | 35.89001 | 27.41735 | 44.36268 | 25.79421 | 45.98582 | 22.62188 | 49.15815 |
| 2017-10-23 | 631 | 36.11406 | 26.64100 | 45.58712 | 24.82621 | 47.40190 | 21.27931 | 50.94880 |
| 2017-10-30 | 638 | 36.33810 | 25.90717 | 46.76903 | 23.90889 | 48.76732 | 20.00334 | 52.67286 |
| 2017-11-06 | 645 | 36.56215 | 25.20364 | 47.92065 | 23.02765 | 50.09664 | 18.77481 | 54.34949 |
| 2017-11-13 | 652 | 36.78619 | 24.52216 | 49.05023 | 22.17269 | 51.39969 | 17.58080 | 55.99159 |
| 2017-11-20 | 659 | 37.01024 | 23.85689 | 50.16358 | 21.33706 | 52.68341 | 16.41219 | 57.60828 |
| 2017-11-27 | 666 | 37.23428 | 23.20358 | 51.26499 | 20.51567 | 53.95290 | 15.26230 | 59.20627 |
| 2017-12-04 | 673 | 37.45833 | 22.55897 | 52.35768 | 19.70465 | 55.21200 | 14.12604 | 60.79061 |
| 2017-12-11 | 680 | 37.68237 | 21.92058 | 53.44416 | 18.90104 | 56.46371 | 12.99951 | 62.36523 |
write_excel_csv(pred,"/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/time series/Manpower/pred.xlsx")
readr::write_csv(pred,path="/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/time series/Manpower/pred.csv")
#write.csv(modeldat,path=)modelseriesforecasts2$residuals%>%autoplot(.,ylab="Residuals")
forecast::ggtsdisplay(residuals(modelseriesforecast), lag.max=40, main='HoltWinters Exponenetial smoothing Residuals')
forecast::checkresiduals(modelseriesforecast) #plots histogram and density of residuals
autocorrelation plot
If the predictive model cannot be improved upon, there should be no correlations between forecast errors for successive predictions. In other words, if there are correlations between forecast errors for successive predictions, it is likely that the simple exponential smoothing forecasts could be improved upon by another forecasting technique. The autocorrelations die down to zero indicating the model cannot be improved upon. The plot shows that the in-sample forecast errors seem to have roughly constant variance over time, although
acf(na.omit(modelseriesforecasts2$residuals), lag.max=20)
ggAcf(na.omit(modelseriesforecasts2$residuals), lag.max=20)
ggAcf(x=modelseriesforecasts2$residuals, lag.max = 20, type = "correlation",
plot = TRUE, na.action = na.contiguous, demean = TRUE)+labs(title="Autocorrelation Plot of Residuals")
#na.omit(modelseriesforecasts)%>%autoplot.forecast()
qplot(na.omit(modelseriesforecasts2$residuals),geom = "histogram",bins = 20,xlab = "residuals") # make a histogram
qplot(na.omit(modelseriesforecasts2$residuals),geom = "density",bins = 20,xlab = "residuals")
# get index from md tk_get_timeseries_signature()
mdk=modeldat%>% tk_index()
mdk%>%head()## [1] "2016-01-11" "2016-01-18" "2016-01-25" "2016-02-01" "2016-02-08"
## [6] "2016-02-15"idx_future<-mdk %>%
tk_make_future_timeseries(n_future = 12)
idx_future%>%tk_tbl()%>%knitr::kable()## Warning in tk_tbl.data.frame(as.data.frame(data), preserve_index,
## rename_index, : Warning: No index to preserve. Object otherwise converted
## to tibble successfully.| data |
|---|
| 2017-09-25 |
| 2017-10-02 |
| 2017-10-09 |
| 2017-10-16 |
| 2017-10-23 |
| 2017-10-30 |
| 2017-11-06 |
| 2017-11-13 |
| 2017-11-20 |
| 2017-11-27 |
| 2017-12-04 |
| 2017-12-11 |
#idx_future
pred_dat=cbind.data.frame(idx_future,HoltWinters_mod)%>%dplyr::rename(Date=idx_future)
pred_dat%>%knitr::kable()| Date | index | Point_Forecast | Lo_80 | Hi_80 | Lo_95 | Hi_95 |
|---|---|---|---|---|---|---|
| 2017-09-25 | 603 | 35.21788 | 31.37963 | 39.05613 | 29.34778 | 41.08798 |
| 2017-10-02 | 610 | 35.44192 | 30.57100 | 40.31284 | 27.99249 | 42.89136 |
| 2017-10-09 | 617 | 35.66597 | 29.89240 | 41.43953 | 26.83606 | 44.49588 |
| 2017-10-16 | 624 | 35.89001 | 29.28872 | 42.49130 | 25.79421 | 45.98582 |
| 2017-10-23 | 631 | 36.11406 | 28.73333 | 43.49478 | 24.82621 | 47.40190 |
| 2017-10-30 | 638 | 36.33810 | 28.21107 | 44.46513 | 23.90889 | 48.76732 |
| 2017-11-06 | 645 | 36.56215 | 27.71242 | 45.41188 | 23.02765 | 50.09664 |
| 2017-11-13 | 652 | 36.78619 | 27.23094 | 46.34145 | 22.17269 | 51.39969 |
| 2017-11-20 | 659 | 37.01024 | 26.76210 | 47.25837 | 21.33706 | 52.68341 |
| 2017-11-27 | 666 | 37.23428 | 26.30257 | 48.16600 | 20.51567 | 53.95290 |
| 2017-12-04 | 673 | 37.45833 | 25.84982 | 49.06683 | 19.70465 | 55.21200 |
| 2017-12-11 | 680 | 37.68237 | 25.40192 | 49.96283 | 18.90104 | 56.46371 |
mdt=test%>%tk_zoo()%>%timetk::tk_tbl()
mdt%>%knitr::kable()| index | Actual |
|---|---|
| 2017-03-27 | 29 |
| 2017-04-03 | 30 |
| 2017-04-10 | 32 |
| 2017-04-17 | 36 |
| 2017-04-24 | 32 |
| 2017-05-01 | 27 |
| 2017-05-08 | 32 |
| 2017-05-15 | 28 |
| 2017-05-22 | 28 |
| 2017-05-29 | 30 |
| 2017-06-05 | 34 |
| 2017-06-12 | 32 |
| 2017-06-19 | 28 |
| 2017-06-26 | 34 |
| 2017-07-03 | 32 |
| 2017-07-10 | 35 |
| 2017-07-17 | 32 |
| 2017-07-24 | 30 |
| 2017-07-31 | 33 |
| 2017-08-07 | 33 |
| 2017-08-14 | 32 |
| 2017-08-21 | 30 |
| 2017-08-28 | 27 |
| 2017-09-04 | 32 |
| 2017-09-11 | 32 |
| 2017-09-18 | 36 |
#forecast(modelseriesforecasts, mdt["index"])
pred <- predict(modelseriesforecasts, n.ahead = 12)
pred%>%tk_tbl()%>%knitr::kable()| index | fit |
|---|---|
| 603 | 35.21788 |
| 610 | 35.44192 |
| 617 | 35.66597 |
| 624 | 35.89001 |
| 631 | 36.11406 |
| 638 | 36.33810 |
| 645 | 36.56215 |
| 652 | 36.78619 |
| 659 | 37.01024 |
| 666 | 37.23428 |
| 673 | 37.45833 |
| 680 | 37.68237 |
#as.data.frame.list(mdt["index"],modelseriesforecasts)# pred_future <- predict(modelseriesforecasts, newdata = mdt["index"])
# pred_futureSimple Moving Average
library(smooth)
#summary(sma(modelseries, h=12))
#sma(modelseries, h=12)%>%plot()
library("TTR")
modelseries12 <- SMA(modelseries,n=12)
plot.ts(modelseries12 )
auto.ssarima State-Space ARIMA
Function selects the best State-Space ARIMA based on information criteria, using fancy branch and bound mechanism. The resulting model can be not optimal in IC meaning, but it is usually reasonable.
Model <- auto.ssarima(modelseries,orders=list(ar=c(1,0),i=c(0,0),ma=c(0,0)),lags=c(1,12),
h=12,holdout=TRUE,intervals="np")
#Model=auto.ces(modelseries,h=12,holdout=FALSE)
Model%>%summary()## Time elapsed: 1.45 seconds
## Model estimated: ARIMA(1,0,0) with constant
## Matrix of AR terms:
## Lag 1
## AR(1) 0.77
## Constant value is: 6.775
## Initial values were produced using backcasting.
## 3 parameters were estimated in the process
## Residuals standard deviation: 2.906
## Cost function type: MSE; Cost function value: 8.101
##
## Information criteria:
## AIC AICc BIC
## 370.8139 371.1568 377.7261
## 95% parametric prediction intervals were constructed
## 100% of values are in the prediction interval
## Forecast errors:
## MPE: 3.8%; Bias: 62.9%; MAPE: 6.6%; SMAPE: 6.8%
## MASE: 0.894; sMAE: 7.4%; RelMAE: 0.862; sMSE: 0.8%forecast(Model)%>%tk_tbl()%>%knitr::kable()| index | Point Forecast | Lo 0.95 | Hi 0.95 |
|---|---|---|---|
| 17434 | 34.48997 | 28.86595 | 40.11398 |
| 17441 | 33.32743 | 26.22979 | 40.42508 |
| 17448 | 32.43243 | 24.59100 | 40.27386 |
| 17455 | 31.74339 | 23.49271 | 39.99407 |
| 17462 | 31.21292 | 22.72898 | 39.69685 |
| 17469 | 30.80452 | 22.18531 | 39.42373 |
| 17476 | 30.49011 | 21.79171 | 39.18850 |
| 17483 | 30.24805 | 21.50306 | 38.99304 |
| 17490 | 30.06170 | 21.28921 | 38.83418 |
| 17497 | 29.91823 | 21.12948 | 38.70697 |
#forecast(Model)%>%plot()Model <- auto.ssarima(modelseries,orders=list(ar=c(1,0),i=c(0,0),ma=c(0,0)),lags=c(1,12),
h=12,holdout=TRUE,intervals="np")
#Model=auto.ces(modelseries,h=12,holdout=FALSE)
summary(Model)## Time elapsed: 0.06 seconds
## Model estimated: ARIMA(1,0,0) with constant
## Matrix of AR terms:
## Lag 1
## AR(1) 0.77
## Constant value is: 6.775
## Initial values were produced using backcasting.
## 3 parameters were estimated in the process
## Residuals standard deviation: 2.906
## Cost function type: MSE; Cost function value: 8.101
##
## Information criteria:
## AIC AICc BIC
## 370.8139 371.1568 377.7261
## 95% parametric prediction intervals were constructed
## 100% of values are in the prediction interval
## Forecast errors:
## MPE: 3.8%; Bias: 62.9%; MAPE: 6.6%; SMAPE: 6.8%
## MASE: 0.894; sMAE: 7.4%; RelMAE: 0.862; sMSE: 0.8%forecast(Model)%>%tk_tbl()%>%knitr::kable()| index | Point Forecast | Lo 0.95 | Hi 0.95 |
|---|---|---|---|
| 17434 | 34.48997 | 28.86595 | 40.11398 |
| 17441 | 33.32743 | 26.22979 | 40.42508 |
| 17448 | 32.43243 | 24.59100 | 40.27386 |
| 17455 | 31.74339 | 23.49271 | 39.99407 |
| 17462 | 31.21292 | 22.72898 | 39.69685 |
| 17469 | 30.80452 | 22.18531 | 39.42373 |
| 17476 | 30.49011 | 21.79171 | 39.18850 |
| 17483 | 30.24805 | 21.50306 | 38.99304 |
| 17490 | 30.06170 | 21.28921 | 38.83418 |
| 17497 | 29.91823 | 21.12948 | 38.70697 |
es Exponential Smoothing in SSOE state-space model
es 15 Description Function constructs ETS model and returns forecast, fitted values, errors and matrix of states.
$y_{t} = ot(w(vt−l) + xtat−1 + r(vt−l)εt) vt = f(vt−l) + g(vt−l)εt at =FXat−1 +gXεt/xt $
Hide
#See how holdout and trace parameters influence the forecast
Model <- es(modelseries,model="AAdN",h=12,holdout=FALSE,cfType="MSE")## Warning in if (class(data) == "smooth.sim") {: the condition has length > 1
## and only the first element will be used## Warning in if (class(data) == "smooth") {: the condition has length > 1 and
## only the first element will be used#Model=auto.ces(modelseries,h=12,holdout=FALSE)
summary(Model)## Time elapsed: 0.08 seconds
## Model estimated: ETS(AAdN)
## Persistence vector g:
## alpha beta
## 0.717 0.000
## Damping parameter: 1
## Initial values were optimised.
## 5 parameters were estimated in the process
## Residuals standard deviation: 2.982
## Cost function type: MSE; Cost function value: 8.274
##
## Information criteria:
## AIC AICc BIC
## 437.7866 438.8499 452.5127forecast(Model)%>%tk_tbl()## Warning in if (class(data) == "smooth.sim") {: the condition has length > 1
## and only the first element will be used
## Warning in if (class(data) == "smooth.sim") {: the condition has length > 1
## and only the first element will be usedplot(Model)
#plot(forecast(Model))# Something simple:
Model=ges(modelseries,orders=c(1),lags=c(1),h=18,holdout=TRUE,bounds="a",intervals="p")
summary(Model)## Time elapsed: 0.15 seconds
## Model estimated: GES(1[1])
## Persistence vector g:
## [,1]
## [1,] 0.316
## Transition matrix F:
## [,1]
## [1,] 0.998
## Measurement vector w: 2.408
## Initial values were optimised.
## 5 parameters were estimated in the process
## Residuals standard deviation: 2.998
## Cost function type: MSE; Cost function value: 8.327
##
## Information criteria:
## AIC AICc BIC
## 347.1012 348.0689 358.1987
## 95% parametric prediction intervals were constructed
## 100% of values are in the prediction interval
## Forecast errors:
## MPE: 10.2%; Bias: 89.3%; MAPE: 11.1%; SMAPE: 11.9%
## MASE: 1.54; sMAE: 12.5%; RelMAE: 0.961; sMSE: 2.1%forecast(Model)%>%tk_tbl()plot(Model)
ets {forecast} R Documentation
Exponential smoothing state space model
Description
Returns ets model applied to y.
Usage
ets(y, model = “ZZZ”, damped = NULL, alpha = NULL, beta = NULL, gamma = NULL, phi = NULL, additive.only = FALSE, lambda = NULL, biasadj = FALSE, lower = c(rep(1e-04, 3), 0.8), upper = c(rep(0.9999, 3), 0.98), opt.crit = c(“lik”, “amse”, “mse”, “sigma”, “mae”), nmse = 3, bounds = c(“both”, “usual”, “admissible”), ic = c(“aicc”, “aic”, “bic”), restrict = TRUE, allow.multiplicative.trend = FALSE, use.initial.values = FALSE, …) Arguments
y
a numeric vector or time series of class ts model
Usually a three-character string identifying method using the framework terminology of Hyndman et al. (2002) and Hyndman et al. (2008). The first letter denotes the error type (“A”, “M” or “Z”); the second letter denotes the trend type (“N”,“A”,“M” or “Z”); and the third letter denotes the season type (“N”,“A”,“M” or “Z”). In all cases, “N”=none, “A”=additive, “M”=multiplicative and “Z”=automatically selected. So, for example, “ANN” is simple exponential smoothing with additive errors, “MAM” is multiplicative Holt-Winters’ method with multiplicative errors, and so on. It is also possible for the model to be of class “ets”, and equal to the output from a previous call to ets. In this case, the same model is fitted to y without re-estimating any smoothing parameters. See also the use.initial.values argument. damped
If TRUE, use a damped trend (either additive or multiplicative). If NULL, both damped and non-damped trends will be tried and the best model (according to the information criterion ic) returned. alpha
Value of alpha. If NULL, it is estimated. beta
Value of beta. If NULL, it is estimated. gamma
Value of gamma. If NULL, it is estimated. phi Value of phi. If NULL, it is estimated. additive.only
If TRUE, will only consider additive models. Default is FALSE. lambda
Box-Cox transformation parameter. Ignored if NULL. Otherwise, data transformed before model is estimated. When lambda is specified, additive.only is set to TRUE. biasadj Use adjusted back-transformed mean for Box-Cox transformations. If TRUE, point forecasts and fitted values are mean forecast. Otherwise, these points can be considered the median of the forecast densities. lower
Lower bounds for the parameters (alpha, beta, gamma, phi) upper
Upper bounds for the parameters (alpha, beta, gamma, phi) opt.crit
Optimization criterion. One of “mse” (Mean Square Error), “amse” (Average MSE over first nmse forecast horizons), “sigma” (Standard deviation of residuals), “mae” (Mean of absolute residuals), or “lik” (Log-likelihood, the default). nmse
Number of steps for average multistep MSE (1<=nmse<=30). bounds
Type of parameter space to impose: “usual” indicates all parameters must lie between specified lower and upper bounds; “admissible” indicates parameters must lie in the admissible space; “both” (default) takes the intersection of these regions. ic
Information criterion to be used in model selection. restrict
If TRUE (default), the models with infinite variance will not be allowed. allow.multiplicative.trend
If TRUE, models with multiplicative trend are allowed when searching for a model. Otherwise, the model space excludes them. This argument is ignored if a multiplicative trend model is explicitly requested (e.g., using model=“MMN”). use.initial.values
If TRUE and model is of class “ets”, then the initial values in the model are also not re-estimated. … Other undocumented arguments. Details
Based on the classification of methods as described in Hyndman et al (2008).
The methodology is fully automatic. The only required argument for ets is the time series. The model is chosen automatically if not specified. This methodology performed extremely well on the M3-competition data. (See Hyndman, et al, 2002, below.)
Value
An object of class “ets”.
The generic accessor functions fitted.values and residuals extract useful features of the value returned by ets and associated functions.
fit <- ets(modelseries)
autoplot(forecast(fit))+labs(y="Number of Durability \n Vehicles")
fit## ETS(A,N,N)
##
## Call:
## ets(y = modelseries)
##
## Smoothing parameters:
## alpha = 0.7186
##
## Initial states:
## l = 26.2569
##
## sigma: 2.8799
##
## AIC AICc BIC
## 571.0050 571.2976 578.3680autoplot(fit)
fit$fitted%>%timetk::tk_tbl()%>%head()fit$residuals%>%autoplot()+labs(y="Residuals")
fit1=fit$fitted%>%timetk::tk_tbl()%>%head()
fit1=fit$fitted%>%timetk::tk_tbl()
fit2=modeldat%>%select(Date)
etsdat=cbind.data.frame(fit2,fit1)%>%rename(Predicted=value)
etsdat%>%head()%>%knitr::kable()| Date | index | Predicted |
|---|---|---|
| 2016-01-11 | 1 | 26.25688 |
| 2016-01-18 | 8 | 26.07229 |
| 2016-01-25 | 15 | 26.73894 |
| 2016-02-01 | 22 | 27.64513 |
| 2016-02-08 | 29 | 23.58858 |
| 2016-02-15 | 36 | 26.04000 |
modeldat%>%ggplot(aes(x=Date,y=Actual))+geom_line(aes(color="Observed"),show.legend=TRUE, size=1.5, linetype=1)+geom_line(aes(x=Date,y=Predicted,color="Predicted"),data=etsdat, show.legend=TRUE, size=1.5, linetype=1)+
labs(title = "Predicted Values vs Observed values", x = "Time",y="Number of \n Durability Vehicles")+
theme_bw() +
# define a custom background theme
#theme(panel.background = element_rect(fill = 'grey75')) +
scale_colour_manual(name='Exponential smoothing state \n space model Method',values=c("Predicted"="red","Observed"='black'))+
#Make title bold and add a little space at the baseline (face, vjust)
theme(plot.title = element_text(size=14, face="bold", vjust=2))+
#change the position of the legend
theme(legend.position="top") +
# Change the color of the title of the legend (name)
theme(legend.title = element_text(colour="chocolate", size=14, face="bold"))+
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 month"),
labels=date_format("%b %d %y")))
Naive and Random Walk Forecasts
rwf() returns forecasts and prediction intervals for a random walk with drift model applied to y. This is equivalent to an ARIMA(0,1,0) model with an optional drift coefficient. naive() is simply a wrapper to rwf() for simplicity. snaive() returns forecasts and prediction intervals from an ARIMA(0,0,0)(0,1,0)m model where m is the seasonal period.
Usage
rwf(y, h = 10, drift = FALSE, level = c(80, 95), fan = FALSE, lambda = NULL, biasadj = FALSE, x = y)
naive(y, h = 10, level = c(80, 95), fan = FALSE, lambda = NULL, biasadj = FALSE, x = y)
snaive(y, h = 2 * frequency(x), level = c(80, 95), fan = FALSE, lambda = NULL, biasadj = FALSE, x = y) Arguments
y
a numeric vector or time series of class ts h
Number of periods for forecasting drift
Logical flag. If TRUE, fits a random walk with drift model. level
Confidence levels for prediction intervals. fan If TRUE, level is set to seq(51,99,by=3). This is suitable for fan plots. lambda
Box-Cox transformation parameter. Ignored if NULL. Otherwise, forecasts back-transformed via an inverse Box-Cox transformation. biasadj Use adjusted back-transformed mean for Box-Cox transformations. If TRUE, point forecasts and fitted values are mean forecast. Otherwise, these points can be considered the median of the forecast densities. x
Deprecated. Included for backwards compatibility. Details
The random walk with drift model is
\(Y_{t}=c + Y_{t-1} + Z_{t}\)
where Z_{t} is a normal iid error. Forecasts are given by
\(Y_{n+h}=ch+Y_{n}\)
. If there is no drift (as in naive), the drift parameter c=0. Forecast standard errors allow for uncertainty in estimating the drift parameter.
The seasonal naive model is
\(Y_{t}=Y_{t-m} + Z_{t}\)
where \(Z_{t}\) is a normal iid error.
Value
An object of class “forecast”.
The function summary is used to obtain and print a summary of the results, while the function plot produces a plot of the forecasts and prediction intervals.
The generic accessor functions fitted.values and residuals extract useful features of the value returned by naive or snaive.
An object of class “forecast” is a list containing at least the following elements:
model
A list containing information about the fitted model method
The name of the forecasting method as a character string mean
Point forecasts as a time series lower
Lower limits for prediction intervals upper
Upper limits for prediction intervals level
The confidence values associated with the prediction intervals x
The original time series (either object itself or the time series used to create the model stored as object). residuals
Residuals from the fitted model. That is x minus fitted values. fitted
Fitted values (one-step forecasts)
#rwf(modelseries)
rwf1=rwf(modeldat[,2],h=12)
rwf1%>%timetk::tk_tbl()%>%knitr::kable()| index | Point Forecast | Lo 80 | Hi 80 | Lo 95 | Hi 95 |
|---|---|---|---|---|---|
| 87 | 36 | 32.15283 | 39.84717 | 30.11627 | 41.88373 |
| 88 | 36 | 30.55928 | 41.44072 | 27.67914 | 44.32086 |
| 89 | 36 | 29.33651 | 42.66349 | 25.80907 | 46.19093 |
| 90 | 36 | 28.30567 | 43.69433 | 24.23253 | 47.76747 |
| 91 | 36 | 27.39747 | 44.60253 | 22.84357 | 49.15643 |
| 92 | 36 | 26.57640 | 45.42360 | 21.58785 | 50.41215 |
| 93 | 36 | 25.82135 | 46.17865 | 20.43310 | 51.56690 |
| 94 | 36 | 25.11857 | 46.88143 | 19.35829 | 52.64171 |
| 95 | 36 | 24.45850 | 47.54150 | 18.34880 | 53.65120 |
| 96 | 36 | 23.83419 | 48.16581 | 17.39400 | 54.60600 |
| 97 | 36 | 23.24039 | 48.75961 | 16.48586 | 55.51414 |
| 98 | 36 | 22.67302 | 49.32698 | 15.61815 | 56.38185 |
autoplot(rwf1)+labs(y="Number of Durability \n Vehicles")
autoplot(naive(modeldat[,2],h=12),include=200)+labs(y="Number of Durability \n Vehicles")
autoplot(snaive(modeldat[,2]))+labs(y="Number of Durability \n Vehicles")
#install.packages("fpp")
#library(fpp)
#fit <- ses(oil, h=3)
#plot(fit)
#summary(fit)fit<-auto.arima(WWWusage)
checkresiduals(fit)
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,1,1)
## Q* = 7.8338, df = 8, p-value = 0.4499
##
## Model df: 2. Total lags used: 10fit<-ets(woolyrnq)
res<-cbind(Residuals=residuals(fit),Response.residuals=residuals(fit,type="response"))
autoplot(res,facets=TRUE)
gghistogram(lynx)
ggseasonplot(USAccDeaths,polar = TRUE)+theme_bw()
fc<-WWWusage%>%ets%>%forecast(h=20)
autoplot(WWWusage,series="Data")+autolayer(WWWusage,series="Data", size=1.5, linetype=1)+autolayer(fc,series="Forecast", size=1.5, linetype=1)+
autolayer(fitted(fc),series="Fitted", size=1.5, linetype=1)
idx=modeldat%>%tk_index()%>%tk_get_timeseries_signature()
idx# Augmenting a data frame
md=modeldat%>%mutate(YQ = as.yearqtr(Date))
md=tk_augment_timeseries_signature(md)
md# Convert tibble to ts object with tk_ts()
md1=md%>%select(Date,Actual)
md_ts <- tk_ts(md1, silent = TRUE)
# get index from md tk_get_timeseries_signature()
md2=md%>% tk_index()
md2## [1] "2016-01-11" "2016-01-18" "2016-01-25" "2016-02-01" "2016-02-08"
## [6] "2016-02-15" "2016-02-22" "2016-02-29" "2016-03-07" "2016-03-14"
## [11] "2016-03-21" "2016-03-28" "2016-04-04" "2016-04-11" "2016-04-18"
## [16] "2016-04-25" "2016-05-02" "2016-05-09" "2016-05-16" "2016-05-23"
## [21] "2016-05-30" "2016-06-06" "2016-06-13" "2016-06-20" "2016-06-27"
## [26] "2016-07-04" "2016-07-11" "2016-07-18" "2016-07-25" "2016-08-01"
## [31] "2016-08-08" "2016-08-15" "2016-08-22" "2016-08-29" "2016-09-05"
## [36] "2016-09-12" "2016-09-19" "2016-09-26" "2016-10-03" "2016-10-10"
## [41] "2016-10-17" "2016-10-24" "2016-10-31" "2016-11-07" "2016-11-14"
## [46] "2016-11-28" "2016-12-05" "2016-12-12" "2017-01-02" "2017-01-09"
## [51] "2017-01-16" "2017-01-23" "2017-01-30" "2017-02-06" "2017-02-13"
## [56] "2017-02-20" "2017-02-27" "2017-03-06" "2017-03-13" "2017-03-20"
## [61] "2017-03-27" "2017-04-03" "2017-04-10" "2017-04-17" "2017-04-24"
## [66] "2017-05-01" "2017-05-08" "2017-05-15" "2017-05-22" "2017-05-29"
## [71] "2017-06-05" "2017-06-12" "2017-06-19" "2017-06-26" "2017-07-03"
## [76] "2017-07-10" "2017-07-17" "2017-07-24" "2017-07-31" "2017-08-07"
## [81] "2017-08-14" "2017-08-21" "2017-08-28" "2017-09-04" "2017-09-11"
## [86] "2017-09-18"idx_future<-md2 %>%
tk_make_future_timeseries(n_future = 12)
idx_future%>%knitr::kable()## Warning in kable_markdown(x = structure(c("2017-09-25", "2017-10-02",
## "2017-10-09", : The table should have a header (column names)| 2017-09-25 |
| 2017-10-02 |
| 2017-10-09 |
| 2017-10-16 |
| 2017-10-23 |
| 2017-10-30 |
| 2017-11-06 |
| 2017-11-13 |
| 2017-11-20 |
| 2017-11-27 |
| 2017-12-04 |
| 2017-12-11 |
HW=HoltWinters(md_ts, gamma=FALSE, l.start=30, b.start=1)
fc=HW%>%forecast(h=12,level=c(90,95))
autoplot(md_ts,series="Data")+autolayer(fc,series="Forecast", size=1.5, linetype=1)+
autolayer(fitted(fc),series="Fitted", size=1.5, linetype=1)+autolayer(md_ts,series="Data", size=1.5, linetype=1)+theme_bw()+
labs(title = "Predicted,Observed ,Forecast values", x = "Time",y="Durability Vehicles")
dfuture=data.frame(Date=idx_future,fc)%>%rename(Actual=Point.Forecast)
rio::export(dfuture, "/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/DurabilityHW.xlsx")
dfutureHWdata=cbind.data.frame(modeldat[,1],sweep::sw_augment(HW)%>%rename())
HWdata%>%knitr::kable()| Date | index | .actual | .fitted | .resid |
|---|---|---|---|---|
| 2016-01-11 | 1 | 26 | NA | NA |
| 2016-01-18 | 2 | 27 | NA | NA |
| 2016-01-25 | 3 | 28 | 31.00000 | -3.0000000 |
| 2016-02-01 | 4 | 22 | 29.58635 | -7.5863533 |
| 2016-02-08 | 5 | 27 | 24.40501 | 2.5949861 |
| 2016-02-15 | 6 | 31 | 27.21845 | 3.7815463 |
| 2016-02-22 | 7 | 26 | 31.05379 | -5.0537902 |
| 2016-02-29 | 8 | 27 | 27.87867 | -0.8786682 |
| 2016-03-07 | 9 | 21 | 27.93166 | -6.9316631 |
| 2016-03-14 | 10 | 23 | 23.09196 | -0.0919564 |
| 2016-03-21 | 11 | 25 | 23.57549 | 1.4245113 |
| 2016-03-28 | 12 | 23 | 25.27671 | -2.2767103 |
| 2016-04-04 | 13 | 23 | 24.03704 | -1.0370355 |
| 2016-04-11 | 14 | 23 | 23.73574 | -0.7357370 |
| 2016-04-18 | 15 | 23 | 23.64997 | -0.6499723 |
| 2016-04-25 | 16 | 27 | 23.61414 | 3.3858577 |
| 2016-05-02 | 17 | 31 | 26.80849 | 4.1915097 |
| 2016-05-09 | 18 | 30 | 30.73877 | -0.7387718 |
| 2016-05-16 | 19 | 33 | 30.81103 | 2.1889730 |
| 2016-05-23 | 20 | 29 | 33.21965 | -4.2196502 |
| 2016-05-30 | 21 | 29 | 30.52895 | -1.5289516 |
| 2016-06-06 | 22 | 32 | 29.89370 | 2.1063039 |
| 2016-06-13 | 23 | 31 | 32.14356 | -1.1435575 |
| 2016-06-20 | 24 | 36 | 31.83333 | 4.1666671 |
| 2016-06-27 | 25 | 37 | 35.76581 | 1.2341925 |
| 2016-07-04 | 26 | 38 | 37.44695 | 0.5530548 |
| 2016-07-11 | 27 | 39 | 38.61206 | 0.3879406 |
| 2016-07-18 | 28 | 40 | 39.65866 | 0.3413360 |
| 2016-07-25 | 29 | 35 | 40.67783 | -5.6778267 |
| 2016-08-01 | 30 | 38 | 36.86312 | 1.1368752 |
| 2016-08-08 | 31 | 32 | 38.38404 | -6.3840384 |
| 2016-08-15 | 32 | 33 | 33.88347 | -0.8834724 |
| 2016-08-22 | 33 | 29 | 33.64293 | -4.6429334 |
| 2016-08-29 | 34 | 29 | 30.35483 | -1.3548284 |
| 2016-09-05 | 35 | 27 | 29.59184 | -2.5918394 |
| 2016-09-12 | 36 | 24 | 27.79850 | -3.7985032 |
| 2016-09-19 | 37 | 23 | 24.96718 | -1.9671775 |
| 2016-09-26 | 38 | 31 | 23.51080 | 7.4891983 |
| 2016-10-03 | 39 | 32 | 29.61156 | 2.3884384 |
| 2016-10-10 | 40 | 33 | 31.80260 | 1.1974009 |
| 2016-10-17 | 41 | 30 | 33.09729 | -3.0972869 |
| 2016-10-24 | 42 | 32 | 30.96772 | 1.0322800 |
| 2016-10-31 | 43 | 33 | 32.08032 | 0.9196770 |
| 2016-11-07 | 44 | 35 | 33.12908 | 1.8709163 |
| 2016-11-14 | 45 | 32 | 34.96700 | -2.9669971 |
| 2016-11-28 | 46 | 30 | 32.96106 | -2.9610589 |
| 2016-12-05 | 47 | 29 | 30.88301 | -1.8830062 |
| 2016-12-12 | 48 | 27 | 29.59556 | -2.5955615 |
| 2017-01-02 | 49 | 27 | 27.68603 | -0.6860317 |
| 2017-01-09 | 50 | 26 | 27.24555 | -1.2455460 |
| 2017-01-16 | 51 | 26 | 26.33712 | -0.3371247 |
| 2017-01-23 | 52 | 25 | 26.12729 | -1.1272935 |
| 2017-01-30 | 53 | 25 | 25.27300 | -0.2729960 |
| 2017-02-06 | 54 | 22 | 25.07681 | -3.0768079 |
| 2017-02-13 | 55 | 25 | 22.61774 | 2.3822588 |
| 2017-02-20 | 56 | 26 | 24.47102 | 1.5289773 |
| 2017-02-27 | 57 | 23 | 25.69954 | -2.6995356 |
| 2017-03-06 | 58 | 25 | 23.56563 | 1.4343723 |
| 2017-03-13 | 59 | 28 | 24.68769 | 3.3123097 |
| 2017-03-20 | 60 | 28 | 27.35782 | 0.6421818 |
| 2017-03-27 | 61 | 29 | 27.96554 | 1.0344613 |
| 2017-04-03 | 62 | 30 | 28.90551 | 1.0944901 |
| 2017-04-10 | 63 | 32 | 29.92059 | 2.0794140 |
| 2017-04-17 | 64 | 36 | 31.75645 | 4.2435539 |
| 2017-04-24 | 65 | 32 | 35.38735 | -3.3873521 |
| 2017-05-01 | 66 | 27 | 32.98880 | -5.9887962 |
| 2017-05-08 | 67 | 32 | 28.40947 | 3.5905345 |
| 2017-05-15 | 68 | 28 | 31.38197 | -3.3819704 |
| 2017-05-22 | 69 | 28 | 28.83781 | -0.8378057 |
| 2017-05-29 | 70 | 30 | 28.25290 | 1.7471005 |
| 2017-06-05 | 71 | 34 | 29.72596 | 4.2740356 |
| 2017-06-12 | 72 | 32 | 33.27735 | -1.2773495 |
| 2017-06-19 | 73 | 28 | 32.47314 | -4.4731388 |
| 2017-06-26 | 74 | 34 | 29.06466 | 4.9353441 |
| 2017-07-03 | 75 | 32 | 33.10983 | -1.1098326 |
| 2017-07-10 | 76 | 35 | 32.41927 | 2.5807276 |
| 2017-07-17 | 77 | 32 | 34.66919 | -2.6691861 |
| 2017-07-24 | 78 | 30 | 32.76217 | -2.7621691 |
| 2017-07-31 | 79 | 33 | 30.71117 | 2.2888312 |
| 2017-08-07 | 80 | 33 | 32.65236 | 0.3476386 |
| 2017-08-14 | 81 | 32 | 33.09109 | -1.0910865 |
| 2017-08-21 | 82 | 30 | 32.38130 | -2.3812962 |
| 2017-08-28 | 83 | 27 | 30.60519 | -3.6051928 |
| 2017-09-04 | 84 | 32 | 27.78269 | 4.2173084 |
| 2017-09-11 | 85 | 32 | 31.16034 | 0.8396563 |
| 2017-09-18 | 86 | 36 | 31.92980 | 4.0701956 |
mycolors=c("red","black","blue")
#mycolors=c("#56ddc5","#ee3db7","#4699dd")
modeldat%>%ggplot(aes(x=as.Date(Date)))+geom_line(aes(y=Actual,color="Actual Data"), size=1.5, linetype=1)+geom_line(aes(x=as.Date(Date),y=.fitted,color="Model Prediction on Data"),data=HWdata, size=1.5, linetype=1)+
labs(title = "Holtwinters Exponential smoothing model ", x = "Time",y=" Durability Vehicles")+
theme_bw() +
# remove legend title
theme(legend.title = element_blank()) +
# define a custom background theme
#theme(panel.background = element_rect(fill = 'grey75')) +
#Make title bold and add a little space at the baseline (face, vjust)
#theme(plot.title = element_text(size=14, face="bold", vjust=2))+
#change the position of the legend
theme(legend.position="top") +
# Change the color of the title of the legend (name)
#theme(legend.title = element_text(color="chocolate", size=14, face="bold"))+
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 month"),
labels=date_format("%b %d %y")))+
geom_vline(xintercept=as.Date("2017-09-18"), linetype=2)+
#geom_point(aes(x =as.Date(Date), y = Actual, colour="Forecast"), data =dfuture, alpha = 0.5, size=1.5, linetype=1)+
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95), fill = "grey", alpha=0.5,data=dfuture)+
geom_smooth(aes(x =as.Date(Date), y = Actual,color="12 Week Forecast"), data =dfuture,
method = 'loess', size=1.5, linetype=1)+
scale_color_manual(values=mycolors)
fc=md_ts%>%ets%>%forecast(h=12,level=c(90,95))
autoplot(md_ts,series="Data")+autolayer(fc,series="Forecast", size=1.5, linetype=1)+
autolayer(fitted(fc),series="Fitted", size=1.5, linetype=1)+
autolayer(md_ts,series="Data", size=1.5, linetype=1)+
theme_bw()+
labs(title = "Predicted,Observed ,Forecast values", x = "Time",y="Durability Vehicles")
dfuture=data.frame(Date=idx_future,fc)%>%rename(Actual=Point.Forecast)
dfuture%>%knitr::kable()| Date | Actual | Lo.90 | Hi.90 | Lo.95 | Hi.95 | |
|---|---|---|---|---|---|---|
| 87 | 2017-09-25 | 34.7857 | 30.04876 | 39.52263 | 29.14129 | 40.43010 |
| 88 | 2017-10-02 | 34.7857 | 28.95258 | 40.61881 | 27.83511 | 41.73628 |
| 89 | 2017-10-09 | 34.7857 | 28.03203 | 41.53936 | 26.73821 | 42.83318 |
| 90 | 2017-10-16 | 34.7857 | 27.22272 | 42.34868 | 25.77385 | 43.79754 |
| 91 | 2017-10-23 | 34.7857 | 26.49200 | 43.07939 | 24.90315 | 44.66824 |
| 92 | 2017-10-30 | 34.7857 | 25.82065 | 43.75075 | 24.10318 | 45.46821 |
| 93 | 2017-11-06 | 34.7857 | 25.19618 | 44.37521 | 23.35908 | 46.21231 |
| 94 | 2017-11-13 | 34.7857 | 24.60996 | 44.96143 | 22.66056 | 46.91083 |
| 95 | 2017-11-20 | 34.7857 | 24.05573 | 45.51566 | 22.00015 | 47.57124 |
| 96 | 2017-11-27 | 34.7857 | 23.52875 | 46.04265 | 21.37221 | 48.19918 |
| 97 | 2017-12-04 | 34.7857 | 23.02535 | 46.54604 | 20.77238 | 48.79901 |
| 98 | 2017-12-11 | 34.7857 | 22.54264 | 47.02875 | 20.19720 | 49.37419 |
rio::export(dfuture, "/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/Durabilityets.xlsx")modeldat%>%ggplot(aes(x=Date,y=Actual))+geom_line(aes(color="Observed"),show.legend=TRUE, size=1.5, linetype=1)+geom_line(aes(x=Date,y=Predicted,color="Predicted"),data=etsdat, show.legend=TRUE, size=1.5, linetype=1)+
labs(title = "Exponential smoothing state \n space model ", x = "Time",y=" Durability Vehicles")+
theme_bw() +
# define a custom background theme
#theme(panel.background = element_rect(fill = 'grey75')) +
#scale_colour_manual(name='Exponential smoothing state \n space model Method',values=c("Predicted"="red","Observed"='black'))+
#Make title bold and add a little space at the baseline (face, vjust)
#theme(plot.title = element_text(size=14, face="bold", vjust=2))+
#change the position of the legend
theme(legend.position="top") +
# remove legend title
theme(legend.title = element_blank()) +
# Change the color of the title of the legend (name)
theme(legend.title = element_text(colour="chocolate", size=14, face="bold"))+
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 month"),
labels=date_format("%b %d %y")))+
geom_vline(xintercept=82, linetype=2)+
geom_vline(xintercept=as.Date("2017-09-18"), linetype=2)+
geom_line(aes(x =as.Date(Date), y = Actual, colour="Forecast"), data =dfuture, alpha = 0.5, size=1.5, linetype=1)+
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95), fill = "#D5DBFF", alpha=0.5,data=dfuture)+
geom_ribbon(aes(ymin=Lo.90, ymax=Hi.90), fill = "#596DD5", alpha=0.5,data=dfuture)
modeldat%>%ggplot(aes(x=Date))+geom_line(aes(y=Actual,color="Actual Data"),show.legend=TRUE)+geom_line(aes(x=Date,y=Predicted,color="Model Prediction on Data"),data=etsdat, show.legend=TRUE)+
labs(title = "Exponential smoothing state \n space model ", x = "Time",y="Number of \n Durability Vehicles")+
theme_bw() +
# define a custom background theme
#theme(panel.background = element_rect(fill = 'grey75')) +
#Make title bold and add a little space at the baseline (face, vjust)
theme(plot.title = element_text(size=14, face="bold", vjust=2))+
#change the position of the legend
theme(legend.position="top") +
# Change the color of the title of the legend (name)
theme(legend.title = element_text(color="chocolate", size=14, face="bold"))+
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 month"),
labels=date_format("%b %d %y")))+
geom_vline(xintercept=as.Date("2017-09-18"), linetype=2)+
#geom_point(aes(x =as.Date(Date), y = Actual, colour="Forecast"), data =dfuture, alpha = 0.5, size=1.5, linetype=1)+
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95), fill = "grey", alpha=0.5,data=dfuture)+
geom_smooth(aes(x =as.Date(Date), y = Actual,color="12 Week Forecast"), data =dfuture,
method = 'loess')
Manually change Colors
mycolors=c("red","black","blue")
#mycolors=c("#56ddc5","#ee3db7","#4699dd")
modeldat%>%ggplot(aes(x=Date))+geom_line(aes(y=Actual,color="Actual Data"), size=1.5, linetype=1)+geom_line(aes(x=Date,y=Predicted,color="Model Prediction on Data"),data=etsdat, size=1.5, linetype=1)+
labs(title = "Exponential smoothing state \n space model ", x = "Time",y="Number of \n Durability Vehicles")+
theme_bw() +
# remove legend title
theme(legend.title = element_blank()) +
# define a custom background theme
#theme(panel.background = element_rect(fill = 'grey75')) +
#Make title bold and add a little space at the baseline (face, vjust)
#theme(plot.title = element_text(size=14, face="bold", vjust=2))+
#change the position of the legend
theme(legend.position="top") +
# Change the color of the title of the legend (name)
#theme(legend.title = element_text(color="chocolate", size=14, face="bold"))+
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 month"),
labels=date_format("%b %d %y")))+
geom_vline(xintercept=as.Date("2017-09-18"), linetype=2)+
#geom_point(aes(x =as.Date(Date), y = Actual, colour="Forecast"), data =dfuture, alpha = 0.5, size=1.5, linetype=1)+
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95), fill = "grey", alpha=0.5,data=dfuture)+
geom_smooth(aes(x =as.Date(Date), y = Actual,color="12 Week Forecast"), data =dfuture,
method = 'loess', size=1.5, linetype=1)+
scale_color_manual(values=mycolors)
mycolors=c("black","blue","chocolate")
library(scales)
#mycolors=c("#832424FF","#3A3A98FF","#8B8B0080")
modeldat%>%ggplot(aes(x=Date))+geom_line(aes(y=Actual,color="Actual Data"), size=1.5, linetype=1)+geom_line(aes(x=Date,y=Predicted,color="Model Prediction on Data"),data=etsdat, size=1.5, linetype=1)+
labs(title = "Exponential smoothing state \n space model ", x = "Time",y=" Durability Vehicles")+
theme_bw() +
# remove legend title
theme(legend.title = element_blank()) +
# define a custom background theme
#theme(panel.background = element_rect(fill = 'grey75')) +
#Make title bold and add a little space at the baseline (face, vjust)
#theme(plot.title = element_text(size=14, face="bold", vjust=2))+
#change the position of the legend
theme(legend.position="top") +
# Change the color of the title of the legend (name)
#theme(legend.title = element_text(color="chocolate", size=14, face="bold"))+
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 month"),
labels=date_format("%b %d %y")))+
geom_vline(xintercept=as.Date("2017-09-18"), linetype=2)+
#geom_point(aes(x =as.Date(Date), y = Actual, colour="Forecast"), data =dfuture, alpha = 0.5, size=1.5, linetype=1)+
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95), fill = "grey", alpha=0.5,data=dfuture)+
geom_smooth(aes(x =as.Date(Date), y = Actual,color="12 Week Forecast"), data =dfuture,
method = 'loess', size=1.5, linetype=1)+
scale_color_manual(values=mycolors)
Durad<- rio::import("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actvsfcdatajuly311.xlsx",sheet="Sheet3")
tail(Durad)%>%knitr::kable()| Week | Actual | |
|---|---|---|
| 125 | 2018-05-21 | 20 |
| 126 | 2018-05-28 | 21 |
| 127 | 2018-06-04 | 24 |
| 128 | 2018-06-11 | 25 |
| 129 | 2018-06-18 | 25 |
| 130 | 2018-06-25 | 25 |
idx=Durad%>%tk_index()%>%tk_get_timeseries_signature()
idx%>%knitr::kable()| index | index.num | diff | year | half | quarter | month | month.xts | month.lbl | day | hour | minute | second | hour12 | am.pm | wday | wday.xts | wday.lbl | mday | qday | yday | mweek | week | week.iso | week2 | week3 | week4 | mday7 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2016-01-04 | 1451865600 | NA | 2016 | 1 | 1 | 1 | 0 | January | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 4 | 4 | 2 | 1 | 1 | 1 | 1 | 1 | 1 |
| 2016-01-11 | 1452470400 | 604800 | 2016 | 1 | 1 | 1 | 0 | January | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 11 | 11 | 3 | 2 | 2 | 0 | 2 | 2 | 2 |
| 2016-01-18 | 1453075200 | 604800 | 2016 | 1 | 1 | 1 | 0 | January | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 18 | 18 | 4 | 3 | 3 | 1 | 0 | 3 | 3 |
| 2016-01-25 | 1453680000 | 604800 | 2016 | 1 | 1 | 1 | 0 | January | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 25 | 25 | 5 | 4 | 4 | 0 | 1 | 0 | 4 |
| 2016-02-01 | 1454284800 | 604800 | 2016 | 1 | 1 | 2 | 1 | February | 1 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 1 | 32 | 32 | 6 | 5 | 5 | 1 | 2 | 1 | 1 |
| 2016-02-08 | 1454889600 | 604800 | 2016 | 1 | 1 | 2 | 1 | February | 8 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 8 | 39 | 39 | 2 | 6 | 6 | 0 | 0 | 2 | 2 |
| 2016-02-15 | 1455494400 | 604800 | 2016 | 1 | 1 | 2 | 1 | February | 15 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 15 | 46 | 46 | 3 | 7 | 7 | 1 | 1 | 3 | 3 |
| 2016-02-22 | 1456099200 | 604800 | 2016 | 1 | 1 | 2 | 1 | February | 22 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 22 | 53 | 53 | 4 | 8 | 8 | 0 | 2 | 0 | 4 |
| 2016-02-29 | 1456704000 | 604800 | 2016 | 1 | 1 | 2 | 1 | February | 29 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 29 | 60 | 60 | 5 | 9 | 9 | 1 | 0 | 1 | 5 |
| 2016-03-07 | 1457308800 | 604800 | 2016 | 1 | 1 | 3 | 2 | March | 7 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 7 | 67 | 67 | 2 | 10 | 10 | 0 | 1 | 2 | 2 |
| 2016-03-14 | 1457913600 | 604800 | 2016 | 1 | 1 | 3 | 2 | March | 14 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 14 | 74 | 74 | 3 | 11 | 11 | 1 | 2 | 3 | 3 |
| 2016-03-21 | 1458518400 | 604800 | 2016 | 1 | 1 | 3 | 2 | March | 21 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 21 | 81 | 81 | 4 | 12 | 12 | 0 | 0 | 0 | 4 |
| 2016-03-28 | 1459123200 | 604800 | 2016 | 1 | 1 | 3 | 2 | March | 28 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 28 | 88 | 88 | 5 | 13 | 13 | 1 | 1 | 1 | 5 |
| 2016-04-04 | 1459728000 | 604800 | 2016 | 1 | 2 | 4 | 3 | April | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 4 | 95 | 2 | 14 | 14 | 0 | 2 | 2 | 1 |
| 2016-04-11 | 1460332800 | 604800 | 2016 | 1 | 2 | 4 | 3 | April | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 11 | 102 | 3 | 15 | 15 | 1 | 0 | 3 | 2 |
| 2016-04-18 | 1460937600 | 604800 | 2016 | 1 | 2 | 4 | 3 | April | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 18 | 109 | 4 | 16 | 16 | 0 | 1 | 0 | 3 |
| 2016-04-25 | 1461542400 | 604800 | 2016 | 1 | 2 | 4 | 3 | April | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 25 | 116 | 5 | 17 | 17 | 1 | 2 | 1 | 4 |
| 2016-05-02 | 1462147200 | 604800 | 2016 | 1 | 2 | 5 | 4 | May | 2 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 2 | 32 | 123 | 1 | 18 | 18 | 0 | 0 | 2 | 1 |
| 2016-05-09 | 1462752000 | 604800 | 2016 | 1 | 2 | 5 | 4 | May | 9 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 9 | 39 | 130 | 2 | 19 | 19 | 1 | 1 | 3 | 2 |
| 2016-05-16 | 1463356800 | 604800 | 2016 | 1 | 2 | 5 | 4 | May | 16 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 16 | 46 | 137 | 3 | 20 | 20 | 0 | 2 | 0 | 3 |
| 2016-05-23 | 1463961600 | 604800 | 2016 | 1 | 2 | 5 | 4 | May | 23 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 23 | 53 | 144 | 4 | 21 | 21 | 1 | 0 | 1 | 4 |
| 2016-05-30 | 1464566400 | 604800 | 2016 | 1 | 2 | 5 | 4 | May | 30 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 30 | 60 | 151 | 5 | 22 | 22 | 0 | 1 | 2 | 5 |
| 2016-06-06 | 1465171200 | 604800 | 2016 | 1 | 2 | 6 | 5 | June | 6 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 6 | 67 | 158 | 2 | 23 | 23 | 1 | 2 | 3 | 1 |
| 2016-06-13 | 1465776000 | 604800 | 2016 | 1 | 2 | 6 | 5 | June | 13 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 13 | 74 | 165 | 3 | 24 | 24 | 0 | 0 | 0 | 2 |
| 2016-06-20 | 1466380800 | 604800 | 2016 | 1 | 2 | 6 | 5 | June | 20 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 20 | 81 | 172 | 4 | 25 | 25 | 1 | 1 | 1 | 3 |
| 2016-06-27 | 1466985600 | 604800 | 2016 | 1 | 2 | 6 | 5 | June | 27 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 27 | 88 | 179 | 5 | 26 | 26 | 0 | 2 | 2 | 4 |
| 2016-07-04 | 1467590400 | 604800 | 2016 | 2 | 3 | 7 | 6 | July | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 4 | 186 | 2 | 27 | 27 | 1 | 0 | 3 | 1 |
| 2016-07-11 | 1468195200 | 604800 | 2016 | 2 | 3 | 7 | 6 | July | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 11 | 193 | 3 | 28 | 28 | 0 | 1 | 0 | 2 |
| 2016-07-18 | 1468800000 | 604800 | 2016 | 2 | 3 | 7 | 6 | July | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 18 | 200 | 4 | 29 | 29 | 1 | 2 | 1 | 3 |
| 2016-07-25 | 1469404800 | 604800 | 2016 | 2 | 3 | 7 | 6 | July | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 25 | 207 | 5 | 30 | 30 | 0 | 0 | 2 | 4 |
| 2016-08-01 | 1470009600 | 604800 | 2016 | 2 | 3 | 8 | 7 | August | 1 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 1 | 32 | 214 | 6 | 31 | 31 | 1 | 1 | 3 | 1 |
| 2016-08-08 | 1470614400 | 604800 | 2016 | 2 | 3 | 8 | 7 | August | 8 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 8 | 39 | 221 | 2 | 32 | 32 | 0 | 2 | 0 | 2 |
| 2016-08-15 | 1471219200 | 604800 | 2016 | 2 | 3 | 8 | 7 | August | 15 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 15 | 46 | 228 | 3 | 33 | 33 | 1 | 0 | 1 | 3 |
| 2016-08-22 | 1471824000 | 604800 | 2016 | 2 | 3 | 8 | 7 | August | 22 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 22 | 53 | 235 | 4 | 34 | 34 | 0 | 1 | 2 | 4 |
| 2016-08-29 | 1472428800 | 604800 | 2016 | 2 | 3 | 8 | 7 | August | 29 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 29 | 60 | 242 | 5 | 35 | 35 | 1 | 2 | 3 | 5 |
| 2016-09-05 | 1473033600 | 604800 | 2016 | 2 | 3 | 9 | 8 | September | 5 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 5 | 67 | 249 | 2 | 36 | 36 | 0 | 0 | 0 | 1 |
| 2016-09-12 | 1473638400 | 604800 | 2016 | 2 | 3 | 9 | 8 | September | 12 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 12 | 74 | 256 | 3 | 37 | 37 | 1 | 1 | 1 | 2 |
| 2016-09-19 | 1474243200 | 604800 | 2016 | 2 | 3 | 9 | 8 | September | 19 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 19 | 81 | 263 | 4 | 38 | 38 | 0 | 2 | 2 | 3 |
| 2016-09-26 | 1474848000 | 604800 | 2016 | 2 | 3 | 9 | 8 | September | 26 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 26 | 88 | 270 | 5 | 39 | 39 | 1 | 0 | 3 | 4 |
| 2016-10-03 | 1475452800 | 604800 | 2016 | 2 | 4 | 10 | 9 | October | 3 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 3 | 3 | 277 | 2 | 40 | 40 | 0 | 1 | 0 | 1 |
| 2016-10-10 | 1476057600 | 604800 | 2016 | 2 | 4 | 10 | 9 | October | 10 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 10 | 10 | 284 | 3 | 41 | 41 | 1 | 2 | 1 | 2 |
| 2016-10-17 | 1476662400 | 604800 | 2016 | 2 | 4 | 10 | 9 | October | 17 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 17 | 17 | 291 | 4 | 42 | 42 | 0 | 0 | 2 | 3 |
| 2016-10-24 | 1477267200 | 604800 | 2016 | 2 | 4 | 10 | 9 | October | 24 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 24 | 24 | 298 | 5 | 43 | 43 | 1 | 1 | 3 | 4 |
| 2016-10-31 | 1477872000 | 604800 | 2016 | 2 | 4 | 10 | 9 | October | 31 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 31 | 31 | 305 | 6 | 44 | 44 | 0 | 2 | 0 | 5 |
| 2016-11-07 | 1478476800 | 604800 | 2016 | 2 | 4 | 11 | 10 | November | 7 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 7 | 38 | 312 | 2 | 45 | 45 | 1 | 0 | 1 | 2 |
| 2016-11-14 | 1479081600 | 604800 | 2016 | 2 | 4 | 11 | 10 | November | 14 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 14 | 45 | 319 | 3 | 46 | 46 | 0 | 1 | 2 | 3 |
| 2016-11-21 | 1479686400 | 604800 | 2016 | 2 | 4 | 11 | 10 | November | 21 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 21 | 52 | 326 | 4 | 47 | 47 | 1 | 2 | 3 | 4 |
| 2016-11-28 | 1480291200 | 604800 | 2016 | 2 | 4 | 11 | 10 | November | 28 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 28 | 59 | 333 | 5 | 48 | 48 | 0 | 0 | 0 | 5 |
| 2016-12-05 | 1480896000 | 604800 | 2016 | 2 | 4 | 12 | 11 | December | 5 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 5 | 66 | 340 | 2 | 49 | 49 | 1 | 1 | 1 | 1 |
| 2016-12-12 | 1481500800 | 604800 | 2016 | 2 | 4 | 12 | 11 | December | 12 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 12 | 73 | 347 | 3 | 50 | 50 | 0 | 2 | 2 | 2 |
| 2016-12-19 | 1482105600 | 604800 | 2016 | 2 | 4 | 12 | 11 | December | 19 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 19 | 80 | 354 | 4 | 51 | 51 | 1 | 0 | 3 | 3 |
| 2016-12-26 | 1482710400 | 604800 | 2016 | 2 | 4 | 12 | 11 | December | 26 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 26 | 87 | 361 | 5 | 52 | 52 | 0 | 1 | 0 | 4 |
| 2017-01-02 | 1483315200 | 604800 | 2017 | 1 | 1 | 1 | 0 | January | 2 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 2 | 2 | 2 | 1 | 1 | 1 | 1 | 1 | 1 | 1 |
| 2017-01-09 | 1483920000 | 604800 | 2017 | 1 | 1 | 1 | 0 | January | 9 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 9 | 9 | 9 | 2 | 2 | 2 | 0 | 2 | 2 | 2 |
| 2017-01-16 | 1484524800 | 604800 | 2017 | 1 | 1 | 1 | 0 | January | 16 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 16 | 16 | 16 | 3 | 3 | 3 | 1 | 0 | 3 | 3 |
| 2017-01-23 | 1485129600 | 604800 | 2017 | 1 | 1 | 1 | 0 | January | 23 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 23 | 23 | 23 | 4 | 4 | 4 | 0 | 1 | 0 | 4 |
| 2017-01-30 | 1485734400 | 604800 | 2017 | 1 | 1 | 1 | 0 | January | 30 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 30 | 30 | 30 | 5 | 5 | 5 | 1 | 2 | 1 | 5 |
| 2017-02-06 | 1486339200 | 604800 | 2017 | 1 | 1 | 2 | 1 | February | 6 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 6 | 37 | 37 | 2 | 6 | 6 | 0 | 0 | 2 | 1 |
| 2017-02-13 | 1486944000 | 604800 | 2017 | 1 | 1 | 2 | 1 | February | 13 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 13 | 44 | 44 | 3 | 7 | 7 | 1 | 1 | 3 | 2 |
| 2017-02-20 | 1487548800 | 604800 | 2017 | 1 | 1 | 2 | 1 | February | 20 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 20 | 51 | 51 | 4 | 8 | 8 | 0 | 2 | 0 | 3 |
| 2017-02-27 | 1488153600 | 604800 | 2017 | 1 | 1 | 2 | 1 | February | 27 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 27 | 58 | 58 | 5 | 9 | 9 | 1 | 0 | 1 | 4 |
| 2017-03-06 | 1488758400 | 604800 | 2017 | 1 | 1 | 3 | 2 | March | 6 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 6 | 65 | 65 | 2 | 10 | 10 | 0 | 1 | 2 | 1 |
| 2017-03-13 | 1489363200 | 604800 | 2017 | 1 | 1 | 3 | 2 | March | 13 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 13 | 72 | 72 | 3 | 11 | 11 | 1 | 2 | 3 | 2 |
| 2017-03-20 | 1489968000 | 604800 | 2017 | 1 | 1 | 3 | 2 | March | 20 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 20 | 79 | 79 | 4 | 12 | 12 | 0 | 0 | 0 | 3 |
| 2017-03-27 | 1490572800 | 604800 | 2017 | 1 | 1 | 3 | 2 | March | 27 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 27 | 86 | 86 | 5 | 13 | 13 | 1 | 1 | 1 | 4 |
| 2017-04-03 | 1491177600 | 604800 | 2017 | 1 | 2 | 4 | 3 | April | 3 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 3 | 3 | 93 | 2 | 14 | 14 | 0 | 2 | 2 | 1 |
| 2017-04-10 | 1491782400 | 604800 | 2017 | 1 | 2 | 4 | 3 | April | 10 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 10 | 10 | 100 | 3 | 15 | 15 | 1 | 0 | 3 | 2 |
| 2017-04-17 | 1492387200 | 604800 | 2017 | 1 | 2 | 4 | 3 | April | 17 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 17 | 17 | 107 | 4 | 16 | 16 | 0 | 1 | 0 | 3 |
| 2017-04-24 | 1492992000 | 604800 | 2017 | 1 | 2 | 4 | 3 | April | 24 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 24 | 24 | 114 | 5 | 17 | 17 | 1 | 2 | 1 | 4 |
| 2017-05-01 | 1493596800 | 604800 | 2017 | 1 | 2 | 5 | 4 | May | 1 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 1 | 31 | 121 | 6 | 18 | 18 | 0 | 0 | 2 | 1 |
| 2017-05-08 | 1494201600 | 604800 | 2017 | 1 | 2 | 5 | 4 | May | 8 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 8 | 38 | 128 | 2 | 19 | 19 | 1 | 1 | 3 | 2 |
| 2017-05-15 | 1494806400 | 604800 | 2017 | 1 | 2 | 5 | 4 | May | 15 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 15 | 45 | 135 | 3 | 20 | 20 | 0 | 2 | 0 | 3 |
| 2017-05-22 | 1495411200 | 604800 | 2017 | 1 | 2 | 5 | 4 | May | 22 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 22 | 52 | 142 | 4 | 21 | 21 | 1 | 0 | 1 | 4 |
| 2017-05-29 | 1496016000 | 604800 | 2017 | 1 | 2 | 5 | 4 | May | 29 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 29 | 59 | 149 | 5 | 22 | 22 | 0 | 1 | 2 | 5 |
| 2017-06-05 | 1496620800 | 604800 | 2017 | 1 | 2 | 6 | 5 | June | 5 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 5 | 66 | 156 | 2 | 23 | 23 | 1 | 2 | 3 | 1 |
| 2017-06-12 | 1497225600 | 604800 | 2017 | 1 | 2 | 6 | 5 | June | 12 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 12 | 73 | 163 | 3 | 24 | 24 | 0 | 0 | 0 | 2 |
| 2017-06-19 | 1497830400 | 604800 | 2017 | 1 | 2 | 6 | 5 | June | 19 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 19 | 80 | 170 | 4 | 25 | 25 | 1 | 1 | 1 | 3 |
| 2017-06-26 | 1498435200 | 604800 | 2017 | 1 | 2 | 6 | 5 | June | 26 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 26 | 87 | 177 | 5 | 26 | 26 | 0 | 2 | 2 | 4 |
| 2017-07-03 | 1499040000 | 604800 | 2017 | 2 | 3 | 7 | 6 | July | 3 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 3 | 3 | 184 | 2 | 27 | 27 | 1 | 0 | 3 | 1 |
| 2017-07-10 | 1499644800 | 604800 | 2017 | 2 | 3 | 7 | 6 | July | 10 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 10 | 10 | 191 | 3 | 28 | 28 | 0 | 1 | 0 | 2 |
| 2017-07-17 | 1500249600 | 604800 | 2017 | 2 | 3 | 7 | 6 | July | 17 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 17 | 17 | 198 | 4 | 29 | 29 | 1 | 2 | 1 | 3 |
| 2017-07-24 | 1500854400 | 604800 | 2017 | 2 | 3 | 7 | 6 | July | 24 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 24 | 24 | 205 | 5 | 30 | 30 | 0 | 0 | 2 | 4 |
| 2017-07-31 | 1501459200 | 604800 | 2017 | 2 | 3 | 7 | 6 | July | 31 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 31 | 31 | 212 | 6 | 31 | 31 | 1 | 1 | 3 | 5 |
| 2017-08-07 | 1502064000 | 604800 | 2017 | 2 | 3 | 8 | 7 | August | 7 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 7 | 38 | 219 | 2 | 32 | 32 | 0 | 2 | 0 | 2 |
| 2017-08-14 | 1502668800 | 604800 | 2017 | 2 | 3 | 8 | 7 | August | 14 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 14 | 45 | 226 | 3 | 33 | 33 | 1 | 0 | 1 | 3 |
| 2017-08-21 | 1503273600 | 604800 | 2017 | 2 | 3 | 8 | 7 | August | 21 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 21 | 52 | 233 | 4 | 34 | 34 | 0 | 1 | 2 | 4 |
| 2017-08-28 | 1503878400 | 604800 | 2017 | 2 | 3 | 8 | 7 | August | 28 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 28 | 59 | 240 | 5 | 35 | 35 | 1 | 2 | 3 | 5 |
| 2017-09-04 | 1504483200 | 604800 | 2017 | 2 | 3 | 9 | 8 | September | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 66 | 247 | 2 | 36 | 36 | 0 | 0 | 0 | 1 |
| 2017-09-11 | 1505088000 | 604800 | 2017 | 2 | 3 | 9 | 8 | September | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 73 | 254 | 3 | 37 | 37 | 1 | 1 | 1 | 2 |
| 2017-09-18 | 1505692800 | 604800 | 2017 | 2 | 3 | 9 | 8 | September | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 80 | 261 | 4 | 38 | 38 | 0 | 2 | 2 | 3 |
| 2017-09-25 | 1506297600 | 604800 | 2017 | 2 | 3 | 9 | 8 | September | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 87 | 268 | 5 | 39 | 39 | 1 | 0 | 3 | 4 |
| 2017-10-02 | 1506902400 | 604800 | 2017 | 2 | 4 | 10 | 9 | October | 2 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 2 | 2 | 275 | 1 | 40 | 40 | 0 | 1 | 0 | 1 |
| 2017-10-09 | 1507507200 | 604800 | 2017 | 2 | 4 | 10 | 9 | October | 9 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 9 | 9 | 282 | 2 | 41 | 41 | 1 | 2 | 1 | 2 |
| 2017-10-16 | 1508112000 | 604800 | 2017 | 2 | 4 | 10 | 9 | October | 16 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 16 | 16 | 289 | 3 | 42 | 42 | 0 | 0 | 2 | 3 |
| 2017-10-23 | 1508716800 | 604800 | 2017 | 2 | 4 | 10 | 9 | October | 23 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 23 | 23 | 296 | 4 | 43 | 43 | 1 | 1 | 3 | 4 |
| 2017-10-30 | 1509321600 | 604800 | 2017 | 2 | 4 | 10 | 9 | October | 30 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 30 | 30 | 303 | 5 | 44 | 44 | 0 | 2 | 0 | 5 |
| 2017-11-06 | 1509926400 | 604800 | 2017 | 2 | 4 | 11 | 10 | November | 6 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 6 | 37 | 310 | 2 | 45 | 45 | 1 | 0 | 1 | 1 |
| 2017-11-13 | 1510531200 | 604800 | 2017 | 2 | 4 | 11 | 10 | November | 13 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 13 | 44 | 317 | 3 | 46 | 46 | 0 | 1 | 2 | 2 |
| 2017-11-20 | 1511136000 | 604800 | 2017 | 2 | 4 | 11 | 10 | November | 20 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 20 | 51 | 324 | 4 | 47 | 47 | 1 | 2 | 3 | 3 |
| 2017-11-27 | 1511740800 | 604800 | 2017 | 2 | 4 | 11 | 10 | November | 27 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 27 | 58 | 331 | 5 | 48 | 48 | 0 | 0 | 0 | 4 |
| 2017-12-04 | 1512345600 | 604800 | 2017 | 2 | 4 | 12 | 11 | December | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 65 | 338 | 2 | 49 | 49 | 1 | 1 | 1 | 1 |
| 2017-12-11 | 1512950400 | 604800 | 2017 | 2 | 4 | 12 | 11 | December | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 72 | 345 | 3 | 50 | 50 | 0 | 2 | 2 | 2 |
| 2017-12-18 | 1513555200 | 604800 | 2017 | 2 | 4 | 12 | 11 | December | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 79 | 352 | 4 | 51 | 51 | 1 | 0 | 3 | 3 |
| 2017-12-25 | 1514160000 | 604800 | 2017 | 2 | 4 | 12 | 11 | December | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 86 | 359 | 5 | 52 | 52 | 0 | 1 | 0 | 4 |
| 2018-01-01 | 1514764800 | 604800 | 2018 | 1 | 1 | 1 | 0 | January | 1 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 1 | 1 | 1 | 6 | 1 | 1 | 1 | 1 | 1 | 1 |
| 2018-01-08 | 1515369600 | 604800 | 2018 | 1 | 1 | 1 | 0 | January | 8 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 8 | 8 | 8 | 2 | 2 | 2 | 0 | 2 | 2 | 2 |
| 2018-01-15 | 1515974400 | 604800 | 2018 | 1 | 1 | 1 | 0 | January | 15 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 15 | 15 | 15 | 3 | 3 | 3 | 1 | 0 | 3 | 3 |
| 2018-01-22 | 1516579200 | 604800 | 2018 | 1 | 1 | 1 | 0 | January | 22 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 22 | 22 | 22 | 4 | 4 | 4 | 0 | 1 | 0 | 4 |
| 2018-01-29 | 1517184000 | 604800 | 2018 | 1 | 1 | 1 | 0 | January | 29 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 29 | 29 | 29 | 5 | 5 | 5 | 1 | 2 | 1 | 5 |
| 2018-02-05 | 1517788800 | 604800 | 2018 | 1 | 1 | 2 | 1 | February | 5 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 5 | 36 | 36 | 2 | 6 | 6 | 0 | 0 | 2 | 1 |
| 2018-02-12 | 1518393600 | 604800 | 2018 | 1 | 1 | 2 | 1 | February | 12 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 12 | 43 | 43 | 3 | 7 | 7 | 1 | 1 | 3 | 2 |
| 2018-02-19 | 1518998400 | 604800 | 2018 | 1 | 1 | 2 | 1 | February | 19 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 19 | 50 | 50 | 4 | 8 | 8 | 0 | 2 | 0 | 3 |
| 2018-02-26 | 1519603200 | 604800 | 2018 | 1 | 1 | 2 | 1 | February | 26 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 26 | 57 | 57 | 5 | 9 | 9 | 1 | 0 | 1 | 4 |
| 2018-03-05 | 1520208000 | 604800 | 2018 | 1 | 1 | 3 | 2 | March | 5 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 5 | 64 | 64 | 2 | 10 | 10 | 0 | 1 | 2 | 1 |
| 2018-03-12 | 1520812800 | 604800 | 2018 | 1 | 1 | 3 | 2 | March | 12 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 12 | 71 | 71 | 3 | 11 | 11 | 1 | 2 | 3 | 2 |
| 2018-03-19 | 1521417600 | 604800 | 2018 | 1 | 1 | 3 | 2 | March | 19 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 19 | 78 | 78 | 4 | 12 | 12 | 0 | 0 | 0 | 3 |
| 2018-03-26 | 1522022400 | 604800 | 2018 | 1 | 1 | 3 | 2 | March | 26 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 26 | 85 | 85 | 5 | 13 | 13 | 1 | 1 | 1 | 4 |
| 2018-04-02 | 1522627200 | 604800 | 2018 | 1 | 2 | 4 | 3 | April | 2 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 2 | 2 | 92 | 1 | 14 | 14 | 0 | 2 | 2 | 1 |
| 2018-04-09 | 1523232000 | 604800 | 2018 | 1 | 2 | 4 | 3 | April | 9 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 9 | 9 | 99 | 2 | 15 | 15 | 1 | 0 | 3 | 2 |
| 2018-04-16 | 1523836800 | 604800 | 2018 | 1 | 2 | 4 | 3 | April | 16 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 16 | 16 | 106 | 3 | 16 | 16 | 0 | 1 | 0 | 3 |
| 2018-04-23 | 1524441600 | 604800 | 2018 | 1 | 2 | 4 | 3 | April | 23 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 23 | 23 | 113 | 4 | 17 | 17 | 1 | 2 | 1 | 4 |
| 2018-04-30 | 1525046400 | 604800 | 2018 | 1 | 2 | 4 | 3 | April | 30 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 30 | 30 | 120 | 5 | 18 | 18 | 0 | 0 | 2 | 5 |
| 2018-05-07 | 1525651200 | 604800 | 2018 | 1 | 2 | 5 | 4 | May | 7 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 7 | 37 | 127 | 2 | 19 | 19 | 1 | 1 | 3 | 2 |
| 2018-05-14 | 1526256000 | 604800 | 2018 | 1 | 2 | 5 | 4 | May | 14 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 14 | 44 | 134 | 3 | 20 | 20 | 0 | 2 | 0 | 3 |
| 2018-05-21 | 1526860800 | 604800 | 2018 | 1 | 2 | 5 | 4 | May | 21 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 21 | 51 | 141 | 4 | 21 | 21 | 1 | 0 | 1 | 4 |
| 2018-05-28 | 1527465600 | 604800 | 2018 | 1 | 2 | 5 | 4 | May | 28 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 28 | 58 | 148 | 5 | 22 | 22 | 0 | 1 | 2 | 5 |
| 2018-06-04 | 1528070400 | 604800 | 2018 | 1 | 2 | 6 | 5 | June | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 65 | 155 | 2 | 23 | 23 | 1 | 2 | 3 | 1 |
| 2018-06-11 | 1528675200 | 604800 | 2018 | 1 | 2 | 6 | 5 | June | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 72 | 162 | 3 | 24 | 24 | 0 | 0 | 0 | 2 |
| 2018-06-18 | 1529280000 | 604800 | 2018 | 1 | 2 | 6 | 5 | June | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 79 | 169 | 4 | 25 | 25 | 1 | 1 | 1 | 3 |
| 2018-06-25 | 1529884800 | 604800 | 2018 | 1 | 2 | 6 | 5 | June | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 86 | 176 | 5 | 26 | 26 | 0 | 2 | 2 | 4 |
#HW=HoltWinters(md_ts, gamma=FALSE, l.start=30, b.start=1)
modelseries=Durad%>%tidyr::drop_na()%>%tk_xts()
#modelseries=Durad%>%tk_xts()
modelseries%>%timetk::tk_tbl()%>%head()HW=HoltWinters(modelseries, gamma=FALSE, l.start=30, b.start=1)
sweep::sw_augment(HW)%>%head()%>%knitr::kable()| index | .actual | .fitted | .resid |
|---|---|---|---|
| 1 | 26 | NA | NA |
| 604801 | 27 | NA | NA |
| 1209601 | 28 | 31.00000 | -3.000000 |
| 1814401 | 22 | 29.07589 | -7.075887 |
| 2419201 | 27 | 23.09402 | 3.905981 |
| 3024001 | 31 | 27.61581 | 3.384190 |
Durad<-Durad%>%tidyr::drop_na()
Durad%>%dim()## [1] 126 2HWdata=cbind.data.frame(Date=Durad[,1],sweep::sw_augment(HW))
mycolors=c("red","black","blue")
HWdata%>%head()%>%knitr::kable()| Date | index | .actual | .fitted | .resid |
|---|---|---|---|---|
| 2016-01-11 | 1 | 26 | NA | NA |
| 2016-01-18 | 604801 | 27 | NA | NA |
| 2016-01-25 | 1209601 | 28 | 31.00000 | -3.000000 |
| 2016-02-01 | 1814401 | 22 | 29.07589 | -7.075887 |
| 2016-02-08 | 2419201 | 27 | 23.09402 | 3.905981 |
| 2016-02-15 | 3024001 | 31 | 27.61581 | 3.384190 |
HWdata%>%ggplot(aes(x=as.Date(Date)))+geom_line(aes(y=.actual,color="Actual Data"), size=1.5, linetype=1)+geom_line(aes(x=as.Date(Date),y=.fitted,color="Model Prediction on Data"),data=HWdata, size=1.5, linetype=1)+
labs(title = "Holtwinters Exponential smoothing model ", x = "Time",y=" Durability Vehicles")+
theme_bw() +
# remove legend title
theme(legend.title = element_blank()) +
#change the position of the legend
theme(legend.position="top") +
# Change the color of the title of the legend (name)
#theme(legend.title = element_text(color="chocolate", size=14, face="bold"))+
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 month"),
labels=date_format("%b %d %y")))+
geom_vline(xintercept=as.Date("2017-09-18"), linetype=2)+
geom_vline(xintercept=as.Date("2017-09-18"), linetype=2)+
#geom_point(aes(x =as.Date(Date), y = Actual, colour="Forecast"), data =dfuture, alpha = 0.5, size=1.5, linetype=1)+
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95), fill = "grey", alpha=0.5,data=dfuture)+
geom_smooth(aes(x =as.Date(Date), y = Actual,color="12 Week Forecast"), data =dfuture,
method = 'loess', size=1.5, linetype=1)+
scale_color_manual(values=mycolors)
Durad<- rio::import("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actvsfcdatajuly311.xlsx",sheet="Sheet3")
Durad<-Durad[1:104,]
tail(Durad)%>%knitr::kable()| Week | Actual | |
|---|---|---|
| 99 | 2017-11-20 | 56 |
| 100 | 2017-11-27 | 53 |
| 101 | 2017-12-04 | 58 |
| 102 | 2017-12-11 | 61 |
| 103 | 2017-12-18 | 64 |
| 104 | 2017-12-25 | 62 |
idx=Durad%>%tk_index()%>%tk_get_timeseries_signature()
idx%>%knitr::kable()| index | index.num | diff | year | half | quarter | month | month.xts | month.lbl | day | hour | minute | second | hour12 | am.pm | wday | wday.xts | wday.lbl | mday | qday | yday | mweek | week | week.iso | week2 | week3 | week4 | mday7 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2016-01-04 | 1451865600 | NA | 2016 | 1 | 1 | 1 | 0 | January | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 4 | 4 | 2 | 1 | 1 | 1 | 1 | 1 | 1 |
| 2016-01-11 | 1452470400 | 604800 | 2016 | 1 | 1 | 1 | 0 | January | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 11 | 11 | 3 | 2 | 2 | 0 | 2 | 2 | 2 |
| 2016-01-18 | 1453075200 | 604800 | 2016 | 1 | 1 | 1 | 0 | January | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 18 | 18 | 4 | 3 | 3 | 1 | 0 | 3 | 3 |
| 2016-01-25 | 1453680000 | 604800 | 2016 | 1 | 1 | 1 | 0 | January | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 25 | 25 | 5 | 4 | 4 | 0 | 1 | 0 | 4 |
| 2016-02-01 | 1454284800 | 604800 | 2016 | 1 | 1 | 2 | 1 | February | 1 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 1 | 32 | 32 | 6 | 5 | 5 | 1 | 2 | 1 | 1 |
| 2016-02-08 | 1454889600 | 604800 | 2016 | 1 | 1 | 2 | 1 | February | 8 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 8 | 39 | 39 | 2 | 6 | 6 | 0 | 0 | 2 | 2 |
| 2016-02-15 | 1455494400 | 604800 | 2016 | 1 | 1 | 2 | 1 | February | 15 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 15 | 46 | 46 | 3 | 7 | 7 | 1 | 1 | 3 | 3 |
| 2016-02-22 | 1456099200 | 604800 | 2016 | 1 | 1 | 2 | 1 | February | 22 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 22 | 53 | 53 | 4 | 8 | 8 | 0 | 2 | 0 | 4 |
| 2016-02-29 | 1456704000 | 604800 | 2016 | 1 | 1 | 2 | 1 | February | 29 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 29 | 60 | 60 | 5 | 9 | 9 | 1 | 0 | 1 | 5 |
| 2016-03-07 | 1457308800 | 604800 | 2016 | 1 | 1 | 3 | 2 | March | 7 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 7 | 67 | 67 | 2 | 10 | 10 | 0 | 1 | 2 | 2 |
| 2016-03-14 | 1457913600 | 604800 | 2016 | 1 | 1 | 3 | 2 | March | 14 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 14 | 74 | 74 | 3 | 11 | 11 | 1 | 2 | 3 | 3 |
| 2016-03-21 | 1458518400 | 604800 | 2016 | 1 | 1 | 3 | 2 | March | 21 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 21 | 81 | 81 | 4 | 12 | 12 | 0 | 0 | 0 | 4 |
| 2016-03-28 | 1459123200 | 604800 | 2016 | 1 | 1 | 3 | 2 | March | 28 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 28 | 88 | 88 | 5 | 13 | 13 | 1 | 1 | 1 | 5 |
| 2016-04-04 | 1459728000 | 604800 | 2016 | 1 | 2 | 4 | 3 | April | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 4 | 95 | 2 | 14 | 14 | 0 | 2 | 2 | 1 |
| 2016-04-11 | 1460332800 | 604800 | 2016 | 1 | 2 | 4 | 3 | April | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 11 | 102 | 3 | 15 | 15 | 1 | 0 | 3 | 2 |
| 2016-04-18 | 1460937600 | 604800 | 2016 | 1 | 2 | 4 | 3 | April | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 18 | 109 | 4 | 16 | 16 | 0 | 1 | 0 | 3 |
| 2016-04-25 | 1461542400 | 604800 | 2016 | 1 | 2 | 4 | 3 | April | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 25 | 116 | 5 | 17 | 17 | 1 | 2 | 1 | 4 |
| 2016-05-02 | 1462147200 | 604800 | 2016 | 1 | 2 | 5 | 4 | May | 2 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 2 | 32 | 123 | 1 | 18 | 18 | 0 | 0 | 2 | 1 |
| 2016-05-09 | 1462752000 | 604800 | 2016 | 1 | 2 | 5 | 4 | May | 9 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 9 | 39 | 130 | 2 | 19 | 19 | 1 | 1 | 3 | 2 |
| 2016-05-16 | 1463356800 | 604800 | 2016 | 1 | 2 | 5 | 4 | May | 16 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 16 | 46 | 137 | 3 | 20 | 20 | 0 | 2 | 0 | 3 |
| 2016-05-23 | 1463961600 | 604800 | 2016 | 1 | 2 | 5 | 4 | May | 23 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 23 | 53 | 144 | 4 | 21 | 21 | 1 | 0 | 1 | 4 |
| 2016-05-30 | 1464566400 | 604800 | 2016 | 1 | 2 | 5 | 4 | May | 30 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 30 | 60 | 151 | 5 | 22 | 22 | 0 | 1 | 2 | 5 |
| 2016-06-06 | 1465171200 | 604800 | 2016 | 1 | 2 | 6 | 5 | June | 6 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 6 | 67 | 158 | 2 | 23 | 23 | 1 | 2 | 3 | 1 |
| 2016-06-13 | 1465776000 | 604800 | 2016 | 1 | 2 | 6 | 5 | June | 13 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 13 | 74 | 165 | 3 | 24 | 24 | 0 | 0 | 0 | 2 |
| 2016-06-20 | 1466380800 | 604800 | 2016 | 1 | 2 | 6 | 5 | June | 20 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 20 | 81 | 172 | 4 | 25 | 25 | 1 | 1 | 1 | 3 |
| 2016-06-27 | 1466985600 | 604800 | 2016 | 1 | 2 | 6 | 5 | June | 27 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 27 | 88 | 179 | 5 | 26 | 26 | 0 | 2 | 2 | 4 |
| 2016-07-04 | 1467590400 | 604800 | 2016 | 2 | 3 | 7 | 6 | July | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 4 | 186 | 2 | 27 | 27 | 1 | 0 | 3 | 1 |
| 2016-07-11 | 1468195200 | 604800 | 2016 | 2 | 3 | 7 | 6 | July | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 11 | 193 | 3 | 28 | 28 | 0 | 1 | 0 | 2 |
| 2016-07-18 | 1468800000 | 604800 | 2016 | 2 | 3 | 7 | 6 | July | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 18 | 200 | 4 | 29 | 29 | 1 | 2 | 1 | 3 |
| 2016-07-25 | 1469404800 | 604800 | 2016 | 2 | 3 | 7 | 6 | July | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 25 | 207 | 5 | 30 | 30 | 0 | 0 | 2 | 4 |
| 2016-08-01 | 1470009600 | 604800 | 2016 | 2 | 3 | 8 | 7 | August | 1 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 1 | 32 | 214 | 6 | 31 | 31 | 1 | 1 | 3 | 1 |
| 2016-08-08 | 1470614400 | 604800 | 2016 | 2 | 3 | 8 | 7 | August | 8 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 8 | 39 | 221 | 2 | 32 | 32 | 0 | 2 | 0 | 2 |
| 2016-08-15 | 1471219200 | 604800 | 2016 | 2 | 3 | 8 | 7 | August | 15 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 15 | 46 | 228 | 3 | 33 | 33 | 1 | 0 | 1 | 3 |
| 2016-08-22 | 1471824000 | 604800 | 2016 | 2 | 3 | 8 | 7 | August | 22 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 22 | 53 | 235 | 4 | 34 | 34 | 0 | 1 | 2 | 4 |
| 2016-08-29 | 1472428800 | 604800 | 2016 | 2 | 3 | 8 | 7 | August | 29 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 29 | 60 | 242 | 5 | 35 | 35 | 1 | 2 | 3 | 5 |
| 2016-09-05 | 1473033600 | 604800 | 2016 | 2 | 3 | 9 | 8 | September | 5 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 5 | 67 | 249 | 2 | 36 | 36 | 0 | 0 | 0 | 1 |
| 2016-09-12 | 1473638400 | 604800 | 2016 | 2 | 3 | 9 | 8 | September | 12 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 12 | 74 | 256 | 3 | 37 | 37 | 1 | 1 | 1 | 2 |
| 2016-09-19 | 1474243200 | 604800 | 2016 | 2 | 3 | 9 | 8 | September | 19 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 19 | 81 | 263 | 4 | 38 | 38 | 0 | 2 | 2 | 3 |
| 2016-09-26 | 1474848000 | 604800 | 2016 | 2 | 3 | 9 | 8 | September | 26 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 26 | 88 | 270 | 5 | 39 | 39 | 1 | 0 | 3 | 4 |
| 2016-10-03 | 1475452800 | 604800 | 2016 | 2 | 4 | 10 | 9 | October | 3 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 3 | 3 | 277 | 2 | 40 | 40 | 0 | 1 | 0 | 1 |
| 2016-10-10 | 1476057600 | 604800 | 2016 | 2 | 4 | 10 | 9 | October | 10 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 10 | 10 | 284 | 3 | 41 | 41 | 1 | 2 | 1 | 2 |
| 2016-10-17 | 1476662400 | 604800 | 2016 | 2 | 4 | 10 | 9 | October | 17 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 17 | 17 | 291 | 4 | 42 | 42 | 0 | 0 | 2 | 3 |
| 2016-10-24 | 1477267200 | 604800 | 2016 | 2 | 4 | 10 | 9 | October | 24 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 24 | 24 | 298 | 5 | 43 | 43 | 1 | 1 | 3 | 4 |
| 2016-10-31 | 1477872000 | 604800 | 2016 | 2 | 4 | 10 | 9 | October | 31 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 31 | 31 | 305 | 6 | 44 | 44 | 0 | 2 | 0 | 5 |
| 2016-11-07 | 1478476800 | 604800 | 2016 | 2 | 4 | 11 | 10 | November | 7 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 7 | 38 | 312 | 2 | 45 | 45 | 1 | 0 | 1 | 2 |
| 2016-11-14 | 1479081600 | 604800 | 2016 | 2 | 4 | 11 | 10 | November | 14 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 14 | 45 | 319 | 3 | 46 | 46 | 0 | 1 | 2 | 3 |
| 2016-11-21 | 1479686400 | 604800 | 2016 | 2 | 4 | 11 | 10 | November | 21 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 21 | 52 | 326 | 4 | 47 | 47 | 1 | 2 | 3 | 4 |
| 2016-11-28 | 1480291200 | 604800 | 2016 | 2 | 4 | 11 | 10 | November | 28 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 28 | 59 | 333 | 5 | 48 | 48 | 0 | 0 | 0 | 5 |
| 2016-12-05 | 1480896000 | 604800 | 2016 | 2 | 4 | 12 | 11 | December | 5 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 5 | 66 | 340 | 2 | 49 | 49 | 1 | 1 | 1 | 1 |
| 2016-12-12 | 1481500800 | 604800 | 2016 | 2 | 4 | 12 | 11 | December | 12 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 12 | 73 | 347 | 3 | 50 | 50 | 0 | 2 | 2 | 2 |
| 2016-12-19 | 1482105600 | 604800 | 2016 | 2 | 4 | 12 | 11 | December | 19 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 19 | 80 | 354 | 4 | 51 | 51 | 1 | 0 | 3 | 3 |
| 2016-12-26 | 1482710400 | 604800 | 2016 | 2 | 4 | 12 | 11 | December | 26 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 26 | 87 | 361 | 5 | 52 | 52 | 0 | 1 | 0 | 4 |
| 2017-01-02 | 1483315200 | 604800 | 2017 | 1 | 1 | 1 | 0 | January | 2 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 2 | 2 | 2 | 1 | 1 | 1 | 1 | 1 | 1 | 1 |
| 2017-01-09 | 1483920000 | 604800 | 2017 | 1 | 1 | 1 | 0 | January | 9 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 9 | 9 | 9 | 2 | 2 | 2 | 0 | 2 | 2 | 2 |
| 2017-01-16 | 1484524800 | 604800 | 2017 | 1 | 1 | 1 | 0 | January | 16 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 16 | 16 | 16 | 3 | 3 | 3 | 1 | 0 | 3 | 3 |
| 2017-01-23 | 1485129600 | 604800 | 2017 | 1 | 1 | 1 | 0 | January | 23 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 23 | 23 | 23 | 4 | 4 | 4 | 0 | 1 | 0 | 4 |
| 2017-01-30 | 1485734400 | 604800 | 2017 | 1 | 1 | 1 | 0 | January | 30 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 30 | 30 | 30 | 5 | 5 | 5 | 1 | 2 | 1 | 5 |
| 2017-02-06 | 1486339200 | 604800 | 2017 | 1 | 1 | 2 | 1 | February | 6 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 6 | 37 | 37 | 2 | 6 | 6 | 0 | 0 | 2 | 1 |
| 2017-02-13 | 1486944000 | 604800 | 2017 | 1 | 1 | 2 | 1 | February | 13 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 13 | 44 | 44 | 3 | 7 | 7 | 1 | 1 | 3 | 2 |
| 2017-02-20 | 1487548800 | 604800 | 2017 | 1 | 1 | 2 | 1 | February | 20 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 20 | 51 | 51 | 4 | 8 | 8 | 0 | 2 | 0 | 3 |
| 2017-02-27 | 1488153600 | 604800 | 2017 | 1 | 1 | 2 | 1 | February | 27 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 27 | 58 | 58 | 5 | 9 | 9 | 1 | 0 | 1 | 4 |
| 2017-03-06 | 1488758400 | 604800 | 2017 | 1 | 1 | 3 | 2 | March | 6 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 6 | 65 | 65 | 2 | 10 | 10 | 0 | 1 | 2 | 1 |
| 2017-03-13 | 1489363200 | 604800 | 2017 | 1 | 1 | 3 | 2 | March | 13 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 13 | 72 | 72 | 3 | 11 | 11 | 1 | 2 | 3 | 2 |
| 2017-03-20 | 1489968000 | 604800 | 2017 | 1 | 1 | 3 | 2 | March | 20 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 20 | 79 | 79 | 4 | 12 | 12 | 0 | 0 | 0 | 3 |
| 2017-03-27 | 1490572800 | 604800 | 2017 | 1 | 1 | 3 | 2 | March | 27 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 27 | 86 | 86 | 5 | 13 | 13 | 1 | 1 | 1 | 4 |
| 2017-04-03 | 1491177600 | 604800 | 2017 | 1 | 2 | 4 | 3 | April | 3 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 3 | 3 | 93 | 2 | 14 | 14 | 0 | 2 | 2 | 1 |
| 2017-04-10 | 1491782400 | 604800 | 2017 | 1 | 2 | 4 | 3 | April | 10 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 10 | 10 | 100 | 3 | 15 | 15 | 1 | 0 | 3 | 2 |
| 2017-04-17 | 1492387200 | 604800 | 2017 | 1 | 2 | 4 | 3 | April | 17 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 17 | 17 | 107 | 4 | 16 | 16 | 0 | 1 | 0 | 3 |
| 2017-04-24 | 1492992000 | 604800 | 2017 | 1 | 2 | 4 | 3 | April | 24 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 24 | 24 | 114 | 5 | 17 | 17 | 1 | 2 | 1 | 4 |
| 2017-05-01 | 1493596800 | 604800 | 2017 | 1 | 2 | 5 | 4 | May | 1 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 1 | 31 | 121 | 6 | 18 | 18 | 0 | 0 | 2 | 1 |
| 2017-05-08 | 1494201600 | 604800 | 2017 | 1 | 2 | 5 | 4 | May | 8 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 8 | 38 | 128 | 2 | 19 | 19 | 1 | 1 | 3 | 2 |
| 2017-05-15 | 1494806400 | 604800 | 2017 | 1 | 2 | 5 | 4 | May | 15 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 15 | 45 | 135 | 3 | 20 | 20 | 0 | 2 | 0 | 3 |
| 2017-05-22 | 1495411200 | 604800 | 2017 | 1 | 2 | 5 | 4 | May | 22 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 22 | 52 | 142 | 4 | 21 | 21 | 1 | 0 | 1 | 4 |
| 2017-05-29 | 1496016000 | 604800 | 2017 | 1 | 2 | 5 | 4 | May | 29 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 29 | 59 | 149 | 5 | 22 | 22 | 0 | 1 | 2 | 5 |
| 2017-06-05 | 1496620800 | 604800 | 2017 | 1 | 2 | 6 | 5 | June | 5 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 5 | 66 | 156 | 2 | 23 | 23 | 1 | 2 | 3 | 1 |
| 2017-06-12 | 1497225600 | 604800 | 2017 | 1 | 2 | 6 | 5 | June | 12 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 12 | 73 | 163 | 3 | 24 | 24 | 0 | 0 | 0 | 2 |
| 2017-06-19 | 1497830400 | 604800 | 2017 | 1 | 2 | 6 | 5 | June | 19 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 19 | 80 | 170 | 4 | 25 | 25 | 1 | 1 | 1 | 3 |
| 2017-06-26 | 1498435200 | 604800 | 2017 | 1 | 2 | 6 | 5 | June | 26 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 26 | 87 | 177 | 5 | 26 | 26 | 0 | 2 | 2 | 4 |
| 2017-07-03 | 1499040000 | 604800 | 2017 | 2 | 3 | 7 | 6 | July | 3 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 3 | 3 | 184 | 2 | 27 | 27 | 1 | 0 | 3 | 1 |
| 2017-07-10 | 1499644800 | 604800 | 2017 | 2 | 3 | 7 | 6 | July | 10 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 10 | 10 | 191 | 3 | 28 | 28 | 0 | 1 | 0 | 2 |
| 2017-07-17 | 1500249600 | 604800 | 2017 | 2 | 3 | 7 | 6 | July | 17 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 17 | 17 | 198 | 4 | 29 | 29 | 1 | 2 | 1 | 3 |
| 2017-07-24 | 1500854400 | 604800 | 2017 | 2 | 3 | 7 | 6 | July | 24 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 24 | 24 | 205 | 5 | 30 | 30 | 0 | 0 | 2 | 4 |
| 2017-07-31 | 1501459200 | 604800 | 2017 | 2 | 3 | 7 | 6 | July | 31 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 31 | 31 | 212 | 6 | 31 | 31 | 1 | 1 | 3 | 5 |
| 2017-08-07 | 1502064000 | 604800 | 2017 | 2 | 3 | 8 | 7 | August | 7 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 7 | 38 | 219 | 2 | 32 | 32 | 0 | 2 | 0 | 2 |
| 2017-08-14 | 1502668800 | 604800 | 2017 | 2 | 3 | 8 | 7 | August | 14 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 14 | 45 | 226 | 3 | 33 | 33 | 1 | 0 | 1 | 3 |
| 2017-08-21 | 1503273600 | 604800 | 2017 | 2 | 3 | 8 | 7 | August | 21 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 21 | 52 | 233 | 4 | 34 | 34 | 0 | 1 | 2 | 4 |
| 2017-08-28 | 1503878400 | 604800 | 2017 | 2 | 3 | 8 | 7 | August | 28 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 28 | 59 | 240 | 5 | 35 | 35 | 1 | 2 | 3 | 5 |
| 2017-09-04 | 1504483200 | 604800 | 2017 | 2 | 3 | 9 | 8 | September | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 66 | 247 | 2 | 36 | 36 | 0 | 0 | 0 | 1 |
| 2017-09-11 | 1505088000 | 604800 | 2017 | 2 | 3 | 9 | 8 | September | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 73 | 254 | 3 | 37 | 37 | 1 | 1 | 1 | 2 |
| 2017-09-18 | 1505692800 | 604800 | 2017 | 2 | 3 | 9 | 8 | September | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 80 | 261 | 4 | 38 | 38 | 0 | 2 | 2 | 3 |
| 2017-09-25 | 1506297600 | 604800 | 2017 | 2 | 3 | 9 | 8 | September | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 87 | 268 | 5 | 39 | 39 | 1 | 0 | 3 | 4 |
| 2017-10-02 | 1506902400 | 604800 | 2017 | 2 | 4 | 10 | 9 | October | 2 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 2 | 2 | 275 | 1 | 40 | 40 | 0 | 1 | 0 | 1 |
| 2017-10-09 | 1507507200 | 604800 | 2017 | 2 | 4 | 10 | 9 | October | 9 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 9 | 9 | 282 | 2 | 41 | 41 | 1 | 2 | 1 | 2 |
| 2017-10-16 | 1508112000 | 604800 | 2017 | 2 | 4 | 10 | 9 | October | 16 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 16 | 16 | 289 | 3 | 42 | 42 | 0 | 0 | 2 | 3 |
| 2017-10-23 | 1508716800 | 604800 | 2017 | 2 | 4 | 10 | 9 | October | 23 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 23 | 23 | 296 | 4 | 43 | 43 | 1 | 1 | 3 | 4 |
| 2017-10-30 | 1509321600 | 604800 | 2017 | 2 | 4 | 10 | 9 | October | 30 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 30 | 30 | 303 | 5 | 44 | 44 | 0 | 2 | 0 | 5 |
| 2017-11-06 | 1509926400 | 604800 | 2017 | 2 | 4 | 11 | 10 | November | 6 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 6 | 37 | 310 | 2 | 45 | 45 | 1 | 0 | 1 | 1 |
| 2017-11-13 | 1510531200 | 604800 | 2017 | 2 | 4 | 11 | 10 | November | 13 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 13 | 44 | 317 | 3 | 46 | 46 | 0 | 1 | 2 | 2 |
| 2017-11-20 | 1511136000 | 604800 | 2017 | 2 | 4 | 11 | 10 | November | 20 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 20 | 51 | 324 | 4 | 47 | 47 | 1 | 2 | 3 | 3 |
| 2017-11-27 | 1511740800 | 604800 | 2017 | 2 | 4 | 11 | 10 | November | 27 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 27 | 58 | 331 | 5 | 48 | 48 | 0 | 0 | 0 | 4 |
| 2017-12-04 | 1512345600 | 604800 | 2017 | 2 | 4 | 12 | 11 | December | 4 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 4 | 65 | 338 | 2 | 49 | 49 | 1 | 1 | 1 | 1 |
| 2017-12-11 | 1512950400 | 604800 | 2017 | 2 | 4 | 12 | 11 | December | 11 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 11 | 72 | 345 | 3 | 50 | 50 | 0 | 2 | 2 | 2 |
| 2017-12-18 | 1513555200 | 604800 | 2017 | 2 | 4 | 12 | 11 | December | 18 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 18 | 79 | 352 | 4 | 51 | 51 | 1 | 0 | 3 | 3 |
| 2017-12-25 | 1514160000 | 604800 | 2017 | 2 | 4 | 12 | 11 | December | 25 | 0 | 0 | 0 | 0 | 1 | 2 | 1 | Monday | 25 | 86 | 359 | 5 | 52 | 52 | 0 | 1 | 0 | 4 |
#HW=HoltWinters(md_ts, gamma=FALSE, l.start=30, b.start=1)
modelseries=Durad%>%tidyr::drop_na()%>%tk_xts()
#modelseries=Durad%>%tk_xts()
modelseries%>%timetk::tk_tbl()%>%head()HW=HoltWinters(modelseries, gamma=FALSE, l.start=30, b.start=1)
sweep::sw_augment(HW)%>%head()%>%knitr::kable()| index | .actual | .fitted | .resid |
|---|---|---|---|
| 1 | 26 | NA | NA |
| 604801 | 27 | NA | NA |
| 1209601 | 28 | 31.00000 | -3.000000 |
| 1814401 | 22 | 29.48675 | -7.486751 |
| 2419201 | 27 | 24.11319 | 2.886813 |
| 3024001 | 31 | 27.17667 | 3.823332 |
Durad<-Durad%>%tidyr::drop_na()
Durad%>%dim()## [1] 100 2HWdata=cbind.data.frame(Date=Durad[,1],sweep::sw_augment(HW))
mycolors=c("red","black","blue")
HWdata%>%head()%>%knitr::kable()| Date | index | .actual | .fitted | .resid |
|---|---|---|---|---|
| 2016-01-11 | 1 | 26 | NA | NA |
| 2016-01-18 | 604801 | 27 | NA | NA |
| 2016-01-25 | 1209601 | 28 | 31.00000 | -3.000000 |
| 2016-02-01 | 1814401 | 22 | 29.48675 | -7.486751 |
| 2016-02-08 | 2419201 | 27 | 24.11319 | 2.886813 |
| 2016-02-15 | 3024001 | 31 | 27.17667 | 3.823332 |
HWdata%>%ggplot(aes(x=as.Date(Date)))+geom_line(aes(y=.actual,color="Actual Data"), size=1.5, linetype=1)+geom_line(aes(x=as.Date(Date),y=.fitted,color="Model Prediction on Data"),data=HWdata, size=1.5, linetype=1)+
labs(title = "Holtwinters Exponential smoothing model ", x = "Time",y=" Durability Vehicles")+
theme_bw() +
# remove legend title
theme(legend.title = element_blank()) +
#change the position of the legend
theme(legend.position="top") +
# Change the color of the title of the legend (name)
#theme(legend.title = element_text(color="chocolate", size=14, face="bold"))+
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 month"),
labels=date_format("%b %d %y")))+
geom_vline(xintercept=as.Date("2017-09-18"), linetype=2)+
geom_vline(xintercept=as.Date("2017-09-18"), linetype=2)+
#geom_point(aes(x =as.Date(Date), y = Actual, colour="Forecast"), data =dfuture, alpha = 0.5, size=1.5, linetype=1)+
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95), fill = "grey", alpha=0.5,data=dfuture)+
geom_smooth(aes(x =as.Date(Date), y = Actual,color="12 Week Forecast"), data =dfuture,
method = 'loess', size=1.5, linetype=1)+
scale_color_manual(values=mycolors)
Data<- rio::import("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actvsfcdatajuly311.xlsx",sheet="Sheet4")
tail(Data)modelseries=Data%>%tidyr::drop_na()%>%tk_ts()## Warning in tk_xts_.data.frame(ret, select = select, silent = silent): Non-
## numeric columns being dropped: Datetail(modelseries)## Time Series:
## Start = 97
## End = 102
## Frequency = 1
## [1] 58 56 51 52 52 55HW=HoltWinters(modelseries, gamma=FALSE, l.start=30, b.start=1)
sweep::sw_augment(HW)%>%head()%>%knitr::kable()| index | .actual | .fitted | .resid |
|---|---|---|---|
| 1 | 26 | NA | NA |
| 2 | 27 | NA | NA |
| 3 | 28 | 31.00000 | -3.000000 |
| 4 | 22 | 29.41425 | -7.414254 |
| 5 | 27 | 23.96552 | 3.034484 |
| 6 | 31 | 27.37868 | 3.621324 |
idx=Data%>%tk_index()%>%tk_get_timeseries_signature()
idx%>%tail()fc=forecast(HW,h=12)
md=tk_augment_timeseries_signature(Data)
md# Convert tibble to ts object with tk_ts()
md1=md%>%select(Date,Actual)
md_ts <- tk_ts(md1, silent = TRUE)
# get index from md tk_get_timeseries_signature()
md2=md%>% tk_index()
md2## [1] "2016-01-04 UTC" "2016-01-11 UTC" "2016-01-18 UTC" "2016-01-25 UTC"
## [5] "2016-02-01 UTC" "2016-02-08 UTC" "2016-02-15 UTC" "2016-02-22 UTC"
## [9] "2016-02-29 UTC" "2016-03-07 UTC" "2016-03-14 UTC" "2016-03-21 UTC"
## [13] "2016-03-28 UTC" "2016-04-04 UTC" "2016-04-11 UTC" "2016-04-18 UTC"
## [17] "2016-04-25 UTC" "2016-05-02 UTC" "2016-05-09 UTC" "2016-05-16 UTC"
## [21] "2016-05-23 UTC" "2016-05-30 UTC" "2016-06-06 UTC" "2016-06-13 UTC"
## [25] "2016-06-20 UTC" "2016-06-27 UTC" "2016-07-04 UTC" "2016-07-11 UTC"
## [29] "2016-07-18 UTC" "2016-07-25 UTC" "2016-08-01 UTC" "2016-08-08 UTC"
## [33] "2016-08-15 UTC" "2016-08-22 UTC" "2016-08-29 UTC" "2016-09-05 UTC"
## [37] "2016-09-12 UTC" "2016-09-19 UTC" "2016-09-26 UTC" "2016-10-03 UTC"
## [41] "2016-10-10 UTC" "2016-10-17 UTC" "2016-10-24 UTC" "2016-10-31 UTC"
## [45] "2016-11-07 UTC" "2016-11-14 UTC" "2016-11-21 UTC" "2016-11-28 UTC"
## [49] "2016-12-05 UTC" "2016-12-12 UTC" "2016-12-19 UTC" "2016-12-26 UTC"
## [53] "2017-01-02 UTC" "2017-01-09 UTC" "2017-01-16 UTC" "2017-01-23 UTC"
## [57] "2017-01-30 UTC" "2017-02-06 UTC" "2017-02-13 UTC" "2017-02-20 UTC"
## [61] "2017-02-27 UTC" "2017-03-06 UTC" "2017-03-13 UTC" "2017-03-20 UTC"
## [65] "2017-03-27 UTC" "2017-04-03 UTC" "2017-04-10 UTC" "2017-04-17 UTC"
## [69] "2017-04-24 UTC" "2017-05-01 UTC" "2017-05-08 UTC" "2017-05-15 UTC"
## [73] "2017-05-22 UTC" "2017-05-29 UTC" "2017-06-05 UTC" "2017-06-12 UTC"
## [77] "2017-06-19 UTC" "2017-06-26 UTC" "2017-07-03 UTC" "2017-07-10 UTC"
## [81] "2017-07-17 UTC" "2017-07-24 UTC" "2017-07-31 UTC" "2017-08-07 UTC"
## [85] "2017-08-14 UTC" "2017-08-21 UTC" "2017-08-28 UTC" "2017-09-04 UTC"
## [89] "2017-09-11 UTC" "2017-09-18 UTC" "2017-09-25 UTC" "2017-10-02 UTC"
## [93] "2017-10-09 UTC" "2017-10-16 UTC" "2017-10-23 UTC" "2017-10-30 UTC"
## [97] "2017-11-06 UTC" "2017-11-13 UTC" "2017-11-20 UTC" "2017-11-27 UTC"
## [101] "2017-12-04 UTC" "2017-12-11 UTC" "2017-12-18 UTC" "2017-12-25 UTC"
## [105] "2018-01-01 UTC" "2018-01-08 UTC"idx_future<-md2 %>%
tk_make_future_timeseries(n_future = 12)
idx_future%>%knitr::kable()## Warning in kable_markdown(x = structure(c("2018-01-15", "2018-01-22",
## "2018-01-29", : The table should have a header (column names)| 2018-01-15 |
| 2018-01-22 |
| 2018-01-29 |
| 2018-02-05 |
| 2018-02-12 |
| 2018-02-19 |
| 2018-02-26 |
| 2018-03-05 |
| 2018-03-12 |
| 2018-03-19 |
| 2018-03-26 |
| 2018-04-02 |
dfuture=data.frame(Date=idx_future,fc)%>%rename(Actual=Point.Forecast)
dfuture%>%knitr::kable()| Date | Actual | Lo.80 | Hi.80 | Lo.95 | Hi.95 | |
|---|---|---|---|---|---|---|
| 103 | 2018-01-15 | 55.13627 | 50.92773 | 59.34482 | 48.69986 | 61.57268 |
| 104 | 2018-01-22 | 55.65683 | 50.10076 | 61.21291 | 47.15956 | 64.15411 |
| 105 | 2018-01-29 | 56.17740 | 49.49699 | 62.85780 | 45.96060 | 66.39420 |
| 106 | 2018-02-05 | 56.69796 | 49.01688 | 64.37903 | 44.95077 | 68.44515 |
| 107 | 2018-02-12 | 57.21852 | 48.61640 | 65.82064 | 44.06271 | 70.37433 |
| 108 | 2018-02-19 | 57.73908 | 48.27156 | 67.20661 | 43.25975 | 72.21841 |
| 109 | 2018-02-26 | 58.25964 | 47.96766 | 68.55162 | 42.51942 | 73.99987 |
| 110 | 2018-03-05 | 58.78021 | 47.69498 | 69.86543 | 41.82681 | 75.73360 |
| 111 | 2018-03-12 | 59.30077 | 47.44666 | 71.15487 | 41.17148 | 77.43005 |
| 112 | 2018-03-19 | 59.82133 | 47.21773 | 72.42493 | 40.54579 | 79.09687 |
| 113 | 2018-03-26 | 60.34189 | 47.00442 | 73.67937 | 39.94398 | 80.73980 |
| 114 | 2018-04-02 | 60.86245 | 46.80379 | 74.92111 | 39.36159 | 82.36332 |
rio::export(dfuture, "/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/DurabilityHW.xlsx")
Data2<- rio::import("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actvsfcdatajuly311.xlsx",sheet="Sheet3")
#tail(Data2,20)
Data2%>%dplyr::filter(Week>=as.Date("2017-11-13"))%>%rename(Date=Week)->futd
#Data2[Data2$Week>=as.Date("2017-10-9"),]
futdboth=inner_join(futd,dfuture,by = "Date")
bothmycolors=c("red","black","blue")
#mycolors=c("#56ddc5","#ee3db7","#4699dd")
both%>%ggplot(aes(x=as.Date(Date)))+geom_line(aes(y=Actual.x,color="System Data"), size=1.5, linetype=1)+geom_line(aes(x=as.Date(Date),y=Actual.y,color="Model Prediction "),data=both, size=1.5, linetype=1)+
labs(title = "Holtwinters Exponential smoothing model ", x = "Time",y=" Durability Vehicles")+
theme_bw() +
# remove legend title
theme(legend.title = element_blank()) +
# define a custom background theme
#theme(panel.background = element_rect(fill = 'grey75')) +
#Make title bold and add a little space at the baseline (face, vjust)
#theme(plot.title = element_text(size=14, face="bold", vjust=2))+
#change the position of the legend
theme(legend.position="top") +
# Change the color of the title of the legend (name)
#theme(legend.title = element_text(color="chocolate", size=14, face="bold"))+
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 week"),
labels=date_format("%b %d %y")))+
# geom_vline(xintercept=as.Date("2017-09-18"), linetype=2)+
#geom_point(aes(x =as.Date(Date), y = Actual, colour="Forecast"), data =dfuture, alpha = 0.5, size=1.5, linetype=1)+
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95), fill = "grey", alpha=0.5,data=dfuture)+
#geom_smooth(aes(x =as.Date(Date), y = Actual,color="12 Week Forecast"), data =dfuture,
# method = 'loess', size=1.5, linetype=1)+
scale_color_manual(values=mycolors)
Impute Missing Values in Time Series
pacman::p_load(imputeTS)
Data<- rio::import("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actvsfcdatajuly311.xlsx",sheet="Sheet4")
Data1<-Data%>%filter(Date<"2017-09-25")
Data2<-Data%>%filter(Date>"2017-09-25")We can visualize the missing values.
plotNA.gapsize(Data%>%tk_ts())## Warning in tk_xts_.data.frame(ret, select = select, silent = silent): Non-
## numeric columns being dropped: Date
#plotNA.imputations(modelseries)
statsNA(Data%>%tk_ts())## Warning in tk_xts_.data.frame(ret, select = select, silent = silent): Non-
## numeric columns being dropped: Date## [1] "Length of time series:"
## [1] 106
## [1] "-------------------------"
## [1] "Number of Missing Values:"
## [1] 4
## [1] "-------------------------"
## [1] "Percentage of Missing Values:"
## [1] "3.77%"
## [1] "-------------------------"
## [1] "Stats for Bins"
## [1] " Bin 1 (27 values from 1 to 27) : 1 NAs (3.7%)"
## [1] " Bin 2 (27 values from 28 to 54) : 3 NAs (11.1%)"
## [1] " Bin 3 (27 values from 55 to 81) : 0 NAs (0%)"
## [1] " Bin 4 (25 values from 82 to 106) : 0 NAs (0%)"
## [1] "-------------------------"
## [1] "Longest NA gap (series of consecutive NAs)"
## [1] "2 in a row"
## [1] "-------------------------"
## [1] "Most frequent gap size (series of consecutive NA series)"
## [1] "1 NA in a row (occuring 2 times)"
## [1] "-------------------------"
## [1] "Gap size accounting for most NAs"
## [1] "2 NA in a row (occuring 1 times, making up for overall 2 NAs)"
## [1] "-------------------------"
## [1] "Overview NA series"
## [1] " 1 NA in a row: 2 times"
## [1] " 2 NA in a row: 1 times"plotNA.distributionBar(Data%>%tk_ts())## Warning in tk_xts_.data.frame(ret, select = select, silent = silent): Non-
## numeric columns being dropped: Date
plotNA.distribution(Data%>%tk_ts())## Warning in tk_xts_.data.frame(ret, select = select, silent = silent): Non-
## numeric columns being dropped: Date
Data$Actual[which(is.na(Data$Actual))]## [1] NA NA NA NA#
#Uses Kalman Smoothing on structural time series models (or on the state space representation of an arima model) for imputation
modelseries=Data1%>%tk_ts()## Warning in tk_xts_.data.frame(ret, select = select, silent = silent): Non-
## numeric columns being dropped: Datemodelseries=na.kalman(modelseries)
#plotNA.imputations(modelseries)HW=HoltWinters(modelseries, gamma=FALSE, l.start=30, b.start=1)
sweep::sw_augment(HW)%>%head()%>%knitr::kable()| index | .actual | .fitted | .resid |
|---|---|---|---|
| 1 | 26.08303 | NA | NA |
| 2 | 26.00000 | NA | NA |
| 3 | 27.00000 | 31.00000 | -4.0000000 |
| 4 | 28.00000 | 28.82716 | -0.8271632 |
| 5 | 22.00000 | 29.06474 | -7.0647398 |
| 6 | 27.00000 | 24.33263 | 2.6673706 |
fc=forecast(HW,h=15)
#### make prediction dates
idx_future<-Data1%>%tidyr::drop_na()%>%tk_zoo() %>% tk_index()%>%
tk_make_future_timeseries(n_future = 15)## Warning in tk_xts_.data.frame(data = data, select = select, date_var =
## date_var, : Non-numeric columns being dropped: Date## Using column `Date` for date_var.## Warning in if (!(tclass %in% c("yearmon", "yearqtr"))) lubridate::tz(ret)
## <- tzone: the condition has length > 1 and only the first element will be
## useddfuture=data.frame(Date=idx_future,fc)%>%rename(Actual=Point.Forecast)
rio::export(dfuture, "/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/DurabilityHW.xlsx")
## model on actual data prediction
HWdata=cbind.data.frame(Date=Data1%>%tk_index(),sweep::sw_augment(HW))
#Data%>%drop_na()%>%tk_index()%>%length()
#sweep::sw_augment(HW)%>%dim()
rio::export(dfuture, "/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/DurabilityHW.xlsx")mycolors=viridis_pal(option = "D")(4)
#mycolors=c("#2c3e50", "#e31a1c","#18BC9C")
HWdata%>%ggplot(aes(x=as.Date(Date)))+geom_line(aes(y=.actual,color="Actual Data"), size=1.5, linetype=1)+geom_line(aes(x=as.Date(Date),y=.fitted,color="Model fit on Data"),data=HWdata, size=1.5, linetype=1)+
labs(title = "Holtwinters Exponential smoothing model ", x = "Time",y=" Number of Vehicles")+
theme_tq() +
# remove legend title
theme(legend.title = element_blank()) +
#Make title bold and add a little space at the baseline (face, vjust)
#theme(plot.title = element_text(size=14, face="bold", vjust=2))+
#change the position of the legend
theme(legend.position="top") +
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 month"),
labels=date_format("%b %d %y")))+
scale_color_manual(values=mycolors)+
#scale_fill_manual(values = palette_light()[1:2])
#scale_fill_manual(values=viridis_pal(option = "D")(2))
geom_vline(xintercept=as.Date("2017-09-25"), linetype=2)+
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95), fill = "grey", alpha=0.5,data=dfuture)+
geom_line(aes(x =as.Date(Date), y = Actual,color="Actual after 09-25-2017"),data = Data2, size=1.5)+
geom_line(aes(x =as.Date(Date), y = Actual,color="12 Week Forecast"), data =dfuture, size=1.5, linetype=1)
#geom_smooth(aes(x =as.Date(Date), y = Actual,color="12 Week Forecast"), data =dfuture, method = 'loess', size=1.5, linetype=1)modelseries=Data%>%tk_ts()%>%na.kalman
HW=HoltWinters(modelseries, gamma=FALSE, l.start=30, b.start=1)
sweep::sw_augment(HW)%>%head()%>%knitr::kable()| index | .actual | .fitted | .resid |
|---|---|---|---|
| 1 | 26.08489 | NA | NA |
| 2 | 26.00000 | NA | NA |
| 3 | 27.00000 | 31.00000 | -4.0000000 |
| 4 | 28.00000 | 28.60785 | -0.6078459 |
| 5 | 22.00000 | 29.00733 | -7.0073257 |
| 6 | 27.00000 | 23.96688 | 3.0331232 |
fc=forecast(HW,h=12)
DataHW## Holt-Winters exponential smoothing with trend and without seasonal component.
##
## Call:
## HoltWinters(x = modelseries, gamma = FALSE, l.start = 30, b.start = 1)
##
## Smoothing parameters:
## alpha: 0.8267776
## beta : 0.02571534
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 54.5793089
## b 0.5229416fc## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 107 55.10225 50.97764 59.22686 48.79420 61.41030
## 108 55.62519 50.21712 61.03326 47.35426 63.89612
## 109 56.14813 49.65943 62.63683 46.22452 66.07174
## 110 56.67108 49.21482 64.12733 45.26772 68.07443
## 111 57.19402 48.84296 65.54507 44.42218 69.96586
## 112 57.71696 48.52175 66.91217 43.65410 71.77982
## 113 58.23990 48.23758 68.24222 42.94268 73.53712
## 114 58.76284 47.98143 69.54425 42.27410 75.25158
## 115 59.28578 47.74695 70.82462 41.63866 76.93291
## 116 59.80873 47.52950 72.08795 41.02927 78.58818
## 117 60.33167 47.32558 73.33776 40.44057 80.22276
## 118 60.85461 47.13248 74.57674 39.86842 81.84080#HWdata=cbind.data.frame(Date=Data%>%select(Date),sweep::sw_augment(HW))
HWdata=cbind.data.frame(Date=Data$Date ,sweep::sw_augment(HW))
#### make prediction dates
idx_future<-Data%>%tk_zoo() %>% tk_index()%>%
tk_make_future_timeseries(n_future = 12)
dfuture=data.frame(Date=idx_future,fc)%>%rename(Actual=Point.Forecast)
HWdata%>%ggplot(aes(x=as.Date(Date)))+geom_line(aes(y=.actual,color="Actual Data"), size=1.5, linetype=1)+geom_line(aes(x=as.Date(Date),y=.fitted,color="Model fit on Data"),data=HWdata, size=1.5, linetype=1)+
labs(title = "Holtwinters Exponential smoothing model ", x = "Time",y=" Number of Vehicles")+
theme_tq() +
# remove legend title
theme(legend.title = element_blank()) +
#Make title bold and add a little space at the baseline (face, vjust)
#theme(plot.title = element_text(size=14, face="bold", vjust=2))+
#change the position of the legend
theme(legend.position="top") +
theme(axis.text.x=element_text(angle=50, size=10, vjust=0.5))+
(scale_x_date(breaks=date_breaks("1 month"),
labels=date_format("%b %d %y")))+
scale_color_manual(values=mycolors)+
#scale_fill_manual(values = palette_light()[1:2])
#scale_fill_manual(values=viridis_pal(option = "D")(2))
geom_vline(xintercept=as.Date("2018-01-01"), linetype=2)+
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95), fill = "grey", alpha=0.5,data=dfuture)+
#geom_line(aes(x =as.Date(Date), y = Actual,color="Actual after #09-25-2017"),data = Data2, size=1.5)+
geom_line(aes(x =as.Date(Date), y = Actual,color="12 Week Forecast"), data =dfuture, size=1.5, linetype=1)