# Complete Portfolio Construction with Long-Short Beta Strategy and Performance Table
# This script creates a portfolio that:
# 1. Goes LONG in the 10 assets with the LOWEST beta
# 2. Goes SHORT in the 10 assets with the HIGHEST beta
# The portfolio is rebalanced monthly based on rolling 36-month analysis windows
# ---- PACKAGE INSTALLATION AND LOADING ----
# Install and load required packages
if (!require("pacman")) install.packages("pacman")
## Cargando paquete requerido: pacman
pacman::p_load(
tidyverse, # Data manipulation and visualization
quantmod, # Financial data retrieval and analysis
PerformanceAnalytics, # Performance and risk analysis
zoo, # Time series analysis
roll, # Rolling window calculations
xts, # Extensible time series
lubridate, # Date handling
readxl, # Excel file reading
knitr, # For tables
grid, # For graphics
gridExtra # For arranging multiple plots
)
# ---- 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")
# Use forward slashes instead of backslashes
stock_file_path <- file.path(base_dir, "data.xlsx")
market_file_path <- file.path(base_dir, "data2.xlsx")
# Print the paths for verification
cat("Stock file path:", stock_file_path, "\n")
## Stock file path: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/data.xlsx
cat("Market file path:", market_file_path, "\n")
## Market file path: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/data2.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 ----
# Function to import Excel data
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
sp500_prices <- as.numeric(market_data[[2]]) # S&P 500 Price Index
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))
})
}
# ---- ANALYSIS FUNCTIONS ----
# Function to calculate beta
calculate_beta <- function(returns, benchmark_returns) {
# Calculate beta
beta <- cov(returns, benchmark_returns) / var(benchmark_returns)
return(beta)
}
# Function to construct long-short portfolio based on rolling beta
construct_portfolio <- function(asset_returns, benchmark_returns, risk_free_rate,
window_size = 36, top_n = 10) {
dates <- index(asset_returns)
n_periods <- length(dates) - window_size
portfolio_returns <- numeric(n_periods)
selected_long_assets <- list()
selected_short_assets <- list()
all_betas <- list() # Store all betas for each period for analysis
cat("Starting portfolio construction with", n_periods, "rebalancing periods\n")
for (i in 1:n_periods) {
# Define the analysis window
start_idx <- i
end_idx <- i + window_size - 1
window_returns <- asset_returns[start_idx:end_idx, ]
window_benchmark <- benchmark_returns[start_idx:end_idx]
# Calculate beta for each asset
betas <- numeric(ncol(window_returns))
for (j in 1:ncol(window_returns)) {
if (all(!is.na(window_returns[, j]))) {
betas[j] <- calculate_beta(window_returns[, j], window_benchmark)
} else {
betas[j] <- NA
}
}
# Store all betas for this period
asset_names <- colnames(window_returns)
period_betas <- data.frame(
asset = asset_names,
beta = betas
)
all_betas[[i]] <- period_betas
# Select top N assets with lowest beta for LONG positions
beta_df_long <- period_betas %>%
filter(!is.na(beta)) %>% # Remove NA values
arrange(beta) %>% # Sort by beta in ascending order
head(top_n) # Take top N assets with lowest beta
# Select top N assets with highest beta for SHORT positions
beta_df_short <- period_betas %>%
filter(!is.na(beta)) %>% # Remove NA values
arrange(desc(beta)) %>% # Sort by beta in descending order
head(top_n) # Take top N assets with highest beta
# Store selected assets for this period
selected_long_assets[[i]] <- beta_df_long$asset
selected_short_assets[[i]] <- beta_df_short$asset
# Calculate portfolio return for the next month
# For long positions
if (length(beta_df_long$asset) > 0) {
selected_long_idx <- match(beta_df_long$asset, asset_names)
weights_long <- rep(0.5/length(selected_long_idx), length(selected_long_idx)) # Allocate 50% to long
next_month_returns_long <- as.numeric(asset_returns[end_idx + 1, selected_long_idx])
next_month_return_long <- sum(weights_long * next_month_returns_long, na.rm = TRUE)
} else {
next_month_return_long <- 0
}
# For short positions
if (length(beta_df_short$asset) > 0) {
selected_short_idx <- match(beta_df_short$asset, asset_names)
weights_short <- rep(-0.5/length(selected_short_idx), length(selected_short_idx)) # Allocate 50% to short (negative weights)
next_month_returns_short <- as.numeric(asset_returns[end_idx + 1, selected_short_idx])
next_month_return_short <- sum(weights_short * next_month_returns_short, na.rm = TRUE)
} else {
next_month_return_short <- 0
}
# Combine long and short returns
portfolio_returns[i] <- next_month_return_long + next_month_return_short
# Print progress
if (i %% 5 == 0 || i == 1 || i == n_periods) {
cat("Processing period", i, "of", n_periods,
"- Date:", as.character(dates[end_idx + 1]), "\n")
if (length(beta_df_long$asset) > 0) {
cat("LONG assets:", paste(head(beta_df_long$asset, 5), collapse=", "),
ifelse(length(beta_df_long$asset) > 5, "...", ""), "\n")
cat("LONG beta range:", sprintf("%.3f", min(beta_df_long$beta)), "to",
sprintf("%.3f", max(beta_df_long$beta)), "\n")
} else {
cat("No assets for LONG positions found for this period\n")
}
if (length(beta_df_short$asset) > 0) {
cat("SHORT assets:", paste(head(beta_df_short$asset, 5), collapse=", "),
ifelse(length(beta_df_short$asset) > 5, "...", ""), "\n")
cat("SHORT beta range:", sprintf("%.3f", min(beta_df_short$beta)), "to",
sprintf("%.3f", max(beta_df_short$beta)), "\n")
} else {
cat("No assets for SHORT positions found for this period\n")
}
}
}
# Create a time series of portfolio returns
portfolio_returns_ts <- xts(portfolio_returns, order.by = dates[(window_size + 1):length(dates)])
# Save all betas to a file for analysis
all_betas_df <- do.call(rbind, lapply(1:length(all_betas), function(i) {
df <- all_betas[[i]]
df$period <- i
df$date <- as.character(dates[i + window_size])
return(df)
}))
output_file <- file.path(base_dir, "all_asset_betas_long_short.csv")
write.csv(all_betas_df, output_file, row.names = FALSE)
cat("Saved all asset betas to:", output_file, "\n")
return(list(
returns = portfolio_returns_ts,
selected_long_assets = selected_long_assets,
selected_short_assets = selected_short_assets,
all_betas = all_betas
))
}
# ---- PERFORMANCE ANALYSIS FUNCTION ----
# Function to analyze portfolio performance
analyze_portfolio <- function(portfolio_result, risk_free_rate, sp500_returns) {
portfolio_returns <- portfolio_result$returns
# Calculate cumulative returns
cumulative_returns <- cumprod(1 + portfolio_returns) - 1
# Plot results
plot(cumulative_returns, main = "Cumulative Portfolio Returns",
ylab = "Return", xlab = "Date")
# Calculate performance metrics
portfolio_avg_return <- mean(portfolio_returns) * 12 * 100 # Annualized and as percentage
portfolio_sd <- sd(portfolio_returns) * sqrt(12) * 100 # Annualized and as percentage
portfolio_sharpe <- mean(portfolio_returns - risk_free_rate) / sd(portfolio_returns)
# Calculate benchmark metrics for the same period
benchmark_returns <- sp500_returns[(36+1):length(sp500_returns)]
benchmark_avg_return <- mean(benchmark_returns) * 12 * 100 # Annualized and as percentage
benchmark_sd <- sd(benchmark_returns) * sqrt(12) * 100 # Annualized and as percentage
benchmark_sharpe <- mean(benchmark_returns - risk_free_rate) / sd(benchmark_returns)
# Calculate Upside-Potential Ratio for both
target_return <- mean(risk_free_rate)
portfolio_upside <- mean(pmax(portfolio_returns - target_return, 0)) /
sqrt(mean((portfolio_returns - mean(portfolio_returns))^2))
benchmark_upside <- mean(pmax(benchmark_returns - target_return, 0)) /
sqrt(mean((benchmark_returns - mean(benchmark_returns))^2))
# Create performance comparison table
performance_table <- data.frame(
Metric = c("Average Return", "Standard Deviation", "Sharpe Ratio", "Upside-Potential Ratio"),
Portfolio = c(sprintf("%.2f%%", portfolio_avg_return),
sprintf("%.2f%%", portfolio_sd),
sprintf("%.3f", portfolio_sharpe),
sprintf("%.3f", portfolio_upside)),
Benchmark = c(sprintf("%.2f%%", benchmark_avg_return),
sprintf("%.2f%%", benchmark_sd),
sprintf("%.3f", benchmark_sharpe),
sprintf("%.3f", benchmark_upside))
)
cat("\n----- Portfolio Performance Metrics -----\n")
print(performance_table)
# Save the performance table
output_file <- file.path(base_dir, "performance_comparison_long_short.csv")
write.csv(performance_table, output_file, row.names = FALSE)
cat("Saved performance comparison to:", output_file, "\n")
# Create data frames of portfolio composition over time for long and short positions
composition_long <- data.frame(
Date = index(portfolio_returns),
stringsAsFactors = FALSE
)
composition_short <- data.frame(
Date = index(portfolio_returns),
stringsAsFactors = FALSE
)
for (i in 1:length(portfolio_result$selected_long_assets)) {
long_assets <- portfolio_result$selected_long_assets[[i]]
short_assets <- portfolio_result$selected_short_assets[[i]]
composition_long[i, "Assets"] <- paste(long_assets, collapse = ", ")
composition_short[i, "Assets"] <- paste(short_assets, collapse = ", ")
}
# Save portfolio compositions to CSV
output_file_long <- file.path(base_dir, "portfolio_composition_long.csv")
write.csv(composition_long, output_file_long, row.names = FALSE)
cat("Saved long portfolio composition to:", output_file_long, "\n")
output_file_short <- file.path(base_dir, "portfolio_composition_short.csv")
write.csv(composition_short, output_file_short, row.names = FALSE)
cat("Saved short portfolio composition to:", output_file_short, "\n")
# Save portfolio returns to CSV
returns_df <- data.frame(
Date = index(portfolio_returns),
Return = as.numeric(portfolio_returns)
)
output_file <- file.path(base_dir, "portfolio_returns_long_short.csv")
write.csv(returns_df, output_file, row.names = FALSE)
cat("Saved portfolio returns to:", output_file, "\n")
# Count frequency of asset selection for long positions
all_selected_long <- unlist(portfolio_result$selected_long_assets)
selection_freq_long <- sort(table(all_selected_long), decreasing = TRUE)
cat("\n----- Most Frequently Selected LONG Assets -----\n")
print(head(selection_freq_long, 10))
# Count frequency of asset selection for short positions
all_selected_short <- unlist(portfolio_result$selected_short_assets)
selection_freq_short <- sort(table(all_selected_short), decreasing = TRUE)
cat("\n----- Most Frequently Selected SHORT Assets -----\n")
print(head(selection_freq_short, 10))
# Save selection frequency to CSV for long positions
selection_freq_long_df <- data.frame(
Asset = names(selection_freq_long),
Frequency = as.numeric(selection_freq_long),
Percentage = as.numeric(selection_freq_long) / length(portfolio_result$selected_long_assets) * 100
)
output_file <- file.path(base_dir, "asset_selection_frequency_long.csv")
write.csv(selection_freq_long_df, output_file, row.names = FALSE)
cat("Saved long asset selection frequency to:", output_file, "\n")
# Save selection frequency to CSV for short positions
selection_freq_short_df <- data.frame(
Asset = names(selection_freq_short),
Frequency = as.numeric(selection_freq_short),
Percentage = as.numeric(selection_freq_short) / length(portfolio_result$selected_short_assets) * 100
)
output_file <- file.path(base_dir, "asset_selection_frequency_short.csv")
write.csv(selection_freq_short_df, output_file, row.names = FALSE)
cat("Saved short asset selection frequency to:", output_file, "\n")
# Create a nice performance comparison table for display
create_performance_table <- function() {
# Use actual calculated metrics instead of hardcoded values
metrics_table <- data.frame(
Metric = c("Average Return", "Standard Deviation", "Sharpe Ratio", "Upside-Potential Ratio"),
Portfolio = c(sprintf("%.2f%%", portfolio_avg_return),
sprintf("%.2f%%", portfolio_sd),
sprintf("%.3f", portfolio_sharpe),
sprintf("%.3f", portfolio_upside)),
Benchmark = c(sprintf("%.2f%%", benchmark_avg_return),
sprintf("%.2f%%", benchmark_sd),
sprintf("%.3f", benchmark_sharpe),
sprintf("%.3f", benchmark_upside))
)
colnames(metrics_table) <- c("Metric", "Long-Short\nBeta Portfolio", "S&P 500 Benchmark")
# Create a nice table with the metrics
grid.newpage()
grid.table(metrics_table, rows = NULL)
# Save the table as an image
output_file <- file.path(base_dir, "performance_table_long_short.png")
png(output_file, width = 800, height = 400)
grid.table(metrics_table, rows = NULL)
dev.off()
cat("Saved performance table image to:", output_file, "\n")
}
# Create the table
create_performance_table()
# Calculate and display portfolio beta
portfolio_beta <- calculate_portfolio_beta(portfolio_result, sp500_returns)
cat("\n----- Portfolio Beta Analysis -----\n")
cat("Overall Portfolio Beta:", sprintf("%.4f", portfolio_beta), "\n")
return(list(
cumulative_returns = cumulative_returns,
performance_table = performance_table,
composition_long = composition_long,
composition_short = composition_short,
selection_frequency_long = selection_freq_long_df,
selection_frequency_short = selection_freq_short_df,
portfolio_beta = portfolio_beta
))
}
# Function to calculate the portfolio's overall beta
calculate_portfolio_beta <- function(portfolio_result, sp500_returns) {
# Get the portfolio returns
portfolio_returns <- portfolio_result$returns
# Get the benchmark returns for the same period
benchmark_returns <- sp500_returns[(36+1):length(sp500_returns)]
# Calculate the portfolio's beta
portfolio_beta <- cov(portfolio_returns, benchmark_returns) / var(benchmark_returns)
return(portfolio_beta)
}
# ---- MAIN EXECUTION ----
# Run the complete analysis
run_analysis <- function() {
# Start timer
start_time <- Sys.time()
cat("Starting analysis at", as.character(start_time), "\n")
# Import data
cat("Importing data from Excel files...\n")
data <- import_excel_data(stock_file_path, market_file_path)
# Basic data exploration
cat("\nData summary:\n")
cat("- Number of stocks:", ncol(data$stock_returns), "\n")
cat("- Date range:", as.character(first(index(data$stock_returns))),
"to", as.character(last(index(data$stock_returns))), "\n")
cat("- Number of observations:", nrow(data$stock_returns), "\n\n")
# Run the portfolio construction
cat("Constructing long-short portfolio...\n")
portfolio_result <- construct_portfolio(
asset_returns = data$stock_returns,
benchmark_returns = data$sp500_returns,
risk_free_rate = data$risk_free_rate,
window_size = 36, # 3 years of monthly data
top_n = 10 # Top 10 assets with lowest/highest beta
)
# Analyze performance
cat("\nAnalyzing portfolio performance...\n")
analysis <- analyze_portfolio(
portfolio_result = portfolio_result,
risk_free_rate = data$risk_free_rate,
sp500_returns = data$sp500_returns
)
# End timer
end_time <- Sys.time()
cat("\nAnalysis completed in", round(difftime(end_time, start_time, units = "mins"), 2), "minutes\n")
# Return results
return(list(
portfolio = portfolio_result,
analysis = analysis,
data = data
))
}
# Execute the analysis and store the results
result <- run_analysis()
## Starting analysis at 2025-05-04 10:00:13.536449
## Importing data from Excel files...
## 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/data2.xlsx
## New names:
## • `` -> `...1`
##
## Data summary:
## - Number of stocks: 50
## - Date range: 2005-01-31 to 2024-02-29
## - Number of observations: 230
##
## Constructing long-short portfolio...
## Starting portfolio construction with 194 rebalancing periods
## Processing period 1 of 194 - Date: 2008-01-31
## LONG assets: ABBOTT LABORATORIES, UNITEDHEALTH GROUP, PEPSICO, MEDTRONIC, WALMART ...
## LONG beta range: -0.133 to 0.543
## SHORT assets: SALESFORCE, AMAZON.COM, NVIDIA, ADOBE (NAS), APPLE ...
## SHORT beta range: 1.637 to 4.136
## Processing period 5 of 194 - Date: 2008-05-30
## LONG assets: ABBOTT LABORATORIES, WALMART, PEPSICO, MEDTRONIC, BANK OF AMERICA ...
## LONG beta range: -0.098 to 0.519
## SHORT assets: SALESFORCE, AMAZON.COM, APPLE, NVIDIA, ALPHABET A ...
## SHORT beta range: 1.543 to 3.224
## Processing period 10 of 194 - Date: 2008-10-31
## LONG assets: WELLS FARGO & CO, WALMART, ABBOTT LABORATORIES, PEPSICO, MEDTRONIC ...
## LONG beta range: -0.135 to 0.428
## SHORT assets: APPLE, NVIDIA, AMAZON.COM, SALESFORCE, ALPHABET A ...
## SHORT beta range: 1.377 to 2.918
## Processing period 15 of 194 - Date: 2009-03-31
## LONG assets: WALMART, AMGEN, ABBOTT LABORATORIES, HOME DEPOT, EXXON MOBIL ...
## LONG beta range: 0.263 to 0.670
## SHORT assets: CITIGROUP, BANK OF AMERICA, SALESFORCE, ADOBE (NAS), NVIDIA ...
## SHORT beta range: 1.186 to 2.422
## Processing period 20 of 194 - Date: 2009-08-31
## LONG assets: ABBOTT LABORATORIES, WALMART, EXXON MOBIL, AMGEN, GILEAD SCIENCES ...
## LONG beta range: 0.195 to 0.609
## SHORT assets: CITIGROUP, BANK OF AMERICA, ADOBE (NAS), SALESFORCE, APPLE ...
## SHORT beta range: 1.232 to 2.872
## Processing period 25 of 194 - Date: 2010-01-29
## LONG assets: WALMART, ABBOTT LABORATORIES, EXXON MOBIL, AMGEN, GILEAD SCIENCES ...
## LONG beta range: 0.258 to 0.590
## SHORT assets: CITIGROUP, BANK OF AMERICA, SALESFORCE, ADOBE (NAS), NVIDIA ...
## SHORT beta range: 1.172 to 2.917
## Processing period 30 of 194 - Date: 2010-06-30
## LONG assets: ABBOTT LABORATORIES, WALMART, GILEAD SCIENCES, EXXON MOBIL, AMGEN ...
## LONG beta range: 0.260 to 0.591
## SHORT assets: CITIGROUP, BANK OF AMERICA, SALESFORCE, ADOBE (NAS), NVIDIA ...
## SHORT beta range: 1.222 to 2.846
## Processing period 35 of 194 - Date: 2010-11-30
## LONG assets: ABBOTT LABORATORIES, WALMART, GILEAD SCIENCES, EXXON MOBIL, AMGEN ...
## LONG beta range: 0.265 to 0.573
## SHORT assets: CITIGROUP, BANK OF AMERICA, NVIDIA, ADOBE (NAS), WELLS FARGO & CO ...
## SHORT beta range: 1.183 to 2.667
## Processing period 40 of 194 - Date: 2011-04-29
## LONG assets: ABBOTT LABORATORIES, WALMART, NETFLIX, GILEAD SCIENCES, MCDONALDS ...
## LONG beta range: 0.292 to 0.517
## SHORT assets: CITIGROUP, BANK OF AMERICA, NVIDIA, WELLS FARGO & CO, ADOBE (NAS) ...
## SHORT beta range: 1.185 to 2.644
## Processing period 45 of 194 - Date: 2011-09-30
## LONG assets: ABBOTT LABORATORIES, MCDONALDS, WALMART, GILEAD SCIENCES, NETFLIX ...
## LONG beta range: 0.283 to 0.515
## SHORT assets: CITIGROUP, BANK OF AMERICA, ADOBE (NAS), WELLS FARGO & CO, NVIDIA ...
## SHORT beta range: 1.141 to 2.649
## Processing period 50 of 194 - Date: 2012-02-29
## LONG assets: MCDONALDS, AMERICAN TOWER, WALMART, PEPSICO, ABBOTT LABORATORIES ...
## LONG beta range: 0.305 to 0.450
## SHORT assets: CITIGROUP, BANK OF AMERICA, WELLS FARGO & CO, ADOBE (NAS), JP MORGAN CHASE & CO. ...
## SHORT beta range: 1.211 to 2.855
## Processing period 55 of 194 - Date: 2012-07-31
## LONG assets: MCDONALDS, BRISTOL MYERS SQUIBB, AMERICAN TOWER, PROCTER & GAMBLE, PEPSICO ...
## LONG beta range: 0.244 to 0.421
## SHORT assets: CITIGROUP, NVIDIA, BANK OF AMERICA, JP MORGAN CHASE & CO., CISCO SYSTEMS ...
## SHORT beta range: 1.235 to 1.978
## Processing period 60 of 194 - Date: 2012-12-31
## LONG assets: BRISTOL MYERS SQUIBB, AMERICAN TOWER, PROCTER & GAMBLE, MERCK & COMPANY, MCDONALDS ...
## LONG beta range: 0.104 to 0.386
## SHORT assets: CITIGROUP, NVIDIA, BANK OF AMERICA, JP MORGAN CHASE & CO., ORACLE ...
## SHORT beta range: 1.221 to 1.854
## Processing period 65 of 194 - Date: 2013-05-31
## LONG assets: BRISTOL MYERS SQUIBB, AMERICAN TOWER, PROCTER & GAMBLE, MCDONALDS, PEPSICO ...
## LONG beta range: 0.124 to 0.394
## SHORT assets: CITIGROUP, BANK OF AMERICA, NVIDIA, JP MORGAN CHASE & CO., ORACLE ...
## SHORT beta range: 1.191 to 1.860
## Processing period 70 of 194 - Date: 2013-10-31
## LONG assets: VERIZON COMMUNICATIONS, AMERICAN TOWER, BRISTOL MYERS SQUIBB, COCA COLA, WALMART ...
## LONG beta range: 0.100 to 0.373
## SHORT assets: CITIGROUP, BANK OF AMERICA, JP MORGAN CHASE & CO., NETFLIX, NVIDIA ...
## SHORT beta range: 1.303 to 2.325
## Processing period 75 of 194 - Date: 2014-03-31
## LONG assets: VERIZON COMMUNICATIONS, AMERICAN TOWER, AT&T, NEXTERA ENERGY, ELI LILLY ...
## LONG beta range: 0.019 to 0.379
## SHORT assets: CITIGROUP, NETFLIX, BANK OF AMERICA, JP MORGAN CHASE & CO., ADOBE (NAS) ...
## SHORT beta range: 1.264 to 2.278
## Processing period 80 of 194 - Date: 2014-08-29
## LONG assets: VERIZON COMMUNICATIONS, AMERICAN TOWER, AT&T, AMGEN, PEPSICO ...
## LONG beta range: -0.024 to 0.346
## SHORT assets: NETFLIX, CITIGROUP, BANK OF AMERICA, JP MORGAN CHASE & CO., SALESFORCE ...
## SHORT beta range: 1.198 to 2.261
## Processing period 85 of 194 - Date: 2015-01-30
## LONG assets: VERIZON COMMUNICATIONS, AT&T, WALMART, UNION PACIFIC, AMERICAN TOWER ...
## LONG beta range: 0.113 to 0.501
## SHORT assets: NETFLIX, JP MORGAN CHASE & CO., CITIGROUP, AMAZON.COM, LOWE'S COMPANIES ...
## SHORT beta range: 1.318 to 2.774
## Processing period 90 of 194 - Date: 2015-06-30
## LONG assets: NEXTERA ENERGY, ELI LILLY, MERCK & COMPANY, NIKE 'B', AMERICAN TOWER ...
## LONG beta range: 0.380 to 0.652
## SHORT assets: NVIDIA, WALT DISNEY, AMAZON.COM, MEDTRONIC, CITIGROUP ...
## SHORT beta range: 1.245 to 1.541
## Processing period 95 of 194 - Date: 2015-11-30
## LONG assets: ELI LILLY, AT&T, WALMART, NIKE 'B', NEXTERA ENERGY ...
## LONG beta range: 0.187 to 0.744
## SHORT assets: AMAZON.COM, WALT DISNEY, CITIGROUP, MEDTRONIC, ABBOTT LABORATORIES ...
## SHORT beta range: 1.166 to 1.491
## Processing period 100 of 194 - Date: 2016-04-29
## LONG assets: ELI LILLY, WALMART, AT&T, NEXTERA ENERGY, VERIZON COMMUNICATIONS ...
## LONG beta range: 0.183 to 0.645
## SHORT assets: AMAZON.COM, CITIGROUP, ABBOTT LABORATORIES, WALT DISNEY, APPLE ...
## SHORT beta range: 1.242 to 1.626
## Processing period 105 of 194 - Date: 2016-09-30
## LONG assets: ELI LILLY, WALMART, NEXTERA ENERGY, AT&T, VERIZON COMMUNICATIONS ...
## LONG beta range: 0.071 to 0.632
## SHORT assets: AMAZON.COM, ABBOTT LABORATORIES, APPLE, SALESFORCE, CITIGROUP ...
## SHORT beta range: 1.278 to 1.644
## Processing period 110 of 194 - Date: 2017-02-28
## LONG assets: WALMART, ELI LILLY, NEXTERA ENERGY, AT&T, NIKE 'B' ...
## LONG beta range: -0.025 to 0.621
## SHORT assets: NVIDIA, AMGEN, SALESFORCE, ABBOTT LABORATORIES, CITIGROUP ...
## SHORT beta range: 1.348 to 1.715
## Processing period 115 of 194 - Date: 2017-07-31
## LONG assets: WALMART, ELI LILLY, NEXTERA ENERGY, NIKE 'B', AT&T ...
## LONG beta range: 0.071 to 0.631
## SHORT assets: AMGEN, SALESFORCE, BANK OF AMERICA, NVIDIA, CITIGROUP ...
## SHORT beta range: 1.380 to 1.746
## Processing period 120 of 194 - Date: 2017-12-29
## LONG assets: ELI LILLY, WALMART, NEXTERA ENERGY, PROCTER & GAMBLE, AT&T ...
## LONG beta range: 0.108 to 0.618
## SHORT assets: BANK OF AMERICA, AMGEN, CITIGROUP, ABBOTT LABORATORIES, SALESFORCE ...
## SHORT beta range: 1.347 to 1.746
## Processing period 125 of 194 - Date: 2018-05-31
## LONG assets: ELI LILLY, NEXTERA ENERGY, AT&T, PROCTER & GAMBLE, WALMART ...
## LONG beta range: 0.245 to 0.654
## SHORT assets: AMGEN, AMAZON.COM, ABBOTT LABORATORIES, BANK OF AMERICA, NVIDIA ...
## SHORT beta range: 1.335 to 1.709
## Processing period 130 of 194 - Date: 2018-10-31
## LONG assets: NEXTERA ENERGY, WALMART, PROCTER & GAMBLE, AT&T, ELI LILLY ...
## LONG beta range: -0.029 to 0.674
## SHORT assets: NVIDIA, AMAZON.COM, LOWE'S COMPANIES, BANK OF AMERICA, ABBOTT LABORATORIES ...
## SHORT beta range: 1.417 to 2.055
## Processing period 135 of 194 - Date: 2019-03-29
## LONG assets: NEXTERA ENERGY, PROCTER & GAMBLE, AMERICAN TOWER, COCA COLA, MCDONALDS ...
## LONG beta range: 0.201 to 0.495
## SHORT assets: NVIDIA, INTERNATIONAL BUS.MCHS., CITIGROUP, AMAZON.COM, NETFLIX ...
## SHORT beta range: 1.274 to 2.287
## Processing period 140 of 194 - Date: 2019-08-30
## LONG assets: AMERICAN TOWER, NEXTERA ENERGY, ELI LILLY, COCA COLA, PROCTER & GAMBLE ...
## LONG beta range: 0.054 to 0.520
## SHORT assets: NVIDIA, CITIGROUP, AMAZON.COM, BANK OF AMERICA, INTERNATIONAL BUS.MCHS. ...
## SHORT beta range: 1.196 to 2.439
## Processing period 145 of 194 - Date: 2020-01-31
## LONG assets: AMERICAN TOWER, NEXTERA ENERGY, MCDONALDS, ELI LILLY, MERCK & COMPANY ...
## LONG beta range: 0.066 to 0.427
## SHORT assets: NVIDIA, CITIGROUP, NETFLIX, AMAZON.COM, BANK OF AMERICA ...
## SHORT beta range: 1.189 to 2.402
## Processing period 150 of 194 - Date: 2020-06-30
## LONG assets: NEXTERA ENERGY, ELI LILLY, AMERICAN TOWER, MERCK & COMPANY, PROCTER & GAMBLE ...
## LONG beta range: 0.219 to 0.583
## SHORT assets: CITIGROUP, BANK OF AMERICA, EXXON MOBIL, LOWE'S COMPANIES, NVIDIA ...
## SHORT beta range: 1.187 to 1.880
## Processing period 155 of 194 - Date: 2020-11-30
## LONG assets: ELI LILLY, NEXTERA ENERGY, AMERICAN TOWER, MERCK & COMPANY, VERIZON COMMUNICATIONS ...
## LONG beta range: 0.216 to 0.588
## SHORT assets: CITIGROUP, LOWE'S COMPANIES, NVIDIA, BANK OF AMERICA, EXXON MOBIL ...
## SHORT beta range: 1.186 to 1.791
## Processing period 160 of 194 - Date: 2021-04-30
## LONG assets: NEXTERA ENERGY, AMERICAN TOWER, ELI LILLY, GILEAD SCIENCES, WALMART ...
## LONG beta range: 0.198 to 0.584
## SHORT assets: CITIGROUP, BANK OF AMERICA, EXXON MOBIL, CHEVRON, APPLE ...
## SHORT beta range: 1.223 to 2.024
## Processing period 165 of 194 - Date: 2021-09-30
## LONG assets: ELI LILLY, NEXTERA ENERGY, AMERICAN TOWER, GILEAD SCIENCES, WALMART ...
## LONG beta range: 0.181 to 0.570
## SHORT assets: CITIGROUP, BANK OF AMERICA, EXXON MOBIL, CHEVRON, WELLS FARGO & CO ...
## SHORT beta range: 1.218 to 1.970
## Processing period 170 of 194 - Date: 2022-02-28
## LONG assets: GILEAD SCIENCES, ELI LILLY, VERIZON COMMUNICATIONS, NEXTERA ENERGY, AMERICAN TOWER ...
## LONG beta range: 0.038 to 0.565
## SHORT assets: CITIGROUP, WALT DISNEY, BANK OF AMERICA, LOWE'S COMPANIES, CHEVRON ...
## SHORT beta range: 1.189 to 1.651
## Processing period 175 of 194 - Date: 2022-07-29
## LONG assets: GILEAD SCIENCES, VERIZON COMMUNICATIONS, MERCK & COMPANY, PROCTER & GAMBLE, ELI LILLY ...
## LONG beta range: 0.049 to 0.529
## SHORT assets: CITIGROUP, WALT DISNEY, BANK OF AMERICA, ACCENTURE CLASS A, NVIDIA ...
## SHORT beta range: 1.160 to 1.500
## Processing period 180 of 194 - Date: 2022-12-30
## LONG assets: GILEAD SCIENCES, VERIZON COMMUNICATIONS, BRISTOL MYERS SQUIBB, ELI LILLY, MERCK & COMPANY ...
## LONG beta range: 0.193 to 0.589
## SHORT assets: NVIDIA, CITIGROUP, WALT DISNEY, BANK OF AMERICA, CHEVRON ...
## SHORT beta range: 1.150 to 1.501
## Processing period 185 of 194 - Date: 2023-05-31
## LONG assets: BRISTOL MYERS SQUIBB, LOCKHEED MARTIN, GILEAD SCIENCES, JOHNSON & JOHNSON, VERIZON COMMUNICATIONS ...
## LONG beta range: 0.312 to 0.481
## SHORT assets: NVIDIA, NETFLIX, ADOBE (NAS), WALT DISNEY, SALESFORCE ...
## SHORT beta range: 1.244 to 2.187
## Processing period 190 of 194 - Date: 2023-10-31
## LONG assets: BRISTOL MYERS SQUIBB, VERIZON COMMUNICATIONS, LOCKHEED MARTIN, JOHNSON & JOHNSON, PROCTER & GAMBLE ...
## LONG beta range: 0.306 to 0.536
## SHORT assets: NVIDIA, NETFLIX, ADOBE (NAS), WALT DISNEY, NIKE 'B' ...
## SHORT beta range: 1.265 to 2.103
## Processing period 194 of 194 - Date: 2024-02-29
## LONG assets: BRISTOL MYERS SQUIBB, LOCKHEED MARTIN, MERCK & COMPANY, VERIZON COMMUNICATIONS, JOHNSON & JOHNSON ...
## LONG beta range: 0.243 to 0.450
## SHORT assets: NVIDIA, NETFLIX, ADOBE (NAS), SALESFORCE, ORACLE ...
## SHORT beta range: 1.251 to 2.273
## Saved all asset betas to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/all_asset_betas_long_short.csv
##
## Analyzing portfolio performance...
##
## ----- Portfolio Performance Metrics -----
## Metric Portfolio Benchmark
## 1 Average Return -5.09% 9.04%
## 2 Standard Deviation 9.55% 16.18%
## 3 Sharpe Ratio -0.183 0.144
## 4 Upside-Potential Ratio 0.280 0.460
## Saved performance comparison to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/performance_comparison_long_short.csv
## Saved long portfolio composition to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/portfolio_composition_long.csv
## Saved short portfolio composition to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/portfolio_composition_short.csv
## Saved portfolio returns to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/portfolio_returns_long_short.csv
##
## ----- Most Frequently Selected LONG Assets -----
## all_selected_long
## PROCTER & GAMBLE WALMART ELI LILLY
## 157 153 140
## VERIZON COMMUNICATIONS NEXTERA ENERGY PEPSICO
## 136 120 96
## AT&T BRISTOL MYERS SQUIBB AMERICAN TOWER
## 95 93 92
## MCDONALDS
## 90
##
## ----- Most Frequently Selected SHORT Assets -----
## all_selected_short
## CITIGROUP NVIDIA BANK OF AMERICA SALESFORCE
## 185 175 160 115
## AMAZON.COM ADOBE (NAS) APPLE WALT DISNEY
## 108 104 102 94
## CISCO SYSTEMS WELLS FARGO & CO
## 83 73
## Saved long asset selection frequency to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/asset_selection_frequency_long.csv
## Saved short asset selection frequency to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/asset_selection_frequency_short.csv
## Saved performance table image to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/performance_table_long_short.png
##
## ----- Portfolio Beta Analysis -----
## Overall Portfolio Beta: -0.3385
##
## Analysis completed in 0.04 minutes
# ---- ADDITIONAL ANALYSIS ----
# 1. Plot the portfolio returns alongside the benchmark
portfolio_vs_benchmark <- merge(
Portfolio = cumprod(1 + result$portfolio$returns) - 1,
Benchmark = cumprod(1 + result$data$sp500_returns[(36+1):length(result$data$sp500_returns)]) - 1
)
# Create a plot with different colors and a legend
plot(portfolio_vs_benchmark,
main = "Long-Short Beta Portfolio vs. S&P 500",
col = c("blue", "red"),
lwd = c(2, 2),
legend.loc = "topleft")
# Save the plot
output_file <- file.path(base_dir, "portfolio_vs_benchmark_long_short.png")
png(output_file, width = 800, height = 500)
plot(portfolio_vs_benchmark,
main = "Long-Short Beta Portfolio vs. S&P 500",
col = c("blue", "red"),
lwd = c(2, 2),
legend.loc = "topleft")
dev.off()
## png
## 2
cat("Saved portfolio vs benchmark plot to:", output_file, "\n")
## Saved portfolio vs benchmark plot to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/portfolio_vs_benchmark_long_short.png
# 2. Calculate annual returns
annual_returns <- apply.yearly(result$portfolio$returns, Return.cumulative)
print(annual_returns)
## [,1]
## 2008-12-31 0.171981189
## 2009-12-31 -0.282649771
## 2010-12-31 -0.013902688
## 2011-12-30 0.087956012
## 2012-12-31 -0.073847566
## 2013-12-31 -0.070959633
## 2014-12-31 -0.043732111
## 2015-12-31 -0.084315093
## 2016-12-30 -0.008541285
## 2017-12-29 -0.085320116
## 2018-12-31 0.010963575
## 2019-12-31 -0.071924236
## 2020-12-31 -0.062758039
## 2021-12-31 -0.096352626
## 2022-12-30 0.095319893
## 2023-12-29 -0.202694333
## 2024-02-29 -0.048855234
# 3. Monthly returns statistics
monthly_stats <- data.frame(
Statistic = c("Min", "1st Quartile", "Median", "Mean", "3rd Quartile", "Max", "Standard Deviation"),
Value = c(
min(result$portfolio$returns),
quantile(result$portfolio$returns, 0.25),
median(result$portfolio$returns),
mean(result$portfolio$returns),
quantile(result$portfolio$returns, 0.75),
max(result$portfolio$returns),
sd(result$portfolio$returns)
)
)
# Print monthly statistics
cat("\n----- Monthly Return Statistics -----\n")
##
## ----- Monthly Return Statistics -----
print(monthly_stats)
## Statistic Value
## 1 Min -0.111084887
## 2 1st Quartile -0.018743299
## 3 Median -0.002092285
## 4 Mean -0.004242236
## 5 3rd Quartile 0.010741258
## 6 Max 0.058715803
## 7 Standard Deviation 0.027575658
# Save statistics to CSV
output_file <- file.path(base_dir, "monthly_statistics_long_short.csv")
write.csv(monthly_stats, output_file, row.names = FALSE)
cat("Saved monthly return statistics to:", output_file, "\n")
## Saved monthly return statistics to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/monthly_statistics_long_short.csv
# 4. Analyze market exposure and neutrality
cat("\n----- Market Exposure Analysis -----\n")
##
## ----- Market Exposure Analysis -----
cat("Portfolio Beta (Market Exposure):", sprintf("%.4f", result$analysis$portfolio_beta), "\n")
## Portfolio Beta (Market Exposure): -0.3385
if (abs(result$analysis$portfolio_beta) < 0.2) {
cat("The portfolio has relatively low market exposure (close to market-neutral)\n")
} else if (result$analysis$portfolio_beta > 0) {
cat("The portfolio has positive market exposure (tends to move with the market)\n")
} else {
cat("The portfolio has negative market exposure (tends to move against the market)\n")
}
## The portfolio has negative market exposure (tends to move against the market)
# 5. Calculate correlation with the benchmark
correlation <- cor(result$portfolio$returns, result$data$sp500_returns[(36+1):length(result$data$sp500_returns)])
cat("Correlation with S&P 500:", sprintf("%.4f", correlation), "\n")
## Correlation with S&P 500: -0.5732
# 6. Calculate average betas for long and short positions
average_long_betas <- numeric(length(result$portfolio$selected_long_assets))
average_short_betas <- numeric(length(result$portfolio$selected_short_assets))
for (i in 1:length(result$portfolio$selected_long_assets)) {
# Long positions
long_assets <- result$portfolio$selected_long_assets[[i]]
long_betas <- result$portfolio$all_betas[[i]]$beta[match(long_assets, result$portfolio$all_betas[[i]]$asset)]
average_long_betas[i] <- mean(long_betas)
# Short positions
short_assets <- result$portfolio$selected_short_assets[[i]]
short_betas <- result$portfolio$all_betas[[i]]$beta[match(short_assets, result$portfolio$all_betas[[i]]$asset)]
average_short_betas[i] <- mean(short_betas)
}
average_long_beta <- mean(average_long_betas)
average_short_beta <- mean(average_short_betas)
cat("\n----- Beta Analysis of Portfolio Components -----\n")
##
## ----- Beta Analysis of Portfolio Components -----
cat("Average Beta of LONG positions:", sprintf("%.4f", average_long_beta), "\n")
## Average Beta of LONG positions: 0.3852
cat("Average Beta of SHORT positions:", sprintf("%.4f", average_short_beta), "\n")
## Average Beta of SHORT positions: 1.5614
cat("Beta Spread (SHORT - LONG):", sprintf("%.4f", average_short_beta - average_long_beta), "\n")
## Beta Spread (SHORT - LONG): 1.1762
# Save all output files in one directory for easy access
save(result, file = file.path(base_dir, "long_short_beta_portfolio_results.RData"))
cat("All analysis results saved to:", file.path(base_dir, "long_short_beta_portfolio_results.RData"), "\n")
## All analysis results saved to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/long_short_beta_portfolio_results.RData
# Display a final message with key findings
cat("\n===== PORTFOLIO ANALYSIS SUMMARY =====\n")
##
## ===== PORTFOLIO ANALYSIS SUMMARY =====
cat("Portfolio Strategy: Long-Short Beta Strategy\n")
## Portfolio Strategy: Long-Short Beta Strategy
cat("- LONG: Equally weighted in the 10 assets with lowest beta\n")
## - LONG: Equally weighted in the 10 assets with lowest beta
cat("- SHORT: Equally weighted in the 10 assets with highest beta\n")
## - SHORT: Equally weighted in the 10 assets with highest beta
cat("Rebalancing: Monthly, based on rolling 36-month analysis windows\n\n")
## Rebalancing: Monthly, based on rolling 36-month analysis windows
cat("Key Performance Metrics:\n")
## Key Performance Metrics:
cat("- Portfolio Average Return: ", sprintf("%.2f%%", mean(result$portfolio$returns) * 12 * 100),
" vs. S&P 500: ", sprintf("%.2f%%", mean(result$data$sp500_returns[(36+1):length(result$data$sp500_returns)]) * 12 * 100), "\n", sep="")
## - Portfolio Average Return: -5.09% vs. S&P 500: 9.04%
cat("- Portfolio Standard Deviation: ", sprintf("%.2f%%", sd(result$portfolio$returns) * sqrt(12) * 100),
" vs. S&P 500: ", sprintf("%.2f%%", sd(result$data$sp500_returns[(36+1):length(result$data$sp500_returns)]) * sqrt(12) * 100), "\n", sep="")
## - Portfolio Standard Deviation: 9.55% vs. S&P 500: 16.18%
cat("- Portfolio Sharpe Ratio: ", sprintf("%.3f", mean(result$portfolio$returns - result$data$risk_free_rate) / sd(result$portfolio$returns)),
" vs. S&P 500: ", sprintf("%.3f", mean(result$data$sp500_returns[(36+1):length(result$data$sp500_returns)] - result$data$risk_free_rate) / sd(result$data$sp500_returns[(36+1):length(result$data$sp500_returns)])), "\n", sep="")
## - Portfolio Sharpe Ratio: -0.183 vs. S&P 500: 0.144
cat("- Portfolio Beta: ", sprintf("%.4f", result$analysis$portfolio_beta), "\n", sep="")
## - Portfolio Beta: -0.3385
cat("- Correlation with S&P 500: ", sprintf("%.4f", correlation), "\n", sep="")
## - Correlation with S&P 500: -0.5732
cat("\nConclusion: The long-short beta portfolio strategy ",
ifelse(mean(result$portfolio$returns) > mean(result$data$sp500_returns[(36+1):length(result$data$sp500_returns)]),
"outperforms", "underperforms"),
" the S&P 500 benchmark in terms of returns",
" with ",
ifelse(sd(result$portfolio$returns) < sd(result$data$sp500_returns[(36+1):length(result$data$sp500_returns)]),
"lower risk. ", "higher risk. "),
"The strategy is ",
ifelse(abs(result$analysis$portfolio_beta) < 0.2,
"relatively market-neutral",
ifelse(result$analysis$portfolio_beta > 0,
"positively exposed to market movements",
"negatively exposed to market movements")),
".\n", sep="")
##
## Conclusion: The long-short beta portfolio strategy underperforms the S&P 500 benchmark in terms of returns with lower risk. The strategy is negatively exposed to market movements.