# ── Install missing packages automatically ────────────────────────────────────
pkgs <- c("quantmod","tidyverse","lubridate","xts","zoo","quadprog",
          "PerformanceAnalytics","ggplot2","knitr","kableExtra","e1071","httr")
new  <- pkgs[!pkgs %in% installed.packages()[,"Package"]]
if (length(new)) install.packages(new, repos = "https://cloud.r-project.org")

library(quantmod)
library(tidyverse)
library(lubridate)
library(xts)
library(zoo)
library(quadprog)
library(PerformanceAnalytics)
library(ggplot2)
library(knitr)
library(kableExtra)
library(e1071)
library(httr)

# ── Helper: download a Ken French zip and return the raw text lines ───────────
fetch_french_zip <- function(zip_url) {
  tmp_zip <- tempfile(fileext = ".zip")
  tmp_dir <- tempdir()
  resp <- httr::GET(zip_url,
                    httr::user_agent("Mozilla/5.0"),
                    httr::write_disk(tmp_zip, overwrite = TRUE),
                    httr::timeout(120))
  httr::stop_for_status(resp)
  csv_file <- unzip(tmp_zip, exdir = tmp_dir)[1]   # extract & get path
  readLines(csv_file, warn = FALSE)
}

1 Computer Questions

1.1 Q1 — Download ETF Daily Price Data (2010–2025)

I used quantmod::getSymbols() with Yahoo Finance as the data source and extract adjusted closing prices to account for dividends and splits.

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 and merge into one xts object
prices_daily <- do.call(merge, lapply(tickers, function(tk) Ad(get(tk))))
colnames(prices_daily) <- tickers

cat("Daily price data dimensions:", dim(prices_daily), "\n")
## Daily price data dimensions: 4023 8
cat("Date range:", as.character(range(index(prices_daily))), "\n")
## Date range: 2010-01-04 2025-12-30
head(prices_daily, 5) %>%
  as.data.frame() %>%
  round(2) %>%
  kable(caption = "First 5 Rows of Daily Adjusted Prices") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE)
First 5 Rows of Daily Adjusted Prices
SPY QQQ EEM IWM EFA TLT IYR GLD
2010-01-04 84.80 40.29 30.35 51.37 35.13 56.14 26.77 109.80
2010-01-05 85.02 40.29 30.57 51.19 35.16 56.50 26.83 109.70
2010-01-06 85.08 40.05 30.64 51.14 35.31 55.74 26.82 111.51
2010-01-07 85.44 40.07 30.46 51.52 35.17 55.84 27.06 110.82
2010-01-08 85.72 40.40 30.70 51.80 35.45 55.81 26.88 111.37

1.2 Q2 — Monthly Discrete Returns

We convert daily prices to end-of-month prices using to.monthly(), then compute discrete (simple) returns: \(R_t = \frac{P_t - P_{t-1}}{P_{t-1}}\).

# End-of-month adjusted prices
monthly_prices <- do.call(merge,
  lapply(tickers, function(tk) {
    m <- to.monthly(Ad(get(tk)), indexAt = "lastof", OHLC = FALSE)
    colnames(m) <- tk
    m
  })
)

# Discrete monthly returns
monthly_returns <- na.omit(Return.calculate(monthly_prices, method = "discrete"))

cat("Monthly returns dimensions:", dim(monthly_returns), "\n")
## Monthly returns dimensions: 191 8
cat("Date range:", as.character(range(index(monthly_returns))), "\n")
## Date range: 2010-02-28 2025-12-31
tail(monthly_returns, 6) %>%
  as.data.frame() %>%
  round(4) %>%
  kable(caption = "Last 6 Months of Monthly Discrete Returns") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE)
Last 6 Months of Monthly Discrete Returns
SPY QQQ EEM IWM EFA TLT IYR GLD
2025-07-31 0.0230 0.0242 0.0066 0.0167 -0.0209 -0.0114 0.0012 -0.0061
2025-08-31 0.0205 0.0095 0.0268 0.0719 0.0452 0.0001 0.0291 0.0499
2025-09-30 0.0356 0.0538 0.0710 0.0318 0.0207 0.0359 0.0006 0.1176
2025-10-31 0.0238 0.0478 0.0356 0.0176 0.0120 0.0138 -0.0249 0.0356
2025-11-30 0.0020 -0.0156 -0.0177 0.0102 0.0074 0.0027 0.0237 0.0537
2025-12-31 0.0083 0.0016 0.0248 0.0004 0.0315 -0.0188 -0.0137 0.0284

1.3 Q3 — Download Fama–French 3-Factor Data

We download the Fama–French 3-Factor monthly file directly from Ken French’s data library and convert percentage values to decimals.

ff3_lines <- fetch_french_zip(
  "https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/F-F_Research_Data_Factors_CSV.zip"
)

# Find the header row (contains "Mkt-RF")
header_idx <- which(grepl("Mkt-RF", ff3_lines))[1]

# Read from the header row; stop before the blank line that precedes annual data
raw_text   <- ff3_lines[header_idx:length(ff3_lines)]
blank_idx  <- which(raw_text == "" | trimws(raw_text) == "")[1]
monthly_text <- raw_text[1:(blank_idx - 1)]

ff_monthly <- read.csv(
  text             = paste(monthly_text, collapse = "\n"),
  header           = TRUE,
  stringsAsFactors = FALSE,
  strip.white      = TRUE
) %>%
  setNames(c("Date","MktRF","SMB","HML","RF")) %>%
  filter(grepl("^\\d{6}$", trimws(Date))) %>%
  mutate(
    Date  = as.Date(paste0(trimws(Date), "01"), "%Y%m%d"),
    Date  = ceiling_date(Date, "month") - days(1),
    across(c(MktRF, SMB, HML, RF), ~ as.numeric(.x) / 100)
  ) %>%
  filter(!is.na(MktRF))

