spx日次収益 ~ vix + vix 日次変化 cut scale factor

データ

#spx 日次収益率(spx)、 #vix 終値(vix)、同じく日次変化(vixdiff)をそれぞれ計算し、各列に代入する。

head(df)
                    spx     vixdiff   vix
2021-01-04 -0.014754828  0.18549446 26.97
2021-01-05  0.007082595 -0.06043749 25.34
2021-01-06  0.005709843 -0.01065509 25.07
2021-01-07  0.014847404 -0.10769840 22.37
2021-01-08  0.005491863 -0.03620930 21.56
2021-01-11 -0.006554751  0.11688317 24.08
> 

重回帰分析

これら三者の間には統計学的に有意な関係が存在する。つまり、spx = vixdiff + vix の関係である。解析結果は以下のとおり。決定係数=0.544、p値< 2.2e-16。したがって、信頼度には問題ない。

summary(lm(df$spx ~ df$vix+df$vixdiff))

Call:
lm(formula = df$spx ~ df$vix + df$vixdiff)

Residuals:
      Min        1Q    Median        3Q       Max 
-0.015382 -0.003901 -0.000469  0.002962  0.024159 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)  6.622e-03  1.350e-03   4.907 1.25e-06 ***
df$vix      -2.951e-04  6.057e-05  -4.873 1.48e-06 ***
df$vixdiff  -9.600e-02  4.071e-03 -23.579  < 2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.005994 on 506 degrees of freedom
Multiple R-squared:  0.5458,	Adjusted R-squared:  0.544 
F-statistic:   304 on 2 and 506 DF,  p-value: < 2.2e-16

ソースコード 改訂版

データの準備及びグラフの出力を行うソースは以下のとおり。

m <- merge(dailyReturn(GSPC)["2021::"], dailyReturn(VIX)["2020::"][index(dailyReturn(GSPC)["2021::"])], VIX[,4][index(dailyReturn(GSPC)["2021::"])])
# m <- merge(weeklyReturn(GSPC)["2011::"], weeklyReturn(VIX)["2011::"][index(weeklyReturn(GSPC)["2011::"])], apply.weekly(VIX[,4],mean)[index(weeklyReturn(GSPC)["2011::"])])
colnames(m) <- c('spx','vixdiff','vix')
m <- data.frame(m,s=cut(m$spx,breaks=c(max(m$spx),0.01,0.005,0,-0.005,-0.01,min(m$spx)),labels=c('a','b','c','d','e','f'),include.lowest = T))
m$s <- factor(m$s,levels=c('f','e','d','c','b','a')) # this is critical. never remove nor comment out.

df <- m
p <- ggplot(df, aes(x=vixdiff,y=vix,color=s))
p <- p + geom_point(alpha=1)
# p <- p + stat_smooth(aes(x=vixdiff,y=spx),method = loess, formula = y ~ x,se=F)
p <- p + annotate("text", x=last(df$vixdiff),y=last(df$vix), label = "◇",family = "HiraKakuProN-W3",alpha=1,color='red')

p <- p + scale_color_brewer(name='spx daily return',label=c('more than 0.01','between 0.01 and 0.005','between 0.005 and 0','between 0 and -0.005','between -0.005 and -0.01','less than -0.01'),palette='Set1')
p <- p + theme_dark(base_family = "HiraKakuPro-W3")
p <- p + guides(color = guide_legend(title="SPX"))
# p  <- p + scale_color_gradient2( low = "#FF0000",mid="#00FF00" , high = "#0000FF",midpoint=0)
p <- p + xlab("VIX日次変化率") + ylab("VIX")
r <- (lm(df$spx ~ df$vix+df$vixdiff))
p <- p + geom_abline(intercept = -r$coefficients[1]/r$coefficients[2], slope = -r$coefficients[3]/r$coefficients[2])
p <- p + geom_abline(intercept = (as.vector(last(dailyReturn(GSPC)))-r$coefficients[1])/r$coefficients[2], slope = -r$coefficients[3]/r$coefficients[2],color='red')
plot(p)
png("~/Dropbox/R-script/covid/w.png", width = 1200, height = 1000)

p <- p + annotate("text", x=0.2,y=15.2, label =paste0("傾き = ",sprintf("%.3f",-r$coefficients[3]/r$coefficients[2])),family = "HiraKakuProN-W3",alpha=1,color='black')
p <- p + annotate("text", x=0.2,y=15.7, label =paste0("切片 = ",sprintf("%.2f",-r$coefficients[1]/r$coefficients[2])),family = "HiraKakuProN-W3",alpha=1,color='black')
plot(p)
dev.off()

グラフ出力結果

縦軸に #vix 終値、横軸に同じく日次変化をとったグラフ。重回帰分析の結果 #spx 予想日次収益率がゼロになる地点を黒の実線で表した。

ソースコード　オリジナル

m <- merge(dailyReturn(GSPC)["2021::"], dailyReturn(VIX)["2020::"][index(dailyReturn(GSPC)["2021::"])], VIX[,4][index(dailyReturn(GSPC)["2021::"])])
# m <- merge(weeklyReturn(GSPC)["2011::"], weeklyReturn(VIX)["2011::"][index(weeklyReturn(GSPC)["2011::"])], apply.weekly(VIX[,4],mean)[index(weeklyReturn(GSPC)["2011::"])])
colnames(m) <- c('spx','vixdiff','vix')
df <- m
p <- ggplot(df, aes(x=vixdiff,y=vix,color=spx))
p <- p + geom_point(alpha=1)
# p <- p + stat_smooth(aes(x=vixdiff,y=spx),method = loess, formula = y ~ x,se=F)
p <- p + annotate("text", x=last(df$vixdiff),y=last(df$vix), label = "◇",family = "HiraKakuProN-W3",alpha=1,color='red')

p <- p + theme_gray (base_family = "HiraKakuPro-W3")
p <- p + guides(color = guide_legend(title="SPX"))
p  <- p + scale_color_gradient2( low = "#FF0000",mid="#00FF00" , high = "#0000FF",midpoint=0)
p <- p + xlab("VIX日次変化率") + ylab("VIX")
r <- (lm(df$spx ~ df$vix+df$vixdiff))
p <- p + geom_abline(intercept = -r$coefficients[1]/r$coefficients[2], slope = -r$coefficients[3]/r$coefficients[2])
p <- p + geom_abline(intercept = (as.vector(last(dailyReturn(GSPC)))-r$coefficients[1])/r$coefficients[2], slope = -r$coefficients[3]/r$coefficients[2],color='red')
plot(p)
png("~/Dropbox/R-script/covid/w.png", width = 1200, height = 1000)

p <- p + annotate("text", x=0.2,y=15.2, label =paste0("傾き = ",sprintf("%.3f",-r$coefficients[3]/r$coefficients[2])),family = "HiraKakuProN-W3",alpha=1,color='black')
p <- p + annotate("text", x=0.2,y=15.7, label =paste0("切片 = ",sprintf("%.2f",-r$coefficients[1]/r$coefficients[2])),family = "HiraKakuProN-W3",alpha=1,color='black')
plot(p)
dev.off()