名目GDP四半期伸び率 vs. CLI Delta Nominal GDP quater basis legend title #spline #gdp

 

名目GDP四半期伸び率　vs.　CLI Delta Nominal GDP quater basis を対照プロットする。

period <- "2001::2021-06"  # end period month should be march,june,september or december.

w <- (GDPC1/lag(GDPC1))[period] - 1

result <- lm(as.vector(diff(apply.quarterly(cli_xts$oecd,mean))[period]) ~ w)

df <- data.frame(delta=as.vector(diff(apply.quarterly(cli_xts$oecd,mean))[period]) ,gdp=as.vector(w)

                 ,spx= as.vector(quarterlyReturn(GSPC)[period])  )

p <- ggplot(df, aes(y=delta,x=gdp))

p <- p + theme_gray (base_family = "HiraKakuPro-W3")

p <- p + xlab("GDP四半期伸び率") + ylab("CLI delta")

p <- p + geom_point(alpha=1,aes(color=spx))

p <- p + scale_color_gradient(low = "red", high = "green")

p <- p + geom_smooth(method = "lm",se=F,size=0.5)

p <- p + geom_vline(xintercept =(-1*result$coefficients[1] / result$coefficients[2]),

                    size=0.5,linetype=2,colour="red",alpha=0.5)

p <- p + geom_hline(yintercept = last(as.vector(diff(apply.quarterly(cli_xts$oecd,mean))[period])),

                    size=0.5,linetype=2,colour="green",alpha=0.5)

p <- p + geom_vline(xintercept = last(w),

                    size=0.5,linetype=2,colour="green",alpha=0.5)

p <- p+annotate("text",label=as.character(round(-1*result$coefficients[1] / result$coefficients[2],4)),x=(-1*result$coefficients[1] / result$coefficients[2]), y=-5.1,colour='red')

p <- p+annotate("text",label=as.character(round(last(w),4)),x=last(w), y=-5.1,colour='green')

p <- p +  labs(color="S&P500\n四半期\n収益率")

plot(p)

summary(result)

spline を使用して補完の上月次GDPを算出その上でグラフを作成する。

period <- "2015::2021-09"  # end period month should be march,june,september or december.

w <- spline(GDPC1[period],xmin=1/3,xmax=length(GDPC1[period])+1/3,n=3*length(GDPC1[period])+1,method='natural')$y

# w <- w/lag(w) -1

w <- w[2:length(w)]/w[1:(length(w)-1)] - 1

# w <- (GDPC1/lag(GDPC1))[period] - 1

# result <- lm(as.vector(diff(cli_xts$oecd)[period]) ~ w)

result <- lm(as.vector(diff(cli_xts$oecd)[period]) ~ w)

df <- data.frame(delta=as.vector(diff((cli_xts$oecd))[period]) ,gdp=as.vector(w)

                 ,spx= as.vector(monthlyReturn(GSPC)[period])  )

p <- ggplot(df, aes(y=delta,x=gdp))

p <- p + theme_gray (base_family = "HiraKakuPro-W3")

p <- p + xlab("GDP補正月間伸び率") + ylab("CLI delta")

p <- p + geom_point(alpha=1,aes(color=spx))

p <- p + scale_color_gradient(low = "red", high = "green")

p <- p + geom_smooth(method = "lm",se=F,size=0.5)

p <- p + geom_vline(xintercept =(-1*result$coefficients[1] / result$coefficients[2]),

                    size=0.5,linetype=2,colour="red",alpha=0.5)

p <- p + geom_hline(yintercept = last(as.vector(diff((cli_xts$oecd))[period])),

                    size=0.5,linetype=2,colour="green",alpha=0.5)

p <- p + geom_vline(xintercept = last(w),

                    size=0.5,linetype=2,colour="green",alpha=0.5)

p <- p+annotate("text",label=as.character(round(-1*result$coefficients[1] / result$coefficients[2],4)),x=(-1*result$coefficients[1] / result$coefficients[2]), y=-5.1,colour='red')

p <- p+annotate("text",label=as.character(round(last(w),4)),x=last(w), y=-5.1,colour='green')

p <- p +  labs(color="S&P500\n月間\n収益率")

plot(p)

summary(result)

> summary(result)

Call:

lm(formula = as.vector(diff(apply.quarterly(cli_xts$oecd, mean))[period]) ~ w)

Residuals:

     Min       1Q   Median       3Q      Max 

-1.44728 -0.33122  0.01372  0.19903  2.09477 

Coefficients:

            Estimate Std. Error t value Pr(>|t|)    

(Intercept) -0.45260    0.06811  -6.645 3.53e-09 ***

w           47.61859    3.71852  12.806  < 2e-16 ***

---

Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.5276 on 79 degrees of freedom

Multiple R-squared:  0.6749, Adjusted R-squared:  0.6708 

F-statistic:   164 on 1 and 79 DF,  p-value: < 2.2e-16