#import data
#load libraries
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 zoo
library(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
## ══ 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)
library(tibble)
library(readr)
library(xts)
library(PerformanceAnalytics)
library(magrittr)
##
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
##
## set_names
library(fBasics)
## Loading required package: timeDate
##
## Attaching package: 'timeDate'
## The following objects are masked from 'package:PerformanceAnalytics':
##
## kurtosis, skewness
## Loading required package: timeSeries
##
## Attaching package: 'timeSeries'
## The following object is masked from 'package:zoo':
##
## time<-
##
## Attaching package: 'fBasics'
## The following object is masked from 'package:TTR':
##
## volatility
library(tidyverse)
## ── Attaching packages ───────────────────────────────────────────────────────────────────────── tidyverse 1.3.0 ──
## ✓ ggplot2 3.3.2 ✓ stringr 1.4.0
## ✓ tidyr 1.1.3 ✓ forcats 0.5.0
## ✓ dplyr 1.0.5
## ── 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 timeSeries::filter(), stats::filter()
## x dplyr::first() masks xts::first()
## x lubridate::intersect() masks base::intersect()
## x dplyr::lag() masks timeSeries::lag(), stats::lag()
## x dplyr::last() masks xts::last()
## x magrittr::set_names() masks purrr::set_names()
## x lubridate::setdiff() masks base::setdiff()
## x lubridate::union() masks base::union()
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"
ETFList <- merge(Ad(SPY), Ad(QQQ),Ad(EEM), Ad(IWM),Ad(EFA),Ad(TLT),Ad(IYR),Ad(GLD))
colnames(ETFList) <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
head(ETFList)
## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 90.79006 41.51847 34.10928 54.61730 41.03314 66.03745 30.41554
## 2010-01-05 91.03041 41.51847 34.35684 54.42949 41.06930 66.46396 30.48858
## 2010-01-06 91.09449 41.26806 34.42872 54.37827 41.24289 65.57423 30.47530
## 2010-01-07 91.47905 41.29489 34.22906 54.77949 41.08377 65.68450 30.74751
## 2010-01-08 91.78343 41.63475 34.50059 55.07827 41.40926 65.65512 30.54169
## 2010-01-11 91.91164 41.46482 34.42872 54.85632 41.74921 65.29481 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.85
tail(ETFList)
## SPY QQQ EEM IWM EFA TLT IYR GLD
## 2021-04-06 406.12 330.82 54.37 224.31 77.15 137.6382 94.20 163.22
## 2021-04-07 406.59 331.62 53.57 220.69 77.31 136.6796 94.20 162.76
## 2021-04-08 408.52 335.08 54.01 222.56 77.75 137.8079 93.97 164.51
## 2021-04-09 411.49 337.11 53.55 222.59 77.99 137.3086 93.96 163.27
## 2021-04-12 411.64 336.67 53.23 221.72 77.56 137.2487 94.47 162.28
## 2021-04-13 412.86 340.60 53.45 221.14 78.01 138.2772 95.04 163.43
ETFList.xts <- xts(ETFList)
head(ETFList.xts)
## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 90.79006 41.51847 34.10928 54.61730 41.03314 66.03745 30.41554
## 2010-01-05 91.03041 41.51847 34.35684 54.42949 41.06930 66.46396 30.48858
## 2010-01-06 91.09449 41.26806 34.42872 54.37827 41.24289 65.57423 30.47530
## 2010-01-07 91.47905 41.29489 34.22906 54.77949 41.08377 65.68450 30.74751
## 2010-01-08 91.78343 41.63475 34.50059 55.07827 41.40926 65.65512 30.54169
## 2010-01-11 91.91164 41.46482 34.42872 54.85632 41.74921 65.29481 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.85
#weekly returns
weekly.returns <- to.weekly(ETFList.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.019848537 -0.006324356 -0.004589865
## 2010-01-22 0.010050310 -0.042683345 -0.033851813
## 2010-01-29 0.003363789 -0.008483115 -0.011354685
## 2010-02-05 -0.000053732 0.003218256 -0.012153577
## 2010-02-12 -0.019653381 -0.007602937 0.022294528
## 2010-02-19 -0.008238932 0.048966490 0.022447943
tail(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.020730233 0.051252724 0.0146589405
## 2021-03-19 -0.009674828 -0.009175922 0.0107782890
## 2021-03-26 0.014074907 0.034467797 -0.0061447899
## 2021-04-01 0.007567240 0.009016849 -0.0016039051
## 2021-04-09 0.000000000 0.004052442 0.0079324505
## 2021-04-13 0.007029286 0.011428717 0.0009794246
#monthly returns
monthly.returns <- to.monthly(ETFList.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.003430786 0.05313334 0.032223420
## 2010-03-31 -0.020787687 0.09302102 -0.004396042
## 2010-04-30 0.032678847 0.06192375 0.057168648
## 2010-05-28 0.049821743 -0.05851441 0.030056874
## 2010-06-30 0.056359738 -0.04782683 0.023280092
## 2010-07-30 -0.009509251 0.08988455 -0.052210719
tail(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.01650211 0.082312759 -0.05560390
## 2020-12-31 -0.01235249 0.024725619 0.06778819
## 2021-01-29 -0.03700417 -0.004329307 -0.03276927
## 2021-02-26 -0.05903846 0.023983094 -0.06461193
## 2021-03-31 -0.05387845 0.056135171 -0.01149897
## 2021-04-13 0.02349013 0.033161654 0.02146089
#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 rows
#fama french
ff3.csv <- read_csv('ff3.csv')
##
## ── Column specification ──────────────────────────────────────────────────────────────────────────────────────────
## cols(
## Date = col_double(),
## `Mkt-RF` = col_double(),
## SMB = col_double(),
## HML = col_double(),
## RF = col_double()
## )
str(ff3.csv)
## 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(ff3.csv)
## # 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.28
dim(ff3.csv)
## [1] 1136 5
tail(ff3.csv)
## # A tibble: 6 x 5
## Date `Mkt-RF` SMB HML RF
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 202009 -3.63 0.06 -2.51 0.01
## 2 202010 -2.1 4.44 4.03 0.01
## 3 202011 12.5 5.48 2.11 0.01
## 4 202012 4.63 4.81 -1.36 0.01
## 5 202101 -0.04 7.19 2.85 0
## 6 202102 2.79 2.11 7.07 0
glimpse(ff3.csv)
## Rows: 1,136
## Columns: 5
## $ Date <dbl> 192607, 192608, 192609, 192610, 192611, 192612, 192701, 19270…
## $ `Mkt-RF` <dbl> 2.96, 2.64, 0.36, -3.24, 2.53, 2.62, -0.06, 4.18, 0.13, 0.46,…
## $ SMB <dbl> -2.30, -1.40, -1.32, 0.04, -0.20, -0.04, -0.56, -0.10, -1.60,…
## $ HML <dbl> -2.87, 4.19, 0.01, 0.51, -0.35, -0.02, 4.83, 3.17, -2.67, 0.6…
## $ RF <dbl> 0.22, 0.25, 0.23, 0.32, 0.31, 0.28, 0.25, 0.26, 0.30, 0.25, 0…
colnames(ff3.csv) <- paste(c("date","Mkt-RF","SMB","HML","RF"))
ff3.digit <- ff3.csv %>% mutate(date = as.character(date))%>%
mutate(date=ymd(parse_date(date,format="%Y%m"))) %>%
mutate(date=rollback(date))
head(ff3.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.28
#convert to xts
ff3.digit.xts <- xts(ff3.digit[,-1],order.by=as.Date(ff3.digit$date))
head(ff3.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.28
#merge of monthly returns and fama french
final.data <- merge(ff3.digit,ETF.monthly.returns)
tail(final.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.02349013 0.03316165 0.02146089
## 153356 0.0009048001 0.02781566 0.02349013 0.03316165 0.02146089
## 153357 0.0009048001 0.02781566 0.02349013 0.03316165 0.02146089
## 153358 0.0009048001 0.02781566 0.02349013 0.03316165 0.02146089
## 153359 0.0009048001 0.02781566 0.02349013 0.03316165 0.02146089
## 153360 0.0009048001 0.02781566 0.02349013 0.03316165 0.02146089
final.data.tibble <- as_tibble(final.data)
head(final.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>
# 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.
final.data2 <- final.data.tibble[final.data.tibble$date>="2015-01-01"&final.data.tibble$date<="2021-03-01",]
head(final.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>
spy_rf <- final.data.tibble$SPY-final.data.tibble$RF
qqq_rf <- final.data.tibble$QQQ-final.data.tibble$RF
eem_rf <- final.data.tibble$EEM-final.data.tibble$RF
iwm_rf <- final.data.tibble$IWM-final.data.tibble$RF
efa_rf <- final.data.tibble$EFA-final.data.tibble$RF
tlt_rf <- final.data.tibble$TLT-final.data.tibble$RF
iyr_rf <- final.data.tibble$IYR-final.data.tibble$RF
gld_rf <- final.data.tibble$GLD-final.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,final.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.267106686 -0.263542880 -0.269167866
## 0.003289358 0.003289358 0.003289358
#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.06531471
#covariance matrix single factor model
cov.mat <- var(final.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.137606
#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
## [,1]
## spy_rf 0.5040870
## qqq_rf 0.9994087
## eem_rf -0.3117224
## iwm_rf 0.4071013
## efa_rf -0.1850956
## tlt_rf -0.1941993
## iyr_rf 0.1968170
## gld_rf -0.4163966
#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(final.data2)[1]
markets <- final.data2[,c(2,3,4)]
final.data3 <- final.data2[,c(-1,-2,-3,-4,-5)]
head(final.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.0322
final.data3 <- as.matrix(final.data3)
n <- dim(final.data3)[2]
one_vec <- rep(1,t)
p <- cbind(one_vec,markets)
p <- as.matrix(p)
b.hat <- solve(t(p)%*%p)%*%t(p)%*%final.data3
res <- final.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.001360224
## IYR GLD
## 0.002038717 0.002158507
#r square
retvar <- apply(final.data3,2,var)
rsq <- 1-diag(t(res)%*%res)/((t-1)/retvar)
res.stdev <- sqrt(diag.d)
factor.cov <- var(final.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.795477e-05 -3.107758e-05 -8.003193e-06 -2.880290e-05 -1.239848e-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.795477e-05 7.412658e-05 1.904804e-06
## QQQ -3.107758e-05 8.634935e-05 5.207976e-06
## EEM -8.003193e-06 2.245151e-05 3.578556e-06
## IWM -2.880290e-05 6.637312e-05 7.184762e-07
## EFA -1.239848e-05 3.163140e-05 1.393196e-06
## TLT 1.000000e+00 -2.369524e-06 4.216853e-06
## IYR -2.369524e-06 1.000000e+00 4.361797e-06
## GLD 4.216853e-06 4.361797e-06 1.000000e+00
#sample variance and correlation
sample.cov <- cov(final.data3)
sample.cor <- cor(final.data3)
sample.cov
## 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.703854e-04 -0.0006115072 -0.0007277970 -1.034231e-03 -0.0007349267
## 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.703854e-04 1.298440e-03 9.449304e-05
## QQQ -6.115072e-04 1.241060e-03 2.119846e-04
## EEM -7.277970e-04 1.491324e-03 6.731871e-04
## IWM -1.034231e-03 1.740817e-03 5.336725e-05
## EFA -7.349267e-04 1.369536e-03 1.708319e-04
## TLT 1.359534e-03 -8.473845e-05 4.270801e-04
## IYR -8.473845e-05 2.037683e-03 3.226754e-04
## GLD 4.270801e-04 3.226754e-04 2.157412e-03
sample.cor
## SPY QQQ EEM IWM EFA TLT
## SPY 1.00000000 0.9185666 0.7526455 0.8980223 0.87527997 -0.45677101
## QQQ 0.91856665 1.0000000 0.6897194 0.7792951 0.80238152 -0.36435403
## EEM 0.75264550 0.6897194 1.0000000 0.7120714 0.85020965 -0.36708802
## IWM 0.89802234 0.7792951 0.7120714 1.0000000 0.78826179 -0.50527517
## EFA 0.87527997 0.8023815 0.8502096 0.7882618 1.00000000 -0.44107553
## TLT -0.45677101 -0.3643540 -0.3670880 -0.5052752 -0.44107553 1.00000000
## IYR 0.72264133 0.6040066 0.6144105 0.6946887 0.67138126 -0.05091165
## GLD 0.05110958 0.1002663 0.2695406 0.0206973 0.08138913 0.24937203
## 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.05091165 0.24937203
## IYR 1.00000000 0.15389729
## GLD 0.15389729 1.00000000
#mvp monthly returns of 8 assets_ff 3 factor
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
## [,1]
## SPY 0.15920568
## QQQ 0.12171482
## EEM 0.08726785
## IWM 0.08184495
## EFA 0.12355391
## TLT 0.18563615
## IYR 0.12380496
## GLD 0.11697168
##Based on PCA with 3 factors, compute MVP monthly returns covariance matrix for the
#8-asset portfolio by using past 60-month returns from 2015/01 - 2021/03.
head(ETFList)
## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 90.79006 41.51847 34.10928 54.61730 41.03314 66.03745 30.41554
## 2010-01-05 91.03041 41.51847 34.35684 54.42949 41.06930 66.46396 30.48858
## 2010-01-06 91.09449 41.26806 34.42872 54.37827 41.24289 65.57423 30.47530
## 2010-01-07 91.47905 41.29489 34.22906 54.77949 41.08377 65.68450 30.74751
## 2010-01-08 91.78343 41.63475 34.50059 55.07827 41.40926 65.65512 30.54169
## 2010-01-11 91.91164 41.46482 34.42872 54.85632 41.74921 65.29481 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.85
dim(ETFList)
## [1] 2838 8
PCA.FF3 = princomp (ETFList, cor = T)
summary(PCA.FF3)
## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## Standard deviation 2.4655478 1.0722981 0.77147557 0.280785221 0.215765496
## Proportion of Variance 0.7598657 0.1437279 0.07439682 0.009855043 0.005819344
## Cumulative Proportion 0.7598657 0.9035936 0.97799047 0.987845508 0.993664851
## Comp.6 Comp.7 Comp.8
## Standard deviation 0.188111541 0.118320469 0.0359930999
## Proportion of Variance 0.004423244 0.001749967 0.0001619379
## Cumulative Proportion 0.998088095 0.999838062 1.0000000000
PCA.FF3$sdev^2
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6
## 6.078925881 1.149823290 0.595174552 0.078840340 0.046554749 0.035385952
## Comp.7 Comp.8
## 0.013999733 0.001295503
loadings(PCA.FF3)
##
## Loadings:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
## SPY 0.403 0.217 0.177 0.256 0.822
## QQQ 0.396 0.641 0.184 0.103 0.326 -0.518
## EEM 0.317 -0.231 -0.728 -0.453 0.303 -0.134
## IWM 0.394 0.163 0.517 -0.730
## EFA 0.384 0.191 -0.235 -0.279 -0.756 0.310
## TLT 0.353 -0.132 0.581 -0.612 -0.150 -0.341
## IYR 0.384 0.165 0.228 -0.629 0.522 0.249 -0.203
## GLD -0.910 -0.244 0.283 -0.134
##
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
## SS loadings 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000
## Proportion Var 0.125 0.125 0.125 0.125 0.125 0.125 0.125 0.125
## Cumulative Var 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000
PCA.FF3.cov = princomp(ETFList)
PCA.FF3.cov$sdev
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
## 113.714993 23.858295 11.782236 9.290490 4.100425 2.711911 1.982714
## Comp.8
## 1.273043
loadings(PCA.FF3.cov)
##
## Loadings:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
## SPY 0.684 0.181 0.166 0.484 0.430 0.201
## QQQ 0.607 -0.306 -0.189 -0.597 -0.168 -0.284 -0.170
## EEM -0.238 0.101 0.521 -0.493 0.641
## IWM 0.322 0.328 -0.347 0.477 -0.643 -0.164
## EFA 0.100 -0.116 0.148 0.709 -0.666
## TLT 0.185 -0.207 0.809 0.105 -0.428 0.250 0.108
## IYR 0.134 0.119 0.253 0.347 0.351 -0.349 -0.690 -0.248
## GLD -0.836 -0.215 0.480 0.111
##
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
## SS loadings 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000
## Proportion Var 0.125 0.125 0.125 0.125 0.125 0.125 0.125 0.125
## Cumulative Var 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000
biplot(PCA.FF3.cov)
## Plot the performance of three strategies in the above and comment and conclude the results
# Installation from GitHub
# install.packages("devtools")
devtools::install_github("dppalomar/covFactorModel")
## Error in get(genname, envir = envir) : object 'testthat_print' not found
## Skipping install of 'covFactorModel' from a github remote, the SHA1 (1e7cc3df) has not changed since last install.
## Use `force = TRUE` to force installation
library(covFactorModel)
K <- 5
X_trn <- as.matrix(ETFList)
T_trn <- dim(ETFList)[1]
N <- dim(ETFList)[2]
alpha <- colMeans(X_trn)
X_trn_ <- X_trn - matrix(alpha, T_trn, N, byrow = TRUE)
Sigma_prev <- matrix(0, N, N)
Sigma <- (1/(T_trn-1)) * t(X_trn_) %*% X_trn_
eigSigma <- eigen(Sigma)
eigSigma
## eigen() decomposition
## $values
## [1] 12935.657587 569.418883 138.870015 86.343629 16.819414
## [6] 7.357054 3.932539 1.621209
##
## $vectors
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] -0.68383056 0.18077973 0.09837074 -0.16550496 -0.48376097 -0.05411938
## [2,] -0.60701182 -0.30623110 -0.18927237 0.59707881 0.16805905 0.08947722
## [3,] -0.03413035 -0.02949238 -0.23813457 -0.07082201 -0.10092869 -0.52129516
## [4,] -0.32155355 0.32780098 -0.34668266 -0.47664098 0.64292868 0.16368566
## [5,] -0.07780776 0.10038814 -0.11602288 -0.14757641 -0.04958808 -0.70855415
## [6,] -0.18468229 -0.20677714 0.80857646 -0.10540334 0.42784950 -0.24973378
## [7,] -0.13448265 0.11898360 0.25329455 -0.34705547 -0.35134226 0.34920729
## [8,] -0.03322156 -0.83559934 -0.21491136 -0.48017336 -0.07233290 0.06451046
## [,7] [,8]
## [1,] 0.43043373 -0.20099498
## [2,] -0.28358367 0.16959455
## [3,] -0.49305835 -0.64124855
## [4,] -0.02438728 -0.03208309
## [5,] -0.02994578 0.66575022
## [6,] -0.03297539 -0.10826067
## [7,] -0.69011625 0.24800029
## [8,] 0.11118123 0.04649520
#Plot of MVP monthly returns covariance matrix for the
#8-asset portfolio by using past 60-month returns from 2015/01 - 2021/03 based on CAPM Model
plot(mvp_capm)
#Plot of MVP monthly returns covariance matrix for the
#8-asset portfolio by using past 60-month returns from 2015/01 - 2021/03 based on FF 3-Factor Model
plot(MVP_FF3)
#Plot of MVP monthly returns covariance matrix for the
#8-asset portfolio by using past 60-month returns from 2015/01 - 2021/03 based on PCA with 3 factors
plot(PCA.FF3.cov)
