NFCI vs. SPX monthly palette

コード

TERM <- "2007::2023-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),30,25,20,15,min(w$vix)),labels=c('a','b','c','d','e'),include.lowest = T)) ->w
w$v <- factor(w$v,levels=c('e','d','c','b','a'))
df <- w
p <- ggplot(df, aes(x=nfci,y=spx,color=v))
# head(w)
p <- p + geom_point(alpha=0.9)
# palette must be used with brewer.
p <- p + scale_color_brewer(name='vix monthly avg.',label=c('more than 30','between 30 and 25','between 25 and 20','between 20 and 15','less than 15'),palette="Spectral")
# 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 ~ poly(x,3,raw=T),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 + xlab("Financial Condition monthly change") + ylab("SPX monthly return")   
plot(p)

回帰分析

summary(lm(df$spx ~ df$nfci))

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

Residuals:
Min 1Q Median 3Q Max
-0.096418 -0.014188 0.001516 0.018825 0.087896

Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.009213 0.002651 3.476 0.000663 ***
df$nfci -0.261687 0.025646 -10.204 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.033 on 153 degrees of freedom
Multiple R-squared: 0.4049, Adjusted R-squared: 0.4011
F-statistic: 104.1 on 1 and 153 DF, p-value: < 2.2e-16

グラフ

フィッシャー検定

> dplyr::filter(df,nfci >0) %>% dim()
[1] 67 4
> dplyr::filter(df,nfci >0 & spx >0) %>% dim()
[1] 26 4
> dplyr::filter(df,nfci <0) %>% dim()
[1] 88 4
> dplyr::filter(df,nfci <0 & spx >0) %>% dim()
[1] 76 4
> matrix(c(76,12,26,41),nrow=2)
[,1] [,2]
[1,] 76 26
[2,] 12 41
> matrix(c(76,12,26,41),nrow=2) %>% fisher.test()

Fisher's Exact Test for Count Data

data: .
p-value = 6.886e-10
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
4.302013 23.827788
sample estimates:
odds ratio
9.80708

コードその2

m <- merge(monthlyReturn(GSPC)["2001::2022"], as.vector(to.monthly(NFCI)[,4]["2001::2022"]))
colnames(m) <- c('spx','fci')
df <- m
df <- as.data.frame(df)
p <- p + theme_gray (base_family = "HiraKakuPro-W3")
df <- cbind(df,l=cut(df$fci,breaks=c(min(df$fci),-0.6,-0.3,max(df$fci)),labels=c('l','m','h'),include.lowest = T))
p <- ggplot(df, aes(x=spx,fill=l))
p <- p + geom_histogram(bins=50,position = "identity", alpha = 0.5)
# p <- p + scale_fill_brewer(palette="Spectral",name="NFCI",label=c("less than 20","eq or more than 20"))
p <- p + scale_fill_brewer(name='NFCI',label=c("eq or less than -0.6","eq or less than -0.3","more than -0.3"),palette='Set2')
p <- p + ylab("回数") + xlab("SPX月次収益率")
plot(p)

グラフその2