ff_xts <- xts(ff_monthly[, c("MktRF","SMB","HML","RF")],
              order.by = ff_monthly$Date)

cat("FF3 data range:", as.character(range(index(ff_xts))), "\n")
## FF3 data range: 1926-07-31 2026-02-28
tail(ff_xts, 3)
##              MktRF     SMB    HML     RF
## 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

1.4 Q4 — Merge Monthly Returns with FF3 Factors

We align the two datasets on their common date index (end-of-month).

# Align index to last-of-month for both series
index(monthly_returns) <- ceiling_date(index(monthly_returns), "month") - 1
index(ff_xts)          <- ceiling_date(index(ff_xts),          "month") - 1

merged_data <- merge(monthly_returns, ff_xts, join = "inner")

cat("Merged dataset dimensions:", dim(merged_data), "\n")
## Merged dataset dimensions: 191 12
cat("Columns:", colnames(merged_data), "\n")
## Columns: SPY QQQ EEM IWM EFA TLT IYR GLD MktRF SMB HML RF
cat("Date range:", as.character(range(index(merged_data))), "\n")
## Date range: 2010-02-28 2025-12-31

1.5 Q5 — MVP via CAPM Covariance Matrix (2020/03–2025/02)

1.5.1 Methodology

Under CAPM, the return of asset \(i\) is: \[R_{i,t} - R_{f,t} = \alpha_i + \beta_i (R_{m,t} - R_{f,t}) + \varepsilon_{i,t}\]

The structured covariance matrix decomposes as: \[\Sigma = \beta \beta^{\top} \sigma_m^2 + \mathbf{D}\] where \(\mathbf{D} = \text{diag}(\sigma_{\varepsilon_1}^2, \ldots, \sigma_{\varepsilon_N}^2)\).

The Minimum Variance Portfolio (MVP) solves: \[\min_{\mathbf{w}} \; \mathbf{w}^{\top} \Sigma \mathbf{w} \quad \text{s.t.} \quad \mathbf{w}^{\top} \mathbf{1} = 1, \; \mathbf{w} \geq 0\]

# Training window: 2020-03 to 2025-02
train_window <- merged_data["2020-03-01/2025-02-28"]
R_etf  <- as.matrix(train_window[, tickers])
R_mkt  <- as.numeric(train_window$MktRF)
R_f    <- as.numeric(train_window$RF)
excess_R <- sweep(R_etf, 1, R_f, "-")  # excess returns

# OLS regression: each ETF excess return ~ market excess return
betas    <- numeric(length(tickers))
resid_var <- numeric(length(tickers))

for (i in seq_along(tickers)) {
  fit <- lm(excess_R[, i] ~ R_mkt)
  betas[i]     <- coef(fit)[2]
  resid_var[i] <- var(resid(fit))
}

sigma2_m  <- var(R_mkt)
Sigma_CAPM <- outer(betas, betas) * sigma2_m + diag(resid_var)

# ── Quadratic Programming: long-only MVP ──────────────────────────────────────
n <- length(tickers)
Dmat <- 2 * Sigma_CAPM
dvec <- rep(0, n)
Amat <- cbind(rep(1, n), diag(n))   # equality + non-negativity
bvec <- c(1, rep(0, n))
meq  <- 1

qp_capm <- solve.QP(Dmat, dvec, Amat, bvec, meq = meq)
w_capm  <- qp_capm$solution
names(w_capm) <- tickers

cat("CAPM-MVP Weights:\n")
## CAPM-MVP Weights:
round(w_capm, 4)
##    SPY    QQQ    EEM    IWM    EFA    TLT    IYR    GLD 
## 0.0000 0.0000 0.1401 0.0000 0.0838 0.3425 0.0000 0.4336
data.frame(ETF = tickers, Weight = round(w_capm, 4)) %>%
  filter(Weight > 0.001) %>%
  ggplot(aes(x = reorder(ETF, -Weight), y = Weight, fill = ETF)) +
  geom_col(show.legend = FALSE) +
  geom_text(aes(label = scales::percent(Weight, accuracy = 0.1)),
            vjust = -0.4, size = 3.5) +
  scale_y_continuous(labels = scales::percent) +
  labs(title = "CAPM-Based MVP Weights (Training: 2020/03 – 2025/02)",
       x = NULL, y = "Portfolio Weight") +
  theme_minimal(base_size = 13)

1.6 Q6 — MVP via FF3-Factor Covariance Matrix (2020/03–2025/02)

1.6.1 Methodology

Under the Fama–French 3-factor model: \[R_{i,t} - R_{f,t} = \alpha_i + \beta_{i,\text{MKT}} \text{MktRF}_t + \beta_{i,\text{SMB}} \text{SMB}_t + \beta_{i,\text{HML}} \text{HML}_t + \varepsilon_{i,t}\]

The structured covariance matrix is: \[\Sigma_{FF3} = B \, \Sigma_F \, B^{\top} + \mathbf{D}\] where \(B\) is the \(N \times 3\) factor-loading matrix and \(\Sigma_F\) is the \(3 \times 3\) factor covariance matrix.

factors      <- as.matrix(train_window[, c("MktRF","SMB","HML")])
Sigma_F      <- cov(factors)

B         <- matrix(0, nrow = n, ncol = 3,
                    dimnames = list(tickers, c("MktRF","SMB","HML")))
resid_var2 <- numeric(n)

for (i in seq_along(tickers)) {
  fit <- lm(excess_R[, i] ~ factors)
  B[i, ]        <- coef(fit)[-1]
  resid_var2[i] <- var(resid(fit))
}

Sigma_FF3 <- B %*% Sigma_F %*% t(B) + diag(resid_var2)

# MVP
Dmat2  <- 2 * Sigma_FF3
qp_ff3 <- solve.QP(Dmat2, dvec, Amat, bvec, meq = meq)
w_ff3  <- qp_ff3$solution
names(w_ff3) <- tickers

