Implementing Capital Asset Pricing Model (CAPM)
Janpu Hou
January 31, 2017
Reguire to install library(tseries)
see https://faculty.washington.edu/ezivot/econ424/portfoliofunctions.pdf.
https://systematicinvestor.wordpress.com/2013/03/22/maximum-sharpe-portfolio/.
http://nakisa.org/bankr-useful-financial-r-snippets/risk-parity-portfolios-r/.
https://cos.name/wp-content/uploads/2011/11/ChinaR2011_SH_Nov13_03_ysd.pdf.
E(Ri) = Rf + βi * (E(Rm) – Rf) Where: E(Ri) is the expect return of an asset Rf is the risk-free return, we usually use the interest rate of T-Bills as the Rf E(Rm) is the expected return of the market, we usually use SP500 index return as the US stock market βi is the sensitivity of the expected excess asset return to the expected excess market return. We can get the value of βi by do a regression on the historical data of the excess returns of an asset and the market.
E(Ri) = Rf + βi * (E(Rm) – Rf)
library(tseries)## Warning: package 'tseries' was built under R version 3.3.3MyData <- read.csv(file="C:/Users/Janpu/Documents/R_Files/return.csv", header=TRUE, sep=",")
# Monthly Return of Investment of Interest
head(MyData)## Month T.Bills SP500 MMM JNJ PG
## 1 4/1/2010 0.0015 -0.08197592 -0.100012182 -0.084992210 -0.017177262
## 2 5/1/2010 0.0015 -0.05388238 -0.004060639 0.013053348 -0.018198198
## 3 6/1/2010 0.0008 0.06877783 0.083038869 -0.016433240 0.027711507
## 4 7/1/2010 0.0016 -0.04744917 -0.076044673 -0.009303209 -0.024464286
## 5 8/1/2010 0.0015 0.08755110 0.103897868 0.086814872 0.005125389
## 6 9/1/2010 0.0012 0.03685594 -0.028666339 0.028566390 0.068111455
## WMT
## 1 -0.05195068
## 2 -0.04925373
## 3 0.06503700
## 4 -0.01495052
## 5 0.06755024
## 6 0.01201442exReturn <- read.csv(file="C:/Users/Janpu/Documents/R_Files/ExcessRt.csv", header=TRUE, sep=",")
# Excess Return of Investment of Interest
head(exReturn)## Month SP500_ExcessR MMM_ExcessR JNJ_ExcessR PG_ExcessR WMT_ExcessR
## 1 2010/4/1 -0.08347592 -0.101512182 -0.08649221 -0.018677262 -0.05345068
## 2 2010/5/1 -0.05538238 -0.005560639 0.01155335 -0.019698198 -0.05075373
## 3 2010/6/1 0.06797783 0.082238869 -0.01723324 0.026911507 0.06423700
## 4 2010/7/1 -0.04904916 -0.077644673 -0.01090321 -0.026064286 -0.01655052
## 5 2010/8/1 0.08605110 0.102397868 0.08531487 0.003625389 0.06605023
## 6 2010/9/1 0.03565594 -0.029866339 0.02736639 0.066911455 0.01081442# Box plot expected return
exReturn <- exReturn[,-1]
boxplot(exReturn,main="Expected Return", xlab="Stock Picks", ylab="Return")
# Compute Mean and Standard Deviation of Expected Return
Mean=sapply(exReturn,mean)
Rf = mean(MyData$T.Bills)
paste("Market Free Retrun = ",Rf*100, "%")## [1] "Market Free Retrun = 0.0735135135135135 %"SD=sapply(exReturn,sd)
cbind(Mean,SD)## Mean SD
## SP500_ExcessR 0.008837961 0.04298597
## MMM_ExcessR 0.008758935 0.05381220
## JNJ_ExcessR 0.010740620 0.03862065
## PG_ExcessR 0.008919860 0.03794766
## WMT_ExcessR 0.012765898 0.04456828# We will use the mean and standard deviation of SP500 excess returns as the market excess return and risk (standard deviation).CAPM
According to the CAPM formula, we will first get the beta of each stock by regressions; then further calculate the expected return of each stock and the covariance matrix of the four stocks; finally we can calculate the optimal asset allocations (weights) of the portfolio consisting of the four stocks.
Beta
attach(exReturn)
lm.MMM<- lm(MMM_ExcessR ~ SP500_ExcessR)
summary(lm.MMM)##
## Call:
## lm(formula = MMM_ExcessR ~ SP500_ExcessR)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.066906 -0.015134 0.006473 0.019116 0.053404
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0005611 0.0049388 -0.114 0.91
## SP500_ExcessR 1.0545439 0.1140273 9.248 6.29e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.02941 on 35 degrees of freedom
## Multiple R-squared: 0.7096, Adjusted R-squared: 0.7013
## F-statistic: 85.53 on 1 and 35 DF, p-value: 6.291e-11plot(SP500_ExcessR,MMM_ExcessR, xlim=c(-0.20,0.20),ylim=c(-0.20,0.20),main="Beta")
BetaMMM <- summary(lm.MMM)$coefficients[2, 1]
abline(lm.MMM, col="blue")
text(-0.2, 0.2, BetaMMM, pos = 4)
Rstde <- summary(lm.MMM)$sigma
paste("MMM Beta = ",BetaMMM)## [1] "MMM Beta = 1.05454385483812"paste("MMM Standard Deviation = ",Rstde)## [1] "MMM Standard Deviation = 0.0294094381997514"coefs <- coef(lm.MMM)
paste("alpha = ",coefs[1])## [1] "alpha = -0.000561081840719523"paste("beta = ",coefs[2])## [1] "beta = 1.05454385483812"lm.JNJ<- lm(JNJ_ExcessR ~ SP500_ExcessR)
summary(lm.JNJ)##
## Call:
## lm(formula = JNJ_ExcessR ~ SP500_ExcessR)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.05674 -0.02364 -0.00549 0.02592 0.08938
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.006864 0.005740 1.196 0.23986
## SP500_ExcessR 0.438671 0.132533 3.310 0.00217 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.03418 on 35 degrees of freedom
## Multiple R-squared: 0.2384, Adjusted R-squared: 0.2166
## F-statistic: 10.96 on 1 and 35 DF, p-value: 0.002171plot(SP500_ExcessR,JNJ_ExcessR, xlim=c(-0.20,0.20),ylim=c(-0.20,0.20),main="Beta")
abline(lm.JNJ, col="blue")
BetaJNJ <- summary(lm.JNJ)$coefficients[2, 1]
text(-0.2, 0.2, BetaJNJ, pos = 4)
lm.PG<- lm(PG_ExcessR ~ SP500_ExcessR)
summary(lm.PG)##
## Call:
## lm(formula = PG_ExcessR ~ SP500_ExcessR)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.068517 -0.023356 -0.002563 0.023847 0.092445
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.005848 0.005941 0.984 0.3317
## SP500_ExcessR 0.347552 0.137168 2.534 0.0159 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.03538 on 35 degrees of freedom
## Multiple R-squared: 0.155, Adjusted R-squared: 0.1309
## F-statistic: 6.42 on 1 and 35 DF, p-value: 0.01592plot(SP500_ExcessR,PG_ExcessR, xlim=c(-0.20,0.20),ylim=c(-0.20,0.20),main="Beta")
abline(lm.PG, col="blue")
BetaPG <- summary(lm.PG)$coefficients[2, 1]
text(-0.2, 0.2, BetaPG, pos = 4)
lm.WMT<- lm(WMT_ExcessR ~ SP500_ExcessR)
summary(lm.WMT)##
## Call:
## lm(formula = WMT_ExcessR ~ SP500_ExcessR)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.095795 -0.029497 -0.002083 0.022572 0.140161
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.00925 0.00701 1.320 0.1955
## SP500_ExcessR 0.39777 0.16184 2.458 0.0191 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.04174 on 35 degrees of freedom
## Multiple R-squared: 0.1472, Adjusted R-squared: 0.1228
## F-statistic: 6.04 on 1 and 35 DF, p-value: 0.01908plot(SP500_ExcessR,WMT_ExcessR, xlim=c(-0.20,0.20),ylim=c(-0.20,0.20),main="Beta")
abline(lm.WMT, col="blue")
BetaWMT <- summary(lm.WMT)$coefficients[2, 1]
text(-0.2, 0.2, BetaWMT, pos = 4)
paste("Beta of MMM: ", BetaMMM)## [1] "Beta of MMM: 1.05454385483812"paste("Beta of JNJ: ", BetaJNJ)## [1] "Beta of JNJ: 0.438670607225637"paste("Beta of PG: ", BetaPG)## [1] "Beta of PG: 0.347551686267287"paste("Beta of MMM: ", BetaWMT)## [1] "Beta of MMM: 0.397765815798328"the covariance matrix of the four stocks
k <- ncol(M) #number of variables n <- nrow(M) #number of subjects
create means for each column
M_mean <- matrix(data=1, nrow=n) %*% cbind(mean(a),mean(b),mean(c),mean(d),mean(e))
creates a difference matrix
D <- M - M_mean
creates the covariance matrix
C <- (n-1)^-1 t(D) %*% D
or just use built-in function cov()
M <- cov(exReturn[,2:5])
M## MMM_ExcessR JNJ_ExcessR PG_ExcessR WMT_ExcessR
## MMM_ExcessR 0.0028957525 0.0010141198 0.0005303840 0.0007643704
## JNJ_ExcessR 0.0010141198 0.0014915545 0.0006024992 0.0006327023
## PG_ExcessR 0.0005303840 0.0006024992 0.0014400250 0.0003698269
## WMT_ExcessR 0.0007643704 0.0006327023 0.0003698269 0.0019863319Expected excess return of MMM =βMMM * Expected excess return of SP500
E(RMMM) – Rf =βMMM * (E(Rm) – Rf), that is,
Expected excess return of MMM =βMMM * Expected excess return of SP500,
Where: The expected excess return of SP500 is the mean value
In general case, finding the Maximum Sharpe Portfolio requires a non-linear solver because we want to find portfolio weights w to maximize w’ mu / sqrt( w’ V w ) (i.e. Sharpe Ratio is a non-linear function of w).
ERm = mean(exReturn$SP500_ExcessR)
Rf = mean(MyData$T.Bills)
ERMMM = Rf + BetaMMM*(ERm-Rf)
ERJNJ = Rf + BetaJNJ*(ERm-Rf)
ERPG = Rf + BetaPG*(ERm-Rf)
ERWMT = Rf + BetaWMT*(ERm-Rf)
ER <- c(ERMMM,ERJNJ,ERPG,ERWMT)
Eret <- matrix(ER, nrow=1)
paste("Expected Return of MMM: ", ERMMM)## [1] "Expected Return of MMM: 0.00927991984473042"paste("Expected Return of JNJ: ", ERJNJ)## [1] "Expected Return of JNJ: 0.00428960646411168"paste("Expected Return of PG: ", ERPG)## [1] "Expected Return of PG: 0.00355128575891991"paste("Expected Return of MMM: ", ERWMT)## [1] "Expected Return of MMM: 0.00395816208203721"Mcov <- cov(exReturn[,2:5])
#weights <- maxSharpe(Eret,Mcov,shorts=F)