1. 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.)

Load necessary libraries

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.1
## ✔ forcats 1.0.0     ✔ tibble  3.2.1
## ✔ ggplot2 3.5.0     ✔ tidyr   1.3.1
## ✔ readr   2.1.5     
## ── 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 86.86006 40.73327 31.82712 52.51540 37.52379 61.13183 28.10298
## 2010-01-05 87.08996 40.73327 32.05812 52.33483 37.55685 61.52663 28.17047
## 2010-01-06 87.15131 40.48758 32.12519 52.28557 37.71560 60.70303 28.15819
## 2010-01-07 87.51921 40.51390 31.93889 52.67135 37.57009 60.80511 28.40971
## 2010-01-08 87.81045 40.84735 32.19226 52.95863 37.86774 60.77786 28.21954
## 2010-01-11 87.93309 40.68063 32.12519 52.74523 38.17862 60.44441 28.35451
##               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
  1. 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 86.86006 40.73327 31.82712 52.51540 37.52379 61.13183 28.10298
## 2010-01-05 87.08996 40.73327 32.05812 52.33483 37.55685 61.52663 28.17047
## 2010-01-06 87.15131 40.48758 32.12519 52.28557 37.71560 60.70303 28.15819
## 2010-01-07 87.51921 40.51390 31.93889 52.67135 37.57009 60.80511 28.40971
## 2010-01-08 87.81045 40.84735 32.19226 52.95863 37.86774 60.77786 28.21954
## 2010-01-11 87.93309 40.68063 32.12519 52.74523 38.17862 60.44441 28.35451
##               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.008117475 -0.015037140 -0.02893498 -0.01301893 -0.003493573
## 2010-01-22 -0.038982704 -0.036859558 -0.05578087 -0.03062185 -0.055740523
## 2010-01-29 -0.016664883 -0.031023463 -0.03357763 -0.02624325 -0.025802911
## 2010-02-05 -0.006797888  0.004439916 -0.02821315 -0.01397468 -0.019054561
## 2010-02-12  0.012938566  0.018148256  0.03333337  0.02952605  0.005244602
## 2010-02-19  0.028692769  0.024451262  0.02445396  0.03343201  0.022995085
##                      TLT          IYR          GLD
## 2010-01-15  2.004814e-02 -0.006304762 -0.004579349
## 2010-01-22  1.010031e-02 -0.041784500 -0.033285246
## 2010-01-29  3.369554e-03 -0.008447798 -0.011290465
## 2010-02-05 -5.415436e-05  0.003223523 -0.012080019
## 2010-02-12 -1.946014e-02 -0.007574216  0.022544905
## 2010-02-19 -8.205747e-03  0.050185321  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.03119435  0.04603891  0.017764152  0.04475096  0.002667557
## 2010-03-31  0.06087966  0.07710891  0.081108652  0.08230713  0.063854226
## 2010-04-30  0.01547000  0.02242521 -0.001661697  0.05678493 -0.028045895
## 2010-05-28 -0.07945434 -0.07392370 -0.093935930 -0.07536668 -0.111927730
## 2010-06-30 -0.05174145 -0.05975645 -0.013986590 -0.07743403 -0.020619526
## 2010-07-30  0.06830123  0.07258211  0.109324858  0.06730919  0.116104116
##                     TLT         IYR          GLD
## 2010-02-26 -0.003424413  0.05457024  0.032748219
## 2010-03-31 -0.020573037  0.09748490 -0.004386396
## 2010-04-30  0.033218219  0.06388132  0.058834363
## 2010-05-28  0.051083408 -0.05683541  0.030513147
## 2010-06-30  0.057978180 -0.04670103  0.023553189
## 2010-07-30 -0.009463171  0.09404756 -0.050871157
  1. 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).
fama <- read_csv("C:/Users/user/Downloads/F-F_Research_Data_Factors.csv")
## Rows: 1172 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (5): Date, Mkt-RF, SMB, HML, RF
## 
## ℹ 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.
head(fama)
## # A tibble: 6 × 5
##     Date `Mkt-RF`   SMB   HML    RF
##    <dbl>    <dbl> <dbl> <dbl> <dbl>
## 1 192607     2.96 -2.56 -2.43  0.22
## 2 192608     2.64 -1.17  3.82  0.25
## 3 192609     0.36 -1.4   0.13  0.23
## 4 192610    -3.24 -0.09  0.7   0.32
## 5 192611     2.53 -0.1  -0.51  0.31
## 6 192612     2.62 -0.03 -0.05  0.28

