-
Notifications
You must be signed in to change notification settings - Fork 0
/
test-predictfunds
66 lines (35 loc) · 2.23 KB
/
test-predictfunds
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
# plot forecast with ggplot2 ----------------------------------------------
rm(list=ls())
dev.off()
setwd("C:\\Users\\Tobi\\Documents\\a1_workfiles\\Wagerenhof")
d.fund <- read.table("C:\\Users\\Tobi\\Documents\\a1_workfiles\\Wagerenhof\\data\\ts_wagi.csv", header=T, sep=";")
d.fund$tm <- substr(d.fund$Belegdatum, 4, 10)
d.fund$tm <- as.numeric(d.fund$tm)
d.fund$fund <- as.numeric(d.fund$Betrag)
d.fund$tm <- as.factor(d.fund$tm)
d.fund <- d.fund[,c("Belegdatum","Betrag", "tm")]
f.y <- aggregate(as.numeric(d.fund$Betrag), list(sfund = d.fund$tm), sum)
demand <- ts(f.y$x, start=c(1996, 1), freq=12)
hw <- HoltWinters(demand)
plot(hw)
forecast <- predict(hw, n.ahead = 12, prediction.interval = T, level = 0.95)
plot(hw, forecast)
# ggplot function ---------------------------------------------------------
#HWplot.R
library(ggplot2)
library(reshape)
HWplot<-function(ts_object, n.ahead=4, CI=.95, error.ribbon='green', line.size=1){
hw_object<-HoltWinters(ts_object)
forecast<-predict(hw_object, n.ahead=n.ahead, prediction.interval=T, level=CI)
for_values<-data.frame(time=round(time(forecast), 3), value_forecast=as.data.frame(forecast)$fit, dev=as.data.frame(forecast)$upr-as.data.frame(forecast)$fit)
fitted_values<-data.frame(time=round(time(hw_object$fitted), 3), value_fitted=as.data.frame(hw_object$fitted)$xhat)
actual_values<-data.frame(time=round(time(hw_object$x), 3), Actual=c(hw_object$x))
graphset<-merge(actual_values, fitted_values, by='time', all=TRUE)
graphset<-merge(graphset, for_values, all=TRUE, by='time')
graphset[is.na(graphset$dev), ]$dev<-0
graphset$Fitted<-c(rep(NA, NROW(graphset)-(NROW(for_values) + NROW(fitted_values))), fitted_values$value_fitted, for_values$value_forecast)
graphset.melt<-melt(graphset[, c('time', 'Actual', 'Fitted')], id='time')
p<-ggplot(graphset.melt, aes(x=time, y=value)) + geom_ribbon(data=graphset, aes(x=time, y=Fitted, ymin=Fitted-dev, ymax=Fitted + dev), alpha=.2, fill=error.ribbon) + geom_line(aes(colour=variable), size=line.size) + geom_vline(x=max(actual_values$time), lty=2) + xlab('Time') + ylab('Value') + theme(legend.position='bottom') + scale_colour_hue('')
return(p)
}
HWplot(demand, n.ahead = 12)