library(tidyverse)
library(timetk)
library(readxl)
library(tidyquant)
library(scales)
library(forecast)   #  forecasting pkg
library(sweep)# Broom tidiers for forecast pkg
library(DT)
library(timekit)
library(tseries)
library(stringr)
library(plotly)
library(viridisLite)
library(RColorBrewer)
library(viridis)
#install.packages("rsconnect")
rm(list=ls())
# modeldata=read_excel("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actfcdatajuly31.xlsx",sheet = "ModelData")
# modeldata%>%head()
#if removing NA from only week column
#filter(!is.na(week))
#filter(week!=NA)
#remove NA from all columns
# filter(complete.cases(.))
#drop_na()

modeldata=read_excel("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actvsfcdatajuly311.xlsx",sheet = "Sheet1")%>%rename(Date=Week)%>%na.omit()
modeldata%>%tail()%>%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 
Data<- rio::import("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actvsfcdatajuly311.xlsx",sheet="Sheet1")

Data%>%tail()
modeldata%>%tail()%>%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 
modeldata%>%summary()
##       Date                         Actual     
##  Min.   :2016-01-11 00:00:00   Min.   :21.00  
##  1st Qu.:2016-06-07 18:00:00   1st Qu.:27.00  
##  Median :2016-11-03 12:00:00   Median :30.00  
##  Mean   :2016-11-13 00:33:29   Mean   :29.57  
##  3rd Qu.:2017-04-22 06:00:00   3rd Qu.:32.00  
##  Max.   :2017-09-18 00:00:00   Max.   :40.00
dim(modeldata)
## [1] 86  2
glimpse(modeldata)
## 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,...
modeldata%>%mutate(Date=as.Date(Date))%>%summary()%>%knitr::kable()
Date Actual
Min. :2016-01-11 Min. :21.00
1st Qu.:2016-06-07 1st Qu.:27.00
Median :2016-11-03 Median :30.00
Mean :2016-11-13 Mean :29.57
3rd Qu.:2017-04-22 3rd Qu.:32.00
Max. :2017-09-18 Max. :40.00 
data1=read_excel("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/actfcdatajuly31.xlsx",sheet = "rawdata")
data1%>%head()%>%knitr::kable()
Week Act 4 and 8 wk model 8 wk model -2 wk fc -4 wk fc -6 wk fc -8 wk fc 4 and 8 wk model resid 8 wk model resids
2017-01-02 27 NA NA NA NA NA NA NA NA
2017-01-09 26 NA NA NA NA NA NA NA NA
2017-01-16 26 NA NA 27 NA NA NA NA NA
2017-01-23 25 NA NA 25 NA NA NA NA NA
2017-01-30 25 NA NA 26 28 NA NA NA NA
2017-02-06 22 NA NA 30 28 NA NA NA NA 
modeldata%>%mutate(Date=as.Date(Date))%>%ggplot(aes(Date,Actual))+geom_line()+
  
  theme_tq()+ geom_point(color = palette_light()[[1]], alpha = 0.5) +
  labs(title = "Durability Vehicles Forecasting", x = "Time", y = "Number of \n Durability Vehicles",
       subtitle = "data from 2016 & 2017") +
  scale_y_continuous(labels = scales::comma) +
  theme_tq()+
  scale_x_date(labels = date_format("%m-%d-%Y"))

# set all select to dplyr select to avoid conflicts with MASS::select package
select=dplyr::select


modeldata%>%mutate(Date=as.Date(Date))%>%ggplot(aes(Date,Actual))+geom_line()+
  
  theme_tq()+ geom_point( alpha = 0.5) +
 labs(title = "Durability Vehicles Forecasting", x = "Time", y = "Number of \n Durability Vehicles",
       subtitle = "data from 2016 & 2017") +
  scale_y_continuous(labels = scales::comma) +
  theme_bw()+
  
  scale_fill_manual(values = c("#FF5500","#A60021"))

modeldata%>%mutate(Date=as.Date(Date))%>%ggplot(aes(Date,Actual))+geom_line(col="#0055FF")+
  
  theme_tq()+ geom_point(color = "#0055FF", alpha = 0.5) +
  labs(title = "Durability Vehicles Forecasting", x = "Time", y = "Number of \n Durability Vehicles",
       subtitle = "data from 2016 & 2017") +
  scale_y_continuous(labels = scales::comma) +
  theme_tq()+
  scale_x_date(labels = date_format("%m-%d-%Y"))

