1 Introduction and Setup

1.1 Executive Summary

This memo presents our analysis and recommendations for capital allocation between stocks and bonds using Modern Portfolio Theory (MPT). We analyze historical data from January 1997 to September 2024 to construct optimal portfolios and evaluate their performance across different market conditions, including three significant recessions.

1.2 Load Required Packages

# Install packages if not already installed
required_packages <- c(
  "quantmod",      # For downloading financial data from Yahoo Finance

  "PerformanceAnalytics",  # For portfolio analytics
  "tidyverse",     # For data manipulation and visualization
  "xts",           # For time series objects
  "zoo",           # For time series manipulation
  "knitr",         # For nice tables
  "kableExtra",    # For enhanced tables
  "scales",        # For formatting
  "gridExtra",     # For arranging multiple plots
  "quadprog"       # For quadratic programming (optimization)
)

# Install missing packages
new_packages <- required_packages[!(required_packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages)

# Load all packages
lapply(required_packages, library, character.only = TRUE)
## [[1]]
##  [1] "quantmod"  "TTR"       "xts"       "zoo"       "stats"     "graphics" 
##  [7] "grDevices" "datasets"  "utils"     "methods"   "base"     
## 
## [[2]]
##  [1] "PerformanceAnalytics" "quantmod"             "TTR"                 
##  [4] "xts"                  "zoo"                  "stats"               
##  [7] "graphics"             "grDevices"            "datasets"            
## [10] "utils"                "methods"              "base"                
## 
## [[3]]
##  [1] "lubridate"            "forcats"              "stringr"             
##  [4] "dplyr"                "purrr"                "readr"               
##  [7] "tidyr"                "tibble"               "ggplot2"             
## [10] "tidyverse"            "PerformanceAnalytics" "quantmod"            
## [13] "TTR"                  "xts"                  "zoo"                 
## [16] "stats"                "graphics"             "grDevices"           
## [19] "datasets"             "utils"                "methods"             
## [22] "base"                
## 
## [[4]]
##  [1] "lubridate"            "forcats"              "stringr"             
##  [4] "dplyr"                "purrr"                "readr"               
##  [7] "tidyr"                "tibble"               "ggplot2"             
## [10] "tidyverse"            "PerformanceAnalytics" "quantmod"            
## [13] "TTR"                  "xts"                  "zoo"                 
## [16] "stats"                "graphics"             "grDevices"           
## [19] "datasets"             "utils"                "methods"             
## [22] "base"                
## 
## [[5]]
##  [1] "lubridate"            "forcats"              "stringr"             
##  [4] "dplyr"                "purrr"                "readr"               
##  [7] "tidyr"                "tibble"               "ggplot2"             
## [10] "tidyverse"            "PerformanceAnalytics" "quantmod"            
## [13] "TTR"                  "xts"                  "zoo"                 
## [16] "stats"                "graphics"             "grDevices"           
## [19] "datasets"             "utils"                "methods"             
## [22] "base"                
## 
## [[6]]
##  [1] "knitr"                "lubridate"            "forcats"             
##  [4] "stringr"              "dplyr"                "purrr"               
##  [7] "readr"                "tidyr"                "tibble"              
## [10] "ggplot2"              "tidyverse"            "PerformanceAnalytics"
## [13] "quantmod"             "TTR"                  "xts"                 
## [16] "zoo"                  "stats"                "graphics"            
## [19] "grDevices"            "datasets"             "utils"               
## [22] "methods"              "base"                
## 
## [[7]]
##  [1] "kableExtra"           "knitr"                "lubridate"           
##  [4] "forcats"              "stringr"              "dplyr"               
##  [7] "purrr"                "readr"                "tidyr"               
## [10] "tibble"               "ggplot2"              "tidyverse"           
## [13] "PerformanceAnalytics" "quantmod"             "TTR"                 
## [16] "xts"                  "zoo"                  "stats"               
## [19] "graphics"             "grDevices"            "datasets"            
## [22] "utils"                "methods"              "base"                
## 
## [[8]]
##  [1] "scales"               "kableExtra"           "knitr"               
##  [4] "lubridate"            "forcats"              "stringr"             
##  [7] "dplyr"                "purrr"                "readr"               
## [10] "tidyr"                "tibble"               "ggplot2"             
## [13] "tidyverse"            "PerformanceAnalytics" "quantmod"            
## [16] "TTR"                  "xts"                  "zoo"                 
## [19] "stats"                "graphics"             "grDevices"           
## [22] "datasets"             "utils"                "methods"             
## [25] "base"                
## 
## [[9]]
##  [1] "gridExtra"            "scales"               "kableExtra"          
##  [4] "knitr"                "lubridate"            "forcats"             
##  [7] "stringr"              "dplyr"                "purrr"               
## [10] "readr"                "tidyr"                "tibble"              
## [13] "ggplot2"              "tidyverse"            "PerformanceAnalytics"
## [16] "quantmod"             "TTR"                  "xts"                 
## [19] "zoo"                  "stats"                "graphics"            
## [22] "grDevices"            "datasets"             "utils"               
## [25] "methods"              "base"                
## 
## [[10]]
##  [1] "quadprog"             "gridExtra"            "scales"              
##  [4] "kableExtra"           "knitr"                "lubridate"           
##  [7] "forcats"              "stringr"              "dplyr"               
## [10] "purrr"                "readr"                "tidyr"               
## [13] "tibble"               "ggplot2"              "tidyverse"           
## [16] "PerformanceAnalytics" "quantmod"             "TTR"                 
## [19] "xts"                  "zoo"                  "stats"               
## [22] "graphics"             "grDevices"            "datasets"            
## [25] "utils"                "methods"              "base"

1.3 Download Data from Yahoo Finance

We use SPY (SPDR S&P 500 ETF) as a proxy for stock returns and VUSTX (Vanguard Long-Term Treasury Fund) as a proxy for bond returns.

1.4 Convert to Weekly Data and Calculate Returns

# Extract adjusted closing prices (accounts for dividends and splits)
spy_prices <- Ad(SPY)
vustx_prices <- Ad(VUSTX)

# Convert daily prices to weekly prices (using last observation of each week)
spy_weekly <- to.weekly(spy_prices, OHLC = FALSE)
vustx_weekly <- to.weekly(vustx_prices, OHLC = FALSE)

# Calculate weekly returns (net returns, not log returns)
# Return = (P_t - P_{t-1}) / P_{t-1}
spy_returns <- Return.calculate(spy_weekly, method = "discrete")
vustx_returns <- Return.calculate(vustx_weekly, method = "discrete")

# Remove the first NA observation
spy_returns <- spy_returns[-1]
vustx_returns <- vustx_returns[-1]

# Rename columns for clarity
colnames(spy_returns) <- "Stocks"
colnames(vustx_returns) <- "Bonds"

# Merge into a single dataset (this also aligns dates)
returns_data <- merge(spy_returns, vustx_returns)

# Remove any rows with NA values
returns_data <- na.omit(returns_data)

# Display first few rows
head(returns_data, 10)
##                 Stocks        Bonds
## 1997-01-10  0.01373348 -0.011157102
## 1997-01-17  0.01888302  0.004103092
## 1997-01-24 -0.01047537 -0.005107650
## 1997-01-31  0.02157961  0.015998780
## 1997-02-07  0.01036289  0.008130565
## 1997-02-14  0.02485212  0.012096310
## 1997-02-21 -0.01000672 -0.007968435
## 1997-02-28 -0.01516375 -0.013123007
## 1997-03-07  0.02131807 -0.002044667
## 1997-03-14 -0.01430261 -0.012293220

2 Question 1: Compare Stock and Bond Returns

2.1 Descriptive Statistics

Let’s calculate and compare the key statistics for stock and bond returns.

# Function to calculate comprehensive statistics
calc_stats <- function(x) {
  c(
    "Mean (Weekly)" = mean(x, na.rm = TRUE),
    "Mean (Annualized)" = mean(x, na.rm = TRUE) * 52,
    "Std Dev (Weekly)" = sd(x, na.rm = TRUE),
    "Std Dev (Annualized)" = sd(x, na.rm = TRUE) * sqrt(52),
    "Min" = min(x, na.rm = TRUE),
    "Max" = max(x, na.rm = TRUE),
    "Skewness" = skewness(x, na.rm = TRUE),
    "Kurtosis" = kurtosis(x, na.rm = TRUE),
    "Sharpe Ratio (rf=0)" = mean(x, na.rm = TRUE) / sd(x, na.rm = TRUE) * sqrt(52)
  )
}

# Calculate statistics for both assets
stats_stocks <- calc_stats(returns_data$Stocks)
stats_bonds <- calc_stats(returns_data$Bonds)

# Create comparison table
stats_table <- data.frame(
  Statistic = names(stats_stocks),
  Stocks = round(stats_stocks, 4),
  Bonds = round(stats_bonds, 4)
)

# Display nicely formatted table
kable(stats_table, 
      caption = "Comparison of Stock and Bond Returns (1997-2024)",
      row.names = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE) %>%
  row_spec(c(2, 4, 9), bold = TRUE, background = "#f0f8ff")
Comparison of Stock and Bond Returns (1997-2024)
Statistic Stocks Bonds
Mean (Weekly) 0.0021 0.0014
Mean (Annualized) 0.1066 0.0712
Std Dev (Weekly) 0.0248 0.0165
Std Dev (Annualized) 0.1790 0.1192
Min -0.1979 -0.0699
Max 0.1329 0.0859
Skewness -0.5549 -0.0368
Kurtosis 6.1185 1.8301
Sharpe Ratio (rf=0) 0.5958 0.5974

2.1.1 Interpretation of Descriptive Statistics

# Calculate key metrics for interpretation
stock_annual_return <- mean(returns_data$Stocks) * 52 * 100
bond_annual_return <- mean(returns_data$Bonds) * 52 * 100
stock_annual_vol <- sd(returns_data$Stocks) * sqrt(52) * 100
bond_annual_vol <- sd(returns_data$Bonds) * sqrt(52) * 100

cat("KEY FINDINGS:\n")
## KEY FINDINGS:
cat("=============\n\n")
## =============
cat("1. AVERAGE RETURNS:\n")
## 1. AVERAGE RETURNS:
cat(sprintf("   - Stocks: %.2f%% per year\n", stock_annual_return))
##    - Stocks: 10.66% per year
cat(sprintf("   - Bonds: %.2f%% per year\n", bond_annual_return))
##    - Bonds: 7.12% per year
cat(sprintf("   - Stocks earned %.2f percentage points more per year\n\n", 
            stock_annual_return - bond_annual_return))
##    - Stocks earned 3.54 percentage points more per year
cat("2. VOLATILITY (RISK):\n")
## 2. VOLATILITY (RISK):
cat(sprintf("   - Stocks: %.2f%% per year\n", stock_annual_vol))
##    - Stocks: 17.90% per year
cat(sprintf("   - Bonds: %.2f%% per year\n", bond_annual_vol))
##    - Bonds: 11.92% per year
cat(sprintf("   - Stocks are %.1fx more volatile than bonds\n\n", 
            stock_annual_vol / bond_annual_vol))
##    - Stocks are 1.5x more volatile than bonds
cat("3. RISK-ADJUSTED RETURNS (Sharpe Ratio):\n")
## 3. RISK-ADJUSTED RETURNS (Sharpe Ratio):
cat(sprintf("   - Stocks: %.3f\n", stats_stocks["Sharpe Ratio (rf=0)"]))
##    - Stocks: 0.596
cat(sprintf("   - Bonds: %.3f\n", stats_bonds["Sharpe Ratio (rf=0)"]))
##    - Bonds: 0.597

2.2 Time Series Visualization

2.2.1 Plot 1: Returns Over Time

# Convert to data frame for ggplot
returns_df <- data.frame(
  Date = index(returns_data),
  Stocks = as.numeric(returns_data$Stocks),
  Bonds = as.numeric(returns_data$Bonds)
)

# Reshape to long format
returns_long <- returns_df %>%
  pivot_longer(cols = c(Stocks, Bonds), 
               names_to = "Asset", 
               values_to = "Return")

# Plot returns time series
p1 <- ggplot(returns_long, aes(x = Date, y = Return, color = Asset)) +
  geom_line(alpha = 0.7, size = 0.3) +
  facet_wrap(~Asset, ncol = 1, scales = "free_y") +
  scale_y_continuous(labels = percent_format()) +
  scale_color_manual(values = c("Bonds" = "#2E86AB", "Stocks" = "#A23B72")) +
  labs(
    title = "Weekly Returns: Stocks vs Bonds (1997-2024)",
    subtitle = "Notice the higher volatility in stock returns",
    x = "Date",
    y = "Weekly Return"
  ) +
  theme_minimal() +
  theme(
    legend.position = "none",
    strip.text = element_text(size = 12, face = "bold")
  ) +
  # Add recession shading
  annotate("rect", xmin = as.Date("2001-03-01"), xmax = as.Date("2001-11-30"),
           ymin = -Inf, ymax = Inf, alpha = 0.2, fill = "red") +
  annotate("rect", xmin = as.Date("2007-12-01"), xmax = as.Date("2009-06-30"),
           ymin = -Inf, ymax = Inf, alpha = 0.2, fill = "red") +
  annotate("rect", xmin = as.Date("2020-02-01"), xmax = as.Date("2020-04-30"),
           ymin = -Inf, ymax = Inf, alpha = 0.2, fill = "red")

print(p1)

2.2.2 Plot 2: Distribution of Returns

# Histogram comparison
p2 <- ggplot(returns_long, aes(x = Return, fill = Asset)) +
  geom_histogram(bins = 50, alpha = 0.6, position = "identity") +
  geom_vline(xintercept = 0, linetype = "dashed", color = "black") +
  scale_x_continuous(labels = percent_format(), limits = c(-0.15, 0.15)) +
  scale_fill_manual(values = c("Bonds" = "#2E86AB", "Stocks" = "#A23B72")) +
  labs(
    title = "Distribution of Weekly Returns",
    subtitle = "Stocks show wider distribution (higher volatility)",
    x = "Weekly Return",
    y = "Frequency"
  ) +
  theme_minimal() +
  theme(legend.position = "top")

print(p2)

2.2.3 Plot 3: Cumulative Returns (Growth of $1)

# Calculate cumulative returns (growth of $1)
cumulative_returns <- data.frame(
  Date = index(returns_data),
  Stocks = cumprod(1 + as.numeric(returns_data$Stocks)),
  Bonds = cumprod(1 + as.numeric(returns_data$Bonds))
)

cumulative_long <- cumulative_returns %>%
  pivot_longer(cols = c(Stocks, Bonds), 
               names_to = "Asset", 
               values_to = "Value")

p3 <- ggplot(cumulative_long, aes(x = Date, y = Value, color = Asset)) +
  geom_line(size = 1) +
  scale_y_continuous(labels = dollar_format()) +
  scale_color_manual(values = c("Bonds" = "#2E86AB", "Stocks" = "#A23B72")) +
  labs(
    title = "Growth of $1 Investment (1997-2024)",
    subtitle = "Stocks provide higher long-term growth but with more volatility",
    x = "Date",
    y = "Portfolio Value ($)"
  ) +
  theme_minimal() +
  theme(legend.position = "top") +
  # Add recession shading
  annotate("rect", xmin = as.Date("2001-03-01"), xmax = as.Date("2001-11-30"),
           ymin = -Inf, ymax = Inf, alpha = 0.2, fill = "gray") +
  annotate("rect", xmin = as.Date("2007-12-01"), xmax = as.Date("2009-06-30"),
           ymin = -Inf, ymax = Inf, alpha = 0.2, fill = "gray") +
  annotate("rect", xmin = as.Date("2020-02-01"), xmax = as.Date("2020-04-30"),
           ymin = -Inf, ymax = Inf, alpha = 0.2, fill = "gray")

print(p3)

# Print final values
cat("\nGrowth of $1 invested in January 1997:\n")
## 
## Growth of $1 invested in January 1997:
cat(sprintf("  Stocks: $%.2f\n", tail(cumulative_returns$Stocks, 1)))
##   Stocks: $12.37
cat(sprintf("  Bonds: $%.2f\n", tail(cumulative_returns$Bonds, 1)))
##   Bonds: $5.95

2.2.4 Plot 4: Rolling Volatility Comparison

# Calculate 52-week rolling standard deviation
rolling_vol <- data.frame(
  Date = index(returns_data),
  Stocks = rollapply(as.numeric(returns_data$Stocks), width = 52, 
                     FUN = sd, fill = NA, align = "right") * sqrt(52),
  Bonds = rollapply(as.numeric(returns_data$Bonds), width = 52, 
                    FUN = sd, fill = NA, align = "right") * sqrt(52)
)

rolling_vol_long <- rolling_vol %>%
  pivot_longer(cols = c(Stocks, Bonds), 
               names_to = "Asset", 
               values_to = "Volatility")

p4 <- ggplot(rolling_vol_long, aes(x = Date, y = Volatility, color = Asset)) +
  geom_line(size = 0.8) +
  scale_y_continuous(labels = percent_format()) +
  scale_color_manual(values = c("Bonds" = "#2E86AB", "Stocks" = "#A23B72")) +
  labs(
    title = "52-Week Rolling Volatility (Annualized)",
    subtitle = "Volatility spikes during market stress periods",
    x = "Date",
    y = "Annualized Volatility"
  ) +
  theme_minimal() +
  theme(legend.position = "top")

print(p4)


3 Question 2: The Main Idea Behind Modern Portfolio Theory

3.1 Conceptual Explanation

Modern Portfolio Theory (MPT), developed by Harry Markowitz in 1952, is based on a fundamental insight: investors should focus on the risk and return of their entire portfolio, not individual assets.

3.1.1 The Key Principles:

  1. Risk is measured by variance (or standard deviation) of returns
  2. Investors are risk-averse: they prefer less risk for the same return
  3. Diversification reduces risk: combining assets that don’t move perfectly together can reduce portfolio volatility without necessarily reducing expected returns

3.1.2 The Mathematical Foundation

For a two-asset portfolio with weights \(w_1\) and \(w_2\) (where \(w_1 + w_2 = 1\)):

Expected Return: \[E(R_p) = w_1 \cdot E(R_1) + w_2 \cdot E(R_2)\]

Portfolio Variance: \[\sigma_p^2 = w_1^2 \sigma_1^2 + w_2^2 \sigma_2^2 + 2 w_1 w_2 \sigma_1 \sigma_2 \rho_{12}\]

Where \(\rho_{12}\) is the correlation between the two assets.

3.1.3 The Diversification Benefit

The magic happens in the last term. When correlation (\(\rho\)) is less than 1:

  • The portfolio’s risk is less than the weighted average of individual risks
  • This is the “free lunch” of diversification

3.2 Demonstrating Diversification with Our Data

# Calculate correlation between stocks and bonds
correlation <- cor(returns_data$Stocks, returns_data$Bonds)

cat("CORRELATION ANALYSIS\n")
## CORRELATION ANALYSIS
cat("====================\n")
## ====================
cat(sprintf("Correlation between Stocks and Bonds: %.4f\n\n", correlation))
## Correlation between Stocks and Bonds: -0.1764
if(correlation < 0) {
  cat("The correlation is NEGATIVE, which means:\n")
  cat("- When stocks go up, bonds tend to go down (and vice versa)\n")
  cat("- This provides excellent diversification benefits!\n")
} else if(correlation < 0.5) {
  cat("The correlation is LOW POSITIVE, which means:\n")
  cat("- Stocks and bonds have weak positive relationship\n")
  cat("- Good diversification benefits are available\n")
} else {
  cat("The correlation is HIGH POSITIVE, which means:\n")
  cat("- Stocks and bonds tend to move together\n")
  cat("- Diversification benefits are limited\n")
}
## The correlation is NEGATIVE, which means:
## - When stocks go up, bonds tend to go down (and vice versa)
## - This provides excellent diversification benefits!

3.2.1 Visualizing the Efficient Frontier

# Extract return vectors
r_stocks <- as.numeric(returns_data$Stocks)
r_bonds <- as.numeric(returns_data$Bonds)

# Calculate annualized parameters
mu_stocks <- mean(r_stocks) * 52
mu_bonds <- mean(r_bonds) * 52
sigma_stocks <- sd(r_stocks) * sqrt(52)
sigma_bonds <- sd(r_bonds) * sqrt(52)
rho <- cor(r_stocks, r_bonds)

# Create portfolio weights
weights <- seq(0, 1, by = 0.01)

# Calculate portfolio return and risk
portfolio_stats <- data.frame(
  w_stocks = weights,
  w_bonds = 1 - weights,
  return = weights * mu_stocks + (1 - weights) * mu_bonds,
  risk = sqrt(
    weights^2 * sigma_stocks^2 + 
    (1 - weights)^2 * sigma_bonds^2 + 
    2 * weights * (1 - weights) * sigma_stocks * sigma_bonds * rho
  )
)

# Find minimum variance portfolio
min_var_idx <- which.min(portfolio_stats$risk)
min_var_portfolio <- portfolio_stats[min_var_idx, ]

# Separate efficient vs inefficient portions
efficient_frontier <- portfolio_stats[min_var_idx:nrow(portfolio_stats), ]
inefficient_frontier <- portfolio_stats[1:min_var_idx, ]

# Plot
p_frontier <- ggplot() +
  geom_path(data = inefficient_frontier, aes(x = risk, y = return),
            color = "gray60", linewidth = 1, linetype = "dashed") +
  geom_path(data = efficient_frontier, aes(x = risk, y = return),
            color = "#2E86AB", linewidth = 1.5) +
  geom_point(aes(x = sigma_stocks, y = mu_stocks), color = "#A23B72", size = 4) +
  geom_point(aes(x = sigma_bonds, y = mu_bonds), color = "#2E86AB", size = 4) +
  geom_point(aes(x = min_var_portfolio$risk, y = min_var_portfolio$return), 
             color = "#F18F01", size = 4) +
  annotate("text", x = sigma_stocks + 0.005, y = mu_stocks, label = "100% Stocks", hjust = 0) +
  annotate("text", x = sigma_bonds + 0.005, y = mu_bonds - 0.005, label = "100% Bonds", hjust = 0) +
  annotate("text", x = min_var_portfolio$risk - 0.005, y = min_var_portfolio$return + 0.003,
           label = "Min Variance", hjust = 1, color = "#F18F01", fontface = "bold") +
  scale_x_continuous(labels = scales::percent_format()) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(title = "The Efficient Frontier: Stocks and Bonds",
       subtitle = "Solid = efficient | Dashed = inefficient",
       x = "Portfolio Risk (Annualized Standard Deviation)",
       y = "Portfolio Expected Return (Annualized)") +
  theme_minimal()

print(p_frontier)

cat("\nMinimum Variance Portfolio:\n")
## 
## Minimum Variance Portfolio:
cat(sprintf("  Weight in Stocks: %.1f%%\n", min_var_portfolio$w_stocks * 100))
##   Weight in Stocks: 33.0%
cat(sprintf("  Weight in Bonds: %.1f%%\n", min_var_portfolio$w_bonds * 100))
##   Weight in Bonds: 67.0%
cat(sprintf("  Expected Return: %.2f%%\n", min_var_portfolio$return * 100))
##   Expected Return: 8.29%
cat(sprintf("  Risk (Std Dev): %.2f%%\n", min_var_portfolio$risk * 100))
##   Risk (Std Dev): 9.06%

4 Question 3: Is There Scope for Applying MPT?

4.1 Analysis for a Risk-Averse Client

cat("ASSESSMENT: Should We Apply MPT for This Risk-Averse Client?\n")
## ASSESSMENT: Should We Apply MPT for This Risk-Averse Client?
cat("=============================================================\n\n")
## =============================================================
# Key metrics
cat("KEY FACTORS TO CONSIDER:\n\n")
## KEY FACTORS TO CONSIDER:
# 1. Correlation
cat("1. CORRELATION BETWEEN STOCKS AND BONDS\n")
## 1. CORRELATION BETWEEN STOCKS AND BONDS
cat(sprintf("   Current correlation: %.4f\n", correlation))
##    Current correlation: -0.1764
if(correlation < 0.3) {
  cat("   ✓ LOW correlation provides strong diversification benefits\n\n")
} else if(correlation < 0.6) {
  cat("   ✓ MODERATE correlation still provides diversification benefits\n\n")
} else {
  cat("   ✗ HIGH correlation limits diversification benefits\n\n")
}
##    ✓ LOW correlation provides strong diversification benefits
# 2. Risk reduction potential
min_risk <- min_var_portfolio$risk
weighted_avg_risk <- 0.5 * sigma_stocks + 0.5 * sigma_bonds
risk_reduction <- (weighted_avg_risk - min_risk) / weighted_avg_risk * 100

cat("2. RISK REDUCTION POTENTIAL\n")
## 2. RISK REDUCTION POTENTIAL
cat(sprintf("   If correlation were 1 (no diversification), 50/50 portfolio risk: %.2f%%\n", 
            weighted_avg_risk * 100))
##    If correlation were 1 (no diversification), 50/50 portfolio risk: 14.91%
cat(sprintf("   Actual minimum variance portfolio risk: %.2f%%\n", min_risk * 100))
##    Actual minimum variance portfolio risk: 9.06%
cat(sprintf("   ✓ Diversification reduces risk by %.1f%%\n\n", risk_reduction))
##    ✓ Diversification reduces risk by 39.3%
# 3. Sharpe ratio improvement
sharpe_stocks <- mu_stocks / sigma_stocks
sharpe_bonds <- mu_bonds / sigma_bonds

# Find optimal risky portfolio (max Sharpe with rf=0)
sharpe_ratios <- portfolio_stats$return / portfolio_stats$risk
optimal_idx <- which.max(sharpe_ratios)
optimal_portfolio <- portfolio_stats[optimal_idx, ]
sharpe_optimal <- optimal_portfolio$return / optimal_portfolio$risk

cat("3. RISK-ADJUSTED RETURN IMPROVEMENT\n")
## 3. RISK-ADJUSTED RETURN IMPROVEMENT
cat(sprintf("   Sharpe Ratio (Stocks only): %.4f\n", sharpe_stocks))
##    Sharpe Ratio (Stocks only): 0.5958
cat(sprintf("   Sharpe Ratio (Bonds only): %.4f\n", sharpe_bonds))
##    Sharpe Ratio (Bonds only): 0.5974
cat(sprintf("   Sharpe Ratio (Optimal Portfolio): %.4f\n", sharpe_optimal))
##    Sharpe Ratio (Optimal Portfolio): 0.9297
cat(sprintf("   ✓ Optimal portfolio improves Sharpe ratio by %.1f%% vs best single asset\n\n",
            (sharpe_optimal / max(sharpe_stocks, sharpe_bonds) - 1) * 100))
##    ✓ Optimal portfolio improves Sharpe ratio by 55.6% vs best single asset
# Conclusion
cat("CONCLUSION:\n")
## CONCLUSION:
cat("-----------\n")
## -----------
cat("YES, there is significant scope for applying MPT:\n\n")
## YES, there is significant scope for applying MPT:
cat("• The correlation between stocks and bonds is sufficiently low to provide\n")
## • The correlation between stocks and bonds is sufficiently low to provide
cat("  meaningful diversification benefits.\n\n")
##   meaningful diversification benefits.
cat("• A risk-averse client can achieve LOWER risk than holding either asset alone\n")
## • A risk-averse client can achieve LOWER risk than holding either asset alone
cat("  while still earning positive expected returns.\n\n")
##   while still earning positive expected returns.
cat("• The optimal portfolio provides better risk-adjusted returns than either\n")
## • The optimal portfolio provides better risk-adjusted returns than either
cat("  individual asset.\n")
##   individual asset.

5 Question 4: Optimal Risky Portfolio (Risk-Free Rate = 0%)

5.1 Finding the Tangency Portfolio

The optimal risky portfolio (tangency portfolio) maximizes the Sharpe ratio:

\[\text{Sharpe Ratio} = \frac{E(R_p) - R_f}{\sigma_p}\]

When \(R_f = 0\), we simply maximize \(\frac{E(R_p)}{\sigma_p}\).

# Define the optimization function
# We'll use analytical solution for 2-asset case

# Parameters (annualized)
rf <- 0  # Risk-free rate

# Excess returns
excess_stocks <- mu_stocks - rf
excess_bonds <- mu_bonds - rf

# Covariance
cov_sb <- rho * sigma_stocks * sigma_bonds

# Optimal weight in stocks (analytical formula for 2 assets)
# w* = (E[R1] - Rf) * σ2² - (E[R2] - Rf) * σ1 * σ2 * ρ
#      ------------------------------------------------
#      (E[R1] - Rf) * σ2² + (E[R2] - Rf) * σ1² - (E[R1] - Rf + E[R2] - Rf) * σ1 * σ2 * ρ

numerator <- excess_stocks * sigma_bonds^2 - excess_bonds * cov_sb
denominator <- excess_stocks * sigma_bonds^2 + excess_bonds * sigma_stocks^2 - 
               (excess_stocks + excess_bonds) * cov_sb

w_stocks_optimal <- numerator / denominator
w_bonds_optimal <- 1 - w_stocks_optimal

# Calculate optimal portfolio characteristics
optimal_return <- w_stocks_optimal * mu_stocks + w_bonds_optimal * mu_bonds
optimal_risk <- sqrt(
  w_stocks_optimal^2 * sigma_stocks^2 + 
  w_bonds_optimal^2 * sigma_bonds^2 + 
  2 * w_stocks_optimal * w_bonds_optimal * cov_sb
)
optimal_sharpe <- (optimal_return - rf) / optimal_risk

# Display results
cat("OPTIMAL RISKY PORTFOLIO (Risk-Free Rate = 0%)\n")
## OPTIMAL RISKY PORTFOLIO (Risk-Free Rate = 0%)
cat("==============================================\n\n")
## ==============================================
cat("PORTFOLIO WEIGHTS:\n")
## PORTFOLIO WEIGHTS:
cat(sprintf("  Stocks (SPY):  %.2f%% \n", w_stocks_optimal * 100))
##   Stocks (SPY):  39.93%
cat(sprintf("  Bonds (VUSTX): %.2f%% \n\n", w_bonds_optimal * 100))
##   Bonds (VUSTX): 60.07%
cat("PORTFOLIO CHARACTERISTICS (Annualized):\n")
## PORTFOLIO CHARACTERISTICS (Annualized):
cat(sprintf("  Expected Return: %.2f%%\n", optimal_return * 100))
##   Expected Return: 8.54%
cat(sprintf("  Standard Deviation: %.2f%%\n", optimal_risk * 100))
##   Standard Deviation: 9.18%
cat(sprintf("  Sharpe Ratio: %.4f\n\n", optimal_sharpe))
##   Sharpe Ratio: 0.9297
cat("INTERPRETATION:\n")
## INTERPRETATION:
cat(sprintf("  For every 1%% of risk taken, the portfolio is expected to earn %.2f%% return.\n",
            optimal_sharpe * 100))
##   For every 1% of risk taken, the portfolio is expected to earn 92.97% return.

5.2 Visualizing the Capital Allocation Line

# Create CAL (Capital Allocation Line)
rf <- 0  # Risk-free rate
optimal_sharpe <- (optimal_return - rf) / optimal_risk

cal_risk <- seq(0, max(portfolio_stats$risk) * 1.2, length.out = 100)
cal_return <- rf + optimal_sharpe * cal_risk
cal_data <- data.frame(risk = cal_risk, return = cal_return)

# Plot with CAL - HOLLOW FRONTIER
p_cal <- ggplot() +
  # Inefficient frontier (dashed)
  geom_path(data = inefficient_frontier, aes(x = risk, y = return),
            color = "gray60", linewidth = 1, linetype = "dashed") +
  # Efficient frontier (solid)
  geom_path(data = efficient_frontier, aes(x = risk, y = return),
            color = "#2E86AB", linewidth = 1.5) +
  # Capital Allocation Line
  geom_line(data = cal_data, aes(x = risk, y = return),
            color = "#F18F01", linewidth = 1, linetype = "dashed") +
  # Individual assets
  geom_point(aes(x = sigma_stocks, y = mu_stocks), color = "#A23B72", size = 4) +
  geom_point(aes(x = sigma_bonds, y = mu_bonds), color = "#2E86AB", size = 4) +
  # Optimal portfolio (tangency point)
  geom_point(aes(x = optimal_risk, y = optimal_return), color = "#F18F01", size = 5) +
  # Risk-free asset
  geom_point(aes(x = 0, y = rf), color = "black", size = 4) +
  # Labels
  annotate("text", x = sigma_stocks + 0.01, y = mu_stocks, label = "Stocks", hjust = 0) +
  annotate("text", x = sigma_bonds + 0.01, y = mu_bonds, label = "Bonds", hjust = 0) +
  annotate("text", x = optimal_risk + 0.01, y = optimal_return + 0.01,
           label = "Optimal Risky\nPortfolio", hjust = 0, color = "#F18F01", fontface = "bold") +
  annotate("text", x = 0.01, y = rf + 0.01, label = "Risk-Free\nAsset", hjust = 0) +
  annotate("text", x = max(cal_risk) * 0.8, y = rf + optimal_sharpe * max(cal_risk) * 0.8 + 0.01,
           label = "Capital Allocation Line", color = "#F18F01", fontface = "italic") +
  scale_x_continuous(labels = scales::percent_format(), limits = c(0, NA)) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(title = "Efficient Frontier with Capital Allocation Line",
       subtitle = "The CAL connects the risk-free asset to the optimal risky portfolio",
       x = "Portfolio Risk (Annualized Standard Deviation)",
       y = "Portfolio Expected Return (Annualized)") +
  theme_minimal()

print(p_cal)

5.3 Summary Table

# Create summary table
summary_df <- data.frame(
  Metric = c("Weight in Stocks", "Weight in Bonds", 
             "Expected Return (Annual)", "Standard Deviation (Annual)",
             "Sharpe Ratio"),
  Value = c(sprintf("%.2f%%", w_stocks_optimal * 100),
            sprintf("%.2f%%", w_bonds_optimal * 100),
            sprintf("%.2f%%", optimal_return * 100),
            sprintf("%.2f%%", optimal_risk * 100),
            sprintf("%.4f", optimal_sharpe))
)

kable(summary_df, 
      caption = "Optimal Risky Portfolio Characteristics (Rf = 0%)",
      col.names = c("Metric", "Value"),
      align = c("l", "r")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE)
Optimal Risky Portfolio Characteristics (Rf = 0%)
Metric Value
Weight in Stocks 39.93%
Weight in Bonds 60.07%
Expected Return (Annual) 8.54%
Standard Deviation (Annual) 9.18%
Sharpe Ratio 0.9297

6 Question 5: Sensitivity to Different Risk-Free Rates

6.1 How Does the Optimal Portfolio Change?

# Test different risk-free rates
rf_rates <- c(0, 0.01, 0.02, 0.03, 0.04, 0.05)

sensitivity_results <- data.frame()

for(rf_test in rf_rates) {
  # Excess returns
  excess_s <- mu_stocks - rf_test
  excess_b <- mu_bonds - rf_test
  
  # Optimal weight calculation
  num <- excess_s * sigma_bonds^2 - excess_b * cov_sb
  den <- excess_s * sigma_bonds^2 + excess_b * sigma_stocks^2 - 
         (excess_s + excess_b) * cov_sb
  
  w_s <- num / den
  w_b <- 1 - w_s
  
  # Constrain weights to [0, 1] for practical interpretation
  w_s_constrained <- max(0, min(1, w_s))
  w_b_constrained <- 1 - w_s_constrained
  
  # Portfolio characteristics
  p_ret <- w_s_constrained * mu_stocks + w_b_constrained * mu_bonds
  p_risk <- sqrt(w_s_constrained^2 * sigma_stocks^2 + 
                 w_b_constrained^2 * sigma_bonds^2 + 
                 2 * w_s_constrained * w_b_constrained * cov_sb)
  p_sharpe <- (p_ret - rf_test) / p_risk
  
  sensitivity_results <- rbind(sensitivity_results, data.frame(
    rf_rate = rf_test,
    w_stocks = w_s,
    w_stocks_constrained = w_s_constrained,
    w_bonds = w_b,
    w_bonds_constrained = w_b_constrained,
    expected_return = p_ret,
    risk = p_risk,
    sharpe = p_sharpe
  ))
}

# Display results
display_table <- sensitivity_results %>%
  mutate(
    `Risk-Free Rate` = sprintf("%.1f%%", rf_rate * 100),
    `Stocks Weight` = sprintf("%.1f%%", w_stocks_constrained * 100),
    `Bonds Weight` = sprintf("%.1f%%", w_bonds_constrained * 100),
    `Expected Return` = sprintf("%.2f%%", expected_return * 100),
    `Std Deviation` = sprintf("%.2f%%", risk * 100),
    `Sharpe Ratio` = sprintf("%.4f", sharpe)
  ) %>%
  select(`Risk-Free Rate`, `Stocks Weight`, `Bonds Weight`, 
         `Expected Return`, `Std Deviation`, `Sharpe Ratio`)

kable(display_table, 
      caption = "Sensitivity of Optimal Portfolio to Risk-Free Rate Changes",
      align = c("c", "c", "c", "c", "c", "c")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)
Sensitivity of Optimal Portfolio to Risk-Free Rate Changes
Risk-Free Rate Stocks Weight Bonds Weight Expected Return Std Deviation Sharpe Ratio
0.0% 39.9% 60.1% 8.54% 9.18% 0.9297
1.0% 40.8% 59.2% 8.57% 9.22% 0.8210
2.0% 42.0% 58.0% 8.61% 9.27% 0.7128
3.0% 43.6% 56.4% 8.67% 9.36% 0.6054
4.0% 46.0% 54.0% 8.75% 9.51% 0.4994
5.0% 49.8% 50.2% 8.88% 9.82% 0.3957

6.2 Visualization of Sensitivity

# Plot how weights change with risk-free rate
sensitivity_long <- sensitivity_results %>%
  select(rf_rate, w_stocks_constrained, w_bonds_constrained) %>%
  pivot_longer(cols = c(w_stocks_constrained, w_bonds_constrained),
               names_to = "Asset",
               values_to = "Weight") %>%
  mutate(Asset = ifelse(Asset == "w_stocks_constrained", "Stocks", "Bonds"))

p_sens <- ggplot(sensitivity_long, aes(x = rf_rate * 100, y = Weight * 100, 
                                        color = Asset, group = Asset)) +
  geom_line(size = 1.5) +
  geom_point(size = 3) +
  scale_color_manual(values = c("Bonds" = "#2E86AB", "Stocks" = "#A23B72")) +
  labs(
    title = "How Optimal Portfolio Weights Change with Risk-Free Rate",
    x = "Risk-Free Rate (%)",
    y = "Portfolio Weight (%)"
  ) +
  theme_minimal() +
  theme(legend.position = "top")

print(p_sens)

6.3 Explanation of Sensitivity Results

cat("WHY DOES THE OPTIMAL PORTFOLIO CHANGE WITH RISK-FREE RATE?\n")
## WHY DOES THE OPTIMAL PORTFOLIO CHANGE WITH RISK-FREE RATE?
cat("==========================================================\n\n")
## ==========================================================
cat("1. THE GEOMETRIC INTUITION:\n")
## 1. THE GEOMETRIC INTUITION:
cat("   - The Capital Allocation Line (CAL) starts at the risk-free rate\n")
##    - The Capital Allocation Line (CAL) starts at the risk-free rate
cat("   - As rf increases, the starting point moves UP on the y-axis\n")
##    - As rf increases, the starting point moves UP on the y-axis
cat("   - The tangency point (optimal portfolio) shifts along the frontier\n\n")
##    - The tangency point (optimal portfolio) shifts along the frontier
cat("2. THE ECONOMIC INTUITION:\n")
## 2. THE ECONOMIC INTUITION:
cat("   - Higher rf = higher 'hurdle rate' for taking risk\n")
##    - Higher rf = higher 'hurdle rate' for taking risk
cat("   - When rf is high, you need MORE return to justify taking risk\n")
##    - When rf is high, you need MORE return to justify taking risk
cat("   - This changes which portfolio maximizes the Sharpe ratio\n\n")
##    - This changes which portfolio maximizes the Sharpe ratio
cat("3. WHAT WE OBSERVE:\n")
## 3. WHAT WE OBSERVE:
if(sensitivity_results$w_stocks[1] > sensitivity_results$w_stocks[nrow(sensitivity_results)]) {
  cat("   - As rf increases, the optimal portfolio becomes MORE CONSERVATIVE\n")
  cat("   - Weight in stocks DECREASES, weight in bonds INCREASES\n")
  cat("   - This makes sense: when 'safe' returns are higher, you take less risk\n")
} else {
  cat("   - As rf increases, the optimal portfolio becomes MORE AGGRESSIVE\n")
  cat("   - This can happen when bonds have lower expected returns relative to rf\n")
}
##    - As rf increases, the optimal portfolio becomes MORE AGGRESSIVE
##    - This can happen when bonds have lower expected returns relative to rf
cat("\n4. PRACTICAL IMPLICATIONS FOR YOUR CLIENT:\n")
## 
## 4. PRACTICAL IMPLICATIONS FOR YOUR CLIENT:
cat("   - In low interest rate environments: optimal to hold more stocks\n")
##    - In low interest rate environments: optimal to hold more stocks
cat("   - In high interest rate environments: optimal to be more conservative\n")
##    - In high interest rate environments: optimal to be more conservative
cat("   - The client should periodically rebalance as rates change\n")
##    - The client should periodically rebalance as rates change

7 Question 6: Recession Analysis

7.1 Define Recession Periods

# Define recession periods (NBER dates)
recessions <- list(
  dotcom = list(
    name = "Dot-Com Bust",
    start = "2001-03-01",
    end = "2001-11-30"
  ),
  gfc = list(
    name = "Great Financial Crisis",
    start = "2007-12-01",
    end = "2009-06-30"  # Extended slightly for full impact
  ),
  covid = list(
    name = "COVID-19 Recession",
    start = "2020-02-01",
    end = "2020-04-30"
  )
)

# Display recession periods
cat("RECESSION PERIODS ANALYZED:\n")
## RECESSION PERIODS ANALYZED:
cat("===========================\n\n")
## ===========================
for(rec in recessions) {
  cat(sprintf("%s: %s to %s\n", rec$name, rec$start, rec$end))
}
## Dot-Com Bust: 2001-03-01 to 2001-11-30
## Great Financial Crisis: 2007-12-01 to 2009-06-30
## COVID-19 Recession: 2020-02-01 to 2020-04-30

7.2 Calculate Statistics for Each Recession

# Function to calculate portfolio stats for a given period
calc_period_stats <- function(returns_xts, start_date, end_date, w_stocks, w_bonds) {
  # Subset data
  period_data <- returns_xts[paste(start_date, end_date, sep = "/")]
  
  if(nrow(period_data) == 0) {
    return(NULL)
  }
  
  # Extract returns
  r_s <- as.numeric(period_data$Stocks)
  r_b <- as.numeric(period_data$Bonds)
  
  # Individual asset stats (annualized)
  mu_s <- mean(r_s) * 52
  mu_b <- mean(r_b) * 52
  sigma_s <- sd(r_s) * sqrt(52)
  sigma_b <- sd(r_b) * sqrt(52)
  corr <- cor(r_s, r_b)
  
  # Portfolio stats using the ORIGINAL optimal weights
  port_returns <- w_stocks * r_s + w_bonds * r_b
  mu_p <- mean(port_returns) * 52
  sigma_p <- sd(port_returns) * sqrt(52)
  
  # Calculate portfolio stats using the formula (as a check)
  cov_sb <- corr * sigma_s * sigma_b
  sigma_p_formula <- sqrt(w_stocks^2 * sigma_s^2 + w_bonds^2 * sigma_b^2 + 
                          2 * w_stocks * w_bonds * cov_sb)
  
  return(list(
    n_weeks = nrow(period_data),
    mu_stocks = mu_s,
    mu_bonds = mu_b,
    sigma_stocks = sigma_s,
    sigma_bonds = sigma_b,
    correlation = corr,
    port_return = mu_p,
    port_risk = sigma_p,
    port_sharpe = mu_p / sigma_p
  ))
}

# Calculate stats for full sample
full_stats <- calc_period_stats(returns_data, start_date, end_date, 
                                 w_stocks_optimal, w_bonds_optimal)

# Calculate stats for each recession
recession_stats <- list()
for(rec_name in names(recessions)) {
  rec <- recessions[[rec_name]]
  recession_stats[[rec_name]] <- calc_period_stats(
    returns_data, rec$start, rec$end, w_stocks_optimal, w_bonds_optimal
  )
  recession_stats[[rec_name]]$name <- rec$name
}

# Create comparison table
comparison_data <- data.frame(
  Period = c("Full Sample (1997-2024)",
             recessions$dotcom$name,
             recessions$gfc$name,
             recessions$covid$name),
  Weeks = c(full_stats$n_weeks,
            recession_stats$dotcom$n_weeks,
            recession_stats$gfc$n_weeks,
            recession_stats$covid$n_weeks),
  Stock_Return = c(full_stats$mu_stocks,
                   recession_stats$dotcom$mu_stocks,
                   recession_stats$gfc$mu_stocks,
                   recession_stats$covid$mu_stocks),
  Bond_Return = c(full_stats$mu_bonds,
                  recession_stats$dotcom$mu_bonds,
                  recession_stats$gfc$mu_bonds,
                  recession_stats$covid$mu_bonds),
  Stock_Vol = c(full_stats$sigma_stocks,
                recession_stats$dotcom$sigma_stocks,
                recession_stats$gfc$sigma_stocks,
                recession_stats$covid$sigma_stocks),
  Bond_Vol = c(full_stats$sigma_bonds,
               recession_stats$dotcom$sigma_bonds,
               recession_stats$gfc$sigma_bonds,
               recession_stats$covid$sigma_bonds),
  Correlation = c(full_stats$correlation,
                  recession_stats$dotcom$correlation,
                  recession_stats$gfc$correlation,
                  recession_stats$covid$correlation),
  Port_Return = c(full_stats$port_return,
                  recession_stats$dotcom$port_return,
                  recession_stats$gfc$port_return,
                  recession_stats$covid$port_return),
  Port_Risk = c(full_stats$port_risk,
                recession_stats$dotcom$port_risk,
                recession_stats$gfc$port_risk,
                recession_stats$covid$port_risk)
)

7.3 Results Table

# Format for display
display_recession <- comparison_data %>%
  mutate(
    `Stock Return` = sprintf("%.2f%%", Stock_Return * 100),
    `Bond Return` = sprintf("%.2f%%", Bond_Return * 100),
    `Stock Vol` = sprintf("%.2f%%", Stock_Vol * 100),
    `Bond Vol` = sprintf("%.2f%%", Bond_Vol * 100),
    Correlation = sprintf("%.3f", Correlation),
    `Portfolio Return` = sprintf("%.2f%%", Port_Return * 100),
    `Portfolio Risk` = sprintf("%.2f%%", Port_Risk * 100)
  ) %>%
  select(Period, Weeks, `Stock Return`, `Bond Return`, `Stock Vol`, `Bond Vol`,
         Correlation, `Portfolio Return`, `Portfolio Risk`)

kable(display_recession,
      caption = sprintf("Performance Analysis: Optimal Portfolio (%.1f%% Stocks, %.1f%% Bonds)",
                       w_stocks_optimal * 100, w_bonds_optimal * 100),
      align = c("l", "c", "c", "c", "c", "c", "c", "c", "c")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = TRUE) %>%
  row_spec(1, bold = TRUE, background = "#e6f3ff") %>%
  row_spec(2:4, background = "#fff0f0")
Performance Analysis: Optimal Portfolio (39.9% Stocks, 60.1% Bonds)
Period Weeks Stock Return Bond Return Stock Vol Bond Vol Correlation Portfolio Return Portfolio Risk
Full Sample (1997-2024) 1447 10.66% 7.12% 17.90% 11.92% -0.176 8.54% 9.18%
Dot-Com Bust 40 -7.81% 8.50% 23.96% 10.82% -0.054 1.99% 11.27%
Great Financial Crisis 82 -22.22% 8.77% 33.29% 13.82% -0.199 -3.60% 14.20%
COVID-19 Recession 12 -37.10% 75.44% 58.00% 27.41% 0.142 30.51% 30.25%

7.4 Visualization of Recession Performance

# Create bar chart comparison
recession_plot_data <- comparison_data %>%
  select(Period, Port_Return, Port_Risk, Correlation) %>%
  pivot_longer(cols = c(Port_Return, Port_Risk, Correlation),
               names_to = "Metric",
               values_to = "Value") %>%
  mutate(
    Metric = case_when(
      Metric == "Port_Return" ~ "Portfolio Return",
      Metric == "Port_Risk" ~ "Portfolio Risk",
      TRUE ~ "Correlation"
    ),
    Period = factor(Period, levels = comparison_data$Period)
  )

# Separate plots for each metric
p_returns <- ggplot(comparison_data, aes(x = Period, y = Port_Return * 100)) +
  geom_bar(stat = "identity", fill = ifelse(comparison_data$Port_Return > 0, "#2E86AB", "#A23B72")) +
  geom_hline(yintercept = 0, linetype = "dashed") +
  labs(title = "Portfolio Returns by Period", y = "Annualized Return (%)") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_blank())

