Index Correlation
rm(list = ls())
# install.packages("corrplot")
library(quantmod)
## Loading required package: xts
## Warning: package 'xts' was built under R version 4.0.2
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Loading required package: TTR
## Warning: package 'TTR' was built under R version 4.0.2
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library(corrplot)
## corrplot 0.92 loaded
# Define the symbols
# S&P 500: "^GSPC"
# Dow Jones Industrial Average: "^DJI"
# Nasdaq Composite: "^IXIC"
# E-mini S&P 500 Futures: "ES=F"
# E-mini Dow Jones Futures: "YM=F"
# E-mini Nasdaq Futures: "NQ=F"
# E-mini Russell 2000 Futures: "RTY=F"
# Gold Futures: "GC=F"
# Silver Futures: "SI=F"
# Crude Oil Futures(WTI): "CL=F"
# Natural Gas Futures: "NG=F"
# Copper Futures: "HG=F"
# Corn Futures: "ZC=F"
symbols <- c("^GSPC", "^DJI", "^IXIC",
"ES=F", "YM=F", "NQ=F", "RTY=F",
"GC=F", "SI=F", "CL=F", "NG=F", "HG=F", "ZC=F")
# Set the start and end dates
start_date <- as.Date("2018-01-01")
end_date <- Sys.Date()
# Fetch the data
getSymbols(symbols, from = start_date, to = end_date)
## Warning: ES=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## Warning: YM=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## Warning: NQ=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## Warning: RTY=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## Warning: GC=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## Warning: SI=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## Warning: CL=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## Warning: NG=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## Warning: HG=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## Warning: ZC=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## [1] "GSPC" "DJI" "IXIC" "ES=F" "YM=F" "NQ=F" "RTY=F" "GC=F" "SI=F"
## [10] "CL=F" "NG=F" "HG=F" "ZC=F"
symbols <- c("GSPC", "DJI", "IXIC",
"ES=F", "YM=F", "NQ=F", "RTY=F",
"GC=F", "SI=F", "CL=F", "NG=F", "HG=F", "ZC=F")
# Compute daily returns
daily_returns <- do.call(merge, lapply(symbols, function(sym) dailyReturn(Ad(get(sym)))))
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
colnames(daily_returns) <- symbols
# Compute weekly returns
weekly_returns <- do.call(merge, lapply(symbols, function(sym) weeklyReturn(Ad(get(sym)))))
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
colnames(weekly_returns) <- symbols
# Compute monthly returns
monthly_returns <- do.call(merge, lapply(symbols, function(sym) monthlyReturn(Ad(get(sym)))))
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
colnames(monthly_returns) <- symbols
# Check The Data Structure
str(daily_returns)
## An 'xts' object on 2018-01-02/2023-07-03 containing:
## Data: num [1:1387, 1:13] 0 0.0064 0.00403 0.00703 0.00166 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:13] "GSPC" "DJI" "IXIC" "ES=F" ...
## Indexed by objects of class: [Date] TZ: UTC
## xts Attributes:
## NULL
str(weekly_returns)
## An 'xts' object on 2018-01-05/2023-07-03 containing:
## Data: num [1:289, 1:13] 0.01756 0.01571 0.00864 0.02226 -0.03855 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:13] "GSPC" "DJI" "IXIC" "ES=F" ...
## Indexed by objects of class: [Date] TZ: UTC
## xts Attributes:
## NULL
str(monthly_returns)
## An 'xts' object on 2018-01-31/2023-07-03 containing:
## Data: num [1:68, 1:13] 0.04748 -0.03895 -0.02688 0.00272 0.02161 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:13] "GSPC" "DJI" "IXIC" "ES=F" ...
## Indexed by objects of class: [Date] TZ: UTC
## xts Attributes:
## NULL
# Compute correlations
correlation_daily <- cor(daily_returns, use = "complete.obs")
correlation_weekly <- cor(weekly_returns, use = "complete.obs")
correlation_monthly <- cor(monthly_returns, use = "complete.obs")
# Plot the correlations
corrplot(correlation_daily, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Daily Returns Correlation")
corrplot(correlation_weekly, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Weekly Returns Correlation")
corrplot(correlation_monthly, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Monthly Returns Correlation")
Upside vs Downside Index Correlation
daily_returns_up <- daily_returns[daily_returns$GSPC >= 0]
daily_returns_down <- daily_returns[daily_returns$GSPC < 0]
weekly_returns_up <- weekly_returns[weekly_returns$GSPC >= 0]
weekly_returns_down <- weekly_returns[weekly_returns$GSPC < 0]
monthly_returns_up <- monthly_returns[monthly_returns$GSPC >= 0]
monthly_returns_down <- monthly_returns[monthly_returns$GSPC < 0]
# Compute market upside correlations
correlation_daily_up <- cor(daily_returns_up, use = "complete.obs")
correlation_weekly_up <- cor(weekly_returns_up, use = "complete.obs")
correlation_monthly_up <- cor(monthly_returns_up, use = "complete.obs")
# Plot the upside correlations
corrplot(correlation_daily_up, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Daily Returns Correlation")
corrplot(correlation_weekly_up, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Weekly Returns Correlation")
corrplot(correlation_monthly_up, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Monthly Returns Correlation")
# Compute market downside correlations
correlation_daily_down <- cor(daily_returns_down, use = "complete.obs")
correlation_weekly_down <- cor(weekly_returns_down, use = "complete.obs")
correlation_monthly_down <- cor(monthly_returns_down, use = "complete.obs")
# Plot the downside correlations
corrplot(correlation_daily_down, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Daily Returns Correlation")
corrplot(correlation_weekly_down, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Weekly Returns Correlation")
corrplot(correlation_monthly_down, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Monthly Returns Correlation")
Extreme Downside Index Correlation
# Extreme Downside Market Data
daily_returns_down <- daily_returns[daily_returns$GSPC < 0]
weekly_returns_down <- weekly_returns[weekly_returns$GSPC < -0.01]
monthly_returns_down <- monthly_returns[monthly_returns$GSPC < -0.05]
# Compute market extreme downside correlations
correlation_daily_down <- cor(daily_returns_down, use = "complete.obs")
correlation_weekly_down <- cor(weekly_returns_down, use = "complete.obs")
correlation_monthly_down <- cor(monthly_returns_down, use = "complete.obs")
# Plot the downside correlations
corrplot(correlation_daily_down, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Daily Returns Correlation")
corrplot(correlation_weekly_down, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Weekly Returns Correlation")
corrplot(correlation_monthly_down, method = "color", type = "lower", tl.cex = 0.8, tl.col = "black", addCoef.col = "black", diag = FALSE, title = "Monthly Returns Correlation")
S&P500 with Gold Futures Portfolio
library(quantmod)
library(dplyr)
##
## 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
library(ggplot2)
# Set the start and end dates
start_date <- as.Date("2018-01-01")
end_date <- Sys.Date()
# Fetch the S&P 500 index data
getSymbols("^GSPC", from = start_date, to = end_date)
## [1] "GSPC"
# Fetch the Gold Futures data
getSymbols("GC=F", from = start_date, to = end_date)
## Warning: GC=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## [1] "GC=F"
# Compute monthly returns for S&P 500
sp500_returns <- monthlyReturn(Ad(GSPC))
# Compute monthly returns for Gold Futures
gold_returns <- monthlyReturn(Ad(`GC=F`))
## Warning in to_period(xx, period = on.opts[[period]], ...): missing values
## removed from data
# Create a data frame to store the weight combinations and results
weight_table <- expand.grid(SnP500_Weight = seq(0, 1, by = 0.05))
# Compute Gold weights based on SnP500 weights
weight_table$Gold_Weight <- 1 - weight_table$SnP500_Weight
# Function to compute portfolio returns and standard deviations
compute_portfolio_stats <- function(SnP500_Weight, Gold_Weight) {
portfolio_returns <- SnP500_Weight * sp500_returns + Gold_Weight * gold_returns
expected_return <- mean(portfolio_returns)
standard_deviation <- sd(portfolio_returns)
return(c(Expected_Return = expected_return, Standard_Deviation = standard_deviation))
}
# Apply the function to each row of the weight table
portfolio_stats <- t(apply(weight_table, 1, function(x) compute_portfolio_stats(x[1], x[2])))
# Combine the weight table and portfolio statistics into a final table
final_table <- cbind(weight_table, portfolio_stats)
# Print the final table
print(final_table)
## SnP500_Weight Gold_Weight Expected_Return Standard_Deviation
## 1 0.00 1.00 0.006908562 0.03805550
## 2 0.05 0.95 0.006969765 0.03676455
## 3 0.10 0.90 0.007030968 0.03566559
## 4 0.15 0.85 0.007092171 0.03477683
## 5 0.20 0.80 0.007153374 0.03411471
## 6 0.25 0.75 0.007214576 0.03369259
## 7 0.30 0.70 0.007275779 0.03351954
## 8 0.35 0.65 0.007336982 0.03359941
## 9 0.40 0.60 0.007398185 0.03393040
## 10 0.45 0.55 0.007459388 0.03450530
## 11 0.50 0.50 0.007520591 0.03531219
## 12 0.55 0.45 0.007581793 0.03633563
## 13 0.60 0.40 0.007642996 0.03755791
## 14 0.65 0.35 0.007704199 0.03896032
## 15 0.70 0.30 0.007765402 0.04052417
## 16 0.75 0.25 0.007826605 0.04223152
## 17 0.80 0.20 0.007887808 0.04406570
## 18 0.85 0.15 0.007949011 0.04601155
## 19 0.90 0.10 0.008010213 0.04805550
## 20 0.95 0.05 0.008071416 0.05018556
## 21 1.00 0.00 0.008132619 0.05239124
plot(final_table[,4:3],
xlab = "Portfolio SD",
ylab = "Portfolio Expected Returns",
main = "S&P500 + Gold Futures Portfolio")
# Combine the returns into a data frame
port100 = cumprod(1 + sp500_returns) * 10000
port9010 = cumprod(1 + 0.9 * sp500_returns + 0.1 * gold_returns) * 10000
port8020 = cumprod(1 + 0.8 * sp500_returns + 0.2 * gold_returns) * 10000
port7030 = cumprod(1 + 0.7 * sp500_returns + 0.3 * gold_returns) * 10000
port6040 = cumprod(1 + 0.6 * sp500_returns + 0.4 * gold_returns) * 10000
port5050 = cumprod(1 + 0.5 * sp500_returns + 0.5 * gold_returns) * 10000
ret <- merge(port100, port9010, port8020, port7030, port6040, port5050)
returns <- data.frame(Date = index(sp500_returns), ret)
returns <- returns[1:65,]
colnames(returns) <- c("Date","port100","port9010", "port8020",
"port7030", "port6040", "port5050")
# Plot cumulative returns
ggplot(returns, aes(x = Date)) +
geom_line(aes(y = port100, color = "port100")) +
geom_line(aes(y = port9010, color = "port9010")) +
geom_line(aes(y = port8020, color = "port8020")) +
geom_line(aes(y = port7030, color = "port7030")) +
geom_line(aes(y = port6040, color = "port6040")) +
geom_line(aes(y = port5050, color = "port5050")) +
labs(title = "Cumulative Returns of Portfolios") +
scale_color_manual(values = c("port100" = "blue",
"port9010" = "red",
"port8020" = "green",
"port7030" = "purple",
"port6040" = "orange",
"port5050" = "black")) +
theme_minimal()
Stock Portfolio Hedge
# Set the start and end dates for the cumulative return calculation
start_date <- as.Date("2020-01-01")
end_date <- Sys.Date()
# Fetch the price data for AAPL, TSLA, WMT, and SBUX from 2020 to present
symbols <- c("AAPL", "TSLA", "WMT", "SBUX")
getSymbols(symbols, from = start_date, to = end_date)
## [1] "AAPL" "TSLA" "WMT" "SBUX"
# Calculate the monthly returns for the selected period
returns_2020 <- data.frame(AAPL = monthlyReturn(Ad(AAPL)),
TSLA = monthlyReturn(Ad(TSLA)),
WMT = monthlyReturn(Ad(WMT)),
SBUX = monthlyReturn(Ad(SBUX)))
returns_2020 <- as.matrix(returns_2020,
nrow(returns_2020),
ncol(returns_2020))
optimal_weights <- as.matrix(c(0.25,0.25,0.25,0.25),4,1)
# Compute the portfolio returns using the optimal weights
portfolio_returns <- returns_2020 %*% optimal_weights
# Calculate the cumulative returns
cumulative_returns <- cumprod(1 + portfolio_returns) * 10000
# Create a data frame with the cumulative returns
portfolio_cumulative <- data.frame(Date = index(portfolio_returns), Cumulative_Return = cumulative_returns)
# Plot the cumulative returns
ggplot(portfolio_cumulative, aes(x = Date, y = Cumulative_Return)) +
geom_line(color = "blue") +
ylab("Portfolio Value (USD)") +
xlab("Date") +
ggtitle("Cumulative Portfolio Returns") +
theme_minimal()
Optimal Hedge Ratio
### First we will calculate the optimal hedge ratio for AAPL stock using the S&P500 Futures Index
# Load required libraries
library(quantmod)
# Set the start and end dates for historical data
start_date <- as.Date("2020-01-01") # Replace with the desired start date
end_date <- as.Date("2021-12-31") # Replace with the desired end date
# Define the symbol for the asset to be hedged and the hedging instrument
asset_symbol <- "AAPL" # Replace with the symbol of the asset to be hedged
hedging_symbol <- "ES=F" # Replace with the symbol of the hedging instrument
# Fetch the historical price data for the asset and hedging instrument
getSymbols(c(asset_symbol, hedging_symbol), from = start_date, to = end_date)
## [1] "AAPL" "ES=F"
# Extract the adjusted close prices for the asset and hedging instrument
asset_prices <- Ad(get(asset_symbol))
hedging_prices <- Ad(get(hedging_symbol))
# Combine the prices into a data frame
data <- merge(Asset = asset_prices, Hedging = hedging_prices)
data <- na.omit(data)
data <- diff(data)
data <- na.omit(data)
colnames(data) <- c("AAPL", "SPF")
cor(data$AAPL, data$SPF)
## SPF
## AAPL 0.6746872
# Perform linear regression (OLS) to determine the hedge ratio
model <- lm(AAPL ~ SPF, data = data)
optimal_hedge_ratio <- coef(model)["SPF"] ### THIS IS THE OPTIMAL HEDGE RATIO!
# Print the optimal hedge ratio
cat("Optimal Hedge Ratio:", optimal_hedge_ratio, "\n")
## Optimal Hedge Ratio: 0.03285104
### Then we will evaluate the hedging performance from January 1, 2022 - June 30, 2023
# Set the start and end dates for historical data
start_date <- as.Date("2022-01-01") # Replace with the desired start date
end_date <- as.Date("2023-06-30") # Replace with the desired end date
# Define the symbol for the asset to be hedged and the hedging instrument
asset_symbol <- "AAPL" # Replace with the symbol of the asset to be hedged
hedging_symbol <- "ES=F" # Replace with the symbol of the hedging instrument
# Fetch the historical price data for the asset and hedging instrument
getSymbols(c(asset_symbol, hedging_symbol), from = start_date, to = end_date)
## Warning: ES=F contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using na.omit(),
## na.approx(), na.fill(), etc to remove or replace them.
## [1] "AAPL" "ES=F"
# Extract the adjusted close prices for the asset and hedging instrument
asset_prices <- Ad(get(asset_symbol))
hedging_prices <- Ad(get(hedging_symbol))
# Combine the prices into a data frame
data <- merge(Asset = asset_prices, Hedging = hedging_prices)
data <- na.omit(data)
data <- diff(data)
data <- na.omit(data)
colnames(data) <- c("AAPL", "SPF")
# Calculate the hedged values
unhedged_values <- data$AAPL
hedged_values <- data$AAPL - optimal_hedge_ratio * data$SPF ## TO HEDGE THE APPL STOCK, YOU **SHORT** THE S&P 500 INDEX FUTURES = 0.03994316 PER ONE APPL STOCK
# Unhedged vs Hedge Stats
psych::describe(unhedged_values)
## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 373 0.02 3.03 0.02 0.03 2.8 -9.55 11.97 21.51 0.14 1.15 0.16
psych::describe(hedged_values)
## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 373 0.06 1.72 0.01 0.04 1.46 -5.78 7.88 13.65 0.34 2.35 0.09
# Calculate the post-hedged performance
pre_hedged_performance <- cumsum(unhedged_values)
post_hedged_performance <- cumsum(hedged_values)
# Plot the pre vs post-hedged performance
par(mfrow = c(2,1))
plot(pre_hedged_performance)
plot(post_hedged_performance)
