library(quantmod)
library(PerformanceAnalytics)
library(quadprog)
library(dplyr)
library(tidyr)
library(ggplot2)
library(knitr)
library(xts)
library(lubridate)tickers <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
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 prices only
adj_prices <- do.call(merge, lapply(tickers, function(tk) {
Ad(get(tk))
}))
colnames(adj_prices) <- tickers
cat("Daily price data shape:", dim(adj_prices), "\n")## Daily price data shape: 4023 8
## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 84.79638 40.29078 30.35151 51.36656 35.12844 56.13518 26.76811
## 2010-01-05 85.02082 40.29078 30.57181 51.18993 35.15940 56.49771 26.83239
## 2010-01-06 85.08070 40.04776 30.63577 51.14178 35.30801 55.74142 26.82069
## 2010-01-07 85.43986 40.07379 30.45810 51.51909 35.17178 55.83517 27.06028
## 2010-01-08 85.72417 40.40363 30.69973 51.80009 35.45043 55.81015 26.87914
## 2010-01-11 85.84389 40.23871 30.63577 51.59137 35.74147 55.50384 27.00768
## GLD
## 2010-01-04 109.80
## 2010-01-05 109.70
## 2010-01-06 111.51
## 2010-01-07 110.82
## 2010-01-08 111.37
## 2010-01-11 112.85
# Convert daily adjusted prices to end-of-month prices
monthly_prices <- to.monthly(adj_prices, indexAt = "lastof", OHLC = FALSE)
# Discrete (simple) returns: (P_t - P_{t-1}) / P_{t-1}
monthly_ret <- Return.calculate(monthly_prices, method = "discrete")
monthly_ret <- na.omit(monthly_ret)
cat("Monthly returns shape:", dim(monthly_ret), "\n")## Monthly returns shape: 191 8
## SPY QQQ EEM IWM EFA
## 2010-02-28 0.03119469 0.04603857 0.017763848 0.04475136 0.002667738
## 2010-03-31 0.06087928 0.07710907 0.081109008 0.08230661 0.063853962
## 2010-04-30 0.01547050 0.02242536 -0.001661749 0.05678463 -0.028045888
## 2010-05-31 -0.07945471 -0.07392391 -0.093935870 -0.07536617 -0.111927576
## 2010-06-30 -0.05174128 -0.05975678 -0.013986498 -0.07743393 -0.020619665
## 2010-07-31 0.06830097 0.07258241 0.109324852 0.06730902 0.116104384
## TLT IYR GLD
## 2010-02-28 -0.003425225 0.05457033 0.032748219
## 2010-03-31 -0.020573557 0.09748516 -0.004386396
## 2010-04-30 0.033219047 0.06388023 0.058834363
## 2010-05-31 0.051083751 -0.05683477 0.030513147
## 2010-06-30 0.057978089 -0.04670110 0.023553189
## 2010-07-31 -0.009464107 0.09404791 -0.050871157
# Download FF3 monthly data from Ken French's library
# Fixed Question 3 — Download Fama-French 3 Factors
ff3_url <- "https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/F-F_Research_Data_Factors_CSV.zip"
tmp_file <- tempfile(fileext = ".zip")
download.file(ff3_url, tmp_file, mode = "wb", quiet = TRUE)
tmp_dir <- tempdir()
files <- unzip(tmp_file, exdir = tmp_dir)
# Instead of a strict pattern, find the file that contains "Factors" and is a CSV
csv_file <- files[grep("Factors.*csv$", files, ignore.case = TRUE)][1]
# Check if file exists to prevent the 'invalid description' error
if (is.na(csv_file)) stop("CSV file not found in the zip archive.")
raw <- readLines(csv_file)
# ... [rest of your logic remains the same]
# Find start (first numeric row) and end (blank line before annual data)
start_row <- which(grepl("^\\s*[0-9]{6}", raw))[1]
end_row <- which(grepl("^\\s*$", raw[start_row:length(raw)]))[1] + start_row - 2
ff3_raw <- read.csv(csv_file,
skip = start_row - 1,
nrows = end_row - start_row + 1,
header = FALSE,
stringsAsFactors = FALSE)
colnames(ff3_raw) <- c("Date", "Mkt_RF", "SMB", "HML", "RF")
# Convert Date (YYYYMM) to last day of month, convert % → decimal
ff3_raw$Date <- as.Date(paste0(ff3_raw$Date, "01"), format = "%Y%m%d")
ff3_raw$Date <- as.Date(format(ff3_raw$Date + 31, "%Y-%m-01")) - 1 # last of month
ff3_raw[, c("Mkt_RF","SMB","HML","RF")] <-
ff3_raw[, c("Mkt_RF","SMB","HML","RF")] / 100
ff3_xts <- xts(ff3_raw[, c("Mkt_RF","SMB","HML","RF")],
order.by = ff3_raw$Date)
cat("FF3 factors shape:", dim(ff3_xts), "\n")## FF3 factors shape: 1196 4
## Mkt_RF SMB HML RF
## 2025-10-31 0.0196 -0.0055 -0.0310 0.0037
## 2025-11-30 -0.0013 0.0038 0.0376 0.0030
## 2025-12-31 -0.0036 -0.0106 0.0242 0.0034
## 2026-01-31 0.0102 0.0220 0.0372 0.0030
## 2026-02-28 -0.0117 0.0014 0.0283 0.0028
# Align index to last-of-month for both series
index(monthly_ret) <- as.Date(format(index(monthly_ret), "%Y-%m-01")) +
as.numeric(format(as.Date(format(
index(monthly_ret), "%Y-%m-01")) %m+% months(1) - 1,
"%d")) - 1
merged_data <- merge(monthly_ret, ff3_xts, join = "inner")
merged_data <- na.omit(merged_data)
cat("Merged dataset shape:", dim(merged_data), "\n")## Merged dataset shape: 191 12
## Date range: 2010-02-28 to 2025-12-31
## SPY QQQ EEM IWM EFA
## 2010-02-28 0.03119469 0.04603857 0.017763848 0.04475136 0.002667738
## 2010-03-31 0.06087928 0.07710907 0.081109008 0.08230661 0.063853962
## 2010-04-30 0.01547050 0.02242536 -0.001661749 0.05678463 -0.028045888
## 2010-05-31 -0.07945471 -0.07392391 -0.093935870 -0.07536617 -0.111927576
## 2010-06-30 -0.05174128 -0.05975678 -0.013986498 -0.07743393 -0.020619665
## 2010-07-31 0.06830097 0.07258241 0.109324852 0.06730902 0.116104384
## TLT IYR GLD Mkt_RF SMB HML RF
## 2010-02-28 -0.003425225 0.05457033 0.032748219 0.0339 0.0118 0.0318 0e+00
## 2010-03-31 -0.020573557 0.09748516 -0.004386396 0.0630 0.0146 0.0219 1e-04
## 2010-04-30 0.033219047 0.06388023 0.058834363 0.0199 0.0484 0.0296 1e-04
## 2010-05-31 0.051083751 -0.05683477 0.030513147 -0.0790 0.0013 -0.0248 1e-04
## 2010-06-30 0.057978089 -0.04670110 0.023553189 -0.0556 -0.0179 -0.0473 1e-04
## 2010-07-31 -0.009464107 0.09404791 -0.050871157 0.0692 0.0022 -0.0050 1e-04
# Window: 2020/03 – 2025/02
capm_window <- merged_data["2020-03/2025-02"]
ret_window <- as.matrix(coredata(capm_window[, tickers]))
cat("CAPM estimation window:", nrow(ret_window), "months\n")## CAPM estimation window: 60 months
# --- Estimate covariance matrix via CAPM residuals ---
# Use as.numeric() to flatten the xts subset into a 1D vector
mkt_rf <- as.numeric(coredata(capm_window[, "Mkt_RF"]))
rf <- as.numeric(coredata(capm_window[, "RF"]))
# Excess returns for each ETF
excess_ret <- sweep(ret_window, 1, rf, "-")
# CAPM betas via OLS
betas <- apply(excess_ret, 2, function(r) {
coef(lm(r ~ mkt_rf))[2]
})
# Residuals
fitted_excess <- outer(mkt_rf, betas)
residuals_mat <- excess_ret - fitted_excess
# CAPM-implied covariance matrix:
# Sigma = beta %*% t(beta) * var(Mkt) + diag(residual variances)
var_mkt <- var(mkt_rf)
sigma_system <- betas %o% betas * as.numeric(var_mkt)
sigma_resid <- diag(apply(residuals_mat, 2, var))
Sigma_capm <- sigma_system + sigma_resid
cat("\nCAPM-implied covariance matrix (first 3x3):\n")##
## CAPM-implied covariance matrix (first 3x3):
## SPY QQQ EEM
## SPY 0.002623 0.002884 0.001888
## QQQ 0.002884 0.003791 0.002102
## EEM 0.001888 0.002102 0.002712
# --- Minimum Variance Portfolio via quadprog ---
n <- length(tickers)
Dmat <- 2 * Sigma_capm
dvec <- rep(0, n)
# Constraints: sum of weights = 1, all weights >= 0 (long-only)
Amat <- cbind(rep(1, n), diag(n))
bvec <- c(1, rep(0, n))
mvp_capm_sol <- solve.QP(Dmat, dvec, Amat, bvec, meq = 1)
w_mvp_capm <- mvp_capm_sol$solution
names(w_mvp_capm) <- tickers
cat("\nCAPM MVP Weights:\n")##
## CAPM MVP Weights:
## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.0000 0.0000 0.1401 0.0000 0.0838 0.3425 0.0000 0.4336
# Portfolio variance & expected return
port_var_capm <- t(w_mvp_capm) %*% Sigma_capm %*% w_mvp_capm
port_mean_capm <- colMeans(ret_window) %*% w_mvp_capm
cat("\nCAPM MVP Expected Monthly Return:", round(port_mean_capm, 5))##
## CAPM MVP Expected Monthly Return: 0.00393
##
## CAPM MVP Monthly Std Dev: 0.02984
ff3_window <- capm_window # same 60-month window
smb <- coredata(ff3_window[, "SMB"])
hml <- coredata(ff3_window[, "HML"])
# FF3 factor matrix
F_mat <- cbind(mkt_rf, smb, hml)
# OLS: regress each ETF excess return on 3 factors
B_mat <- matrix(NA, nrow = n, ncol = 3)
resid_ff3 <- matrix(NA, nrow = nrow(ret_window), ncol = n)
for (i in seq_len(n)) {
fit <- lm(excess_ret[, i] ~ F_mat)
B_mat[i, ] <- coef(fit)[-1]
resid_ff3[, i] <- residuals(fit)
}
# FF3-implied covariance matrix
Sigma_F <- cov(F_mat) # 3x3 factor cov
Sigma_ff3 <- B_mat %*% Sigma_F %*% t(B_mat) +
diag(apply(resid_ff3, 2, var)) # + idiosyncratic
rownames(Sigma_ff3) <- tickers
colnames(Sigma_ff3) <- tickers
cat("FF3-implied covariance matrix (first 3x3):\n")## FF3-implied covariance matrix (first 3x3):
## SPY QQQ EEM
## SPY 0.002623 0.002885 0.001881
## QQQ 0.002885 0.003791 0.001964
## EEM 0.001881 0.001964 0.002712
# MVP via quadprog
Dmat2 <- 2 * Sigma_ff3
mvp_ff3_sol <- solve.QP(Dmat2, dvec, Amat, bvec, meq = 1)
w_mvp_ff3 <- mvp_ff3_sol$solution
names(w_mvp_ff3) <- tickers
cat("\nFF3 MVP Weights:\n")##
## FF3 MVP Weights:
## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.0000 0.0000 0.1565 0.0000 0.0821 0.3391 0.0000 0.4223
port_var_ff3 <- t(w_mvp_ff3) %*% Sigma_ff3 %*% w_mvp_ff3
port_mean_ff3 <- colMeans(ret_window) %*% w_mvp_ff3
cat("\nFF3 MVP Expected Monthly Return:", round(port_mean_ff3, 5))##
## FF3 MVP Expected Monthly Return: 0.00388
##
## FF3 MVP Monthly Std Dev: 0.02974
# March 2025 actual returns
ret_mar2025 <- as.numeric(monthly_ret["2025-03", tickers])
names(ret_mar2025) <- tickers
cat("Actual ETF returns in March 2025:\n")## Actual ETF returns in March 2025:
## SPY QQQ EEM IWM EFA TLT IYR GLD
## -0.0557 -0.0759 0.0113 -0.0685 0.0018 -0.0120 -0.0234 0.0945
# Realized returns using CAPM and FF3 weights
realized_capm_mar <- sum(w_mvp_capm * ret_mar2025)
realized_ff3_mar <- sum(w_mvp_ff3 * ret_mar2025)
cat("\nRealized MVP Return (March 2025):\n")##
## Realized MVP Return (March 2025):
## CAPM weights: 3.858 %
## FF3 weights: 3.773 %
# Summary table
kable(data.frame(
Model = c("CAPM", "FF3"),
Realized_Return_Pct = round(c(realized_capm_mar, realized_ff3_mar) * 100, 3)
), col.names = c("Model", "Realized Return (%)"),
caption = "Realized MVP Portfolio Return — March 2025")| Model | Realized Return (%) |
|---|---|
| CAPM | 3.858 |
| FF3 | 3.773 |
# New window: 2020/04 – 2025/03
window_apr <- merged_data["2020-04/2025-03"]
ret_apr_w <- as.matrix(coredata(window_apr[, tickers]))
mkt_rf_apr <- as.numeric(coredata(window_apr[, "Mkt_RF"]))
smb_apr <- as.numeric(coredata(window_apr[, "SMB"]))
hml_apr <- as.numeric(coredata(window_apr[, "HML"]))
rf_apr <- as.numeric(coredata(window_apr[, "RF"]))
excess_ret_apr <- sweep(ret_apr_w, 1, rf_apr, "-")
# --- CAPM covariance ---
betas_apr <- apply(excess_ret_apr, 2, function(r) coef(lm(r ~ mkt_rf_apr))[2])
fitted_apr <- outer(mkt_rf_apr, betas_apr)
resid_apr <- excess_ret_apr - fitted_apr
Sigma_capm2 <- betas_apr %o% betas_apr * var(mkt_rf_apr) +
diag(apply(resid_apr, 2, var))
mvp_capm2 <- solve.QP(2 * Sigma_capm2, rep(0,n), Amat, bvec, meq=1)
w_capm2 <- mvp_capm2$solution; names(w_capm2) <- tickers
# --- FF3 covariance ---
F_apr <- cbind(mkt_rf_apr, smb_apr, hml_apr)
B_apr <- matrix(NA, n, 3); resid_ff3_apr <- matrix(NA, nrow(ret_apr_w), n)
for (i in seq_len(n)) {
fit <- lm(excess_ret_apr[, i] ~ F_apr)
B_apr[i, ] <- coef(fit)[-1]
resid_ff3_apr[, i] <- residuals(fit)
}
Sigma_ff3_2 <- B_apr %*% cov(F_apr) %*% t(B_apr) +
diag(apply(resid_ff3_apr, 2, var))
mvp_ff3_2 <- solve.QP(2 * Sigma_ff3_2, rep(0,n), Amat, bvec, meq=1)
w_ff3_2 <- mvp_ff3_2$solution; names(w_ff3_2) <- tickers
# April 2025 realized returns
ret_apr2025 <- as.numeric(monthly_ret["2025-04", tickers])
names(ret_apr2025) <- tickers
cat("Actual ETF returns in April 2025:\n")## Actual ETF returns in April 2025:
## SPY QQQ EEM IWM EFA TLT IYR GLD
## -0.0087 0.0140 0.0014 -0.0232 0.0370 -0.0136 -0.0215 0.0542
realized_capm_apr <- sum(w_capm2 * ret_apr2025)
realized_ff3_apr <- sum(w_ff3_2 * ret_apr2025)
cat("\nRealized MVP Return (April 2025):\n")##
## Realized MVP Return (April 2025):
## CAPM weights: 2.184 %
## FF3 weights: 2.133 %
kable(data.frame(
Model = c("CAPM", "FF3"),
Weights_Source = "2020/04–2025/03 window",
Realized_Return_Pct = round(c(realized_capm_apr, realized_ff3_apr) * 100, 3)
), col.names = c("Model", "Estimation Window", "Realized Return (%)"),
caption = "Realized MVP Portfolio Return — April 2025")| Model | Estimation Window | Realized Return (%) |
|---|---|---|
| CAPM | 2020/04–2025/03 window | 2.184 |
| FF3 | 2020/04–2025/03 window | 2.133 |
Reference: Investments by Bodie, Kane & Marcus, 12th ed.
Problem: An investment provides a payoff of $1,100 in one year. If the risk-free rate is 5% and the required rate of return is 8%, what is the present value? What does the difference imply?
Answer:
The present value (PV) using the required rate:
\[PV = \frac{1100}{1.08} = \$1018.52\]
The risk-free PV:
\[PV_{rf} = \frac{1100}{1.05} = \$1047.62\]
The difference of $29.10 is the risk discount — the amount investors are willing to give up to avoid bearing the investment’s risk. Equivalently, investors require the extra return above the risk-free rate as compensation for taking on systematic risk.
If the investment is currently priced at $1,018.52, then:
The risk premium compensates investors for the additional uncertainty relative to a riskless Treasury investment.
Problem: A portfolio has an expected return of 13% and a standard deviation of 20%. The risk-free rate is 5%. A client wants to invest a fraction y in the risky portfolio and the rest in T-bills, targeting a standard deviation of 12%.
(a) What fraction y should be invested in the risky portfolio?
The client’s portfolio standard deviation is: \(\sigma_C = y \times \sigma_P\)
\[y = \frac{\sigma_C}{\sigma_P} = \frac{12\%}{20\%} = 0.60\]
So 60% is invested in the risky portfolio and 40% in T-bills.
(b) What is the expected return of the client’s portfolio?
\[E(r_C) = r_f + y[E(r_P) - r_f] = 5\% + 0.60 \times (13\% - 5\%) = 5\% + 4.8\% = \mathbf{9.8\%}\]
(c) What is the reward-to-variability (Sharpe) ratio?
\[S = \frac{E(r_P) - r_f}{\sigma_P} = \frac{13\% - 5\%}{20\%} = \frac{8\%}{20\%} = \mathbf{0.40}\]
The Sharpe ratio is the same for all portfolios on the Capital Allocation Line (CAL) — it is a property of the risky portfolio, independent of the allocation y.
Problem: Suppose that the borrowing rate is 9% (higher than the lending rate of 5%). The risky portfolio has E(r) = 13%, σ = 20%.
(a) Draw the CAL for borrowers and lenders.
sigma_seq <- seq(0, 35, by = 0.5)
# Lending segment: y from 0 to 1, sigma from 0 to 20
y_lend <- sigma_seq / 20
er_lend <- ifelse(y_lend <= 1,
5 + y_lend * (13 - 5),
NA)
# Borrowing segment: y > 1, sigma > 20
er_borrow <- ifelse(sigma_seq >= 20,
9 + (sigma_seq / 20) * (13 - 9),
NA)
plot(sigma_seq, er_lend,
type = "l", col = "steelblue", lwd = 2.5,
xlim = c(0, 35), ylim = c(0, 20),
xlab = "Portfolio Std Dev (%)",
ylab = "Expected Return (%)",
main = "Capital Allocation Line with Different Borrowing/Lending Rates")
lines(sigma_seq, er_borrow, col = "firebrick", lwd = 2.5, lty = 2)
points(0, 5, pch = 19, col = "steelblue", cex = 1.4)
points(0, 9, pch = 19, col = "firebrick", cex = 1.4)
points(20, 13, pch = 17, col = "black", cex = 1.6)
legend("topleft",
legend = c("Lending CAL (rf=5%)", "Borrowing CAL (rb=9%)", "Risky Portfolio P"),
col = c("steelblue", "firebrick", "black"),
lty = c(1, 2, NA), pch = c(NA, NA, 17), lwd = 2,
bty = "n")
text(20, 13, "P (13%, 20%)", pos = 4, cex = 0.85)(b) What is the maximum Sharpe ratio attainable?
Since borrowing costs more, the maximum Sharpe ratio depends on whether the investor is a lender or borrower:
The overall maximum Sharpe ratio is 0.40, achieved by lending investors.
Problem: The return on the market portfolio is 12%, the risk-free rate is 5%, and the standard deviation of the market is 20%. An investor has risk aversion coefficient A = 4.
Optimal fraction invested in the market portfolio:
\[y^* = \frac{E(r_M) - r_f}{A \cdot \sigma_M^2} = \frac{0.12 - 0.05}{4 \times (0.20)^2} = \frac{0.07}{0.16} = \mathbf{0.4375}\]
Expected return of optimal portfolio:
\[E(r_C) = 5\% + 0.4375 \times 7\% = 5\% + 3.0625\% = \mathbf{8.06\%}\]
Standard deviation of optimal portfolio:
\[\sigma_C = 0.4375 \times 20\% = \mathbf{8.75\%}\]
The investor places about 43.75% in the market and 56.25% in T-bills — a relatively conservative allocation due to the high risk aversion.
Problem: As in CFA Problem 4, but now A = 2 (less risk-averse investor).
\[y^* = \frac{0.07}{2 \times 0.04} = \frac{0.07}{0.08} = \mathbf{0.875}\]
Expected return: \[E(r_C) = 5\% + 0.875 \times 7\% = \mathbf{11.125\%}\]
Standard deviation: \[\sigma_C = 0.875 \times 20\% = \mathbf{17.5\%}\]
With A = 2, the investor puts 87.5% in the risky market portfolio — a much more aggressive position. This illustrates that lower risk aversion leads to a higher allocation to risky assets.
Problem: True or false: “A more risk-averse investor will choose a portfolio with a lower expected return.”
Answer: True, in general, but with an important qualification.
A more risk-averse investor optimally chooses a lower allocation y in the risky portfolio, reducing both expected return and standard deviation. The investor moves down the Capital Allocation Line toward the risk-free asset.
However, the statement is only strictly true when all investors face the same CAL (same risky portfolio). The key insight is that more risk-averse investors sacrifice expected return to reduce risk, settling at a point on the CAL closer to the risk-free rate.
Problem: Suppose the index model for stocks A and B gives:
(a) Expected returns:
\[E(R_A) = 1\% + 0.9 \times 8\% = 1\% + 7.2\% = \mathbf{8.2\%}\] \[E(R_B) = -2\% + 1.1 \times 8\% = -2\% + 8.8\% = \mathbf{6.8\%}\]
(b) Standard deviations:
\[\sigma_A = \sqrt{0.9^2 \times 20^2 + 30^2} = \sqrt{324 + 900} = \sqrt{1224} \approx \mathbf{34.99\%}\] \[\sigma_B = \sqrt{1.1^2 \times 20^2 + 10^2} = \sqrt{484 + 100} = \sqrt{584} \approx \mathbf{24.17\%}\]
(c) Covariance between A and B:
\[\text{Cov}(R_A, R_B) = \beta_A \beta_B \sigma_M^2 = 0.9 \times 1.1 \times 400 = \mathbf{396}\]
(d) Correlation between A and B:
\[\rho_{AB} = \frac{396}{34.99 \times 24.17} \approx \frac{396}{846} \approx \mathbf{0.468}\]
The single-index model implies that all correlation between stocks comes solely through their common exposure to the market factor, which significantly simplifies portfolio construction.
Problem: Using the same index model data as Problem 11, construct the minimum-variance portfolio of A and B.
The portfolio variance for weight w in A and (1−w) in B:
\[\sigma_P^2 = w^2 \sigma_A^2 + (1-w)^2 \sigma_B^2 + 2w(1-w)\text{Cov}(A,B)\]
Minimizing over w:
\[w^* = \frac{\sigma_B^2 - \text{Cov}(A,B)}{\sigma_A^2 + \sigma_B^2 - 2\text{Cov}(A,B)}\]
sig_A <- sqrt(0.9^2 * 400 + 900) # ~34.99
sig_B <- sqrt(1.1^2 * 400 + 100) # ~24.17
cov_AB <- 0.9 * 1.1 * 400 # 396
w_star <- (sig_B^2 - cov_AB) / (sig_A^2 + sig_B^2 - 2 * cov_AB)
er_A <- 1 + 0.9 * 8
er_B <- -2 + 1.1 * 8
port_er <- w_star * er_A + (1 - w_star) * er_B
port_var <- w_star^2 * sig_A^2 + (1 - w_star)^2 * sig_B^2 +
2 * w_star * (1 - w_star) * cov_AB
port_sd <- sqrt(port_var)
cat("Weight in A:", round(w_star, 4), "\n")## Weight in A: 0.185
## Weight in B: 0.815
## MVP Expected Return: 7.06 %
## MVP Std Dev: 23.44 %
The MVP places more weight in Stock B due to its lower idiosyncratic risk (σ(e_B) = 10% vs. 30%), even though Stock A has a slightly higher expected return.
Problem: Which of the following factors does the single-index model assume drives all covariances between security returns?
Answer: The single-index model assumes that all covariances between security returns are driven solely by their common exposure to a single market index (systematic risk). Formally:
\[\text{Cov}(R_i, R_j) = \beta_i \beta_j \sigma_M^2\]
This assumption means that once you control for market movement, the residuals \(e_i\) and \(e_j\) are uncorrelated — all firm-specific (idiosyncratic) risks are independent across stocks. This is the key simplifying assumption that reduces the number of parameters needed for portfolio optimization from \(n(n+1)/2\) covariances to just \(n\) betas plus the market variance.
Problem: Suppose two portfolio managers achieve the same Sharpe ratio. Manager A operates in a more diversified universe. Does this mean they have equal skill?
Answer: No — equal Sharpe ratios do not imply equal skill.
The appropriate performance measure depends on the investor’s context:
Since Manager A operates in a more diversified universe, their total volatility (σ) is partly lower due to diversification rather than skill. Manager B, managing a less diversified portfolio with the same Sharpe ratio, may actually be generating more alpha per unit of systematic risk, making them more skilled at security selection.
In short, the Sharpe ratio does not distinguish between risk reduction through diversification and genuine return enhancement through skill.
Problem: Define and explain the following performance measures: (a) Sharpe ratio, (b) Treynor measure, (c) Jensen’s alpha, and (d) Information ratio.
(a) Sharpe Ratio
\[S_P = \frac{E(r_P) - r_f}{\sigma_P}\]
Measures excess return per unit of total risk (standard deviation). Best used when the portfolio represents the investor’s entire risky investment — it penalizes both systematic and idiosyncratic risk equally.
(b) Treynor Measure
\[T_P = \frac{E(r_P) - r_f}{\beta_P}\]
Measures excess return per unit of systematic risk (beta). Most appropriate when the portfolio is part of a larger, well-diversified portfolio, so only market (non-diversifiable) risk matters.
(c) Jensen’s Alpha
\[\alpha_P = E(r_P) - [r_f + \beta_P (E(r_M) - r_f)]\]
The abnormal return above what the CAPM predicts given the portfolio’s market risk. A positive alpha indicates the manager added value beyond what could be achieved by a passive strategy with the same beta. Alpha is the most direct measure of stock-selection skill.
(d) Information Ratio
\[IR = \frac{\alpha_P}{\sigma(e_P)}\]
Measures the alpha generated per unit of active (idiosyncratic) risk taken. A high information ratio indicates the manager is efficiently converting active risk into outperformance. It is widely used to evaluate active managers and is especially meaningful when comparing managers within the same asset class.
| Measure | Numerator | Denominator | Best Used When |
|---|---|---|---|
| Sharpe | Excess return | Total σ | Portfolio = entire wealth |
| Treynor | Excess return | Beta | Portfolio = part of diversified fund |
| Jensen’s α | Abnormal return | — | Evaluating selection skill |
| Info Ratio | Alpha | Tracking error | Evaluating active management |