library(quantmod)
library(tidyverse)
library(xts)
library(PerformanceAnalytics)
library(quadprog)
library(knitr)
library(kableExtra)
# Define ETF tickers
tickers <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
# Download adjusted prices from 2010 to 2025
getSymbols(tickers,
src = "yahoo",
from = "2010-01-01",
to = "2025-12-31",
auto.assign = TRUE)## [1] "SPY" "QQQ" "EEM" "IWM" "EFA" "TLT" "IYR" "GLD"# Extract adjusted close prices
adj_prices <- do.call(merge, lapply(tickers, function(tk) Ad(get(tk))))
colnames(adj_prices) <- tickers
cat("Downloaded data from", as.character(index(adj_prices)[1]),
"to", as.character(tail(index(adj_prices), 1)), "\n")## Downloaded data from 2010-01-04 to 2025-12-30## Dimensions: 4023 rows x 8 columns# Show last 6 rows
tail(adj_prices, 6) %>%
as.data.frame() %>%
kable(caption = "Last 6 Rows of Adjusted Daily Prices", digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| SPY | QQQ | EEM | IWM | EFA | TLT | IYR | GLD | |
|---|---|---|---|---|---|---|---|---|
| 2025-12-22 | 682.96 | 618.43 | 54.01 | 253.13 | 95.70 | 86.39 | 93.35 | 408.23 |
| 2025-12-23 | 686.09 | 621.33 | 54.31 | 251.63 | 96.29 | 86.53 | 93.28 | 413.64 |
| 2025-12-24 | 688.50 | 623.14 | 54.42 | 252.26 | 96.41 | 87.06 | 93.96 | 411.93 |
| 2025-12-26 | 688.43 | 623.10 | 54.80 | 250.97 | 96.57 | 86.77 | 94.06 | 416.74 |
| 2025-12-29 | 685.98 | 620.09 | 54.66 | 249.44 | 96.28 | 87.10 | 94.24 | 398.60 |
| 2025-12-30 | 685.14 | 618.65 | 54.88 | 247.59 | 96.44 | 86.89 | 94.44 | 398.89 |
# Convert daily adjusted prices to monthly (end-of-month)
monthly_prices <- to.monthly(adj_prices, indexAt = "lastof", OHLC = FALSE)
# Calculate discrete (simple) monthly returns: (P_t - P_{t-1}) / P_{t-1}
monthly_returns <- na.omit(Return.calculate(monthly_prices, method = "discrete"))
cat("Monthly returns from", as.character(index(monthly_returns)[1]),
"to", as.character(tail(index(monthly_returns), 1)), "\n")## Monthly returns from 2010-02-28 to 2025-12-31## Number of monthly observations: 191# Display summary statistics
summary_stats <- data.frame(
Mean = round(colMeans(monthly_returns) * 100, 4),
StdDev = round(apply(monthly_returns, 2, sd) * 100, 4),
Min = round(apply(monthly_returns, 2, min) * 100, 4),
Max = round(apply(monthly_returns, 2, max) * 100, 4)
)
kable(summary_stats,
caption = "Monthly Return Summary Statistics (%)",
col.names = c("Mean (%)", "Std Dev (%)", "Min (%)", "Max (%)")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| Mean (%) | Std Dev (%) | Min (%) | Max (%) | |
|---|---|---|---|---|
| SPY | 1.2135 | 4.1344 | -12.4871 | 12.6984 |
| QQQ | 1.6056 | 4.9670 | -13.5957 | 14.9738 |
| EEM | 0.5004 | 5.1517 | -17.8947 | 16.2678 |
| IWM | 1.0190 | 5.6435 | -21.4771 | 18.2442 |
| EFA | 0.6712 | 4.4774 | -14.1067 | 14.2694 |
| TLT | 0.2909 | 3.9409 | -9.4238 | 13.2062 |
| IYR | 0.8069 | 4.8171 | -19.6324 | 13.1896 |
| GLD | 0.7987 | 4.5524 | -11.0623 | 12.2749 |
library(frenchdata)
# Download Fama-French 3-factor monthly data
ff3_raw <- download_french_data("Fama/French 3 Factors")
ff3_monthly <- ff3_raw$subsets$data[[1]] # monthly data
# Convert to numeric (originally in percentage, divide by 100)
ff3_monthly <- ff3_monthly %>%
mutate(
date = as.Date(paste0(date, "01"), format = "%Y%m%d"),
`Mkt-RF` = as.numeric(`Mkt-RF`) / 100,
SMB = as.numeric(SMB) / 100,
HML = as.numeric(HML) / 100,
RF = as.numeric(RF) / 100
) %>%
filter(!is.na(`Mkt-RF`))
cat("FF3 data from", as.character(min(ff3_monthly$date)),
"to", as.character(max(ff3_monthly$date)), "\n")## FF3 data from 1926-07-01 to 2026-02-01tail(ff3_monthly, 6) %>%
kable(caption = "Last 6 Rows of Fama-French 3 Factors (decimal)", digits = 6) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| date | Mkt-RF | SMB | HML | RF |
|---|---|---|---|---|
| 2025-09-01 | 0.0339 | -0.0185 | -0.0105 | 0.0033 |
| 2025-10-01 | 0.0196 | -0.0055 | -0.0310 | 0.0037 |
| 2025-11-01 | -0.0013 | 0.0038 | 0.0376 | 0.0030 |
| 2025-12-01 | -0.0036 | -0.0106 | 0.0242 | 0.0034 |
| 2026-01-01 | 0.0102 | 0.0220 | 0.0372 | 0.0030 |
| 2026-02-01 | -0.0117 | 0.0014 | 0.0283 | 0.0028 |
# Convert xts monthly returns to data frame with date column
returns_df <- as.data.frame(monthly_returns)
returns_df$date <- as.Date(index(monthly_returns))
# Align FF3 dates to last day of month to match Yahoo Finance end-of-month
ff3_monthly <- ff3_monthly %>%
mutate(date = ceiling_date(date, "month") - days(1))
# Merge on date
merged_data <- inner_join(returns_df, ff3_monthly, by = "date") %>%
arrange(date)
cat("Merged dataset: from", as.character(min(merged_data$date)),
"to", as.character(max(merged_data$date)), "\n")## Merged dataset: from 2010-02-28 to 2025-12-31## Number of observations: 191# Show last 6 rows
tail(merged_data, 6) %>%
select(date, SPY, QQQ, EEM, `Mkt-RF`, SMB, HML, RF) %>%
kable(caption = "Last 6 Rows of Merged Data", digits = 5) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| date | SPY | QQQ | EEM | Mkt-RF | SMB | HML | RF | |
|---|---|---|---|---|---|---|---|---|
| 186 | 2025-07-31 | 0.02303 | 0.02424 | 0.00663 | 0.0198 | 0.0027 | -0.0127 | 0.0034 |
| 187 | 2025-08-31 | 0.02052 | 0.00954 | 0.02677 | 0.0184 | 0.0387 | 0.0442 | 0.0038 |
| 188 | 2025-09-30 | 0.03562 | 0.05376 | 0.07100 | 0.0339 | -0.0185 | -0.0105 | 0.0033 |
| 189 | 2025-10-31 | 0.02384 | 0.04780 | 0.03558 | 0.0196 | -0.0055 | -0.0310 | 0.0037 |
| 190 | 2025-11-30 | 0.00195 | -0.01561 | -0.01772 | -0.0013 | 0.0038 | 0.0376 | 0.0030 |
| 191 | 2025-12-31 | 0.00827 | 0.00158 | 0.02477 | -0.0036 | -0.0106 | 0.0242 | 0.0034 |
We use the 60-month window from 2020/03 to 2025/02 to estimate betas and residual variances under CAPM, then construct the covariance matrix and find the Minimum Variance Portfolio (MVP).
library(lubridate)
# --- Helper: Minimum Variance Portfolio weights via quadprog ---
compute_mvp <- function(cov_mat) {
n <- ncol(cov_mat)
Dmat <- 2 * cov_mat
dvec <- rep(0, n)
# Equality constraint: sum of weights = 1; no short-sale constraints here
Amat <- cbind(rep(1, n), diag(n))
bvec <- c(1, rep(0, n)) # weights >= 0 (long-only)
result <- solve.QP(Dmat, dvec, Amat, bvec, meq = 1)
weights <- result$solution
names(weights) <- colnames(cov_mat)
return(weights)
}
# Window: 2020-03-01 to 2025-02-28
window_data <- merged_data %>%
filter(date >= as.Date("2020-03-01") & date <= as.Date("2025-02-28"))
cat("CAPM window observations:", nrow(window_data), "\n")## CAPM window observations: 60# Extract excess returns for each ETF
rf_vec <- window_data$RF
mkt_rf <- window_data$`Mkt-RF`
excess_returns <- window_data[, tickers] - rf_vec # each ETF excess return
# CAPM: Run OLS for each ETF to get beta and residual variance
betas <- numeric(length(tickers))
resid_vars <- numeric(length(tickers))
names(betas) <- names(resid_vars) <- tickers
for (tk in tickers) {
fit <- lm(excess_returns[[tk]] ~ mkt_rf)
betas[tk] <- coef(fit)[2]
resid_vars[tk] <- var(residuals(fit))
}
# Market variance
mkt_var <- var(mkt_rf)
# CAPM covariance matrix: Cov(i,j) = beta_i * beta_j * sigma_m^2 + (i==j)*sigma_e_i^2
cov_capm <- outer(betas, betas) * mkt_var + diag(resid_vars)
rownames(cov_capm) <- colnames(cov_capm) <- tickers
# Compute MVP weights
mvp_weights_capm <- compute_mvp(cov_capm)
kable(data.frame(
ETF = names(mvp_weights_capm),
Weight = round(mvp_weights_capm * 100, 4)
), caption = "MVP Weights Based on CAPM Covariance Matrix (%)",
col.names = c("ETF", "Weight (%)")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| ETF | Weight (%) | |
|---|---|---|
| SPY | SPY | 0.0000 |
| QQQ | QQQ | 0.0000 |
| EEM | EEM | 14.0092 |
| IWM | IWM | 0.0000 |
| EFA | EFA | 8.3843 |
| TLT | TLT | 34.2483 |
| IYR | IYR | 0.0000 |
| GLD | GLD | 43.3582 |
cat("\nPortfolio expected variance (CAPM):",
round(t(mvp_weights_capm) %*% cov_capm %*% mvp_weights_capm * 100^2, 6), "(%^2)\n")##
## Portfolio expected variance (CAPM): 8.902848 (%^2)# FF3 factors in the window
F_mat <- as.matrix(window_data[, c("Mkt-RF", "SMB", "HML")])
# Estimate factor loadings (betas) for each ETF via OLS
beta_mat <- matrix(0, nrow = length(tickers), ncol = 3,
dimnames = list(tickers, c("Mkt-RF", "SMB", "HML")))
resid_vars_ff3 <- numeric(length(tickers))
names(resid_vars_ff3) <- tickers
for (tk in tickers) {
fit <- lm(excess_returns[[tk]] ~ F_mat)
beta_mat[tk, ] <- coef(fit)[-1] # drop intercept
resid_vars_ff3[tk] <- var(residuals(fit))
}
# Factor covariance matrix (3x3)
cov_factors <- cov(F_mat)
# FF3 covariance matrix: B %*% Cov_F %*% B' + diag(resid_vars)
cov_ff3 <- beta_mat %*% cov_factors %*% t(beta_mat) + diag(resid_vars_ff3)
rownames(cov_ff3) <- colnames(cov_ff3) <- tickers
# Compute MVP weights
mvp_weights_ff3 <- compute_mvp(cov_ff3)
kable(data.frame(
ETF = names(mvp_weights_ff3),
Weight = round(mvp_weights_ff3 * 100, 4)
), caption = "MVP Weights Based on FF3 Covariance Matrix (%)",
col.names = c("ETF", "Weight (%)")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| ETF | Weight (%) | |
|---|---|---|
| SPY | SPY | 0.0000 |
| QQQ | QQQ | 0.0000 |
| EEM | EEM | 15.6532 |
| IWM | IWM | 0.0000 |
| EFA | EFA | 8.2083 |
| TLT | TLT | 33.9124 |
| IYR | IYR | 0.0000 |
| GLD | GLD | 42.2260 |
cat("\nPortfolio expected variance (FF3):",
round(t(mvp_weights_ff3) %*% cov_ff3 %*% mvp_weights_ff3 * 100^2, 6), "(%^2)\n")##
## Portfolio expected variance (FF3): 8.843778 (%^2)# Get March 2025 actual returns
march_2025 <- merged_data %>%
filter(format(date, "%Y-%m") == "2025-03")
if (nrow(march_2025) == 0) {
# If not in merged, try from monthly_returns directly
march_ret <- as.numeric(monthly_returns["2025-03", tickers])
names(march_ret) <- tickers
} else {
march_ret <- as.numeric(march_2025[1, tickers])
names(march_ret) <- tickers
}
cat("March 2025 Actual ETF Returns:\n")## March 2025 Actual ETF Returns:## SPY QQQ EEM IWM EFA TLT IYR GLD
## -5.5719 -7.5862 1.1340 -6.8541 0.1839 -1.2047 -2.3382 9.4466# Realized portfolio returns
realized_capm_mar <- sum(mvp_weights_capm * march_ret)
realized_ff3_mar <- sum(mvp_weights_ff3 * march_ret)
results_mar <- data.frame(
Model = c("CAPM-based MVP", "FF3-based MVP"),
`Portfolio Return` = round(c(realized_capm_mar, realized_ff3_mar) * 100, 4)
)
kable(results_mar,
caption = "Realized MVP Portfolio Returns in March 2025 (%)",
col.names = c("Model", "Realized Return (%)")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| Model | Realized Return (%) |
|---|---|
| CAPM-based MVP | 3.8576 |
| FF3-based MVP | 3.7730 |
For April 2025, we roll the window forward to 2020/04 – 2025/03 and re-estimate weights.
# Rolling window: 2020-04-01 to 2025-03-31
window_data_apr <- merged_data %>%
filter(date >= as.Date("2020-04-01") & date <= as.Date("2025-03-31"))
cat("April rolling window observations:", nrow(window_data_apr), "\n")## April rolling window observations: 60rf_vec_apr <- window_data_apr$RF
mkt_rf_apr <- window_data_apr$`Mkt-RF`
excess_ret_apr <- window_data_apr[, tickers] - rf_vec_apr
F_mat_apr <- as.matrix(window_data_apr[, c("Mkt-RF", "SMB", "HML")])
# --- CAPM window for April ---
betas_apr <- numeric(length(tickers))
resid_vars_apr <- numeric(length(tickers))
names(betas_apr) <- names(resid_vars_apr) <- tickers
for (tk in tickers) {
fit <- lm(excess_ret_apr[[tk]] ~ mkt_rf_apr)
betas_apr[tk] <- coef(fit)[2]
resid_vars_apr[tk] <- var(residuals(fit))
}
mkt_var_apr <- var(mkt_rf_apr)
cov_capm_apr <- outer(betas_apr, betas_apr) * mkt_var_apr + diag(resid_vars_apr)
rownames(cov_capm_apr) <- colnames(cov_capm_apr) <- tickers
mvp_w_capm_apr <- compute_mvp(cov_capm_apr)
# --- FF3 window for April ---
beta_mat_apr <- matrix(0, nrow = length(tickers), ncol = 3,
dimnames = list(tickers, c("Mkt-RF","SMB","HML")))
resid_vars_ff3_apr <- numeric(length(tickers))
names(resid_vars_ff3_apr) <- tickers
for (tk in tickers) {
fit <- lm(excess_ret_apr[[tk]] ~ F_mat_apr)
beta_mat_apr[tk, ] <- coef(fit)[-1]
resid_vars_ff3_apr[tk] <- var(residuals(fit))
}
cov_factors_apr <- cov(F_mat_apr)
cov_ff3_apr <- beta_mat_apr %*% cov_factors_apr %*% t(beta_mat_apr) + diag(resid_vars_ff3_apr)
rownames(cov_ff3_apr) <- colnames(cov_ff3_apr) <- tickers
mvp_w_ff3_apr <- compute_mvp(cov_ff3_apr)
# Get April 2025 realized returns
april_2025 <- merged_data %>%
filter(format(date, "%Y-%m") == "2025-04")
if (nrow(april_2025) == 0) {
april_ret <- as.numeric(monthly_returns["2025-04", tickers])
names(april_ret) <- tickers
} else {
april_ret <- as.numeric(april_2025[1, tickers])
names(april_ret) <- tickers
}
cat("April 2025 Actual ETF Returns:\n")## April 2025 Actual ETF Returns:## SPY QQQ EEM IWM EFA TLT IYR GLD
## -0.8670 1.3968 0.1373 -2.3209 3.6951 -1.3605 -2.1514 5.4244realized_capm_apr <- sum(mvp_w_capm_apr * april_ret)
realized_ff3_apr <- sum(mvp_w_ff3_apr * april_ret)
# Compare weights
weights_comparison <- data.frame(
ETF = tickers,
CAPM_Mar = round(mvp_weights_capm * 100, 3),
FF3_Mar = round(mvp_weights_ff3 * 100, 3),
CAPM_Apr = round(mvp_w_capm_apr * 100, 3),
FF3_Apr = round(mvp_w_ff3_apr * 100, 3)
)
kable(weights_comparison,
caption = "MVP Weights Comparison: March vs April Windows (%)",
col.names = c("ETF","CAPM Mar (%)","FF3 Mar (%)","CAPM Apr (%)","FF3 Apr (%)")) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"))| ETF | CAPM Mar (%) | FF3 Mar (%) | CAPM Apr (%) | FF3 Apr (%) | |
|---|---|---|---|---|---|
| SPY | SPY | 0.000 | 0.000 | 0.000 | 0.000 |
| QQQ | QQQ | 0.000 | 0.000 | 0.000 | 0.000 |
| EEM | EEM | 14.009 | 15.653 | 18.469 | 19.494 |
| IWM | IWM | 0.000 | 0.000 | 0.000 | 0.000 |
| EFA | EFA | 8.384 | 8.208 | 11.398 | 10.515 |
| TLT | TLT | 34.248 | 33.912 | 30.464 | 30.636 |
| IYR | IYR | 0.000 | 0.000 | 0.000 | 0.000 |
| GLD | GLD | 43.358 | 42.226 | 39.670 | 39.355 |
results_apr <- data.frame(
Model = c("CAPM-based MVP", "FF3-based MVP"),
Return = round(c(realized_capm_apr, realized_ff3_apr) * 100, 4)
)
kable(results_apr,
caption = "Realized MVP Portfolio Returns in April 2025 (%)",
col.names = c("Model", "Realized Return (%)")) %>%
kable_styling(bootstrap_options = c("striped","hover","condensed"))| Model | Realized Return (%) |
|---|---|
| CAPM-based MVP | 2.1839 |
| FF3-based MVP | 2.1333 |
Problem 12: During a particular year, T-bill rate was 6%, the market return was 14%, and a stock with a beta of 0.7 had a return of 10%. Evaluate the performance of the stock relative to CAPM predictions using Jensen’s alpha.
Solution:
Under CAPM, the expected return of the stock is:
\[E(r_i) = r_f + \beta_i [E(r_M) - r_f] = 6\% + 0.7 \times (14\% - 6\%) = 6\% + 5.6\% = 11.6\%\]
Jensen’s alpha: \[\alpha = r_i - E(r_i) = 10\% - 11.6\% = -1.6\%\]
rf <- 0.06
rm <- 0.14
beta <- 0.7
r_i <- 0.10
expected_return <- rf + beta * (rm - rf)
alpha <- r_i - expected_return
cat(sprintf("Expected Return (CAPM): %.2f%%\n", expected_return * 100))## Expected Return (CAPM): 11.60%## Actual Return: 10.00%## Jensen's Alpha: -1.60%Interpretation: The stock’s Jensen’s alpha of −1.6% indicates that the stock underperformed relative to its CAPM-predicted return. Given its systematic risk (β = 0.7), investors received less compensation than the model predicts.
Problem 21: A portfolio manager summarizes the input for the mean-variance optimization. Asset A has mean return of 10% and standard deviation of 20%. Asset B has mean return of 6% and standard deviation of 15%. Correlation between A and B is 0.0. What is the minimum variance portfolio composition and its expected return and standard deviation?
Solution:
For a two-asset MVP with zero correlation:
\[w_A^* = \frac{\sigma_B^2}{\sigma_A^2 + \sigma_B^2}\]
mu_A <- 0.10; mu_B <- 0.06
sig_A <- 0.20; sig_B <- 0.15
rho_AB <- 0.00
sig_A2 <- sig_A^2; sig_B2 <- sig_B^2
cov_AB <- rho_AB * sig_A * sig_B
# MVP weights
w_A <- (sig_B2 - cov_AB) / (sig_A2 + sig_B2 - 2 * cov_AB)
w_B <- 1 - w_A
# MVP statistics
mvp_ret <- w_A * mu_A + w_B * mu_B
mvp_var <- w_A^2 * sig_A2 + w_B^2 * sig_B2 + 2 * w_A * w_B * cov_AB
mvp_sd <- sqrt(mvp_var)
cat(sprintf("MVP Weight on A: %.4f (%.2f%%)\n", w_A, w_A * 100))## MVP Weight on A: 0.3600 (36.00%)## MVP Weight on B: 0.6400 (64.00%)## MVP Expected Return: 0.0744 (7.44%)## MVP Standard Deviation: 0.1200 (12.00%)Interpretation: Investing 36% in Asset A and 64% in Asset B yields the minimum variance portfolio with an expected return of 7.44% and standard deviation of 12%.
Problem 22: Using the same assets from Problem 21, suppose the correlation changes to 0.30. Recalculate the minimum variance portfolio and comment on how the correlation affects portfolio risk.
rho_new <- 0.30
cov_AB_new <- rho_new * sig_A * sig_B
w_A_new <- (sig_B2 - cov_AB_new) / (sig_A2 + sig_B2 - 2 * cov_AB_new)
w_B_new <- 1 - w_A_new
mvp_ret_new <- w_A_new * mu_A + w_B_new * mu_B
mvp_var_new <- w_A_new^2 * sig_A2 + w_B_new^2 * sig_B2 + 2 * w_A_new * w_B_new * cov_AB_new
mvp_sd_new <- sqrt(mvp_var_new)
cat(sprintf("Correlation = 0.30\n"))## Correlation = 0.30## MVP Weight on A: 0.3034 (30.34%)## MVP Weight on B: 0.6966 (69.66%)## MVP Expected Return: 0.0721 (7.21%)## MVP Standard Deviation: 0.1357 (13.57%)##
## Change in MVP StdDev vs ρ=0: 1.5663%Interpretation: As correlation rises from 0 to 0.30, the diversification benefit decreases, leading to a higher minimum portfolio variance. The MVP standard deviation increases, confirming that lower (or negative) correlations provide superior diversification.
CFA 4: An analyst estimates that a stock has the following return probabilities: boom (0.25, return = 44%), normal (0.45, return = 14%), bust (0.30, return = −16%). Compute the expected return and standard deviation.
probs <- c(0.25, 0.45, 0.30)
returns <- c(0.44, 0.14, -0.16)
E_r <- sum(probs * returns)
Var <- sum(probs * (returns - E_r)^2)
SD <- sqrt(Var)
cat(sprintf("Expected Return: %.4f (%.2f%%)\n", E_r, E_r * 100))## Expected Return: 0.1250 (12.50%)## Variance: 0.049275## Standard Deviation: 0.2220 (22.20%)CFA 5: Historically, the 30-year Treasury bond return was 5% with std dev 2%. The stock market had a return of 15% with std dev 20%. Correlation = 0.10. Compute the expected return and standard deviation for a portfolio with 75% stocks and 25% bonds.
w_S <- 0.75; w_B_port <- 0.25
mu_S <- 0.15; mu_B_port <- 0.05
sd_S <- 0.20; sd_B_port <- 0.02
rho <- 0.10
E_port <- w_S * mu_S + w_B_port * mu_B_port
Var_port <- w_S^2 * sd_S^2 + w_B_port^2 * sd_B_port^2 +
2 * w_S * w_B_port * rho * sd_S * sd_B_port
SD_port <- sqrt(Var_port)
cat(sprintf("Portfolio Expected Return: %.4f (%.2f%%)\n", E_port, E_port * 100))## Portfolio Expected Return: 0.1250 (12.50%)## Portfolio Standard Deviation: 0.1506 (15.06%)CFA 8: Consider a portfolio with the following assets: Asset X (weight=60%, mean=10%, SD=15%) and Asset Y (weight=40%, mean=6%, SD=10%), with correlation = 0.25. Calculate the expected return and standard deviation of the portfolio.
w_X <- 0.60; w_Y <- 0.40
mu_X <- 0.10; mu_Y <- 0.06
sd_X <- 0.15; sd_Y <- 0.10
rho_XY <- 0.25
E_XY <- w_X * mu_X + w_Y * mu_Y
Var_XY <- w_X^2 * sd_X^2 + w_Y^2 * sd_Y^2 +
2 * w_X * w_Y * rho_XY * sd_X * sd_Y
SD_XY <- sqrt(Var_XY)
cat(sprintf("Portfolio Expected Return: %.4f (%.2f%%)\n", E_XY, E_XY * 100))## Portfolio Expected Return: 0.0840 (8.40%)## Portfolio Standard Deviation: 0.1072 (10.72%)Problem 11: If the simple CAPM is valid, which situations are possible? Consider the following and comment on each:
| Portfolio | E(r) | β |
|---|---|---|
| A | 20% | 1.4 |
| B | 25% | 1.2 |
Assume: \(r_f = 5\%\), \(E(r_M) = 15\%\).
rf_7 <- 0.05; rm_7 <- 0.15
beta_A <- 1.4; r_A <- 0.20
beta_B <- 1.2; r_B <- 0.25
E_A_capm <- rf_7 + beta_A * (rm_7 - rf_7)
E_B_capm <- rf_7 + beta_B * (rm_7 - rf_7)
alpha_A <- r_A - E_A_capm
alpha_B <- r_B - E_B_capm
cat(sprintf("Portfolio A — CAPM Expected: %.2f%%, Actual: %.2f%%, Alpha: %.2f%%\n",
E_A_capm*100, r_A*100, alpha_A*100))## Portfolio A — CAPM Expected: 19.00%, Actual: 20.00%, Alpha: 1.00%cat(sprintf("Portfolio B — CAPM Expected: %.2f%%, Actual: %.2f%%, Alpha: %.2f%%\n",
E_B_capm*100, r_B*100, alpha_B*100))## Portfolio B — CAPM Expected: 17.00%, Actual: 25.00%, Alpha: 8.00%Interpretation:
Problem 12: A stock has a beta of 1.2. The risk-free rate is 5% and the expected market return is 12%. What is the required return? If the stock’s expected return is 11%, should you invest in it?
rf_12 <- 0.05
rm_12 <- 0.12
beta_12 <- 1.2
actual_12 <- 0.11
required_12 <- rf_12 + beta_12 * (rm_12 - rf_12)
alpha_12 <- actual_12 - required_12
cat(sprintf("Required Return (CAPM): %.2f%%\n", required_12 * 100))## Required Return (CAPM): 13.40%## Expected Return: 11.00%## Alpha (abnormal return): -2.40%if (alpha_12 > 0) {
cat("Decision: BUY — stock is underpriced (positive alpha).\n")
} else {
cat("Decision: DO NOT BUY — stock is overpriced (negative alpha).\n")
}## Decision: DO NOT BUY — stock is overpriced (negative alpha).Interpretation: The CAPM required return is 13.4% but the expected return is only 11%, giving a negative alpha of -2.4%. The stock is overpriced relative to its systematic risk; an investor should not invest unless they have non-CAPM reasons to do so.
CFA 12: In a CAPM world, the risk-free rate is 8%, the expected return on the market is 16%. Stock X has a beta of 1.5 and an expected return of 20%. Is Stock X correctly priced, overpriced, or underpriced? What would its price need to change to be correctly priced?
rf_c <- 0.08
rm_c <- 0.16
beta_c <- 1.5
actual_c <- 0.20
required_c <- rf_c + beta_c * (rm_c - rf_c)
alpha_c <- actual_c - required_c
cat(sprintf("CAPM Required Return: %.2f%%\n", required_c * 100))## CAPM Required Return: 20.00%## Expected Return: 20.00%## Alpha: 0.00%status <- ifelse(alpha_c > 0, "UNDERPRICED (buy opportunity)",
ifelse(alpha_c < 0, "OVERPRICED (avoid or sell)", "CORRECTLY PRICED"))
cat("Pricing Status:", status, "\n")## Pricing Status: CORRECTLY PRICEDInterpretation: The CAPM expected return is 20%, but the stock only offers 20%. With alpha = 0%, the stock is overpriced. In equilibrium, selling pressure would push its price down (raising its return) until the expected return rises to 20%.
Problem 17: Suppose you have three stocks. Their alphas are 2%, −1%, and 3%; their betas are 1.0, 1.5, and 0.7; and the residual standard deviations are 30%, 20%, and 25%, respectively. The market risk premium is 8% and the risk-free rate is 4%. Using the Treynor–Black model, form the optimal active portfolio and find its contribution to performance.
# Treynor-Black model
alphas <- c(0.02, -0.01, 0.03)
betas <- c(1.0, 1.5, 0.7)
resid_sd <- c(0.30, 0.20, 0.25)
resid_var <- resid_sd^2
rf_8 <- 0.04
mkt_prem <- 0.08 # E(rM) - rf
# Step 1: Appraisal ratios
appraisal <- alphas / resid_var
# Step 2: Initial (unnormalized) active portfolio weights
w0 <- appraisal / sum(appraisal)
# Step 3: Active portfolio statistics
alpha_A <- sum(w0 * alphas)
beta_A <- sum(w0 * betas)
resid_A2 <- sum(w0^2 * resid_var)
# Step 4: Active portfolio weight in combined portfolio
# w_A* = (alpha_A / resid_A2) / (E(rM)/sigma_M2)
# Using market Sharpe ratio = mkt_prem / sd_M; assume sd_M = 20%
sd_M <- 0.20
SR_M <- mkt_prem / sd_M
w_A_star_initial <- (alpha_A / resid_A2) / (SR_M / sd_M)
# Adjustment for beta != 1
w_A_star <- w_A_star_initial / (1 + (1 - beta_A) * w_A_star_initial)
# Display
cat("--- Individual Securities ---\n")## --- Individual Securities ---for (i in 1:3) {
cat(sprintf("Stock %d: Alpha=%.2f%%, Beta=%.2f, ResidSD=%.2f%%, Appraisal Ratio=%.4f\n",
i, alphas[i]*100, betas[i], resid_sd[i]*100, appraisal[i]))
}## Stock 1: Alpha=2.00%, Beta=1.00, ResidSD=30.00%, Appraisal Ratio=0.2222
## Stock 2: Alpha=-1.00%, Beta=1.50, ResidSD=20.00%, Appraisal Ratio=-0.2500
## Stock 3: Alpha=3.00%, Beta=0.70, ResidSD=25.00%, Appraisal Ratio=0.4800##
## --- Active Portfolio ---## Weights (w0): 0.4914, -0.5528, 1.0614## Alpha_A: 0.0472 (4.72%)## Beta_A: 0.4052## ResidVar_A: 0.104371## Optimal weight of active portfolio in combined portfolio: 0.1993Interpretation: The Treynor-Black model tilts toward stocks with high alpha-to-residual-variance (appraisal ratio). Stock 3 (α=3%, σ_ε=25%) and Stock 1 (α=2%) receive positive weights, while Stock 2 (α=−1%) receives a short position. The combined portfolio weight on the active portfolio is 19.93%, which augments the passive market index position.
CFA 1: Identify and briefly explain two factors that determine the Sharpe ratio of an actively managed portfolio in the Treynor-Black framework.
Answer:
In the Treynor-Black framework, the squared Sharpe ratio of the optimally combined (active + passive) portfolio is:
\[S_P^2 = S_M^2 + \left(\frac{\alpha_A}{\sigma(\varepsilon_A)}\right)^2\]
where \(S_M\) is the Sharpe ratio of the market (passive) portfolio, \(\alpha_A\) is the alpha of the active portfolio, and \(\sigma(\varepsilon_A)\) is the residual risk of the active portfolio.
The two key factors are:
The Information Ratio (\(IR = \alpha_A / \sigma(\varepsilon_A)\)): This measures the abnormal return per unit of unsystematic (residual) risk generated by the active manager’s security selection. A higher IR (larger alpha relative to residual risk) makes a larger contribution to portfolio performance beyond the passive benchmark.
The Sharpe Ratio of the Passive Benchmark (\(S_M\)): The performance of the overall optimal portfolio is bounded below by the passive market Sharpe ratio. Even with zero active management skill, the investor achieves \(S_M\) by holding the market portfolio. Active management adds value only if \(IR > 0\).
# Illustrative: compare combined vs passive Sharpe ratio
alpha_ill <- 0.02 # 2% active alpha
resid_ill <- 0.10 # 10% residual risk
S_M_ill <- 0.40 # market Sharpe ratio
IR_ill <- alpha_ill / resid_ill
S_P_ill <- sqrt(S_M_ill^2 + IR_ill^2)
cat(sprintf("Passive Market Sharpe: %.4f\n", S_M_ill))## Passive Market Sharpe: 0.4000## Information Ratio (IR): 0.2000## Combined Portfolio Sharpe: 0.4472## Improvement over passive: 0.0472The combined portfolio Sharpe ratio of 0.4472 exceeds the passive benchmark of 0.4 because the active manager generates a positive information ratio. The higher the IR, the greater the active management benefit.