-
Notifications
You must be signed in to change notification settings - Fork 27
/
Copy pathvix.dist.correl.R
218 lines (187 loc) · 6.6 KB
/
vix.dist.correl.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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
##
# looking at relationship between SPX HV, RV & VIX
#
# Peter Werner, 2013
##
library(quantmod)
library(ggplot2)
library(reshape2)
library(gridExtra)
rsq <- function(y,f) { 1 - sum((y-f)^2)/sum((y-mean(y))^2) }
build.rets <- function(x, k=1)
{
r <- ROC(x,k)
return(as.vector(r))
}
#realized vol
#passed a series of log rets
rv <- function(x, dpy=252)
{
n <- length(x)
#assume mean ret is 0
meanret <- 0
r <- sum((x - meanret)^2, na.rm=TRUE)/(n - 1)
r <- r * dpy
return(100 * sqrt(r))
}
prop.dist <- function(x)
{
tgt <- x[length(x)]
minval <- min(x)
maxval <- max(x)
rg <- max(x) - min(x)
d <- (tgt - min(x)) / rg
return(d)
}
maptobin <- function(x, minval=0L, maxval=1L, nbins=5)
{
if (is.na(x))
return(x)
if (x < minval || x > maxval) {
stop(cat(sprintf("x outside range %.2f min %.2f max %.2f\n", x, minval, maxval)))
}
#capture the upside boundary condition
if (x == maxval)
return(nbins)
#work out the size of each bin
binsize <- (maxval - minval)/nbins
#see where the value lies
binidx <- floor(x / binsize)
#add plus 1 so they are indexed from 1-nbins
return(binidx + 1)
}
getSymbols(c("^GSPC", "^VIX"), from="2000-01-01")
spx <- GSPC
vix <- VIX
#spx <- GSPC["2011/2012"]
#vix <- VIX["2011/2012"]
r <- build.rets(Cl(spx))
#the # of periods (not cal days) to calc vol
n <- 21
#we use na.omit as the first item of r will be NA
#so for forward looking realized vol it will be r[2:11] with n=10
#but cause r[1] is na, it looks like r[1:10].
#for hist vol, we use the returns up to and including the current day.
#this is because VIX[i] is the vix close for that day, not the
#previous day. We want to look at what hv was on that day, so we
#should include the current day as the VIX would have factored that in
#n.b. we could add a 1 day lag (by using n+1 in the rep for histvol),
#and see if there is any material difference
voltmp <- rollapply(na.omit(r), n, rv)
realvol <- c(voltmp, rep(NA, n))
histvol <- c(rep(NA, n), voltmp)
iv <- Cl(vix)
spxvals <- cbind(Cl(spx), histvol, realvol, iv)
names(spxvals) <- c("C", "hv", "rv", "iv")
spxvals <- na.omit(spxvals)
nrow(spxvals)
cor(spxvals$iv, spxvals$hv)
cor(spxvals$iv, spxvals$rv)
cor(spxvals$hv, spxvals$rv)
rsq(spxvals$iv, spxvals$hv)
rsq(spxvals$iv, spxvals$rv)
rsq(spxvals$hv, spxvals$rv)
cor(spxvals[,2:4])
###
#look at distributions of next day returns for some relative measure of iv
###
r <- build.rets(Cl(spx))
iv <- Cl(vix)
n <- 252 #lookback period
iv.prop <- rollapply(iv, n, prop.dist, align='right', fill=NA)
tail(iv.prop)
ivrel <- cbind(Next(r), iv, as.vector(iv.prop))
names(ivrel) <- c('nd', 'iv', 'ivp')
head(ivrel)
nrow(ivrel)
nbins <- 5
ivrel$bin <- sapply(as.vector(ivrel$ivp), maptobin)
binnedrets <- list()
for (i in 1:nbins) {
#get the next day returns for the given bin
rets <- ivrel[ivrel$bin == i]$nd
binnedrets[[i]] <- as.vector(rets)
}
#with lookback of 252 it shows vol increasing
#we can see the mean next day return is still 0, regardless of where vol was
#iv is not necessarily a good predictor of next day returns
#however is a good indicator of higher volatility
boxplot(binnedrets)
tmp <- melt(binnedrets)
title <- 'VIX Next Day Return Distributions'
#qplot(L1, y=value, data=tmp, geom="boxplot", group=L1)
p <- ggplot(tmp, aes(x=L1, y=value, group=L1)) + geom_boxplot()
p <- p + opts(title=title) + labs(list(x="Relative VIX Quintile", y="Return"))
png('vix.ndr.rel.png')
p
dev.off()
###
# plots of vix vs spx rv/hv, use a subset 2011 and 2012
###
spxvals <- spxvals['2011/2012']
plot(as.vector(spxvals$hv), type='l')
lines(1:nrow(spxvals),as.vector(spxvals$iv), col='red')
lines(1:nrow(spxvals),as.vector(spxvals$rv), col='blue')
plot(as.vector(spxvals$rv), type='l')
lines(1:nrow(spxvals),as.vector(spxvals$iv), col='red')
head(spxvals)
##ggplot of vix vs spx rv
df <- data.frame(date=index(spxvals), RzdVol=as.vector(spxvals[,3]), VIX=as.vector(spxvals[,4]))
df <- melt(df, id="date")
title <- 'VIX vs. SPX Realized Vol\n2011-2012'
p <- ggplot(df, aes(x=date, y=value, group=variable)) + geom_line(aes(color=variable, name='a'))
#p + opts(title=title, plot.title=theme_text(size=20))
p <- p + labs(list(x="", y="Value")) + scale_color_hue(name='Data')
#p + opts(legend.position='top')
p <- p + opts(legend.position=c(0.9, 0.85))
p <- p + opts(legend.background=theme_rect(fill='white'))
p <- p + opts(title=title)
##ggplot of difference between two
diffvals <- as.vector(spxvals$iv - spxvals$rv)
#hist(diffvals)
#qplot(diffvals, geom='density', binwidth=5)
diff_df <- data.frame(date=index(spxvals), diff=diffvals)
head(diff_df)
#qplot(x=date, y=diff, data=df, geom='line')
#qplot(x=date, y=diff, data=df, geom='bar', stat='identity')
#ggplot(df, aes(x=date, y=diff)) + geom_bar(stat='identity')
p2 <- ggplot(diff_df, aes(x=date, y=diff)) + geom_line(aes(colour=diff)) + opts(legend.position="none")
#p2 <- p2 + geom_abline(intercept=0, slope=0, color='red')
p2 <- p2 + geom_hline(yintercept=0, color='red', alpha=0.7)
p2 <- p2 + labs(list(x='Date', y='Difference'))
#p2 <- p2 + opts(title='Difference')
#grid.arrange(p, p2, heights = c(0.9, 0.5), widths=c(0.9, 0.9), main=title)
png('vix.vs.spx.rv.png')
grid.arrange(p, p2, heights = c(0.9, 0.5), widths=c(0.9, 0.9))
dev.off()
###end plot of vix vs spx rv
####ggplot of vix spx hv
df <- data.frame(date=index(spxvals), HistVol=as.vector(spxvals[,2]), VIX=as.vector(spxvals[,4]))
df <- melt(df, id="date")
title <- 'VIX vs. SPX Historical Vol\n2011-2012'
p <- ggplot(df, aes(x=date, y=value, group=variable)) + geom_line(aes(color=variable, name='a'))
#p + opts(title=title, plot.title=theme_text(size=20))
p <- p + labs(list(x="", y="Value")) + scale_color_hue(name='Data')
#p + opts(legend.position='top')
p <- p + opts(legend.position=c(0.9, 0.85))
p <- p + opts(legend.background=theme_rect(fill='white'))
p <- p + opts(title=title)
##ggplot of difference between two
diffvals <- as.vector(spxvals$iv - spxvals$hv)
#hist(diffvals)
#qplot(diffvals, geom='density', binwidth=5)
diff_df <- data.frame(date=index(spxvals), diff=diffvals)
head(diff_df)
#qplot(x=date, y=diff, data=df, geom='line')
#qplot(x=date, y=diff, data=df, geom='bar', stat='identity')
#ggplot(df, aes(x=date, y=diff)) + geom_bar(stat='identity')
p2 <- ggplot(diff_df, aes(x=date, y=diff)) + geom_line(aes(colour=diff)) + opts(legend.position="none")
#p2 <- p2 + geom_abline(intercept=0, slope=0, color='red')
p2 <- p2 + geom_hline(yintercept=0, color='red', alpha=0.7)
p2 <- p2 + labs(list(x='Date', y='Difference'))
#p2 <- p2 + opts(title='Difference')
#grid.arrange(p, p2, heights = c(0.9, 0.5), widths=c(0.9, 0.9), main=title)
png('vix.vs.spx.hv.png')
grid.arrange(p, p2, heights = c(0.9, 0.5), widths=c(0.9, 0.9))
dev.off()
### end plot of vix vs spx hv