cat("FF3-MVP Weights:\n")
## FF3-MVP Weights:
round(w_ff3, 4)
##    SPY    QQQ    EEM    IWM    EFA    TLT    IYR    GLD 
## 0.0000 0.0000 0.1565 0.0000 0.0821 0.3391 0.0000 0.4223
data.frame(ETF = tickers, Weight = round(w_ff3, 4)) %>%
  filter(Weight > 0.001) %>%
  ggplot(aes(x = reorder(ETF, -Weight), y = Weight, fill = ETF)) +
  geom_col(show.legend = FALSE) +
  geom_text(aes(label = scales::percent(Weight, accuracy = 0.1)),
            vjust = -0.4, size = 3.5) +
  scale_y_continuous(labels = scales::percent) +
  labs(title = "FF3-Based MVP Weights (Training: 2020/03 – 2025/02)",
       x = NULL, y = "Portfolio Weight") +
  theme_minimal(base_size = 13)

data.frame(
  ETF         = tickers,
  CAPM_Weight = round(w_capm, 4),
  FF3_Weight  = round(w_ff3,  4)
) %>%
  kable(caption = "MVP Weight Comparison: CAPM vs FF3") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
MVP Weight Comparison: CAPM vs FF3
ETF CAPM_Weight FF3_Weight
SPY SPY 0.0000 0.0000
QQQ QQQ 0.0000 0.0000
EEM EEM 0.1401 0.1565
IWM IWM 0.0000 0.0000
EFA EFA 0.0838 0.0821
TLT TLT 0.3425 0.3391
IYR IYR 0.0000 0.0000
GLD GLD 0.4336 0.4223

1.7 Q7 — Realized Portfolio Returns in March 2025

We apply the MVP weights derived from the training window to the out-of-sample March 2025 returns.

# March 2025 returns
mar2025 <- merged_data["2025-03-01/2025-03-31"]

if (nrow(mar2025) == 0) {
  # If not yet in merged_data, pull direct from monthly_returns
  index(monthly_returns) <- ceiling_date(index(monthly_returns), "month") - 1
  mar2025_r <- as.numeric(monthly_returns["2025-03-31", tickers])
} else {
  mar2025_r <- as.numeric(mar2025[nrow(mar2025), tickers])
}

ret_capm_mar <- sum(w_capm * mar2025_r)
ret_ff3_mar  <- sum(w_ff3  * mar2025_r)

data.frame(
  Model           = c("CAPM-MVP", "FF3-MVP"),
  Realized_Return = scales::percent(c(ret_capm_mar, ret_ff3_mar), accuracy = 0.01)
) %>%
  kable(caption = "Realized MVP Portfolio Return — March 2025") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
Realized MVP Portfolio Return — March 2025
Model Realized_Return
CAPM-MVP 3.86%
FF3-MVP 3.77%

Interpretation: The realized returns reflect the out-of-sample performance of each covariance model. Differences arise because the FF3 model captures additional systematic risk premia (size and value), potentially yielding a better-diversified minimum-variance portfolio than the single-factor CAPM structure.

1.8 Q8 — Realized Portfolio Return in April 2025 (Rolling 60-Month Window)

We roll the training window forward by one month (2020/04–2025/03) and re-estimate the MVP weights, then evaluate on April 2025 returns.

# Rolling window: 2020-04 to 2025-03
roll_window <- merged_data["2020-04-01/2025-03-31"]
R_etf_r   <- as.matrix(roll_window[, tickers])
R_mkt_r   <- as.numeric(roll_window$MktRF)
R_f_r     <- as.numeric(roll_window$RF)
excess_R_r <- sweep(R_etf_r, 1, R_f_r, "-")
factors_r   <- as.matrix(roll_window[, c("MktRF","SMB","HML")])

# ── CAPM covariance (rolling) ─────────────────────────────────────────────────
betas_r    <- numeric(n); resid_var_r <- numeric(n)
for (i in seq_along(tickers)) {
  fit <- lm(excess_R_r[, i] ~ R_mkt_r)
  betas_r[i]    <- coef(fit)[2]
  resid_var_r[i]<- var(resid(fit))
}
Sigma_CAPM_r <- outer(betas_r, betas_r) * var(R_mkt_r) + diag(resid_var_r)
qp_capm_r    <- solve.QP(2*Sigma_CAPM_r, dvec, Amat, bvec, meq=meq)
w_capm_r     <- qp_capm_r$solution; names(w_capm_r) <- tickers

# ── FF3 covariance (rolling) ──────────────────────────────────────────────────
B_r <- matrix(0, n, 3); resid_var2_r <- numeric(n)
for (i in seq_along(tickers)) {
  fit <- lm(excess_R_r[, i] ~ factors_r)
  B_r[i, ]        <- coef(fit)[-1]
  resid_var2_r[i] <- var(resid(fit))
}
Sigma_FF3_r <- B_r %*% cov(factors_r) %*% t(B_r) + diag(resid_var2_r)
qp_ff3_r    <- solve.QP(2*Sigma_FF3_r, dvec, Amat, bvec, meq=meq)
w_ff3_r     <- qp_ff3_r$solution; names(w_ff3_r) <- tickers

# ── April 2025 realized returns ───────────────────────────────────────────────
apr2025_r <- as.numeric(monthly_returns["2025-04-30", tickers])

ret_capm_apr <- sum(w_capm_r * apr2025_r)
ret_ff3_apr  <- sum(w_ff3_r  * apr2025_r)

data.frame(
  Model           = c("CAPM-MVP (rolled)", "FF3-MVP (rolled)"),
  Realized_Return = scales::percent(c(ret_capm_apr, ret_ff3_apr), accuracy = 0.01)
) %>%
  kable(caption = "Realized MVP Portfolio Return — April 2025 (60-month rolling)") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