Format the data frame

colnames(fama) <- paste(c("date","MKT-RF","SMB","HML","RF"))
fama.digit <- fama %>% mutate(date = as.character(date))%>% 
  mutate(date=ymd(parse_date(date,format="%Y%m"))) %>%
  mutate(date=rollback(date))
head(fama.digit)
## # A tibble: 6 × 5
##   date       `MKT-RF`   SMB   HML    RF
##   <date>        <dbl> <dbl> <dbl> <dbl>
## 1 1926-06-30     2.96 -2.56 -2.43  0.22
## 2 1926-07-31     2.64 -1.17  3.82  0.25
## 3 1926-08-31     0.36 -1.4   0.13  0.23
## 4 1926-09-30    -3.24 -0.09  0.7   0.32
## 5 1926-10-31     2.53 -0.1  -0.51  0.31
## 6 1926-11-30     2.62 -0.03 -0.05  0.28
fama.digit.xts <- xts(fama.digit[,-1],order.by=as.Date(fama.digit$date))
head(fama.digit.xts)
##            MKT-RF   SMB   HML   RF
## 1926-06-30   2.96 -2.56 -2.43 0.22
## 1926-07-31   2.64 -1.17  3.82 0.25
## 1926-08-31   0.36 -1.40  0.13 0.23
## 1926-09-30  -3.24 -0.09  0.70 0.32
## 1926-10-31   2.53 -0.10 -0.51 0.31
## 1926-11-30   2.62 -0.03 -0.05 0.28
  1. Merge with ETF Monthly returns
merge_data <- merge(fama.digit, etf_monthly_returns)
tail(merge_data)
##              date MKT-RF   SMB   HML   RF       SPY        QQQ         EEM
## 158215 2023-08-31  -5.24 -2.51  1.52 0.43 0.0417077 0.06727678 0.002062279
## 158216 2023-09-30  -3.19 -3.87  0.19 0.47 0.0417077 0.06727678 0.002062279
## 158217 2023-10-31   8.84 -0.02  1.64 0.44 0.0417077 0.06727678 0.002062279
## 158218 2023-11-30   4.87  6.34  4.93 0.43 0.0417077 0.06727678 0.002062279
## 158219 2023-12-31   0.71 -5.09 -2.38 0.47 0.0417077 0.06727678 0.002062279
## 158220 2024-01-31   5.06 -0.24 -3.48 0.42 0.0417077 0.06727678 0.002062279
##                 IWM        EFA        TLT        IYR        GLD
## 158215 0.0009051669 0.02820604 0.02376793 0.03371768 0.02169283
## 158216 0.0009051669 0.02820604 0.02376793 0.03371768 0.02169283
## 158217 0.0009051669 0.02820604 0.02376793 0.03371768 0.02169283
## 158218 0.0009051669 0.02820604 0.02376793 0.03371768 0.02169283
## 158219 0.0009051669 0.02820604 0.02376793 0.03371768 0.02169283
## 158220 0.0009051669 0.02820604 0.02376793 0.03371768 0.02169283
merge_data_tibble <- as_tibble(merge_data)
head(merge_data_tibble)
## # A tibble: 6 × 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.56 -2.43  0.22 0.0312 0.0460 0.0178 0.0448 0.00267
## 2 1926-07-31     2.64 -1.17  3.82  0.25 0.0312 0.0460 0.0178 0.0448 0.00267
## 3 1926-08-31     0.36 -1.4   0.13  0.23 0.0312 0.0460 0.0178 0.0448 0.00267
## 4 1926-09-30    -3.24 -0.09  0.7   0.32 0.0312 0.0460 0.0178 0.0448 0.00267
## 5 1926-10-31     2.53 -0.1  -0.51  0.31 0.0312 0.0460 0.0178 0.0448 0.00267
## 6 1926-11-30     2.62 -0.03 -0.05  0.28 0.0312 0.0460 0.0178 0.0448 0.00267
## # ℹ 3 more variables: TLT <dbl>, IYR <dbl>, GLD <dbl>
  1. 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)
