Import dataDownload ETF daily data from yahoo with ticker names of
SPY, QQQ, EEM, IWM, EFA, TLT, IYR andGLD from 2010 to current date (See
http://etfdb.com/ for ETF
information). (Hint: Use libraryquantmodto help you to download these
prices and use adjusted prices for your computation.)
x<-c("quantmod", "tidyquant", "lubridate", "timetk", "purrr","tidyverse", "tibble", "readr", "xts", "PerformanceAnalytics", "magrittr", "dplyr")
lapply(x, require, character.only = TRUE)
## Loading required package: quantmod
## Loading required package: xts
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## Loading required package: tidyquant
## Loading required package: lubridate
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
## Loading required package: PerformanceAnalytics
##
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend
## Loading required package: timetk
## Loading required package: purrr
## Loading required package: tidyverse
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ stringr 1.5.0
## ✔ forcats 1.0.0 ✔ tibble 3.2.1
## ✔ ggplot2 3.4.4 ✔ tidyr 1.3.0
## ✔ readr 2.1.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks xts::first()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks xts::last()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## Loading required package: magrittr
##
##
## Attaching package: 'magrittr'
##
##
## The following object is masked from 'package:tidyr':
##
## extract
##
##
## The following object is masked from 'package:purrr':
##
## set_names
## [[1]]
## [1] TRUE
##
## [[2]]
## [1] TRUE
##
## [[3]]
## [1] TRUE
##
## [[4]]
## [1] TRUE
##
## [[5]]
## [1] TRUE
##
## [[6]]
## [1] TRUE
##
## [[7]]
## [1] TRUE
##
## [[8]]
## [1] TRUE
##
## [[9]]
## [1] TRUE
##
## [[10]]
## [1] TRUE
##
## [[11]]
## [1] TRUE
##
## [[12]]
## [1] TRUE
tickers <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
data = new.env()
getSymbols(tickers, src = 'yahoo', from = '2010-01-01', to = '2021-04-14', auto.assign = TRUE)
## [1] "SPY" "QQQ" "EEM" "IWM" "EFA" "TLT" "IYR" "GLD"
etf_data <- merge(Ad(SPY), Ad(QQQ),Ad(EEM), Ad(IWM),Ad(EFA),Ad(TLT),Ad(IYR),Ad(GLD))
colnames(etf_data) <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
head(etf_data)
## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 85.76847 40.48580 31.08409 51.92012 36.38437 58.68237 27.40290
## 2010-01-05 85.99548 40.48580 31.30971 51.74158 36.41644 59.06135 27.46869
## 2010-01-06 86.05602 40.24161 31.37522 51.69287 36.57037 58.27070 27.45672
## 2010-01-07 86.41929 40.26777 31.19327 52.07431 36.42926 58.36876 27.70198
## 2010-01-08 86.70688 40.59921 31.44072 52.35832 36.71788 58.34264 27.51654
## 2010-01-11 86.82797 40.43350 31.37522 52.14733 37.01932 58.02243 27.64815
## GLD
## 2010-01-04 109.80
## 2010-01-05 109.70
## 2010-01-06 111.51
## 2010-01-07 110.82
## 2010-01-08 111.37
## 2010-01-11 112.85
Calculate weekly and monthly returns using discrete returns.
etf_data.xts <- xts(etf_data)
head(etf_data)
## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 85.76847 40.48580 31.08409 51.92012 36.38437 58.68237 27.40290
## 2010-01-05 85.99548 40.48580 31.30971 51.74158 36.41644 59.06135 27.46869
## 2010-01-06 86.05602 40.24161 31.37522 51.69287 36.57037 58.27070 27.45672
## 2010-01-07 86.41929 40.26777 31.19327 52.07431 36.42926 58.36876 27.70198
## 2010-01-08 86.70688 40.59921 31.44072 52.35832 36.71788 58.34264 27.51654
## 2010-01-11 86.82797 40.43350 31.37522 52.14733 37.01932 58.02243 27.64815
## GLD
## 2010-01-04 109.80
## 2010-01-05 109.70
## 2010-01-06 111.51
## 2010-01-07 110.82
## 2010-01-08 111.37
## 2010-01-11 112.85
WEEKLY - Only count the last day of the week. exclude na values
weekly_returns <- to.weekly(etf_data.xts, indexAt = "last", OHLC = FALSE)
etf_weekly_returns <- na.omit(Return.calculate(weekly_returns, method = "discrete"))
head(etf_weekly_returns)
## SPY QQQ EEM IWM EFA
## 2010-01-15 -0.008117577 -0.015038094 -0.02893523 -0.01301920 -0.003493475
## 2010-01-22 -0.038982704 -0.036859176 -0.05578071 -0.03062186 -0.055740634
## 2010-01-29 -0.016664770 -0.031023425 -0.03357737 -0.02624327 -0.025802752
## 2010-02-05 -0.006797858 0.004440173 -0.02821298 -0.01397420 -0.019055130
## 2010-02-12 0.012938311 0.018148056 0.03333329 0.02952568 0.005244899
## 2010-02-19 0.028693127 0.024452194 0.02445373 0.03343160 0.022994799
## TLT IYR GLD
## 2010-01-15 2.004685e-02 -0.006304122 -0.004579349
## 2010-01-22 1.010117e-02 -0.041785214 -0.033285246
## 2010-01-29 3.368942e-03 -0.008447197 -0.011290465
## 2010-02-05 -5.388501e-05 0.003223502 -0.012080019
## 2010-02-12 -1.946056e-02 -0.007574154 0.022544905
## 2010-02-19 -8.204846e-03 0.050184868 0.022701796
MONTHLY - Only count the last day of the month, exclude na
values
monthly_returns <- to.monthly(etf_data.xts, indexAt = "last", OHLC = FALSE)
etf_monthly_returns <- na.omit(Return.calculate(monthly_returns, method = "discrete"))
head(etf_monthly_returns)
## SPY QQQ EEM IWM EFA
## 2010-02-26 0.03119420 0.04603862 0.017763832 0.04475105 0.002667566
## 2010-03-31 0.06087991 0.07710917 0.081108610 0.08230692 0.063854431
## 2010-04-30 0.01547013 0.02242521 -0.001661535 0.05678500 -0.028046130
## 2010-05-28 -0.07945426 -0.07392321 -0.093936049 -0.07536675 -0.111927948
## 2010-06-30 -0.05174125 -0.05975711 -0.013986280 -0.07743395 -0.020619263
## 2010-07-30 0.06830042 0.07258250 0.109324769 0.06730929 0.116103931
## TLT IYR GLD
## 2010-02-26 -0.003424165 0.05457017 0.032748219
## 2010-03-31 -0.020573885 0.09748474 -0.004386396
## 2010-04-30 0.033218371 0.06388156 0.058834363
## 2010-05-28 0.051083359 -0.05683559 0.030513147
## 2010-06-30 0.057979359 -0.04670120 0.023553189
## 2010-07-30 -0.009464080 0.09404813 -0.050871157
Download Fama French 3 factors data and change to digit numbers (not
inpercentage): •Go to http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/data_library.html
•Download Fama/French 3 factor returns’ monthly data (Mkt-RF, SMB and
HML).
library(readr)
fama <- read_csv("C:\\Users\\quanj\\Downloads\\F-F_Research_Data_Factors_CSV\\F-F_Research_Data_Factors.CSV")
## Warning: One or more parsing issues, call `problems()` on your data frame for details,
## e.g.:
## dat <- vroom(...)
## problems(dat)
## Rows: 1285 Columns: 1
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): This file was created by CMPT_ME_BEME_RETS using the 202412 CRSP da...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
print(head(fama))
## # A tibble: 6 × 1
## `This file was created by CMPT_ME_BEME_RETS using the 202412 CRSP database.`
## <chr>
## 1 The 1-month TBill rate data until 202405 are from Ibbotson Associates. Starti…
## 2 ,Mkt-RF,SMB,HML,RF
## 3 192607, 2.96, -2.56, -2.43, 0.22
## 4 192608, 2.64, -1.17, 3.82, 0.25
## 5 192609, 0.36, -1.40, 0.13, 0.23
## 6 192610, -3.24, -0.09, 0.70, 0.32
head(fama)
## # A tibble: 6 × 1
## `This file was created by CMPT_ME_BEME_RETS using the 202412 CRSP database.`
## <chr>
## 1 The 1-month TBill rate data until 202405 are from Ibbotson Associates. Starti…
## 2 ,Mkt-RF,SMB,HML,RF
## 3 192607, 2.96, -2.56, -2.43, 0.22
## 4 192608, 2.64, -1.17, 3.82, 0.25
## 5 192609, 0.36, -1.40, 0.13, 0.23
## 6 192610, -3.24, -0.09, 0.70, 0.32
head(fama.digit)
fama.digit <- fama.digit[!is.na(fama.digit\(date) &
###!is.infinite(as.numeric(fama.digit\)date)), ]
fama.digit.xts <- xts(fama.digit[, -1], order.by =
as.Date(fama.digit$date))
head(fama.digit.xts)
#Merge with ETF Monthly returns
### merge_data <- merge(fama.digit, etf_monthly_returns)
### tail(merge_data)
#5) Based on CAPM model, compute MVP monthly returns based on estimated covariance matrix for the 8-asset portfolio by using past 60-month returns from 2019/03 - 2024/02.
### calc_data <- merge_data_tibble[merge_data_tibble$date>="2019-03-01"&merge_data_tibble$date<="2024-02-01",]
head(calc_data)
spy_rf <- merge_data_tibble\(SPY-merge_data_tibble\)RF
qqq_rf <- merge_data_tibble\(QQQ-merge_data_tibble\)RF
eem_rf <- merge_data_tibble\(EEM-merge_data_tibble\)RF
iwm_rf <- merge_data_tibble\(IWM-merge_data_tibble\)RF
efa_rf <- merge_data_tibble\(EFA-merge_data_tibble\)RF
tlt_rf <- merge_data_tibble\(TLT-merge_data_tibble\)RF
iyr_rf <- merge_data_tibble\(IYR-merge_data_tibble\)RF
gld_rf <- merge_data_tibble\(GLD-merge_data_tibble\)RF
y <-
cbind(spy_rf,qqq_rf,eem_rf,iwm_rf,efa_rf,tlt_rf,iyr_rf,gld_rf)
n <- nrow(y)
one.vec <- rep(1,n)
x <- cbind(one.vec,merge_data_tibble$MKT-RF)
x.mat <- as.matrix(x)
beta <- solve(t(x)%%x)%%t(x)%*%y
beta
#residual
### e.hat <- y - x%*%beta
### res.var <- diag(t(e.hat)%*%e.hat)/(n-2)
### d <- diag(res.var);d
covariance matrix single factor model
cov.mat <-
var(merge_data_tibble$MKT-RF)t(beta)%%beta +
d
cov.mat
mvp montly returns of 8 assest CAMP
one.vec2 <- rep(1,8)
top <- solve(cov.mat)%*%one.vec2
bot <- t(one.vec2)%*%top
mvp_capm <- top/as.numeric(bot)
mvp_capm```
6)Based on FF 3-factor model, compute MVP monthly returns covariance
matrix for the 8-asset portfolio by using past 60-month returns from
2019/03 - 2024/02.
t <- dim(calc_data)[1]
markets <- calc_data[,c(2,3,4)]
FM <- calc_data[,c(-1,-2,-3,-4,-5)]
head(FM)
FM <- as.matrix(FM)
n <- dim(FM)[2]
one_vec <- rep(1,t)
p <- cbind(one_vec,markets)
p <- as.matrix(p)
b.hat <- solve(t(p)%%p)%%t(p)%*%FM
res <- FM-p%*%b.hat
diag.d <- diag(t(res)%*%res)/(t-6)
diag.d
retvar <- apply(FM,2,var)
rsq <- 1-diag(t(res)%*%res)/((t-1)/retvar)
res.stdev <- sqrt(diag.d)
factor.cov <- var(FM)t(b.hat)%%b.hat+diag(diag.d)
stdev <- sqrt(diag(factor.cov))
factor.cor <- factor.cov/(stdev%*%t(stdev))
factor.cor
sample.cov <- cov(FM)
sample.cor <- cor(FM)
sample.cov
one <- rep(1,8)
top.mat <- solve(factor.cov)%*%one
bot.mat <- t(one)%*%top.mat
MVP_FF3 <- top.mat/as.numeric(bot.mat)
MVP_FF3
You can invest in the 8-asset portfolio in 2024/03 based on the
optimal weightsof MVP from question 5 and 6. What are the realized
portfolio returns in theMarch of 2024 using the weights from question 5
and 6?2
calc_data2 <- tail(merge_data_tibble, n=1)
head(calc_data2)
calc_data2 <- calc_data2[c(-1,-2,-3,-4,-5)]
calc_data2
With weights
returns_q5 <- rowSums(calc_data2*mvp_capm)
returns_q5
returns_q6 <- rowSums(calc_data2*MVP_FF3)
returns_q6