# Load libraries
#install.packages("quadprog")
library(quadprog)
library(SIT)
library(ROI)## ROI: R Optimization Infrastructure## Registered solver plugins: nlminb.## Default solver: auto.library(ggplot2)
library(readr)
library(dplyr)##
## Attaching package: 'dplyr'## 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## Loading required package: PerformanceAnalytics## Loading required package: xts## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## #################################################################################
## Attaching package: 'xts'## The following objects are masked from 'package:dplyr':
##
## first, last##
## Attaching package: 'PerformanceAnalytics'## The following object is masked from 'package:graphics':
##
## legend## Loading required package: quantmod## Loading required package: TTR## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(lubridate)
library(timetk)
library(purrr)
library(xts)
library(dplyr)
library(quantmod)
library(zoo)Question 1:Import Data
#Define the symbols we want to take
symbols <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
#Extract data from yahoo finance and feed the data in prices
prices <-
getSymbols(symbols, src = 'yahoo', from = "2010-01-01",
auto.assign = TRUE, warnings = FALSE) %>%
map(~Ad(get(.))) %>%
reduce(merge) %>%
`colnames<-`(symbols)
#Show the data prices
head(prices)## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 88.11790 41.00547 32.42903 53.08979 37.99449 63.06114 28.77183
## 2010-01-05 88.35116 41.00547 32.66441 52.90723 38.02797 63.46841 28.84092
## 2010-01-06 88.41336 40.75812 32.73273 52.85744 38.18871 62.61879 28.82835
## 2010-01-07 88.78656 40.78462 32.54291 53.24745 38.04136 62.72412 29.08586
## 2010-01-08 89.08205 41.12031 32.80107 53.53788 38.34275 62.69606 28.89116
## 2010-01-11 89.20642 40.95246 32.73273 53.32213 38.65752 62.35194 29.02933
## 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.85Question 2: Calculate weekly and monthly returns using log returns
#Change data from daily to weekly
prices_weekly <- to.weekly(prices, indexAt = "last", OHLC = FALSE)
#Change data from daily to monthly
prices_monthly <- to.monthly(prices, indexAt = "last", OHLC = FALSE)
#Calculate weekly retun
asset_returns_wk_xts <- na.omit(Return.calculate(prices_weekly))
#Calculate monthly return
asset_returns_mon_xts <- na.omit(Return.calculate(prices_monthly))
#Weekly return
head(asset_returns_wk_xts)## SPY QQQ EEM IWM EFA
## 2010-01-15 -0.008117136 -0.015037604 -0.02893499 -0.01301908 -0.003493471
## 2010-01-22 -0.038982902 -0.036859682 -0.05578083 -0.03062212 -0.055740561
## 2010-01-29 -0.016665455 -0.031023488 -0.03357756 -0.02624321 -0.025802879
## 2010-02-05 -0.006797525 0.004440521 -0.02821289 -0.01397431 -0.019054778
## 2010-02-12 0.012938512 0.018147852 0.03333309 0.02952562 0.005244577
## 2010-02-19 0.028692893 0.024451690 0.02445406 0.03343163 0.022995169
## TLT IYR GLD
## 2010-01-15 2.004649e-02 -0.006304758 -0.004579349
## 2010-01-22 1.010088e-02 -0.041784529 -0.033285246
## 2010-01-29 3.369511e-03 -0.008447493 -0.011290465
## 2010-02-05 -5.449858e-05 0.003223196 -0.012080019
## 2010-02-12 -1.946053e-02 -0.007573717 0.022544905
## 2010-02-19 -8.205009e-03 0.050184585 0.022701796#Monthly return
head(asset_returns_mon_xts)## SPY QQQ EEM IWM EFA
## 2010-02-26 0.03119488 0.04603881 0.01776399 0.04475160 0.002667612
## 2010-03-31 0.06087977 0.07710931 0.08110871 0.08230646 0.063854206
## 2010-04-30 0.01546992 0.02242514 -0.00166157 0.05678478 -0.028045606
## 2010-05-28 -0.07945455 -0.07392326 -0.09393619 -0.07536643 -0.111927959
## 2010-06-30 -0.05174072 -0.05975729 -0.01398617 -0.07743395 -0.020619634
## 2010-07-30 0.06830041 0.07258270 0.10932453 0.06730889 0.116104338
## TLT IYR GLD
## 2010-02-26 -0.003424347 0.05457016 0.032748219
## 2010-03-31 -0.020573275 0.09748511 -0.004386396
## 2010-04-30 0.033217634 0.06388090 0.058834363
## 2010-05-28 0.051084116 -0.05683555 0.030513147
## 2010-06-30 0.057978195 -0.04670071 0.023553189
## 2010-07-30 -0.009463862 0.09404732 -0.050871157Question 3:Convert monthly returns into tibble format. Hint: use
as_tibble(., rownames = 'date') or
tk_tbl(., rename_index = 'date').
#Monthly return to tibble format
monthly_return <- as_tibble(asset_returns_mon_xts,rownames = 'date')
tail(monthly_return)## # A tibble: 6 × 9
## date SPY QQQ EEM IWM EFA TLT IYR GLD
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2023-0… 0.0629 0.106 0.0913 0.0982 0.0900 0.0764 0.0998 0.0576
## 2 2023-0… -0.0251 -0.00360 -0.0757 -0.0172 -0.0307 -0.0485 -0.0596 -0.0537
## 3 2023-0… 0.0371 0.0949 0.0322 -0.0485 0.0313 0.0484 -0.0194 0.0792
## 4 2023-0… 0.0160 0.00508 -0.00836 -0.0179 0.0294 0.00338 0.00919 0.00862
## 5 2023-0… 0.00462 0.0788 -0.0240 -0.00816 -0.0401 -0.0302 -0.0403 -0.0134
## 6 2023-0… 0.0355 0.0324 0.0547 0.0732 0.0342 -0.00893 0.0274 -0.00274Question 4: Download Fama French 3 factors data and change to digit numbers
ff_url <- "https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/F-F_Research_Data_Factors_CSV.zip"
temp_file <- tempfile()
download.file(ff_url, temp_file)
ff_data_raw <- read_csv(unzip(temp_file), skip = 3)## New names:
## • `` -> `...1`## Warning: One or more parsing issues, call `problems()` on your data frame for details,
## e.g.:
## dat <- vroom(...)
## problems(dat)## Rows: 1261 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): ...1
## dbl (4): 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.ff_data_raw <- ff_data_raw[c(1:1162),]
colnames(ff_data_raw) <- paste(c('date', "mkt_excess", "smb", "hml", "rf"))
attach(ff_data_raw)
ff_data_raw## # A tibble: 1,162 × 5
## date mkt_excess smb hml rf
## <chr> <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
## 7 192701 -0.06 -0.37 4.54 0.25
## 8 192702 4.18 0.04 2.94 0.26
## 9 192703 0.13 -1.65 -2.61 0.3
## 10 192704 0.46 0.3 0.81 0.25
## # ℹ 1,152 more rows#Convert into xts data
ff_data <- ff_data_raw %>% mutate(date = as.character(date)) %>%
mutate(date = ymd(parse_date(date, format = "%Y%m"))) %>%
mutate(date = rollback(date))
ff_data## # A tibble: 1,162 × 5
## date mkt_excess 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
## 7 1926-12-31 -0.06 -0.37 4.54 0.25
## 8 1927-01-31 4.18 0.04 2.94 0.26
## 9 1927-02-28 0.13 -1.65 -2.61 0.3
## 10 1927-03-31 0.46 0.3 0.81 0.25
## # ℹ 1,152 more rowsff_data_xts <- xts(ff_data[, -1],
order.by = as.Date(as.numeric(ff_data$date)))
head(ff_data_xts,10)## mkt_excess 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
## 1926-12-31 -0.06 -0.37 4.54 0.25
## 1927-01-31 4.18 0.04 2.94 0.26
## 1927-02-28 0.13 -1.65 -2.61 0.30
## 1927-03-31 0.46 0.30 0.81 0.25tail(ff_data_xts)## mkt_excess smb hml rf
## 2022-10-31 4.60 -3.40 1.38 0.29
## 2022-11-30 -6.41 -0.68 1.32 0.33
## 2022-12-31 6.65 5.02 -4.05 0.35
## 2023-01-31 -2.58 1.21 -0.78 0.34
## 2023-02-28 2.51 -5.59 -9.01 0.36
## 2023-03-31 0.61 -3.34 -0.03 0.35Question 5: Merge monthly return data in question 3 and 4 into tibble format
monthly_return_xts <- xts(monthly_return[,-1], order.by = as.Date(monthly_return$date))
merged <- merge(x = ff_data_xts, y = monthly_return_xts)
head(merged, 5)## mkt_excess smb hml rf SPY QQQ EEM IWM EFA TLT IYR GLD
## 1926-06-30 2.96 -2.56 -2.43 0.22 NA NA NA NA NA NA NA NA
## 1926-07-31 2.64 -1.17 3.82 0.25 NA NA NA NA NA NA NA NA
## 1926-08-31 0.36 -1.40 0.13 0.23 NA NA NA NA NA NA NA NA
## 1926-09-30 -3.24 -0.09 0.70 0.32 NA NA NA NA NA NA NA NA
## 1926-10-31 2.53 -0.10 -0.51 0.31 NA NA NA NA NA NA NA NAQuestion 6: Compute covariance matrix for the 8-asset portfolio based on CAPM model
data <- na.omit(merged["2010-02-28/2014-12-31"])
head(data)## mkt_excess smb hml rf SPY QQQ EEM
## 2010-03-31 2.00 4.87 2.89 0.01 0.06087977 0.077109311 0.08110871
## 2010-04-30 -7.89 0.09 -2.44 0.01 0.01546992 0.022425137 -0.00166157
## 2010-06-30 6.93 0.22 -0.33 0.01 -0.05174072 -0.059757290 -0.01398617
## 2010-08-31 9.54 3.97 -3.18 0.01 -0.04498073 -0.051298482 -0.03236697
## 2010-09-30 3.88 1.19 -2.51 0.01 0.08955493 0.131727546 0.11757384
## 2010-11-30 6.82 0.69 3.76 0.01 0.00000000 -0.001725048 -0.02905442
## IWM EFA TLT IYR GLD
## 2010-03-31 0.08230646 0.06385421 -0.02057328 0.09748511 -0.004386396
## 2010-04-30 0.05678478 -0.02804561 0.03321763 0.06388090 0.058834363
## 2010-06-30 -0.07743395 -0.02061963 0.05797820 -0.04670071 0.023553189
## 2010-08-31 -0.07443866 -0.03795033 0.08390980 -0.01297181 0.057061253
## 2010-09-30 0.12445308 0.09971961 -0.02520427 0.04629667 0.047755584
## 2010-11-30 0.03485089 -0.04823713 -0.01689359 -0.01582959 0.021112978# Create an empty list to store the results
result_list <- list()
y <- NULL
# Perform the calculation using a for loop
for (symbol in symbols) {
diff <- data[,symbol] - data$rf
result_name <- paste0(symbol, "_rf")
assign(result_name, diff)
y <- cbind(y, get(result_name))
}
#Calculating Beta
n <- nrow(y)
one_vec <- rep(1,n)
x <- NULL
x <- cbind(one_vec,data$mkt_excess)
beta_hat = solve(t(x)%*%x)%*%t(x) %*% y
beta_hat## SPY QQQ EEM IWM EFA
## one_vec 0.011516072 0.0119783568 0.002191876 0.015013712 0.0028633091
## mkt_excess -0.001750035 -0.0009771542 -0.001029281 -0.003149498 -0.0004973766
## TLT IYR GLD
## one_vec 0.005430750 0.012371487 0.006062257
## mkt_excess 0.001633657 -0.001879846 -0.004148860E_hat = y - x %*% beta_hat
# Excluding constant term
beta_hat = as.matrix(beta_hat[-1,])
diagD_hat = diag(t(E_hat) %*% E_hat)/(n-2)
# Covariance matrix by single factor model
cov = as.numeric(var(data$mkt_excess))*beta_hat%*%t(beta_hat) + diag(diagD_hat)Question 7: Compute covariance matrix for the 8-asset portfolio based on FF 3-factor model
#separate data to 2 groups:
t <- dim(data)[1]
markets <- data[,c(2,3,4)]
stocks <- data[,c(-1,-2,-3,-4)]
head(stocks)## SPY QQQ EEM IWM EFA
## 2010-03-31 0.06087977 0.077109311 0.08110871 0.08230646 0.06385421
## 2010-04-30 0.01546992 0.022425137 -0.00166157 0.05678478 -0.02804561
## 2010-06-30 -0.05174072 -0.059757290 -0.01398617 -0.07743395 -0.02061963
## 2010-08-31 -0.04498073 -0.051298482 -0.03236697 -0.07443866 -0.03795033
## 2010-09-30 0.08955493 0.131727546 0.11757384 0.12445308 0.09971961
## 2010-11-30 0.00000000 -0.001725048 -0.02905442 0.03485089 -0.04823713
## TLT IYR GLD
## 2010-03-31 -0.02057328 0.09748511 -0.004386396
## 2010-04-30 0.03321763 0.06388090 0.058834363
## 2010-06-30 0.05797820 -0.04670071 0.023553189
## 2010-08-31 0.08390980 -0.01297181 0.057061253
## 2010-09-30 -0.02520427 0.04629667 0.047755584
## 2010-11-30 -0.01689359 -0.01582959 0.021112978#Compute the beta
stocks <- as.matrix(stocks)
n <- dim(stocks)[2]
one_vec <- rep(1,t)
p <- as.matrix(cbind(one_vec,markets))
beta <- solve(t(p)%*%p)%*%t(p)%*%stocks
#Compute the residual
res <- stocks-p%*%beta
diag.d <- diag(t(res)%*%res)/(t-6)
diag.d## SPY QQQ EEM IWM EFA TLT
## 0.001630382 0.002268298 0.004019548 0.003558772 0.002644977 0.001882766
## IYR GLD
## 0.002277914 0.002220032#Compute the R-square
retvar <- apply(stocks,2,var)
rsq <- 1-diag(t(res)%*%res)/((t-1)/retvar)
res.stdev <- sqrt(diag.d)
factor.cov <- var(stocks)*t(beta)%*%beta+diag(diag.d)
stdev <- sqrt(diag(factor.cov))
factor.cor <- factor.cov/(stdev%*%t(stdev))
factor.cor## SPY QQQ EEM IWM EFA TLT IYR
## SPY 1.0000000 0.18956066 0.4269597 0.4503113 0.4463893 0.124000898 0.36704794
## QQQ 0.1895607 1.00000000 0.2415772 0.2590624 0.2578596 0.067134237 0.20381438
## EEM 0.4269597 0.24157722 1.0000000 0.6117628 0.6983932 0.164988373 0.57866068
## IWM 0.4503113 0.25906240 0.6117628 1.0000000 0.5855178 0.172283837 0.54474306
## EFA 0.4463893 0.25785956 0.6983932 0.5855178 1.0000000 0.170944311 0.54231647
## TLT 0.1240009 0.06713424 0.1649884 0.1722838 0.1709443 1.000000000 0.08561446
## IYR 0.3670479 0.20381438 0.5786607 0.5447431 0.5423165 0.085614455 1.00000000
## GLD 0.1366439 0.09136662 0.3079442 0.2769033 0.1889609 0.002219785 0.25878430
## GLD
## SPY 0.136643941
## QQQ 0.091366618
## EEM 0.307944200
## IWM 0.276903338
## EFA 0.188960921
## TLT 0.002219785
## IYR 0.258784296
## GLD 1.000000000#Compute the MVP monthly return of 8 assets
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.337667339
## QQQ 0.295044388
## EEM -0.055232522
## IWM -0.042329375
## EFA -0.008957536
## TLT 0.401070145
## IYR 0.059505929
## GLD 0.013231631Question 8: Compute global minimum variance portfolio weights based on question 6 and 7.
# Compute global minimum variance portfolio weights based on CAPM model
cov_matrix_capm <- cov
dmat_capm <- 2 * cov_matrix_capm
dvec_capm <- rep(0, ncol(cov_matrix_capm))
Amat_capm <- matrix(1, nrow = 1, ncol = ncol(cov_matrix_capm))
bvec_capm <- 1
weights_capm <- solve.QP(Dmat = dmat_capm, dvec = dvec_capm, Amat = t(Amat_capm), bvec = bvec_capm)$solution
# Compute global minimum variance portfolio weights based on FF 3-factor model
cov_matrix_ff3 <- factor.cov
dmat_ff3 <- 2 * cov_matrix_ff3
dvec_ff3 <- rep(0, ncol(cov_matrix_ff3))
Amat_ff3 <- matrix(1, nrow = 1, ncol = ncol(cov_matrix_ff3))
bvec_ff3 <- 1
weights_ff3 <- solve.QP(Dmat = dmat_ff3, dvec = dvec_ff3, Amat = t(Amat_ff3), bvec = bvec_ff3)$solution
# Print the weights
weights_capm## [1] 0.18350274 0.13750631 0.07107109 0.07686587 0.11449132 0.19168215 0.12989921
## [8] 0.09498132weights_ff3## [1] 0.337667339 0.295044388 -0.055232522 -0.042329375 -0.008957536
## [6] 0.401070145 0.059505929 0.013231631Question 9: Using SIT package to backtest the
performance of GMV (global minimum variance) portfolios based on CAPM
model and Fama-French three-factor model. You have to use historical six
monthly returns (t-6 to t-1) to estimate the
optimal weights which will be assigned to assets to construct portfolios
for investment in next month (t). By repeating this process
every month, you can derive the monthly returns of GMV portfolios based
on CAPM and Fama-French three-factor model.
# compute the covariance matrix based on the CAPM model
compute_covariance_capm <- function(data) {
n <- nrow(data)
one_vec <- rep(1, n)
x <- cbind(one_vec, data$mkt_excess)
y <- data[, -c(1:4)]
beta_hat <- solve(t(x) %*% x) %*% t(x) %*% y
E_hat <- y - x %*% beta_hat
diagD_hat <- diag(t(E_hat) %*% E_hat) / (n - 2)
cov_matrix_capm <- as.numeric(var(data$mkt_excess)) * t(beta_hat) %*% beta_hat + diag(diagD_hat)
return(cov_matrix_capm)
}
cov_matrix_capm <- compute_covariance_capm(data)
head(cov_matrix_capm)## SPY QQQ EEM IWM EFA TLT
## SPY 0.004958974 0.003569903 0.0012834055 0.004336892 0.0014263212 0.0019702398
## QQQ 0.003569903 0.005741219 0.0013114008 0.004433055 0.0014657846 0.0020547486
## EEM 0.001283406 0.001311401 0.0044943580 0.001603637 0.0005242440 0.0007120599
## IWM 0.004336892 0.004433055 0.0016036369 0.008627073 0.0017720490 0.0024113010
## EFA 0.001426321 0.001465785 0.0005242440 0.001772049 0.0031973149 0.0008186382
## TLT 0.001970240 0.002054749 0.0007120599 0.002411301 0.0008186382 0.0029256492
## IYR GLD
## SPY 0.003685655 0.0022706292
## QQQ 0.003778001 0.0022887402
## EEM 0.001358546 0.0008526075
## IWM 0.004590744 0.0028754286
## EFA 0.001509493 0.0009170364
## TLT 0.002083924 0.0011571318# compute the covariance matrix based on the Fama-French three-factor model
compute_covariance_ff3 <- function(data) {
markets <- data[, c(2, 3, 4)]
stocks <- data[, c(-1, -2, -3, -4)]
n <- nrow(stocks)
one_vec <- rep(1, n)
p <- cbind(one_vec, markets)
beta <- solve(t(p) %*% p) %*% t(p) %*% stocks
res <- stocks - p %*% beta
diag_d <- diag(t(res) %*% res) / (n - 6)
ret_var <- apply(stocks, 2, var)
stdev <- sqrt(diag_d)
factor_cov <- var(stocks) * t(beta) %*% beta + diag(diag_d)
return(factor_cov)
}
cov_matrix_ff3 <- compute_covariance_ff3(data)
head(cov_matrix_ff3)## SPY QQQ EEM IWM EFA
## SPY 0.0024217521 0.0004756909 0.003395022 0.0025575684 0.0023895342
## QQQ 0.0004756909 0.0026003008 0.001990484 0.0015246344 0.0014303082
## EEM 0.0033950218 0.0019904838 0.026108487 0.0114083668 0.0122751112
## IWM 0.0025575684 0.0015246344 0.011408367 0.0133198423 0.0073506249
## EFA 0.0023895342 0.0014303082 0.012275111 0.0073506249 0.0118323000
## TLT 0.0002771951 0.0001555076 0.001210988 0.0009032124 0.0008446661
## TLT IYR GLD
## SPY 0.0002771951 0.0017674247 0.0015162480
## QQQ 0.0001555076 0.0010169507 0.0010505443
## EEM 0.0012109884 0.0091488839 0.0112196138
## IWM 0.0009032124 0.0061516912 0.0072059751
## EFA 0.0008446661 0.0057721907 0.0046346998
## TLT 0.0020634389 0.0003805364 0.0000227364# compute the GMV portfolio weights
compute_gmv_weights <- function(cov_matrix) {
n <- nrow(cov_matrix)
dvec <- rep(0, n)
Amat <- matrix(1, 1, n)
bvec <- 1
gmv_weights <- solve.QP(Dmat = 2 * cov_matrix, dvec = dvec, Amat = t(Amat), bvec = bvec)$solution
return(gmv_weights)
}
gmv_weights_capm <- compute_gmv_weights(cov_matrix_capm)
head(gmv_weights_capm)## [1] 0.01248232 -0.01100338 0.22719217 -0.10019041 0.32583838 0.36169868gmv_weights_ff3 <- compute_gmv_weights(cov_matrix_ff3)
head(gmv_weights_ff3)## [1] 0.337667339 0.295044388 -0.055232522 -0.042329375 -0.008957536
## [6] 0.401070145# Compute the GMV portfolio weights
compute_gmv_weights <- function(cov_matrix) {
n <- nrow(cov_matrix)
dvec <- rep(0, n)
Amat <- matrix(1, 1, n)
bvec <- 1
gmv_weights <- solve.QP(Dmat = 2 * cov_matrix, dvec = dvec, Amat = t(Amat), bvec = bvec)$solution
return(gmv_weights)
}
gmv_weights_capm <- compute_gmv_weights(cov_matrix_capm)
gmv_weights_ff3 <- compute_gmv_weights(cov_matrix_ff3)
# Calculate portfolio returns based on GMV weights
calculate_portfolio_returns <- function(gmv_weights, data) {
returns <- xts()
for (i in 1:(nrow(data) - 6)) {
weights <- gmv_weights
returns_month <- data[i:(i + 5), -(1:4)]
portfolio_returns <- Return.portfolio(returns_month, weights = weights, geometric = TRUE)
returns <- rbind(returns, portfolio_returns)
}
return(returns)
}
portfolio_returns_capm <- calculate_portfolio_returns(gmv_weights_capm, data)
portfolio_returns_ff3 <- calculate_portfolio_returns(gmv_weights_ff3, data)
# Print the results
head(gmv_weights_capm)## [1] 0.01248232 -0.01100338 0.22719217 -0.10019041 0.32583838 0.36169868head(gmv_weights_ff3)## [1] 0.337667339 0.295044388 -0.055232522 -0.042329375 -0.008957536
## [6] 0.401070145head(portfolio_returns_capm)## [,1]
## 2010-03-31 08:00:00 0.019559229
## 2010-04-30 08:00:00 0.005734082
## 2010-04-30 08:00:00 0.007427358
## 2010-06-30 08:00:00 0.026060477
## 2010-06-30 08:00:00 0.026833074
## 2010-06-30 08:00:00 0.025309255head(portfolio_returns_ff3)## [,1]
## 2010-03-31 08:00:00 0.032263561
## 2010-04-30 08:00:00 0.027540167
## 2010-04-30 08:00:00 0.027681794
## 2010-06-30 08:00:00 -0.012113765
## 2010-06-30 08:00:00 -0.009685917
## 2010-06-30 08:00:00 -0.010081279