NFCI vs. SPX 月次収益率 with VIX &CLI png facet

VIXを利用して分類した場合 facet_wrap 使用

NFCI月間変化値とS&P500月次収益率の関係はすでに検証済みだが、これをVIX<20の場合とそれ以外に分けて分析する。

コード

TERM <- "2007::2024-01"

w <- data.frame(fci=(diff(to.monthly(NFCI)[,4]))[TERM],spx=(monthlyReturn(GSPC))[TERM])
cbind(w,apply.monthly(VIX[,4],mean,na.rm=T)[TERM]) -> w
colnames(w) <- c('nfci','spx','vix')
# cut(w$vix,breaks=c(max(w$vix),30,25,20,15,min(w$vix)),labels=c('a','b','c','d','e'),include.lowest = T)
data.frame(w,v=cut(w$vix,breaks=c(max(w$vix),20,min(w$vix)),labels=c('a','b'),include.lowest = T)) ->w
w$v <- factor(w$v,levels=c('b','a'))
df <- w
p <- ggplot(df, aes(x=nfci,y=spx,color=v))
# head(w)
p <- p + geom_point(alpha=0.9) + facet_wrap(. ~ v, ncol=1)
# palette must be used with brewer.
p <- p + scale_color_brewer(name='vix monthly avg.',label=c('equal or more than 20','less than 20'))
# p <- p + scale_color_discrete(name='vix monthly avg.',label=c('more than 30','between 30 and 25','between 25 and 20','between 20 and 15','less than 15'))
p <- p + theme_dark(base_family = "HiraKakuPro-W3")
p <- p + stat_smooth(method = lm, formula = y ~ x,se=F,size=0.5,color='white')
p <- p + geom_vline(xintercept=(last(diff(NFCI,4))), colour="white",size=0.4,alpha=0.5)
p <- p + geom_hline(yintercept=(monthlyReturn(GSPC) %>% last()), colour="white",size=0.4,alpha=0.5)
p <- p + geom_hline(yintercept=(last(GSPC,20)[20,4]/as.vector(last(GSPC,20)[1,1])- 1), colour="red",size=0.4,alpha=0.5)
p <- p + geom_vline(xintercept=0.042196, colour="red",size=0.4,alpha=0.5)
p <- p + xlab("Financial Condition monthly change") + ylab("SPX monthly return")   
plot(p)

回帰分析

vix < 20以下の場合

vix < 20 の月を抜き出して回帰分析を行う。結果は以下の通り。これによりvix < 20以下の月で期待収益率=0が想定される時のnfciの値を得られる。

>   dplyr::filter(df,vix<20) -> df
>   summary(lm(df$spx ~ df$nfci))

Call:
lm(formula = df$spx ~ df$nfci)

Residuals:
Min 1Q Median 3Q Max
-0.067586 -0.011820 -0.000035 0.015745 0.063757

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.01175 0.00227 5.178 8.79e-07 ***
df$nfci -0.27846 0.03641 -7.647 4.92e-12 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.02541 on 124 degrees of freedom
Multiple R-squared: 0.3205, Adjusted R-squared: 0.315
F-statistic: 58.47 on 1 and 124 DF, p-value: 4.921e-12

vix > 20以上の場合

> dplyr::filter(df,vix>20) -> df
> summary(lm(df$spx ~ df$nfci))

Call:
lm(formula = df$spx ~ df$nfci)

Residuals:
Min 1Q Median 3Q Max
-0.16200 -0.03961 0.00265 0.03590 0.11200

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.001273 0.005905 -0.216 0.83
df$nfci -0.128457 0.022927 -5.603 3.14e-07 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.05245 on 77 degrees of freedom
Multiple R-squared: 0.2896, Adjusted R-squared: 0.2804
F-statistic: 31.39 on 1 and 77 DF, p-value: 3.135e-07

グラフ facet_wrapを使用した場合

ソースコード facet_gridを使用した場合

TERM <- "2007::2024-01"

w <- data.frame(fci=(diff(to.monthly(NFCI)[,4]))[TERM],spx=(monthlyReturn(GSPC))[TERM])
cbind(w,apply.monthly(VIX[,4],mean,na.rm=T)[TERM]) -> w
colnames(w) <- c('nfci','spx','vix')
# cut(w$vix,breaks=c(max(w$vix),30,25,20,15,min(w$vix)),labels=c('a','b','c','d','e'),include.lowest = T)
data.frame(w,v=cut(w$vix,breaks=c(max(w$vix),20,min(w$vix)),labels=c('a','b'),include.lowest = T)) ->w
w$v <- factor(w$v,levels=c('b','a'))
df <- w
p <- ggplot(df, aes(x=nfci,y=spx,color=v))
# head(w)
p <- p + geom_point(alpha=0.9) + facet_grid(. ~ v, margins=TRUE)
# p <- p + geom_point(alpha=0.9) + facet_wrap(. ~ v, ncol=1)
# palette must be used with brewer.
p <- p + scale_color_brewer(name='vix monthly avg.',label=c('equal or more than 20','less than 20','all'),palette='Set1')
# p <- p + scale_color_discrete(name='vix monthly avg.',label=c('more than 30','between 30 and 25','between 25 and 20','between 20 and 15','less than 15'))
p <- p + theme_dark(base_family = "HiraKakuPro-W3")
p <- p + stat_smooth(method = lm, formula = y ~ x,se=F,size=0.5,color='white')
p <- p + geom_vline(xintercept=(last(diff(NFCI,4))), colour="white",size=0.4,alpha=0.5)
p <- p + geom_hline(yintercept=(monthlyReturn(GSPC) %>% last()), colour="white",size=0.4,alpha=0.5)
p <- p + geom_hline(yintercept=(last(GSPC,20)[20,4]/as.vector(last(GSPC,20)[1,1])- 1), colour="red",size=0.4,alpha=0.5)
p <- p + geom_vline(xintercept=0.042196, colour="red",size=0.4,alpha=0.5)
p <- p + xlab("Financial Condition monthly change") + ylab("SPX monthly return")
plot(p)

