Final Exam: Portfolio Analysis
Yukko
2026-06-10
Questions from Textbook (60%)
Chapter 7
CFA 1a. Limiting to 20 stocks will likely increase portfolio risk. Fewer stocks means less diversification, so unsystematic (firm-specific) risk increases.
CFA 1b. Yes — Hennessy could keep the 20 highest-conviction stocks and drop the weakest ones. If the removed stocks were highly correlated with the remaining ones, risk would not rise significantly.
CFA 2. Going from 40→20 stocks may help by concentrating on the best ideas. However, going from 20→10 is more dangerous because diversification benefits drop off rapidly at small N, and unsystematic risk becomes harder to eliminate. The marginal benefit of adding one more stock is greatest when the portfolio is small.
CFA 3. If Hennessy’s portfolio is evaluated as part of the full $280M fund (not standalone), what matters is its covariance with the other portfolios — not its own variance. Since the other five managers hold 150+ stocks, the fund is already well-diversified. Limiting Hennessy to 10 or 20 stocks has less impact on total fund risk.
CFA 4. Portfolio Y (return = 9%, SD = 21%) cannot lie on the efficient frontier. Portfolio X dominates it with higher return (12%) and lower risk (15%).
CFA 10. Choose the B + C portfolio. Both portfolios have a similar average standard deviation, but correlation(B, C) = 0.10 is far lower than correlation(A, B) = 0.90. Lower correlation produces greater diversification benefit and lower portfolio variance. B + C is clearly preferred.
Chapter 8
CFA 1.
- ABC: Alpha = −3.2% (underperformed benchmark), Beta = 0.60 (low market sensitivity), R² = 0.35 (35% of variance is systematic). Residual SD = 13.02% — substantial firm-specific risk.
- XYZ: Alpha = +7.3% (outperformed), Beta = 0.97 (near market), R² = 0.17 (only 17% systematic). Residual SD = 21.45% — very high unsystematic risk.
- Implication: Past alphas may not persist. In a well-diversified portfolio, only beta matters since unsystematic risk is diversified away. XYZ’s higher beta implies higher expected return going forward. The differing brokerage beta estimates reflect estimation error, but both confirm ABC is low-beta and XYZ is near-market.
CFA 2. Systematic risk = R² = 0.70² = 0.49 (49%). Therefore nonsystematic (specific) risk = 51%.
CFA 3. Using CAPM: E(R) = Rf + β × (Rm − Rf)
9% = 3% + β × (11% − 3%) → β = 6/8 = 0.75
CFA 4. Answer: d. Systematic risk. Beta measures only systematic (market-wide) risk.
CFA 5. Answer: b. Beta measures only systematic risk, while standard deviation measures total risk (systematic + unsystematic).
Chapter 9
Data: Portfolio R — return 11%, SD 10%, Beta 0.5. S&P 500 — return 14%, SD 12%, Beta 1.0.
CFA 8 — SML position:
At beta = 0.5, SML predicts: E(R) = Rf + 0.5 × (14% − Rf). For any
reasonable Rf (e.g., 0%), expected return ≈ 7%. Portfolio R earns 11%
> 7% → above the SML. Answer:
c.
CFA 9 — CML position:
Portfolio R’s Sharpe ratio = (11% − Rf)/10%, which exceeds the market
Sharpe = (14% − Rf)/12% for any reasonable Rf. Therefore Portfolio R
plots above the CML. Answer: c.
CFA 10. No — CAPM says expected return depends only on beta, not on specific (unsystematic) risk. Both Portfolio A and B have beta = 1.0, so CAPM predicts the same expected return for both. Specific risk is diversifiable and receives no risk premium.
Chapter 10
Setup: 2-factor APT. GDP risk premium = 8%, Inflation risk
premium = 2%. Rf = 4%.
High Growth Fund: β₁ = 1.25, β₂ = 1.5. Large Cap Fund: β₁ = 0.75, β₂
= 1.25. Utility Fund: β₁ = 1.0, β₂ = 2.0.
Q13. E(R) = 4% + 1.25 × 8% + 1.5 × 2% = 4% + 10% + 3% = 17%
Q14. APT expected excess return for Large Cap = 0.75
× 8% + 1.25 × 2% = 6% + 2.5% = 8.5%
Kwon’s fundamental estimate also = 8.5% above Rf → matches APT exactly.
No arbitrage opportunity.
Q15. Build GDP Fund: β_GDP = 1, β_inflation =
0.
Solving the system of equations gives weight in Utility Fund =
−2.2. Answer: (a)
Q16. Answer: b. Both are correct. Stiles is right that steady GDP growth benefits retirees needing stable income. McCracken is right it’s a good bet if supply-side policies succeed. Both views are valid from their own perspectives.
Questions Using R Codes (40%)
Q1: Import Data
library(tidyquant)
library(lubridate)
library(timetk)
library(tidyr)
library(dplyr)
library(quadprog)
library(ggplot2)
library(zoo)
tickers <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
prices_raw <- tq_get(tickers,
from = "2010-01-01",
to = Sys.Date(),
get = "stock.prices")
# Wide tibble of adjusted prices, then xts
prices_wide <- prices_raw %>%
select(date, symbol, adjusted) %>%
pivot_wider(names_from = symbol, values_from = adjusted) %>%
arrange(date)
prices_xts <- xts(prices_wide[, tickers], order.by = prices_wide$date)
head(prices_xts)## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 84.79636 40.29079 30.35151 51.36656 35.12845 55.70954 26.76809
## 2010-01-05 85.02083 40.29079 30.57181 51.18993 35.15940 56.06929 26.83238
## 2010-01-06 85.08070 40.04777 30.63575 51.14177 35.30801 55.31876 26.82069
## 2010-01-07 85.43986 40.07381 30.45810 51.51912 35.17178 55.41179 27.06027
## 2010-01-08 85.72421 40.40361 30.69972 51.80010 35.45044 55.38701 26.87913
## 2010-01-11 85.84388 40.23870 30.63575 51.59136 35.74146 55.08300 27.00768
## GLD
## 2010-01-04 109.80
## 2010-01-05 109.70
## 2010-01-06 111.51
## 2010-01-07 110.82
## 2010-01-08 111.37
## 2010-01-11 112.85tail(prices_xts)## SPY QQQ EEM IWM EFA TLT IYR GLD
## 2026-06-02 759.57 746.16 70.80 291.66 105.02 85.65 99.99 411.95
## 2026-06-03 754.24 744.21 69.92 287.67 104.12 85.31 100.00 407.87
## 2026-06-04 757.09 740.61 69.10 292.01 104.95 85.50 101.79 411.27
## 2026-06-05 737.55 705.06 64.59 281.65 102.26 85.06 102.54 396.24
## 2026-06-08 739.22 716.07 65.75 284.11 102.88 84.62 101.08 397.27
## 2026-06-09 NA NA NA NA NA NA NA NAQ2: Weekly and Monthly Simple Returns
# to.monthly keeps OHLC; we need just adjusted close → apply.monthly on each column
weekly_ret <- do.call(merge, lapply(tickers, function(tk) {
apply.weekly(prices_xts[, tk], function(x) (as.numeric(last(x)) / as.numeric(first(x))) - 1)
}))
colnames(weekly_ret) <- tickers
monthly_ret <- do.call(merge, lapply(tickers, function(tk) {
apply.monthly(prices_xts[, tk], function(x) (as.numeric(last(x)) / as.numeric(first(x))) - 1)
}))
colnames(monthly_ret) <- tickers
head(monthly_ret)## SPY QQQ EEM IWM EFA
## 2010-01-29 -0.05241313 -0.07819872 -0.103722809 -0.06048768 -0.07491656
## 2010-02-26 0.01540484 0.03467392 -0.008903904 0.03255506 -0.01534423
## 2010-03-31 0.04997572 0.06169201 0.063098794 0.05771657 0.05562920
## 2010-04-30 0.00857420 0.02242499 -0.027070643 0.04705535 -0.04493598
## 2010-05-28 -0.09123364 -0.08672153 -0.098864641 -0.09568653 -0.11824782
## 2010-06-30 -0.03551436 -0.05101614 0.004468181 -0.04856797 -0.01079325
## TLT IYR GLD
## 2010-01-29 0.027836428 -0.05195327 -0.034972713
## 2010-02-26 0.005704985 0.03573049 0.009967714
## 2010-03-31 -0.020144281 0.08633675 -0.004386396
## 2010-04-30 0.035750495 0.05898799 0.046254293
## 2010-05-28 0.052460175 -0.08516494 0.027218472
## 2010-06-30 0.050593340 -0.02782177 0.014761042Q3: Monthly Returns as Tibble
monthly_tbl <- data.frame(date = as.yearmon(index(monthly_ret)),
coredata(monthly_ret),
check.names = FALSE)
head(monthly_tbl)## date SPY QQQ EEM IWM EFA
## 1 Jan 2010 -0.05241313 -0.07819872 -0.103722809 -0.06048768 -0.07491656
## 2 Feb 2010 0.01540484 0.03467392 -0.008903904 0.03255506 -0.01534423
## 3 Mar 2010 0.04997572 0.06169201 0.063098794 0.05771657 0.05562920
## 4 Apr 2010 0.00857420 0.02242499 -0.027070643 0.04705535 -0.04493598
## 5 May 2010 -0.09123364 -0.08672153 -0.098864641 -0.09568653 -0.11824782
## 6 Jun 2010 -0.03551436 -0.05101614 0.004468181 -0.04856797 -0.01079325
## TLT IYR GLD
## 1 0.027836428 -0.05195327 -0.034972713
## 2 0.005704985 0.03573049 0.009967714
## 3 -0.020144281 0.08633675 -0.004386396
## 4 0.035750495 0.05898799 0.046254293
## 5 0.052460175 -0.08516494 0.027218472
## 6 0.050593340 -0.02782177 0.014761042Q4: Fama-French 3 Factors
ff_url <- "https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/F-F_Research_Data_Factors_CSV.zip"
tmp_zip <- tempfile(fileext = ".zip")
download.file(ff_url, tmp_zip, mode = "wb")
# Auto-detect CSV name inside zip
zip_contents <- unzip(tmp_zip, list = TRUE)
csv_name <- zip_contents$Name[grepl("\\.CSV$|\\.csv$", zip_contents$Name)][1]
extract_dir <- tempdir()
unzip(tmp_zip, files = csv_name, exdir = extract_dir)
csv_path <- file.path(extract_dir, csv_name)
ff_raw <- read.csv(csv_path, skip = 3, header = TRUE, stringsAsFactors = FALSE)
colnames(ff_raw)[1] <- "date"
# Keep only monthly rows (6-digit YYYYMM)
ff_monthly <- ff_raw %>%
filter(grepl("^\\s*[0-9]{6}\\s*$", as.character(date))) %>%
mutate(
date = as.yearmon(trimws(as.character(date)), "%Y%m"),
MktRF = as.numeric(trimws(as.character(Mkt.RF))) / 100,
SMB = as.numeric(trimws(as.character(SMB))) / 100,
HML = as.numeric(trimws(as.character(HML))) / 100,
RF = as.numeric(trimws(as.character(RF))) / 100
) %>%
select(date, MktRF, SMB, HML, RF)
head(ff_monthly)## date MktRF SMB HML RF
## 1 Jul 1926 0.0289 -0.0255 -0.0239 0.0022
## 2 Aug 1926 0.0264 -0.0114 0.0381 0.0025
## 3 Sep 1926 0.0038 -0.0136 0.0005 0.0023
## 4 Oct 1926 -0.0327 -0.0014 0.0082 0.0032
## 5 Nov 1926 0.0254 -0.0011 -0.0061 0.0031
## 6 Dec 1926 0.0262 -0.0007 0.0006 0.0028Q5: Merge Monthly Returns and FF3 Factors
merged_tbl <- inner_join(monthly_tbl, ff_monthly, by = "date")
# Verify ticker columns exist
stopifnot(all(tickers %in% colnames(merged_tbl)))
cat("Merged data: ", nrow(merged_tbl), "rows,", ncol(merged_tbl), "columns\n")## Merged data: 196 rows, 13 columnscat("Columns:", paste(colnames(merged_tbl), collapse = ", "), "\n")## Columns: date, SPY, QQQ, EEM, IWM, EFA, TLT, IYR, GLD, MktRF, SMB, HML, RFhead(merged_tbl)## date SPY QQQ EEM IWM EFA
## 1 Jan 2010 -0.05241313 -0.07819872 -0.103722809 -0.06048768 -0.07491656
## 2 Feb 2010 0.01540484 0.03467392 -0.008903904 0.03255506 -0.01534423
## 3 Mar 2010 0.04997572 0.06169201 0.063098794 0.05771657 0.05562920
## 4 Apr 2010 0.00857420 0.02242499 -0.027070643 0.04705535 -0.04493598
## 5 May 2010 -0.09123364 -0.08672153 -0.098864641 -0.09568653 -0.11824782
## 6 Jun 2010 -0.03551436 -0.05101614 0.004468181 -0.04856797 -0.01079325
## TLT IYR GLD MktRF SMB HML RF
## 1 0.027836428 -0.05195327 -0.034972713 -0.0335 0.0043 0.0033 0e+00
## 2 0.005704985 0.03573049 0.009967714 0.0339 0.0118 0.0318 0e+00
## 3 -0.020144281 0.08633675 -0.004386396 0.0630 0.0146 0.0219 1e-04
## 4 0.035750495 0.05898799 0.046254293 0.0199 0.0484 0.0296 1e-04
## 5 0.052460175 -0.08516494 0.027218472 -0.0790 0.0013 -0.0248 1e-04
## 6 0.050593340 -0.02782177 0.014761042 -0.0556 -0.0179 -0.0473 1e-04Q6: GMV Portfolio via CAPM (Single Period)
# --- Helper functions ---
# Global Minimum Variance weights (long-only) via quadprog
gmv_weights <- function(cov_mat) {
n <- ncol(cov_mat)
Dmat <- 2 * cov_mat
dvec <- rep(0, n)
Amat <- cbind(rep(1, n), diag(n)) # sum=1 + non-negative
bvec <- c(1, rep(0, n))
sol <- tryCatch(
solve.QP(Dmat, dvec, Amat, bvec, meq = 1)$solution,
error = function(e) rep(1/n, n) # fallback: equal weight
)
sol / sum(sol) # ensure exact sum=1
}
# CAPM covariance matrix
capm_cov <- function(ret_mat, mkt) {
n <- ncol(ret_mat)
betas <- sapply(1:n, function(i) cov(ret_mat[, i], mkt) / var(mkt))
resid_var <- sapply(1:n, function(i) {
e <- ret_mat[, i] - betas[i] * mkt
var(e)
})
as.matrix(betas %*% t(betas) * var(mkt) + diag(resid_var))
}
# FF3 covariance matrix
ff3_cov <- function(ret_mat, mkt, smb, hml) {
n <- ncol(ret_mat)
f_mat <- cbind(mkt, smb, hml)
betas <- t(sapply(1:n, function(i) {
coef(lm(ret_mat[, i] ~ mkt + smb + hml))[-1]
}))
resid_var <- sapply(1:n, function(i) {
var(residuals(lm(ret_mat[, i] ~ mkt + smb + hml)))
})
cov_f <- cov(f_mat)
as.matrix(betas %*% cov_f %*% t(betas) + diag(resid_var))
}
# --- Training window: 2010/02 – 2015/01 (60 months) ---
train <- merged_tbl %>%
filter(date >= as.yearmon("2010-02") & date <= as.yearmon("2015-01"))
ret_mat <- as.matrix(train[, tickers])
mkt_tot <- train$MktRF + train$RF # total market return for CAPM
cov_capm <- capm_cov(ret_mat, mkt_tot)
w_capm <- gmv_weights(cov_capm)
names(w_capm) <- tickers
cat("CAPM GMV Weights (estimated on 2015/01):\n")## CAPM GMV Weights (estimated on 2015/01):print(round(w_capm, 4))## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.2605 0.1036 0.0052 0.0000 0.0348 0.4598 0.0578 0.0783# Realized return in 2015/02
ret_201502 <- as.numeric(merged_tbl[merged_tbl$date == as.yearmon("2015-02"), tickers])
realized_capm <- sum(w_capm * ret_201502)
cat("\nRealized Return (CAPM GMV) 2015/02:", round(realized_capm * 100, 4), "%\n")##
## Realized Return (CAPM GMV) 2015/02: -1.222 %Q7: GMV Portfolio via FF3 Factor Model (Single Period)
cov_ff3 <- ff3_cov(ret_mat, train$MktRF, train$SMB, train$HML)
w_ff3 <- gmv_weights(cov_ff3)
names(w_ff3) <- tickers
cat("FF3 GMV Weights (estimated on 2015/01):\n")## FF3 GMV Weights (estimated on 2015/01):print(round(w_ff3, 4))## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.3279 0.0282 0.0000 0.0289 0.0214 0.4688 0.0640 0.0608realized_ff3 <- sum(w_ff3 * ret_201502)
cat("\nRealized Return (FF3 GMV) 2015/02:", round(realized_ff3 * 100, 4), "%\n")##
## Realized Return (FF3 GMV) 2015/02: -1.3181 %Q8: Rolling Backtest — GMV Portfolios (2015/02 to 2026/05)
invest_dates <- merged_tbl$date[
merged_tbl$date >= as.yearmon("2015-02") &
merged_tbl$date <= as.yearmon("2026-05")
]
roll_results <- lapply(invest_dates, function(t) {
train_end <- t - 1/12 # month before investment
train_start <- train_end - 59/12 # 60 months back
train_w <- merged_tbl %>%
filter(date >= train_start & date <= train_end)
if (nrow(train_w) < 55) return(NULL) # need ~60 obs
r_mat <- as.matrix(train_w[, tickers])
mkt_e <- train_w$MktRF
smb_ <- train_w$SMB
hml_ <- train_w$HML
rf_ <- train_w$RF
cov_c <- tryCatch(capm_cov(r_mat, mkt_e + rf_), error = function(e) NULL)
cov_f <- tryCatch(ff3_cov(r_mat, mkt_e, smb_, hml_), error = function(e) NULL)
ret_t <- as.numeric(merged_tbl[merged_tbl$date == t, tickers])
r_capm <- if (!is.null(cov_c)) sum(gmv_weights(cov_c) * ret_t) else NA
r_ff3 <- if (!is.null(cov_f)) sum(gmv_weights(cov_f) * ret_t) else NA
data.frame(date = t, ret_capm = r_capm, ret_ff3 = r_ff3)
})
backtest <- do.call(rbind, roll_results)
# Cumulative returns
backtest$cum_capm <- cumprod(1 + ifelse(is.na(backtest$ret_capm), 0, backtest$ret_capm))
backtest$cum_ff3 <- cumprod(1 + ifelse(is.na(backtest$ret_ff3), 0, backtest$ret_ff3))
cat("Final Cumulative Returns:\n")## Final Cumulative Returns:cat(" CAPM GMV:", round(tail(backtest$cum_capm, 1), 4), "\n")## CAPM GMV: 1.8267cat(" FF3 GMV:", round(tail(backtest$cum_ff3, 1), 4), "\n")## FF3 GMV: 1.7887# Plot
plot_data <- data.frame(
date = as.Date(as.yearmon(backtest$date)),
CAPM = backtest$cum_capm,
FF3 = backtest$cum_ff3
)
plot_long <- pivot_longer(plot_data, cols = c(CAPM, FF3),
names_to = "Model", values_to = "CumReturn")
ggplot(plot_long, aes(x = date, y = CumReturn, color = Model)) +
geom_line(linewidth = 1.1) +
scale_color_manual(values = c("CAPM" = "steelblue", "FF3" = "tomato")) +
labs(
title = "Cumulative Returns: GMV Portfolios (2015/02 – 2026/05)",
subtitle = "Rolling 60-month window, rebalanced monthly",
x = "Date",
y = "Cumulative Return (1 = initial investment)",
color = "Model"
) +
theme_minimal(base_size = 13) +
theme(legend.position = "bottom")