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.

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]
  readLines(csv_file, warn = FALSE)
}

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]

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).

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^2_m + D\]

where $D = \text{diag}(\sigma^2_{\varepsilon_1}, \ldots, \sigma^2_{\varepsilon_N})$.

The Minimum Variance Portfolio (MVP) solves:

\[\min_w \; w^\top \Sigma w \quad \text{s.t.} \quad w^\top \mathbf{1} = 1, \; 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, "-")

n <- length(tickers)
betas     <- numeric(n)
resid_var <- numeric(n)

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
Dmat <- 2 * Sigma_CAPM
dvec <- rep(0, n)
Amat <- cbind(rep(1, n), diag(n))
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:

print(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) +
  scale_fill_manual(values = c("#0f3460","#16213e","#e94560","#533483",
                               "#2e86ab","#a23b72","#f18f01","#c73e1d")) +
  labs(title = "CAPM-Based MVP Weights (Training: 2020/03 – 2025/02)",
       x = NULL, y = "Portfolio Weight") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(family = "serif", face = "bold"))

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,MKT}\text{MktRF}_t + \beta_{i,SMB}\text{SMB}_t + \beta_{i,HML}\text{HML}_t + \varepsilon_{i,t}\]

The structured covariance matrix is:

\[\Sigma_{FF3} = B\Sigma_F B^\top + 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)

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:

print(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) +
  scale_fill_manual(values = c("#0f3460","#16213e","#e94560","#533483",
                               "#2e86ab","#a23b72","#f18f01","#c73e1d")) +
  labs(title = "FF3-Based MVP Weights (Training: 2020/03 – 2025/02)",
       x = NULL, y = "Portfolio Weight") +
  theme_minimal(base_size = 13) +
  theme(plot.title = element_text(family = "serif", face = "bold"))

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.

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

if (nrow(mar2025) == 0) {
  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.

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 (60%)

2.1 Chapter 5 — Problem 12

Problem: 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"
)

vw_idx      <- which(grepl("Value Weight", ff6_lines, ignore.case = TRUE))[1]
header_idx2 <- vw_idx + 1

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"))

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 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: Risky portfolio: $E(r_P) = 11\%$, $\sigma_P = 15\%$, $r_f = 5\%$.

Client wants $E(r_C) = 8\%$. What proportion $y$ in the risky portfolio?
What is the standard deviation of her complete portfolio?
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
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 vs Client (c) %.0f%%\n", y_a*100, y_c*100))

##     Client (a) invests 50% in risky 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)

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% to the risky fund vs 80% for Client (c), so Client (a) is more risk-averse.

2.3 Chapter 6 — Problem 22

Problem: 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%

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

Question: 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 (CAL).

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

Question: Which point designates the optimal portfolio of risky assets?

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

2.6 Chapter 6 — CFA Problem 8

Problem: 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
w_rf    <- 40000 / total

Er_C8    <- w_eq * rp_8 + w_rf * rf_8
sigma_C8 <- w_eq * sigma_8
sharpe_8 <- (rp_8 - rf_8) / sigma_8

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 = (%.2f - %.2f) / %.2f = %.4f\n",
            rp_8, rf_8, sigma_8, sharpe_8))

## Sharpe ratio = (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: Stocks: $E(r) = 18\%$, $\sigma = 22\%$; Gold: $E(r) = 10\%$, $\sigma = 30\%$.

Despite gold’s inferiority in both mean and variance, would anyone hold gold?
With $\rho = 1$, illustrate graphically and explain.
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)
  )
})

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(linewidth = 1.1) +
  annotate("point", x = s_s, y = E_s, shape = 17, size = 3.5, color = "#0f3460") +
  annotate("point", x = s_g, y = E_g, shape = 15, size = 3.5, color = "#e94560") +
  annotate("text",  x = s_s + 0.005, y = E_s, label = "Stocks", hjust = 0, fontface = "bold") +
  annotate("text",  x = s_g + 0.005, y = E_g, label = "Gold",   hjust = 0, fontface = "bold") +
  scale_x_continuous(labels = scales::percent) +
  scale_y_continuous(labels = scales::percent) +
  scale_color_manual(values = c("#e94560","#0f3460","#f18f01","#533483")) +
  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) +
  theme(plot.title = element_text(family = "serif", face = "bold"),
        legend.position = "bottom")