png("~/Dropbox/R-script/covid/w.png", width = 1200, height = 1000)
plot(p)
dev.off()

グラフ　facet_grid

VIX 及びCLIを利用して分類した場合

VIX20以上とそれ未満、CLIデルタがプラスの場合とマイナスの場合それぞれを利用してマトリックスを作図する。

ソースコード　facet_grid 使用

TERM <- "2007::2024-01"

w <- data.frame(fci=(diff(to.monthly(NFCI)[,4]))[TERM],spx=(monthlyReturn(GSPC))[TERM])
cbind(w,apply.monthly(VIX[,4],mean,na.rm=T)[TERM]) -> w
colnames(w) <- c('nfci','spx','vix')
cbind(w,cli=diff(cli_g20)[TERM]) -> w
# cut(w$vix,breaks=c(max(w$vix),30,25,20,15,min(w$vix)),labels=c('a','b','c','d','e'),include.lowest = T)
data.frame(w,v=cut(w$vix,breaks=c(max(w$vix),20,min(w$vix)),labels=c('a','b'),include.lowest = T)) ->w
data.frame(w,c=cut(w$cli,breaks=c(max(w$cli),0,min(w$cli)),labels=c('negative','positive'),include.lowest = T)) ->w
w$v <- factor(w$v,levels=c('b','a'))
w$c <- factor(w$c,levels=c('positive','negative'))
df <- w
p <- ggplot(df, aes(x=nfci,y=spx,color=v))
# head(w)
p <- p + geom_point(alpha=0.9) + facet_grid(c ~ v)
# palette must be used with brewer.
p <- p + scale_color_brewer(name='vix monthly avg.',label=c('equal or more than 20','less than 20'),palette='Set1')
# p <- p + scale_color_discrete(name='vix monthly avg.',label=c('more than 30','between 30 and 25','between 25 and 20','between 20 and 15','less than 15'))
p <- p + theme_dark(base_family = "HiraKakuPro-W3")
p <- p + stat_smooth(method = lm, formula = y ~ x,se=F,size=0.5,color='white')
p <- p + geom_vline(xintercept=(last(diff(NFCI,4))), colour="white",size=0.4,alpha=0.5)
p <- p + geom_hline(yintercept=(monthlyReturn(GSPC) %>% last()), colour="white",size=0.4,alpha=0.5)
p <- p + geom_hline(yintercept=(last(GSPC,20)[20,4]/as.vector(last(GSPC,20)[1,1])- 1), colour="red",size=0.4,alpha=0.5)
p <- p + geom_vline(xintercept=0.042196, colour="red",size=0.4,alpha=0.5)
p <- p + xlab("Financial Condition monthly change") + ylab("SPX monthly return")   
plot(p)

png("~/Dropbox/R-script/covid/w.png", width = 1200, height = 1000)
plot(p)
dev.off()

グラフ

回帰分析 VIX<20の場合にCLIがプラス・マイナスの場合をそれぞれ

> summary(lm((dplyr::filter(df,cli>0,vix<20))$spx ~ (dplyr::filter(df,cli>0,vix<20))$nfci ))

Call:
lm(formula = (dplyr::filter(df, cli > 0, vix < 20))$spx ~ (dplyr::filter(df,
cli > 0, vix < 20))$nfci)

Residuals:
Min 1Q Median 3Q Max
-0.055277 -0.011418 -0.002417 0.015075 0.054703

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.011842 0.003362 3.523 0.000824 ***
(dplyr::filter(df, cli > 0, vix < 20))$nfci -0.281073 0.068914 -4.079 0.000136 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.02333 on 60 degrees of freedom
Multiple R-squared: 0.2171, Adjusted R-squared: 0.204
F-statistic: 16.64 on 1 and 60 DF, p-value: 0.0001355

> summary(lm((dplyr::filter(df,cli<0,vix<20))$spx ~ (dplyr::filter(df,cli<0,vix<20))$nfci ))

Call:
lm(formula = (dplyr::filter(df, cli < 0, vix < 20))$spx ~ (dplyr::filter(df,
cli < 0, vix < 20))$nfci)

Residuals:
Min 1Q Median 3Q Max
-0.067486 -0.015253 0.000764 0.016848 0.063882

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.011586 0.003514 3.297 0.00162 **
(dplyr::filter(df, cli < 0, vix < 20))$nfci -0.276546 0.048067 -5.753 2.89e-07 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.02765 on 62 degrees of freedom
Multiple R-squared: 0.3481, Adjusted R-squared: 0.3376
F-statistic: 33.1 on 1 and 62 DF, p-value: 2.895e-07

>