Zolboo_FInal
2023-06-12
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
# 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 zoolibrary(timetk)
library(dplyr)##
## ######################### 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: 'dplyr'## The following objects are masked from 'package:xts':
##
## first, last## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# Define the ticker symbols
symbols <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
# Set the start and end dates
start_date <- "2010-01-01"
end_date <- Sys.Date()
# Download the daily prices for the tickers
getSymbols(symbols, src = "yahoo", from = start_date, to = end_date)## [1] "SPY" "QQQ" "EEM" "IWM" "EFA" "TLT" "IYR" "GLD"# Extract the adjusted closing prices
prices <- do.call(merge, lapply(symbols, function(sym) Cl(get(sym))))
# Rename the columns with the ticker symbols
colnames(prices) <- symbols
# Convert the prices to a tibble
prices <- as_tibble(prices, rownames = "date")
# View the head of the prices data
head(prices)## # A tibble: 6 × 9
## date SPY QQQ EEM IWM EFA TLT IYR GLD
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2010-01-04 113. 46.4 42.7 64.0 56.7 89.8 45.8 110.
## 2 2010-01-05 114. 46.4 43.0 63.8 56.8 90.4 45.9 110.
## 3 2010-01-06 114. 46.1 43.1 63.7 57.0 89.2 45.9 112.
## 4 2010-01-07 114. 46.2 42.9 64.2 56.8 89.3 46.3 111.
## 5 2010-01-08 115. 46.5 43.2 64.5 57.2 89.3 46 111.
## 6 2010-01-11 115. 46.4 43.1 64.3 57.7 88.8 46.2 113.# Convert prices to an xts object
prices_xts <- as.xts(prices[,-1], order.by = as.Date(prices$date))
# Calculate weekly returns
weekly_returns <- apply.weekly(prices_xts, function(x) log(last(x)) - log(first(x)))
# Calculate monthly returns
monthly_returns <- apply.monthly(prices_xts, function(x) log(last(x)) - log(first(x)))
# View the head of weekly returns
head(weekly_returns)## SPY QQQ EEM IWM EFA
## 2010-01-08 0.010882054 0.002796626 0.01140745 0.008404674 0.009124479
## 2010-01-15 -0.009546019 -0.011061866 -0.02727655 -0.009066841 -0.011675692
## 2010-01-22 -0.052181084 -0.053566531 -0.07745646 -0.049306858 -0.067122457
## 2010-01-29 -0.021920175 -0.034905964 -0.04144883 -0.027727125 -0.038318851
## 2010-02-05 -0.022251928 -0.006493501 -0.05517019 -0.025815394 -0.037366130
## 2010-02-12 0.020100724 0.025224065 0.04278577 0.039102728 0.025243507
## TLT IYR GLD
## 2010-01-08 -0.005806791 0.004138959 0.01419746
## 2010-01-15 0.025351577 -0.011095559 -0.01779134
## 2010-01-22 0.012909055 -0.062395811 -0.03978758
## 2010-01-29 0.007939524 -0.015762717 -0.01424316
## 2010-02-05 0.009064681 -0.014808370 -0.03445863
## 2010-02-12 -0.020956343 0.015381329 0.02842716# View the head of monthly returns
head(monthly_returns)## SPY QQQ EEM IWM EFA
## 2010-01-29 -0.053836871 -0.08142591 -0.109505529 -0.06239430 -0.07787103
## 2010-02-26 0.015286925 0.03408646 -0.008943519 0.03203638 -0.01546325
## 2010-03-31 0.044657694 0.05879646 0.061188648 0.05362485 0.05413671
## 2010-04-30 0.008537261 0.02217754 -0.027444011 0.04598185 -0.04597688
## 2010-05-28 -0.095667497 -0.09071435 -0.104099890 -0.10057932 -0.12584463
## 2010-06-30 -0.040907223 -0.05622145 -0.002141377 -0.04978691 -0.02819481
## TLT IYR GLD
## 2010-01-29 0.027456151 -0.05335198 -0.035598901
## 2010-02-26 0.005688634 0.03510687 0.009918364
## 2010-03-31 -0.020350142 0.07311946 -0.004396045
## 2010-04-30 0.035126214 0.05731394 0.045216446
## 2010-05-28 0.051129660 -0.08901133 0.026854637
## 2010-06-30 0.049355450 -0.03680633 0.014653159# Convert monthly returns to tibble format
monthly_returns_tibble <- as_tibble(monthly_returns, rownames = "date")
# View the tibble
monthly_returns_tibble## # A tibble: 162 × 9
## date SPY QQQ EEM IWM EFA TLT IYR GLD
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2010-01… -0.0538 -0.0814 -0.110 -0.0624 -0.0779 0.0275 -0.0534 -0.0356
## 2 2010-02… 0.0153 0.0341 -0.00894 0.0320 -0.0155 0.00569 0.0351 0.00992
## 3 2010-03… 0.0447 0.0588 0.0612 0.0536 0.0541 -0.0204 0.0731 -0.00440
## 4 2010-04… 0.00854 0.0222 -0.0274 0.0460 -0.0460 0.0351 0.0573 0.0452
## 5 2010-05… -0.0957 -0.0907 -0.104 -0.101 -0.126 0.0511 -0.0890 0.0269
## 6 2010-06… -0.0409 -0.0562 -0.00214 -0.0498 -0.0282 0.0494 -0.0368 0.0147
## 7 2010-07… 0.0705 0.0729 0.0965 0.0691 0.0953 -0.0111 0.0918 -0.0133
## 8 2010-08… -0.0684 -0.0713 -0.0584 -0.0946 -0.0718 0.0947 -0.0430 0.0551
## 9 2010-09… 0.0510 0.0919 0.0766 0.0768 0.0600 -0.00463 0.00550 0.0499
## 10 2010-10… 0.0333 0.0627 0.0151 0.0353 0.0274 -0.0409 0.0337 0.0284
## # ℹ 152 more rows# Download Fama French 3 factors data and change to digit numbers
download.file("http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/F-F_Research_Data_Factors_CSV.zip",
"FamaFrench.zip")
unzip("FamaFrench.zip", exdir = "FamaFrench")
ff_data <- read.csv("FamaFrench/F-F_Research_Data_Factors.CSV", skip = 3, header = TRUE)
colnames(ff_data)[colnames(ff_data) == "X"] <- "Date"
colnames(ff_data)[grepl("^X$", colnames(ff_data))] <- "Date"
# Convert "Date" column in ff_data to Date format
ff_data$Date <- as.Date(as.yearmon(ff_data$Date, "%Y%m"))
# Convert "Date" column in ff_data to match the format in monthly_returns_tibble
ff_data$Date <- format(ff_data$Date, "%Y-%d-%m")
# Convert monthly returns from question 3 to tibble format
monthly_returns_tibble <- as_tibble(monthly_returns, rownames = "Date")
# Convert Fama-French data from question 4 to tibble format
ff_data_tibble <- as_tibble(ff_data, rownames = "Date")
# Rename duplicate column names in Fama-French data
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "Date"] <- "FF_Date"
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "Mkt-RF"] <- "FF_Mkt_RF"
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "SMB"] <- "FF_SMB"
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "HML"] <- "FF_HML"
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "RF"] <- "FF_RF"
# Convert monthly returns from question 3 to tibble format
monthly_returns_tibble <- as_tibble(monthly_returns, rownames = "Date")
# Convert Fama-French data from question 4 to tibble format
ff_data_tibble <- as_tibble(ff_data, rownames = "Date")
# Rename duplicate column names in Fama-French data
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "Date"] <- "FF_Date"
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "Mkt-RF"] <- "FF_Mkt_RF"
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "SMB"] <- "FF_SMB"
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "HML"] <- "FF_HML"
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "RF"] <- "FF_RF"
# Rename the "Date" column in ff_data_tibble
colnames(ff_data_tibble)[colnames(ff_data_tibble) == "Date"] <- "FF_Date"
# Convert the "Date" column in monthly_returns_tibble to match the format in ff_data_tibble
monthly_returns_tibble$Date <- format(as.Date(monthly_returns_tibble$Date, "%Y-%m-%d"), "%Y-%m")
# Create the 8x1 matrix with value = 1
one_8 <- rep(1, 8)
one_8_1 <- matrix(one_8, ncol = 1)
# Calculate the covariance matrix
cov_matrix <- cov(monthly_returns_tibble[, symbols])
# Calculate the inverse of the covariance matrix
inv_cov_matrix <- solve(cov_matrix)
# Calculate the numerator and denominator for the GMVP
a_sfm <- inv_cov_matrix %*% one_8_1
b_sfm <- t(one_8_1) %*% inv_cov_matrix %*% one_8_1
# Calculate the GMVP weights
gmvp_weights <- a_sfm / as.vector(b_sfm)
# Sum of weights
sum(gmvp_weights)## [1] 1# Create a tibble for the weights
gmvp_weights_tibble <- tibble(Asset = symbols, Weight = gmvp_weights)
# Print the GMVP weights
gmvp_weights_tibble## # A tibble: 8 × 2
## Asset Weight[,1]
## <chr> <dbl>
## 1 SPY 1.00
## 2 QQQ -0.524
## 3 EEM -0.0687
## 4 IWM 0.0759
## 5 EFA 0.148
## 6 TLT 0.529
## 7 IYR -0.315
## 8 GLD 0.152library(SIT)
# Define the historical window
window <- 6
# Get the historical returns data
returns <- monthly_returns_tibble[, symbols]
# Convert returns data to a matrix
returns_matrix <- as.matrix(returns)
# Get the number of assets
n_assets <- ncol(returns_matrix)
# Function to estimate optimal weights
estimate_weights <- function(model, returns_matrix) {
# Calculate the excess returns
excess_returns <- returns_matrix - model$FF_RF
# Estimate the optimal weights
weights <- SITCAPM(excess_returns, model)$weights
return(weights)
}
# Initialize a list to store the GMV portfolio weights
gmv_weights <- vector("list", length = nrow(returns_matrix) - window)Including Plots
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.