p_risk <- ggplot(comparison_data, aes(x = Period, y = Port_Risk * 100)) +
  geom_bar(stat = "identity", fill = "#F18F01") +
  labs(title = "Portfolio Risk by Period", y = "Annualized Std Dev (%)") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_blank())

p_corr <- ggplot(comparison_data, aes(x = Period, y = Correlation)) +
  geom_bar(stat = "identity", fill = ifelse(comparison_data$Correlation > 0, "#2E86AB", "#A23B72")) +
  geom_hline(yintercept = 0, linetype = "dashed") +
  labs(title = "Stock-Bond Correlation by Period", y = "Correlation") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_blank())

grid.arrange(p_returns, p_risk, p_corr, ncol = 1)


8 Question 7: Discussion of Findings

8.1 Key Observations and Analysis

cat("COMPREHENSIVE ANALYSIS: FULL SAMPLE VS. RECESSIONS\n")
## COMPREHENSIVE ANALYSIS: FULL SAMPLE VS. RECESSIONS
cat("===================================================\n\n")
## ===================================================
cat("1. RETURN DIFFERENCES\n")
## 1. RETURN DIFFERENCES
cat("---------------------\n")
## ---------------------
cat(sprintf("Full Sample Portfolio Return: %.2f%%\n", full_stats$port_return * 100))
## Full Sample Portfolio Return: 8.54%
cat(sprintf("Dot-Com Recession Return: %.2f%%\n", recession_stats$dotcom$port_return * 100))
## Dot-Com Recession Return: 1.99%
cat(sprintf("GFC Recession Return: %.2f%%\n", recession_stats$gfc$port_return * 100))
## GFC Recession Return: -3.60%
cat(sprintf("COVID Recession Return: %.2f%%\n\n", recession_stats$covid$port_return * 100))
## COVID Recession Return: 30.51%
cat("INSIGHT: During recessions, the portfolio experienced significantly lower\n")
## INSIGHT: During recessions, the portfolio experienced significantly lower
cat("(often negative) returns compared to the full sample average. However,\n")
## (often negative) returns compared to the full sample average. However,
cat("the bond allocation helped cushion the losses during most recessions.\n\n")
## the bond allocation helped cushion the losses during most recessions.
cat("2. RISK (VOLATILITY) DIFFERENCES\n")
## 2. RISK (VOLATILITY) DIFFERENCES
cat("---------------------------------\n")
## ---------------------------------
cat(sprintf("Full Sample Portfolio Risk: %.2f%%\n", full_stats$port_risk * 100))
## Full Sample Portfolio Risk: 9.18%
cat(sprintf("Dot-Com Recession Risk: %.2f%%\n", recession_stats$dotcom$port_risk * 100))
## Dot-Com Recession Risk: 11.27%
cat(sprintf("GFC Recession Risk: %.2f%%\n", recession_stats$gfc$port_risk * 100))
## GFC Recession Risk: 14.20%
cat(sprintf("COVID Recession Risk: %.2f%%\n\n", recession_stats$covid$port_risk * 100))
## COVID Recession Risk: 30.25%
cat("INSIGHT: Volatility typically SPIKES during recessions. The GFC and COVID\n")
## INSIGHT: Volatility typically SPIKES during recessions. The GFC and COVID
cat("periods showed especially elevated volatility, reflecting the severe\n")
## periods showed especially elevated volatility, reflecting the severe
cat("market stress during these times.\n\n")
## market stress during these times.
cat("3. CORRELATION DYNAMICS - THE CRITICAL INSIGHT\n")
## 3. CORRELATION DYNAMICS - THE CRITICAL INSIGHT
cat("-----------------------------------------------\n")
## -----------------------------------------------
cat(sprintf("Full Sample Correlation: %.3f\n", full_stats$correlation))
## Full Sample Correlation: -0.176
cat(sprintf("Dot-Com Recession Correlation: %.3f\n", recession_stats$dotcom$correlation))
## Dot-Com Recession Correlation: -0.054
cat(sprintf("GFC Recession Correlation: %.3f\n", recession_stats$gfc$correlation))
## GFC Recession Correlation: -0.199
cat(sprintf("COVID Recession Correlation: %.3f\n\n", recession_stats$covid$correlation))
## COVID Recession Correlation: 0.142
cat("INSIGHT: This is perhaps the most important finding:\n\n")
## INSIGHT: This is perhaps the most important finding:
if(recession_stats$gfc$correlation < full_stats$correlation) {
  cat("• During the GFC, stock-bond correlation was LOWER (or more negative)\n")
  cat("  than the full sample. This 'flight to quality' effect meant bonds\n")
  cat("  actually provided diversification when needed most.\n\n")
} else {
  cat("• During the GFC, stock-bond correlation was HIGHER than the full sample.\n")
  cat("  This reduced diversification benefits exactly when they were needed.\n\n")
}
## • During the GFC, stock-bond correlation was LOWER (or more negative)
##   than the full sample. This 'flight to quality' effect meant bonds
##   actually provided diversification when needed most.
if(recession_stats$covid$correlation < 0) {
  cat("• During COVID, the negative correlation meant bonds rallied while\n")
  cat("  stocks crashed - exactly the hedge a risk-averse investor wants.\n\n")
}

