#Question1
# 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, union
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
## 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 zoo
library(lubridate)
library(timetk)
library(purrr)
library(xts)
library(dplyr)
library(quantmod)
library(zoo)
#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 86.86005 40.73328 31.82712 52.51541 37.52378 60.71096 28.10299
## 2010-01-05 87.08997 40.73328 32.05814 52.33482 37.55685 61.10306 28.17046
## 2010-01-06 87.15130 40.48759 32.12519 52.28558 37.71560 60.28509 28.15820
## 2010-01-07 87.51922 40.51393 31.93888 52.67135 37.57008 60.38651 28.40972
## 2010-01-08 87.81044 40.84735 32.19225 52.95863 37.86774 60.35946 28.21954
## 2010-01-11 87.93307 40.68063 32.12519 52.74523 38.17862 60.02821 28.35450
## 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
#Question2
#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.008117475 -0.015037607 -0.02893504 -0.01301907 -0.003493573
## 2010-01-22 -0.038982357 -0.036859291 -0.05578064 -0.03062207 -0.055740422
## 2010-01-29 -0.016665334 -0.031023666 -0.03357724 -0.02624303 -0.025802801
## 2010-02-05 -0.006797797 0.004440325 -0.02821327 -0.01397430 -0.019054997
## 2010-02-12 0.012938380 0.018148155 0.03333316 0.02952589 0.005244716
## 2010-02-19 0.028693146 0.024451563 0.02445389 0.03343154 0.022995310
## TLT IYR GLD
## 2010-01-15 2.004813e-02 -0.006304491 -0.004579349
## 2010-01-22 1.009970e-02 -0.041785101 -0.033285246
## 2010-01-29 3.369543e-03 -0.008447375 -0.011290465
## 2010-02-05 -5.355167e-05 0.003223165 -0.012080019
## 2010-02-12 -1.946133e-02 -0.007573505 0.022544905
## 2010-02-19 -8.204716e-03 0.050184797 0.022701796
#Monthly return
head(asset_returns_mon_xts)
## SPY QQQ EEM IWM EFA
## 2010-02-26 0.03119473 0.04603903 0.017763745 0.04475096 0.002667337
## 2010-03-31 0.06087947 0.07710913 0.081108789 0.08230705 0.063854555
## 2010-04-30 0.01546966 0.02242567 -0.001661637 0.05678486 -0.028046195
## 2010-05-28 -0.07945395 -0.07392394 -0.093935858 -0.07536643 -0.111927836
## 2010-06-30 -0.05174099 -0.05975702 -0.013986588 -0.07743409 -0.020619468
## 2010-07-30 0.06830005 0.07258286 0.109324699 0.06730911 0.116104062
## TLT IYR GLD
## 2010-02-26 -0.003424801 0.05457095 0.032748219
## 2010-03-31 -0.020572923 0.09748449 -0.004386396
## 2010-04-30 0.033218594 0.06388068 0.058834363
## 2010-05-28 0.051083593 -0.05683525 0.030513147
## 2010-06-30 0.057977781 -0.04670116 0.023553189
## 2010-07-30 -0.009463253 0.09404804 -0.050871157
#Question3
#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 2024-01-… 0.0159 0.0182 -0.0453 -0.0390 -0.00451 -0.0225 -0.0510 -0.0142
## 2 2024-02-… 0.0522 0.0528 0.0417 0.0563 0.0299 -0.0225 0.0213 0.00456
## 3 2024-03-… 0.0327 0.0127 0.0273 0.0349 0.0338 0.00783 0.0185 0.0867
## 4 2024-04-… -0.0403 -0.0437 -0.00219 -0.0685 -0.0324 -0.0646 -0.0812 0.0299
## 5 2024-05-… 0.0506 0.0615 0.0195 0.0504 0.0506 0.0289 0.0493 0.0162
## 6 2024-06-… 0.0126 0.0272 0.00598 -0.0222 0.00111 0.0151 -0.00277 -0.0172
#Question4
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: 1274 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 rows
ff_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.25
tail(ff_data_xts)
## mkt_excess smb hml rf
## 2022-10-31 4.60 -3.52 1.38 0.29
## 2022-11-30 -6.41 -0.69 1.37 0.33
## 2022-12-31 6.65 5.01 -4.01 0.35
## 2023-01-31 -2.58 1.17 -0.81 0.34
## 2023-02-28 2.51 -5.51 -8.85 0.36
## 2023-03-31 0.61 -3.35 -0.04 0.35
#Question5
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 NA
#Question6
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.06087947 0.077109129 0.081108789
## 2010-04-30 -7.89 0.09 -2.44 0.01 0.01546966 0.022425666 -0.001661637
## 2010-06-30 6.93 0.20 -0.31 0.01 -0.05174099 -0.059757021 -0.013986588
## 2010-08-31 9.54 3.96 -3.16 0.01 -0.04498019 -0.051299042 -0.032367173
## 2010-09-30 3.88 1.14 -2.43 0.01 0.08955434 0.131728222 0.117573621
## 2010-11-30 6.82 0.73 3.70 0.01 0.00000000 -0.001724914 -0.029054773
## IWM EFA TLT IYR GLD
## 2010-03-31 0.08230705 0.06385455 -0.02057292 0.09748449 -0.004386396
## 2010-04-30 0.05678486 -0.02804619 0.03321859 0.06388068 0.058834363
## 2010-06-30 -0.07743409 -0.02061947 0.05797778 -0.04670116 0.023553189
## 2010-08-31 -0.07443861 -0.03795021 0.08390904 -0.01297218 0.057061253
## 2010-09-30 0.12445314 0.09971965 -0.02520414 0.04629699 0.047755584
## 2010-11-30 0.03485068 -0.04823734 -0.01689298 -0.01582912 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.011516060 0.0119784092 0.002191836 0.015013689 0.0028633017
## mkt_excess -0.001750047 -0.0009771518 -0.001029271 -0.003149481 -0.0004973715
## TLT IYR GLD
## one_vec 0.005430768 0.01237142 0.006062257
## mkt_excess 0.001633665 -0.00187984 -0.004148860
E_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)
#Question7
#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.06087947 0.077109129 0.081108789 0.08230705 0.06385455
## 2010-04-30 0.01546966 0.022425666 -0.001661637 0.05678486 -0.02804619
## 2010-06-30 -0.05174099 -0.059757021 -0.013986588 -0.07743409 -0.02061947
## 2010-08-31 -0.04498019 -0.051299042 -0.032367173 -0.07443861 -0.03795021
## 2010-09-30 0.08955434 0.131728222 0.117573621 0.12445314 0.09971965
## 2010-11-30 0.00000000 -0.001724914 -0.029054773 0.03485068 -0.04823734
## TLT IYR GLD
## 2010-03-31 -0.02057292 0.09748449 -0.004386396
## 2010-04-30 0.03321859 0.06388068 0.058834363
## 2010-06-30 0.05797778 -0.04670116 0.023553189
## 2010-08-31 0.08390904 -0.01297218 0.057061253
## 2010-09-30 -0.02520414 0.04629699 0.047755584
## 2010-11-30 -0.01689298 -0.01582912 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.001628480 0.002266297 0.004010950 0.003556660 0.002638339 0.001881765
## IYR GLD
## 0.002277246 0.002219845
#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.18759078 0.4247361 0.4477336 0.4440015 0.120936577 0.36513302
## QQQ 0.1875908 1.00000000 0.2399925 0.2572292 0.2561312 0.065384869 0.20247560
## EEM 0.4247361 0.23999247 1.0000000 0.6106200 0.6973520 0.161537624 0.57787569
## IWM 0.4477336 0.25722918 0.6106200 1.0000000 0.5843397 0.168590926 0.54372075
## EFA 0.4440015 0.25613124 0.6973520 0.5843397 1.0000000 0.167345418 0.54150168
## TLT 0.1209366 0.06538487 0.1615376 0.1685909 0.1673454 1.000000000 0.08382204
## IYR 0.3651330 0.20247560 0.5778757 0.5437207 0.5415017 0.083822038 1.00000000
## GLD 0.1360125 0.09082006 0.3077093 0.2765479 0.1887896 0.002175092 0.25858457
## GLD
## SPY 0.136012515
## QQQ 0.090820062
## EEM 0.307709323
## IWM 0.276547894
## EFA 0.188789615
## TLT 0.002175092
## IYR 0.258584572
## 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.337485161
## QQQ 0.294335746
## EEM -0.054900404
## IWM -0.041468317
## EFA -0.008381046
## TLT 0.400827713
## IYR 0.059027700
## GLD 0.013073446
#Question8
# 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.18350270 0.13750606 0.07107091 0.07686591 0.11449122 0.19168251 0.12989940
## [8] 0.09498130
weights_ff3
## [1] 0.337485161 0.294335746 -0.054900404 -0.041468317 -0.008381046
## [6] 0.400827713 0.059027700 0.013073446
#Question9
# 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.004958966 0.003569912 0.0012833950 0.004336883 0.0014263183 0.0019702419
## QQQ 0.003569912 0.005741247 0.0013113953 0.004433065 0.0014657878 0.0020547601
## EEM 0.001283395 0.001311395 0.0044943596 0.001603622 0.0005242394 0.0007120561
## IWM 0.004336883 0.004433065 0.0016036224 0.008627059 0.0017720443 0.0024113032
## EFA 0.001426318 0.001465788 0.0005242394 0.001772044 0.0031973142 0.0008186390
## TLT 0.001970242 0.002054760 0.0007120561 0.002411303 0.0008186390 0.0029256498
## IYR GLD
## SPY 0.003685636 0.0022706282
## QQQ 0.003777997 0.0022887477
## EEM 0.001358530 0.0008526009
## IWM 0.004590717 0.0028754241
## EFA 0.001509485 0.0009170349
## TLT 0.002083919 0.0011571340
# 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.0024083517 0.0004688341 0.003351991 0.0025268676 0.0023605005
## QQQ 0.0004688341 0.0025935550 0.001965482 0.0015065057 0.0014130906
## EEM 0.0033519915 0.0019654824 0.025861138 0.0112926972 0.0121488613
## IWM 0.0025268676 0.0015065057 0.011292697 0.0132253031 0.0072799422
## EFA 0.0023605005 0.0014130906 0.012148861 0.0072799422 0.0117359825
## TLT 0.0002690081 0.0001509290 0.001177457 0.0008787892 0.0008217151
## TLT IYR GLD
## SPY 0.0002690081 0.0017492443 1.502141e-03
## QQQ 0.0001509290 0.0010066067 1.040882e-03
## EEM 0.0011774574 0.0090718873 1.113618e-02
## IWM 0.0008787892 0.0061040507 7.157232e-03
## EFA 0.0008217151 0.0057266276 4.602669e-03
## TLT 0.0020544491 0.0003708902 2.218693e-05
# 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.01248249 -0.01100623 0.22719250 -0.10018997 0.32583834 0.36169828
gmv_weights_ff3 <- compute_gmv_weights(cov_matrix_ff3)
head(gmv_weights_ff3)
## [1] 0.337485161 0.294335746 -0.054900404 -0.041468317 -0.008381046
## [6] 0.400827713
# 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.01248249 -0.01100623 0.22719250 -0.10018997 0.32583834 0.36169828
head(gmv_weights_ff3)
## [1] 0.337485161 0.294335746 -0.054900404 -0.041468317 -0.008381046
## [6] 0.400827713
head(portfolio_returns_capm)
## [,1]
## 2010-03-31 0.019559562
## 2010-04-30 0.005734299
## 2010-04-30 0.007427590
## 2010-06-30 0.026060291
## 2010-06-30 0.026832886
## 2010-06-30 0.025309058
head(portfolio_returns_ff3)
## [,1]
## 2010-03-31 0.032291424
## 2010-04-30 0.027505301
## 2010-04-30 0.027647795
## 2010-06-30 -0.012141185
## 2010-06-30 -0.009714125
## 2010-06-30 -0.010108340
##3####33#
con = gzcon(url('https://github.com/systematicinvestor/SIT/raw/master/sit.gz', 'rb'))
source(con)
close(con)
tickers = spl('SPY,QQQ,EEM,IWM,EFA,TLT,IYR,GLD')
prices
## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 86.86005 40.73328 31.82712 52.51541 37.52378 60.71096 28.10299
## 2010-01-05 87.08997 40.73328 32.05814 52.33482 37.55685 61.10306 28.17046
## 2010-01-06 87.15130 40.48759 32.12519 52.28558 37.71560 60.28509 28.15820
## 2010-01-07 87.51922 40.51393 31.93888 52.67135 37.57008 60.38651 28.40972
## 2010-01-08 87.81044 40.84735 32.19225 52.95863 37.86774 60.35946 28.21954
## 2010-01-11 87.93307 40.68063 32.12519 52.74523 38.17862 60.02821 28.35450
## 2010-01-12 87.11298 40.17168 31.61101 52.17067 37.72883 61.05571 27.87600
## 2010-01-13 87.84878 40.67187 31.70787 52.84373 38.04633 60.34594 28.39745
## 2010-01-14 88.08637 40.70696 31.62592 53.04071 38.33736 61.19093 28.29929
## 2010-01-15 87.09764 40.23310 31.26077 52.26916 37.73545 61.56955 28.04163
## ...
## 2024-05-24 529.44000 457.95001 43.02000 205.44000 81.05000 91.06883 85.09000
## 2024-05-28 529.81000 459.67999 42.96000 205.16000 81.02000 89.76329 84.57000
## 2024-05-29 526.09998 456.44000 42.32000 202.13000 79.74000 88.67701 83.78000
## 2024-05-30 522.60999 451.54999 42.20000 204.05000 80.41000 89.53407 85.00000
## 2024-05-31 527.37000 450.70999 41.79000 205.77000 81.18000 90.14200 86.67000
## 2024-06-03 527.79999 453.13000 42.23000 204.61000 81.41000 91.60000 86.43000
## 2024-06-04 528.39001 454.37000 41.64000 201.97000 81.31000 92.67000 87.20000
## 2024-06-05 534.66998 463.53000 42.31000 205.06000 81.88000 93.35000 86.99000
## 2024-06-06 534.65997 463.37000 42.52000 203.59000 82.16000 93.21000 87.13000
## 2024-06-07 534.01001 462.95999 42.04000 201.20000 81.27000 91.50000 86.43000
## 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
## 2010-01-12 110.49
## 2010-01-13 111.54
## 2010-01-14 112.03
## 2010-01-15 110.86
## ...
## 2024-05-24 215.92
## 2024-05-28 218.19
## 2024-05-29 216.16
## 2024-05-30 216.57
## 2024-05-31 215.30
## 2024-06-03 217.22
## 2024-06-04 215.27
## 2024-06-05 217.82
## 2024-06-06 219.43
## 2024-06-07 211.60
asset_returns_mon_xts <- na.omit(Return.calculate(prices_monthly))
prices_q <- to.quarterly(prices, indexAt = "last", OHLC = FALSE)
asset_q <- na.omit(Return.calculate(prices_q))
head(asset_returns_mon_xts)
## SPY QQQ EEM IWM EFA
## 2010-02-26 0.03119473 0.04603903 0.017763745 0.04475096 0.002667337
## 2010-03-31 0.06087947 0.07710913 0.081108789 0.08230705 0.063854555
## 2010-04-30 0.01546966 0.02242567 -0.001661637 0.05678486 -0.028046195
## 2010-05-28 -0.07945395 -0.07392394 -0.093935858 -0.07536643 -0.111927836
## 2010-06-30 -0.05174099 -0.05975702 -0.013986588 -0.07743409 -0.020619468
## 2010-07-30 0.06830005 0.07258286 0.109324699 0.06730911 0.116104062
## TLT IYR GLD
## 2010-02-26 -0.003424801 0.05457095 0.032748219
## 2010-03-31 -0.020572923 0.09748449 -0.004386396
## 2010-04-30 0.033218594 0.06388068 0.058834363
## 2010-05-28 0.051083593 -0.05683525 0.030513147
## 2010-06-30 0.057977781 -0.04670116 0.023553189
## 2010-07-30 -0.009463253 0.09404804 -0.050871157
tail(asset_returns_mon_xts)
## SPY QQQ EEM IWM EFA
## 2024-01-31 0.01592648 0.01819209 -0.045262366 -0.03901149 -0.004512228
## 2024-02-29 0.05218682 0.05283355 0.041677580 0.05625254 0.029862656
## 2024-03-28 0.03270197 0.01274969 0.027256817 0.03486971 0.033786416
## 2024-04-30 -0.04031964 -0.04373778 -0.002190851 -0.06847365 -0.032431805
## 2024-05-31 0.05057967 0.06151816 0.019516936 0.05038290 0.050601836
## 2024-06-07 0.01259081 0.02717934 0.005982292 -0.02220930 0.001108602
## TLT IYR GLD
## 2024-01-31 -0.02245140 -0.05097916 -0.014228180
## 2024-02-29 -0.02252199 0.02132566 0.004563548
## 2024-03-28 0.00782871 0.01853849 0.086683238
## 2024-04-30 -0.06455446 -0.08120137 0.029894973
## 2024-05-31 0.02886978 0.04927360 0.016189210
## 2024-06-07 0.01506514 -0.00276910 -0.017185308
head(asset_q)
## SPY QQQ EEM IWM EFA
## 2010-06-30 -0.1135802021 -0.109736637 -0.10809310 -0.09852509 -0.15463289
## 2010-09-30 0.1116153182 0.151601806 0.19962475 0.11080239 0.18082142
## 2010-12-31 0.1076088917 0.112043773 0.07301752 0.16435978 0.07006469
## 2011-03-31 0.0589737964 0.056023313 0.02162044 0.07803824 0.03194794
## 2011-06-30 0.0002587202 -0.004389191 -0.01220444 -0.01627691 0.02044961
## 2011-09-30 -0.1381724334 -0.078223416 -0.26260505 -0.21807542 -0.20552065
## TLT IYR GLD
## 2010-06-30 0.14896293 -0.04344587 0.116842622
## 2010-09-30 0.04659127 0.12984993 0.051199896
## 2010-12-31 -0.09557107 0.06966938 0.084512526
## 2011-03-31 -0.01452924 0.07072136 0.008217989
## 2011-06-30 0.03383296 0.02440171 0.043901039
## 2011-09-30 0.29630933 -0.15231133 0.082602723
tail(asset_q)
## SPY QQQ EEM IWM EFA
## 2023-03-31 0.07458217 0.20710083 0.04116090 0.02694582 0.08957965
## 2023-06-30 0.08680376 0.15267123 0.01038836 0.05262681 0.03228440
## 2023-09-29 -0.03224175 -0.02877854 -0.04069765 -0.05179955 -0.04937936
## 2023-12-29 0.11639631 0.14593400 0.07958998 0.13978658 0.10701087
## 2024-03-28 0.10390104 0.08565429 0.02163648 0.05044093 0.05985404
## 2024-06-07 0.02091499 0.04267918 0.02336901 -0.04327155 0.01765585
## TLT IYR GLD
## 2023-03-31 0.07378901 0.01417591 0.08005189
## 2023-06-30 -0.02475892 0.02412876 -0.02701668
## 2023-09-29 -0.13111749 -0.08679658 -0.03825662
## 2023-12-29 0.12944642 0.17970376 0.11501897
## 2024-03-28 -0.03698716 -0.01277206 0.07611029
## 2024-06-07 -0.02304889 -0.03859846 0.02858256
# Load necessary libraries
library(ggplot2)
library(dplyr)
# Generate sample data
set.seed(123) # For reproducibility
dates <- seq.Date(from = as.Date("2010-02-28"), by = "month", length.out = 55)
gmvp_returns <- runif(55, min = 0.01, max = 0.02)
growth <- cumprod(1 + gmvp_returns)
# Create a data frame with the sample data
data <- data.frame(Date = dates, Growth = growth)
# Plot using ggplot2
ggplot(data) +
geom_line(aes(x = Date, y = Growth)) +
ylab("Amount ($)") +
xlab("Date") +
ggtitle("Backtesting of 1-factor model: Cumulative Return") +
theme_minimal() +
theme(
axis.text.x = element_text(size = 10),
axis.text.y = element_text(size = 10),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10),
title = element_text(size = 10, face = 'bold'),
legend.text = element_text(size = 10)
)
# Load necessary libraries
library(ggplot2)
library(dplyr)
# Assuming return data frame already exists
# If not, you can create a sample return data frame for demonstration
# Here, I'm using sample data; replace it with your actual data
set.seed(123) # For reproducibility
dates <- seq.Date(from = as.Date("2010-02-28"), by = "month", length.out = 55)
gmvp_returns <- runif(55, min = 0.01, max = 0.02)
growth <- cumprod(1 + gmvp_returns)
# Create a data frame with the sample data
return <- data.frame(Date = dates, Value = growth)
# Plot using ggplot2
ggplot(return) +
geom_line(aes(x = Date, y = Value)) +
ylab("Profit (in digit)") +
xlab("Date") +
ggtitle("Backtesting of 1-factor model: Return") +
theme_minimal() +
theme(
axis.text.x = element_text(size = 10),
axis.text.y = element_text(size = 10),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10),
title = element_text(size = 10, face = 'bold'),
legend.text = element_text(size = 10)
)
# Load necessary libraries
library(ggplot2)
library(dplyr)
# Generate sample data
set.seed(123) # For reproducibility
dates <- seq.Date(from = as.Date("2010-02-28"), by = "month", length.out = 55)
gmvp_returns <- runif(55, min = 0.01, max = 0.02)
growth <- cumprod(1 + gmvp_returns)
# Create a data frame with the sample data
data <- data.frame(Date = dates, Growth = growth)
# Plot using ggplot2
ggplot(data) +
geom_line(aes(x = Date, y = Growth)) +
ylab("Amount ($)") +
xlab("Date") +
ggtitle("Backtesting of 3-factor model: Cumulative Return") +
theme_minimal() +
theme(
axis.text.x = element_text(size = 10),
axis.text.y = element_text(size = 10),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10),
title = element_text(size = 10, face = 'bold'),
legend.text = element_text(size = 10)
)
library(ggplot2)
library(dplyr)
plot_return <- function(data, title) {
ggplot(data) +
geom_line(aes(x = Date, y = value)) +
ylab("Profit (in digit)") +
xlab("Date") +
ggtitle(title) +
theme_minimal() +
theme(
axis.text.x = element_text(size = 10),
axis.text.y = element_text(size = 10),
axis.title.x = element_text(size = 10),
axis.title.y = element_text(size = 10),
title = element_text(size = 10, face = 'bold'),
legend.text = element_text(size = 10)
)
}
# Assuming return_3 data frame already exists
# If not, you can create a sample return_3 data frame for demonstration
# Here, I'm using sample data; replace it with your actual data
set.seed(123) # For reproducibility
dates <- seq.Date(from = as.Date("2010-02-28"), by = "month", length.out = 55)
gmvp_returns <- runif(55, min = 0.01, max = 0.02)
growth <- cumprod(1 + gmvp_returns)
# Create a data frame with the sample data
return_3 <- data.frame(Date = dates, value = growth)
# Plot using the function
plot_return(return_3, "Backtesting of 3-factors model: Return")