## # A tibble: 6 × 13
##   date       `MKT-RF`   SMB   HML    RF    SPY    QQQ    EEM    IWM     EFA
##   <date>        <dbl> <dbl> <dbl> <dbl>  <dbl>  <dbl>  <dbl>  <dbl>   <dbl>
## 1 2019-03-31     3.97 -1.74  2.15  0.21 0.0312 0.0460 0.0178 0.0448 0.00267
## 2 2019-04-30    -6.94 -1.32 -2.37  0.21 0.0312 0.0460 0.0178 0.0448 0.00267
## 3 2019-05-31     6.93  0.29 -0.71  0.18 0.0312 0.0460 0.0178 0.0448 0.00267
## 4 2019-06-30     1.19 -1.93  0.48  0.19 0.0312 0.0460 0.0178 0.0448 0.00267
## 5 2019-07-31    -2.58 -2.38 -4.78  0.16 0.0312 0.0460 0.0178 0.0448 0.00267
## 6 2019-08-31     1.43 -0.96  6.75  0.18 0.0312 0.0460 0.0178 0.0448 0.00267
## # ℹ 3 more variables: TLT <dbl>, IYR <dbl>, GLD <dbl>
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
##               spy_rf       qqq_rf       eem_rf       iwm_rf       efa_rf
## one.vec -0.257580976 -0.252687281 -0.264474096 -0.257645508 -0.263693115
##          0.003069948  0.003069948  0.003069948  0.003069948  0.003069948
##               tlt_rf       iyr_rf       gld_rf
## one.vec -0.264089535 -0.260174432 -0.265765506
##          0.003069948  0.003069948  0.003069948
#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.06407155 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [2,] 0.00000000 0.06461115 0.00000000 0.00000000 0.00000000 0.00000000
## [3,] 0.00000000 0.00000000 0.06534369 0.00000000 0.00000000 0.00000000
## [4,] 0.00000000 0.00000000 0.00000000 0.06552049 0.00000000 0.00000000
## [5,] 0.00000000 0.00000000 0.00000000 0.00000000 0.06450559 0.00000000
## [6,] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.06388392
## [7,] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
## [8,] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
##            [,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.06447875 0.00000000
## [8,] 0.00000000 0.06465395
# covariance matrix single factor model
cov.mat <- var(merge_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 1.955798 1.855791 1.942343 1.892200 1.936609 1.939520 1.910770 1.951827
## qqq_rf 1.855791 1.885150 1.905447 1.856256 1.899821 1.902676 1.874473 1.914750
## eem_rf 1.942343 1.905447 2.059659 1.942830 1.988427 1.991416 1.961897 2.004052
## iwm_rf 1.892200 1.856256 1.942830 1.958195 1.937094 1.940005 1.911249 1.952315
## efa_rf 1.936609 1.899821 1.988427 1.937094 2.047062 1.985536 1.956105 1.998135
## tlt_rf 1.939520 1.902676 1.991416 1.940005 1.985536 2.052405 1.959045 2.001139
## iyr_rf 1.910770 1.874473 1.961897 1.911249 1.956105 1.959045 1.994485 1.971476
## gld_rf 1.951827 1.914750 2.004052 1.952315 1.998135 2.001139 1.971476 2.078490
# 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.4735261
## qqq_rf  0.9990353
## eem_rf -0.2731199
## iwm_rf  0.4561694
## efa_rf -0.1920334
## tlt_rf -0.2372802
## iyr_rf  0.1893654
## gld_rf -0.4156626
  1. 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)
