NFCI vs. CLI delta = SPX monthly cut
ソースコード データ準備編
#
TERM <- "2011::2022-11"
FC <- ANFCI
w <- merge(diff(apply.monthly(FC,mean))[TERM],as.vector(diff(cli_xts$usa)[TERM]))
colnames(w) <- c("FC","cli_delta")
ソースコード plot編
#後で作業する 暫定コード
plot.default(w$FC,w$cli_delta)
abline(lm(w$cli_delta ~ w$NFCI))
abline(v=0,lty=2)
abline(h=0,lty=2)
abline(v=(diff(apply.monthly(NFCI,mean)) %>% last()))
ソースコード回帰分析編
summary(lm(w$cli_delta ~ w$FC))
Call:
lm(formula = w$cli_delta ~ w$FC)
Residuals:
Min 1Q Median 3Q Max
-4.3508 -0.1127 0.0173 0.1365 1.9515
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.007963 0.039416 -0.202 0.84
w$NFCI -3.776124 0.425250 -8.880 3.04e-15 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.4679 on 139 degrees of freedom
Multiple R-squared: 0.3619, Adjusted R-squared: 0.3574
F-statistic: 78.85 on 1 and 139 DF, p-value: 3.038e-15
ソースコード相関係数編
cor.test(w$FC,w$cli_delta)
Pearson's product-moment correlation
data: w$NFCI and w$cli_delta
t = -8.8798, df = 139, p-value = 3.038e-15
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
-0.6975572 -0.4844940
sample estimates:
cor
-0.6016207
ソースコードggplot 編
TERM <- "2011::2023-01"
FC <- NFCI
CLI <- cli_usa
w <- merge(diff(apply.monthly(FC,mean))[TERM],as.vector(diff(CLI)[TERM]))
colnames(w) <- c("FC","cli_delta")
w <- merge(w,spx=as.vector(monthlyReturn(GSPC)[TERM]))
# w <- data.frame(w,s=cut(w$spx,breaks=c(min(w$spx),-0.025,0,0.025,max(w$spx)),labels=c('d','c','b','a'),include.lowest = T))
w <- data.frame(w,s=cut(w$spx,breaks=c(max(w$spx),0.025,0,-0.025,min(w$spx)),labels=c('a','b','c','d'),include.lowest = T))
# w$s <- factor(w$s,levels=c('a','b','c','d'))
w$s <- factor(w$s,levels=c('d','c','b','a')) # this is critical. never remove nor comment out.
df <- w
p <- ggplot(df, aes(x=FC,y=cli_delta,color=s))
p <- p + geom_point(alpha=0.9)
# p <- p + guide_legend(reverse = TRUE)
# p <- p + scale_color_gradient(low = "green", high = "blue",name = "vix")
# p <- p + scale_color_gradient2( low = "#FF0000",mid="#FFFF00" , high = "#0000FF",midpoint=0)
# p <- p + scale_color_discrete(name='spx daily return',label=c('less than -0.025','between -0.025 and 0','between 0 and 0.025','more than 0.025'))
p <- p + scale_color_discrete(name='spx monthly return',label=c('more than 0.025','between 0.025 and 0','between 0 and -0.025','less than -0.025'))
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=(diff(apply.monthly(FC,mean)) %>% last()), colour="white",size=0.4,alpha=0.5)
p <- p + xlab("Financial Condition monthly change") + ylab("CLI monthly delta")
p <- p + annotate("text", x=last(df$FC),y=last(df$cli_delta), label = "◇",family = "HiraKakuProN-W3",alpha=1,color='red')
plot(p)
出力サンプル
おまけ: PMI差分も統合する
wはdata.frame なのでcbind()を使用してマージする。
TERM <- "2011::2022-11"
FC <- ANFCI
w <- merge(diff(apply.monthly(FC,mean))[TERM],as.vector(diff(cli_xts$usa)[TERM]))
colnames(w) <- c("FC","cli_delta")
w <- merge(w,spx=as.vector(monthlyReturn(GSPC)[TERM]))
# w <- data.frame(w,s=cut(w$spx,breaks=c(min(w$spx),-0.025,0,0.025,max(w$spx)),labels=c('d','c','b','a'),include.lowest = T))
w <- data.frame(w,s=cut(w$spx,breaks=c(max(w$spx),0.025,0,-0.025,min(w$spx)),labels=c('a','b','c','d'),include.lowest = T))
w$s <- factor(w$s,levels=c('d','c','b','a')) # this is critical. never remove nor comment out.
w <- cbind(w,as.vector(diff(PMI)[TERM]))
おまけその2:FCIの差分データの計算方法を変更
w[,1] <- (to.monthly(FC)[,4] %>% diff())[TERM]
summary(lm(w[,3] ~ w[,1] + w[,2]))
Call:
lm(formula = w[, 3] ~ w[, 1] + w[, 2])
Residuals:
Min 1Q Median 3Q Max
-0.089678 -0.014008 0.001099 0.020290 0.078188
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.009393 0.002675 3.512 0.000601 ***
w[, 1] -0.282831 0.028159 -10.044 < 2e-16 ***
w[, 2] -0.015143 0.005480 -2.763 0.006494 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.03186 on 139 degrees of freedom
Multiple R-squared: 0.4212, Adjusted R-squared: 0.4129
F-statistic: 50.57 on 2 and 139 DF, p-value: < 2.2e-16
この記事が気に入ったらサポートをしてみませんか?