Investment Portfolio Management — Midterm
Nomin Ayurzana
April 17, 2026
1 Part I — Computer Questions
1.1 Preliminaries and R Environment
library(quantmod)
library(PerformanceAnalytics)
library(xts)
library(zoo)
library(dplyr)
library(tidyr)
library(lubridate)
library(quadprog)
library(ggplot2)
library(knitr)
library(scales)read_ff_zip <- function(url, skip_rows) {
temp <- tempfile(fileext = ".zip")
download.file(url, temp, mode = "wb", quiet = TRUE)
zip_files <- unzip(temp, list = TRUE)$Name
csv_name <- zip_files[grepl("\\.csv$", zip_files, ignore.case = TRUE)][1]
tmpdir <- tempdir()
unzip(temp, files = csv_name, exdir = tmpdir)
df <- read.csv(file.path(tmpdir, csv_name),
skip = skip_rows, header = TRUE,
stringsAsFactors = FALSE)
unlink(temp)
df
}1.2 Q1. Downloading ETF Daily Data (2010–2025)
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"adj_prices <- do.call(merge, lapply(tickers, function(tk) Ad(get(tk))))
colnames(adj_prices) <- tickers
cat("Daily observations:", nrow(adj_prices),
"\nDate range:", format(start(adj_prices)), "to",
format(end(adj_prices)), "\n")## Daily observations: 4023
## Date range: 2010-01-04 to 2025-12-30## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 84.79638 40.29079 30.35150 51.36657 35.12843 56.13520 26.76811
## 2010-01-05 85.02083 40.29079 30.57181 51.18994 35.15939 56.49768 26.83238
## 2010-01-06 85.08071 40.04777 30.63576 51.14177 35.30801 55.74144 26.82070
## GLD
## 2010-01-04 109.80
## 2010-01-05 109.70
## 2010-01-06 111.51## SPY QQQ EEM IWM EFA TLT IYR GLD
## 2025-12-26 688.4299 623.1043 54.80 250.9736 96.57 86.76930 94.05600 416.74
## 2025-12-29 685.9766 620.0881 54.66 249.4363 96.28 87.09564 94.23550 398.60
## 2025-12-30 685.1389 618.6499 54.88 247.5896 96.44 86.88797 94.44491 398.891.3 Q2. Monthly Discrete Returns
monthly_prices <- to.monthly(adj_prices, indexAt = "lastof", OHLC = FALSE)
monthly_returns <- Return.calculate(monthly_prices, method = "discrete")
monthly_returns <- na.omit(monthly_returns)
cat("Monthly return observations:", nrow(monthly_returns), "\n")## Monthly return observations: 191## SPY QQQ EEM IWM EFA TLT IYR GLD
## 2010-02-28 0.0312 0.0460 0.0178 0.0448 0.0027 -0.0034 0.0546 0.0327
## 2010-03-31 0.0609 0.0771 0.0811 0.0823 0.0639 -0.0206 0.0975 -0.0044
## 2010-04-30 0.0155 0.0224 -0.0017 0.0568 -0.0280 0.0332 0.0639 0.0588
## 2010-05-31 -0.0795 -0.0739 -0.0939 -0.0754 -0.1119 0.0511 -0.0568 0.0305
## 2010-06-30 -0.0517 -0.0598 -0.0140 -0.0774 -0.0206 0.0580 -0.0467 0.02361.4 Q3. Fama–French Three-Factor Data
ff3_url <- "https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/F-F_Research_Data_Factors_CSV.zip"
ff3_raw <- read_ff_zip(ff3_url, skip_rows = 3)
# Keep only monthly rows (6-digit YYYYMM)
ff3_raw <- ff3_raw[nchar(trimws(ff3_raw[, 1])) == 6, ]
colnames(ff3_raw) <- c("Date", "Mkt_RF", "SMB", "HML", "RF")
ff3_raw$Date <- as.Date(paste0(ff3_raw$Date, "01"), format = "%Y%m%d")
ff3_raw[, 2:5] <- lapply(ff3_raw[, 2:5], function(x) as.numeric(x) / 100)
ff3_raw <- ff3_raw[!is.na(ff3_raw$Date), ]
ff3 <- ff3_raw %>%
filter(Date >= as.Date("2010-01-01"),
Date <= as.Date("2025-12-31"))
ff3_xts <- xts(ff3[, 2:5], order.by = as.yearmon(ff3$Date))
cat("FF3 observations retained:", nrow(ff3), "\n")## FF3 observations retained: 1921.5 Q4. Merging ETF Returns and Factor Data
index(monthly_returns) <- as.yearmon(index(monthly_returns))
index(ff3_xts) <- as.yearmon(index(ff3_xts))
merged_data <- merge(monthly_returns, ff3_xts, join = "inner")
merged_data <- na.omit(merged_data)
cat("Merged dataset dimensions:", dim(merged_data),
"\nDate range:", as.character(start(merged_data)),
"→", as.character(end(merged_data)), "\n")## Merged dataset dimensions: 191 12
## Date range: Feb 2010 → Dec 2025## SPY QQQ EEM IWM EFA TLT IYR GLD
## Feb 2010 0.0312 0.0460 0.0178 0.0448 0.0027 -0.0034 0.0546 0.0327
## Mar 2010 0.0609 0.0771 0.0811 0.0823 0.0639 -0.0206 0.0975 -0.0044
## Apr 2010 0.0155 0.0224 -0.0017 0.0568 -0.0280 0.0332 0.0639 0.0588
## May 2010 -0.0795 -0.0739 -0.0939 -0.0754 -0.1119 0.0511 -0.0568 0.0305
## Jun 2010 -0.0517 -0.0598 -0.0140 -0.0774 -0.0206 0.0580 -0.0467 0.0236
## Mkt_RF SMB HML RF
## Feb 2010 0.0339 0.0118 0.0318 0e+00
## Mar 2010 0.0630 0.0146 0.0219 1e-04
## Apr 2010 0.0199 0.0484 0.0296 1e-04
## May 2010 -0.0790 0.0013 -0.0248 1e-04
## Jun 2010 -0.0556 -0.0179 -0.0473 1e-041.6 Q5. CAPM-Based Minimum-Variance Portfolio
capm_window <- merged_data[
index(merged_data) >= as.yearmon("Mar 2020") &
index(merged_data) <= as.yearmon("Feb 2025"),
]
stopifnot(nrow(capm_window) == 60)
etf_returns_capm <- as.matrix(capm_window[, tickers])
rf_capm <- as.numeric(capm_window$RF)
mkt_rf <- as.numeric(capm_window$Mkt_RF)
betas_capm <- numeric(length(tickers))
resid_capm <- matrix(NA, nrow = nrow(etf_returns_capm), ncol = length(tickers))
for (i in seq_along(tickers)) {
excess_ret <- etf_returns_capm[, i] - rf_capm
fit <- lm(excess_ret ~ mkt_rf)
betas_capm[i] <- coef(fit)[2]
resid_capm[, i] <- resid(fit)
}
names(betas_capm) <- tickers
var_mkt_capm <- var(mkt_rf)
resid_var_capm <- apply(resid_capm, 2, var)
cov_capm <- betas_capm %o% betas_capm * var_mkt_capm + diag(resid_var_capm)
colnames(cov_capm) <- rownames(cov_capm) <- tickers
# QP setup
n <- length(tickers)
Dmat <- 2 * cov_capm
dvec <- rep(0, n)
Amat <- cbind(rep(1, n), diag(n)) # sum-to-one + long-only
bvec <- c(1, rep(0, n))
sol_capm <- solve.QP(Dmat, dvec, Amat, bvec, meq = 1)
weights_capm <- sol_capm$solution
names(weights_capm) <- tickers
port_var_capm <- as.numeric(t(weights_capm) %*% cov_capm %*% weights_capm)
cat("CAPM Beta Estimates (Mar 2020 – Feb 2025):\n")## CAPM Beta Estimates (Mar 2020 – Feb 2025):## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.9552 1.0634 0.6963 1.1858 0.8243 0.3310 1.0036 0.1746##
## 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.4336cat("\nMVP variance:", round(port_var_capm, 6),
"\nMVP monthly std dev:", percent(sqrt(port_var_capm), accuracy = 0.01),
"\nMVP annualized std dev:", percent(sqrt(port_var_capm*12), accuracy = 0.01),
"\n")##
## MVP variance: 0.00089
## MVP monthly std dev: 2.98%
## MVP annualized std dev: 10.34%1.7 Q6. Fama–French Three-Factor MVP
ff3_window <- capm_window
etf_ret_ff3 <- as.matrix(ff3_window[, tickers])
rf_ff3 <- as.numeric(ff3_window$RF)
mkt_rf_ff3 <- as.numeric(ff3_window$Mkt_RF)
smb_ff3 <- as.numeric(ff3_window$SMB)
hml_ff3 <- as.numeric(ff3_window$HML)
resid_ff3 <- matrix(NA, nrow = nrow(etf_ret_ff3), ncol = length(tickers))
betas_ff3 <- matrix(NA, nrow = 3, ncol = length(tickers),
dimnames = list(c("Mkt","SMB","HML"), tickers))
for (i in seq_along(tickers)) {
excess_ret <- etf_ret_ff3[, i] - rf_ff3
fit <- lm(excess_ret ~ mkt_rf_ff3 + smb_ff3 + hml_ff3)
betas_ff3[, i] <- coef(fit)[2:4]
resid_ff3[, i] <- resid(fit)
}
factors_mat <- cbind(mkt_rf_ff3, smb_ff3, hml_ff3)
cov_factors <- cov(factors_mat)
cov_ff3 <- t(betas_ff3) %*% cov_factors %*% betas_ff3 +
diag(apply(resid_ff3, 2, var))
colnames(cov_ff3) <- rownames(cov_ff3) <- tickers
sol_ff3 <- solve.QP(2 * cov_ff3, dvec, Amat, bvec, meq = 1)
weights_ff3 <- sol_ff3$solution
names(weights_ff3) <- tickers
port_var_ff3 <- as.numeric(t(weights_ff3) %*% cov_ff3 %*% weights_ff3)
cat("FF3 Factor Loadings (Mar 2020 – Feb 2025):\n")## FF3 Factor Loadings (Mar 2020 – Feb 2025):## SPY QQQ EEM IWM EFA TLT IYR GLD
## Mkt 0.9853 1.0813 0.6794 1.0058 0.8477 0.3443 0.9953 0.2420
## SMB -0.1487 -0.0890 0.0834 0.8895 -0.1152 -0.0658 0.0409 -0.3330
## HML 0.0194 -0.3994 0.1476 0.2660 0.2169 -0.2622 0.2032 -0.0197##
## 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.4223cat("\nMVP variance:", round(port_var_ff3, 6),
"\nMVP monthly std dev:", percent(sqrt(port_var_ff3), accuracy = 0.01),
"\nMVP annualized std dev:", percent(sqrt(port_var_ff3*12), accuracy = 0.01),
"\n")##
## MVP variance: 0.000884
## MVP monthly std dev: 2.97%
## MVP annualized std dev: 10.30%compare_df <- data.frame(
Ticker = tickers,
CAPM = weights_capm,
FF3 = weights_ff3
) %>% pivot_longer(-Ticker, names_to = "Model", values_to = "Weight")
ggplot(compare_df, aes(x = Ticker, y = Weight, fill = Model)) +
geom_col(position = position_dodge(width = 0.8), width = 0.7) +
geom_text(aes(label = percent(Weight, accuracy = 0.1)),
position = position_dodge(width = 0.8),
vjust = -0.4, size = 3) +
scale_y_continuous(labels = percent, expand = expansion(mult = c(0, .15))) +
labs(title = "CAPM vs FF3 Minimum-Variance Portfolio Weights",
subtitle = "Estimation window: March 2020 – February 2025",
y = "Portfolio Weight", x = NULL) +
theme_minimal(base_size = 12) +
theme(legend.position = "top")
1.8 Q7. Realized MVP Returns in March 2025
mar2025 <- merged_data[index(merged_data) == as.yearmon("Mar 2025"), tickers]
if (nrow(mar2025) == 0) {
getSymbols(tickers, src = "yahoo",
from = "2025-02-25", to = "2025-04-05",
auto.assign = TRUE)
mar_prices <- do.call(merge, lapply(tickers, function(tk) Ad(get(tk))))
colnames(mar_prices) <- tickers
mar_monthly <- to.monthly(mar_prices, indexAt = "lastof", OHLC = FALSE)
mar2025_ret <- as.numeric(Return.calculate(mar_monthly, method = "discrete")[2, ])
} else {
mar2025_ret <- as.numeric(mar2025)
}
names(mar2025_ret) <- tickers
realized_capm_mar <- sum(weights_capm * mar2025_ret)
realized_ff3_mar <- sum(weights_ff3 * mar2025_ret)
mar_table <- data.frame(
Ticker = tickers,
Return_Mar25 = percent(mar2025_ret, accuracy = 0.01),
W_CAPM = percent(weights_capm, accuracy = 0.1),
W_FF3 = percent(weights_ff3, accuracy = 0.1)
)
kable(mar_table, caption = "March 2025 ETF returns and MVP weights")| Ticker | Return_Mar25 | W_CAPM | W_FF3 | |
|---|---|---|---|---|
| SPY | SPY | -5.57% | 0.0% | 0.0% |
| QQQ | QQQ | -7.59% | 0.0% | 0.0% |
| EEM | EEM | 1.13% | 14.0% | 15.7% |
| IWM | IWM | -6.85% | 0.0% | 0.0% |
| EFA | EFA | 0.18% | 8.4% | 8.2% |
| TLT | TLT | -1.20% | 34.2% | 33.9% |
| IYR | IYR | -2.34% | 0.0% | 0.0% |
| GLD | GLD | 9.45% | 43.4% | 42.2% |
## Realized MVP Return (CAPM weights): 3.86%## Realized MVP Return (FF3 weights): 3.77%1.9 Q8. Rolling-Window MVP Returns in April 2025
apr_window <- merged_data[
index(merged_data) >= as.yearmon("Apr 2020") &
index(merged_data) <= as.yearmon("Mar 2025"),
]
stopifnot(nrow(apr_window) == 60)
etf_ret_apr <- as.matrix(apr_window[, tickers])
rf_apr <- as.numeric(apr_window$RF)
mkt_rf_apr <- as.numeric(apr_window$Mkt_RF)
smb_apr <- as.numeric(apr_window$SMB)
hml_apr <- as.numeric(apr_window$HML)
# CAPM
betas_apr_capm <- numeric(length(tickers))
resid_apr_capm <- matrix(NA, nrow(etf_ret_apr), length(tickers))
for (i in seq_along(tickers)) {
excess_ret <- etf_ret_apr[, i] - rf_apr
fit <- lm(excess_ret ~ mkt_rf_apr)
betas_apr_capm[i] <- coef(fit)[2]
resid_apr_capm[, i] <- resid(fit)
}
cov_capm_apr <- betas_apr_capm %o% betas_apr_capm * var(mkt_rf_apr) +
diag(apply(resid_apr_capm, 2, var))
colnames(cov_capm_apr) <- rownames(cov_capm_apr) <- tickers
w_apr_capm <- solve.QP(2 * cov_capm_apr, dvec, Amat, bvec, meq = 1)$solution
names(w_apr_capm) <- tickers
# FF3
resid_apr_ff3 <- matrix(NA, nrow(etf_ret_apr), length(tickers))
betas_apr_ff3 <- matrix(NA, 3, length(tickers),
dimnames = list(c("Mkt","SMB","HML"), tickers))
for (i in seq_along(tickers)) {
excess_ret <- etf_ret_apr[, i] - rf_apr
fit <- lm(excess_ret ~ mkt_rf_apr + smb_apr + hml_apr)
betas_apr_ff3[, i] <- coef(fit)[2:4]
resid_apr_ff3[, i] <- resid(fit)
}
cov_factors_apr <- cov(cbind(mkt_rf_apr, smb_apr, hml_apr))
cov_ff3_apr <- t(betas_apr_ff3) %*% cov_factors_apr %*% betas_apr_ff3 +
diag(apply(resid_apr_ff3, 2, var))
colnames(cov_ff3_apr) <- rownames(cov_ff3_apr) <- tickers
w_apr_ff3 <- solve.QP(2 * cov_ff3_apr, dvec, Amat, bvec, meq = 1)$solution
names(w_apr_ff3) <- tickers
# April 2025 realized returns
getSymbols(tickers, src = "yahoo",
from = "2025-03-25", to = "2025-05-05",
auto.assign = TRUE)## [1] "SPY" "QQQ" "EEM" "IWM" "EFA" "TLT" "IYR" "GLD"apr_prices <- do.call(merge, lapply(tickers, function(tk) Ad(get(tk))))
colnames(apr_prices) <- tickers
apr_monthly <- to.monthly(apr_prices, indexAt = "lastof", OHLC = FALSE)
apr2025_ret <- as.numeric(Return.calculate(apr_monthly, method = "discrete")[2, ])
names(apr2025_ret) <- tickers
realized_capm_apr <- sum(w_apr_capm * apr2025_ret)
realized_ff3_apr <- sum(w_apr_ff3 * apr2025_ret)
apr_table <- data.frame(
Ticker = tickers,
Return_Apr25 = percent(apr2025_ret, accuracy = 0.01),
W_CAPM = percent(w_apr_capm, accuracy = 0.1),
W_FF3 = percent(w_apr_ff3, accuracy = 0.1)
)
kable(apr_table, caption = "April 2025 ETF returns and rolled-forward MVP weights")| Ticker | Return_Apr25 | W_CAPM | W_FF3 | |
|---|---|---|---|---|
| SPY | SPY | -0.87% | 0.0% | 0.0% |
| QQQ | QQQ | 1.40% | 0.0% | 0.0% |
| EEM | EEM | 0.14% | 18.5% | 19.5% |
| IWM | IWM | -2.32% | 0.0% | 0.0% |
| EFA | EFA | 3.70% | 11.4% | 10.5% |
| TLT | TLT | -1.36% | 30.5% | 30.6% |
| IYR | IYR | -2.15% | 0.0% | 0.0% |
| GLD | GLD | 5.42% | 39.7% | 39.4% |
## Realized MVP Return April 2025 (CAPM): 2.18%## Realized MVP Return April 2025 (FF3): 2.13%1.9.1 Summary of Out-of-Sample Performance
summary_df <- data.frame(
Month = c("March 2025", "April 2025"),
CAPM_MVP = percent(c(realized_capm_mar, realized_capm_apr), accuracy = 0.01),
FF3_MVP = percent(c(realized_ff3_mar, realized_ff3_apr), accuracy = 0.01)
)
kable(summary_df,
caption = "Out-of-sample realized MVP returns under CAPM and FF3 covariance structures")| Month | CAPM_MVP | FF3_MVP |
|---|---|---|
| March 2025 | 3.86% | 3.77% |
| April 2025 | 2.18% | 2.13% |
2 Part II — Textbook Questions
2.1 Chapter 5 — Problem 12
Q12. Using the Ken French “6 Portfolios formed on Size and Book-to-Market” (2×3, value-weighted, January 1930 – December 2018), split the sample into two equal halves. Compute the arithmetic mean, standard deviation, skewness and excess kurtosis for each half and each portfolio. Do the two halves appear to come from the same underlying return distribution?
p6_url <- "https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/6_Portfolios_2x3_CSV.zip"
p6_raw <- read_ff_zip(p6_url, skip_rows = 15)
p6_raw <- p6_raw[nchar(trimws(p6_raw[, 1])) == 6, ]
colnames(p6_raw) <- c("Date","SL","SM","SH","BL","BM","BH")
p6_raw[, 2:7] <- lapply(p6_raw[, 2:7], function(x) as.numeric(x) / 100)
p6_raw$Date <- as.Date(paste0(p6_raw$Date, "01"), format = "%Y%m%d")
p6_raw <- p6_raw[!is.na(p6_raw$Date), ]
p6_raw <- p6_raw[p6_raw$Date >= as.Date("1930-01-01") &
p6_raw$Date <= as.Date("2018-12-31"), ]
p6_raw <- na.omit(p6_raw[p6_raw[, 2] > -9.99, ]) # remove sentinel missing
mid <- floor(nrow(p6_raw) / 2)
h1 <- p6_raw[1:mid, 2:7]
h2 <- p6_raw[(mid + 1):nrow(p6_raw), 2:7]
port_names <- c("Small-Low","Small-Mid","Small-High",
"Big-Low","Big-Mid","Big-High")
summarize_half <- function(df, label) {
data.frame(
Portfolio = port_names,
Half = label,
Mean = sapply(df, mean),
SD = sapply(df, sd),
Skewness = sapply(df, function(x) mean(((x - mean(x)) / sd(x))^3)),
Kurtosis = sapply(df, function(x) mean(((x - mean(x)) / sd(x))^4) - 3)
)
}
stats_all <- rbind(summarize_half(h1, "First Half"),
summarize_half(h2, "Second Half"))
rownames(stats_all) <- NULL
kable(stats_all, digits = 4,
caption = "Sample moments of Fama–French 6 portfolios, first half vs. second half (1930–2018)")| Portfolio | Half | Mean | SD | Skewness | Kurtosis |
|---|---|---|---|---|---|
| Small-Low | First Half | 1.6891 | 3.8639 | 2.4918 | 5.1118 |
| Small-Mid | First Half | 1.8524 | 3.7854 | 2.1065 | 3.0868 |
| Small-High | First Half | 2.1320 | 4.5585 | 2.3731 | 4.8271 |
| Big-Low | First Half | 1.9326 | 3.2774 | 2.4332 | 6.2701 |
| Big-Mid | First Half | 1.4976 | 2.5378 | 2.9219 | 11.1153 |
| Big-High | First Half | 0.9583 | 2.3514 | 5.2931 | 34.6785 |
| Small-Low | Second Half | 0.3884 | 1.4232 | 4.3712 | 19.8119 |
| Small-Mid | Second Half | 0.3799 | 1.3655 | 4.2697 | 18.5047 |
| Small-High | Second Half | 0.2270 | 0.7820 | 4.4606 | 20.7180 |
| Big-Low | Second Half | 14.1449 | 49.5207 | 3.9395 | 16.0579 |
| Big-Mid | Second Half | 10.0016 | 36.3434 | 4.3095 | 19.0608 |
| Big-High | Second Half | 8.9243 | 34.2899 | 4.7575 | 23.8582 |
2.2 Chapter 6 — Problem 21
Given: \(E(r_{P}) = 11\%\), \(\sigma_{P} = 15\%\), \(r_{f} = 5\%\).
(a) A client wants expected return \(E(r_{C}) = 8\%\). Find the weight \(y\) allocated to the risky portfolio.
(b) Compute the resulting standard deviation of the client’s portfolio.
(c) A second client requires \(\sigma_{C} \le 12\%\). Which client is more risk-averse?
Erp <- 0.11; sigp <- 0.15; rf <- 0.05
# (a)
y_a <- (0.08 - rf) / (Erp - rf)
cat(sprintf("(a) y = (0.08 - 0.05)/(0.11 - 0.05) = %.4f\n", y_a))## (a) y = (0.08 - 0.05)/(0.11 - 0.05) = 0.5000## Weight in risk-free asset = 0.5000# (b)
sig_C_a <- y_a * sigp
cat(sprintf("(b) σ_C = %.4f × %.4f = %.4f (= %.2f%%)\n",
y_a, sigp, sig_C_a, sig_C_a*100))## (b) σ_C = 0.5000 × 0.1500 = 0.0750 (= 7.50%)# (c)
y_c <- 0.12 / sigp
Er_C_c <- rf + y_c * (Erp - rf)
cat(sprintf("(c) Client 2: y = %.4f, E(r_C) = %.4f\n", y_c, Er_C_c))## (c) Client 2: y = 0.8000, E(r_C) = 0.0980cat(" Client 1 tolerates only 7.5% risk for 8% return; Client 2 accepts 12% risk for 9.8% return.\n")## Client 1 tolerates only 7.5% risk for 8% return; Client 2 accepts 12% risk for 9.8% return.## Therefore Client 1 is MORE risk-averse.2.3 Chapter 6 — Problem 22
IMI’s forecasts: \(E(r_{M}) = 12\%\), \(\sigma_{M} = 20\%\), \(r_{f} = 5\%\). Samuel Johnson requests a portfolio with volatility equal to half that of the market (\(\sigma = 10\%\)). Using the CML, what expected return can IMI deliver?
ErM <- 0.12; sigM <- 0.20; rf22 <- 0.05
sig_target <- sigM / 2
Er_johnson <- rf22 + ((ErM - rf22) / sigM) * sig_target
y_johnson <- sig_target / sigM
cat(sprintf("Slope of CML (Sharpe ratio of market) = %.4f\n", (ErM-rf22)/sigM))## Slope of CML (Sharpe ratio of market) = 0.3500## Target σ: 10.00%cat(sprintf("Expected return on Johnson's portfolio: %.4f (= %.2f%%)\n",
Er_johnson, Er_johnson*100))## Expected return on Johnson's portfolio: 0.0850 (= 8.50%)## Weight in market portfolio: y = 0.50## Weight in risk-free asset: 1 - y = 0.502.4 Chapter 6 — CFA Problem 4
From the graph: which indifference curve represents the greatest utility?
Answer. Indifference curve 1 represents the greatest attainable utility. Given the investor’s mean–variance utility \(U = E(r) - \tfrac{1}{2}A\sigma^{2}\), indifference curves are parallel upward parabolas in \((\sigma, E(r))\)-space, with higher curves corresponding to higher utility. Curves 2, 3, and 4 either lie above the Capital Allocation Line (unattainable) or below the tangency (suboptimal). The investor maximizes utility where the highest feasible indifference curve is tangent to the CAL — that single point corresponds to curve 1.
2.5 Chapter 6 — CFA Problem 5
Which point designates the optimal portfolio of risky assets?
Answer. Point E — the tangency point of the Capital Allocation Line with the efficient frontier — is the optimal portfolio of risky assets. This tangency is independent of the investor’s risk aversion: every investor, regardless of \(A\), holds the same risky portfolio and only adjusts the split between this portfolio and the risk-free asset. This is the celebrated two-fund separation theorem (Tobin, 1958).
2.6 Chapter 6 — CFA Problem 8
Equity fund: risk premium 10%, \(\sigma = 14\%\), \(r_{f} = 6\%\). Client holds $60,000 in the equity fund and $40,000 in T-bills. Find portfolio expected return and standard deviation.
rp_eq <- 0.10
sig_eq <- 0.14
rf_eq <- 0.06
Er_eq <- rf_eq + rp_eq
w_eq <- 60000 / 100000
w_tbill <- 40000 / 100000
Er_client <- w_eq * Er_eq + w_tbill * rf_eq
sig_client <- w_eq * sig_eq
cat(sprintf("E(r_fund) = %.2f%% + %.2f%% = %.2f%%\n",
rf_eq*100, rp_eq*100, Er_eq*100))## E(r_fund) = 6.00% + 10.00% = 16.00%cat(sprintf("E(r_client) = %.2f × %.4f + %.2f × %.4f = %.4f (%.2f%%)\n",
w_eq, Er_eq, w_tbill, rf_eq, Er_client, Er_client*100))## E(r_client) = 0.60 × 0.1600 + 0.40 × 0.0600 = 0.1200 (12.00%)## σ_client = 0.60 × 0.1400 = 0.0840 (8.40%)2.7 Chapter 7 — Problem 11
Stocks: \(E(r)=18\%\), \(\sigma=22\%\). Gold: \(E(r)=10\%\), \(\sigma=30\%\).
(a) Would rational investors ever hold gold?
(b) If \(\rho = 1\), would anyone hold gold?
(c) Can \(\rho = 1\) arise in equilibrium?
Er_s <- 0.18; sig_s <- 0.22
Er_g <- 0.10; sig_g <- 0.30
weights <- seq(0, 1, by = 0.01)
frontier_data <- do.call(rbind, lapply(c(-0.5, 0, 0.5, 1), function(rho) {
data.frame(
w_stock = weights,
Er = weights * Er_s + (1 - weights) * Er_g,
Sig = sqrt(weights^2 * sig_s^2 + (1 - weights)^2 * sig_g^2 +
2 * weights * (1 - weights) * rho * sig_s * sig_g),
rho = factor(rho, levels = c(-0.5, 0, 0.5, 1))
)
}))
ggplot(frontier_data, aes(x = Sig, y = Er, color = rho)) +
geom_path(size = 1) +
geom_point(aes(x = sig_s, y = Er_s), color = "steelblue", size = 3, shape = 17) +
geom_point(aes(x = sig_g, y = Er_g), color = "goldenrod3", size = 3, shape = 17) +
annotate("text", x = sig_s + 0.005, y = Er_s, label = "Stocks", hjust = 0) +
annotate("text", x = sig_g + 0.005, y = Er_g, label = "Gold", hjust = 0) +
scale_x_continuous(labels = percent_format(accuracy = 1)) +
scale_y_continuous(labels = percent_format(accuracy = 1)) +
labs(title = "Two-asset frontier: Stocks and Gold under varying correlations",
x = "Portfolio Standard Deviation", y = "Expected Return",
color = "ρ") +
theme_minimal(base_size = 12)
(a) Despite gold’s apparent dominance by stocks on a stand-alone mean–variance basis, rational investors may still hold gold when its correlation with stocks is sufficiently low or negative. As the plot demonstrates, for \(\rho = -0.5\) or \(\rho = 0\), the frontier bulges to the left of the stocks-only point, meaning that a mixed portfolio can achieve the same expected return as stocks with strictly less variance. This is the essential lesson of diversification: the marginal contribution of an asset to portfolio variance depends on its covariance with the existing portfolio, not its own variance.
(b) If \(\rho = 1\), the frontier collapses to a straight line between the two assets in \((\sigma, E(r))\)-space. Gold is then a dominated asset (same or higher risk, lower return), and no rational investor would hold it.
(c) \(\rho = 1\) is inconsistent with market equilibrium when gold is dominated. If no investor holds gold, its price must fall until expected returns rise sufficiently to attract demand — restoring equilibrium at either a higher expected return or a lower correlation with stocks. The persistent existence of gold as a held asset therefore requires \(\rho < 1\).
2.8 Chapter 7 — Problem 12
Stocks A and B: \(E(r_{A})=10\%\), \(\sigma_{A}=5\%\); \(E(r_{B})=15\%\), \(\sigma_{B}=10\%\); \(\rho = -1\). What must the risk-free rate equal?
w_A_rf <- 10 / (5 + 10)
w_B_rf <- 1 - w_A_rf
Er_riskfree_port <- w_A_rf * 0.10 + w_B_rf * 0.15
cat(sprintf("w_A = %.4f, w_B = %.4f\n", w_A_rf, w_B_rf))## w_A = 0.6667, w_B = 0.3333cat(sprintf("Zero-risk portfolio return = %.4f (%.2f%%)\n",
Er_riskfree_port, Er_riskfree_port*100))## Zero-risk portfolio return = 0.1167 (11.67%)## Therefore r_f must equal 11.67% to rule out arbitrage.If \(r_{f}\) were below 11.67%, an investor could borrow at \(r_{f}\) and earn 11.67% risk-free — a money pump. If \(r_{f}\) were above 11.67%, the reverse arbitrage (sell short the synthetic portfolio, lend at \(r_{f}\)) applies. By the no-arbitrage principle, \(r_{f} = 11.67\%\).
2.9 Chapter 7 — CFA Problem 12: Abigail Grace
Grace holds a $1,000,000 diversified portfolio. She is considering: (a) adding $100,000 of ABC stock; (b) adding $100,000 of risk-free government securities paying 0.42% monthly. Given \(E(r_{\text{orig}})=0.67\%\), \(\sigma_{\text{orig}}=2.37\%\), \(E(r_{\text{ABC}})=1.25\%\), \(\sigma_{\text{ABC}}=2.95\%\), \(\rho_{\text{ABC,orig}}=0.40\).
w_orig <- 0.90
w_abc <- 0.10
Er_orig <- 0.0067; sig_orig <- 0.0237
Er_abc <- 0.0125; sig_abc <- 0.0295
rho_abc <- 0.40
# (a) Adding ABC
Er_new_a <- w_orig * Er_orig + w_abc * Er_abc
cov_abc_orig <- rho_abc * sig_abc * sig_orig
sig_new_a <- sqrt(w_orig^2 * sig_orig^2 +
w_abc^2 * sig_abc^2 +
2 * w_orig * w_abc * cov_abc_orig)
cat("=== (a) Adding ABC ===\n")## === (a) Adding ABC ===## E(r_new) = 0.007280 (0.7280%)## Cov(ABC, Original) = 0.000280## σ_new = 0.022672 (2.2672%)# (b) Adding risk-free
Er_gov <- 0.0042
Er_new_b <- w_orig * Er_orig + w_abc * Er_gov
sig_new_b <- w_orig * sig_orig # risk-free has zero variance and covariance
cat("=== (b) Adding risk-free government securities ===\n")## === (b) Adding risk-free government securities ===## E(r_new) = 0.006450 (0.6450%)## Cov(Gov, Original) = 0## σ_new = 0.021330 (2.1330%)(c) Systematic-risk comparison. Risk-free government securities have beta 0, so replacing equity (beta ≈ 1) with government bonds mechanically reduces the portfolio’s systematic risk (beta) while eliminating its own contribution to total variance. Grace’s total portfolio beta falls, with proportionally reduced sensitivity to broad market movements.
(d) ABC vs. XYZ with identical marginal moments. The husband is incorrect. Even if ABC and XYZ share the same expected return and standard deviation, their correlations with Grace’s existing portfolio may differ materially. Portfolio variance \[ \sigma^{2}_{P} = \sum_{i} w_{i}^{2}\sigma_{i}^{2} + 2\sum_{i<j} w_{i}w_{j}\rho_{ij}\sigma_{i}\sigma_{j} \] depends on pairwise covariances; identical marginals do not imply interchangeability.
(e) Standard deviation as a risk measure for Grace. Grace is concerned primarily with loss, yet standard deviation is a symmetric measure — it penalizes upside and downside deviations equally. More appropriate downside measures include:
- Semi-variance / downside deviation: second moment of returns below a target.
- Value-at-Risk (VaR): worst loss at a given confidence level.
- Expected Shortfall / Conditional VaR: expected loss given that the loss exceeds the VaR threshold.
These measures align risk assessment with Grace’s loss-aversion preferences.
2.10 Chapter 8 — Problem 17
Macro forecasts: \(r_{f} = 8\%\), \(E(r_{M}) = 16\%\), \(\sigma_{M} = 23\%\). Micro forecasts for four stocks (A, B, C, D): expected returns \(\{20\%, 18\%, 17\%, 12\%\}\), betas \(\{1.3, 1.8, 0.7, 1.0\}\), residual standard deviations \(\{58\%, 71\%, 60\%, 55\%\}\). Apply the Treynor–Black framework.
rf_17 <- 0.08; Er_mkt <- 0.16; sig_mkt <- 0.23
stocks <- data.frame(
name = c("A","B","C","D"),
Er = c(0.20, 0.18, 0.17, 0.12),
beta = c(1.3, 1.8, 0.7, 1.0),
res_sd = c(0.58, 0.71, 0.60, 0.55)
)
# (a) CAPM-required return, alpha, residual variance
stocks$Er_capm <- rf_17 + stocks$beta * (Er_mkt - rf_17)
stocks$alpha <- stocks$Er - stocks$Er_capm
stocks$res_var <- stocks$res_sd^2
kable(stocks[, c("name","Er","Er_capm","alpha","res_var")],
digits = 4, caption = "(a) Alphas and residual variances")| name | Er | Er_capm | alpha | res_var |
|---|---|---|---|---|
| A | 0.20 | 0.184 | 0.016 | 0.3364 |
| B | 0.18 | 0.224 | -0.044 | 0.5041 |
| C | 0.17 | 0.136 | 0.034 | 0.3600 |
| D | 0.12 | 0.160 | -0.040 | 0.3025 |
# (b) Active-portfolio weights w_i ∝ α_i / σ²(ε_i)
stocks$w0 <- stocks$alpha / stocks$res_var
stocks$w <- stocks$w0 / sum(stocks$w0)
kable(stocks[, c("name","alpha","res_var","w0","w")],
digits = 4, caption = "(b) Active-portfolio weights")| name | alpha | res_var | w0 | w |
|---|---|---|---|---|
| A | 0.016 | 0.3364 | 0.0476 | -0.6136 |
| B | -0.044 | 0.5041 | -0.0873 | 1.1261 |
| C | 0.034 | 0.3600 | 0.0944 | -1.2185 |
| D | -0.040 | 0.3025 | -0.1322 | 1.7060 |
alpha_A <- sum(stocks$w * stocks$alpha)
beta_A <- sum(stocks$w * stocks$beta)
resvar_A <- sum(stocks$w^2 * stocks$res_var)
cat(sprintf("α_A = %.4f β_A = %.4f σ²(ε_A) = %.4f\n",
alpha_A, beta_A, resvar_A))## α_A = -0.1690 β_A = 2.0824 σ²(ε_A) = 2.1809# (c) Sharpe ratio of the optimal risky portfolio
IR_A <- alpha_A / sqrt(resvar_A) # information ratio
Sp <- (Er_mkt - rf_17) / sig_mkt # passive Sharpe
S_opt <- sqrt(Sp^2 + IR_A^2)
cat(sprintf("\n(c) Passive Sharpe S_M = %.4f\n", Sp))##
## (c) Passive Sharpe S_M = 0.3478## Information ratio IR = -0.1145## Optimal Sharpe S* = 0.3662 (= sqrt(S_M² + IR²))##
## (d) Absolute improvement: 0.0183## Relative improvement: 5.28%# (e) Complete portfolio for A = 2.8
var_mkt <- sig_mkt^2
w_A_raw <- (alpha_A / resvar_A) /
((Er_mkt - rf_17) / var_mkt + alpha_A / resvar_A * (1 - beta_A))
w_A_adj <- w_A_raw / (1 + (1 - beta_A) * w_A_raw)
Er_risky <- (1 - w_A_adj) * (Er_mkt - rf_17) +
w_A_adj * (alpha_A + beta_A * (Er_mkt - rf_17))
var_risky <- ((1 - w_A_adj) + w_A_adj * beta_A)^2 * var_mkt +
w_A_adj^2 * resvar_A
y_star <- Er_risky / (2.8 * var_risky)
cat("\n(e) Complete portfolio for A = 2.8:\n")##
## (e) Complete portfolio for A = 2.8:## Weight of active portfolio (within risky): -0.0461## Weight of passive market (within risky): 1.0461## Overall allocation to risky assets y* : 0.5713## Allocation to T-bills : 0.42872.11 Chapter 8 — CFA Problem 1
Regressions of ABC and XYZ excess returns on the market excess return yield: ABC — \(\alpha=-3.20\%\), \(\beta=0.60\), \(R^{2}=0.35\), residual SD \(=13.02\%\); XYZ — \(\alpha=+7.30\%\), \(\beta=0.97\), \(R^{2}=0.17\), residual SD \(=21.45\%\). Discuss the implications.
cfa1 <- data.frame(
Statistic = c("Alpha (%)","Beta","R-squared","Residual SD (%)"),
ABC = c(-3.20, 0.60, 0.35, 13.02),
XYZ = c( 7.30, 0.97, 0.17, 21.45)
)
kable(cfa1, caption = "Regression statistics for ABC and XYZ")| Statistic | ABC | XYZ |
|---|---|---|
| Alpha (%) | -3.20 | 7.30 |
| Beta | 0.60 | 0.97 |
| R-squared | 0.35 | 0.17 |
| Residual SD (%) | 13.02 | 21.45 |