HW8.2
Abdullah Al Shammre
5/20/2017
Introduction
We will estimate a CAPM model with time-varying coefficients with time varying coefficient \(\alpha_t\) and \(\beta_t\). We will analyse the excess return of IBM stock and excess return of market.
Import data:
Use monthly data for the closing price of S&P 500 index, closing price of IBM stock, and for the annualized 3 month Treasury bill rate.
library("Quandl")## Loading required package: xts## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericQuandl.api_key('3fnnc4EE2uzFb1a44mAQ')library("xts")
library("zoo")
library("vars")## Loading required package: MASS## Loading required package: strucchange## Loading required package: sandwich## Loading required package: urca## Loading required package: lmtestlibrary("urca")
library("gdata")## gdata: read.xls support for 'XLS' (Excel 97-2004) files ENABLED.## ## gdata: read.xls support for 'XLSX' (Excel 2007+) files ENABLED.##
## Attaching package: 'gdata'## The following objects are masked from 'package:xts':
##
## first, last## The following object is masked from 'package:stats':
##
## nobs## The following object is masked from 'package:utils':
##
## object.size## The following object is masked from 'package:base':
##
## startsWithlibrary("stargazer")##
## Please cite as:## Hlavac, Marek (2015). stargazer: Well-Formatted Regression and Summary Statistics Tables.## R package version 5.2. http://CRAN.R-project.org/package=stargazerlibrary("dlmodeler")
library("KFAS")
library("forecast")SP500 <-Quandl("YAHOO/INDEX_GSPC/CLOSE",collapse="monthly", type="zoo")
IBM <-Quandl("GOOG/NYSE_IBM/CLOSE",collapse="monthly", type="zoo")
TB3MS <-Quandl("FRED/TB3MS",collapse="monthly", type="zoo")(a)
rSP500 <- 100*diff(log(SP500), differences = 1)
rIBM <- 100*diff(log(IBM), differences = 1)
rTB3MS<- TB3MS / 12par(mfrow=c(1,2), cex=0.8)
plot(log(SP500), xlab="Time", ylab="log(SP500)", main="log SP500")
plot(rSP500, xlab="Time", ylab="rSP500", main="100*diff. of log SP500")
plot(IBM, xlab="Time", ylab="IBM", main="IBM")
plot(rIBM, xlab="Time", ylab="rIBM", main="100*diff. of log IBM ")
plot(TB3MS, xlab="Time", ylab="TB3MS", main="Treasury Bill 3 Month")
plot(rTB3MS, xlab="Time", ylab="rTB3MS", main="100*diff. of log Treasury Bill 3 Month ")
By restrict SP500, IBM, and TB3MS over the window start at April 1981 to April 2017.
reg.rSP500 <- window(rSP500, start = 1981 + 3/12, end = 2017 + 3/12)
reg.rIBM <- window(rIBM, start = 1981 + 3/12, end = 2017 + 3/12)
reg.rTB3MS <- window(rTB3MS, start = 1981 + 3/12, end = 2017 + 3/12)par(mfrow=c(1,2), cex=0.8)
plot(reg.rSP500, xlab="Time", ylab="", main="100* diff. of log SP500")
plot(reg.rIBM, xlab="Time", ylab="", main="100*diff. of log IBM ")
plot(reg.rTB3MS, xlab="Time", ylab="", main="100*diff. of log Treasury Bill 3 Month")
(b)
excessSP500 <- reg.rSP500 - reg.rTB3MS
excessIBM <- reg.rIBM - reg.rTB3MS
simple.OLS <- lm(excessIBM ~ excessSP500)alpha.OLS <- simple.OLS$coefficients[1]
beta.OLS <- simple.OLS$coefficients[2]plot(excessIBM, excessSP500, main="A simple OLS relating excess returns for IBM S&P500")
abline(lm(excessSP500~excessIBM))
summary(simple.OLS)##
## Call:
## lm(formula = excessIBM ~ excessSP500)
##
## Residuals:
## Min 1Q Median 3Q Max
## -31.2343 -3.1235 -0.1644 3.4677 24.5022
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.09957 0.29559 -0.337 0.736
## excessSP500 0.92509 0.06804 13.597 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.134 on 431 degrees of freedom
## Multiple R-squared: 0.3002, Adjusted R-squared: 0.2986
## F-statistic: 184.9 on 1 and 431 DF, p-value: < 2.2e-16For the OLS estimated CAPM the \(\alpha\) and \(\beta\) have to be constant across time.We find that, \(\alpha\) is -0.09957 and \(\beta\) is 0.92509.
(c)
ss.excesssp500ts <- as.ts(excessSP500)
ss.excessIBMts <- as.ts(excessIBM)T <- length(ss.excesssp500ts)Zt <- array(rbind(rep(1,T), ss.excesssp500ts), dim=c(1,2,T))
Ht <- matrix(NA)
Tt <- diag(2)
Rt <- diag(2)
Qt <- matrix(c(NA,0,0,NA), 2,2)a1 <- matrix(c(0, 1), 2, 1)
P1 <- matrix(0, 2, 2)
P1inf <- diag(2)y.ss <- SSModel(ss.excessIBMts ~ -1 + SSMcustom(Z=Zt, T=Tt, R=Rt, Q=Qt, a1=a1, P1=P1, P1inf=P1inf), H=Ht)y.ss.ML <- fitSSM(y.ss, inits = c(0.001,0.001,0.001), method="BFGS")y.ss.KFS <- KFS(y.ss.ML$model)alpha.KFS <- ts( cbind(y.ss.KFS$a[,1], y.ss.KFS$alphahat[,1]), start=c(1981,4), frequency=12)
beta.KFS <- ts( cbind(y.ss.KFS$a[,2], y.ss.KFS$alphahat[,2]), start=c(1981,4), frequency=12)par(mfrow=c(1,2), cex=0.8)
plot.ts(alpha.KFS, plot.type="single", xlab="Time",ylab= expression(alpha), col=c("blue","red"), lwd=2)
legend("topright", c("filtered","smoothed"), col=c("blue","red"), lwd=2, cex=0.7, bty="n")
plot.ts(beta.KFS, plot.type="single", xlab="Time",ylab= expression(beta), col=c("blue","red"), lwd=2)
legend("topright", c("filtered","smoothed"), col=c("blue","red"), lwd=2, cex=0.7, bty="n")
par(mfrow=c(1,2), cex=0.8)
plot.ts(alpha.KFS[,2], plot.type="single", xlab="Time",ylab= expression(alpha), col="red", lwd=2)
legend("topright", "smoothed", col="red", lwd=2, cex=0.7, bty="n")
plot.ts(beta.KFS[,2], plot.type="single", xlab="Time",ylab= expression(beta), col="red", lwd=2)
legend("topright", "smoothed", col="red", lwd=2, cex=0.7, bty="n")
(d)
mean(simple.OLS$coefficients[1])## [1] -0.09956639mean(simple.OLS$coefficients[2])## [1] 0.9250887This is the simple OLS \(\alpha_t\) and \(\beta_t\).
Kalman filtered smoothed:
mean(y.ss.KFS$alphahat[, 1])## [1] -0.07471126mean(y.ss.KFS$alphahat[, 2])## [1] 0.9228255Conclusions
Based on the results, all the \(\beta\) are the same about (0.92). Also, the \(\alpha\) of OLS is same with the \(\alpha\) of the other models. When \(\alpha\) and \(\beta\) are not constant, state space model better than a simple OLS which consider that \(\alpha\) and \(\beta\) for CAPM are constant.