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.
# 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"
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.
# 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
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")| 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 |
# 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:
## =============
## 1. AVERAGE RETURNS:
## - Stocks: 10.66% per year
## - 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
## 2. VOLATILITY (RISK):
## - Stocks: 17.90% per year
## - 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
## 3. RISK-ADJUSTED RETURNS (Sharpe Ratio):
## - Stocks: 0.596
## - Bonds: 0.597
# 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)# 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)# 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)##
## Growth of $1 invested in January 1997:
## Stocks: $12.37
## Bonds: $5.95
# 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)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.
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.
The magic happens in the last term. When correlation (\(\rho\)) is less than 1:
# Calculate correlation between stocks and bonds
correlation <- cor(returns_data$Stocks, returns_data$Bonds)
cat("CORRELATION ANALYSIS\n")## CORRELATION ANALYSIS
## ====================
## 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!
# 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)##
## Minimum Variance Portfolio:
## Weight in Stocks: 33.0%
## Weight in Bonds: 67.0%
## Expected Return: 8.29%
## Risk (Std Dev): 9.06%
## ASSESSMENT: Should We Apply MPT for This Risk-Averse Client?
## =============================================================
## KEY FACTORS TO CONSIDER:
## 1. CORRELATION BETWEEN STOCKS AND BONDS
## 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%
## Actual minimum variance portfolio risk: 9.06%
## ✓ 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
## Sharpe Ratio (Stocks only): 0.5958
## Sharpe Ratio (Bonds only): 0.5974
## 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:
## -----------
## YES, there is significant scope for applying MPT:
## • The correlation between stocks and bonds is sufficiently low to provide
## meaningful diversification benefits.
## • A risk-averse client can achieve LOWER risk than holding either asset alone
## while still earning positive expected returns.
## • The optimal portfolio provides better risk-adjusted returns than either
## individual asset.
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%)
## ==============================================
## PORTFOLIO WEIGHTS:
## Stocks (SPY): 39.93%
## Bonds (VUSTX): 60.07%
## PORTFOLIO CHARACTERISTICS (Annualized):
## Expected Return: 8.54%
## Standard Deviation: 9.18%
## Sharpe Ratio: 0.9297
## 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.
# 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)# 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)| 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 |
# 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)| 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 |
# 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)## WHY DOES THE OPTIMAL PORTFOLIO CHANGE WITH RISK-FREE RATE?
## ==========================================================
## 1. THE GEOMETRIC INTUITION:
## - The Capital Allocation Line (CAL) starts at the risk-free rate
## - As rf increases, the starting point moves UP on the y-axis
## - The tangency point (optimal portfolio) shifts along the frontier
## 2. THE ECONOMIC INTUITION:
## - Higher rf = higher 'hurdle rate' for taking risk
## - When rf is high, you need MORE return to justify taking risk
## - This changes which portfolio maximizes the Sharpe ratio
## 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
##
## 4. PRACTICAL IMPLICATIONS FOR YOUR CLIENT:
## - In low interest rate environments: optimal to hold more stocks
## - In high interest rate environments: optimal to be more conservative
## - The client should periodically rebalance as rates change
# 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:
## ===========================
## 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
# 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)
)# 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")| 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% |
# 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)## COMPREHENSIVE ANALYSIS: FULL SAMPLE VS. RECESSIONS
## ===================================================
## 1. RETURN DIFFERENCES
## ---------------------
## Full Sample Portfolio Return: 8.54%
## Dot-Com Recession Return: 1.99%
## GFC Recession Return: -3.60%
## COVID Recession Return: 30.51%
## INSIGHT: During recessions, the portfolio experienced significantly lower
## (often negative) returns compared to the full sample average. However,
## the bond allocation helped cushion the losses during most recessions.
## 2. RISK (VOLATILITY) DIFFERENCES
## ---------------------------------
## Full Sample Portfolio Risk: 9.18%
## Dot-Com Recession Risk: 11.27%
## GFC Recession Risk: 14.20%
## COVID Recession Risk: 30.25%
## INSIGHT: Volatility typically SPIKES during recessions. The GFC and COVID
## periods showed especially elevated volatility, reflecting the severe
## market stress during these times.
## 3. CORRELATION DYNAMICS - THE CRITICAL INSIGHT
## -----------------------------------------------
## Full Sample Correlation: -0.176
## Dot-Com Recession Correlation: -0.054
## GFC Recession Correlation: -0.199
## COVID Recession Correlation: 0.142
## 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
## -------------------------------
## a) The optimal portfolio based on full-sample data may not perform as
## expected during extreme market stress.
## b) Correlations are NOT stable - they change during crises, which can
## either help or hurt the portfolio.
## c) A truly risk-averse client might want to hold MORE bonds than the
## 'optimal' allocation suggests, as a buffer against worst-case scenarios.
## d) Consider stress-testing any proposed allocation against historical
## recession scenarios before implementation.
## 5. LIMITATIONS OF MODERN PORTFOLIO THEORY
## ------------------------------------------
## This analysis reveals several limitations of MPT:
## • MPT assumes stable correlations - but correlations change over time
## • MPT uses historical data as a forecast - but the future may differ
## • MPT assumes normal distributions - but returns have 'fat tails'
## • The 'optimal' portfolio may be far from optimal in stress periods
# 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")| 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) |
# 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:
## - weekly_returns_data.csv: Weekly returns for stocks and bonds
## - recession_analysis_summary.csv: Summary statistics by period
## 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