# Long-Short Portfolio Construction with Jensen's Alpha and Performance Table
# This script creates a portfolio that goes long in the 10 stocks with the highest positive
# Jensen's alpha and short in the 10 stocks with the lowest negative alpha,
# 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 Jensen's Alpha
calculate_jensen_alpha <- function(returns, benchmark_returns, risk_free_rate) {
# Calculate beta
beta <- cov(returns, benchmark_returns) / var(benchmark_returns)
# Calculate average returns
avg_return <- mean(returns)
avg_benchmark_return <- mean(benchmark_returns)
# Calculate Jensen's Alpha
alpha <- avg_return - (risk_free_rate + beta * (avg_benchmark_return - risk_free_rate))
return(list(alpha = alpha, beta = beta))
}
# Function to construct long-short portfolio based on rolling Jensen's Alpha
construct_long_short_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_alphas <- list() # Store all alphas for each period for analysis
cat("Starting long-short 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]
window_rf <- mean(risk_free_rate[start_idx:end_idx])
# Calculate Jensen's Alpha for each asset
alphas <- numeric(ncol(window_returns))
betas <- numeric(ncol(window_returns))
for (j in 1:ncol(window_returns)) {
if (all(!is.na(window_returns[, j]))) {
result <- calculate_jensen_alpha(window_returns[, j], window_benchmark, window_rf)
alphas[j] <- result$alpha
betas[j] <- result$beta
} else {
alphas[j] <- NA
betas[j] <- NA
}
}
# Store all alphas for this period
asset_names <- colnames(window_returns)
period_alphas <- data.frame(
asset = asset_names,
alpha = alphas,
beta = betas
)
all_alphas[[i]] <- period_alphas
# Select top N assets with positive alphas for LONG positions
long_alpha_df <- period_alphas %>%
filter(alpha > 0) %>%
arrange(desc(alpha)) %>%
head(top_n)
# Select bottom N assets with negative alphas for SHORT positions
short_alpha_df <- period_alphas %>%
filter(alpha < 0) %>%
arrange(alpha) %>%
head(top_n)
# Store selected assets for this period
selected_long_assets[[i]] <- long_alpha_df$asset
selected_short_assets[[i]] <- short_alpha_df$asset
# Find indices of selected stocks
long_idx <- match(long_alpha_df$asset, asset_names)
short_idx <- match(short_alpha_df$asset, asset_names)
# Calculate portfolio return for the next month
next_month_return <- 0
if (length(long_idx) > 0 && length(short_idx) > 0) {
# Equal weighting in both long and short positions
# Long positions get +0.5 weight in total, short positions get -0.5 weight in total
long_weights <- rep(0.5/length(long_idx), length(long_idx))
short_weights <- rep(-0.5/length(short_idx), length(short_idx))
# Calculate returns
next_month_long_returns <- as.numeric(asset_returns[end_idx + 1, long_idx])
next_month_short_returns <- as.numeric(asset_returns[end_idx + 1, short_idx])
# Combine long and short returns
long_return <- sum(long_weights * next_month_long_returns, na.rm = TRUE)
short_return <- sum(short_weights * next_month_short_returns, na.rm = TRUE)
next_month_return <- long_return + short_return
} else if (length(long_idx) > 0) {
# Only long positions available
long_weights <- rep(1/length(long_idx), length(long_idx))
next_month_long_returns <- as.numeric(asset_returns[end_idx + 1, long_idx])
next_month_return <- sum(long_weights * next_month_long_returns, na.rm = TRUE)
} else if (length(short_idx) > 0) {
# Only short positions available
short_weights <- rep(-1/length(short_idx), length(short_idx))
next_month_short_returns <- as.numeric(asset_returns[end_idx + 1, short_idx])
next_month_return <- sum(short_weights * next_month_short_returns, na.rm = TRUE)
} else {
# If no assets meet criteria, return 0 (cash position)
next_month_return <- 0
}
portfolio_returns[i] <- next_month_return
# 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(long_alpha_df$asset) > 0) {
cat("Selected LONG assets:", paste(head(long_alpha_df$asset, 5), collapse=", "),
ifelse(length(long_alpha_df$asset) > 5, "...", ""), "\n")
} else {
cat("No assets with positive alpha found for long positions this period\n")
}
if (length(short_alpha_df$asset) > 0) {
cat("Selected SHORT assets:", paste(head(short_alpha_df$asset, 5), collapse=", "),
ifelse(length(short_alpha_df$asset) > 5, "...", ""), "\n")
} else {
cat("No assets with negative alpha found for short positions 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 alphas to a file for analysis
all_alphas_df <- do.call(rbind, lapply(1:length(all_alphas), function(i) {
df <- all_alphas[[i]]
df$period <- i
df$date <- as.character(dates[i + window_size])
return(df)
}))
output_file <- file.path(base_dir, "long_short_jensen_alphas.csv")
write.csv(all_alphas_df, output_file, row.names = FALSE)
cat("Saved all Jensen's alphas to:", output_file, "\n")
return(list(
returns = portfolio_returns_ts,
selected_long_assets = selected_long_assets,
selected_short_assets = selected_short_assets,
all_alphas = all_alphas
))
}
# ---- PERFORMANCE ANALYSIS FUNCTION ----
# Function to analyze portfolio performance
analyze_long_short_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 Long-Short 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"),
`Long-Short Portfolio` = c(sprintf("%.2f%%", portfolio_avg_return),
sprintf("%.2f%%", portfolio_sd),
sprintf("%.3f", portfolio_sharpe),
sprintf("%.3f", portfolio_upside)),
`S&P 500 Benchmark` = c(sprintf("%.2f%%", benchmark_avg_return),
sprintf("%.2f%%", benchmark_sd),
sprintf("%.3f", benchmark_sharpe),
sprintf("%.3f", benchmark_upside))
)
cat("\n----- Long-Short Portfolio Performance Metrics -----\n")
print(performance_table)
# Save the performance table
output_file <- file.path(base_dir, "long_short_performance_comparison.csv")
write.csv(performance_table, output_file, row.names = FALSE)
cat("Saved performance comparison to:", output_file, "\n")
# Create a data frame of portfolio composition over time
composition <- 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[i, "Long_Assets"] <- paste(long_assets, collapse = ", ")
composition[i, "Short_Assets"] <- paste(short_assets, collapse = ", ")
}
# Save portfolio composition to CSV
output_file <- file.path(base_dir, "long_short_portfolio_composition.csv")
write.csv(composition, output_file, row.names = FALSE)
cat("Saved portfolio composition to:", output_file, "\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, "long_short_portfolio_returns.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_long_selected <- unlist(portfolio_result$selected_long_assets)
long_selection_freq <- sort(table(all_long_selected), decreasing = TRUE)
cat("\n----- Most Frequently Selected LONG Assets -----\n")
print(head(long_selection_freq, 10))
# Count frequency of asset selection for short positions
all_short_selected <- unlist(portfolio_result$selected_short_assets)
short_selection_freq <- sort(table(all_short_selected), decreasing = TRUE)
cat("\n----- Most Frequently Selected SHORT Assets -----\n")
print(head(short_selection_freq, 10))
# Save selection frequency to CSV
long_selection_freq_df <- data.frame(
Asset = names(long_selection_freq),
Frequency = as.numeric(long_selection_freq),
Percentage = as.numeric(long_selection_freq) / length(portfolio_result$selected_long_assets) * 100
)
output_file <- file.path(base_dir, "long_asset_selection_frequency.csv")
write.csv(long_selection_freq_df, output_file, row.names = FALSE)
cat("Saved long asset selection frequency to:", output_file, "\n")
short_selection_freq_df <- data.frame(
Asset = names(short_selection_freq),
Frequency = as.numeric(short_selection_freq),
Percentage = as.numeric(short_selection_freq) / length(portfolio_result$selected_short_assets) * 100
)
output_file <- file.path(base_dir, "short_asset_selection_frequency.csv")
write.csv(short_selection_freq_df, output_file, row.names = FALSE)
cat("Saved short asset selection frequency to:", output_file, "\n")
return(list(
cumulative_returns = cumulative_returns,
performance_table = performance_table,
composition = composition,
long_selection_frequency = long_selection_freq_df,
short_selection_frequency = short_selection_freq_df
))
}
# ---- MAIN EXECUTION ----
# Run the complete analysis
run_long_short_analysis <- function() {
# Start timer
start_time <- Sys.time()
cat("Starting long-short portfolio 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_long_short_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 for long and short positions
)
# Analyze performance
cat("\nAnalyzing long-short portfolio performance...\n")
analysis <- analyze_long_short_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
long_short_result <- run_long_short_analysis()
## Starting long-short portfolio analysis at 2025-05-03 14:38:01.845744
## 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 long-short portfolio construction with 194 rebalancing periods
## Processing period 1 of 194 - Date: 2008-01-31
## Selected LONG assets: APPLE, NVIDIA, SALESFORCE, ALPHABET A, GILEAD SCIENCES ...
## Selected SHORT assets: CITIGROUP, HOME DEPOT, STARBUCKS, AMGEN, LOWE'S COMPANIES ...
## Processing period 5 of 194 - Date: 2008-05-30
## Selected LONG assets: SALESFORCE, APPLE, NETFLIX, NVIDIA, GILEAD SCIENCES ...
## Selected SHORT assets: CITIGROUP, STARBUCKS, UNITEDHEALTH GROUP, PFIZER, AMGEN ...
## Processing period 10 of 194 - Date: 2008-10-31
## Selected LONG assets: APPLE, SALESFORCE, AMAZON.COM, UNION PACIFIC, GILEAD SCIENCES ...
## Selected SHORT assets: UNITEDHEALTH GROUP, CITIGROUP, STARBUCKS, HOME DEPOT, PFIZER ...
## Processing period 15 of 194 - Date: 2009-03-31
## Selected LONG assets: AMAZON.COM, APPLE, SALESFORCE, NETFLIX, ORACLE ...
## Selected SHORT assets: CITIGROUP, STARBUCKS, BANK OF AMERICA, HOME DEPOT, PFIZER ...
## Processing period 20 of 194 - Date: 2009-08-31
## Selected LONG assets: AMAZON.COM, APPLE, SALESFORCE, NETFLIX, ADOBE (NAS) ...
## Selected SHORT assets: CITIGROUP, PFIZER, ELI LILLY, COMCAST A, STARBUCKS ...
## Processing period 25 of 194 - Date: 2010-01-29
## Selected LONG assets: AMAZON.COM, APPLE, SALESFORCE, NETFLIX, UNION PACIFIC ...
## Selected SHORT assets: CITIGROUP, COMCAST A, PFIZER, ELI LILLY, HOME DEPOT ...
## Processing period 30 of 194 - Date: 2010-06-30
## Selected LONG assets: NETFLIX, APPLE, SALESFORCE, AMAZON.COM, UNION PACIFIC ...
## Selected SHORT assets: CITIGROUP, PFIZER, AT&T, ELI LILLY, VERIZON COMMUNICATIONS ...
## Processing period 35 of 194 - Date: 2010-11-30
## Selected LONG assets: NETFLIX, SALESFORCE, AMAZON.COM, APPLE, UNION PACIFIC ...
## Selected SHORT assets: CITIGROUP, NVIDIA, MERCK & COMPANY, EXXON MOBIL, AT&T ...
## Processing period 40 of 194 - Date: 2011-04-29
## Selected LONG assets: NETFLIX, AMAZON.COM, SALESFORCE, APPLE, STARBUCKS ...
## Selected SHORT assets: CITIGROUP, ELI LILLY, CISCO SYSTEMS, BANK OF AMERICA, AT&T ...
## Processing period 45 of 194 - Date: 2011-09-30
## Selected LONG assets: NETFLIX, AMAZON.COM, SALESFORCE, STARBUCKS, APPLE ...
## Selected SHORT assets: CITIGROUP, BANK OF AMERICA, LOCKHEED MARTIN, MEDTRONIC, ADOBE (NAS) ...
## Processing period 50 of 194 - Date: 2012-02-29
## Selected LONG assets: NETFLIX, APPLE, SALESFORCE, STARBUCKS, AMAZON.COM ...
## Selected SHORT assets: CITIGROUP, BANK OF AMERICA, LOCKHEED MARTIN, MEDTRONIC, JP MORGAN CHASE & CO. ...
## Processing period 55 of 194 - Date: 2012-07-31
## Selected LONG assets: APPLE, STARBUCKS, SALESFORCE, NETFLIX, AMAZON.COM ...
## Selected SHORT assets: BANK OF AMERICA, CITIGROUP, CISCO SYSTEMS, JP MORGAN CHASE & CO., ADOBE (NAS) ...
## Processing period 60 of 194 - Date: 2012-12-31
## Selected LONG assets: NETFLIX, APPLE, SALESFORCE, STARBUCKS, HOME DEPOT ...
## Selected SHORT assets: BANK OF AMERICA, CITIGROUP, CISCO SYSTEMS, JP MORGAN CHASE & CO., MICROSOFT ...
## Processing period 65 of 194 - Date: 2013-05-31
## Selected LONG assets: NETFLIX, GILEAD SCIENCES, AMERICAN TOWER, STARBUCKS, VERIZON COMMUNICATIONS ...
## Selected SHORT assets: BANK OF AMERICA, CISCO SYSTEMS, CITIGROUP, NVIDIA, JP MORGAN CHASE & CO. ...
## Processing period 70 of 194 - Date: 2013-10-31
## Selected LONG assets: GILEAD SCIENCES, NETFLIX, STARBUCKS, AMGEN, AMAZON.COM ...
## Selected SHORT assets: BANK OF AMERICA, CITIGROUP, CISCO SYSTEMS, JP MORGAN CHASE & CO., ORACLE ...
## Processing period 75 of 194 - Date: 2014-03-31
## Selected LONG assets: GILEAD SCIENCES, NETFLIX, AMGEN, BRISTOL MYERS SQUIBB, AMAZON.COM ...
## Selected SHORT assets: CITIGROUP, NVIDIA, JP MORGAN CHASE & CO., BANK OF AMERICA, CHEVRON ...
## Processing period 80 of 194 - Date: 2014-08-29
## Selected LONG assets: GILEAD SCIENCES, AMGEN, AMERICAN TOWER, LOCKHEED MARTIN, NETFLIX ...
## Selected SHORT assets: CITIGROUP, JP MORGAN CHASE & CO., INTERNATIONAL BUS.MCHS., CHEVRON, ACCENTURE CLASS A ...
## Processing period 85 of 194 - Date: 2015-01-30
## Selected LONG assets: GILEAD SCIENCES, NETFLIX, AMGEN, UNION PACIFIC, BANK OF AMERICA ...
## Selected SHORT assets: INTERNATIONAL BUS.MCHS., CHEVRON, EXXON MOBIL, MCDONALDS, NVIDIA ...
## Processing period 90 of 194 - Date: 2015-06-30
## Selected LONG assets: NETFLIX, GILEAD SCIENCES, THERMO FISHER SCIENTIFIC, LOCKHEED MARTIN, AMGEN ...
## Selected SHORT assets: CHEVRON, INTERNATIONAL BUS.MCHS., EXXON MOBIL, COCA COLA, AT&T ...
## Processing period 95 of 194 - Date: 2015-11-30
## Selected LONG assets: NETFLIX, NIKE 'B', GILEAD SCIENCES, STARBUCKS, LOCKHEED MARTIN ...
## Selected SHORT assets: CHEVRON, INTERNATIONAL BUS.MCHS., EXXON MOBIL, WALMART, PROCTER & GAMBLE ...
## Processing period 100 of 194 - Date: 2016-04-29
## Selected LONG assets: NETFLIX, NVIDIA, LOCKHEED MARTIN, UNITEDHEALTH GROUP, NIKE 'B' ...
## Selected SHORT assets: CHEVRON, INTERNATIONAL BUS.MCHS., CITIGROUP, EXXON MOBIL, ABBOTT LABORATORIES ...
## Processing period 105 of 194 - Date: 2016-09-30
## Selected LONG assets: NVIDIA, NETFLIX, AMAZON.COM, LOCKHEED MARTIN, UNITEDHEALTH GROUP ...
## Selected SHORT assets: CHEVRON, CITIGROUP, INTERNATIONAL BUS.MCHS., EXXON MOBIL, ABBOTT LABORATORIES ...
## Processing period 110 of 194 - Date: 2017-02-28
## Selected LONG assets: NVIDIA, NETFLIX, UNITEDHEALTH GROUP, AMAZON.COM, ADOBE (NAS) ...
## Selected SHORT assets: GILEAD SCIENCES, CHEVRON, EXXON MOBIL, ABBOTT LABORATORIES, INTERNATIONAL BUS.MCHS. ...
## Processing period 115 of 194 - Date: 2017-07-31
## Selected LONG assets: NVIDIA, NETFLIX, AMAZON.COM, UNITEDHEALTH GROUP, ADOBE (NAS) ...
## Selected SHORT assets: CHEVRON, EXXON MOBIL, INTERNATIONAL BUS.MCHS., GILEAD SCIENCES, VERIZON COMMUNICATIONS ...
## Processing period 120 of 194 - Date: 2017-12-29
## Selected LONG assets: NVIDIA, NETFLIX, AMAZON.COM, UNITEDHEALTH GROUP, ADOBE (NAS) ...
## Selected SHORT assets: GILEAD SCIENCES, INTERNATIONAL BUS.MCHS., AMGEN, MERCK & COMPANY, EXXON MOBIL ...
## Processing period 125 of 194 - Date: 2018-05-31
## Selected LONG assets: NVIDIA, NETFLIX, AMAZON.COM, ADOBE (NAS), UNITEDHEALTH GROUP ...
## Selected SHORT assets: GILEAD SCIENCES, INTERNATIONAL BUS.MCHS., BRISTOL MYERS SQUIBB, WALT DISNEY, WELLS FARGO & CO ...
## Processing period 130 of 194 - Date: 2018-10-31
## Selected LONG assets: NVIDIA, NETFLIX, ADOBE (NAS), AMAZON.COM, NEXTERA ENERGY ...
## Selected SHORT assets: GILEAD SCIENCES, WELLS FARGO & CO, INTERNATIONAL BUS.MCHS., BRISTOL MYERS SQUIBB, COMCAST A ...
## Processing period 135 of 194 - Date: 2019-03-29
## Selected LONG assets: NVIDIA, NETFLIX, ADOBE (NAS), AMAZON.COM, SALESFORCE ...
## Selected SHORT assets: GILEAD SCIENCES, INTERNATIONAL BUS.MCHS., AT&T, BRISTOL MYERS SQUIBB, EXXON MOBIL ...
## Processing period 140 of 194 - Date: 2019-08-30
## Selected LONG assets: NETFLIX, ADOBE (NAS), NVIDIA, AMERICAN TOWER, MICROSOFT ...
## Selected SHORT assets: BRISTOL MYERS SQUIBB, EXXON MOBIL, GILEAD SCIENCES, INTERNATIONAL BUS.MCHS., AT&T ...
## Processing period 145 of 194 - Date: 2020-01-31
## Selected LONG assets: ADOBE (NAS), AMERICAN TOWER, NEXTERA ENERGY, APPLE, MICROSOFT ...
## Selected SHORT assets: INTERNATIONAL BUS.MCHS., EXXON MOBIL, GILEAD SCIENCES, WELLS FARGO & CO, AT&T ...
## Processing period 150 of 194 - Date: 2020-06-30
## Selected LONG assets: NETFLIX, ADOBE (NAS), NVIDIA, MICROSOFT, AMAZON.COM ...
## Selected SHORT assets: WELLS FARGO & CO, EXXON MOBIL, CITIGROUP, INTERNATIONAL BUS.MCHS., AT&T ...
## Processing period 155 of 194 - Date: 2020-11-30
## Selected LONG assets: AMAZON.COM, NETFLIX, NVIDIA, APPLE, DANAHER ...
## Selected SHORT assets: EXXON MOBIL, WELLS FARGO & CO, CITIGROUP, CHEVRON, INTERNATIONAL BUS.MCHS. ...
## Processing period 160 of 194 - Date: 2021-04-30
## Selected LONG assets: ELI LILLY, APPLE, MICROSOFT, DANAHER, THERMO FISHER SCIENTIFIC ...
## Selected SHORT assets: EXXON MOBIL, WELLS FARGO & CO, INTERNATIONAL BUS.MCHS., CHEVRON, CITIGROUP ...
## Processing period 165 of 194 - Date: 2021-09-30
## Selected LONG assets: ELI LILLY, DANAHER, NVIDIA, MICROSOFT, NEXTERA ENERGY ...
## Selected SHORT assets: EXXON MOBIL, CHEVRON, WELLS FARGO & CO, CITIGROUP, INTERNATIONAL BUS.MCHS. ...
## Processing period 170 of 194 - Date: 2022-02-28
## Selected LONG assets: NVIDIA, APPLE, MICROSOFT, DANAHER, ELI LILLY ...
## Selected SHORT assets: CITIGROUP, AT&T, EXXON MOBIL, CHEVRON, WELLS FARGO & CO ...
## Processing period 175 of 194 - Date: 2022-07-29
## Selected LONG assets: NVIDIA, ELI LILLY, APPLE, UNITEDHEALTH GROUP, COSTCO WHOLESALE ...
## Selected SHORT assets: NETFLIX, WALT DISNEY, CITIGROUP, CISCO SYSTEMS, WELLS FARGO & CO ...
## Processing period 180 of 194 - Date: 2022-12-30
## Selected LONG assets: ELI LILLY, NVIDIA, APPLE, UNITEDHEALTH GROUP, DANAHER ...
## Selected SHORT assets: INTEL, WALT DISNEY, CITIGROUP, MEDTRONIC, VERIZON COMMUNICATIONS ...
## Processing period 185 of 194 - Date: 2023-05-31
## Selected LONG assets: NVIDIA, ELI LILLY, EXXON MOBIL, APPLE, LOWE'S COMPANIES ...
## Selected SHORT assets: INTEL, VERIZON COMMUNICATIONS, AMAZON.COM, NETFLIX, WALT DISNEY ...
## Processing period 190 of 194 - Date: 2023-10-31
## Selected LONG assets: ELI LILLY, EXXON MOBIL, NVIDIA, CHEVRON, ALPHABET A ...
## Selected SHORT assets: VERIZON COMMUNICATIONS, WALT DISNEY, AMERICAN TOWER, INTEL, NIKE 'B' ...
## Processing period 194 of 194 - Date: 2024-02-29
## Selected LONG assets: NVIDIA, ELI LILLY, EXXON MOBIL, COSTCO WHOLESALE, MERCK & COMPANY ...
## Selected SHORT assets: WALT DISNEY, NIKE 'B', NEXTERA ENERGY, INTEL, MEDTRONIC ...
## Saved all Jensen's alphas to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/long_short_jensen_alphas.csv
##
## Analyzing long-short portfolio performance...
##
## ----- Long-Short Portfolio Performance Metrics -----
## Metric Long.Short.Portfolio S.P.500.Benchmark
## 1 Average Return 3.43% 9.04%
## 2 Standard Deviation 8.94% 16.18%
## 3 Sharpe Ratio 0.080 0.144
## 4 Upside-Potential Ratio 0.416 0.460
## Saved performance comparison to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/long_short_performance_comparison.csv
## Saved portfolio composition to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/long_short_portfolio_composition.csv
## Saved portfolio returns to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/long_short_portfolio_returns.csv
##
## ----- Most Frequently Selected LONG Assets -----
## all_long_selected
## NETFLIX AMAZON.COM NVIDIA APPLE
## 156 132 128 118
## UNITEDHEALTH GROUP SALESFORCE ADOBE (NAS) NEXTERA ENERGY
## 102 87 84 71
## MICROSOFT STARBUCKS
## 68 67
##
## ----- Most Frequently Selected SHORT Assets -----
## all_short_selected
## CITIGROUP EXXON MOBIL INTERNATIONAL BUS.MCHS.
## 162 121 96
## AT&T BANK OF AMERICA WELLS FARGO & CO
## 93 87 86
## CHEVRON GILEAD SCIENCES MEDTRONIC
## 85 66 66
## PFIZER
## 65
## Saved long asset selection frequency to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/long_asset_selection_frequency.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/short_asset_selection_frequency.csv
##
## Analysis completed in 0.04 minutes
# ---- ADDITIONAL ANALYSIS ----
# 1. Plot the portfolio returns alongside the benchmark
portfolio_vs_benchmark <- merge(
`Long-Short` = cumprod(1 + long_short_result$portfolio$returns) - 1,
Benchmark = cumprod(1 + long_short_result$data$sp500_returns[(36+1):length(long_short_result$data$sp500_returns)]) - 1
)
# Create a plot with different colors and a legend
plot(portfolio_vs_benchmark,
main = "Long-Short 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, "long_short_portfolio_vs_benchmark.png")
png(output_file, width = 800, height = 500)
plot(portfolio_vs_benchmark,
main = "Long-Short 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/long_short_portfolio_vs_benchmark.png
# 2. Calculate annual returns
annual_returns <- apply.yearly(long_short_result$portfolio$returns, Return.cumulative)
print(annual_returns)
## [,1]
## 2008-12-31 -0.076175340
## 2009-12-31 0.063490766
## 2010-12-31 0.081633741
## 2011-12-30 -0.006198951
## 2012-12-31 -0.001123510
## 2013-12-31 0.043511742
## 2014-12-31 0.027475013
## 2015-12-31 0.096945762
## 2016-12-30 -0.035252996
## 2017-12-29 0.100553679
## 2018-12-31 0.048876249
## 2019-12-31 0.017912284
## 2020-12-31 0.234071767
## 2021-12-31 0.009652970
## 2022-12-30 -0.088811076
## 2023-12-29 -0.029832094
## 2024-02-29 0.052645242
# 3. Monthly returns statistics
monthly_stats <- data.frame(
Statistic = c("Min", "1st Quartile", "Median", "Mean", "3rd Quartile", "Max", "Standard Deviation"),
Value = c(
min(long_short_result$portfolio$returns),
quantile(long_short_result$portfolio$returns, 0.25),
median(long_short_result$portfolio$returns),
mean(long_short_result$portfolio$returns),
quantile(long_short_result$portfolio$returns, 0.75),
max(long_short_result$portfolio$returns),
sd(long_short_result$portfolio$returns)
)
)
# Print monthly statistics
cat("\n----- Monthly Return Statistics -----\n")
##
## ----- Monthly Return Statistics -----
print(monthly_stats)
## Statistic Value
## 1 Min -0.092082417
## 2 1st Quartile -0.011120215
## 3 Median 0.004835875
## 4 Mean 0.002857763
## 5 3rd Quartile 0.018199524
## 6 Max 0.078542707
## 7 Standard Deviation 0.025813278
# Save statistics to CSV
output_file <- file.path(base_dir, "long_short_monthly_statistics.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/long_short_monthly_statistics.csv
# Save all output files in one directory for easy access
save(long_short_result, file = file.path(base_dir, "long_short_jensen_alpha_portfolio_results.RData"))
cat("All analysis results saved to:", file.path(base_dir, "long_short_jensen_alpha_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_jensen_alpha_portfolio_results.RData
# 4. Additional visualization: Histogram of returns
png(file.path(base_dir, "long_short_returns_histogram.png"), width = 800, height = 500)
hist(long_short_result$portfolio$returns,
breaks = 30,
main = "Long-Short Portfolio Monthly Returns Distribution",
xlab = "Monthly Return",
col = "skyblue")
abline(v = mean(long_short_result$portfolio$returns), col = "red", lwd = 2)
dev.off()
## png
## 2
# 5. Drawdown analysis
drawdown_portfolio <- PerformanceAnalytics::Drawdowns(long_short_result$portfolio$returns)
drawdown_benchmark <- PerformanceAnalytics::Drawdowns(
long_short_result$data$sp500_returns[(36+1):length(long_short_result$data$sp500_returns)]
)
drawdowns <- merge(
`Long-Short` = drawdown_portfolio,
Benchmark = drawdown_benchmark
)
png(file.path(base_dir, "long_short_drawdowns.png"), width = 800, height = 500)
plot(drawdowns,
main = "Drawdowns: Long-Short Portfolio vs S&P 500",
col = c("blue", "red"),
lwd = c(2, 2),
legend.loc = "bottomleft")
dev.off()
## png
## 2
# Display a final message with key findings
cat("\n===== LONG-SHORT PORTFOLIO ANALYSIS SUMMARY =====\n")
##
## ===== LONG-SHORT PORTFOLIO ANALYSIS SUMMARY =====
cat("Portfolio Strategy: Long positions in 10 assets with highest positive Jensen's alpha\n")
## Portfolio Strategy: Long positions in 10 assets with highest positive Jensen's alpha
cat(" Short positions in 10 assets with lowest negative Jensen's alpha\n")
## Short positions in 10 assets with lowest negative Jensen's alpha
cat("Rebalancing: Monthly, based on rolling 36-month analysis windows\n\n")
## Rebalancing: Monthly, based on rolling 36-month analysis windows
# Performance metrics will be filled in after running the script
cat("Key Performance Metrics will be displayed after running the script.\n\n")
## Key Performance Metrics will be displayed after running the script.
cat("For comparing with the long-only strategy, refer to the separate performance files.\n")
## For comparing with the long-only strategy, refer to the separate performance files.