cat("4. IMPLICATIONS FOR THE CLIENT\n")
## 4. IMPLICATIONS FOR THE CLIENT
cat("-------------------------------\n")
## -------------------------------
cat("a) The optimal portfolio based on full-sample data may not perform as\n")
## a) The optimal portfolio based on full-sample data may not perform as
cat("   expected during extreme market stress.\n\n")
##    expected during extreme market stress.
cat("b) Correlations are NOT stable - they change during crises, which can\n")
## b) Correlations are NOT stable - they change during crises, which can
cat("   either help or hurt the portfolio.\n\n")
##    either help or hurt the portfolio.
cat("c) A truly risk-averse client might want to hold MORE bonds than the\n")
## c) A truly risk-averse client might want to hold MORE bonds than the
cat("   'optimal' allocation suggests, as a buffer against worst-case scenarios.\n\n")
##    'optimal' allocation suggests, as a buffer against worst-case scenarios.
cat("d) Consider stress-testing any proposed allocation against historical\n")
## d) Consider stress-testing any proposed allocation against historical
cat("   recession scenarios before implementation.\n\n")
##    recession scenarios before implementation.
cat("5. LIMITATIONS OF MODERN PORTFOLIO THEORY\n")
## 5. LIMITATIONS OF MODERN PORTFOLIO THEORY
cat("------------------------------------------\n")
## ------------------------------------------
cat("This analysis reveals several limitations of MPT:\n\n")
## This analysis reveals several limitations of MPT:
cat("• MPT assumes stable correlations - but correlations change over time\n")
## • MPT assumes stable correlations - but correlations change over time
cat("• MPT uses historical data as a forecast - but the future may differ\n")
## • MPT uses historical data as a forecast - but the future may differ
cat("• MPT assumes normal distributions - but returns have 'fat tails'\n")
## • MPT assumes normal distributions - but returns have 'fat tails'
cat("• The 'optimal' portfolio may be far from optimal in stress periods\n")
## • The 'optimal' portfolio may be far from optimal in stress periods