# Augmenting a data frame

md=modeldata%>%mutate(YQ = as.yearqtr(Date))
md=tk_augment_timeseries_signature(md)
md%>%knitr::kable()
Date Actual YQ 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-11 26 2016 Q1 1452470400 NA 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 27 2016 Q1 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 28 2016 Q1 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 22 2016 Q1 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 27 2016 Q1 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 31 2016 Q1 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 26 2016 Q1 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 27 2016 Q1 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 21 2016 Q1 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 23 2016 Q1 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 25 2016 Q1 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 23 2016 Q1 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 23 2016 Q2 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 23 2016 Q2 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 23 2016 Q2 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 27 2016 Q2 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 31 2016 Q2 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 30 2016 Q2 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 33 2016 Q2 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 29 2016 Q2 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 29 2016 Q2 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 32 2016 Q2 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 31 2016 Q2 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 36 2016 Q2 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 37 2016 Q2 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 38 2016 Q3 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 39 2016 Q3 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 40 2016 Q3 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 35 2016 Q3 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 38 2016 Q3 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 32 2016 Q3 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 33 2016 Q3 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 29 2016 Q3 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 29 2016 Q3 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 27 2016 Q3 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 24 2016 Q3 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 23 2016 Q3 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 31 2016 Q3 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 32 2016 Q4 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 33 2016 Q4 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 30 2016 Q4 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 32 2016 Q4 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 33 2016 Q4 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 35 2016 Q4 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 32 2016 Q4 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-28 30 2016 Q4 1480291200 1209600 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 29 2016 Q4 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 27 2016 Q4 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
2017-01-02 27 2017 Q1 1483315200 1814400 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 26 2017 Q1 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 26 2017 Q1 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 25 2017 Q1 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 25 2017 Q1 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 22 2017 Q1 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 25 2017 Q1 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 26 2017 Q1 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 23 2017 Q1 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 25 2017 Q1 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 28 2017 Q1 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 28 2017 Q1 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 29 2017 Q1 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 30 2017 Q2 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 32 2017 Q2 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 36 2017 Q2 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 32 2017 Q2 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 27 2017 Q2 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 32 2017 Q2 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 28 2017 Q2 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 28 2017 Q2 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 30 2017 Q2 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 34 2017 Q2 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 32 2017 Q2 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 28 2017 Q2 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 34 2017 Q2 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 32 2017 Q3 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 35 2017 Q3 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 32 2017 Q3 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 30 2017 Q3 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 33 2017 Q3 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 33 2017 Q3 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 32 2017 Q3 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 30 2017 Q3 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 27 2017 Q3 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 32 2017 Q3 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 32 2017 Q3 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 36 2017 Q3 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 
idx=modeldata%>%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-11 1452470400 NA 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-28 1480291200 1209600 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
2017-01-02 1483315200 1814400 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 
modeldata %>%mutate(Date=as.Date(Date))%>%dplyr::select(Date)%>%tk_index() %>%
    tk_make_future_timeseries(n_future = 10, inspect_weekdays=TRUE)%>%
    tk_get_timeseries_signature()%>%
    ggplot(aes(x = index, y = diff)) +
    geom_line(color = palette_light()[[1]]) +
    theme_tq() +
    labs(title = "Simple Test: Frequency of predection with inspect_weekdays = T", 
         subtitle = "Catches missing weekends only") 

modeldata %>%dplyr::select(Date)%>%tk_index()%>%
    tk_get_timeseries_signature() %>%
    ggplot(aes(x = index, y = diff)) +
    geom_line(color = palette_light()[[1]]) +
    theme_tq() +
    labs(title = "Simple Test: Frequency of test set", 
         subtitle = "Missing weekends and missing last two weeks of year") 

# Convert tibble to ts object with tk_ts()

md1=md%>%select(Date,Actual)
  
md_ts <- tk_ts(md1, silent = TRUE)
                                   
