# Momentum Portfolio Construction with 3-month lookback window
# This script creates a portfolio that invests in stocks with positive returns
# over the last 3 months, rebalanced monthly with equal weighting
# ---- 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))
})
}
# ---- MOMENTUM ANALYSIS FUNCTIONS ----
# Function to calculate N-month cumulative returns
calculate_momentum <- function(returns, lookback_period = 3) {
# Calculate cumulative returns over the lookback period
# For 3-month lookback, we calculate (1+r1)*(1+r2)*(1+r3) - 1
momentum <- rep(NA, length(returns))
if (length(returns) >= lookback_period) {
# Calculate cumulative returns using rolling product
for (i in lookback_period:length(returns)) {
momentum[i] <- prod(1 + returns[(i - lookback_period + 1):i]) - 1
}
}
return(momentum)
}
# Function to construct momentum portfolio based on trailing returns
construct_momentum_portfolio <- function(asset_returns, lookback_period = 3,
start_after_months = 36) {
dates <- index(asset_returns)
n_stocks <- ncol(asset_returns)
n_periods <- length(dates) - start_after_months
portfolio_returns <- numeric(n_periods)
selected_assets <- list()
momentum_scores <- list()
cat("Starting momentum portfolio construction with", n_periods, "rebalancing periods\n")
for (i in 1:n_periods) {
# Define the current position in the time series
current_idx <- i + start_after_months - 1
# Calculate momentum for each asset using data up to the current month
asset_momentums <- numeric(n_stocks)
for (j in 1:n_stocks) {
# Get returns for the current asset
asset_data <- asset_returns[1:current_idx, j]
# Calculate momentum (trailing return over lookback period)
if (current_idx >= lookback_period) {
# Get the last lookback_period months of returns
recent_returns <- asset_data[(current_idx - lookback_period + 1):current_idx]
# Calculate cumulative return over the lookback period
if (all(!is.na(recent_returns))) {
asset_momentums[j] <- prod(1 + recent_returns) - 1
} else {
asset_momentums[j] <- NA
}
} else {
asset_momentums[j] <- NA
}
}
# Create data frame of stocks and their momentum scores
asset_names <- colnames(asset_returns)
momentum_df <- data.frame(
asset = asset_names,
momentum = asset_momentums
)
# Store momentum scores for this period
momentum_scores[[i]] <- momentum_df
# Select assets with positive momentum
selected_momentum_df <- momentum_df %>%
filter(!is.na(momentum) & momentum > 0) %>%
arrange(desc(momentum))
selected_assets_names <- selected_momentum_df$asset
selected_assets[[i]] <- selected_assets_names
# Find indices of selected stocks
selected_idx <- match(selected_assets_names, asset_names)
# Calculate portfolio return for the next month
next_month_return <- 0
if (length(selected_idx) > 0) {
# Equal weighting for all selected stocks
weights <- rep(1/length(selected_idx), length(selected_idx))
# Get the returns for the next month
next_month_returns <- as.numeric(asset_returns[current_idx + 1, selected_idx])
# Calculate weighted return
next_month_return <- sum(weights * next_month_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[current_idx + 1]), "\n")
if (length(selected_assets_names) > 0) {
cat("Selected assets count:", length(selected_assets_names), "\n")
cat("Top 5 momentum assets:", paste(head(selected_assets_names, 5), collapse=", "),
ifelse(length(selected_assets_names) > 5, "...", ""), "\n")
cat("Top 5 momentum scores:", paste(sprintf("%.2f%%", head(selected_momentum_df$momentum, 5) * 100), collapse=", "),
ifelse(length(selected_assets_names) > 5, "...", ""), "\n")
} else {
cat("No assets with positive momentum found this period\n")
}
}
}
# Create a time series of portfolio returns
portfolio_returns_ts <- xts(portfolio_returns, order.by = dates[(start_after_months + 1):length(dates)])
# Save all momentum scores to a file for analysis
all_momentum_df <- do.call(rbind, lapply(1:length(momentum_scores), function(i) {
df <- momentum_scores[[i]]
df$period <- i
df$date <- as.character(dates[i + start_after_months])
return(df)
}))
output_file <- file.path(base_dir, "momentum_scores.csv")
write.csv(all_momentum_df, output_file, row.names = FALSE)
cat("Saved all momentum scores to:", output_file, "\n")
return(list(
returns = portfolio_returns_ts,
selected_assets = selected_assets,
all_momentum = all_momentum_df
))
}
# ---- PERFORMANCE ANALYSIS FUNCTION ----
# Function to analyze portfolio performance
analyze_momentum_portfolio <- function(portfolio_result, risk_free_rate, sp500_returns, start_after_months = 36) {
portfolio_returns <- portfolio_result$returns
# Calculate cumulative returns
cumulative_returns <- cumprod(1 + portfolio_returns) - 1
# Plot results
plot(cumulative_returns, main = "Cumulative Momentum 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[(start_after_months + 1):length(risk_free_rate)]) /
sd(portfolio_returns)
# Calculate benchmark metrics for the same period
benchmark_returns <- sp500_returns[(start_after_months + 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[(start_after_months + 1):length(risk_free_rate)]) /
sd(benchmark_returns)
# Calculate Upside-Potential Ratio for both
target_return <- mean(risk_free_rate[(start_after_months + 1):length(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"),
`Momentum 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----- Momentum Portfolio Performance Metrics -----\n")
print(performance_table)
# Save the performance table
output_file <- file.path(base_dir, "momentum_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
)
composition$Assets <- sapply(portfolio_result$selected_assets, function(assets) {
paste(assets, collapse = ", ")
})
composition$Asset_Count <- sapply(portfolio_result$selected_assets, length)
# Save portfolio composition to CSV
output_file <- file.path(base_dir, "momentum_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, "momentum_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
all_selected <- unlist(portfolio_result$selected_assets)
selection_freq <- sort(table(all_selected), decreasing = TRUE)
cat("\n----- Most Frequently Selected Assets -----\n")
print(head(selection_freq, 10))
# Save selection frequency to CSV
selection_freq_df <- data.frame(
Asset = names(selection_freq),
Frequency = as.numeric(selection_freq),
Percentage = as.numeric(selection_freq) / length(portfolio_result$selected_assets) * 100
)
output_file <- file.path(base_dir, "momentum_asset_selection_frequency.csv")
write.csv(selection_freq_df, output_file, row.names = FALSE)
cat("Saved asset selection frequency to:", output_file, "\n")
return(list(
cumulative_returns = cumulative_returns,
performance_table = performance_table,
composition = composition,
selection_frequency = selection_freq_df
))
}
# ---- MAIN EXECUTION ----
# Run the complete analysis
run_momentum_analysis <- function() {
# Start timer
start_time <- Sys.time()
cat("Starting momentum 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 momentum portfolio...\n")
portfolio_result <- construct_momentum_portfolio(
asset_returns = data$stock_returns,
lookback_period = 3, # 3 months lookback for momentum
start_after_months = 36 # Start after 36 months of data
)
# Analyze performance
cat("\nAnalyzing momentum portfolio performance...\n")
analysis <- analyze_momentum_portfolio(
portfolio_result = portfolio_result,
risk_free_rate = data$risk_free_rate,
sp500_returns = data$sp500_returns,
start_after_months = 36
)
# 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
momentum_result <- run_momentum_analysis()
## Starting momentum portfolio analysis at 2025-05-03 15:28:33.362401
## 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 momentum portfolio...
## Starting momentum portfolio construction with 194 rebalancing periods
## Processing period 1 of 194 - Date: 2008-01-31
## Selected assets count: 23
## Top 5 momentum assets: APPLE, NETFLIX, SALESFORCE, ALPHABET A, MICROSOFT ...
## Top 5 momentum scores: 29.07%, 28.29%, 22.16%, 21.90%, 20.84% ...
## Processing period 5 of 194 - Date: 2008-05-30
## Selected assets count: 31
## Top 5 momentum assets: SALESFORCE, APPLE, NETFLIX, UNION PACIFIC, AMERICAN TOWER ...
## Top 5 momentum scores: 28.55%, 28.51%, 27.16%, 16.38%, 16.00% ...
## Processing period 10 of 194 - Date: 2008-10-31
## Selected assets count: 21
## Top 5 momentum assets: WELLS FARGO & CO, BANK OF AMERICA, JP MORGAN CHASE & CO., AMGEN, CITIGROUP ...
## Top 5 momentum scores: 58.02%, 46.63%, 36.11%, 25.68%, 22.37% ...
## Processing period 15 of 194 - Date: 2009-03-31
## Selected assets count: 9
## Top 5 momentum assets: NETFLIX, AMAZON.COM, ALPHABET A, INTERNATIONAL BUS.MCHS., NVIDIA ...
## Top 5 momentum scores: 57.70%, 51.73%, 15.37%, 12.78%, 10.84% ...
## Processing period 20 of 194 - Date: 2009-08-31
## Selected assets count: 45
## Top 5 momentum assets: BANK OF AMERICA, TEXAS INSTRUMENTS, APPLE, THERMO FISHER SCIENTIFIC, AMGEN ...
## Top 5 momentum scores: 65.62%, 33.17%, 29.85%, 29.08%, 28.55% ...
## Processing period 25 of 194 - Date: 2010-01-29
## Selected assets count: 40
## Top 5 momentum assets: AMAZON.COM, SALESFORCE, ALPHABET A, NVIDIA, UNITEDHEALTH GROUP ...
## Top 5 momentum scores: 44.09%, 29.58%, 25.03%, 24.28%, 21.73% ...
## Processing period 30 of 194 - Date: 2010-06-30
## Selected assets count: 22
## Top 5 momentum assets: NETFLIX, SALESFORCE, APPLE, CITIGROUP, STARBUCKS ...
## Top 5 momentum scores: 68.28%, 27.34%, 25.54%, 16.47%, 13.01% ...
## Processing period 35 of 194 - Date: 2010-11-30
## Selected assets count: 41
## Top 5 momentum assets: NETFLIX, AMAZON.COM, NVIDIA, ALPHABET A, ORACLE ...
## Top 5 momentum scores: 69.25%, 40.16%, 30.80%, 26.58%, 24.28% ...
## Processing period 40 of 194 - Date: 2011-04-29
## Selected assets count: 35
## Top 5 momentum assets: NETFLIX, UNITEDHEALTH GROUP, NVIDIA, CHEVRON, GILEAD SCIENCES ...
## Top 5 momentum scores: 35.33%, 25.17%, 19.87%, 17.80%, 17.19% ...
## Processing period 45 of 194 - Date: 2011-09-30
## Selected assets count: 11
## Top 5 momentum assets: MCDONALDS, APPLE, AMAZON.COM, MICROSOFT, COCA COLA ...
## Top 5 momentum scores: 10.88%, 10.64%, 9.43%, 6.36%, 5.45% ...
## Processing period 50 of 194 - Date: 2012-02-29
## Selected assets count: 39
## Top 5 momentum assets: NETFLIX, LOWE'S COMPANIES, HOME DEPOT, AMGEN, GILEAD SCIENCES ...
## Top 5 momentum scores: 46.44%, 27.64%, 23.99%, 18.61%, 17.28% ...
## Processing period 55 of 194 - Date: 2012-07-31
## Selected assets count: 22
## Top 5 momentum assets: VERIZON COMMUNICATIONS, AT&T, WALMART, AMAZON.COM, NEXTERA ENERGY ...
## Top 5 momentum scores: 16.24%, 14.19%, 13.92%, 12.76%, 12.66% ...
## Processing period 60 of 194 - Date: 2012-12-31
## Selected assets count: 36
## Top 5 momentum assets: NETFLIX, GILEAD SCIENCES, LOWE'S COMPANIES, BANK OF AMERICA, CITIGROUP ...
## Top 5 momentum scores: 36.82%, 30.01%, 26.72%, 23.40%, 16.36% ...
## Processing period 65 of 194 - Date: 2013-05-31
## Selected assets count: 44
## Top 5 momentum assets: NETFLIX, GILEAD SCIENCES, VERIZON COMMUNICATIONS, AMGEN, MICROSOFT ...
## Top 5 momentum scores: 30.76%, 28.37%, 23.62%, 21.94%, 20.58% ...
## Processing period 70 of 194 - Date: 2013-10-31
## Selected assets count: 33
## Top 5 momentum assets: NETFLIX, SALESFORCE, GILEAD SCIENCES, APPLE, LOCKHEED MARTIN ...
## Top 5 momentum scores: 46.48%, 35.96%, 22.63%, 20.23%, 17.60% ...
## Processing period 75 of 194 - Date: 2014-03-31
## Selected assets count: 34
## Top 5 momentum assets: THERMO FISHER SCIENTIFIC, NETFLIX, ADOBE (NAS), SALESFORCE, ELI LILLY ...
## Top 5 momentum scores: 23.49%, 21.82%, 20.87%, 19.74%, 18.70% ...
## Processing period 80 of 194 - Date: 2014-08-29
## Selected assets count: 36
## Top 5 momentum assets: NETFLIX, INTEL, GILEAD SCIENCES, AMGEN, APPLE ...
## Top 5 momentum scores: 31.26%, 26.98%, 16.64%, 14.00%, 13.41% ...
## Processing period 85 of 194 - Date: 2015-01-30
## Selected assets count: 37
## Top 5 momentum assets: LOWE'S COMPANIES, ORACLE, UNITEDHEALTH GROUP, MEDTRONIC, BRISTOL MYERS SQUIBB ...
## Top 5 momentum scores: 30.01%, 17.48%, 17.21%, 16.55%, 15.34% ...
## Processing period 90 of 194 - Date: 2015-06-30
## Selected assets count: 23
## Top 5 momentum assets: NETFLIX, AMAZON.COM, ELI LILLY, STARBUCKS, GILEAD SCIENCES ...
## Top 5 momentum scores: 31.41%, 12.91%, 12.44%, 11.16%, 8.44% ...
## Processing period 95 of 194 - Date: 2015-11-30
## Selected assets count: 27
## Top 5 momentum assets: NVIDIA, INTEL, AMAZON.COM, NIKE 'B', TEXAS INSTRUMENTS ...
## Top 5 momentum scores: 42.21%, 16.96%, 16.74%, 13.72%, 13.49% ...
## Processing period 100 of 194 - Date: 2016-04-29
## Selected assets count: 26
## Top 5 momentum assets: VERIZON COMMUNICATIONS, NEXTERA ENERGY, AT&T, ORACLE, WALMART ...
## Top 5 momentum scores: 17.01%, 13.91%, 13.83%, 11.99%, 11.73% ...
## Processing period 105 of 194 - Date: 2016-09-30
## Selected assets count: 39
## Top 5 momentum assets: NVIDIA, TEXAS INSTRUMENTS, INTEL, UNION PACIFIC, MERCK & COMPANY ...
## Top 5 momentum scores: 31.29%, 14.75%, 13.61%, 13.47%, 11.61% ...
## Processing period 110 of 194 - Date: 2017-02-28
## Selected assets count: 40
## Top 5 momentum assets: NVIDIA, BANK OF AMERICA, WELLS FARGO & CO, JP MORGAN CHASE & CO., COMCAST A ...
## Top 5 momentum scores: 53.43%, 37.21%, 22.43%, 22.19%, 22.00% ...
## Processing period 115 of 194 - Date: 2017-07-31
## Selected assets count: 33
## Top 5 momentum assets: NVIDIA, MCDONALDS, THERMO FISHER SCIENTIFIC, UNITEDHEALTH GROUP, ORACLE ...
## Top 5 momentum scores: 32.71%, 18.17%, 13.59%, 13.05%, 12.40% ...
## Processing period 120 of 194 - Date: 2017-12-29
## Selected assets count: 42
## Top 5 momentum assets: INTEL, WALMART, UNION PACIFIC, AMAZON.COM, HOME DEPOT ...
## Top 5 momentum scores: 27.86%, 24.54%, 20.13%, 20.00%, 19.98% ...
## Processing period 125 of 194 - Date: 2018-05-31
## Selected assets count: 11
## Top 5 momentum assets: NETFLIX, ADOBE (NAS), AMAZON.COM, INTEL, CISCO SYSTEMS ...
## Top 5 momentum scores: 15.60%, 10.93%, 7.94%, 7.23%, 6.62% ...
## Processing period 130 of 194 - Date: 2018-10-31
## Selected assets count: 45
## Top 5 momentum assets: ELI LILLY, APPLE, PFIZER, ABBOTT LABORATORIES, LOWE'S COMPANIES ...
## Top 5 momentum scores: 25.76%, 21.95%, 21.47%, 20.28%, 20.14% ...
## Processing period 135 of 194 - Date: 2019-03-29
## Selected assets count: 27
## Top 5 momentum assets: NETFLIX, DANAHER, SALESFORCE, NIKE 'B', LOWE'S COMPANIES ...
## Top 5 momentum scores: 25.15%, 15.96%, 14.63%, 14.12%, 11.36% ...
## Processing period 140 of 194 - Date: 2019-08-30
## Selected assets count: 32
## Top 5 momentum assets: STARBUCKS, MEDTRONIC, COSTCO WHOLESALE, PROCTER & GAMBLE, AT&T ...
## Top 5 momentum scores: 21.90%, 14.78%, 12.26%, 10.86%, 9.98% ...
## Processing period 145 of 194 - Date: 2020-01-31
## Selected assets count: 39
## Top 5 momentum assets: UNITEDHEALTH GROUP, NVIDIA, APPLE, BRISTOL MYERS SQUIBB, AMGEN ...
## Top 5 momentum scores: 35.28%, 35.18%, 31.11%, 26.58%, 24.58% ...
## Processing period 150 of 194 - Date: 2020-06-30
## Selected assets count: 35
## Top 5 momentum assets: NVIDIA, AMAZON.COM, ABBOTT LABORATORIES, LOWE'S COMPANIES, ELI LILLY ...
## Top 5 momentum scores: 31.45%, 29.65%, 23.22%, 22.31%, 21.26% ...
## Processing period 155 of 194 - Date: 2020-11-30
## Selected assets count: 25
## Top 5 momentum assets: NIKE 'B', SALESFORCE, NVIDIA, THERMO FISHER SCIENTIFIC, STARBUCKS ...
## Top 5 momentum scores: 23.02%, 19.20%, 18.08%, 14.29%, 13.63% ...
## Processing period 160 of 194 - Date: 2021-04-30
## Selected assets count: 34
## Top 5 momentum assets: EXXON MOBIL, WELLS FARGO & CO, INTEL, BANK OF AMERICA, CHEVRON ...
## Top 5 momentum scores: 35.44%, 29.46%, 28.46%, 27.65%, 24.09% ...
## Processing period 165 of 194 - Date: 2021-09-30
## Selected assets count: 37
## Top 5 momentum assets: NVIDIA, ADOBE (NAS), ELI LILLY, DANAHER, ALPHABET A ...
## Top 5 momentum scores: 37.80%, 31.54%, 29.31%, 26.56%, 22.79% ...
## Processing period 170 of 194 - Date: 2022-02-28
## Selected assets count: 21
## Top 5 momentum assets: PFIZER, EXXON MOBIL, LOCKHEED MARTIN, APPLE, CHEVRON ...
## Top 5 momentum scores: 20.46%, 17.82%, 17.09%, 16.68%, 14.71% ...
## Processing period 175 of 194 - Date: 2022-07-29
## Selected assets count: 13
## Top 5 momentum assets: AT&T, ELI LILLY, MERCK & COMPANY, INTERNATIONAL BUS.MCHS., BRISTOL MYERS SQUIBB ...
## Top 5 momentum scores: 17.22%, 13.22%, 11.12%, 8.59%, 5.44% ...
## Processing period 180 of 194 - Date: 2022-12-30
## Selected assets count: 37
## Top 5 momentum assets: GILEAD SCIENCES, NETFLIX, MERCK & COMPANY, ELI LILLY, STARBUCKS ...
## Top 5 momentum scores: 38.38%, 36.67%, 29.01%, 23.19%, 21.57% ...
## Processing period 185 of 194 - Date: 2023-05-31
## Selected assets count: 24
## Top 5 momentum assets: NVIDIA, MICROSOFT, SALESFORCE, APPLE, ELI LILLY ...
## Top 5 momentum scores: 42.03%, 23.99%, 18.10%, 17.60%, 15.03% ...
## Processing period 190 of 194 - Date: 2023-10-31
## Selected assets count: 15
## Top 5 momentum assets: AMGEN, ELI LILLY, EXXON MOBIL, ALPHABET A, CHEVRON ...
## Top 5 momentum scores: 21.05%, 14.53%, 9.63%, 9.32%, 7.16% ...
## Processing period 194 of 194 - Date: 2024-02-29
## Selected assets count: 42
## Top 5 momentum assets: NVIDIA, CITIGROUP, SALESFORCE, NETFLIX, BANK OF AMERICA ...
## Top 5 momentum scores: 50.88%, 42.24%, 39.96%, 37.02%, 29.12% ...
## Saved all momentum scores to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/momentum_scores.csv
##
## Analyzing momentum portfolio performance...
##
## ----- Momentum Portfolio Performance Metrics -----
## Metric Momentum.Portfolio S.P.500.Benchmark
## 1 Average Return 13.18% 9.04%
## 2 Standard Deviation 14.72% 16.18%
## 3 Sharpe Ratio 0.240 0.144
## 4 Upside-Potential Ratio 0.525 0.465
## Saved performance comparison to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/momentum_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/momentum_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/momentum_portfolio_returns.csv
##
## ----- Most Frequently Selected Assets -----
## all_selected
## ADOBE (NAS) NETFLIX UNITEDHEALTH GROUP
## 139 137 136
## COSTCO WHOLESALE APPLE DANAHER
## 135 133 133
## UNION PACIFIC SALESFORCE THERMO FISHER SCIENTIFIC
## 132 131 131
## ACCENTURE CLASS A
## 130
## Saved asset selection frequency to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/momentum_asset_selection_frequency.csv
##
## Analysis completed in 0.02 minutes
# ---- ADDITIONAL ANALYSIS ----
# 1. Plot the portfolio returns alongside the benchmark
portfolio_vs_benchmark <- merge(
Momentum = cumprod(1 + momentum_result$portfolio$returns) - 1,
Benchmark = cumprod(1 + momentum_result$data$sp500_returns[(36+1):length(momentum_result$data$sp500_returns)]) - 1
)
# Create a plot with different colors and a legend
plot(portfolio_vs_benchmark,
main = "Momentum 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, "momentum_portfolio_vs_benchmark.png")
png(output_file, width = 800, height = 500)
plot(portfolio_vs_benchmark,
main = "Momentum 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/momentum_portfolio_vs_benchmark.png
# 2. Calculate annual returns
annual_returns <- apply.yearly(momentum_result$portfolio$returns, Return.cumulative)
print(annual_returns)
## [,1]
## 2008-12-31 -0.38409577
## 2009-12-31 0.34457890
## 2010-12-31 0.20131138
## 2011-12-30 0.09319881
## 2012-12-31 0.20209548
## 2013-12-31 0.38559110
## 2014-12-31 0.13052739
## 2015-12-31 0.13211614
## 2016-12-30 0.08836382
## 2017-12-29 0.22573375
## 2018-12-31 0.05158242
## 2019-12-31 0.25945290
## 2020-12-31 0.24029191
## 2021-12-31 0.26586930
## 2022-12-30 -0.11713523
## 2023-12-29 0.16232314
## 2024-02-29 0.05943164
# 3. Monthly returns statistics
monthly_stats <- data.frame(
Statistic = c("Min", "1st Quartile", "Median", "Mean", "3rd Quartile", "Max", "Standard Deviation"),
Value = c(
min(momentum_result$portfolio$returns),
quantile(momentum_result$portfolio$returns, 0.25),
median(momentum_result$portfolio$returns),
mean(momentum_result$portfolio$returns),
quantile(momentum_result$portfolio$returns, 0.75),
max(momentum_result$portfolio$returns),
sd(momentum_result$portfolio$returns)
)
)
# Print monthly statistics
cat("\n----- Monthly Return Statistics -----\n")
##
## ----- Monthly Return Statistics -----
print(monthly_stats)
## Statistic Value
## 1 Min -0.14398432
## 2 1st Quartile -0.01112703
## 3 Median 0.01696985
## 4 Mean 0.01098095
## 5 3rd Quartile 0.03648318
## 6 Max 0.14508267
## 7 Standard Deviation 0.04248239
# Save statistics to CSV
output_file <- file.path(base_dir, "momentum_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/momentum_monthly_statistics.csv
# Save all output files in one directory for easy access
save(momentum_result, file = file.path(base_dir, "momentum_portfolio_results.RData"))
cat("All analysis results saved to:", file.path(base_dir, "momentum_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/momentum_portfolio_results.RData
# 4. Additional visualization: Histogram of returns
png(file.path(base_dir, "momentum_returns_histogram.png"), width = 800, height = 500)
hist(momentum_result$portfolio$returns,
breaks = 30,
main = "Momentum Portfolio Monthly Returns Distribution",
xlab = "Monthly Return",
col = "skyblue")
abline(v = mean(momentum_result$portfolio$returns), col = "red", lwd = 2)
dev.off()
## png
## 2
# 5. Drawdown analysis
drawdown_portfolio <- PerformanceAnalytics::Drawdowns(momentum_result$portfolio$returns)
drawdown_benchmark <- PerformanceAnalytics::Drawdowns(
momentum_result$data$sp500_returns[(36+1):length(momentum_result$data$sp500_returns)]
)
drawdowns <- merge(
Momentum = drawdown_portfolio,
Benchmark = drawdown_benchmark
)
png(file.path(base_dir, "momentum_drawdowns.png"), width = 800, height = 500)
plot(drawdowns,
main = "Drawdowns: Momentum Portfolio vs S&P 500",
col = c("blue", "red"),
lwd = c(2, 2),
legend.loc = "bottomleft")
dev.off()
## png
## 2
# 6. Count the average number of stocks in the portfolio
avg_stocks <- mean(sapply(momentum_result$portfolio$selected_assets, length))
cat("\nAverage number of stocks in the momentum portfolio:", round(avg_stocks, 2), "\n")
##
## Average number of stocks in the momentum portfolio: 30.68
# 7. Calculate the turnover rate
turnover <- numeric(length(momentum_result$portfolio$selected_assets) - 1)
for (i in 2:length(momentum_result$portfolio$selected_assets)) {
prev_stocks <- momentum_result$portfolio$selected_assets[[i-1]]
curr_stocks <- momentum_result$portfolio$selected_assets[[i]]
# Calculate how many stocks were changed
stocks_removed <- setdiff(prev_stocks, curr_stocks)
stocks_added <- setdiff(curr_stocks, prev_stocks)
# Turnover is the number of stocks changed divided by the average number of stocks
total_changed <- length(stocks_removed) + length(stocks_added)
avg_portfolio_size <- (length(prev_stocks) + length(curr_stocks)) / 2
if (avg_portfolio_size > 0) {
turnover[i-1] <- total_changed / (2 * avg_portfolio_size)
} else {
turnover[i-1] <- 0
}
}
cat("Average monthly turnover rate:", round(mean(turnover, na.rm = TRUE) * 100, 2), "%\n")
## Average monthly turnover rate: 25.49 %
# 8. Compare performance with the long-short Jensen's alpha portfolio (if available)
if (exists("long_short_result")) {
# Create a comparison of cumulative returns
combined_returns <- merge(
Momentum = cumprod(1 + momentum_result$portfolio$returns) - 1,
`Long-Short` = cumprod(1 + long_short_result$portfolio$returns) - 1,
Benchmark = cumprod(1 + momentum_result$data$sp500_returns[(36+1):length(momentum_result$data$sp500_returns)]) - 1
)
# Plot the comparison
png(file.path(base_dir, "momentum_vs_longshort_vs_benchmark.png"), width = 800, height = 500)
plot(combined_returns,
main = "Momentum vs Long-Short vs S&P 500",
col = c("blue", "green", "red"),
lwd = c(2, 2, 2),
legend.loc = "topleft")
dev.off()
# Compare performance metrics
if (exists("long_short_result$analysis$performance_table")) {
# Create a combined performance table
momentum_metrics <- momentum_result$analysis$performance_table
long_short_metrics <- long_short_result$analysis$performance_table
# Merge the tables (this assumes they have the same structure)
combined_metrics <- data.frame(
Metric = momentum_metrics$Metric,
`Momentum Portfolio` = momentum_metrics$`Momentum Portfolio`,
`Long-Short Portfolio` = long_short_metrics$`Long-Short Portfolio`,
`S&P 500 Benchmark` = momentum_metrics$`S&P 500 Benchmark`
)
cat("\n----- Comparative Performance Metrics -----\n")
print(combined_metrics)
# Save to CSV
output_file <- file.path(base_dir, "momentum_vs_longshort_performance.csv")
write.csv(combined_metrics, output_file, row.names = FALSE)
cat("Saved comparative performance metrics to:", output_file, "\n")
}
}
# Display a final message with key findings
cat("\n===== MOMENTUM PORTFOLIO ANALYSIS SUMMARY =====\n")
##
## ===== MOMENTUM PORTFOLIO ANALYSIS SUMMARY =====
cat("Portfolio Strategy: Long positions in stocks with positive returns over the past 3 months\n")
## Portfolio Strategy: Long positions in stocks with positive returns over the past 3 months
cat("Rebalancing: Monthly, based on 3-month lookback period\n")
## Rebalancing: Monthly, based on 3-month lookback period
cat("Equal weighting across all selected assets\n\n")
## Equal weighting across all selected assets
# 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.