1 Computer Questions (40%)

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

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

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

Finding: The data shows that means and standard deviations vary significantly between the two halves, especially for small-cap stocks (SL, SM, SH). The shifts in skewness and kurtosis indicate that “fat tails” and market asymmetry are era-specific.

Conclusion: This evidence rejects the IID (identical distribution) hypothesis. It confirms that financial returns are non-stationary, meaning historical moments from the past (like the Great Depression) don’t accurately predict the risk of future regimes (like the AI boom). For portfolio construction, we must use dynamic windows rather than long-term averages.

2.2 Chapter 6 — Problem 21

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)

The following table summarizes the allocation and risk metrics for the complete portfolio:

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%

Risk Aversion Comparison: Client (a) chooses to invest only 50% of her wealth in the risky asset to achieve her target return, whereas Client (c) is willing to allocate up to 80% to meet her volatility limit. Because Client (a) maintains a significantly higher allocation in risk-free T-bills (50% vs. 20%), we conclude that Client (a) exhibits higher risk aversion.

2.3 Chapter 6 — Problem 22

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

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

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) +
  annotate("point", x = s_s, y = E_s, shape = 17, size = 3, color = "blue") +
  annotate("point", x = s_g, y = E_g, shape = 15, size = 3, color = "yellow") +
  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.

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

Analysis:

Stock Diagnostics: ABC: Displays a negative alpha (-3.20%), underperforming CAPM expectations. With a beta of 0.60, it serves as a defensive asset. However, its low $R^2$ suggests that 65% of its risk is idiosyncratic. XYZ: Exhibits a high positive alpha (+7.30%), but its extremely low $R^2$ (0.17) indicates that the vast majority of its volatility is firm-specific rather than market-driven.

Strategic Implications: Beta Instability: The variance between historical 5-year estimates and brokerage data suggests that systematic risk profiles are shifting. Historical alphas should not be used as a singular basis for future projections. Alpha vs. Noise: XYZ’s alpha may reflect “luck” or idiosyncratic shocks rather than persistent managerial skill. A 5-year window is statistically insufficient to confirm alpha persistence in high-residual-risk stocks. The Role of Diversification: In a well-diversified portfolio, XYZ’s high unsystematic risk is mitigated. Unless the alpha is proven to be structural, these stocks offer limited value to an optimized market portfolio. Forecasting with Adjusted Beta: To account for mean reversion, applying Blume’s Adjustment ($\hat{\beta}_t = 0.3 + 0.7\beta_{t-1}$) is recommended. This technique shifts extreme historical betas toward the market average of 1.0 for more robust future modeling. —

End of Midterm Exam

Midterm Exam Project

Anungoo Erdenebat

2026-04-17