8.2 Final Summary Table

# Create a comprehensive summary
final_summary <- data.frame(
  Aspect = c(
    "Optimal Stock Weight",
    "Optimal Bond Weight",
    "Full Sample Annual Return",
    "Full Sample Annual Risk",
    "Full Sample Sharpe Ratio",
    "Worst Recession Return (GFC)",
    "Highest Recession Risk (COVID)",
    "Full Sample Correlation",
    "Most Favorable Recession Correlation"
  ),
  Value = c(
    sprintf("%.1f%%", w_stocks_optimal * 100),
    sprintf("%.1f%%", w_bonds_optimal * 100),
    sprintf("%.2f%%", full_stats$port_return * 100),
    sprintf("%.2f%%", full_stats$port_risk * 100),
    sprintf("%.4f", full_stats$port_return / full_stats$port_risk),
    sprintf("%.2f%%", recession_stats$gfc$port_return * 100),
    sprintf("%.2f%%", recession_stats$covid$port_risk * 100),
    sprintf("%.3f", full_stats$correlation),
    sprintf("%.3f (GFC)", recession_stats$gfc$correlation)
  )
)

kable(final_summary,
      caption = "Executive Summary: Key Portfolio Metrics",
      col.names = c("Aspect", "Value"),
      align = c("l", "r")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE) %>%
  row_spec(c(3, 4, 5), bold = TRUE, background = "#e6f3ff")