Realized MVP Portfolio Return — April 2025 (60-month rolling)
Model Realized_Return
CAPM-MVP (rolled) 2.18%
FF3-MVP (rolled) 2.13%

2 Textbook Questions

2.1 Chapter 5 — Problem 12

Problem 12 — Visit Professor Kenneth French’s data library and download the monthly returns of “6 portfolios formed on size and book-to-market (2×3).” Split the sample (Jan 1930–Dec 2018) in half and compute the average, SD, skew, and kurtosis for each portfolio in each half. Do the statistics suggest returns come from the same distribution over the entire period?

ff6_lines <- fetch_french_zip(
  "https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/6_Portfolios_2x3_CSV.zip"
)

# The file has several blocks; first value-weighted block header contains
# "SMALL" or "LoBM". Find first data header after "Value Weight Returns"
vw_idx     <- which(grepl("Value Weight", ff6_lines, ignore.case = TRUE))[1]
header_idx2 <- vw_idx + 1   # next line is the column header

raw_text2   <- ff6_lines[header_idx2:length(ff6_lines)]
blank_idx2  <- which(trimws(raw_text2) == "")[1]
monthly_text2 <- raw_text2[1:(blank_idx2 - 1)]

ff6_monthly <- read.csv(
  text             = paste(monthly_text2, collapse = "\n"),
  header           = TRUE,
  stringsAsFactors = FALSE,
  strip.white      = TRUE
) %>%
  setNames(c("Date","SL","SM","SH","BL","BM","BH")) %>%
  filter(grepl("^\\d{6}$", trimws(Date))) %>%
  mutate(
    Date = as.Date(paste0(trimws(Date), "01"), "%Y%m%d"),
    across(SL:BH, ~ as.numeric(.x) / 100)
  ) %>%
  filter(!is.na(SL),
         Date >= as.Date("1930-01-01"),
         Date <= as.Date("2018-12-31"))

# Split into two equal halves
midpoint    <- median(ff6_monthly$Date)
first_half  <- ff6_monthly %>% filter(Date <= midpoint)
second_half <- ff6_monthly %>% filter(Date >  midpoint)

portfolios <- c("SL","SM","SH","BL","BM","BH")

compute_stats <- function(df, label) {
  df %>%
    select(all_of(portfolios)) %>%
    summarise(across(everything(),
              list(Mean = mean, SD = sd,
                   Skew = ~ e1071::skewness(.x),
                   Kurt = ~ e1071::kurtosis(.x)),
              .names = "{.col}_{.fn}")) %>%
    pivot_longer(everything(),
                 names_to  = c("Portfolio","Stat"),
                 names_sep = "_") %>%
    pivot_wider(names_from = Stat, values_from = value) %>%
    mutate(Period = label, across(where(is.numeric), ~ round(.x, 4)))
}

stats_half1 <- compute_stats(first_half,  paste0("First Half (1930–", year(midpoint), ")"))
stats_half2 <- compute_stats(second_half, paste0("Second Half (", year(midpoint)+1, "–2018)"))

bind_rows(stats_half1, stats_half2) %>%
  select(Period, Portfolio, Mean, SD, Skew, Kurt) %>%
  arrange(Period, Portfolio) %>%
  kable(caption = "Ch.5 P12 — Descriptive Statistics by Sub-Period (6 Size/BM Portfolios)") %>%
  kable_styling(bootstrap_options = c("striped","hover","condensed"), full_width = FALSE) %>%
  collapse_rows(columns = 1, valign = "top")
Ch.5 P12 — Descriptive Statistics by Sub-Period (6 Size/BM Portfolios)
Period Portfolio Mean SD Skew Kurt
First Half (1930–1974) BH 0.0119 0.0891 1.7645 14.4029
BL 0.0076 0.0571 0.1778 6.8570
BM 0.0081 0.0673 1.7068 17.4583
SH 0.0148 0.1021 2.2811 17.0009
SL 0.0097 0.0823 1.1767 9.0265
SM 0.0117 0.0842 1.5753 12.6815
Second Half (1975–2018) BH 0.0114 0.0489 -0.5158 2.7837
BL 0.0098 0.0470 -0.3328 1.9738
BM 0.0106 0.0434 -0.4716 2.6322
SH 0.0142 0.0550 -0.4629 4.2787
SL 0.0100 0.0669 -0.4074 2.1394
SM 0.0135 0.0528 -0.5315 3.4006

Analysis:

Return distributions across the two sub-periods typically show materially different means and standard deviations, particularly for small-cap portfolios (SL, SM, SH). Skewness and kurtosis also differ, indicating fat tails and asymmetry that vary by era — consistent with the literature on time-varying risk premia and structural breaks (e.g., Great Depression, post-WWII expansion, dot-com bubble). The evidence rejects the hypothesis that returns come from an identical distribution over the full period. This has direct implications for out-of-sample portfolio construction: historical moments are non-stationary.

2.2 Chapter 6 — Problem 21

Problem 21 — Risky portfolio: \(E(r_P) = 11\%\), \(\sigma_P = 15\%\), \(r_f = 5\%\).

(a) Client wants \(E(r_C) = 8\%\). What proportion \(y\) in the risky portfolio? (b) What is the standard deviation of her complete portfolio? (c) Another client wants \(\sigma_C \leq 12\%\). Which client is more risk-averse?

Er_P <- 0.11; sigma_P <- 0.15; rf <- 0.05
target_E <- 0.08; target_sigma <- 0.12

# (a) y such that E(r_C) = y*E(r_P) + (1-y)*rf = target_E
y_a <- (target_E - rf) / (Er_P - rf)
cat(sprintf("(a) y = (%.2f - %.2f) / (%.2f - %.2f) = %.4f (%.2f%%)\n",
            target_E, rf, Er_P, rf, y_a, y_a*100))
