-
Notifications
You must be signed in to change notification settings - Fork 1
/
load_daily.R
138 lines (94 loc) · 3.13 KB
/
load_daily.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
library(forecast)
library(tseries)
library(lubridate)
blue <- read_csv('export_blue.csv')
agg <- setNames(aggregate(blue$value_sell, by=list(as.Date(blue$date)), FUN=mean), c('date', 'x'))
days <- data.frame ( date = as.Date(seq.POSIXt(ymd(min(agg$date)), ymd(max(agg$date)), by = "1 day")))
final <- na.locf(merge(days, agg, by="date", all.x=TRUE))
final$x <- as.numeric(final$x)
offset = 730
numtest = round(sqrt(length(final$x)-offset))
numbase = length(final$x)-numtest
base = final[offset:numbase,]
test = final[(numbase+1):length(final$x),]
basedate = min(ymd(base$date))
testdate = min(ymd(test$date))
bts <- ts(base$x, start=c(year(basedate), yday(basedate)), frequency=365)
tts <- ts(test$x, start=c(year(testdate), yday(testdate)), frequency=365)
plot(bts)
plot(tts)
picos_data = data.frame(
# p1=as.numeric(seq (bts) %in% c(1319:1406)),
# p2=as.numeric(seq (bts) %in% c(1088:1194)),
# p3=as.numeric(seq (bts) %in% c(821:872))
p1=as.numeric(seq (bts) == 1319 - offset),
p2=as.numeric(seq (bts) == 1088 - offset),
p3=as.numeric(seq (bts) == 821 - offset)
)
picos = as.matrix(picos_data)
seasonal <- stl(bts, s.window=4)
plot(seasonal)
monthplot(seasonal$time.series[,"seasonal"], main="", ylab="Seasonal")
plot(bts, col="grey")
lines(seasadj(seasonal),col="red",ylab="Seasonally adjusted")
eeadj <- seasadj(seasonal)
fcast_season <- forecast(seasonal, method="naive")
plot(fcast_season)
lines(tts, col="purple", lwd=2)
plot(bts)
lines(ma(bts,3),col="red")
dec <- decompose(bts, type="multiplicative")
plot(dec)
tsdisplay(bts)
tsdisplay(diff(bts,30))
tsdisplay(diff(diff(bts,30)))
tsdisplay(diff(diff(diff(bts,30))))
plot(diff(log(bts),7))
adf.test(bts, alternative = "stationary")
ns <- nsdiffs(bts)
fit <- Arima(bts, order=c(2,1,2), include.drift=TRUE, method="ML")
summary(fit)
tsdiag(fit)
plot(residuals(fit))
Box.test(residuals(fit), lag=60, fitdf=4, type="Ljung")
fcast <- forecast(fit, h=30)
plot(fcast)
lines(tts, col="purple", lwd=2)
resid <-residuals(fit)
ks.test(resid, 'pnorm', mean(resid), sd(resid))
fit_arima <- auto.arima(bts, d=1,approximation=FALSE, trace=TRUE)
summary(fit_arima)
plot(fit_arima$x,col="red")
lines(fitted(fit_arima),col="blue")
fcast_arima <- forecast(fit_arima, h=30 )
plot(fit_arima$residuals)
ac_arima <- accuracy(fcast_arima, tts)
ac_arima
plot(fcast_arima)
lines(tts, col="purple", lwd=2)
resid <-residuals(fit_arima)
Box.test(resid, lag=60, fitdf=4, type="Ljung")
ks.test(resid, 'pnorm', mean(resid), sd(resid))
fit_ets <- stlf(bts, method="rwdrift", h=30, s.window="periodic")
fcast_ets <- forecast(fit_ets, n.head=30)
summary(fit_ets)
plot(fcast_ets)
lines(tts, col="purple", lwd=2)
plot(fit_ets$x,col="red")
lines(fitted(fit_ets),col="blue")
lines(fitted(fit_ets),col="green")
ac_ets <- accuracy(fcast_ets, tts)
ac_ets
resid <-residuals(fit_ets)
plot(resid)
Box.test(resid, lag=60, fitdf=4, type="Ljung")
ks.test(resid, 'pnorm', mean(resid), sd(resid))
fit_nnet <- nnetar(bts)
fit_nnet
fcast_nnet <- forecast(fit_nnet)
plot(fit_nnet$residuals)
plot(fcast_nnet)
ac_nnetar <- accuracy(fcast_nnet, tts)
ac_nnetar
lines(fit_nnet$fitted, col="red", lwd=2)
lines(tts, col="purple", lwd=2)