PAYEMS monthly delta and S&P500

plot(to.monthly(SP5)[kikan][,1],axes=T)
par(new=T)
plot(diff(PA[kikan]),axes=F,ylim=c(-900,900),col=3)
par(new=T)
plot(rep(0,length(PA[kikan])),col=2,ylim=c(-900,900),axes=F,type='l')

S&P500 vs. GDP and other macroecnomic data and PAYEMS moving average

1.S&P500 vs macroenomics

kikan <- "1992-01-01::2017-06-30"
x <- seq(min(as.Date(index(to.quarterly(SP5[kikan])[,1]))),as.Date(max(index(to.quarterly(SP5[kikan])[,1]))),"quarters")
plot(predict(lm(to.quarterly(SP5[kikan])[,1] ~ apply.quarterly(PA[kikan],mean) * apply.quarterly(UC[kikan],mean) * GDP[kikan] - apply.quarterly(UC[kikan],mean) )),type='l',col=2,axes=F,ylim=c(0,2500),ylab="")
par(new=T)
plot(x,to.quarterly(SP5[kikan])[,1],type='l',ylim=c(0,2500))
par(new=T)
plot(x,rep(2000,length(x)),type='l',col=4,ylim=c(0,2500)) # draw the line at 2000 level
axis(side=2, pos=as.Date("2017-01-01"),labels=F)  # draw aux axis at 2017-01-01
par(new=T)
plot(x,rep(2250,length(x)),type='l',col=4,ylim=c(0,2500)) # draw the line at 2250 level

2.PAYEMS

----------- updated
l <- 300  # length of sample period
a <- 6     # base for moving average
print(strsplit(kikan,"::")[[1]][1])
x <- last(seq(as.Date(strsplit(kikan,"::")[[1]][1]),as.Date(last(index(PA))),by="months"),n=(l-a))
plot(x,na.trim(filter(diff(last(PA,n=l)),rep(1,a))/a),type='h',ylim=c(-800,300))
axis(side=2, pos=as.Date("2017-07-01"),labels=F)
par(new=T)
plot(x,rep(last(na.trim(filter(diff(last(PA,n=l)),rep(1,a))/a)),length(x)),typ='l',col=2,ylim=c(-800,300))
paste(head(x)[1],last(x),sep="::")  
par(new=T)
plot(SP5[paste(head(x)[1],last(x),sep="::")],axes=F,col=3)  # add spx.
------------- ends here

l <- 300  # length of sample period
a <- 6     # base for moving average
x <- last(seq(as.Date("1992-01-01"),as.Date(last(index(PA))),by="months"),n=(l-a))
plot(x,na.trim(filter(diff(last(PA,n=l)),rep(1,a))/a),type='h',ylim=c(-800,300))
axis(side=2, pos=as.Date("2017-07-01"),labels=F)
par(new=T)
plot(x,rep(173,length(x)),typ='l',col=2,ylim=c(-800,300))


3.GDP

x <- seq(as.Date(strsplit(kikan,'::')[[1]][1]),as.Date(strsplit(kikan,'::')[[1]][2]),"quarters")
plot(x,G[kikan],type='h')
axis(side=2, pos=as.Date("2008-07-01"),labels=F,col=2)
axis(side=1, pos=15000,labels=F,col=3)

Draw graph S&P500 vs. refined GDP/S&P500 model

kikan <- "1992-01-01::2017-06-30"
x <- seq(min(as.Date(index(to.quarterly(SP5[kikan])[,1]))),as.Date(max(index(to.quarterly(SP5[kikan])[,1]))),"quarters")
result <- (lm(apply.quarterly(SP5[kikan],mean)[,1] ~ apply.quarterly(PA[kikan],mean) * apply.quarterly(UC[kikan],mean) * G[kikan] *PROP[kikan] - apply.quarterly(UC[kikan],mean) ))
plot(predict(result),type='l',col=2,axes=F,ylim=c(0,2500),ylab="")
par(new=T)
plot(x,to.quarterly(SP5[kikan])[,1],type='l',ylim=c(0,2500))
axis(side=2, pos=as.Date("2017-01-01"))  # draw aux axis at 2017-01-01
axis(side=2, pos=as.Date("2010-01-01"),labels=F)  # draw aux axis at 2010-01-01
par(new=T)
plot(x,rep(2400,length(x)),type='l',col=3,ylim=c(0,2500)) # draw the line at 2400 level

summary(result)

Residual standard error: 61.12 on 87 degrees of freedom
Multiple R-squared:  0.9863, Adjusted R-squared:  0.9841
F-statistic: 446.8 on 14 and 87 DF,  p-value: < 2.2e-16

PAYEMS and UNDCONTSA forecast

# --------------------------------------- starts here
 library(forecast)
 as.xts(forecast(auto.arima(PA),h=10)$mean[1:10],as.Date(as.yearmon(seq(mondate(index(last(PA)))+1,by=1,length.out=10))))[(3-month(index(last(PA))) %% 3) + c(1,4,7)]
# --------------------------------------- ends here
               [,1]
2017-10-01 147069.6
2018-01-01 147531.6
2018-04-01 147967.9

# --------------------------------------- starts here
as.xts(forecast(auto.arima(UC),h=10)$mean[1:10],as.Date(as.yearmon(seq(mondate(index(last(UC)))+1,by=1,length.out=10))))[(3-month(index(last(UC))) %% 3) + c(1,4,7)]
# --------------------------------------- ends here
               [,1]
2017-10-01 1063.764
2018-01-01 1060.613
2018-04-01 1058.185

my_sp5(as.xts(as.vector(last(GDP)) * 1.05**(2/4),as.Date("2017-10-01")),147069.6,1063.764)


> my_sp5(as.xts(as.vector(last(GDP)) * 1.05**(2/4),as.Date("2017-10-01")),147069.6,1063.764)
[1] "m_m params! apply.quarter - UC w/ nominal GDP"
               [,1]
2017-10-01 2584.023
> my_sp5(as.xts(as.vector(last(GDP)) * 1.05**(3/4),as.Date("2018-01-01")),147531.6,1060.613)
[1] "m_m params! apply.quarter - UC w/ nominal GDP"
               [,1]
2018-01-01 2677.544
> my_sp5(as.xts(as.vector(last(GDP)) * 1.05**(4/4),as.Date("2018-04-01")),147967.9,1058.185)
[1] "m_m params! apply.quarter - UC w/ nominal GDP"
               [,1]
2018-04-01 2767.471