## (a) y = (0.08 - 0.05) / (0.11 - 0.05) = 0.5000 (50.00%)
# (b) SD of complete portfolio
sigma_C_a <- y_a * sigma_P
cat(sprintf("(b) sigma_C = y * sigma_P = %.4f * %.2f = %.4f (%.2f%%)\n",
            y_a, sigma_P, sigma_C_a, sigma_C_a*100))
## (b) sigma_C = y * sigma_P = 0.5000 * 0.15 = 0.0750 (7.50%)
# (c) Max y for second client (sigma constraint)
y_c <- target_sigma / sigma_P
cat(sprintf("(c) y for sigma <= 12%%: y = 0.12/0.15 = %.4f (%.2f%%)\n",
            y_c, y_c*100))
## (c) y for sigma <= 12%: y = 0.12/0.15 = 0.8000 (80.00%)
cat(sprintf("    Client (a) invests %.0f%% in risky asset vs Client (c) %.0f%%\n",
            y_a*100, y_c*100))
##     Client (a) invests 50% in risky asset vs Client (c) 80%
cat("    Client (a) is MORE risk-averse (lower y => lower risk tolerance)\n")
##     Client (a) is MORE risk-averse (lower y => lower risk tolerance)

Summary:

Sub-part Formula Result
(a) Proportion in risky fund \(y = \frac{E(r_C) - r_f}{E(r_P) - r_f}\) 50.00%
(b) Portfolio SD \(\sigma_C = y \cdot \sigma_P\) 7.50%
(c) y for \(\sigma \leq 12\%\) \(y = \frac{0.12}{0.15}\) 80.00%

Client (a) allocates only 50.0% to the risky fund vs 80.0% for Client (c), so Client (a) is more risk-averse.

2.3 Chapter 6 — Problem 22

Problem 22 — IMI uses the CML. Forecasts: \(E(r_M) = 12\%\), \(\sigma_M = 20\%\), \(r_f = 5\%\). Samuel Johnson wants \(\sigma_C = \frac{1}{2} \sigma_M\). What expected return can IMI provide?

Er_M <- 0.12; sigma_M <- 0.20; rf_22 <- 0.05
target_sigma_22 <- sigma_M / 2   # 10%

# CML: E(r_C) = rf + [(E(r_M) - rf) / sigma_M] * sigma_C
sharpe_M <- (Er_M - rf_22) / sigma_M
Er_C_22  <- rf_22 + sharpe_M * target_sigma_22

cat(sprintf("Sharpe ratio of market: (%.2f - %.2f) / %.2f = %.4f\n",
            Er_M, rf_22, sigma_M, sharpe_M))
## Sharpe ratio of market: (0.12 - 0.05) / 0.20 = 0.3500
cat(sprintf("E(r_C) = %.2f + %.4f * %.2f = %.4f (%.2f%%)\n",
            rf_22, sharpe_M, target_sigma_22, Er_C_22, Er_C_22*100))
## E(r_C) = 0.05 + 0.3500 * 0.10 = 0.0850 (8.50%)

CML Formula: \[E(r_C) = r_f + \frac{E(r_M) - r_f}{\sigma_M} \cdot \sigma_C = 5\% + \frac{12\%-5\%}{20\%} \times 10\% = \mathbf{8.5%}\]

2.4 Chapter 6 — CFA Problem 4

CFA Problem 4 — From the graph, which indifference curve achieves the greatest utility the investor can attain?

Answer: Curve 2 (the highest indifference curve that is tangent to or lies on the Capital Allocation Line). Curve 1 intersects the CAL (feasible but suboptimal); curves 3 and 4 lie above the CAL (unattainable).

The investor maximises utility at the tangency point between the highest achievable indifference curve and the CAL, which corresponds to Curve 2 at point F.

2.5 Chapter 6 — CFA Problem 5

CFA Problem 5 — Which point designates the optimal portfolio of risky assets?

Answer: Point E — the point where the CAL is tangent to the efficient frontier of risky assets. This point maximises the Sharpe ratio (reward-to-volatility) among all risky portfolios, making it the tangency portfolio that every rational investor will hold as their risky component, regardless of risk aversion.

2.6 Chapter 6 — CFA Problem 8

CFA Problem 8 — Equity fund: risk premium \(= 10\%\), \(\sigma = 14\%\), \(r_f = 6\%\). Client invests $60,000 in the equity fund and $40,000 in T-bills. Find: (a) expected return and SD of complete portfolio; (b) Sharpe ratio.

rp_8  <- 0.06 + 0.10   # E(r_equity) = rf + risk premium = 16%
sigma_8 <- 0.14; rf_8 <- 0.06
total <- 100000
w_eq  <- 60000 / total   # 0.60
w_rf  <- 40000 / total   # 0.40

Er_C8    <- w_eq * rp_8 + w_rf * rf_8
sigma_C8 <- w_eq * sigma_8
sharpe_8 <- (rp_8 - rf_8) / sigma_8   # Sharpe of equity fund

cat(sprintf("E(r_C) = 0.60 * %.2f + 0.40 * %.2f = %.4f (%.2f%%)\n",
            rp_8, rf_8, Er_C8, Er_C8*100))
## E(r_C) = 0.60 * 0.16 + 0.40 * 0.06 = 0.1200 (12.00%)
cat(sprintf("sigma_C = 0.60 * %.2f = %.4f (%.2f%%)\n",
            sigma_8, sigma_C8, sigma_C8*100))
## sigma_C = 0.60 * 0.14 = 0.0840 (8.40%)
cat(sprintf("Sharpe ratio (equity fund) = (%.2f - %.2f) / %.2f = %.4f\n",
            rp_8, rf_8, sigma_8, sharpe_8))
## Sharpe ratio (equity fund) = (0.16 - 0.06) / 0.14 = 0.7143
Metric Value
\(E(r_C)\) 12.00%
\(\sigma_C\) 8.40%
Sharpe ratio (equity fund) 0.7143