md_ts%>%head
## Time Series:
## Start = 1 
## End = 6 
## Frequency = 1 
## [1] 26 27 28 22 27 31
# Model using auto.arima()
fit_arima <- md_ts%>%auto.arima()
fit_arima
## Series: . 
## ARIMA(1,0,0) with non-zero mean 
## 
## Coefficients:
##          ar1     mean
##       0.7568  29.6663
## s.e.  0.0706   1.2068
## 
## sigma^2 estimated as 8.128:  log likelihood=-211.54
## AIC=429.08   AICc=429.38   BIC=436.45
summary(fit_arima)
## Series: . 
## ARIMA(1,0,0) with non-zero mean 
## 
## Coefficients:
##          ar1     mean
##       0.7568  29.6663
## s.e.  0.0706   1.2068
## 
## sigma^2 estimated as 8.128:  log likelihood=-211.54
## AIC=429.08   AICc=429.38   BIC=436.45
## 
## Training set error measures:
##                      ME     RMSE     MAE        MPE     MAPE      MASE
## Training set 0.04700811 2.817666 2.31699 -0.7920474 7.948308 0.9654125
##                    ACF1
## Training set -0.1084783
# sw_glance for model accuracy
sw_glance(fit_arima)
#sw_glance(fit_arima)%>%DT::datatable()
# Ten period forecast 
fcast <- forecast(fit_arima, h = 12)
fcast=fcast%>%as.tibble()
names(fcast)
## [1] "Point Forecast" "Lo 80"          "Hi 80"          "Lo 95"         
## [5] "Hi 95"
m=as_vector(modeldata["Actual"])
tseries::adf.test(m, alternative="stationary", k=0)
## 
##  Augmented Dickey-Fuller Test
## 
## data:  m
## Dickey-Fuller = -3.4235, Lag order = 0, p-value = 0.05678
## alternative hypothesis: stationary

The series is not stationary(p-value=0.07492).

tseries::adf.test(diff(log(m)), alternative="stationary", k=0)
## Warning in tseries::adf.test(diff(log(m)), alternative = "stationary", k =
## 0): p-value smaller than printed p-value
## 
##  Augmented Dickey-Fuller Test
## 
## data:  diff(log(m))
## Dickey-Fuller = -11.466, Lag order = 0, p-value = 0.01
## alternative hypothesis: stationary
pred <- predict(fit_arima, n.ahead = 12)
pred
## $pred
## Time Series:
## Start = 87 
## End = 98 
## Frequency = 1 
##  [1] 34.45944 33.29360 32.41133 31.74365 31.23838 30.85601 30.56664
##  [8] 30.34766 30.18194 30.05653 29.96162 29.88980
## 
## $se
## Time Series:
## Start = 87 
## End = 98 
## Frequency = 1 
##  [1] 2.851012 3.575373 3.930547 4.120188 4.224964 4.283814 4.317156
##  [8] 4.336135 4.346967 4.353159 4.356700 4.358727
# Holtwinters forcasting

manforcast=HoltWinters(ts(modeldata), beta=FALSE, gamma=FALSE)

manforcast
## Holt-Winters exponential smoothing without trend and without seasonal component.
## 
## Call:
## HoltWinters(x = ts(modeldata), beta = FALSE, gamma = FALSE)
## 
## Smoothing parameters:
##  alpha: 0.9996125
##  beta : FALSE
##  gamma: FALSE
## 
## Coefficients:
##       [,1]
## a 35.99845
plot(manforcast$fitted)

#predd=forecast.HoltWinters(manforcast,h=10)

#predd
#HoltWinters(rainseries, beta=FALSE, gamma=FALSE)

#forecast(manforcast)

#manforcast%>%forecast(h=12,level=c(90,95))

md_ts%>%HoltWinters( beta=FALSE, gamma=FALSE)%>%forecast(h=12,level=c(90,95))%>%tk_tbl()%>%knitr::kable()
index Point Forecast Lo 90 Hi 90 Lo 95 Hi 95
87 34.78752 30.00018 39.57485 29.08305 40.49198
88 34.78752 28.89128 40.68375 27.76172 41.81331
89 34.78752 27.96018 41.61485 26.65224 42.92279
90 34.78752 27.14164 42.43340 25.67689 43.89814
91 34.78752 26.40262 43.17241 24.79630 44.77873
92 34.78752 25.72366 43.85137 23.98727 45.58776
93 34.78752 25.09214 44.48289 23.23476 46.34027
94 34.78752 24.49930 45.07573 22.52835 47.04668
95 34.78752 23.93882 45.63622 21.86049 47.71454
96 34.78752 23.40590 46.16914 21.22548 48.34955
97 34.78752 22.89684 46.67819 20.61890 48.95613
98 34.78752 22.40870 47.16634 20.03724 49.53779 
tk_index(fit_arima)
##  [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
## [24] 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
## [47] 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
## [70] 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
tk_index(fit_arima)
##  [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
## [24] 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
## [47] 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
## [70] 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
md_ts%>%auto.arima()%>%forecast()%>%autoplot()+
  labs(title = "Durability Vehicles Forecasting", x = "Time", y = "Number of \n Durability Vehicles",
       subtitle = "data from 2016 & 2017") +
  
  theme_tq()

