# Complete Portfolio Construction with Lowest Beta Selection and Performance Table
# This script creates an equally weighted portfolio of the 10 assets
# with the lowest beta, 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 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_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
beta_df <- 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
# Store selected assets for this period
selected_assets[[i]] <- beta_df$asset
# If fewer than top_n assets available, use all available
selected_idx <- match(beta_df$asset, asset_names)
if (length(selected_idx) > 0) {
# Calculate portfolio return for the next month (equal weighting)
weights <- rep(1/length(selected_idx), length(selected_idx))
next_month_returns <- as.numeric(asset_returns[end_idx + 1, selected_idx])
next_month_return <- sum(weights * next_month_returns, na.rm = TRUE)
portfolio_returns[i] <- next_month_return
} else {
# If no assets with valid beta, return 0 (cash position)
portfolio_returns[i] <- 0
}
# 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$asset) > 0) {
cat("Selected assets:", paste(head(beta_df$asset, 5), collapse=", "),
ifelse(length(beta_df$asset) > 5, "...", ""), "\n")
cat("Beta range:", sprintf("%.3f", min(beta_df$beta)), "to",
sprintf("%.3f", max(beta_df$beta)), "\n")
} else {
cat("No assets with valid beta 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.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_assets = selected_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.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_assets)) {
assets <- portfolio_result$selected_assets[[i]]
composition[i, "Assets"] <- paste(assets, collapse = ", ")
}
# Save portfolio composition to CSV
output_file <- file.path(base_dir, "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, "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, "asset_selection_frequency.csv")
write.csv(selection_freq_df, output_file, row.names = FALSE)
cat("Saved 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", "Equally Weighted\nLow Beta 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.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("Average Portfolio Beta:", sprintf("%.4f", portfolio_beta), "\n")
return(list(
cumulative_returns = cumulative_returns,
performance_table = performance_table,
composition = composition,
selection_frequency = selection_freq_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 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 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 09:56:02.660493
## 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 portfolio...
## Starting portfolio construction with 194 rebalancing periods
## Processing period 1 of 194 - Date: 2008-01-31
## Selected assets: ABBOTT LABORATORIES, UNITEDHEALTH GROUP, PEPSICO, MEDTRONIC, WALMART ...
## Beta range: -0.133 to 0.543
## Processing period 5 of 194 - Date: 2008-05-30
## Selected assets: ABBOTT LABORATORIES, WALMART, PEPSICO, MEDTRONIC, BANK OF AMERICA ...
## Beta range: -0.098 to 0.519
## Processing period 10 of 194 - Date: 2008-10-31
## Selected assets: WELLS FARGO & CO, WALMART, ABBOTT LABORATORIES, PEPSICO, MEDTRONIC ...
## Beta range: -0.135 to 0.428
## Processing period 15 of 194 - Date: 2009-03-31
## Selected assets: WALMART, AMGEN, ABBOTT LABORATORIES, HOME DEPOT, EXXON MOBIL ...
## Beta range: 0.263 to 0.670
## Processing period 20 of 194 - Date: 2009-08-31
## Selected assets: ABBOTT LABORATORIES, WALMART, EXXON MOBIL, AMGEN, GILEAD SCIENCES ...
## Beta range: 0.195 to 0.609
## Processing period 25 of 194 - Date: 2010-01-29
## Selected assets: WALMART, ABBOTT LABORATORIES, EXXON MOBIL, AMGEN, GILEAD SCIENCES ...
## Beta range: 0.258 to 0.590
## Processing period 30 of 194 - Date: 2010-06-30
## Selected assets: ABBOTT LABORATORIES, WALMART, GILEAD SCIENCES, EXXON MOBIL, AMGEN ...
## Beta range: 0.260 to 0.591
## Processing period 35 of 194 - Date: 2010-11-30
## Selected assets: ABBOTT LABORATORIES, WALMART, GILEAD SCIENCES, EXXON MOBIL, AMGEN ...
## Beta range: 0.265 to 0.573
## Processing period 40 of 194 - Date: 2011-04-29
## Selected assets: ABBOTT LABORATORIES, WALMART, NETFLIX, GILEAD SCIENCES, MCDONALDS ...
## Beta range: 0.292 to 0.517
## Processing period 45 of 194 - Date: 2011-09-30
## Selected assets: ABBOTT LABORATORIES, MCDONALDS, WALMART, GILEAD SCIENCES, NETFLIX ...
## Beta range: 0.283 to 0.515
## Processing period 50 of 194 - Date: 2012-02-29
## Selected assets: MCDONALDS, AMERICAN TOWER, WALMART, PEPSICO, ABBOTT LABORATORIES ...
## Beta range: 0.305 to 0.450
## Processing period 55 of 194 - Date: 2012-07-31
## Selected assets: MCDONALDS, BRISTOL MYERS SQUIBB, AMERICAN TOWER, PROCTER & GAMBLE, PEPSICO ...
## Beta range: 0.244 to 0.421
## Processing period 60 of 194 - Date: 2012-12-31
## Selected assets: BRISTOL MYERS SQUIBB, AMERICAN TOWER, PROCTER & GAMBLE, MERCK & COMPANY, MCDONALDS ...
## Beta range: 0.104 to 0.386
## Processing period 65 of 194 - Date: 2013-05-31
## Selected assets: BRISTOL MYERS SQUIBB, AMERICAN TOWER, PROCTER & GAMBLE, MCDONALDS, PEPSICO ...
## Beta range: 0.124 to 0.394
## Processing period 70 of 194 - Date: 2013-10-31
## Selected assets: VERIZON COMMUNICATIONS, AMERICAN TOWER, BRISTOL MYERS SQUIBB, COCA COLA, WALMART ...
## Beta range: 0.100 to 0.373
## Processing period 75 of 194 - Date: 2014-03-31
## Selected assets: VERIZON COMMUNICATIONS, AMERICAN TOWER, AT&T, NEXTERA ENERGY, ELI LILLY ...
## Beta range: 0.019 to 0.379
## Processing period 80 of 194 - Date: 2014-08-29
## Selected assets: VERIZON COMMUNICATIONS, AMERICAN TOWER, AT&T, AMGEN, PEPSICO ...
## Beta range: -0.024 to 0.346
## Processing period 85 of 194 - Date: 2015-01-30
## Selected assets: VERIZON COMMUNICATIONS, AT&T, WALMART, UNION PACIFIC, AMERICAN TOWER ...
## Beta range: 0.113 to 0.501
## Processing period 90 of 194 - Date: 2015-06-30
## Selected assets: NEXTERA ENERGY, ELI LILLY, MERCK & COMPANY, NIKE 'B', AMERICAN TOWER ...
## Beta range: 0.380 to 0.652
## Processing period 95 of 194 - Date: 2015-11-30
## Selected assets: ELI LILLY, AT&T, WALMART, NIKE 'B', NEXTERA ENERGY ...
## Beta range: 0.187 to 0.744
## Processing period 100 of 194 - Date: 2016-04-29
## Selected assets: ELI LILLY, WALMART, AT&T, NEXTERA ENERGY, VERIZON COMMUNICATIONS ...
## Beta range: 0.183 to 0.645
## Processing period 105 of 194 - Date: 2016-09-30
## Selected assets: ELI LILLY, WALMART, NEXTERA ENERGY, AT&T, VERIZON COMMUNICATIONS ...
## Beta range: 0.071 to 0.632
## Processing period 110 of 194 - Date: 2017-02-28
## Selected assets: WALMART, ELI LILLY, NEXTERA ENERGY, AT&T, NIKE 'B' ...
## Beta range: -0.025 to 0.621
## Processing period 115 of 194 - Date: 2017-07-31
## Selected assets: WALMART, ELI LILLY, NEXTERA ENERGY, NIKE 'B', AT&T ...
## Beta range: 0.071 to 0.631
## Processing period 120 of 194 - Date: 2017-12-29
## Selected assets: ELI LILLY, WALMART, NEXTERA ENERGY, PROCTER & GAMBLE, AT&T ...
## Beta range: 0.108 to 0.618
## Processing period 125 of 194 - Date: 2018-05-31
## Selected assets: ELI LILLY, NEXTERA ENERGY, AT&T, PROCTER & GAMBLE, WALMART ...
## Beta range: 0.245 to 0.654
## Processing period 130 of 194 - Date: 2018-10-31
## Selected assets: NEXTERA ENERGY, WALMART, PROCTER & GAMBLE, AT&T, ELI LILLY ...
## Beta range: -0.029 to 0.674
## Processing period 135 of 194 - Date: 2019-03-29
## Selected assets: NEXTERA ENERGY, PROCTER & GAMBLE, AMERICAN TOWER, COCA COLA, MCDONALDS ...
## Beta range: 0.201 to 0.495
## Processing period 140 of 194 - Date: 2019-08-30
## Selected assets: AMERICAN TOWER, NEXTERA ENERGY, ELI LILLY, COCA COLA, PROCTER & GAMBLE ...
## Beta range: 0.054 to 0.520
## Processing period 145 of 194 - Date: 2020-01-31
## Selected assets: AMERICAN TOWER, NEXTERA ENERGY, MCDONALDS, ELI LILLY, MERCK & COMPANY ...
## Beta range: 0.066 to 0.427
## Processing period 150 of 194 - Date: 2020-06-30
## Selected assets: NEXTERA ENERGY, ELI LILLY, AMERICAN TOWER, MERCK & COMPANY, PROCTER & GAMBLE ...
## Beta range: 0.219 to 0.583
## Processing period 155 of 194 - Date: 2020-11-30
## Selected assets: ELI LILLY, NEXTERA ENERGY, AMERICAN TOWER, MERCK & COMPANY, VERIZON COMMUNICATIONS ...
## Beta range: 0.216 to 0.588
## Processing period 160 of 194 - Date: 2021-04-30
## Selected assets: NEXTERA ENERGY, AMERICAN TOWER, ELI LILLY, GILEAD SCIENCES, WALMART ...
## Beta range: 0.198 to 0.584
## Processing period 165 of 194 - Date: 2021-09-30
## Selected assets: ELI LILLY, NEXTERA ENERGY, AMERICAN TOWER, GILEAD SCIENCES, WALMART ...
## Beta range: 0.181 to 0.570
## Processing period 170 of 194 - Date: 2022-02-28
## Selected assets: GILEAD SCIENCES, ELI LILLY, VERIZON COMMUNICATIONS, NEXTERA ENERGY, AMERICAN TOWER ...
## Beta range: 0.038 to 0.565
## Processing period 175 of 194 - Date: 2022-07-29
## Selected assets: GILEAD SCIENCES, VERIZON COMMUNICATIONS, MERCK & COMPANY, PROCTER & GAMBLE, ELI LILLY ...
## Beta range: 0.049 to 0.529
## Processing period 180 of 194 - Date: 2022-12-30
## Selected assets: GILEAD SCIENCES, VERIZON COMMUNICATIONS, BRISTOL MYERS SQUIBB, ELI LILLY, MERCK & COMPANY ...
## Beta range: 0.193 to 0.589
## Processing period 185 of 194 - Date: 2023-05-31
## Selected assets: BRISTOL MYERS SQUIBB, LOCKHEED MARTIN, GILEAD SCIENCES, JOHNSON & JOHNSON, VERIZON COMMUNICATIONS ...
## Beta range: 0.312 to 0.481
## Processing period 190 of 194 - Date: 2023-10-31
## Selected assets: BRISTOL MYERS SQUIBB, VERIZON COMMUNICATIONS, LOCKHEED MARTIN, JOHNSON & JOHNSON, PROCTER & GAMBLE ...
## Beta range: 0.306 to 0.536
## Processing period 194 of 194 - Date: 2024-02-29
## Selected assets: BRISTOL MYERS SQUIBB, LOCKHEED MARTIN, MERCK & COMPANY, VERIZON COMMUNICATIONS, JOHNSON & JOHNSON ...
## Beta range: 0.243 to 0.450
## 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.csv
##
## Analyzing portfolio performance...
##
## ----- Portfolio Performance Metrics -----
## Metric Portfolio Benchmark
## 1 Average Return 8.78% 9.04%
## 2 Standard Deviation 13.11% 16.18%
## 3 Sharpe Ratio 0.172 0.144
## 4 Upside-Potential Ratio 0.465 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.csv
## Saved portfolio composition to: C:/Users/lcyep/OneDrive - Instituto Tecnologico y de Estudios Superiores de Monterrey/Tec/Semestre 6/Risk/R, project/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/portfolio_returns.csv
##
## ----- Most Frequently Selected Assets -----
## all_selected
## 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
## Saved 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.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.png
##
## ----- Portfolio Beta Analysis -----
## Average Portfolio Beta: 0.5912
##
## Analysis completed in 0.03 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 = "Low 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.png")
png(output_file, width = 800, height = 500)
plot(portfolio_vs_benchmark,
main = "Low 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.png
# 2. Calculate annual returns
annual_returns <- apply.yearly(result$portfolio$returns, Return.cumulative)
print(annual_returns)
## [,1]
## 2008-12-31 -0.23372107
## 2009-12-31 -0.00171504
## 2010-12-31 0.17070522
## 2011-12-30 0.07110172
## 2012-12-31 0.20829687
## 2013-12-31 0.19039490
## 2014-12-31 0.10057472
## 2015-12-31 0.03848288
## 2016-12-30 0.10704059
## 2017-12-29 0.18751839
## 2018-12-31 0.06778675
## 2019-12-31 0.26541173
## 2020-12-31 0.01254749
## 2021-12-31 0.18395926
## 2022-12-30 0.04653957
## 2023-12-29 -0.01651340
## 2024-02-29 0.03751627
# 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.126699023
## 2 1st Quartile -0.013338572
## 3 Median 0.007890293
## 4 Mean 0.007317913
## 5 3rd Quartile 0.030988171
## 6 Max 0.131799811
## 7 Standard Deviation 0.037839451
# Save statistics to CSV
output_file <- file.path(base_dir, "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/monthly_statistics.csv