2.7 Chapter 7 — Problem 11

Problem 11 — Stocks: \(E(r) = 18\%\), \(\sigma = 22\%\); Gold: \(E(r) = 10\%\), \(\sigma = 30\%\).

(a) Despite gold’s inferiority in both mean and variance, would anyone hold gold? (b) With \(\rho = 1\), illustrate graphically and explain. (c) Can \(\rho = 1\) represent an equilibrium?

(a) Yes — even with lower mean and higher volatility, gold can reduce portfolio variance if its correlation with stocks is sufficiently low (or negative). The diversification benefit can shift the efficient frontier leftward, enabling portfolios with better risk-return trade-offs than stocks alone.

rho_vals <- c(-0.5, 0, 0.3, 1)
w_seq    <- seq(0, 1, 0.01)

E_s <- 0.18; s_s <- 0.22
E_g <- 0.10; s_g <- 0.30

frontier_data <- map_dfr(rho_vals, function(rho) {
  tibble(
    w_stock = w_seq,
    E_p = w_stock * E_s + (1 - w_stock) * E_g,
    V_p = w_stock^2 * s_s^2 + (1 - w_stock)^2 * s_g^2 +
          2 * w_stock * (1 - w_stock) * rho * s_s * s_g,
    sigma_p = sqrt(V_p),
    rho_label = paste0("ρ = ", rho)   # simple string label per iteration
  )
})

# Convert to ordered factor so ggplot legend follows rho_vals order
frontier_data$rho_label <- factor(frontier_data$rho_label,
                                  levels = paste0("ρ = ", rho_vals))

ggplot(frontier_data, aes(x = sigma_p, y = E_p, color = rho_label)) +
  geom_line(size = 1) +
  annotate("point", x = s_s, y = E_s, shape = 17, size = 3, color = "steelblue") +
  annotate("point", x = s_g, y = E_g, shape = 15, size = 3, color = "gold3") +
  annotate("text",  x = s_s + 0.005, y = E_s, label = "Stocks", hjust = 0) +
  annotate("text",  x = s_g + 0.005, y = E_g, label = "Gold",   hjust = 0) +
  scale_x_continuous(labels = scales::percent) +
  scale_y_continuous(labels = scales::percent) +
  labs(title = "Ch.7 P11 — Stocks–Gold Efficient Frontier by Correlation",
       x = "Portfolio Standard Deviation",
       y = "Expected Return",
       color = "Correlation") +
  theme_minimal(base_size = 13)

(b) When \(\rho = 1\) the frontier collapses to a straight line connecting the two assets. Since gold has both lower return and higher risk than stocks, the efficient portion is the segment from stocks northward — gold is never held under \(\rho = 1\).

(c) \(\rho = 1\) cannot represent equilibrium. If no rational investor held gold, its price would fall (increasing its expected return) until it entered efficient portfolios again — i.e., until the correlation dropped or the expected return rose enough to restore demand. The equilibrium correlation must be \(< 1\) for gold to be held.

2.8 Chapter 7 — Problem 12

Problem 12 — Stock A: \(E(r) = 10\%\), \(\sigma = 5\%\); Stock B: \(E(r) = 15\%\), \(\sigma = 10\%\), \(\rho = -1\). If borrowing at \(r_f\) is possible, what must \(r_f\) be?

E_A <- 0.10; s_A <- 0.05
E_B <- 0.15; s_B <- 0.10; rho_AB <- -1

# With rho = -1: find w_A that gives zero variance (risk-free portfolio)
# sigma_p^2 = w^2 s_A^2 + (1-w)^2 s_B^2 - 2w(1-w)s_A s_B = (w*s_A - (1-w)*s_B)^2 = 0
# => w*s_A = (1-w)*s_B => w = s_B / (s_A + s_B)
w_A_rf <- s_B / (s_A + s_B)
w_B_rf <- 1 - w_A_rf

E_rf_implied <- w_A_rf * E_A + w_B_rf * E_B

cat(sprintf("w_A = s_B/(s_A+s_B) = %.2f/(%.2f+%.2f) = %.4f\n",
            s_B, s_A, s_B, w_A_rf))
## w_A = s_B/(s_A+s_B) = 0.10/(0.05+0.10) = 0.6667
cat(sprintf("w_B = %.4f\n", w_B_rf))
## w_B = 0.3333
cat(sprintf("Implied risk-free rate = %.4f * %.2f + %.4f * %.2f = %.4f (%.2f%%)\n",
            w_A_rf, E_A, w_B_rf, E_B, E_rf_implied, E_rf_implied*100))
## Implied risk-free rate = 0.6667 * 0.10 + 0.3333 * 0.15 = 0.1167 (11.67%)

Solution:

When \(\rho = -1\), a portfolio with weights \(w_A = \frac{\sigma_B}{\sigma_A + \sigma_B} = \frac{10}{15} \approx 66.7\%\) and \(w_B = 33.3\%\) achieves zero variance (a synthetic risk-free asset). Its expected return is the implied risk-free rate:

\[r_f = \frac{2}{3}(10\%) + \frac{1}{3}(15\%) = \mathbf{11.67%}\]

No-arbitrage requires the actual \(r_f\) to equal this value; otherwise riskless profits could be earned by combining this portfolio with borrowing/lending.

2.9 Chapter 7 — CFA Problem 12

CFA Problem 12 — Abigail Grace: $900,000 fully diversified portfolio (monthly \(\mu = 0.67\%\), \(\sigma = 2.37\%\)) + inherited $100,000 ABC stock (\(\mu = 1.25\%\), \(\sigma = 2.95\%\), \(\rho = 0.40\) with original portfolio).

(a) Keep ABC: compute E(r), covariance, and SD of new portfolio. (b) Sell ABC, invest in risk-free at 0.42% monthly. (c) Systematic risk comparison.