# get index from md tk_get_timeseries_signature()

md2=md%>% tk_index()
md2
##  [1] "2016-01-11 UTC" "2016-01-18 UTC" "2016-01-25 UTC" "2016-02-01 UTC"
##  [5] "2016-02-08 UTC" "2016-02-15 UTC" "2016-02-22 UTC" "2016-02-29 UTC"
##  [9] "2016-03-07 UTC" "2016-03-14 UTC" "2016-03-21 UTC" "2016-03-28 UTC"
## [13] "2016-04-04 UTC" "2016-04-11 UTC" "2016-04-18 UTC" "2016-04-25 UTC"
## [17] "2016-05-02 UTC" "2016-05-09 UTC" "2016-05-16 UTC" "2016-05-23 UTC"
## [21] "2016-05-30 UTC" "2016-06-06 UTC" "2016-06-13 UTC" "2016-06-20 UTC"
## [25] "2016-06-27 UTC" "2016-07-04 UTC" "2016-07-11 UTC" "2016-07-18 UTC"
## [29] "2016-07-25 UTC" "2016-08-01 UTC" "2016-08-08 UTC" "2016-08-15 UTC"
## [33] "2016-08-22 UTC" "2016-08-29 UTC" "2016-09-05 UTC" "2016-09-12 UTC"
## [37] "2016-09-19 UTC" "2016-09-26 UTC" "2016-10-03 UTC" "2016-10-10 UTC"
## [41] "2016-10-17 UTC" "2016-10-24 UTC" "2016-10-31 UTC" "2016-11-07 UTC"
## [45] "2016-11-14 UTC" "2016-11-28 UTC" "2016-12-05 UTC" "2016-12-12 UTC"
## [49] "2017-01-02 UTC" "2017-01-09 UTC" "2017-01-16 UTC" "2017-01-23 UTC"
## [53] "2017-01-30 UTC" "2017-02-06 UTC" "2017-02-13 UTC" "2017-02-20 UTC"
## [57] "2017-02-27 UTC" "2017-03-06 UTC" "2017-03-13 UTC" "2017-03-20 UTC"
## [61] "2017-03-27 UTC" "2017-04-03 UTC" "2017-04-10 UTC" "2017-04-17 UTC"
## [65] "2017-04-24 UTC" "2017-05-01 UTC" "2017-05-08 UTC" "2017-05-15 UTC"
## [69] "2017-05-22 UTC" "2017-05-29 UTC" "2017-06-05 UTC" "2017-06-12 UTC"
## [73] "2017-06-19 UTC" "2017-06-26 UTC" "2017-07-03 UTC" "2017-07-10 UTC"
## [77] "2017-07-17 UTC" "2017-07-24 UTC" "2017-07-31 UTC" "2017-08-07 UTC"
## [81] "2017-08-14 UTC" "2017-08-21 UTC" "2017-08-28 UTC" "2017-09-04 UTC"
## [85] "2017-09-11 UTC" "2017-09-18 UTC"
idx_future<-md2 %>%
    tk_make_future_timeseries(n_future = 12)
idx_future
##  [1] "2017-09-25 UTC" "2017-10-02 UTC" "2017-10-09 UTC" "2017-10-16 UTC"
##  [5] "2017-10-23 UTC" "2017-10-30 UTC" "2017-11-06 UTC" "2017-11-13 UTC"
##  [9] "2017-11-20 UTC" "2017-11-27 UTC" "2017-12-04 UTC" "2017-12-11 UTC"
idx_future<-md2 %>%
    tk_make_future_timeseries(n_future = 12) 

#idx_future


pred_dat=cbind.data.frame(idx_future,fcast)%>%mutate(Date=as.Date(idx_future))