## # A tibble: 6 × 8
##      SPY    QQQ    EEM    IWM     EFA      TLT    IYR    GLD
##    <dbl>  <dbl>  <dbl>  <dbl>   <dbl>    <dbl>  <dbl>  <dbl>
## 1 0.0312 0.0460 0.0178 0.0448 0.00267 -0.00342 0.0546 0.0327
## 2 0.0312 0.0460 0.0178 0.0448 0.00267 -0.00342 0.0546 0.0327
## 3 0.0312 0.0460 0.0178 0.0448 0.00267 -0.00342 0.0546 0.0327
## 4 0.0312 0.0460 0.0178 0.0448 0.00267 -0.00342 0.0546 0.0327
## 5 0.0312 0.0460 0.0178 0.0448 0.00267 -0.00342 0.0546 0.0327
## 6 0.0312 0.0460 0.0178 0.0448 0.00267 -0.00342 0.0546 0.0327
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
##         SPY         QQQ         EEM         IWM         EFA         TLT 
## 0.001593372 0.002133371 0.002866457 0.003043388 0.002027732 0.001405610 
##         IYR         GLD 
## 0.002000880 0.002176211
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
##               SPY           QQQ           EEM           IWM           EFA
## SPY  1.000000e+00  1.992777e-04  5.234303e-05  1.386860e-04  6.929618e-05
## QQQ  1.992777e-04  1.000000e+00  6.726485e-05  1.682160e-04  8.864296e-05
## EEM  5.234303e-05  6.726485e-05  1.000000e+00  4.901045e-05  3.008274e-05
## IWM  1.386860e-04  1.682160e-04  4.901045e-05  1.000000e+00  6.201338e-05
## EFA  6.929618e-05  8.864296e-05  3.008274e-05  6.201338e-05  1.000000e+00
## TLT -3.402739e-05 -3.774196e-05 -1.225262e-05 -3.743786e-05 -1.678533e-05
## IYR  8.859360e-05  1.040037e-04  3.366758e-05  8.384215e-05  4.182003e-05
## GLD  2.949946e-06  7.882687e-06  6.345602e-06  1.220827e-06  2.116481e-06
##               TLT           IYR          GLD
## SPY -3.402739e-05  8.859360e-05 2.949946e-06
## QQQ -3.774196e-05  1.040037e-04 7.882687e-06
## EEM -1.225262e-05  3.366758e-05 6.345602e-06
## IWM -3.743786e-05  8.384215e-05 1.220827e-06
## EFA -1.678533e-05  4.182003e-05 2.116481e-06
## TLT  1.000000e+00 -3.000786e-06 6.488105e-06
## IYR -3.000786e-06  1.000000e+00 6.547051e-06
## GLD  6.488105e-06  6.547051e-06 1.000000e+00
sample.cov <- cov(FM)
sample.cor <- cor(FM)
sample.cov
##               SPY           QQQ           EEM           IWM           EFA
## SPY  0.0015923716  0.0016945325  0.0016038794  1.970838e-03  0.0015669217
## QQQ  0.0016945325  0.0021320312  0.0017133455  1.987144e-03  0.0016661963
## EEM  0.0016038794  0.0017133455  0.0028646570  2.086279e-03  0.0020376092
## IWM  0.0019708379  0.0019871444  0.0020862791  3.041477e-03  0.0019480239
## EFA  0.0015669217  0.0016661963  0.0020376092  1.948024e-03  0.0020264586
## TLT -0.0006831249 -0.0006298541 -0.0007368275 -1.044127e-03 -0.0007448900
## IYR  0.0012818726  0.0012509365  0.0014592176  1.685295e-03  0.0013375732
## GLD  0.0001024293  0.0002275246  0.0006600070  5.888916e-05  0.0001624483
##               TLT           IYR          GLD
## SPY -6.831249e-04  1.281873e-03 1.024293e-04
## QQQ -6.298541e-04  1.250937e-03 2.275246e-04
## EEM -7.368275e-04  1.459218e-03 6.600070e-04
## IWM -1.044127e-03  1.685295e-03 5.888916e-05
## EFA -7.448900e-04  1.337573e-03 1.624483e-04
## TLT  1.404728e-03 -8.521219e-05 4.421323e-04
## IYR -8.521219e-05  1.999624e-03 3.215519e-04
## GLD  4.421323e-04  3.215519e-04 2.174845e-03
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.15935090
## QQQ 0.11897831
## EEM 0.08860300
## IWM 0.08341608
## EFA 0.12525008
## TLT 0.18075376
## IYR 0.12691405
## GLD 0.11673383

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)
## # A tibble: 1 × 13
##   date       `MKT-RF`   SMB   HML    RF    SPY    QQQ     EEM      IWM    EFA
##   <date>        <dbl> <dbl> <dbl> <dbl>  <dbl>  <dbl>   <dbl>    <dbl>  <dbl>
## 1 2024-01-31     5.06 -0.24 -3.48  0.42 0.0417 0.0673 0.00206 0.000905 0.0282
## # ℹ 3 more variables: TLT <dbl>, IYR <dbl>, GLD <dbl>
calc_data2 <- calc_data2[c(-1,-2,-3,-4,-5)]
calc_data2
## # A tibble: 1 × 8
##      SPY    QQQ     EEM      IWM    EFA    TLT    IYR    GLD
##    <dbl>  <dbl>   <dbl>    <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
## 1 0.0417 0.0673 0.00206 0.000905 0.0282 0.0238 0.0337 0.0217

With weights

returns_q5 <- rowSums(calc_data2*mvp_capm)
returns_q5
## [1] 0.07312312
returns_q6 <- rowSums(calc_data2*MVP_FF3)
returns_q6
## [1] 0.02954935