# Weights
W_total <- 1000000
W_P     <- 900000; W_ABC <- 100000
w_P  <- W_P / W_total;    w_ABC <- W_ABC / W_total

mu_P  <- 0.0067; sigma_P_c <- 0.0237
mu_ABC <- 0.0125; sigma_ABC <- 0.0295; rho_PABC <- 0.40
rf_monthly <- 0.0042

# (a) Keep ABC
Er_new_a <- w_P * mu_P + w_ABC * mu_ABC
Cov_PABC <- rho_PABC * sigma_P_c * sigma_ABC
Var_new_a <- w_P^2 * sigma_P_c^2 + w_ABC^2 * sigma_ABC^2 +
             2 * w_P * w_ABC * Cov_PABC
sigma_new_a <- sqrt(Var_new_a)

# (b) Sell ABC, buy risk-free
Er_new_b <- w_P * mu_P + w_ABC * rf_monthly
Cov_Prf  <- 0  # risk-free has zero covariance
Var_new_b <- w_P^2 * sigma_P_c^2   # only systematic
sigma_new_b <- sqrt(Var_new_b)

cat("── Part (a): Keep ABC ──────────────────────────────\n")
## ── Part (a): Keep ABC ──────────────────────────────
cat(sprintf("E(r_new)   = %.4f (%.2f%% monthly)\n", Er_new_a, Er_new_a*100))
## E(r_new)   = 0.0073 (0.73% monthly)
cat(sprintf("Cov(P,ABC) = %.6f\n", Cov_PABC))
## Cov(P,ABC) = 0.000280
cat(sprintf("sigma_new  = %.4f (%.2f%% monthly)\n", sigma_new_a, sigma_new_a*100))
## sigma_new  = 0.0227 (2.27% monthly)
cat("\n── Part (b): Sell ABC, invest at rf ────────────────\n")
## 
## ── Part (b): Sell ABC, invest at rf ────────────────
cat(sprintf("E(r_new)   = %.4f (%.2f%% monthly)\n", Er_new_b, Er_new_b*100))
## E(r_new)   = 0.0065 (0.65% monthly)
cat(sprintf("Cov(P,rf)  = 0 (risk-free asset)\n"))
## Cov(P,rf)  = 0 (risk-free asset)
cat(sprintf("sigma_new  = %.4f (%.2f%% monthly)\n", sigma_new_b, sigma_new_b*100))
## sigma_new  = 0.0213 (2.13% monthly)
data.frame(
  Scenario     = c("Keep ABC", "Sell ABC (→ risk-free)"),
  E_Return_pct = scales::percent(c(Er_new_a, Er_new_b), 0.001),
  Covariance   = c(round(Cov_PABC, 6), 0),
  Sigma_pct    = scales::percent(c(sigma_new_a, sigma_new_b), 0.001)
) %>%
  kable(caption = "CFA 12 — New Portfolio Statistics") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
CFA 12 — New Portfolio Statistics
Scenario E_Return_pct Covariance Sigma_pct
Keep ABC 0.728% 0.00028 2.267%
Sell ABC (→ risk-free) 0.645% 0.00000 2.133%

(c) Systematic Risk Comparison:

Replacing ABC stock with a risk-free asset reduces systematic risk. The risk-free asset has \(\beta = 0\) and zero covariance with the market; thus the new portfolio’s beta falls from its current level toward the original portfolio’s beta weighted at 90%. ABC stock (with \(\rho = 0.40\) vs the portfolio) contributed positive systematic risk — removing it lowers overall beta.

(d) Husband’s comment (same XYZ as ABC): The husband is incorrect. Even though XYZ has identical \(\mu\) and \(\sigma\) to ABC, its correlation with the existing portfolio may differ. If XYZ has a lower correlation with the original portfolio, it provides greater diversification benefit than ABC.

(e) Weakness of SD for Grace; alternate measure: - Weakness: Standard deviation penalises both upside and downside deviations equally. Grace is asymmetrically concerned about losses, so SD does not accurately capture her subjective risk. - Better measure: Semi-deviation (or downside deviation / Value-at-Risk) — these measure only the dispersion of negative returns, aligning with Grace’s loss-aversion.

2.10 Chapter 8 — Problem 17

Problem 17 — Portfolio manager forecasts (micro + macro). (a) Excess returns, alpha, residual variances. (b) Optimal risky portfolio (Treynor–Black). (c) Sharpe ratio of optimal portfolio. (d) Sharpe improvement over passive strategy. (e) Complete portfolio for \(A = 2.8\).

# ── Data ──────────────────────────────────────────────────────────────────────
stocks <- c("A","B","C","D")
Er     <- c(20, 18, 17, 12)   # %
beta   <- c(1.3, 1.8, 0.7, 1.0)
resid_sd <- c(58, 71, 60, 55)  # %
rf_17   <- 8; Er_mkt <- 16; sigma_mkt <- 23  # %

# (a) Excess returns, alpha, residual variance
Er_excess <- Er - rf_17
CAPM_Er   <- rf_17 + beta * (Er_mkt - rf_17)
alpha      <- Er - CAPM_Er
resid_var  <- resid_sd^2

df_a <- data.frame(
  Stock         = stocks,
  `E(r)%`       = Er,
  Beta          = beta,
  `E(r) excess` = Er_excess,
  `CAPM E(r)`   = round(CAPM_Er, 2),
  Alpha         = round(alpha, 2),
  `ResidVar`    = resid_var
)