#pred_dat

#colnames(pred_dat)=gsub('([[:punct:]])|\\s+','_',colnames(pred_dat))


#=============================================================================================
# remove white spaces in column names
#=============================================================================================

# This aproach replaces the white spaces in the name with a period

#colnames(pred_dat)=make.names(names(pred_dat) ,unique= TRUE)








# This aproach replaces the white spaces in the name with a an underscore

names(pred_dat)<-gsub("\\s", "_", names(pred_dat))

#Alternatively

#names(pred_dat)%>%str_replace_all("\\s", "_")

pred_dat<-pred_dat%>%rename(Actual=Point_Forecast)
pred_dat%>%knitr::kable()
idx_future Actual Lo_80 Hi_80 Lo_95 Hi_95 Date
2017-09-25 34.45944 30.80572 38.11316 28.87156 40.04732 2017-09-25
2017-10-02 33.29360 28.71157 37.87562 26.28599 40.30120 2017-10-02
2017-10-09 32.41132 27.37413 37.44852 24.70759 40.11506 2017-10-09
2017-10-16 31.74365 26.46342 37.02389 23.66823 39.81907 2017-10-16
2017-10-23 31.23838 25.82387 36.65289 22.95760 39.51916 2017-10-23
2017-10-30 30.85601 25.36608 36.34593 22.45989 39.25213 2017-10-30
2017-11-06 30.56664 25.03398 36.09930 22.10517 39.02811 2017-11-06
2017-11-13 30.34766 24.79068 35.90464 21.84899 38.84632 2017-11-13
2017-11-20 30.18194 24.61107 35.75280 21.66204 38.70184 2017-11-20
2017-11-27 30.05653 24.47773 35.63532 21.52449 38.58856 2017-11-27
2017-12-04 29.96162 24.37828 35.54496 21.42264 38.50060 2017-12-04
2017-12-11 29.88980 24.30386 35.47573 21.34685 38.43275 2017-12-11 
Date=as.tibble(idx_future)%>%rename(Date=value)
Date
fcast=fcast%>%as.tibble()

fcast
bind_cols(Date,fcast)%>%knitr::kable()
Date Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
2017-09-25 34.45944 30.80572 38.11316 28.87156 40.04732
2017-10-02 33.29360 28.71157 37.87562 26.28599 40.30120
2017-10-09 32.41132 27.37413 37.44852 24.70759 40.11506
2017-10-16 31.74365 26.46342 37.02389 23.66823 39.81907
2017-10-23 31.23838 25.82387 36.65289 22.95760 39.51916
2017-10-30 30.85601 25.36608 36.34593 22.45989 39.25213
2017-11-06 30.56664 25.03398 36.09930 22.10517 39.02811
2017-11-13 30.34766 24.79068 35.90464 21.84899 38.84632
2017-11-20 30.18194 24.61107 35.75280 21.66204 38.70184
2017-11-27 30.05653 24.47773 35.63532 21.52449 38.58856
2017-12-04 29.96162 24.37828 35.54496 21.42264 38.50060
2017-12-11 29.88980 24.30386 35.47573 21.34685 38.43275 
pred_dat1=pred_dat%>%select(Lo_80,Hi_80,Lo_95,Hi_95)
 
modeldata%>%ggplot(aes(Date,Actual))+
  
  labs(y="Number of \nDurability Vehicles")+

   
    geom_point(alpha = 0.5, color = palette_light()[[1]]) +
   labs(title = "Durability Vehicles Forecasting", x = "Time", y = "Number of \n Durability Vehicles",
       subtitle = "data from 2016 & 2017")

      #geom_ribbon(aes(ymin = Lo_95, ymax = Hi_95), data = pred_dat1, 
    #              fill = "#D5DBFF", color = NA, size = 0) 
    # 
    # geom_ribbon(aes(ymin = Hi_80, ymax = Hi_80), data = pred_dat,
    #             fill = "#596DD5", color = NA, size = 0, alpha = 0.8) +
    # 
    # geom_point(aes(x = Date, y = Actual), data = pred_dat,
    #            alpha = 0.5, color = palette_light()[[2]]) +
    # 
    # geom_smooth(aes(x = Date, y = Actual), data = pred_dat,
    #             method = 'loess', color = "white") +
    # 
    # labs(title = "10 week Driver Forecast with Prediction Intervals", x = "") +
    # 
    # theme_tq()
