final2
2024-06-10
# Load necessary libraries (if not loaded already)
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##
## 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(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, unionlibrary(lubridate)
library(ggplot2)
# Define ETF tickers and date range
tickers <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
start_date <- "2010-01-01"
end_date <- Sys.Date()
# Download ETF data
etf_data <- tq_get(tickers, from = start_date, to = end_date)
# Calculate monthly log returns for each ETF
monthly_returns <- etf_data %>%
group_by(symbol) %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "monthly_return",
type = "log") %>%
ungroup()
# Summary statistics
summary_stats <- monthly_returns %>%
summarise(
mean_return = mean(monthly_return),
sd_return = sd(monthly_return),
min_return = min(monthly_return),
max_return = max(monthly_return)
)
# Calculate Sharpe ratio
risk_free_rate <- 0.02 # Example risk-free rate
sharpe_ratios <- monthly_returns %>%
mutate(excess_return = monthly_return - risk_free_rate) %>%
group_by(symbol) %>%
summarise(
mean_excess_return = mean(excess_return),
sd_return = sd(excess_return)
) %>%
mutate(
sharpe_ratio = mean_excess_return / sd_return * sqrt(12) # Assuming monthly data
)
# Portfolio Optimization (Example using Equal Weights)
num_assets <- n_distinct(monthly_returns$symbol)
weights <- rep(1/num_assets, num_assets)
portfolio_returns <- monthly_returns %>%
group_by(date) %>%
summarise(
portfolio_return = sum(weights * monthly_return)
)
# Performance Metrics (Example using Cumulative Returns)
cumulative_returns <- monthly_returns %>%
group_by(symbol) %>%
mutate(cumulative_return = cumprod(1 + monthly_return) - 1)
# Drawdown Analysis (Example using Maximum Drawdown)
calculate_drawdown <- function(returns) {
wealth_index <- cumprod(1 + returns)
previous_peaks <- cummax(wealth_index)
drawdown <- (wealth_index - previous_peaks) / previous_peaks
max_drawdown <- min(drawdown)
return(max_drawdown)
}
max_drawdown <- cumulative_returns %>%
group_by(symbol) %>%
summarise(max_drawdown = calculate_drawdown(monthly_return))
# Visualize cumulative returns
ggplot(cumulative_returns, aes(x = date, y = cumulative_return, color = symbol)) +
geom_line() +
labs(title = "Cumulative Returns of ETFs",
x = "Date",
y = "Cumulative Return") +
theme_minimal()
# Backtesting Global Minimum Variance Portfolio (GMV)
# Assuming GMV weights based on historical monthly returns
gmv_weights <- rep(1/num_assets, num_assets) # Example: Equal weights for GMV
# Calculate GMV portfolio returns
gmv_portfolio_returns <- monthly_returns %>%
group_by(date) %>%
summarise(
gmv_portfolio_return = sum(gmv_weights * monthly_return)
)
# Visualize GMV portfolio returns
ggplot(gmv_portfolio_returns, aes(x = date, y = gmv_portfolio_return)) +
geom_line() +
labs(title = "Global Minimum Variance Portfolio Returns",
x = "Date",
y = "Portfolio Return") +
theme_minimal()
# Additional Analysis and Visualization (if needed)
# Example: Histogram of monthly returns for each ETF
ggplot(monthly_returns, aes(x = monthly_return, fill = symbol)) +
geom_histogram(bins = 30, alpha = 0.5) +
labs(title = "Monthly Returns Distribution",
x = "Monthly Return",
y = "Frequency",
fill = "ETF Symbol") +
theme_minimal()
# Final outputs or summaries
print(summary_stats)## # A tibble: 1 × 4
## mean_return sd_return min_return max_return
## <dbl> <dbl> <dbl> <dbl>
## 1 0.00634 0.0485 -0.242 0.168print(sharpe_ratios)## # A tibble: 8 × 4
## symbol mean_excess_return sd_return sharpe_ratio
## <chr> <dbl> <dbl> <dbl>
## 1 EEM -0.0184 0.0537 -1.19
## 2 EFA -0.0156 0.0465 -1.16
## 3 GLD -0.0162 0.0451 -1.25
## 4 IWM -0.0123 0.0572 -0.744
## 5 IYR -0.0135 0.0496 -0.946
## 6 QQQ -0.00603 0.0507 -0.412
## 7 SPY -0.00956 0.0425 -0.780
## 8 TLT -0.0176 0.0397 -1.54print(max_drawdown)## # A tibble: 8 × 2
## symbol max_drawdown
## <chr> <dbl>
## 1 EEM -0.386
## 2 EFA -0.291
## 3 GLD -0.467
## 4 IWM -0.371
## 5 IYR -0.348
## 6 QQQ -0.355
## 7 SPY -0.255
## 8 TLT -0.496R 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:
summary(cars)## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00Including 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.