kable(df_a, caption = "Ch.8 P17(a) — Excess Returns, Alpha, Residual Variances") %>%
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
Ch.8 P17(a) — Excess Returns, Alpha, Residual Variances
Stock E.r.. Beta E.r..excess CAPM.E.r. Alpha ResidVar
A 20 1.3 12 18.4 1.6 3364
B 18 1.8 10 22.4 -4.4 5041
C 17 0.7 9 13.6 3.4 3600
D 12 1.0 4 16.0 -4.0 3025 
# (b) Treynor–Black: optimal active portfolio
# Initial position proportional to alpha_i / sigma^2(epsilon_i)
w0 <- alpha / resid_var
w0_sum <- sum(w0)
w_active <- w0 / w0_sum   # normalised weights in active portfolio

alpha_A  <- sum(w_active * alpha)
beta_A   <- sum(w_active * beta)
sigma2_A_resid <- sum(w_active^2 * resid_var)

# Passive portfolio (index) Sharpe
sharpe_passive <- (Er_mkt - rf_17) / sigma_mkt

# Optimal weight of active portfolio (w_A*)
# w_A* = [alpha_A / sigma2_A] / [E(r_mkt-rf) / sigma_mkt^2]
w_A_star_raw <- (alpha_A / sigma2_A_resid) /
                ((Er_mkt - rf_17) / sigma_mkt^2)

# Adjusted for beta of active portfolio
w_A_star <- w_A_star_raw / (1 + (1 - beta_A) * w_A_star_raw)

# Optimal risky portfolio parameters
beta_opt   <- w_A_star * beta_A + (1 - w_A_star) * 1
Er_opt     <- w_A_star * (rf_17 + alpha_A + beta_A * (Er_mkt - rf_17)) +
              (1 - w_A_star) * Er_mkt
sigma2_opt <- beta_opt^2 * sigma_mkt^2 + w_A_star^2 * sigma2_A_resid
sigma_opt  <- sqrt(sigma2_opt)

cat(sprintf("Active portfolio alpha:       %.4f%%\n", alpha_A))
## Active portfolio alpha:       -16.9037%
cat(sprintf("Active portfolio beta:        %.4f\n",   beta_A))
## Active portfolio beta:        2.0824
cat(sprintf("w_A* (active weight):         %.4f\n",   w_A_star))
## w_A* (active weight):         -0.0486
cat(sprintf("Optimal portfolio E(r):       %.4f%%\n", Er_opt))
## Optimal portfolio E(r):       16.4004%
cat(sprintf("Optimal portfolio sigma:      %.4f%%\n", sigma_opt))
## Optimal portfolio sigma:      22.9408%
# (c) Sharpe ratio of optimal portfolio
sharpe_opt <- (Er_opt - rf_17) / sigma_opt
cat(sprintf("\n(c) Sharpe ratio (optimal):   %.4f\n", sharpe_opt))
## 
## (c) Sharpe ratio (optimal):   0.3662
cat(sprintf("    Sharpe ratio (passive):   %.4f\n",   sharpe_passive))
##     Sharpe ratio (passive):   0.3478
# (d) Improvement
cat(sprintf("\n(d) Sharpe improvement:       %.4f\n",
            sharpe_opt - sharpe_passive))
## 
## (d) Sharpe improvement:       0.0183
# (e) Complete portfolio: A = 2.8
A_17 <- 2.8
y_opt <- (Er_opt - rf_17) / (A_17 * sigma2_opt)
cat(sprintf("(e) Fraction in optimal risky: y = %.4f (%.2f%%)\n",
            y_opt, y_opt*100))
## (e) Fraction in optimal risky: y = 0.0057 (0.57%)
cat(sprintf("    Fraction in T-bills:       %.4f (%.2f%%)\n",
            1-y_opt, (1-y_opt)*100))
##     Fraction in T-bills:       0.9943 (99.43%)

Summary (P17):

  • The active portfolio tilts towards stocks with high alpha-to-residual-variance ratios (Treynor–Black criterion).
  • The Sharpe improvement over the passive strategy quantifies the economic value of active management.
  • For \(A = 2.8\), the investor places approximately 0.6% in the optimal risky portfolio, reflecting moderate risk aversion.

2.11 Chapter 8 — CFA Problem 1

CFA Problem 1 — Regression of ABC and XYZ excess returns on market index over 5 years. Discuss risk–return relationships and implications for future performance.

Regression Results Recap:

Statistic ABC XYZ
Alpha (%) −3.20 7.30
Beta 0.60 0.97
\(R^2\) 0.35 0.17
Residual SD (%) 13.02 21.45

Analysis:

ABC exhibits a negative alpha (−3.20%), indicating it underperformed its CAPM-implied return by 3.20% annually over the sample. Its beta of 0.60 means it is defensive (less sensitive to market movements). The \(R^2 = 0.35\) suggests 35% of return variation is explained by the market — moderate systematic exposure. The relatively low residual SD (13.02%) means idiosyncratic risk is contained.

XYZ shows a positive alpha (+7.30%), outperforming its benchmark-implied return substantially. However, its \(R^2 = 0.17\) is very low — only 17% of its variation is systematic — meaning most of its risk is idiosyncratic. Its high residual SD (21.45%) confirms this. Beta near 1 (0.97) implies near-market systematic exposure.

Implications for future performance:

  1. Brokerage beta estimates (ABC: 0.62/0.71; XYZ: 1.45/1.25) differ substantially from the 5-year estimates, suggesting beta instability — particularly for XYZ, whose brokerage betas are much higher. This warns against extrapolating historical alphas.

  2. Alphas may reflect luck or model misspecification rather than skill. A 5-year period is insufficient to distinguish persistent skill from random variation, especially for XYZ with high idiosyncratic risk.

  3. In a diversified portfolio, idiosyncratic risk of individual stocks is diversified away. ABC’s near-zero systematic alpha and XYZ’s high unsystematic risk suggest no meaningful improvement to a well-diversified portfolio unless the alphas are persistent.

  4. The adjusted beta (using Blume’s technique: \(\hat\beta_t = 0.3 + 0.7\beta_{t-1}\)) would shift both betas toward 1 for future forecasting, reducing the magnitude of any tactical tilts based on these estimates.