# Extract bikes index
idx <- md %>%
    tk_index()

# Get time series summary from index
idx_summary <- idx %>%
    tk_get_timeseries_summary()

idx_summary
#forecast next 10 time points
idx_future <- idx %>%
    tk_make_future_timeseries(n_future = 12)
idx_future
##  [1] "2017-09-25 UTC" "2017-10-02 UTC" "2017-10-09 UTC" "2017-10-16 UTC"
##  [5] "2017-10-23 UTC" "2017-10-30 UTC" "2017-11-06 UTC" "2017-11-13 UTC"
##  [9] "2017-11-20 UTC" "2017-11-27 UTC" "2017-12-04 UTC" "2017-12-11 UTC"
data_future <- idx_future %>%
    tk_get_timeseries_signature() %>%
    rename(date = index)
data_future%>%knitr::kable()
date 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
2017-09-25 1506297600 NA 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 
test_augmented <- md %>%
    tk_augment_timeseries_signature()
test_augmented%>%head()%>%knitr::kable()
Date Actual YQ 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 index.num1 diff1 year1 half1 quarter1 month1 month.xts1 month.lbl1 day1 hour1 minute1 second1 hour121 am.pm1 wday1 wday.xts1 wday.lbl1 mday1 qday1 yday1 mweek1 week1 week.iso1 week21 week31 week41 mday71
2016-01-11 26 2016 Q1 1452470400 NA 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 1452470400 NA 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 27 2016 Q1 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 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 28 2016 Q1 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 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 22 2016 Q1 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 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 27 2016 Q1 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 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 31 2016 Q1 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 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 
pred_future <- predict(fit_arima, newdata = data_future, n.ahead = 12)
(pred_future$pred[1:12])
##  [1] 34.45944 33.29360 32.41133 31.74365 31.23838 30.85601 30.56664
##  [8] 30.34766 30.18194 30.05653 29.96162 29.88980
pred_future
## $pred
## Time Series:
## Start = 87 
## End = 98 
## Frequency = 1 
##  [1] 34.45944 33.29360 32.41133 31.74365 31.23838 30.85601 30.56664
##  [8] 30.34766 30.18194 30.05653 29.96162 29.88980
## 
## $se
## Time Series:
## Start = 87 
## End = 98 
## Frequency = 1 
##  [1] 2.851012 3.575373 3.930547 4.120188 4.224964 4.283814 4.317156
##  [8] 4.336135 4.346967 4.353159 4.356700 4.358727
pred_test <- data_future %>%
    add_column(yhat = pred_future$pred[1:12]) 

pred_test%>%knitr::kable()
date 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 yhat
2017-09-25 1506297600 NA 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 34.45944
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 33.29360
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 32.41132
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 31.74365
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 31.23838
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 30.85601
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 30.56664
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 30.34766
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 30.18194
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 30.05653
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 29.96162
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 29.88980 
# sw_glance for model accuracy
sw_glance(fit_arima)
# Three period forecast 
fcast <- forecast(fit_arima, h = 3)
fcast%>%knitr::kable()
87 34.45944 30.80572 38.11316 28.87156 40.04732
88 33.29360 28.71157 37.87562 26.28599 40.30120
89 32.41132 27.37413 37.44852 24.70759 40.11506 
# Getting a tidy forecast :)
#ne_sweep <- sw_sweep(fcast, timekit_idx = TRUE)
#ne_sweep

Forecasting

Let’s use our model to predict What are the expected future values for the next six months. The first step is to create the date sequence. Let’s use tk_get_timeseries_summary() to review the summary of the dates from the original dataset, “bikes”.

# to make this observed values and forecasted values
# combine (x,y) observed and forecasted value by cbind or bind_col into one data


modeldata1=modeldata%>%mutate(Date=as.Date(Date))


pred_test1=pred_test%>%select(yhat,date)%>%rename(Date=date,Actual=yhat)%>%mutate(method="Forecast")%>%mutate(Date=as.Date(Date))

modeldata3=modeldata%>%mutate(method="Actual")%>%mutate(Date=as.Date(Date))

modeldata2=bind_rows(modeldata3,pred_test1)