Executive Summary: Key Portfolio Metrics
Aspect Value
Optimal Stock Weight 39.9%
Optimal Bond Weight 60.1%
Full Sample Annual Return 8.54%
Full Sample Annual Risk 9.18%
Full Sample Sharpe Ratio 0.9297
Worst Recession Return (GFC) -3.60%
Highest Recession Risk (COVID) 30.25%
Full Sample Correlation -0.176
Most Favorable Recession Correlation -0.199 (GFC)

9 Appendix: Data Export

# Export data to CSV for reference
write.csv(
  data.frame(
    Date = index(returns_data),
    Stocks = as.numeric(returns_data$Stocks),
    Bonds = as.numeric(returns_data$Bonds)
  ),
  "weekly_returns_data.csv",
  row.names = FALSE
)

# Export summary statistics
write.csv(comparison_data, "recession_analysis_summary.csv", row.names = FALSE)

cat("Data files exported:\n")
## Data files exported:
cat("- weekly_returns_data.csv: Weekly returns for stocks and bonds\n")
## - weekly_returns_data.csv: Weekly returns for stocks and bonds
cat("- recession_analysis_summary.csv: Summary statistics by period\n")
## - recession_analysis_summary.csv: Summary statistics by period

10 Session Information

sessionInfo()
## R version 4.4.0 (2024-04-24 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26200)
## 
## Matrix products: default
## 
## 
## locale:
## [1] LC_COLLATE=Chinese (Simplified)_China.utf8 
## [2] LC_CTYPE=Chinese (Simplified)_China.utf8   
## [3] LC_MONETARY=Chinese (Simplified)_China.utf8
## [4] LC_NUMERIC=C                               
## [5] LC_TIME=Chinese (Simplified)_China.utf8    
## 
## time zone: Asia/Shanghai
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices datasets  utils     methods   base     
## 
## other attached packages:
##  [1] quadprog_1.5-8             gridExtra_2.3             
##  [3] scales_1.4.0               kableExtra_1.4.0          
##  [5] knitr_1.50                 lubridate_1.9.4           
##  [7] forcats_1.0.1              stringr_1.6.0             
##  [9] dplyr_1.1.4                purrr_1.2.0               
## [11] readr_2.1.6                tidyr_1.3.1               
## [13] tibble_3.3.0               ggplot2_4.0.1             
## [15] tidyverse_2.0.0            PerformanceAnalytics_2.0.8
## [17] quantmod_0.4.28            TTR_0.24.4                
## [19] xts_0.14.1                 zoo_1.8-14                
## 
## loaded via a namespace (and not attached):
##  [1] sass_0.4.10        generics_0.1.4     renv_1.0.7         xml2_1.5.1        
##  [5] stringi_1.8.7      lattice_0.22-6     hms_1.1.4          digest_0.6.39     
##  [9] magrittr_2.0.4     timechange_0.3.0   evaluate_1.0.5     grid_4.4.0        
## [13] RColorBrewer_1.1-3 fastmap_1.2.0      jsonlite_2.0.0     viridisLite_0.4.2 
## [17] textshaping_1.0.4  jquerylib_0.1.4    cli_3.6.5          rlang_1.1.6       
## [21] withr_3.0.2        cachem_1.1.0       yaml_2.3.11        tools_4.4.0       
## [25] tzdb_0.5.0         curl_7.0.0         vctrs_0.6.5        R6_2.6.1          
## [29] lifecycle_1.0.4    pkgconfig_2.0.3    pillar_1.11.1      bslib_0.9.0       
## [33] gtable_0.3.6       glue_1.8.0         systemfonts_1.3.1  xfun_0.54         
## [37] tidyselect_1.2.1   rstudioapi_0.17.1  farver_2.1.2       htmltools_0.5.8.1 
## [41] labeling_0.4.3     svglite_2.2.2      rmarkdown_2.30     compiler_4.4.0    
## [45] S7_0.2.1