(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.

2.8 Chapter 7 — Problem 12

Problem: 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
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.

2.9 Chapter 7 — CFA Problem 12

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

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

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
sigma_new_b <- sqrt(w_P^2 * sigma_P_c^2)

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 with a risk-free asset reduces systematic risk. The risk-free asset has $\beta = 0$ and zero covariance with the market; thus the portfolio’s beta falls toward the original portfolio’s beta weighted at 90%.

(d) Husband’s comment: 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, it provides greater diversification benefit.

(e) Weakness of SD for Grace: - 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: Portfolio manager forecasts (micro + macro). (a) Excess returns, alpha, residual variances. (b) Optimal risky portfolio (Treynor–Black). (c) Sharpe ratio. (d) Sharpe improvement over passive. (e) Complete portfolio for $A = 2.8$.

stocks   <- c("A","B","C","D")
Er_17    <- c(20, 18, 17, 12)
beta_17  <- 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)
Er_excess  <- Er_17 - rf_17
CAPM_Er    <- rf_17 + beta_17 * (Er_mkt - rf_17)
alpha_17   <- Er_17 - CAPM_Er
resid_var  <- resid_sd^2

data.frame(
  Stock         = stocks,
  `E(r)%`       = Er_17,
  Beta          = beta_17,
  `Excess E(r)` = Er_excess,
  `CAPM E(r)`   = round(CAPM_Er, 2),
  Alpha         = round(alpha_17, 2),
  ResidVar      = resid_var
) %>%
  kable(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	Excess.E.r.	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
w0       <- alpha_17 / resid_var
w0_sum   <- sum(w0)
w_active <- w0 / w0_sum

alpha_A        <- sum(w_active * alpha_17)
beta_A         <- sum(w_active * beta_17)
sigma2_A_resid <- sum(w_active^2 * resid_var)

sharpe_passive <- (Er_mkt - rf_17) / sigma_mkt

w_A_star_raw <- (alpha_A / sigma2_A_resid) /
                ((Er_mkt - rf_17) / sigma_mkt^2)
w_A_star     <- w_A_star_raw / (1 + (1 - beta_A) * w_A_star_raw)

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_opt <- (Er_opt - rf_17) / sigma_opt
cat(sprintf("\n(c) Sharpe (optimal):  %.4f\n", sharpe_opt))

## 
## (c) Sharpe (optimal):  0.3662

cat(sprintf("    Sharpe (passive):  %.4f\n",   sharpe_passive))

##     Sharpe (passive):  0.3478

# (d)
cat(sprintf("\n(d) Sharpe improvement: %.4f\n", sharpe_opt - sharpe_passive))

## 
## (d) Sharpe improvement: 0.0183

# (e)
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: - 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

Problem: Regression of ABC and XYZ excess returns on market index over 5 years.

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

ABC exhibits a negative alpha (−3.20%), indicating underperformance vs CAPM-implied return. Its beta of 0.60 is defensive. $R^2 = 0.35$ means 35% of variation is market-explained; the relatively low residual SD (13.02%) means idiosyncratic risk is contained.

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

Analysis of Future Performance Implications

Beta Instability and Prediction Risk: The significant discrepancy between brokerage-reported betas and our 5-year historical estimates (particularly for XYZ) indicates substantial beta instability. Historical performance is not a reliable proxy for future risk; therefore, we must be cautious when extrapolating historical alphas, as the underlying systematic risk exposure is clearly evolving.
Statistical Significance of Alpha: The observed alphas, especially the high positive alpha of XYZ, may stem from statistical noise or model misspecification rather than genuine managerial skill. A 5-year observation window is often insufficient to separate persistent “alpha” from random luck, given that XYZ’s high idiosyncratic risk makes the return series extremely volatile.
Diversification and Idiosyncratic Risk: From a portfolio construction perspective, idiosyncratic risk should be neutralized through diversification. Since ABC shows a negative systematic alpha and XYZ carries extreme unsystematic risk, neither asset offers a compelling value proposition to a well-diversified portfolio unless there is strong evidence that these alphas will persist in the long run.
Mean Reversion and Beta Adjustment: To improve forecasting accuracy, we should apply Blume’s Adjustment technique ($\hat{\beta}_t = 0.3 + 0.7\beta_{t-1}$). This accounts for the tendency of estimated betas to migrate toward the market mean ($\beta = 1$) over time. Applying this adjustment would provide a more realistic expectation of the risk-return profile for both ABC and XYZ in future periods.

End of Midterm Exam

Midterm Exam — Investment Portfolio Management

Egshiglen Baatar

2026-04-17