modeldata2%>%knitr::kable()
Date Actual method
2016-01-11 26.00000 Actual
2016-01-18 27.00000 Actual
2016-01-25 28.00000 Actual
2016-02-01 22.00000 Actual
2016-02-08 27.00000 Actual
2016-02-15 31.00000 Actual
2016-02-22 26.00000 Actual
2016-02-29 27.00000 Actual
2016-03-07 21.00000 Actual
2016-03-14 23.00000 Actual
2016-03-21 25.00000 Actual
2016-03-28 23.00000 Actual
2016-04-04 23.00000 Actual
2016-04-11 23.00000 Actual
2016-04-18 23.00000 Actual
2016-04-25 27.00000 Actual
2016-05-02 31.00000 Actual
2016-05-09 30.00000 Actual
2016-05-16 33.00000 Actual
2016-05-23 29.00000 Actual
2016-05-30 29.00000 Actual
2016-06-06 32.00000 Actual
2016-06-13 31.00000 Actual
2016-06-20 36.00000 Actual
2016-06-27 37.00000 Actual
2016-07-04 38.00000 Actual
2016-07-11 39.00000 Actual
2016-07-18 40.00000 Actual
2016-07-25 35.00000 Actual
2016-08-01 38.00000 Actual
2016-08-08 32.00000 Actual
2016-08-15 33.00000 Actual
2016-08-22 29.00000 Actual
2016-08-29 29.00000 Actual
2016-09-05 27.00000 Actual
2016-09-12 24.00000 Actual
2016-09-19 23.00000 Actual
2016-09-26 31.00000 Actual
2016-10-03 32.00000 Actual
2016-10-10 33.00000 Actual
2016-10-17 30.00000 Actual
2016-10-24 32.00000 Actual
2016-10-31 33.00000 Actual
2016-11-07 35.00000 Actual
2016-11-14 32.00000 Actual
2016-11-28 30.00000 Actual
2016-12-05 29.00000 Actual
2016-12-12 27.00000 Actual
2017-01-02 27.00000 Actual
2017-01-09 26.00000 Actual
2017-01-16 26.00000 Actual
2017-01-23 25.00000 Actual
2017-01-30 25.00000 Actual
2017-02-06 22.00000 Actual
2017-02-13 25.00000 Actual
2017-02-20 26.00000 Actual
2017-02-27 23.00000 Actual
2017-03-06 25.00000 Actual
2017-03-13 28.00000 Actual
2017-03-20 28.00000 Actual
2017-03-27 29.00000 Actual
2017-04-03 30.00000 Actual
2017-04-10 32.00000 Actual
2017-04-17 36.00000 Actual
2017-04-24 32.00000 Actual
2017-05-01 27.00000 Actual
2017-05-08 32.00000 Actual
2017-05-15 28.00000 Actual
2017-05-22 28.00000 Actual
2017-05-29 30.00000 Actual
2017-06-05 34.00000 Actual
2017-06-12 32.00000 Actual
2017-06-19 28.00000 Actual
2017-06-26 34.00000 Actual
2017-07-03 32.00000 Actual
2017-07-10 35.00000 Actual
2017-07-17 32.00000 Actual
2017-07-24 30.00000 Actual
2017-07-31 33.00000 Actual
2017-08-07 33.00000 Actual
2017-08-14 32.00000 Actual
2017-08-21 30.00000 Actual
2017-08-28 27.00000 Actual
2017-09-04 32.00000 Actual
2017-09-11 32.00000 Actual
2017-09-18 36.00000 Actual
2017-09-25 34.45944 Forecast
2017-10-02 33.29360 Forecast
2017-10-09 32.41132 Forecast
2017-10-16 31.74365 Forecast
2017-10-23 31.23838 Forecast
2017-10-30 30.85601 Forecast
2017-11-06 30.56664 Forecast
2017-11-13 30.34766 Forecast
2017-11-20 30.18194 Forecast
2017-11-27 30.05653 Forecast
2017-12-04 29.96162 Forecast
2017-12-11 29.88980 Forecast 
modeldata2%>%ggplot(aes(Date,Actual))+

    geom_rect(xmin = as.numeric(ymd("2017-08-21")),
              xmax = as.numeric(ymd("2017-12-23")),
              ymin = 20, ymax = 45,
              fill = palette_light()[[4]], alpha = 0.01) +

    annotate("text", x = ymd("2016-03-17"), y = 38,
             color = palette_light()[[1]], label = "Observed") +
  
  annotate("text", x = ymd("2017-10-17"), y = 40,
             color = palette_light()[[1]], label = "Forecast") +

    geom_point(aes(x = Date, y = Actual), data = modeldata2, alpha = 0.5, color=palette_light()[[1]]) +
  
   geom_ribbon(aes(ymin = Lo_95, ymax = Hi_95), data = pred_dat, 
                fill = "#D5DBFF", color = NA, size = 0) +
    geom_ribbon(aes(ymin = Lo_80, ymax = Hi_80, fill = key), data = pred_dat,
                fill = "#596DD5", color = NA, size = 0, alpha = 0.8)+
  
   geom_point(aes(x = Date, y = Actual), data =pred_test1, alpha = 0.5, color=palette_light()[[2]]) +
  
   geom_smooth(aes(x = Date, y = Actual), data = pred_test1,
                method = 'loess')+
  
   labs(title = "Durability Vehicles Forecasting with Prediction Intervals", x = "Time", y = "Number of \n Durability Vehicles",
       subtitle = "data from 2016 & 2017")+
  
    theme_tq()

