Final Exam: Portfolio Analysis
Mochammad Raffy Anugerah_114035129
10th June 2026
1 Part 1: Questions from Textbook (60%)
1.1 Chapter 7: CFA Problems 1–4, 10
Background: Hennessy & Associates manages a $30 million equity portfolio for Wilstead Pension Fund. Jones proposes limiting it to 20 stocks (from 40), doubling commitments to remaining holdings.
1.1.1 CFA 7.1
a. Will limiting to 20 stocks increase or decrease portfolio risk?
Limiting the portfolio to 20 stocks will likely increase risk. Reducing the number of holdings reduces diversification, so more unsystematic (firm-specific) risk remains in the portfolio. With 40 stocks, much of the idiosyncratic risk has already been diversified away; removing half the positions reverses some of that benefit.
b. Could Hennessy go from 40 to 20 stocks without significantly affecting risk?
Yes — if the 20 retained stocks are carefully selected to have low pairwise correlations across different industries and sectors. Diversification benefits depend more on the correlation structure than on the raw number of stocks. A well-chosen 20-stock portfolio with low inter-stock correlations could maintain a similar risk profile to the 40-stock portfolio.
1.1.2 CFA 7.2
Why might reducing to 10 stocks be less advantageous than reducing to 20?
The marginal benefit of diversification diminishes as the number of holdings falls. Going from 20 → 10 stocks means each position carries ~10% of the portfolio. A single adverse event in one stock now has a significant impact on total return. At this concentration level, unsystematic risk rises sharply and Hennessy’s stock-selection skill cannot fully offset that concentration risk. Additionally, Wilstead evaluates Hennessy’s portfolio independently, so there is no offset from the rest of the fund.
1.1.3 CFA 7.3
How does evaluating Hennessy’s portfolio in the context of the total fund change the picture?
If the committee views Hennessy’s holdings as part of the entire $280M Wilstead fund (which already holds 150+ stocks via the other five managers), the relevant risk measure is the contribution to total fund risk, not the standalone risk of Hennessy’s sub-portfolio. Since the other managers provide broad diversification, Hennessy’s portion could be concentrated in 10–20 high-conviction stocks without materially increasing total fund risk. In this broader view, concentration within Hennessy’s sleeve is more acceptable.
1.1.4 CFA 7.4
Which portfolio cannot lie on the Markowitz efficient frontier?
| Portfolio | E(R) | σ |
|---|---|---|
| W | 15% | 36% |
| X | 12% | 15% |
| Z | 5% | 7% |
| Y | 9% | 21% |
Answer: Portfolio Y
Portfolio X (12% return, 15% risk) dominates Portfolio Y (9% return, 21% risk) — X offers both higher return and lower risk. Since Y is dominated, it cannot lie on the efficient frontier.
1.1.5 CFA 7.10
Portfolio A&B vs. Portfolio B&C — which has lower risk?
Given: σ_A = 40%, σ_B = 20%, σ_C = 40%; ρ_AB = 0.90, ρ_BC = 0.10
For equal-weight (50/50) portfolio variance:
\[\sigma_p^2 = 0.25\sigma_1^2 + 2(0.25)\rho\sigma_1\sigma_2 + 0.25\sigma_2^2\]
# Stock parameters
sigma_A <- 40; sigma_B <- 20; sigma_C <- 40
rho_AB <- 0.90; rho_BC <- 0.10
# Portfolio A&B variance
var_AB <- 0.25*sigma_A^2 + 2*0.25*rho_AB*sigma_A*sigma_B + 0.25*sigma_B^2
sd_AB <- sqrt(var_AB)
# Portfolio B&C variance
var_BC <- 0.25*sigma_B^2 + 2*0.25*rho_BC*sigma_B*sigma_C + 0.25*sigma_C^2
sd_BC <- sqrt(var_BC)
cat("Portfolio A&B: Variance =", var_AB, "| Std Dev =", round(sd_AB, 2), "%\n")## Portfolio A&B: Variance = 860 | Std Dev = 29.33 %## Portfolio B&C: Variance = 540 | Std Dev = 23.24 %cat("\nRecommendation: Portfolio B&C has lower risk (", round(sd_BC,2), "% vs",
round(sd_AB,2), "%) due to much lower correlation (0.10 vs 0.90).\n")##
## Recommendation: Portfolio B&C has lower risk ( 23.24 % vs 29.33 %) due to much lower correlation (0.10 vs 0.90).Recommendation: Portfolio B&C — the low correlation (0.10) between B and C provides far greater diversification benefit, resulting in significantly lower portfolio risk.
1.2 Chapter 8: CFA Problems 1–5
1.2.1 CFA 8.1
Regression results: ABC (α=−3.20%, β=0.60, R²=0.35) and XYZ (α=7.3%, β=0.97, R²=0.17)
Interpretation:
ABC: Beta = 0.60 → less volatile than the market. R² = 0.35 → 35% of return variation is market-driven; 65% is firm-specific. Negative alpha suggests underperformance vs. CAPM prediction over the sample.
XYZ: Beta ≈ 1.0 → close to market sensitivity. R² = 0.17 → only 17% market-explained; 83% is unsystematic risk. Positive alpha (7.3%) suggests outperformance vs. CAPM.
Implications for a diversified portfolio:
In a well-diversified portfolio, unsystematic risk is eliminated — only beta drives expected return. XYZ’s high residual variance matters less; what counts is its beta (~0.97). However, beta estimates are unstable: brokerage estimates show ABC’s beta ranging 0.62–0.71 and XYZ’s ranging 1.25–1.45 over the past two years, suggesting both have drifted higher. Future betas may differ from the 5-year OLS estimates, creating uncertainty in forward-looking risk assessment.
1.2.2 CFA 8.2
Baker Fund: ρ(fund, market) = 0.70. What % of total risk is nonsystematic?
\[R^2 = \rho^2 = (0.70)^2 = 0.49\]
rho_baker <- 0.70
R2_baker <- rho_baker^2
nonsyst <- 1 - R2_baker
cat("R² (systematic proportion):", R2_baker, "\n")## R² (systematic proportion): 0.49## Nonsystematic proportion: 51 %51% of Baker Fund’s total risk is nonsystematic (firm-specific).
1.2.3 CFA 8.3
Charlottesville International: ρ = 1.0, E(R_m) = 11%, E(R_fund) = 9%, R_f = 3%. Implied beta?
Using CAPM: \(E(R) = R_f + \beta [E(R_m) - R_f]\)
## Implied Beta = 0.75Implied β = 0.75. Since ρ = 1.0, the fund moves perfectly with the world index but with less amplitude (β < 1), consistent with a defensive international fund.
1.2.4 CFA 8.4
Beta is most closely associated with:
Answer: (d) Systematic risk.
Beta measures a security’s sensitivity to market-wide movements — it is the standardized measure of non-diversifiable, systematic risk.
1.2.5 CFA 8.5
Beta vs. standard deviation as risk measures:
Answer: (b) Beta measures only systematic risk, while standard deviation measures total risk.
Standard deviation captures all variability (systematic + unsystematic). Beta captures only the component correlated with the market that cannot be diversified away in a broad portfolio.
1.3 Chapter 9: CFA Problems 8, 9, 10
Reference data: Portfolio R: E(R) = 11%, σ = 10%, β = 0.5 | S&P 500: E(R) = 14%, σ = 12%, β = 1.0
1.3.1 CFA 9.8
Where does Portfolio R lie relative to the SML?
# Assume Rf — solve: SML return for beta=0.5
# For any Rf: SML_R = Rf + 0.5*(14% - Rf)
# Portfolio R earns 11%. We check if 11% > SML prediction for reasonable Rf values.
Rf_vals <- seq(0, 0.08, by = 0.01)
SML_R <- Rf_vals + 0.5 * (0.14 - Rf_vals)
df <- data.frame(Rf = Rf_vals * 100, SML_predicted = SML_R * 100, Actual = 11)
df$Position <- ifelse(df$Actual > df$SML_predicted, "Above SML", "Below SML")
print(df)## Rf SML_predicted Actual Position
## 1 0 7.0 11 Above SML
## 2 1 7.5 11 Above SML
## 3 2 8.0 11 Above SML
## 4 3 8.5 11 Above SML
## 5 4 9.0 11 Above SML
## 6 5 9.5 11 Above SML
## 7 6 10.0 11 Above SML
## 8 7 10.5 11 Above SML
## 9 8 11.0 11 Below SMLFor any R_f below 8%, Portfolio R’s actual return (11%) exceeds the SML-predicted return. Answer: (c) Above the SML. Portfolio R has a positive alpha — it outperformed its CAPM-implied expected return.
1.3.2 CFA 9.9
Where does Portfolio R lie relative to the CML?
The CML plots efficient portfolios by total risk (σ). With R_f ≈ 6% (implied from S&P data):
\[\text{CML slope} = \frac{E(R_m) - R_f}{\sigma_m} = \frac{14\% - 6\%}{12\%} = 0.667\]
\[\text{CML return at } \sigma=10\% = 6\% + 0.667 \times 10\% = 12.67\%\]
Rf_implied <- 0.06 # reasonable assumption
Rm <- 0.14; sigma_m <- 0.12
CML_slope <- (Rm - Rf_implied) / sigma_m
CML_at_10 <- Rf_implied + CML_slope * 0.10
cat("CML slope:", round(CML_slope, 4), "\n")## CML slope: 0.6667## CML predicted return at sigma=10%: 12.67 %## Portfolio R actual return: 11%## Position: Below CMLPortfolio R earns 11% but the CML predicts ~12.67% for a portfolio with σ = 10%. Since R is not a fully efficient (well-diversified) portfolio, it lies below the CML. Answer: (b) Below the CML.
1.3.3 CFA 9.10
Should investors expect higher return on Portfolio A than Portfolio B according to CAPM?
| Portfolio A | Portfolio B | |
|---|---|---|
| Systematic risk (beta) | 1.0 | 1.0 |
| Specific risk | High | Low |
Answer: No — CAPM says both portfolios should have the same expected return.
Under CAPM, only systematic risk (beta) is priced. Both A and B have identical betas (1.0), so they should earn the same expected return. Specific (unsystematic) risk is not compensated by the market because rational investors hold diversified portfolios and eliminate firm-specific risk. Portfolio A’s higher idiosyncratic risk is irrelevant to its CAPM-implied expected return.
1.4 Chapter 10: Problems 13–16
Background: McCracken uses a two-factor APT model with GDP growth (risk premium = 8%) and inflation (risk premium = 2%).
- High Growth Fund: β_GDP = 1.25, β_inflation = 1.5
- Large Cap Fund: β_GDP = 0.75, β_inflation = 1.25; Kwon’s fundamental estimate = R_f + 8.5%
- Utility Fund: β_GDP = 1.0, β_inflation = 2.0
1.4.1 Problem 13
APT expected return for High Growth Fund (R_f = 4%)?
\[E(R) = R_f + \beta_{GDP} \times RP_{GDP} + \beta_{infl} \times RP_{infl}\]
Rf <- 0.04
beta_gdp_hg <- 1.25; beta_inf_hg <- 1.5
RP_gdp <- 0.08; RP_inf <- 0.02
E_HGF <- Rf + beta_gdp_hg * RP_gdp + beta_inf_hg * RP_inf
cat("APT Expected Return for High Growth Fund:", E_HGF * 100, "%\n")## APT Expected Return for High Growth Fund: 17 %E(R) = 4% + 1.25×8% + 1.5×2% = 4% + 10% + 3% = 17%
1.4.2 Problem 14
Is there an arbitrage opportunity for the Large Cap Fund?
beta_gdp_lc <- 0.75; beta_inf_lc <- 1.25
E_LCF_APT <- Rf + beta_gdp_lc * RP_gdp + beta_inf_lc * RP_inf
E_LCF_fund <- Rf + 0.085 # Kwon's estimate: Rf + 8.5%
cat("APT predicted return for Large Cap Fund:", E_LCF_APT * 100, "%\n")## APT predicted return for Large Cap Fund: 12.5 %## Kwon's fundamental estimate: 12.5 %## Difference: 0 %if (E_LCF_fund > E_LCF_APT) {
cat("=> Large Cap Fund is UNDERPRICED (actual > APT). Arbitrage: LONG Large Cap Fund.\n")
} else {
cat("=> No arbitrage opportunity.\n")
}## => No arbitrage opportunity.APT predicts: 4% + 0.75×8% + 1.25×2% = 4% + 6% + 2.5% = 12.5%
Kwon estimates: 4% + 8.5% = 12.5%
No arbitrage opportunity — Kwon’s estimate equals the APT prediction.
1.4.3 Problem 15
Weight of the Utility Fund in the GDP Fund?
The GDP Fund must have: β_GDP = 1, β_inflation = 0
Let w_HG, w_LC, w_UT be the weights in High Growth, Large Cap, and Utility funds.
System of equations:
- β_GDP: 1.25·w_HG + 0.75·w_LC + 1.0·w_UT = 1
- β_infl: 1.5·w_HG + 1.25·w_LC + 2.0·w_UT = 0
- Weights sum: w_HG + w_LC + w_UT = 1
# Solve the system: A %*% w = b
A <- matrix(c(1.25, 0.75, 1.0,
1.5, 1.25, 2.0,
1.0, 1.0, 1.0), nrow = 3, byrow = TRUE)
b <- c(1, 0, 1)
w <- solve(A, b)
names(w) <- c("w_HighGrowth", "w_LargeCap", "w_Utility")
print(round(w, 4))## w_HighGrowth w_LargeCap w_Utility
## 1.6 1.6 -2.2##
## Weight in Utility Fund: -2.2Answer: (b) −3.2 — the Utility Fund gets a weight of approximately −3.2 (a short position).
1.4.4 Problem 16
Stiles says the GDP Fund suits retirees; McCracken disagrees. Who is correct?
Answer: (c) Stiles is correct and McCracken is wrong.
The GDP Fund has unit sensitivity to real GDP growth and zero inflation sensitivity. Retirees who live off steady investment income benefit from a fund that captures real economic growth (GDP) without inflation drag. This is consistent with Stiles’ view. McCracken’s conditional statement (only good if supply-side policies succeed) is overly restrictive — the fund’s structure inherently suits income-focused investors regardless of specific policy outcomes.
library(tidyverse)
library(tidyquant)
library(timetk)
library(xts)
library(zoo)
library(PerformanceAnalytics)
library(quadprog)
library(frenchdata)2 Part 2: R Code Questions (40%)
2.1 Q1: Import ETF Data
library(tidyquant)
library(tidyverse)
library(timetk)
library(xts)
library(zoo)
tickers <- c("SPY","QQQ","EEM","IWM","EFA","TLT","IYR","GLD")
prices_tbl <- tq_get(
tickers,
from = "2010-01-01",
to = Sys.Date()
)
prices_wide <- prices_tbl %>%
select(symbol,date,adjusted) %>%
pivot_wider(names_from = symbol,
values_from = adjusted)
prices_xts <- xts(
prices_wide[, -1],
order.by = prices_wide$date
)2.2 Q2: Calculate Weekly and Monthly Returns (Simple Returns)
library(PerformanceAnalytics)
monthly_returns_xts <- Return.calculate(
prices_xts,
method = "discrete"
)
monthly_returns_xts <- monthly_returns_xts[-1, ]
monthly_returns_xts <- apply.monthly(
monthly_returns_xts,
Return.cumulative
)
head(monthly_returns_xts)## SPY QQQ EEM IWM EFA
## 2010-01-29 -0.05241349 -0.07819892 -0.103722676 -0.06048754 -0.074916155
## 2010-02-26 0.03119499 0.04603828 0.017763489 0.04475145 0.002667503
## 2010-03-31 0.06087994 0.07710961 0.081109066 0.08230669 0.063854211
## 2010-04-30 0.01546963 0.02242500 -0.001662194 0.05678497 -0.028045888
## 2010-05-28 -0.07945424 -0.07392332 -0.093935383 -0.07536634 -0.111927916
## 2010-06-30 -0.05174110 -0.05975697 -0.013986776 -0.07743420 -0.020618972
## TLT IYR GLD
## 2010-01-29 0.027836225 -0.05195346 -0.034972713
## 2010-02-26 -0.003423951 0.05457070 0.032748219
## 2010-03-31 -0.020573977 0.09748419 -0.004386396
## 2010-04-30 0.033218881 0.06388130 0.058834363
## 2010-05-28 0.051083186 -0.05683535 0.030513147
## 2010-06-30 0.057978586 -0.04670097 0.0235531892.3 Q3: Convert Monthly Returns to Tibble Format
monthly_returns_tbl <- tk_tbl(
monthly_returns_xts,
rename_index = "date"
)
head(monthly_returns_tbl)## # A tibble: 6 × 9
## date SPY QQQ EEM IWM EFA TLT IYR GLD
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2010-01-29 -0.0524 -0.0782 -0.104 -0.0605 -0.0749 0.0278 -0.0520 -0.0350
## 2 2010-02-26 0.0312 0.0460 0.0178 0.0448 0.00267 -0.00342 0.0546 0.0327
## 3 2010-03-31 0.0609 0.0771 0.0811 0.0823 0.0639 -0.0206 0.0975 -0.00439
## 4 2010-04-30 0.0155 0.0224 -0.00166 0.0568 -0.0280 0.0332 0.0639 0.0588
## 5 2010-05-28 -0.0795 -0.0739 -0.0939 -0.0754 -0.112 0.0511 -0.0568 0.0305
## 6 2010-06-30 -0.0517 -0.0598 -0.0140 -0.0774 -0.0206 0.0580 -0.0467 0.02362.4 Q4: Download Fama-French 3 Factors Data
library(frenchdata)
ff3_raw <- download_french_data(
"Fama/French 3 Factors"
)
ff3_monthly_raw <- ff3_raw$subsets$data[[1]]
colnames(ff3_monthly_raw)[1] <- "date"
ff3_monthly <- ff3_monthly_raw %>%
mutate(date = as.character(date)) %>%
filter(grepl("^[0-9]{6}$", date)) %>%
mutate(
date = as.Date(
paste0(date,"01"),
format = "%Y%m%d"
),
`Mkt-RF` = as.numeric(`Mkt-RF`) / 100,
SMB = as.numeric(SMB) / 100,
HML = as.numeric(HML) / 100,
RF = as.numeric(RF) / 100
)
head(ff3_monthly)## # A tibble: 6 × 5
## date `Mkt-RF` SMB HML RF
## <date> <dbl> <dbl> <dbl> <dbl>
## 1 1926-07-01 0.0289 -0.0255 -0.0239 0.0022
## 2 1926-08-01 0.0264 -0.0114 0.0381 0.0025
## 3 1926-09-01 0.0038 -0.0136 0.0005 0.0023
## 4 1926-10-01 -0.0327 -0.0014 0.0082 0.0032
## 5 1926-11-01 0.0254 -0.0011 -0.0061 0.0031
## 6 1926-12-01 0.0262 -0.0007 0.0006 0.00282.5 Q5: Merge Monthly Returns and FF3 Factors
monthly_returns_tbl <- monthly_returns_tbl %>%
mutate(ym = format(date, "%Y-%m"))
ff3_monthly <- ff3_monthly %>%
mutate(ym = format(date, "%Y-%m"))
merged_tbl <- monthly_returns_tbl %>%
inner_join(
ff3_monthly %>%
select(ym, `Mkt-RF`, SMB, HML, RF),
by = "ym"
)
cat("Rows in merged_tbl:", nrow(merged_tbl), "\n")## Rows in merged_tbl: 196## [1] "2010-01-29" "2026-04-30"## # A tibble: 6 × 14
## date SPY QQQ EEM IWM EFA TLT IYR GLD
## <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2010-01-29 -0.0524 -0.0782 -0.104 -0.0605 -0.0749 0.0278 -0.0520 -0.0350
## 2 2010-02-26 0.0312 0.0460 0.0178 0.0448 0.00267 -0.00342 0.0546 0.0327
## 3 2010-03-31 0.0609 0.0771 0.0811 0.0823 0.0639 -0.0206 0.0975 -0.00439
## 4 2010-04-30 0.0155 0.0224 -0.00166 0.0568 -0.0280 0.0332 0.0639 0.0588
## 5 2010-05-28 -0.0795 -0.0739 -0.0939 -0.0754 -0.112 0.0511 -0.0568 0.0305
## 6 2010-06-30 -0.0517 -0.0598 -0.0140 -0.0774 -0.0206 0.0580 -0.0467 0.0236
## # ℹ 5 more variables: ym <chr>, `Mkt-RF` <dbl>, SMB <dbl>, HML <dbl>, RF <dbl>2.6 Q6: CAPM Covariance Matrix & GMV Portfolio (2015/01)
# Helper: Global Minimum Variance weights using quadprog
gmv_weights <- function(cov_matrix) {
n <- ncol(cov_matrix)
Dmat <- 2 * cov_matrix
dvec <- rep(0, n)
# Constraints: weights sum to 1, all weights >= 0 (long-only)
Amat <- cbind(rep(1, n), diag(n))
bvec <- c(1, rep(0, n))
sol <- solve.QP(Dmat, dvec, Amat, bvec, meq = 1)
sol$solution
}
# CAPM covariance from factor model
capm_cov <- function(returns_mat, ff3_mat) {
n <- ncol(returns_mat)
T_obs <- nrow(returns_mat)
betas <- numeric(n)
resid_var <- numeric(n)
mkt_excess <- ff3_mat[, "Mkt-RF"]
rf <- ff3_mat[, "RF"]
for (i in 1:n) {
excess_i <- returns_mat[, i] - rf
fit <- lm(excess_i ~ mkt_excess)
betas[i] <- coef(fit)[2]
resid_var[i] <- var(residuals(fit))
}
var_mkt <- var(mkt_excess)
# Cov = beta %*% t(beta) * var_mkt + diag(residual variances)
cov_mat <- (betas %o% betas) * var_mkt + diag(resid_var)
cov_mat
}
# --- Filter 60-month window: 2010/02 - 2015/01 ---
window_data <- merged_tbl %>%
filter(date >= as.Date("2010-02-01") & date <= as.Date("2015-01-31"))
ret_mat <- as.matrix(window_data[, tickers])
ff3_mat <- as.matrix(window_data[, c("Mkt-RF", "SMB", "HML", "RF")])
# Compute CAPM covariance matrix
cov_capm <- capm_cov(ret_mat, ff3_mat)
rownames(cov_capm) <- colnames(cov_capm) <- tickers
cat("CAPM Covariance Matrix (2010/02 - 2015/01):\n")## CAPM Covariance Matrix (2010/02 - 2015/01):## SPY QQQ EEM IWM EFA TLT IYR GLD
## SPY 0.1397 0.1459 0.1726 0.1828 0.1581 -0.1011 0.1179 0.0235
## QQQ 0.1459 0.1816 0.1815 0.1923 0.1662 -0.1064 0.1240 0.0247
## EEM 0.1726 0.1815 0.3350 0.2274 0.1966 -0.1258 0.1466 0.0292
## IWM 0.1828 0.1923 0.2274 0.2699 0.2083 -0.1333 0.1554 0.0310
## EFA 0.1581 0.1662 0.1966 0.2083 0.2413 -0.1152 0.1343 0.0268
## TLT -0.1011 -0.1064 -0.1258 -0.1333 -0.1152 0.1621 -0.0859 -0.0171
## IYR 0.1179 0.1240 0.1466 0.1554 0.1343 -0.0859 0.2025 0.0200
## GLD 0.0235 0.0247 0.0292 0.0310 0.0268 -0.0171 0.0200 0.2899# Compute GMV weights
w_capm <- gmv_weights(cov_capm)
names(w_capm) <- tickers
cat("\nGMV Optimal Weights (CAPM) as of 2015/01:\n")##
## GMV Optimal Weights (CAPM) as of 2015/01:## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.4471 0.0000 0.0000 0.0000 0.0000 0.4483 0.0373 0.0673# Realized return in 2015/02
ret_201502 <- merged_tbl %>%
filter(format(date, "%Y-%m") == "2015-02") %>%
select(all_of(tickers)) %>%
as.numeric()
realized_capm <- sum(w_capm * ret_201502)
cat("\nRealized GMV Portfolio Return (CAPM) in 2015/02:",
round(realized_capm * 100, 4), "%\n")##
## Realized GMV Portfolio Return (CAPM) in 2015/02: -0.733 %## [1] 60 8## [1] 60 42.7 Q7: FF3 Covariance Matrix & GMV Portfolio (2015/01)
# FF3 covariance from factor model
ff3_cov <- function(returns_mat, ff3_mat) {
n <- ncol(returns_mat)
factors <- ff3_mat[, c("Mkt-RF", "SMB", "HML")]
rf <- ff3_mat[, "RF"]
B <- matrix(0, nrow = n, ncol = 3)
resid_var <- numeric(n)
for (i in 1:n) {
excess_i <- returns_mat[, i] - rf
fit <- lm(excess_i ~ factors)
B[i, ] <- coef(fit)[2:4]
resid_var[i]<- var(residuals(fit))
}
cov_factors <- cov(factors)
# Cov = B %*% cov_factors %*% t(B) + diag(residual variances)
cov_mat <- B %*% cov_factors %*% t(B) + diag(resid_var)
cov_mat
}
# Compute FF3 covariance matrix
cov_ff3 <- ff3_cov(ret_mat, ff3_mat)
rownames(cov_ff3) <- colnames(cov_ff3) <- tickers
cat("FF3 Covariance Matrix (2010/02 - 2015/01):\n")## FF3 Covariance Matrix (2010/02 - 2015/01):## SPY QQQ EEM IWM EFA TLT IYR GLD
## SPY 0.1397 0.1464 0.1725 0.1787 0.1601 -0.1008 0.1179 0.0204
## QQQ 0.1464 0.1816 0.1844 0.1870 0.1713 -0.0995 0.1248 0.0337
## EEM 0.1725 0.1844 0.3350 0.2270 0.1980 -0.1228 0.1470 0.0350
## IWM 0.1787 0.1870 0.2270 0.2699 0.1943 -0.1379 0.1552 0.0469
## EFA 0.1601 0.1713 0.1980 0.1943 0.2413 -0.1104 0.1347 0.0237
## TLT -0.1008 -0.0995 -0.1228 -0.1379 -0.1104 0.1621 -0.0851 -0.0072
## IYR 0.1179 0.1248 0.1470 0.1552 0.1347 -0.0851 0.2025 0.0216
## GLD 0.0204 0.0337 0.0350 0.0469 0.0237 -0.0072 0.0216 0.2899# Compute GMV weights under FF3
w_ff3 <- gmv_weights(cov_ff3)
names(w_ff3) <- tickers
cat("\nGMV Optimal Weights (FF3) as of 2015/01:\n")##
## GMV Optimal Weights (FF3) as of 2015/01:## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.4579 0.0000 0.0000 0.0000 0.0000 0.4507 0.0334 0.0581# Realized return in 2015/02
realized_ff3 <- sum(w_ff3 * ret_201502)
cat("\nRealized GMV Portfolio Return (FF3) in 2015/02:",
round(realized_ff3 * 100, 4), "%\n")##
## Realized GMV Portfolio Return (FF3) in 2015/02: -0.6224 %2.8 Q8: Backtesting GMV Portfolios (2015/02 – 2026/05)
# All dates in merged_tbl
all_dates <- merged_tbl$date
# Training window: 60 months; first investment month: 2015/02
invest_dates <- all_dates[all_dates >= as.Date("2015-02-01") &
all_dates <= as.Date("2026-05-31")]
# Rolling backtest function
rolling_gmv <- function(cov_fn, merged_data, tickers, invest_dates) {
portfolio_returns <- numeric(length(invest_dates))
for (i in seq_along(invest_dates)) {
t_date <- invest_dates[i]
# 60-month training window ending the month before
window_end <- all_dates[all_dates < t_date]
window_end <- tail(window_end, 1)
window_start <- all_dates[all_dates <= window_end]
window_start <- window_start[max(1, length(window_start) - 59)]
train <- merged_data %>%
filter(date >= window_start & date <= window_end)
if (nrow(train) < 60) {
portfolio_returns[i] <- NA
next
}
ret_m <- as.matrix(train[, tickers])
ff3_m <- as.matrix(train[, c("Mkt-RF", "SMB", "HML", "RF")])
cov_m <- cov_fn(ret_m, ff3_m)
w <- tryCatch(gmv_weights(cov_m), error = function(e) rep(1/8, 8))
names(w) <- tickers
ret_t <- merged_data %>%
filter(date == t_date) %>%
select(all_of(tickers)) %>%
as.numeric()
portfolio_returns[i] <- sum(w * ret_t)
}
tibble(date = invest_dates, portfolio_return = portfolio_returns)
}
# Run backtests
cat("Running CAPM backtest...\n")## Running CAPM backtest...bt_capm <- rolling_gmv(capm_cov, merged_tbl, tickers, invest_dates)
bt_capm <- bt_capm %>% mutate(model = "CAPM")
cat("Running FF3 backtest...\n")## Running FF3 backtest...bt_ff3 <- rolling_gmv(ff3_cov, merged_tbl, tickers, invest_dates)
bt_ff3 <- bt_ff3 %>% mutate(model = "FF3")
# Combine
bt_all <- bind_rows(bt_capm, bt_ff3) %>% filter(!is.na(portfolio_return))
# Cumulative returns
bt_all <- bt_all %>%
group_by(model) %>%
mutate(cum_return = cumprod(1 + portfolio_return) - 1) %>%
ungroup()
# Plot cumulative returns
library(ggplot2)
ggplot(bt_all, aes(x = date, y = cum_return * 100, color = model)) +
geom_line(linewidth = 1.1) +
labs(
title = "Cumulative Returns: GMV Portfolio — CAPM vs. Fama-French 3-Factor Model",
subtitle = "Rolling 60-month window | Investment period: 2015/02 – 2026/05",
x = "Date",
y = "Cumulative Return (%)",
color = "Model"
) +
scale_color_manual(values = c("CAPM" = "#2196F3", "FF3" = "#E91E63")) +
scale_y_continuous(labels = scales::percent_format(scale = 1)) +
theme_minimal(base_size = 13) +
theme(legend.position = "top")
# Performance summary table
perf_summary <- bt_all %>%
group_by(model) %>%
summarise(
Total_Return = paste0(round(last(cum_return) * 100, 2), "%"),
Mean_Monthly = paste0(round(mean(portfolio_return) * 100, 4), "%"),
Volatility = paste0(round(sd(portfolio_return) * 100, 4), "%"),
Sharpe_Approx = round(mean(portfolio_return) / sd(portfolio_return), 4),
.groups = "drop"
)
knitr::kable(perf_summary,
caption = "GMV Portfolio Performance Summary (2015/02 – 2026/05)",
align = "lcccc")| model | Total_Return | Mean_Monthly | Volatility | Sharpe_Approx |
|---|---|---|---|---|
| CAPM | 132.29% | 0.6715% | 3.0274% | 0.2218 |
| FF3 | 129.49% | 0.6632% | 3.0515% | 0.2173 |
End of Final Exam