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