ggsave("/Users/nanaakwasiabayieboateng/Documents/memphisclassesbooks/Time series/Manpower/Time.pdf")
## Saving 7 x 5 in image
p=modeldata2%>%ggplot(aes(Date,Actual))+

    geom_rect(xmin = as.numeric(ymd("2017-08-21")),
              xmax = as.numeric(ymd("2017-12-23")),
              ymin = 20, ymax = 45,
              fill = palette_light()[[4]], alpha = 0.01) +

    annotate("text", x = ymd("2016-03-17"), y = 38,
             color = palette_light()[[1]], label = "Observed") +
  
  annotate("text", x = ymd("2017-10-17"), y = 40,
             color = palette_light()[[1]], label = "Forecast") +

    geom_point(aes(x = Date, y = Actual), data = modeldata2, alpha = 0.5, color=palette_light()[[1]]) +
  
   geom_ribbon(aes(ymin = Lo_95, ymax = Hi_95), data = pred_dat, 
                fill = "#D5DBFF", color = NA, size = 0) +
    geom_ribbon(aes(ymin = Lo_80, ymax = Hi_80, fill = key), data = pred_dat,
                fill = "#596DD5", color = NA, size = 0, alpha = 0.8)+
  
   geom_point(aes(x = Date, y = Actual), data =pred_test1, alpha = 0.5, color=palette_light()[[2]]) +
  
   geom_smooth(aes(x = Date, y = Actual), data = pred_test1,
                method = 'loess')+
    labs(title = "Durability Vehicles Forecasting with Prediction Intervals", x = "Time", y = " Durability Vehicles",
       subtitle = "data from 2016 & 2017")+

    theme_tq()



ggplotly(p)
modeldata2%>%mutate(method=as.factor(method))%>%head()
modeldata2%>%ggplot(aes(x=Date,y=Actual,color=method))+geom_line()+geom_point()+  labs(title = "Durability Vehicles Forecasting with Prediction Intervals", x = "Time", y = "Number of \n Durability Vehicles",
       subtitle = "data from 2016 & 2017")

Plot Model, Fitted and Forecast

ARIMA Model
#fc<-ArimaModel%>%forecast(h=100,level=c(90,95))

fc=md_ts%>%auto.arima()%>%forecast(h=12,level=c(90,95))

autoplot(md_ts,series="Data")+autolayer(fc,series="Forecast")+
  autolayer(fitted(fc),series="Fitted")+autolayer(md_ts,series="Data")+theme_bw()+
    labs(title = "Predicted Values vs Observed values", x = "Time",y="Durability Vehicles")

Plot Model, Fitted and Forecast

Holt Winters Model
fc=md_ts%>%HoltWinters( beta=FALSE, gamma=FALSE)%>%forecast(h=12,level=c(90,95))


autoplot(md_ts,series="Data")+autolayer(fc,series="Forecast")+
  autolayer(fitted(fc),series="Fitted")+autolayer(md_ts,series="Data")+theme_bw()+
    labs(title = "Predicted,Observed ,Forecast values", x = "Time",y="Durability Vehicles")

class(modeldata)
## [1] "tbl_df"     "tbl"        "data.frame"