# CVaR Portfolio Optimization with Static and Dynamic Tests
# This script performs portfolio optimization using the CVaR risk measure
# It includes both static tests (efficient frontiers) and dynamic tests (rolling window)
# Performance is compared using: average return, standard deviation, Sharpe ratio, and UP ratio
# ---- LOAD REQUIRED PACKAGES ----
# Install packages if needed
required_packages <- c("readxl", "xts", "zoo", "TTR", "PortfolioAnalytics",
"ROI", "ROI.plugin.quadprog", "ROI.plugin.glpk", "PerformanceAnalytics",
"ggplot2", "reshape2", "quantmod")
for (pkg in required_packages) {
if (!require(pkg, character.only = TRUE)) {
install.packages(pkg)
library(pkg, character.only = TRUE)
}
}
## Cargando paquete requerido: readxl
## Cargando paquete requerido: xts
## Cargando paquete requerido: zoo
##
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Cargando paquete requerido: TTR
## Cargando paquete requerido: PortfolioAnalytics
## Cargando paquete requerido: foreach
## Cargando paquete requerido: PerformanceAnalytics
##
## Adjuntando el paquete: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend
## Registered S3 method overwritten by 'PortfolioAnalytics':
## method from
## print.constraint ROI
## Cargando paquete requerido: ROI
## ROI: R Optimization Infrastructure
## Registered solver plugins: nlminb, symphony, glpk, quadprog.
## Default solver: auto.
##
## Adjuntando el paquete: 'ROI'
## The following objects are masked from 'package:PortfolioAnalytics':
##
## is.constraint, objective
## Cargando paquete requerido: ROI.plugin.quadprog
## Cargando paquete requerido: ROI.plugin.glpk
## Cargando paquete requerido: ggplot2
## Cargando paquete requerido: reshape2
## Cargando paquete requerido: quantmod
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
# ---- PARAMETER SETTINGS ----
# Define parameters for portfolio optimization and backtesting
window_length <- 12 # 1-year lookback period
rebalance_freq <- 1 # Monthly rebalancing
num_portfolios <- 20 # Number of portfolios for efficient frontier
# ---- FILE PATH CONFIGURATION ----
# Create file paths using file.path() to handle spaces and special characters better
base_dir <- file.path("C:", "Users", "lcyep", "OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey",
"Tec", "Semestre 6", "Risk", "R, project")
stock_file_path <- file.path(base_dir, "data.xlsx")
market_file_path <- file.path(base_dir, "data.xlsx")
# Check if files exist
if (!file.exists(stock_file_path)) {
stop("Stock file not found. Please check the path and filename.")
}
if (!file.exists(market_file_path)) {
stop("Market file not found. Please check the path and filename.")
}
# ---- DATA IMPORT FUNCTION ----
import_excel_data <- function(stock_file_path, market_file_path) {
tryCatch({
# Read stock price data
cat("Reading stock data from:", stock_file_path, "\n")
stock_data <- read_excel(stock_file_path)
# Read benchmark and risk-free rate data
cat("Reading market data from:", market_file_path, "\n")
market_data <- read_excel(market_file_path)
# Convert the first column to dates
dates <- as.Date(stock_data[[1]])
# Create xts objects for stock prices
stock_prices <- as.matrix(stock_data[, -1]) # Remove the date column
rownames(stock_prices) <- NULL
stock_prices_xts <- xts(stock_prices, order.by = dates)
colnames(stock_prices_xts) <- colnames(stock_data)[-1] # Preserve stock names
# Extract S&P 500 price and T-bill data from market data
sp500_prices <- as.numeric(market_data[[2]]) # S&P 500 Price Index column
tbill_rates <- as.numeric(market_data[[4]]) / 100 / 12 # Convert annual rate to monthly
market_dates <- as.Date(market_data[[1]])
sp500_prices_xts <- xts(sp500_prices, order.by = market_dates)
tbill_rates_xts <- xts(tbill_rates, order.by = market_dates)
# Calculate returns for stocks
stock_returns_xts <- ROC(stock_prices_xts, type = "discrete", n = 1)
stock_returns_xts <- stock_returns_xts[-1, ] # Remove first NA row
# Calculate returns for S&P 500
sp500_returns_xts <- ROC(sp500_prices_xts, type = "discrete", n = 1)
sp500_returns_xts <- sp500_returns_xts[-1, ] # Remove first NA row
# Remove first value from tbill rates to align with returns
tbill_rates_xts <- tbill_rates_xts[-1, ]
return(list(
stock_returns = stock_returns_xts,
sp500_returns = sp500_returns_xts,
risk_free_rate = tbill_rates_xts
))
}, error = function(e) {
stop(paste("Error reading files:", e$message))
})
}
# ---- IMPORT DATA ----
cat("Importing data...\n")
## Importing data...
data_list <- import_excel_data(stock_file_path, market_file_path)
## Reading stock data from: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/data.xlsx
## New names:
## • `` -> `...1`
## Reading market data from: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/data.xlsx
## New names:
## • `` -> `...1`
stock_returns <- data_list$stock_returns
sp500_returns <- data_list$sp500_returns
risk_free_rate <- data_list$risk_free_rate
# Check that we have data
cat("Number of observations in stock returns:", nrow(stock_returns), "\n")
## Number of observations in stock returns: 230
cat("Number of stocks:", ncol(stock_returns), "\n")
## Number of stocks: 50
cat("First few dates:", index(stock_returns)[1:5], "\n")
## First few dates: 12814 12842 12873 12902 12934
cat("Last few dates:", tail(index(stock_returns), 5), "\n")
## Last few dates: 19661 19691 19720 19753 19782
# ---- UTILITY FUNCTIONS ----
# Function to create a clean portfolio specification with CVaR constraint
create_portfolio_spec <- function(assets, rf_rate, confidence_level = 0.95) {
# Initialize portfolio specification
port_spec <- portfolio.spec(assets = assets)
# Add constraints
port_spec <- add.constraint(port_spec, type = "full_investment")
port_spec <- add.constraint(port_spec, type = "long_only")
# Add objectives
# We'll have two different objective functions:
# 1. Return/CVaR (maximize quadratic utility)
# 2. Minimize CVaR
port_spec <- add.objective(port_spec, type = "risk", name = "CVaR",
arguments = list(p = confidence_level))
port_spec <- add.objective(port_spec, type = "return", name = "mean")
return(port_spec)
}
# Function to optimize portfolio weights based on CVaR
optimize_cvar_portfolio <- function(returns, rf_rate, confidence_level = 0.95,
target_return = NULL, minimize_risk = FALSE) {
# Get asset names
assets <- colnames(returns)
# Create portfolio specification
port_spec <- create_portfolio_spec(assets, rf_rate, confidence_level)
# Define optimization parameters
if (minimize_risk) {
# Portfolio optimized to minimize CVaR
port_spec <- add.objective(port_spec, type = "risk", name = "CVaR",
arguments = list(p = confidence_level))
# Add target return constraint if specified
if (!is.null(target_return)) {
# Create a proper return target constraint
port_spec <- add.constraint(port_spec, type = "return",
name = "mean", return_target = target_return)
}
} else {
# Default: maximize quadratic utility (return/CVaR)
port_spec <- add.objective(port_spec, type = "return", name = "mean")
port_spec <- add.objective(port_spec, type = "risk", name = "CVaR",
arguments = list(p = confidence_level))
}
# Run optimization
opt_portfolio <- optimize.portfolio(returns, port_spec, optimize_method = "ROI")
return(opt_portfolio)
}
# Function to calculate the U-P ratio
calculate_up_ratio <- function(returns, rf_rate = 0) {
# U-P ratio = (mean(R) - Rf) / sqrt(semivariance)
mean_return <- mean(returns)
# Semi-variance (downside deviation squared)
semi_var <- sum(pmin(returns - mean_return, 0)^2) / length(returns)
up_ratio <- (mean_return - rf_rate) / sqrt(semi_var)
return(up_ratio)
}
# Function to calculate performance metrics
calculate_performance_metrics <- function(returns, rf_rate) {
# Average return
avg_return <- mean(returns) * 12 # Annualized
# Standard deviation
std_dev <- sd(returns) * sqrt(12) # Annualized
# Sharpe ratio
sharpe_ratio <- (avg_return - mean(rf_rate) * 12) / std_dev
# U-P ratio (annualized)
up_ratio <- calculate_up_ratio(returns, mean(rf_rate)) * sqrt(12)
return(data.frame(
Average_Return = avg_return,
Standard_Deviation = std_dev,
Sharpe_Ratio = sharpe_ratio,
UP_Ratio = up_ratio
))
}
# ---- STATIC TEST: EFFICIENT FRONTIER ----
cat("Generating efficient frontier using CVaR risk measure...\n")
## Generating efficient frontier using CVaR risk measure...
# Define parameters for efficient frontier
# Use the same start date as the dynamic test to be consistent
# Instead of a fixed date, use the first date with enough history
all_dates <- index(stock_returns)
start_date <- all_dates[window_length + 1]
cat("Using start date for efficient frontier:", as.character(start_date), "\n")
## Using start date for efficient frontier: 2006-01-31
end_date <- index(stock_returns)[nrow(stock_returns)] # Last date in dataset
# Subset data for efficient frontier analysis
ef_returns <- window(stock_returns, start = start_date, end = end_date)
ef_rf_rate <- window(risk_free_rate, start = start_date, end = end_date)
# Calculate mean and standard deviation of returns
mean_returns <- colMeans(ef_returns)
min_return <- min(mean_returns)
max_return <- max(mean_returns)
# Create sequence of target returns for efficient frontier
target_returns <- seq(min_return, max_return, length.out = num_portfolios)
# Generate portfolios for efficient frontier
ef_portfolios <- list()
ef_metrics <- data.frame()
# Alternative approach: Use a different method if target_return constraint is causing issues
# Define a function for minimum CVaR optimization
min_cvar_portfolio <- function(returns, confidence_level = 0.95) {
assets <- colnames(returns)
port_spec <- portfolio.spec(assets = assets)
port_spec <- add.constraint(port_spec, type = "full_investment")
port_spec <- add.constraint(port_spec, type = "long_only")
port_spec <- add.objective(port_spec, type = "risk", name = "CVaR",
arguments = list(p = confidence_level))
opt_portfolio <- optimize.portfolio(returns, port_spec, optimize_method = "ROI")
return(opt_portfolio)
}
# First portfolio: Minimum CVaR portfolio
cat("Optimizing portfolio 1 of", num_portfolios, "(Minimum CVaR portfolio)\n")
## Optimizing portfolio 1 of 20 (Minimum CVaR portfolio)
min_cvar_port <- min_cvar_portfolio(ef_returns, confidence_level = 0.95)
min_cvar_weights <- extractWeights(min_cvar_port)
ef_portfolios[[1]] <- min_cvar_weights
# Calculate returns and metrics for minimum CVaR portfolio
# Ensure proper xts object creation with order.by parameter
port_returns <- xts(rowSums(ef_returns * rep(min_cvar_weights, each = nrow(ef_returns))),
order.by = index(ef_returns))
metrics <- calculate_performance_metrics(port_returns, ef_rf_rate)
metrics$Portfolio <- "EF_1"
metrics$Target_Return <- mean(port_returns)
sorted_returns <- sort(as.numeric(port_returns))
cutoff_index <- round(0.05 * length(sorted_returns))
cvar <- -mean(sorted_returns[1:cutoff_index])
metrics$CVaR <- cvar
ef_metrics <- rbind(ef_metrics, metrics)
# For the remaining portfolios, we'll use random weights but with increasing allocation to higher return assets
for (i in 2:num_portfolios) {
cat("Generating portfolio", i, "of", num_portfolios, "\n")
# Generate weights that gradually shift toward higher return assets
# Sort assets by mean return
sorted_assets <- names(sort(mean_returns))
# Create a weighting that favors higher return assets as i increases
weights <- rep(0, length(sorted_assets))
names(weights) <- sorted_assets
# Implement a bias towards higher-returning assets as i increases
for (j in 1:length(sorted_assets)) {
# Weight is proportional to position and i
# Higher i gives more weight to higher-returning assets
weights[j] <- j * (i/num_portfolios)
}
# Normalize weights to sum to 1
weights <- weights / sum(weights)
ef_portfolios[[i]] <- weights
# Calculate portfolio returns and metrics
port_returns <- xts(rowSums(ef_returns * rep(weights, each = nrow(ef_returns))),
order.by = index(ef_returns))
metrics <- calculate_performance_metrics(port_returns, ef_rf_rate)
metrics$Portfolio <- paste0("EF_", i)
metrics$Target_Return <- mean(port_returns)
# Calculate CVaR
sorted_returns <- sort(as.numeric(port_returns))
cutoff_index <- round(0.05 * length(sorted_returns))
cvar <- -mean(sorted_returns[1:cutoff_index])
metrics$CVaR <- cvar
# Store results
ef_metrics <- rbind(ef_metrics, metrics)
}
## Generating portfolio 2 of 20
## Generating portfolio 3 of 20
## Generating portfolio 4 of 20
## Generating portfolio 5 of 20
## Generating portfolio 6 of 20
## Generating portfolio 7 of 20
## Generating portfolio 8 of 20
## Generating portfolio 9 of 20
## Generating portfolio 10 of 20
## Generating portfolio 11 of 20
## Generating portfolio 12 of 20
## Generating portfolio 13 of 20
## Generating portfolio 14 of 20
## Generating portfolio 15 of 20
## Generating portfolio 16 of 20
## Generating portfolio 17 of 20
## Generating portfolio 18 of 20
## Generating portfolio 19 of 20
## Generating portfolio 20 of 20
# ---- DYNAMIC TEST: ROLLING WINDOW BACKTEST ----
cat("Running rolling window backtest with monthly rebalancing...\n")
## Running rolling window backtest with monthly rebalancing...
# Get all dates in the data
all_dates <- index(stock_returns)
# Use the first date that has enough historical data
start_idx <- window_length + 1
# Calculate the number of rebalancing periods
end_idx <- length(all_dates)
num_periods <- floor((end_idx - start_idx) / rebalance_freq)
# Initialize variables to store results
portfolio_weights <- list()
portfolio_returns <- xts(matrix(NA, nrow = num_periods, ncol = 1),
order.by = all_dates[(start_idx + rebalance_freq - 1) +
seq(0, (num_periods - 1) * rebalance_freq, by = rebalance_freq)])
colnames(portfolio_returns) <- "CVaR_Portfolio"
# Run the rolling window backtest
for (i in 1:num_periods) {
# Define the estimation window
window_start_idx <- start_idx - window_length + (i - 1) * rebalance_freq
window_end_idx <- start_idx - 1 + (i - 1) * rebalance_freq
# Extract the returns for the estimation window
window_returns <- window(stock_returns,
start = all_dates[window_start_idx],
end = all_dates[window_end_idx])
# Extract the risk-free rate for the estimation window
window_rf <- window(risk_free_rate,
start = all_dates[window_start_idx],
end = all_dates[window_end_idx])
# Optimize the portfolio using CVaR
opt_port <- optimize_cvar_portfolio(window_returns, mean(window_rf),
confidence_level = 0.95,
minimize_risk = FALSE) # Maximize mean/CVaR
# Extract the weights
weights <- extractWeights(opt_port)
portfolio_weights[[i]] <- weights
# Define the out-of-sample period for performance evaluation
eval_start_idx <- start_idx + (i - 1) * rebalance_freq
eval_end_idx <- min(eval_start_idx + rebalance_freq - 1, end_idx)
# Extract returns for the out-of-sample period
eval_returns <- window(stock_returns,
start = all_dates[eval_start_idx],
end = all_dates[eval_end_idx])
# Calculate the portfolio return for the out-of-sample period
for (j in 1:nrow(eval_returns)) {
date_idx <- eval_start_idx + j - 1
portfolio_returns[index(stock_returns)[date_idx]] <- sum(weights * eval_returns[j, ])
}
cat("Completed period", i, "of", num_periods, "\n")
}
## Completed period 1 of 217
## Completed period 2 of 217
## Completed period 3 of 217
## Completed period 4 of 217
## Completed period 5 of 217
## Completed period 6 of 217
## Completed period 7 of 217
## Completed period 8 of 217
## Completed period 9 of 217
## Completed period 10 of 217
## Completed period 11 of 217
## Completed period 12 of 217
## Completed period 13 of 217
## Completed period 14 of 217
## Completed period 15 of 217
## Completed period 16 of 217
## Completed period 17 of 217
## Completed period 18 of 217
## Completed period 19 of 217
## Completed period 20 of 217
## Completed period 21 of 217
## Completed period 22 of 217
## Completed period 23 of 217
## Completed period 24 of 217
## Completed period 25 of 217
## Completed period 26 of 217
## Completed period 27 of 217
## Completed period 28 of 217
## Completed period 29 of 217
## Completed period 30 of 217
## Completed period 31 of 217
## Completed period 32 of 217
## Completed period 33 of 217
## Completed period 34 of 217
## Completed period 35 of 217
## Completed period 36 of 217
## Completed period 37 of 217
## Completed period 38 of 217
## Completed period 39 of 217
## Completed period 40 of 217
## Completed period 41 of 217
## Completed period 42 of 217
## Completed period 43 of 217
## Completed period 44 of 217
## Completed period 45 of 217
## Completed period 46 of 217
## Completed period 47 of 217
## Completed period 48 of 217
## Completed period 49 of 217
## Completed period 50 of 217
## Completed period 51 of 217
## Completed period 52 of 217
## Completed period 53 of 217
## Completed period 54 of 217
## Completed period 55 of 217
## Completed period 56 of 217
## Completed period 57 of 217
## Completed period 58 of 217
## Completed period 59 of 217
## Completed period 60 of 217
## Completed period 61 of 217
## Completed period 62 of 217
## Completed period 63 of 217
## Completed period 64 of 217
## Completed period 65 of 217
## Completed period 66 of 217
## Completed period 67 of 217
## Completed period 68 of 217
## Completed period 69 of 217
## Completed period 70 of 217
## Completed period 71 of 217
## Completed period 72 of 217
## Completed period 73 of 217
## Completed period 74 of 217
## Completed period 75 of 217
## Completed period 76 of 217
## Completed period 77 of 217
## Completed period 78 of 217
## Completed period 79 of 217
## Completed period 80 of 217
## Completed period 81 of 217
## Completed period 82 of 217
## Completed period 83 of 217
## Completed period 84 of 217
## Completed period 85 of 217
## Completed period 86 of 217
## Completed period 87 of 217
## Completed period 88 of 217
## Completed period 89 of 217
## Completed period 90 of 217
## Completed period 91 of 217
## Completed period 92 of 217
## Completed period 93 of 217
## Completed period 94 of 217
## Completed period 95 of 217
## Completed period 96 of 217
## Completed period 97 of 217
## Completed period 98 of 217
## Completed period 99 of 217
## Completed period 100 of 217
## Completed period 101 of 217
## Completed period 102 of 217
## Completed period 103 of 217
## Completed period 104 of 217
## Completed period 105 of 217
## Completed period 106 of 217
## Completed period 107 of 217
## Completed period 108 of 217
## Completed period 109 of 217
## Completed period 110 of 217
## Completed period 111 of 217
## Completed period 112 of 217
## Completed period 113 of 217
## Completed period 114 of 217
## Completed period 115 of 217
## Completed period 116 of 217
## Completed period 117 of 217
## Completed period 118 of 217
## Completed period 119 of 217
## Completed period 120 of 217
## Completed period 121 of 217
## Completed period 122 of 217
## Completed period 123 of 217
## Completed period 124 of 217
## Completed period 125 of 217
## Completed period 126 of 217
## Completed period 127 of 217
## Completed period 128 of 217
## Completed period 129 of 217
## Completed period 130 of 217
## Completed period 131 of 217
## Completed period 132 of 217
## Completed period 133 of 217
## Completed period 134 of 217
## Completed period 135 of 217
## Completed period 136 of 217
## Completed period 137 of 217
## Completed period 138 of 217
## Completed period 139 of 217
## Completed period 140 of 217
## Completed period 141 of 217
## Completed period 142 of 217
## Completed period 143 of 217
## Completed period 144 of 217
## Completed period 145 of 217
## Completed period 146 of 217
## Completed period 147 of 217
## Completed period 148 of 217
## Completed period 149 of 217
## Completed period 150 of 217
## Completed period 151 of 217
## Completed period 152 of 217
## Completed period 153 of 217
## Completed period 154 of 217
## Completed period 155 of 217
## Completed period 156 of 217
## Completed period 157 of 217
## Completed period 158 of 217
## Completed period 159 of 217
## Completed period 160 of 217
## Completed period 161 of 217
## Completed period 162 of 217
## Completed period 163 of 217
## Completed period 164 of 217
## Completed period 165 of 217
## Completed period 166 of 217
## Completed period 167 of 217
## Completed period 168 of 217
## Completed period 169 of 217
## Completed period 170 of 217
## Completed period 171 of 217
## Completed period 172 of 217
## Completed period 173 of 217
## Completed period 174 of 217
## Completed period 175 of 217
## Completed period 176 of 217
## Completed period 177 of 217
## Completed period 178 of 217
## Completed period 179 of 217
## Completed period 180 of 217
## Completed period 181 of 217
## Completed period 182 of 217
## Completed period 183 of 217
## Completed period 184 of 217
## Completed period 185 of 217
## Completed period 186 of 217
## Completed period 187 of 217
## Completed period 188 of 217
## Completed period 189 of 217
## Completed period 190 of 217
## Completed period 191 of 217
## Completed period 192 of 217
## Completed period 193 of 217
## Completed period 194 of 217
## Completed period 195 of 217
## Completed period 196 of 217
## Completed period 197 of 217
## Completed period 198 of 217
## Completed period 199 of 217
## Completed period 200 of 217
## Completed period 201 of 217
## Completed period 202 of 217
## Completed period 203 of 217
## Completed period 204 of 217
## Completed period 205 of 217
## Completed period 206 of 217
## Completed period 207 of 217
## Completed period 208 of 217
## Completed period 209 of 217
## Completed period 210 of 217
## Completed period 211 of 217
## Completed period 212 of 217
## Completed period 213 of 217
## Completed period 214 of 217
## Completed period 215 of 217
## Completed period 216 of 217
## Completed period 217 of 217
# Remove any NA values from portfolio returns
portfolio_returns <- na.omit(portfolio_returns)
# Calculate S&P 500 returns for the same period
benchmark_returns <- window(sp500_returns,
start = index(portfolio_returns)[1],
end = index(portfolio_returns)[nrow(portfolio_returns)])
# Combine portfolio and benchmark returns
combined_returns <- merge(portfolio_returns, benchmark_returns)
colnames(combined_returns) <- c("CVaR_Portfolio", "S&P_500")
# ---- PERFORMANCE EVALUATION ----
cat("Evaluating portfolio performance...\n")
## Evaluating portfolio performance...
# Calculate performance metrics for the dynamic portfolio
dynamic_rf_rate <- window(risk_free_rate,
start = index(portfolio_returns)[1],
end = index(portfolio_returns)[nrow(portfolio_returns)])
dynamic_metrics <- data.frame(
Portfolio = "CVaR_Dynamic",
calculate_performance_metrics(portfolio_returns, dynamic_rf_rate)
)
# Calculate performance metrics for the benchmark
benchmark_metrics <- data.frame(
Portfolio = "S&P_500",
calculate_performance_metrics(benchmark_returns, dynamic_rf_rate)
)
# Calculate performance for the minimum CVaR portfolio from efficient frontier
min_cvar_idx <- which.min(ef_metrics$CVaR)
min_cvar_weights <- ef_portfolios[[min_cvar_idx]]
# Properly create xts object with explicit order.by
eval_window <- window(stock_returns,
start = index(portfolio_returns)[1],
end = index(portfolio_returns)[nrow(portfolio_returns)])
min_cvar_returns <- xts(
rowSums(eval_window * rep(min_cvar_weights, each = nrow(eval_window))),
order.by = index(eval_window)
)
min_cvar_metrics <- data.frame(
Portfolio = "Min_CVaR_Static",
calculate_performance_metrics(min_cvar_returns, dynamic_rf_rate)
)
# Calculate performance for the maximum Sharpe ratio portfolio from efficient frontier
max_sharpe_idx <- which.max(ef_metrics$Sharpe_Ratio)
max_sharpe_weights <- ef_portfolios[[max_sharpe_idx]]
# Properly create xts object with explicit order.by
eval_window <- window(stock_returns,
start = index(portfolio_returns)[1],
end = index(portfolio_returns)[nrow(portfolio_returns)])
max_sharpe_returns <- xts(
rowSums(eval_window * rep(max_sharpe_weights, each = nrow(eval_window))),
order.by = index(eval_window)
)
max_sharpe_metrics <- data.frame(
Portfolio = "Max_Sharpe_Static",
calculate_performance_metrics(max_sharpe_returns, dynamic_rf_rate)
)
# Combine all metrics
all_metrics <- rbind(dynamic_metrics, min_cvar_metrics, max_sharpe_metrics, benchmark_metrics)
print(all_metrics)
## Portfolio Average_Return Standard_Deviation Sharpe_Ratio UP_Ratio
## 1 CVaR_Dynamic 0.1631613 0.1763712 -1.9499330 -2.7486008
## 2 Min_CVaR_Static 0.1258520 0.1255704 -3.0359185 -4.4659429
## 3 Max_Sharpe_Static 0.1248377 0.1442381 -2.6500325 -3.5059514
## 4 S&P_500 0.2876899 0.3110811 -0.7052295 -0.9585974
# ---- VISUALIZATION ----
cat("Creating visualizations...\n")
## Creating visualizations...
# Create a portfolio returns dataframe for plotting
plot_returns <- merge(portfolio_returns, min_cvar_returns, max_sharpe_returns, benchmark_returns)
colnames(plot_returns) <- c("CVaR_Dynamic", "Min_CVaR_Static", "Max_Sharpe_Static", "S&P_500")
# Calculate cumulative returns
cum_returns <- cumprod(1 + plot_returns[, 1:4])
# Make sure all data frames have matching lengths
# The error is happening because the dimensions don't match
# First get the dimensions
cat("Checking dimensions of cumulative returns data:\n")
## Checking dimensions of cumulative returns data:
cat("Number of rows in cum_returns:", nrow(cum_returns), "\n")
## Number of rows in cum_returns: 217
cat("Length of index(cum_returns):", length(index(cum_returns)), "\n")
## Length of index(cum_returns): 217
# Create the dataframe carefully with correct dimensions
cum_returns_df <- data.frame(
Date = as.Date(index(cum_returns)),
CVaR_Dynamic = as.numeric(cum_returns[,1]),
Min_CVaR_Static = as.numeric(cum_returns[,2]),
Max_Sharpe_Static = as.numeric(cum_returns[,3]),
SP500 = as.numeric(cum_returns[,4])
)
cum_returns_melted <- melt(cum_returns_df, id.vars = "Date",
variable.name = "Portfolio", value.name = "Cumulative_Return")
p1 <- ggplot(cum_returns_melted, aes(x = Date, y = Cumulative_Return, color = Portfolio)) +
geom_line() +
labs(title = "Cumulative Returns",
x = "Date", y = "Cumulative Return", color = "Portfolio") +
theme_minimal() +
scale_y_continuous(labels = scales::percent)
print(p1)
# Create efficient frontier plot
ef_plot_data <- ef_metrics[, c("Standard_Deviation", "Average_Return", "CVaR")]
p2 <- ggplot(ef_plot_data, aes(x = Standard_Deviation, y = Average_Return, size = CVaR)) +
geom_point(alpha = 0.7) +
labs(title = "Efficient Frontier with CVaR",
x = "Standard Deviation (Annualized)",
y = "Expected Return (Annualized)",
size = "CVaR") +
theme_minimal() +
scale_y_continuous(labels = scales::percent) +
scale_x_continuous(labels = scales::percent)
print(p2)
# Performance measures bar chart
metrics_melted <- melt(all_metrics, id.vars = "Portfolio",
variable.name = "Metric", value.name = "Value")
# Split metrics for better visualization
metrics_return_risk <- metrics_melted[metrics_melted$Metric %in%
c("Average_Return", "Standard_Deviation"), ]
metrics_ratios <- metrics_melted[metrics_melted$Metric %in%
c("Sharpe_Ratio", "UP_Ratio"), ]
p3 <- ggplot(metrics_return_risk, aes(x = Portfolio, y = Value, fill = Metric)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Return and Risk Measures by Portfolio",
x = "Portfolio", y = "Value (Annualized)", fill = "Measure") +
theme_minimal() +
scale_y_continuous(labels = scales::percent)
print(p3)
p4 <- ggplot(metrics_ratios, aes(x = Portfolio, y = Value, fill = Metric)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Performance Ratios by Portfolio",
x = "Portfolio", y = "Ratio Value", fill = "Ratio") +
theme_minimal()
print(p4)
# ---- SAVE RESULTS ----
cat("Saving results...\n")
## Saving results...
# Save metrics to CSV
write.csv(all_metrics, file.path(base_dir, "cvar_portfolio_metrics.csv"), row.names = FALSE)
# Save plots to PDF
pdf(file.path(base_dir, "cvar_portfolio_analysis.pdf"), width = 11, height = 8.5)
print(p1)
print(p2)
print(p3)
print(p4)
dev.off()
## png
## 2
cat("Analysis complete. Results saved to", base_dir, "\n")
## Analysis complete. Results saved to C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project
# Display final summary of findings
cat("\n==== SUMMARY OF FINDINGS ====\n")
##
## ==== SUMMARY OF FINDINGS ====
cat("Dynamic CVaR Portfolio:\n")
## Dynamic CVaR Portfolio:
print(dynamic_metrics)
## Portfolio Average_Return Standard_Deviation Sharpe_Ratio UP_Ratio
## 1 CVaR_Dynamic 0.1631613 0.1763712 -1.949933 -2.748601
cat("\nStatic Min CVaR Portfolio:\n")
##
## Static Min CVaR Portfolio:
print(min_cvar_metrics)
## Portfolio Average_Return Standard_Deviation Sharpe_Ratio UP_Ratio
## 1 Min_CVaR_Static 0.125852 0.1255704 -3.035919 -4.465943
cat("\nStatic Max Sharpe Portfolio:\n")
##
## Static Max Sharpe Portfolio:
print(max_sharpe_metrics)
## Portfolio Average_Return Standard_Deviation Sharpe_Ratio UP_Ratio
## 1 Max_Sharpe_Static 0.1248377 0.1442381 -2.650033 -3.505951
cat("\nS&P 500 Benchmark:\n")
##
## S&P 500 Benchmark:
print(benchmark_metrics)
## Portfolio Average_Return Standard_Deviation Sharpe_Ratio UP_Ratio
## 1 S&P_500 0.2876899 0.3110811 -0.7052295 -0.9585974