Midterm Exam
Mark Raphael T. Flores
4/16/2021
library(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 zoolibrary(readr)
library(xts)
library(PerformanceAnalytics)##
## Attaching package: 'PerformanceAnalytics'## The following object is masked from 'package:graphics':
##
## legendlibrary(magrittr)
library(xts)
library(tibble)
library(readr)
library(tidyr)##
## Attaching package: 'tidyr'## The following object is masked from 'package:magrittr':
##
## extractlibrary(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:xts':
##
## first, last## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyquant)## Loading required package: lubridate##
## Attaching package: 'lubridate'## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union## ══ Need to Learn tidyquant? ════════════════════════════════════════════════════
## Business Science offers a 1-hour course - Learning Lab #9: Performance Analysis & Portfolio Optimization with tidyquant!
## </> Learn more at: https://university.business-science.io/p/learning-labs-pro </>library(lubridate)
library(timetk)
library(purrr)##
## Attaching package: 'purrr'## The following object is masked from 'package:magrittr':
##
## set_nameslibrary(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──## ✓ ggplot2 3.3.3 ✓ forcats 0.5.1
## ✓ stringr 1.4.0## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x lubridate::as.difftime() masks base::as.difftime()
## x lubridate::date() masks base::date()
## x tidyr::extract() masks magrittr::extract()
## x dplyr::filter() masks stats::filter()
## x dplyr::first() masks xts::first()
## x lubridate::intersect() masks base::intersect()
## x dplyr::lag() masks stats::lag()
## x dplyr::last() masks xts::last()
## x purrr::set_names() masks magrittr::set_names()
## x lubridate::setdiff() masks base::setdiff()
## x lubridate::union() masks base::union()library(tibble)1. Import data
#Download ETF daily data from yahoo with ticker names of SPY, QQQ, EEM, IWM, EFA, TLT, IYR and GLD from 2010 to current date (See http://etfdb.com/ for ETF information). (Hint: Use library quantmod to help you to download these prices and use adjusted prices for your computation.)
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)## 'getSymbols' currently uses auto.assign=TRUE by default, but will
## use auto.assign=FALSE in 0.5-0. You will still be able to use
## 'loadSymbols' to automatically load data. getOption("getSymbols.env")
## and getOption("getSymbols.auto.assign") will still be checked for
## alternate defaults.
##
## This message is shown once per session and may be disabled by setting
## options("getSymbols.warning4.0"=FALSE). See ?getSymbols for details.## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols
## pausing 1 second between requests for more than 5 symbols## [1] "SPY" "QQQ" "EEM" "IWM" "EFA" "TLT" "IYR" "GLD"ETFdailydata <- merge(Ad(SPY), Ad(QQQ),Ad(EEM), Ad(IWM),Ad(EFA),Ad(TLT),Ad(IYR),Ad(GLD))
colnames(ETFdailydata) <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
head(ETFdailydata)## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 90.79006 41.51847 34.10928 54.61730 41.03314 66.13428 30.41554
## 2010-01-05 91.03041 41.51847 34.35684 54.42949 41.06930 66.56142 30.48858
## 2010-01-06 91.09449 41.26806 34.42872 54.37827 41.24289 65.67038 30.47530
## 2010-01-07 91.47905 41.29489 34.22906 54.77949 41.08377 65.78078 30.74751
## 2010-01-08 91.78343 41.63475 34.50059 55.07827 41.40926 65.75137 30.54169
## 2010-01-11 91.91164 41.46482 34.42872 54.85632 41.74921 65.39054 30.68776
## 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.85tail(ETFdailydata)## SPY QQQ EEM IWM EFA TLT IYR GLD
## 2021-04-06 406.12 330.82 54.37 224.31 77.15 137.84 94.20 163.22
## 2021-04-07 406.59 331.62 53.57 220.69 77.31 136.88 94.20 162.76
## 2021-04-08 408.52 335.08 54.01 222.56 77.75 138.01 93.97 164.51
## 2021-04-09 411.49 337.11 53.55 222.59 77.99 137.51 93.96 163.27
## 2021-04-12 411.64 336.67 53.23 221.72 77.56 137.45 94.47 162.28
## 2021-04-13 412.86 340.60 53.45 221.14 78.01 138.48 95.04 163.43ETFdailydata.xts <- xts(ETFdailydata)
head(ETFdailydata.xts)## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 90.79006 41.51847 34.10928 54.61730 41.03314 66.13428 30.41554
## 2010-01-05 91.03041 41.51847 34.35684 54.42949 41.06930 66.56142 30.48858
## 2010-01-06 91.09449 41.26806 34.42872 54.37827 41.24289 65.67038 30.47530
## 2010-01-07 91.47905 41.29489 34.22906 54.77949 41.08377 65.78078 30.74751
## 2010-01-08 91.78343 41.63475 34.50059 55.07827 41.40926 65.75137 30.54169
## 2010-01-11 91.91164 41.46482 34.42872 54.85632 41.74921 65.39054 30.68776
## 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.852. Calculate weekly and monthly returns using log returns
Weekly Returns
weekly.returns <- to.weekly(ETFdailydata.xts, indexAt = "last", OHLC = FALSE)
ETF.weekly.returns <- na.omit(Return.calculate(weekly.returns, method = "log"))
head(ETF.weekly.returns)## SPY QQQ EEM IWM EFA
## 2010-01-15 -0.008150165 -0.015151916 -0.02936168 -0.01310462 -0.003499562
## 2010-01-22 -0.039762828 -0.037555380 -0.05739709 -0.03110062 -0.057354555
## 2010-01-29 -0.016805812 -0.031515101 -0.03415421 -0.02659356 -0.026141568
## 2010-02-05 -0.006820546 0.004430648 -0.02861835 -0.01407321 -0.019238635
## 2010-02-12 0.012854811 0.017985357 0.03278946 0.02909861 0.005230847
## 2010-02-19 0.028289444 0.024157168 0.02415967 0.03288489 0.022734954
## TLT IYR GLD
## 2010-01-15 0.0198483225 -0.006324356 -0.004589865
## 2010-01-22 0.0100512027 -0.042683345 -0.033851813
## 2010-01-29 0.0033633583 -0.008483115 -0.011354685
## 2010-02-05 -0.0000540947 0.003218256 -0.012153577
## 2010-02-12 -0.0196525984 -0.007602937 0.022294528
## 2010-02-19 -0.0082390553 0.048966490 0.022447943tail(ETF.weekly.returns)## SPY QQQ EEM IWM EFA
## 2021-03-12 0.026824595 0.021726770 0.002967912 0.070403521 0.0218682367
## 2021-03-19 -0.008420718 -0.007381431 0.001665587 -0.028881750 0.0019645216
## 2021-03-26 0.016551188 0.010353968 -0.015091148 -0.026410480 0.0022217614
## 2021-04-01 0.011624615 0.026759037 0.011014785 0.014088245 0.0033885475
## 2021-04-09 0.026796346 0.037907991 -0.005772328 -0.005153190 0.0145949896
## 2021-04-13 0.003323822 0.010299544 -0.001869122 -0.006535516 0.0002564615
## TLT IYR GLD
## 2021-03-12 -0.020730332 0.051252724 0.0146589405
## 2021-03-19 -0.009674772 -0.009175922 0.0107782890
## 2021-03-26 0.014074908 0.034467797 -0.0061447899
## 2021-04-01 0.007567299 0.009016849 -0.0016039051
## 2021-04-09 0.000000000 0.004052442 0.0079324505
## 2021-04-13 0.007029277 0.011428717 0.0009794246Monthly returns
monthly.returns <- to.monthly(ETFdailydata.xts, indexAt = "last", OHLC = FALSE)
ETF.monthly.returns <- na.omit(Return.calculate(monthly.returns, method = "log"))
head(ETF.monthly.returns)## SPY QQQ EEM IWM EFA
## 2010-02-26 0.03071793 0.04501044 0.01760802 0.04377882 0.002664268
## 2010-03-31 0.05909865 0.07428087 0.07798729 0.07909466 0.061898269
## 2010-04-30 0.01535150 0.02217754 -0.00166310 0.05523070 -0.028446722
## 2010-05-28 -0.08278878 -0.07679864 -0.09864508 -0.07835767 -0.118702355
## 2010-06-30 -0.05312741 -0.06161677 -0.01408547 -0.08059619 -0.020834896
## 2010-07-30 0.06606917 0.07006933 0.10375152 0.06514060 0.109844203
## TLT IYR GLD
## 2010-02-26 -0.003430817 0.05313334 0.032223420
## 2010-03-31 -0.020787064 0.09302102 -0.004396042
## 2010-04-30 0.032678511 0.06192375 0.057168648
## 2010-05-28 0.049821843 -0.05851441 0.030056874
## 2010-06-30 0.056358956 -0.04782683 0.023280092
## 2010-07-30 -0.009508418 0.08988455 -0.052210719tail(ETF.monthly.returns)## SPY QQQ EEM IWM EFA
## 2020-11-30 0.10325753 0.106391900 0.086097691 0.1675816003 0.133388954
## 2020-12-31 0.03637851 0.047860577 0.068867768 0.0829288210 0.048936800
## 2021-01-29 -0.01024267 0.002610233 0.031246646 0.0473172758 -0.007843178
## 2021-02-26 0.02742592 -0.001336071 0.007847555 0.0601780664 0.022132092
## 2021-03-31 0.04439891 0.017022008 -0.007284986 0.0138539151 0.024821143
## 2021-04-13 0.04086135 0.065110227 0.002060137 0.0009048001 0.027815660
## TLT IYR GLD
## 2020-11-30 0.01650212 0.082312759 -0.05560390
## 2020-12-31 -0.01235245 0.024725619 0.06778819
## 2021-01-29 -0.03700419 -0.004329307 -0.03276927
## 2021-02-26 -0.05903855 0.023983094 -0.06461193
## 2021-03-31 -0.05387828 0.056135171 -0.01149897
## 2021-04-13 0.02349007 0.033161654 0.021460893. Convert monthly returns into tibble format.
ETF.monthly.returns.tibble <- as_tibble(ETF.monthly.returns)
ETF.monthly.returns.tibble## # A tibble: 135 x 8
## SPY QQQ EEM IWM EFA TLT IYR GLD
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.0307 0.0450 0.0176 0.0438 0.00266 -0.00343 0.0531 0.0322
## 2 0.0591 0.0743 0.0780 0.0791 0.0619 -0.0208 0.0930 -0.00440
## 3 0.0154 0.0222 -0.00166 0.0552 -0.0284 0.0327 0.0619 0.0572
## 4 -0.0828 -0.0768 -0.0986 -0.0784 -0.119 0.0498 -0.0585 0.0301
## 5 -0.0531 -0.0616 -0.0141 -0.0806 -0.0208 0.0564 -0.0478 0.0233
## 6 0.0661 0.0701 0.104 0.0651 0.110 -0.00951 0.0899 -0.0522
## 7 -0.0460 -0.0527 -0.0329 -0.0774 -0.0387 0.0806 -0.0131 0.0555
## 8 0.0858 0.124 0.111 0.117 0.0951 -0.0255 0.0453 0.0467
## 9 0.0375 0.0615 0.0297 0.0406 0.0373 -0.0457 0.0386 0.0362
## 10 0 -0.00173 -0.0295 0.0343 -0.0494 -0.0170 -0.0160 0.0209
## # … with 125 more rows4. Download Fama French 3 factors data and change to digit numbers (not in percetage): -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) and Convert into xts data.
ffdata <- read_csv("F-F_Research_Data_Factors.csv")##
## ── Column specification ────────────────────────────────────────────────────────
## cols(
## Date = col_double(),
## `Mkt-RF` = col_double(),
## SMB = col_double(),
## HML = col_double(),
## RF = col_double()
## )str(ffdata)## spec_tbl_df [1,136 × 5] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Date : num [1:1136] 192607 192608 192609 192610 192611 ...
## $ Mkt-RF: num [1:1136] 2.96 2.64 0.36 -3.24 2.53 2.62 -0.06 4.18 0.13 0.46 ...
## $ SMB : num [1:1136] -2.3 -1.4 -1.32 0.04 -0.2 -0.04 -0.56 -0.1 -1.6 0.43 ...
## $ HML : num [1:1136] -2.87 4.19 0.01 0.51 -0.35 -0.02 4.83 3.17 -2.67 0.6 ...
## $ RF : num [1:1136] 0.22 0.25 0.23 0.32 0.31 0.28 0.25 0.26 0.3 0.25 ...
## - attr(*, "spec")=
## .. cols(
## .. Date = col_double(),
## .. `Mkt-RF` = col_double(),
## .. SMB = col_double(),
## .. HML = col_double(),
## .. RF = col_double()
## .. )head(ffdata)## # A tibble: 6 x 5
## Date `Mkt-RF` SMB HML RF
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 192607 2.96 -2.3 -2.87 0.22
## 2 192608 2.64 -1.4 4.19 0.25
## 3 192609 0.36 -1.32 0.01 0.23
## 4 192610 -3.24 0.04 0.51 0.32
## 5 192611 2.53 -0.2 -0.35 0.31
## 6 192612 2.62 -0.04 -0.02 0.28colnames(ffdata) <- paste(c("date","Mkt-RF","SMB","HML","RF"))
ffdata.digit <- ffdata %>% mutate(date = as.character(date))%>%
mutate(date=ymd(parse_date(date,format="%Y%m"))) %>%
mutate(date=rollback(date))
head(ffdata.digit)## # A tibble: 6 x 5
## date `Mkt-RF` SMB HML RF
## <date> <dbl> <dbl> <dbl> <dbl>
## 1 1926-06-30 2.96 -2.3 -2.87 0.22
## 2 1926-07-31 2.64 -1.4 4.19 0.25
## 3 1926-08-31 0.36 -1.32 0.01 0.23
## 4 1926-09-30 -3.24 0.04 0.51 0.32
## 5 1926-10-31 2.53 -0.2 -0.35 0.31
## 6 1926-11-30 2.62 -0.04 -0.02 0.28stock.rets<-ffdata.digit %>% select(c(2,3,4))/100
glimpse(stock.rets)## Rows: 1,136
## Columns: 3
## $ `Mkt-RF` <dbl> 0.0296, 0.0264, 0.0036, -0.0324, 0.0253, 0.0262, -0.0006, 0.0…
## $ SMB <dbl> -0.0230, -0.0140, -0.0132, 0.0004, -0.0020, -0.0004, -0.0056,…
## $ HML <dbl> -0.0287, 0.0419, 0.0001, 0.0051, -0.0035, -0.0002, 0.0483, 0.…ffdata.digit.xts <- xts(ffdata.digit[,-1],order.by=as.Date(ffdata.digit$date))
head(ffdata.digit.xts)## Mkt-RF SMB HML RF
## 1926-06-30 2.96 -2.30 -2.87 0.22
## 1926-07-31 2.64 -1.40 4.19 0.25
## 1926-08-31 0.36 -1.32 0.01 0.23
## 1926-09-30 -3.24 0.04 0.51 0.32
## 1926-10-31 2.53 -0.20 -0.35 0.31
## 1926-11-30 2.62 -0.04 -0.02 0.285. Merge monthly return data in question 3 and 4 into tibble format.
combined.data <- merge(ffdata.digit,ETF.monthly.returns)
head(combined.data)## date Mkt-RF SMB HML RF SPY QQQ EEM
## 1 1926-06-30 2.96 -2.30 -2.87 0.22 0.03071793 0.04501044 0.01760802
## 2 1926-07-31 2.64 -1.40 4.19 0.25 0.03071793 0.04501044 0.01760802
## 3 1926-08-31 0.36 -1.32 0.01 0.23 0.03071793 0.04501044 0.01760802
## 4 1926-09-30 -3.24 0.04 0.51 0.32 0.03071793 0.04501044 0.01760802
## 5 1926-10-31 2.53 -0.20 -0.35 0.31 0.03071793 0.04501044 0.01760802
## 6 1926-11-30 2.62 -0.04 -0.02 0.28 0.03071793 0.04501044 0.01760802
## IWM EFA TLT IYR GLD
## 1 0.04377882 0.002664268 -0.003430817 0.05313334 0.03222342
## 2 0.04377882 0.002664268 -0.003430817 0.05313334 0.03222342
## 3 0.04377882 0.002664268 -0.003430817 0.05313334 0.03222342
## 4 0.04377882 0.002664268 -0.003430817 0.05313334 0.03222342
## 5 0.04377882 0.002664268 -0.003430817 0.05313334 0.03222342
## 6 0.04377882 0.002664268 -0.003430817 0.05313334 0.03222342tail(combined.data)## date Mkt-RF SMB HML RF SPY QQQ EEM
## 153355 2020-08-31 -3.63 0.06 -2.51 0.01 0.04086135 0.06511023 0.002060137
## 153356 2020-09-30 -2.10 4.44 4.03 0.01 0.04086135 0.06511023 0.002060137
## 153357 2020-10-31 12.47 5.48 2.11 0.01 0.04086135 0.06511023 0.002060137
## 153358 2020-11-30 4.63 4.81 -1.36 0.01 0.04086135 0.06511023 0.002060137
## 153359 2020-12-31 -0.04 7.19 2.85 0.00 0.04086135 0.06511023 0.002060137
## 153360 2021-01-31 2.79 2.11 7.07 0.00 0.04086135 0.06511023 0.002060137
## IWM EFA TLT IYR GLD
## 153355 0.0009048001 0.02781566 0.02349007 0.03316165 0.02146089
## 153356 0.0009048001 0.02781566 0.02349007 0.03316165 0.02146089
## 153357 0.0009048001 0.02781566 0.02349007 0.03316165 0.02146089
## 153358 0.0009048001 0.02781566 0.02349007 0.03316165 0.02146089
## 153359 0.0009048001 0.02781566 0.02349007 0.03316165 0.02146089
## 153360 0.0009048001 0.02781566 0.02349007 0.03316165 0.02146089combined.data.tibble <- as_tibble(combined.data)
head(combined.data.tibble)## # A tibble: 6 x 13
## date `Mkt-RF` SMB HML RF SPY QQQ EEM IWM EFA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1926-06-30 2.96 -2.3 -2.87 0.22 0.0307 0.0450 0.0176 0.0438 0.00266
## 2 1926-07-31 2.64 -1.4 4.19 0.25 0.0307 0.0450 0.0176 0.0438 0.00266
## 3 1926-08-31 0.36 -1.32 0.01 0.23 0.0307 0.0450 0.0176 0.0438 0.00266
## 4 1926-09-30 -3.24 0.04 0.51 0.32 0.0307 0.0450 0.0176 0.0438 0.00266
## 5 1926-10-31 2.53 -0.2 -0.35 0.31 0.0307 0.0450 0.0176 0.0438 0.00266
## 6 1926-11-30 2.62 -0.04 -0.02 0.28 0.0307 0.0450 0.0176 0.0438 0.00266
## # … with 3 more variables: TLT <dbl>, IYR <dbl>, GLD <dbl>tail(combined.data.tibble)## # A tibble: 6 x 13
## date `Mkt-RF` SMB HML RF SPY QQQ EEM IWM EFA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2020-08-31 -3.63 0.06 -2.51 0.01 0.0409 0.0651 0.00206 0.000905 0.0278
## 2 2020-09-30 -2.1 4.44 4.03 0.01 0.0409 0.0651 0.00206 0.000905 0.0278
## 3 2020-10-31 12.5 5.48 2.11 0.01 0.0409 0.0651 0.00206 0.000905 0.0278
## 4 2020-11-30 4.63 4.81 -1.36 0.01 0.0409 0.0651 0.00206 0.000905 0.0278
## 5 2020-12-31 -0.04 7.19 2.85 0 0.0409 0.0651 0.00206 0.000905 0.0278
## 6 2021-01-31 2.79 2.11 7.07 0 0.0409 0.0651 0.00206 0.000905 0.0278
## # … with 3 more variables: TLT <dbl>, IYR <dbl>, GLD <dbl>6. 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 2015/01 - 2021/03.
combined.data2 <- combined.data.tibble[combined.data.tibble$date>="2015-01-01"&combined.data.tibble$date<="2021-03-01",]
head(combined.data2)## # A tibble: 6 x 13
## date `Mkt-RF` SMB HML RF SPY QQQ EEM IWM EFA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2015-01-31 6.14 0.52 -1.81 0 0.0307 0.0450 0.0176 0.0438 0.00266
## 2 2015-02-28 -1.12 3.02 -0.41 0 0.0307 0.0450 0.0176 0.0438 0.00266
## 3 2015-03-31 0.59 -3.04 1.88 0 0.0307 0.0450 0.0176 0.0438 0.00266
## 4 2015-04-30 1.36 0.89 -1.1 0 0.0307 0.0450 0.0176 0.0438 0.00266
## 5 2015-05-31 -1.53 2.85 -0.74 0 0.0307 0.0450 0.0176 0.0438 0.00266
## 6 2015-06-30 1.54 -4.09 -4.21 0 0.0307 0.0450 0.0176 0.0438 0.00266
## # … with 3 more variables: TLT <dbl>, IYR <dbl>, GLD <dbl>tail(combined.data2)## # A tibble: 6 x 13
## date `Mkt-RF` SMB HML RF SPY QQQ EEM IWM EFA
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2020-08-31 -3.63 0.06 -2.51 0.01 0.0409 0.0651 0.00206 0.000905 0.0278
## 2 2020-09-30 -2.1 4.44 4.03 0.01 0.0409 0.0651 0.00206 0.000905 0.0278
## 3 2020-10-31 12.5 5.48 2.11 0.01 0.0409 0.0651 0.00206 0.000905 0.0278
## 4 2020-11-30 4.63 4.81 -1.36 0.01 0.0409 0.0651 0.00206 0.000905 0.0278
## 5 2020-12-31 -0.04 7.19 2.85 0 0.0409 0.0651 0.00206 0.000905 0.0278
## 6 2021-01-31 2.79 2.11 7.07 0 0.0409 0.0651 0.00206 0.000905 0.0278
## # … with 3 more variables: TLT <dbl>, IYR <dbl>, GLD <dbl>Computation of Beta
spy_rf <- combined.data.tibble$SPY-combined.data.tibble$RF
qqq_rf <- combined.data.tibble$QQQ-combined.data.tibble$RF
eem_rf <- combined.data.tibble$EEM-combined.data.tibble$RF
iwm_rf <- combined.data.tibble$IWM-combined.data.tibble$RF
efa_rf <- combined.data.tibble$EFA-combined.data.tibble$RF
tlt_rf <- combined.data.tibble$TLT-combined.data.tibble$RF
iyr_rf <- combined.data.tibble$IYR-combined.data.tibble$RF
gld_rf <- combined.data.tibble$GLD-combined.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,combined.data.tibble$`Mkt-RF`)
x.mat <- as.matrix(x)
beta <- solve(t(x)%*%x)%*%t(x)%*%y
beta## spy_rf qqq_rf eem_rf iwm_rf efa_rf
## one.vec -0.260759922 -0.256185103 -0.268239271 -0.261556632 -0.267041902
## 0.003289358 0.003289358 0.003289358 0.003289358 0.003289358
## tlt_rf iyr_rf gld_rf
## one.vec -0.267106684 -0.263542880 -0.269167866
## 0.003289358 0.003289358 0.003289358Computation of Residual
e.hat <- y - x%*%beta
res.var <- diag(t(e.hat)%*%e.hat)/(n-2)
d <- diag(res.var);d## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 0.06474174 0.00000000 0.00000000 0.00000000 0.00000000 0.0000000
## [2,] 0.00000000 0.06522919 0.00000000 0.00000000 0.00000000 0.0000000
## [3,] 0.00000000 0.00000000 0.06604851 0.00000000 0.00000000 0.0000000
## [4,] 0.00000000 0.00000000 0.00000000 0.06623891 0.00000000 0.0000000
## [5,] 0.00000000 0.00000000 0.00000000 0.00000000 0.06519938 0.0000000
## [6,] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.0645169
## [7,] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.0000000
## [8,] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.0000000
## [,7] [,8]
## [1,] 0.00000000 0.00000000
## [2,] 0.00000000 0.00000000
## [3,] 0.00000000 0.00000000
## [4,] 0.00000000 0.00000000
## [5,] 0.00000000 0.00000000
## [6,] 0.00000000 0.00000000
## [7,] 0.06519499 0.00000000
## [8,] 0.00000000 0.06531471Single factor model Convariance Matrix
cov.mat <- var(combined.data.tibble$`Mkt-RF`)*t(beta)%*%beta + d
cov.mat## spy_rf qqq_rf eem_rf iwm_rf efa_rf tlt_rf iyr_rf gld_rf
## spy_rf 2.009610 1.910753 2.000644 1.950810 1.991715 1.992198 1.965622 2.007569
## qqq_rf 1.910753 1.942465 1.965550 1.916590 1.956778 1.957252 1.931142 1.972353
## eem_rf 2.000644 1.965550 2.124068 2.006756 2.048834 2.049331 2.021993 2.065143
## iwm_rf 1.950810 1.916590 2.006756 2.023008 1.997800 1.998284 1.971627 2.013702
## efa_rf 1.991715 1.956778 2.048834 1.997800 2.104890 2.040185 2.012968 2.055926
## tlt_rf 1.992198 1.957252 2.049331 1.998284 2.040185 2.105197 2.013457 2.056425
## iyr_rf 1.965622 1.931142 2.021993 1.971627 2.012968 2.013457 2.051792 2.028992
## gld_rf 2.007569 1.972353 2.065143 2.013702 2.055926 2.056425 2.028992 2.1376068 Asset Monthly Return MVP Based on CAPM Model
one.vec2 <- rep(1,8)
top <- solve(cov.mat)%*%one.vec2
bot <- t(one.vec2)%*%top
capm.mvp <- top/as.numeric(bot)
capm.mvp## [,1]
## spy_rf 0.5040870
## qqq_rf 0.9994086
## eem_rf -0.3117224
## iwm_rf 0.4071013
## efa_rf -0.1850957
## tlt_rf -0.1941991
## iyr_rf 0.1968170
## gld_rf -0.4163967barplot(t(capm.mvp), horiz=F, main="Weight of MVP for Single Factor Model", col="dark blue", cex.names = 0.70, las=2)
7. Based on FF 3-factor model, compute MVP monthly returns covariance matrix for the 8-asset portfolio by using past 60-month returns from 2015/01 - 2021/03.
t <- dim(combined.data2)[1]
markets <- combined.data2[,c(2,3,4)]
combined.data3 <- combined.data2[,c(-1,-2,-3,-4,-5)]
head(combined.data3)## # A tibble: 6 x 8
## SPY QQQ EEM IWM EFA TLT IYR GLD
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.0307 0.0450 0.0176 0.0438 0.00266 -0.00343 0.0531 0.0322
## 2 0.0307 0.0450 0.0176 0.0438 0.00266 -0.00343 0.0531 0.0322
## 3 0.0307 0.0450 0.0176 0.0438 0.00266 -0.00343 0.0531 0.0322
## 4 0.0307 0.0450 0.0176 0.0438 0.00266 -0.00343 0.0531 0.0322
## 5 0.0307 0.0450 0.0176 0.0438 0.00266 -0.00343 0.0531 0.0322
## 6 0.0307 0.0450 0.0176 0.0438 0.00266 -0.00343 0.0531 0.0322combined.data3 <- as.matrix(combined.data3)
n <- dim(combined.data3)[2]
one_vec <- rep(1,t)
p <- cbind(one_vec,markets)
p <- as.matrix(p)
b.hat <- solve(t(p)%*%p)%*%t(p)%*%combined.data3
res <- combined.data3-p%*%b.hat
diag.d <- diag(t(res)%*%res)/(t-6)
diag.d## SPY QQQ EEM IWM EFA TLT
## 0.001585194 0.002072938 0.002892747 0.003083257 0.002043113 0.001360219
## IYR GLD
## 0.002038717 0.002158507R-Square
retvar <- apply(combined.data3,2,var)
rsq <- 1-diag(t(res)%*%res)/((t-1)/retvar)
res.stdev <- sqrt(diag.d)
factor.cov <- var(combined.data3)*t(b.hat)%*%b.hat+diag(diag.d)
stdev <- sqrt(diag(factor.cov))
factor.cor <- factor.cov/(stdev%*%t(stdev))
factor.cor## SPY QQQ EEM IWM EFA
## SPY 1.000000e+00 1.726798e-04 3.616519e-05 1.128243e-04 5.422625e-05
## QQQ 1.726798e-04 1.000000e+00 4.618904e-05 1.364532e-04 6.928029e-05
## EEM 3.616519e-05 4.618904e-05 1.000000e+00 3.186946e-05 1.876395e-05
## IWM 1.128243e-04 1.364532e-04 3.186946e-05 1.000000e+00 4.548664e-05
## EFA 5.422625e-05 6.928029e-05 1.876395e-05 4.548664e-05 1.000000e+00
## TLT -2.795475e-05 -3.107755e-05 -8.003181e-06 -2.880292e-05 -1.239845e-05
## IYR 7.412658e-05 8.634935e-05 2.245151e-05 6.637312e-05 3.163140e-05
## GLD 1.904804e-06 5.207976e-06 3.578556e-06 7.184762e-07 1.393196e-06
## TLT IYR GLD
## SPY -2.795475e-05 7.412658e-05 1.904804e-06
## QQQ -3.107755e-05 8.634935e-05 5.207976e-06
## EEM -8.003181e-06 2.245151e-05 3.578556e-06
## IWM -2.880292e-05 6.637312e-05 7.184762e-07
## EFA -1.239845e-05 3.163140e-05 1.393196e-06
## TLT 1.000000e+00 -2.369492e-06 4.216848e-06
## IYR -2.369492e-06 1.000000e+00 4.361797e-06
## GLD 4.216848e-06 4.361797e-06 1.000000e+00Sample variance and correlation matrix
cov_sample <- cov(combined.data3)
cov_sample## SPY QQQ EEM IWM EFA
## SPY 1.584389e-03 0.0016642729 0.0016108921 1.984325e-03 0.0015743959
## QQQ 1.664273e-03 0.0020718859 0.0016881085 1.969153e-03 0.0016504404
## EEM 1.610892e-03 0.0016881085 0.0028912793 2.125510e-03 0.0020658893
## IWM 1.984325e-03 0.0019691532 0.0021255103 3.081692e-03 0.0019774300
## EFA 1.574396e-03 0.0016504404 0.0020658893 1.977430e-03 0.0020420765
## TLT -6.703834e-04 -0.0006115051 -0.0007277943 -1.034230e-03 -0.0007349234
## IYR 1.298440e-03 0.0012410604 0.0014913238 1.740817e-03 0.0013695362
## GLD 9.449304e-05 0.0002119846 0.0006731871 5.336725e-05 0.0001708319
## TLT IYR GLD
## SPY -6.703834e-04 1.298440e-03 9.449304e-05
## QQQ -6.115051e-04 1.241060e-03 2.119846e-04
## EEM -7.277943e-04 1.491324e-03 6.731871e-04
## IWM -1.034230e-03 1.740817e-03 5.336725e-05
## EFA -7.349234e-04 1.369536e-03 1.708319e-04
## TLT 1.359529e-03 -8.473709e-05 4.270787e-04
## IYR -8.473709e-05 2.037683e-03 3.226754e-04
## GLD 4.270787e-04 3.226754e-04 2.157412e-03cor_sample <- cor(combined.data3)
cor_sample## SPY QQQ EEM IWM EFA TLT
## SPY 1.00000000 0.9185666 0.7526455 0.8980223 0.87527997 -0.45677048
## QQQ 0.91856665 1.0000000 0.6897194 0.7792951 0.80238152 -0.36435350
## EEM 0.75264550 0.6897194 1.0000000 0.7120714 0.85020965 -0.36708729
## IWM 0.89802234 0.7792951 0.7120714 1.0000000 0.78826179 -0.50527539
## EFA 0.87527997 0.8023815 0.8502096 0.7882618 1.00000000 -0.44107436
## TLT -0.45677048 -0.3643535 -0.3670873 -0.5052754 -0.44107436 1.00000000
## IYR 0.72264133 0.6040066 0.6144105 0.6946887 0.67138126 -0.05091093
## GLD 0.05110958 0.1002663 0.2695406 0.0206973 0.08138913 0.24937167
## IYR GLD
## SPY 0.72264133 0.05110958
## QQQ 0.60400665 0.10026628
## EEM 0.61441051 0.26954061
## IWM 0.69468871 0.02069730
## EFA 0.67138126 0.08138913
## TLT -0.05091093 0.24937167
## IYR 1.00000000 0.15389729
## GLD 0.15389729 1.000000008 Asset Monthly Return MVP Based on FF 3-factor model
one <- rep(1,8)
top.mat <- solve(factor.cov)%*%one
bot.mat <- t(one)%*%top.mat
ff3f.mvp <- top.mat/as.numeric(bot.mat)
ff3f.mvp## [,1]
## SPY 0.15920557
## QQQ 0.12171474
## EEM 0.08726779
## IWM 0.08184489
## EFA 0.12355382
## TLT 0.18563671
## IYR 0.12380488
## GLD 0.11697160barplot(t(ff3f.mvp), horiz=F, main="Weight of MVP for Fama French 3 Factor Model", col="dark blue", cex.names = 0.70, las=2)