2018年2月22日木曜日

S&P500,GDP,PAYEMS,UNDCONTSA 2018JAN version


# set parameters.
kg <- "1992-01-01::2017-12-31"
kikan <- "1992-01-01::2017-12-31"
l <- 48  # # of months to predict
r <- 1.05 # pesumed GDP growth rate
# download data from FRE.
getSymbols("GDP",src="FRED")
getSymbols("PAYEMS",src="FRED")
getSymbols("UNDCONTSA",src="FRED")
PA <- PAYEMS
UC <- UNDCONTSA
SP5 <- as.xts(read.zoo(read.csv("~/SP5.csv")))
G <- GDP
i <- seq(2,l/3,1)  # seq of quarters to predict
d <- as.Date(as.yearqtr(seq(Sys.Date(),as.Date("2100-12-31"),by="quarters")[i])) # pick up the first day of each quarters.
m_GDP <- as.xts(as.vector(last(GDP)) * r**(i/4),d)
m_PA <- (as.xts(forecast(auto.arima(PA),h=l)$mean[1:l],as.Date(as.yearmon(seq(mondate(index(last(PA)))+1,by=1,length.out=l))))[(3-month(index(last(PA))) %% 3) + seq(1,l-3,3)])[d]
m_UC <- (as.xts(forecast(auto.arima(UC),h=l)$mean[1:l],as.Date(as.yearmon(seq(mondate(index(last(UC)))+1,by=1,length.out=l))))[(3-month(index(last(UC))) %% 3) + seq(1,l-3,3)])[d]
my_sp5(kg,m_GDP,m_PA,m_UC)

> kikan
[1] "1992-01-01::2017-12-31"
> summary(lm(apply.quarterly(SP5[kikan],mean)[,1] ~ apply.quarterly(PA[kikan],mean) * apply.quarterly(UC[kikan],mean) * G[kikan] - apply.quarterly(UC[kikan],mean) -G[kikan] ))

Call:
lm(formula = apply.quarterly(SP5[kikan], mean)[, 1] ~ apply.quarterly(PA[kikan],
    mean) * apply.quarterly(UC[kikan], mean) * G[kikan] - apply.quarterly(UC[kikan],
    mean) - G[kikan])

Residuals:
    Min      1Q  Median      3Q     Max
-255.30  -74.08  -11.65   71.56  300.72


                                                                           Pr(>|t|) 
(Intercept)                                                                2.53e-05 ***
apply.quarterly(PA[kikan], mean)                                           1.13e-05 ***
apply.quarterly(PA[kikan], mean):apply.quarterly(UC[kikan], mean)          4.89e-10 ***
apply.quarterly(PA[kikan], mean):G[kikan]                                  3.12e-09 ***
apply.quarterly(UC[kikan], mean):G[kikan]                                   < 2e-16 ***
apply.quarterly(PA[kikan], mean):apply.quarterly(UC[kikan], mean):G[kikan]  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 117.4 on 98 degrees of freedom
Multiple R-squared:  0.9505, Adjusted R-squared:  0.9479
F-statistic: 376.1 on 5 and 98 DF,  p-value: < 2.2e-16

0 件のコメント: