Mid-Term
Enkhmaa
2026-04-17
1 Part I: Computer Questions (40%)
1.1 Q1: Download ETF Daily Data (2010–2025)
library(quantmod)
library(tidyverse)
library(PerformanceAnalytics)
library(xts)
library(quadprog)
library(frenchdata)
library(moments) # skewness / kurtosis
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"prices_daily <- do.call(merge, lapply(tickers, function(tk) Ad(get(tk))))
colnames(prices_daily) <- tickers
cat("Daily price dimensions:", dim(prices_daily), "\n")## Daily price dimensions: 4023 8## SPY QQQ EEM IWM EFA TLT IYR GLD
## 2025-12-26 688.4299 623.1043 54.80 250.9736 96.57 86.76929 94.05600 416.74
## 2025-12-29 685.9766 620.0881 54.66 249.4363 96.28 87.09565 94.23550 398.60
## 2025-12-30 685.1389 618.6499 54.88 247.5896 96.44 86.88796 94.44491 398.891.2 Q2: Monthly Discrete Returns
prices_monthly <- to.monthly(prices_daily, indexAt = "lastof", OHLC = FALSE)
ret_monthly <- na.omit(Return.calculate(prices_monthly, method = "discrete"))
cat("Monthly return dimensions:", dim(ret_monthly), "\n")## Monthly return dimensions: 191 8## SPY QQQ EEM IWM EFA
## 2010-02-28 0.03119479 0.04603846 0.017763700 0.04475137 0.002667503
## 2010-03-31 0.06087974 0.07710916 0.081109123 0.08230731 0.063854445
## 2010-04-30 0.01546980 0.02242490 -0.001662194 0.05678460 -0.028046102
## TLT IYR GLD
## 2010-02-28 -0.003423575 0.05457024 0.032748219
## 2010-03-31 -0.020573475 0.09748457 -0.004386396
## 2010-04-30 0.033218069 0.06388103 0.0588343631.3 Q3: Fama-French 3-Factor Monthly Data
ff3_raw <- download_french_data("Fama/French 3 Factors")
ff3_mon <- ff3_raw$subsets$data[[1]]
ff3_mon <- ff3_mon %>%
mutate(date = as.Date(paste0(date, "01"), format = "%Y%m%d"),
MktRF = as.numeric(`Mkt-RF`) / 100,
SMB = as.numeric(SMB) / 100,
HML = as.numeric(HML) / 100,
RF = as.numeric(RF) / 100) %>%
select(date, MktRF, SMB, HML, RF) %>%
filter(date >= as.Date("2010-01-01"),
date <= as.Date("2025-12-31"))
head(ff3_mon, 3)## # A tibble: 3 × 5
## date MktRF SMB HML RF
## <date> <dbl> <dbl> <dbl> <dbl>
## 1 2010-01-01 -0.0335 0.0043 0.0033 0
## 2 2010-02-01 0.0339 0.0118 0.0318 0
## 3 2010-03-01 0.063 0.0146 0.0219 0.00011.4 Q4: Merge Monthly Returns with FF3 Factors
ret_df <- as.data.frame(ret_monthly)
ret_df$date <- as.Date(format(as.Date(index(ret_monthly)), "%Y-%m-01"))
merged <- inner_join(ret_df, ff3_mon, by = "date")
cat("Merged data dimensions:", dim(merged), "\n")## Merged data dimensions: 191 13## SPY QQQ EEM IWM EFA TLT
## 1 0.03119479 0.04603846 0.017763700 0.04475137 0.002667503 -0.003423575
## 2 0.06087974 0.07710916 0.081109123 0.08230731 0.063854445 -0.020573475
## 3 0.01546980 0.02242490 -0.001662194 0.05678460 -0.028046102 0.033218069
## IYR GLD date MktRF SMB HML RF
## 1 0.05457024 0.032748219 2010-02-01 0.0339 0.0118 0.0318 0e+00
## 2 0.09748457 -0.004386396 2010-03-01 0.0630 0.0146 0.0219 1e-04
## 3 0.06388103 0.058834363 2010-04-01 0.0199 0.0484 0.0296 1e-041.5 Q5: MVP via CAPM Covariance (2020/03–2025/02)
win <- merged %>%
filter(date >= as.Date("2020-03-01"),
date <= as.Date("2025-02-01"))
etf_ret <- win[, tickers]
mkt_ex <- win$MktRF
rf_vec <- win$RF
n <- length(tickers)
# CAPM betas and residuals
betas_capm <- numeric(n); names(betas_capm) <- tickers
sig2_resid <- numeric(n); names(sig2_resid) <- tickers
for (tk in tickers) {
ex <- etf_ret[[tk]] - rf_vec
fit <- lm(ex ~ mkt_ex)
betas_capm[tk] <- coef(fit)["mkt_ex"]
sig2_resid[tk] <- var(residuals(fit))
}
sig2_mkt <- var(mkt_ex)
cov_capm <- outer(betas_capm, betas_capm) * sig2_mkt + diag(sig2_resid)
# Solve for MVP: min w'Σw s.t. sum(w)=1, w>=0
Amat <- cbind(rep(1, n), diag(n))
bvec <- c(1, rep(0, n))
sol_capm <- solve.QP(2 * cov_capm, rep(0, n), Amat, bvec, meq = 1)
w_capm <- sol_capm$solution; names(w_capm) <- tickers
cat("=== MVP Weights (CAPM) ===\n")## === MVP Weights (CAPM) ===## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.0000 0.0000 0.1401 0.0000 0.0838 0.3425 0.0000 0.4336## Sum: 1mu_assets <- colMeans(etf_ret)
er_mvp_capm <- sum(w_capm * mu_assets)
sd_mvp_capm <- sqrt(t(w_capm) %*% cov_capm %*% w_capm)
cat(sprintf("MVP E(r): %.4f%% | MVP σ: %.4f%%\n",
er_mvp_capm * 100, sd_mvp_capm * 100))## MVP E(r): 0.3927% | MVP σ: 2.9838%1.6 Q6: MVP via FF3 Covariance (2020/03–2025/02)
factors3 <- win[, c("MktRF","SMB","HML")]
betas_ff3 <- matrix(NA, 3, n,
dimnames = list(c("MktRF","SMB","HML"), tickers))
sig2_res_ff3 <- numeric(n); names(sig2_res_ff3) <- tickers
for (tk in tickers) {
ex <- etf_ret[[tk]] - rf_vec
fit <- lm(ex ~ MktRF + SMB + HML, data = factors3)
betas_ff3[, tk] <- coef(fit)[c("MktRF","SMB","HML")]
sig2_res_ff3[tk] <- var(residuals(fit))
}
cov_factors <- cov(factors3)
cov_ff3 <- t(betas_ff3) %*% cov_factors %*% betas_ff3 +
diag(sig2_res_ff3)
sol_ff3 <- solve.QP(2 * cov_ff3, rep(0, n), Amat, bvec, meq = 1)
w_ff3 <- sol_ff3$solution; names(w_ff3) <- tickers
cat("=== MVP Weights (FF3) ===\n")## === MVP Weights (FF3) ===## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.0000 0.0000 0.1565 0.0000 0.0821 0.3391 0.0000 0.4223## Sum: 1er_mvp_ff3 <- sum(w_ff3 * mu_assets)
sd_mvp_ff3 <- sqrt(t(w_ff3) %*% cov_ff3 %*% w_ff3)
cat(sprintf("MVP E(r): %.4f%% | MVP σ: %.4f%%\n",
er_mvp_ff3 * 100, sd_mvp_ff3 * 100))## MVP E(r): 0.3883% | MVP σ: 2.9739%1.7 Q7: Realized Returns – March 2025
mar25 <- merged %>% filter(date == as.Date("2025-03-01"))
if (nrow(mar25) == 0) {
mar25 <- tail(merged, 1)
cat("Note: using latest available month:", as.character(mar25$date), "\n")
}
ret_mar <- as.numeric(mar25[, tickers])
r_capm_mar <- sum(w_capm * ret_mar)
r_ff3_mar <- sum(w_ff3 * ret_mar)
cat(sprintf("Realized MVP Return (CAPM) – March 2025: %.4f%%\n", r_capm_mar * 100))## Realized MVP Return (CAPM) – March 2025: 3.8576%## Realized MVP Return (FF3) – March 2025: 3.7730%1.8 Q8: Realized Returns – April 2025 (Rolling Window 2020/04–2025/03)
win2 <- merged %>%
filter(date >= as.Date("2020-04-01"),
date <= as.Date("2025-03-01"))
etf2 <- win2[, tickers]
mkt2 <- win2$MktRF
rf2 <- win2$RF
fac2 <- win2[, c("MktRF","SMB","HML")]
n2 <- length(tickers)
Amat2 <- cbind(rep(1, n2), diag(n2))
bvec2 <- c(1, rep(0, n2))
# CAPM MVP (April window)
b2_capm <- numeric(n2); s2_capm <- numeric(n2)
names(b2_capm) <- names(s2_capm) <- tickers
for (tk in tickers) {
ex <- etf2[[tk]] - rf2
fit <- lm(ex ~ mkt2)
b2_capm[tk] <- coef(fit)["mkt2"]
s2_capm[tk] <- var(residuals(fit))
}
cov2_capm <- outer(b2_capm, b2_capm) * var(mkt2) + diag(s2_capm)
w2_capm <- solve.QP(2 * cov2_capm, rep(0, n2), Amat2, bvec2, meq = 1)$solution
names(w2_capm) <- tickers
# FF3 MVP (April window)
b2_ff3 <- matrix(NA, 3, n2,
dimnames = list(c("MktRF","SMB","HML"), tickers))
s2_ff3 <- numeric(n2); names(s2_ff3) <- tickers
for (tk in tickers) {
ex <- etf2[[tk]] - rf2
fit <- lm(ex ~ MktRF + SMB + HML, data = fac2)
b2_ff3[, tk] <- coef(fit)[c("MktRF","SMB","HML")]
s2_ff3[tk] <- var(residuals(fit))
}
cov2_ff3 <- t(b2_ff3) %*% cov(fac2) %*% b2_ff3 + diag(s2_ff3)
w2_ff3 <- solve.QP(2 * cov2_ff3, rep(0, n2), Amat2, bvec2, meq = 1)$solution
names(w2_ff3) <- tickers
cat("=== MVP Weights for April 2025 (CAPM window) ===\n")## === MVP Weights for April 2025 (CAPM window) ===## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.0000 0.0000 0.1847 0.0000 0.1140 0.3046 0.0000 0.3967## === MVP Weights for April 2025 (FF3 window) ===## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.0000 0.0000 0.1949 0.0000 0.1051 0.3064 0.0000 0.3936# April 2025 realized return
apr25 <- merged %>% filter(date == as.Date("2025-04-01"))
if (nrow(apr25) > 0) {
ret_apr <- as.numeric(apr25[, tickers])
cat(sprintf("\nRealized MVP Return (CAPM) – April 2025: %.4f%%\n",
sum(w2_capm * ret_apr) * 100))
cat(sprintf("Realized MVP Return (FF3) – April 2025: %.4f%%\n",
sum(w2_ff3 * ret_apr) * 100))
} else {
cat("\nApril 2025 data not yet available in merged dataset.\n")
}##
## Realized MVP Return (CAPM) – April 2025: 2.1839%
## Realized MVP Return (FF3) – April 2025: 2.1333%2 Part II: Textbook Problems (60%)
2.1 Chapter 5 – Problem 12
Download “6 Portfolios Formed on Size and Book-to-Market (2 x 3)” from Ken French’s library. Split Jan 1930–Dec 2018 in half and compare statistics.
# ── FIX: correct dataset name with exact spacing ──────────────────────────────
# If unsure, run: get_french_data_list()$files_list to search available names
p6_raw <- download_french_data("6 Portfolios Formed on Size and Book-to-Market (2 x 3)")
p6_data <- p6_raw$subsets$data[[1]] # value-weighted monthly returns
# Clean and convert
p6 <- p6_data %>%
mutate(date = as.Date(paste0(date, "01"), format = "%Y%m%d"),
across(-date, ~ as.numeric(.) / 100)) %>%
filter(date >= as.Date("1930-01-01"),
date <= as.Date("2018-12-01")) %>%
filter(if_all(-date, ~ . > -0.99)) # remove missing (-99.99)
port_names <- colnames(p6)[-1]
# Split in half
mid_idx <- ceiling(nrow(p6) / 2)
mid_date <- p6$date[mid_idx]
p6_h1 <- p6 %>% filter(date <= mid_date)
p6_h2 <- p6 %>% filter(date > mid_date)
cat("Half 1:", format(min(p6_h1$date), "%Y-%m"),
"to", format(max(p6_h1$date), "%Y-%m"),
" (", nrow(p6_h1), "months)\n")## Half 1: 1930-01 to 1974-06 ( 534 months)cat("Half 2:", format(min(p6_h2$date), "%Y-%m"),
"to", format(max(p6_h2$date), "%Y-%m"),
" (", nrow(p6_h2), "months)\n\n")## Half 2: 1974-07 to 2018-12 ( 534 months)# Summary statistics function (returns in decimal; display rounded to 4dp)
sumstats <- function(df) {
df %>%
select(-date) %>%
summarise(across(everything(),
list(Mean = mean, SD = sd, Skew = skewness, Kurt = kurtosis),
.names = "{.col}_{.fn}")) %>%
pivot_longer(everything(),
names_to = c("Portfolio", "Stat"),
names_sep = "_(?=[^_]+$)") %>%
pivot_wider(names_from = Stat, values_from = value) %>%
mutate(across(where(is.numeric), ~ round(., 4)))
}
cat("=== Half 1 Statistics ===\n")## === Half 1 Statistics ===## # A tibble: 6 × 5
## Portfolio Mean SD Skew Kurt
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 SMALL LoBM 0.0097 0.0823 1.18 12.1
## 2 ME1 BM2 0.0117 0.0842 1.58 15.7
## 3 SMALL HiBM 0.0148 0.102 2.29 20.1
## 4 BIG LoBM 0.0076 0.0571 0.178 9.89
## 5 ME2 BM2 0.0081 0.0673 1.71 20.5
## 6 BIG HiBM 0.0119 0.0891 1.77 17.5##
## === Half 2 Statistics ===## # A tibble: 6 × 5
## Portfolio Mean SD Skew Kurt
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 SMALL LoBM 0.01 0.0669 -0.409 5.16
## 2 ME1 BM2 0.0135 0.0528 -0.533 6.42
## 3 SMALL HiBM 0.0142 0.055 -0.464 7.31
## 4 BIG LoBM 0.0098 0.047 -0.334 4.99
## 5 ME2 BM2 0.0106 0.0434 -0.473 5.65
## 6 BIG HiBM 0.0114 0.0489 -0.517 5.81# Comparison bar plot: mean returns
library(ggplot2)
h1_stats$Half <- "H1 (1930–1974)"
h2_stats$Half <- "H2 (1974–2018)"
combined_stats <- bind_rows(h1_stats, h2_stats)
ggplot(combined_stats, aes(x = Portfolio, y = Mean * 100, fill = Half)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Mean Monthly Returns by Portfolio – Two Halves",
y = "Mean Monthly Return (%)", x = "Portfolio") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Conclusion: If the means, standard deviations, skewness, and kurtosis differ substantially across the two halves, we conclude that returns do not come from the same stationary distribution over the full 1930–2018 period. Typically, the second half shows lower mean returns but also lower volatility, while skewness and kurtosis differ markedly (especially around the Great Depression in the first half), confirming non-stationarity.
2.2 Chapter 6 – Problem 21
Given: E(r_P) = 11%, σ_P = 15%, r_f = 5%.
ErP <- 0.11; sigP <- 0.15; rf <- 0.05
# Part (a): y such that E(r_C) = 8%
ErC_target <- 0.08
y_a <- (ErC_target - rf) / (ErP - rf)
cat(sprintf("(a) y = %.4f → Invest %.1f%% in risky portfolio P\n",
y_a, y_a * 100))## (a) y = 0.5000 → Invest 50.0% in risky portfolio P## Remaining 50.0% in risk-free asset# Part (b): Standard deviation of complete portfolio
sig_C <- y_a * sigP
cat(sprintf("\n(b) σ_C = %.4f = %.2f%%\n", sig_C, sig_C * 100))##
## (b) σ_C = 0.0750 = 7.50%# Part (c): Client who limits σ_C <= 12%
sig_C2 <- 0.12
y_c <- sig_C2 / sigP
ErC2 <- rf + y_c * (ErP - rf)
cat(sprintf("\n(c) Client with σ_C = 12%%:\n"))##
## (c) Client with σ_C = 12%:## y = 0.8000, E(r_C) = 9.8000%## Client (a) accepts lower E(r) for lower σ → MORE risk averse2.3 Chapter 6 – Problem 22
Given (IMI): E(r_M) = 12%, σ_M = 20%, r_f = 5%. Johnson wants σ_C = 10% (half of σ_M).
ErM_22 <- 0.12; sigM_22 <- 0.20; rf_22 <- 0.05
sigC_J <- 0.10 # Johnson's constraint: half of 20%
# CML: E(r_C) = rf + [(ErM - rf)/sigM] * sigC
Sharpe_M <- (ErM_22 - rf_22) / sigM_22
ErC_J <- rf_22 + Sharpe_M * sigC_J
cat(sprintf("Sharpe ratio of market: %.4f\n", Sharpe_M))## Sharpe ratio of market: 0.3500## E(r_C) for Johnson (σ = 10%): 0.0850 = 8.50%## Weight in market portfolio: 50.00%## Weight in risk-free: 50.00%2.4 Chapter 6 – CFA Problem 4
Which indifference curve represents the greatest utility achievable by the investor?
## Answer: Indifference curve '2'.## Reasoning:## Higher indifference curves (3, 4) represent higher utility levels## but lie ENTIRELY ABOVE the CAL → unattainable given the investment## opportunity set.## Curve '2' is tangent to the CAL → highest ACHIEVABLE utility.## Curves below (1) are attainable but sub-optimal (investor can do better).2.5 Chapter 6 – CFA Problem 5
Which point designates the optimal portfolio of risky assets?
## Answer: Point E.## Reasoning:## Point E is where the CAL is tangent to the efficient frontier of## risky assets. It is the tangency portfolio, which has the highest## Sharpe ratio of any risky portfolio. All investors — regardless of## risk aversion — combine this single optimal risky portfolio with the## risk-free asset to form their complete portfolio.2.6 Chapter 6 – CFA Problem 8
Given: Risk premium = 10%, σ_equity = 14%, r_f =
6%.
Client: $60,000 in equity fund, $40,000 in T-bills (total $100,000).
rp_e <- 0.10; sig_e <- 0.14; rf_e <- 0.06
w_eq <- 60000 / 100000 # 0.60
w_tb <- 40000 / 100000 # 0.40
ErP_e <- rf_e + rp_e # 16%
ErC_e <- w_eq * ErP_e + w_tb * rf_e
sigC_e <- w_eq * sig_e
SR_e <- rp_e / sig_e # Sharpe of equity fund
cat(sprintf("Expected return of equity fund: %.2f%%\n", ErP_e * 100))## Expected return of equity fund: 16.00%## E(r) of client portfolio: 12.00%## σ of client portfolio: 8.40%##
## CFA Q9 — Sharpe ratio of equity fund: 0.71432.7 Chapter 7 – Problem 11
Stocks: E(r) = 18%, σ = 22%. Gold: E(r) = 10%, σ = 30%.
library(ggplot2)
Er_s <- 0.18; sig_s <- 0.22
Er_g <- 0.10; sig_g <- 0.30
rf_7 <- 0.05
# Part (a): portfolio frontier for various correlations
w_seq <- seq(0, 1, by = 0.01) # w = weight in stocks
plot_frontier <- function(rho, label) {
tibble(w = w_seq) %>%
mutate(
Er = w * Er_s + (1 - w) * Er_g,
Var = w^2 * sig_s^2 + (1 - w)^2 * sig_g^2 +
2 * w * (1 - w) * rho * sig_s * sig_g,
Sig = sqrt(Var),
rho = label
)
}
frontiers <- bind_rows(
plot_frontier(-0.5, "ρ = -0.5"),
plot_frontier( 0.0, "ρ = 0.0"),
plot_frontier( 0.5, "ρ = 0.5"),
plot_frontier( 1.0, "ρ = 1.0")
)
ggplot(frontiers, aes(x = Sig * 100, y = Er * 100, color = rho)) +
geom_line(linewidth = 1) +
geom_point(
data = data.frame(Sig = c(sig_s, sig_g) * 100,
Er = c(Er_s, Er_g) * 100,
label = c("Stocks","Gold")),
aes(x = Sig, y = Er, color = label), size = 4, inherit.aes = FALSE) +
geom_text(
data = data.frame(Sig = c(sig_s, sig_g) * 100 + 0.5,
Er = c(Er_s, Er_g) * 100,
label = c("Stocks","Gold")),
aes(x = Sig, y = Er, label = label), inherit.aes = FALSE, hjust = 0) +
labs(title = "Portfolio Frontier: Stocks and Gold",
subtitle = "Part (a): Gold can add value when correlation < 1",
x = "Standard Deviation (%)", y = "Expected Return (%)",
color = "Correlation") +
theme_minimal()
# Part (b): rho = 1 → straight line, gold dominated
cat("Part (b): With ρ = 1, the frontier is a straight line.\n")## Part (b): With ρ = 1, the frontier is a straight line.cat(sprintf("Gold's Sharpe ratio: %.4f < Stocks' Sharpe: %.4f\n",
(Er_g - rf_7) / sig_g, (Er_s - rf_7) / sig_s))## Gold's Sharpe ratio: 0.1667 < Stocks' Sharpe: 0.5909## → No investor would hold gold when ρ = 1 (stocks dominate on the CAL).# Part (c): equilibrium
cat("Part (c): With ρ = 1 and gold's Sharpe < stocks', gold would not be\n")## Part (c): With ρ = 1 and gold's Sharpe < stocks', gold would not be## held in equilibrium. For all assets to be held in equilibrium, either## gold's expected return must rise, or the correlation cannot equal 1.2.8 Chapter 7 – Problem 12
Stocks A and B: E(r_A) = 10%, σ_A = 5%. E(r_B) = 15%, σ_B = 10%. ρ = −1.
Er_A <- 0.10; sig_A <- 0.05
Er_B <- 0.15; sig_B <- 0.10
rho12 <- -1
# With ρ = -1, find zero-variance portfolio: w_A*σ_A = (1-w_A)*σ_B
w_A_star <- sig_B / (sig_A + sig_B)
w_B_star <- 1 - w_A_star
Er_rf_implied <- w_A_star * Er_A + w_B_star * Er_B
cat("Zero-variance portfolio weights:\n")## Zero-variance portfolio weights:## w_A = σ_B/(σ_A+σ_B) = 0.6667 = 66.67%## w_B = 0.3333 = 33.33%##
## Return of zero-variance portfolio = implied r_f:## r_f = 0.1167 = 11.67%# Verify σ = 0
sig_check <- sqrt(w_A_star^2 * sig_A^2 + w_B_star^2 * sig_B^2 +
2 * w_A_star * w_B_star * rho12 * sig_A * sig_B)
cat(sprintf("\nVerification — portfolio σ: %.8f (should be ~0)\n", sig_check))##
## Verification — portfolio σ: 0.00000000 (should be ~0)# Plot frontier
w_seq2 <- seq(-0.5, 1.5, by = 0.01)
frontier12 <- tibble(w = w_seq2) %>%
mutate(
Er = w * Er_A + (1 - w) * Er_B,
Sig = sqrt(w^2 * sig_A^2 + (1 - w)^2 * sig_B^2 +
2 * w * (1 - w) * rho12 * sig_A * sig_B)
)
ggplot(frontier12, aes(x = Sig * 100, y = Er * 100)) +
geom_line(color = "steelblue", linewidth = 1) +
geom_point(
data = data.frame(Sig = c(sig_A, sig_B) * 100,
Er = c(Er_A, Er_B) * 100,
pt = c("Stock A","Stock B")),
aes(x = Sig, y = Er, color = pt), size = 4, inherit.aes = FALSE) +
geom_point(aes(x = 0, y = Er_rf_implied * 100),
color = "red", size = 4) +
annotate("text", x = 0.3, y = Er_rf_implied * 100,
label = sprintf("r_f = %.2f%%", Er_rf_implied * 100),
color = "red", hjust = 0) +
labs(title = "Frontier: Stocks A & B (ρ = -1)",
subtitle = "Red dot = zero-variance portfolio = implied risk-free rate",
x = "Standard Deviation (%)", y = "Expected Return (%)",
color = "Asset") +
theme_minimal()
2.9 Chapter 7 – CFA Problem 12
Abigail Grace: Original portfolio $900K + ABC stock $100K.
w_P <- 0.90; w_ABC <- 0.10
Er_P <- 0.0067; sig_P <- 0.0237
Er_ABC <- 0.0125; sig_ABC <- 0.0295
rho_ABC <- 0.40
rf_grace <- 0.0042 # monthly risk-free rate
# Part (a): Keep ABC stock
Er_new_a <- w_P * Er_P + w_ABC * Er_ABC
cat(sprintf("(a-i) E(r) new portfolio: %.4f%%\n", Er_new_a * 100))## (a-i) E(r) new portfolio: 0.7280%Cov_ABC_P <- rho_ABC * sig_ABC * sig_P
cat(sprintf("(a-ii) Cov(ABC, Portfolio): %.8f\n", Cov_ABC_P))## (a-ii) Cov(ABC, Portfolio): 0.00027966Var_new_a <- w_P^2 * sig_P^2 + w_ABC^2 * sig_ABC^2 +
2 * w_P * w_ABC * Cov_ABC_P
sig_new_a <- sqrt(Var_new_a)
cat(sprintf("(a-iii) σ new portfolio: %.4f%%\n", sig_new_a * 100))## (a-iii) σ new portfolio: 2.2672%# Part (b): Sell ABC, replace with risk-free 0.42%/mo
Er_new_b <- w_P * Er_P + w_ABC * rf_grace
cat(sprintf("\n(b-i) E(r) with gov. securities: %.4f%%\n", Er_new_b * 100))##
## (b-i) E(r) with gov. securities: 0.6450%## (b-ii) Cov(risk-free, Portfolio): 0.0000 (risk-free has zero covariance)sig_new_b <- w_P * sig_P # only the portfolio component contributes
cat(sprintf("(b-iii) σ with gov. securities: %.4f%%\n", sig_new_b * 100))## (b-iii) σ with gov. securities: 2.1330%# Part (c): Systematic risk comparison
cat("\n(c) The portfolio with government securities has LOWER systematic risk.\n")##
## (c) The portfolio with government securities has LOWER systematic risk.## Replacing ABC (ρ = 0.40 with portfolio) with a risk-free asset (β = 0)## reduces the portfolio's overall market exposure (beta).##
## (d) The husband's comment is INCORRECT.## Even if XYZ has the same E(r) and σ as ABC, what matters is XYZ's## correlation with the existing portfolio. A lower correlation would## provide better diversification and reduce portfolio risk more. The## marginal contribution to risk — not standalone statistics — determines## which stock is preferable.# Part (e): SD as risk measure
cat("\n(e-i) Weakness: Standard deviation penalizes UPSIDE deviations equally\n")##
## (e-i) Weakness: Standard deviation penalizes UPSIDE deviations equally## with downside deviations. Grace only fears losses, so SD is not## an appropriate measure for her stated preferences.## (e-ii) Better measure: Semi-variance (or downside deviation / VaR),## which captures only the below-target or negative return outcomes.2.10 Chapter 8 – Problem 17
Treynor-Black Active Portfolio Construction
# Given macro forecasts (all in %)
rf_8 <- 8; ErM_8 <- 16; sigM_8 <- 23
RP_M <- ErM_8 - rf_8 # market risk premium = 8%
asset <- c("A","B","C","D")
Er <- c(20, 18, 17, 12)
beta <- c(1.3, 1.8, 0.7, 1.0)
sig_e <- c(58, 71, 60, 55)
sig2_e <- sig_e^2
# Part (a): CAPM-implied return, alpha, residual variance
Er_capm <- rf_8 + beta * RP_M
alpha <- Er - Er_capm
df_a <- data.frame(Asset = asset,
Er = Er,
Er_CAPM = round(Er_capm, 4),
Alpha = round(alpha, 4),
Sig2_e = sig2_e)
cat("=== Part (a): CAPM Analysis ===\n")## === Part (a): CAPM Analysis ===## Asset Er Er_CAPM Alpha Sig2_e
## 1 A 20 18.4 1.6 3364
## 2 B 18 22.4 -4.4 5041
## 3 C 17 13.6 3.4 3600
## 4 D 12 16.0 -4.0 3025# Part (b): Treynor-Black active portfolio weights
w0 <- alpha / sig2_e
w_active <- w0 / sum(w0)
names(w_active) <- asset
alpha_A <- sum(w_active * alpha)
beta_A <- sum(w_active * beta)
sig2_eA <- sum(w_active^2 * sig2_e)
sig_eA <- sqrt(sig2_eA)
cat("\n=== Part (b): Active Portfolio ===\n")##
## === Part (b): Active Portfolio ===## Active weights:## A B C D
## -0.6136 1.1261 -1.2185 1.7060##
## Alpha_A: -16.9037
## Beta_A: 2.0824
## σ_eA: 147.6780# Optimal mix active vs passive (Treynor-Black)
sig2_M <- sigM_8^2
w0_star <- (alpha_A / sig2_eA) / (RP_M / sig2_M)
w_star <- w0_star / (1 + (1 - beta_A) * w0_star)
cat(sprintf("\nInitial w* (before beta adjustment): %.4f\n", w0_star))##
## Initial w* (before beta adjustment): -0.0513## Adjusted w* in active portfolio: -0.0486## Weight in passive index: 1.0486# Part (c): Sharpe ratio comparison
beta_opt <- w_star * beta_A + (1 - w_star) * 1
Er_opt <- rf_8 + w_star * alpha_A + beta_opt * RP_M
sig2_opt <- beta_opt^2 * sig2_M + w_star^2 * sig2_eA
sig_opt <- sqrt(sig2_opt)
SR_opt <- (Er_opt - rf_8) / sig_opt
SR_pass <- RP_M / sigM_8
cat("\n=== Part (c): Sharpe Ratios ===\n")##
## === Part (c): Sharpe Ratios ===## Optimal portfolio — E(r): 16.4004% σ: 22.9408% SR: 0.3662## Passive index only — E(r): 16.0000% σ: 23.00% SR: 0.3478##
## === Part (d): Improvement in Sharpe ===## ΔSharpe = 0.0183 (from 0.3478 to 0.3662)SR_tb_check <- sqrt(SR_pass^2 + (alpha_A / sig_eA)^2)
cat(sprintf("TB formula verification — SR_opt = %.4f\n", SR_tb_check))## TB formula verification — SR_opt = 0.3662# Part (e): Complete portfolio for A = 2.8
cat("\n=== Part (e): Complete Portfolio (A = 2.8) ===\n")##
## === Part (e): Complete Portfolio (A = 2.8) ===A_28 <- 2.8
y_opt <- (Er_opt - rf_8) / (A_28 * sig2_opt)
cat(sprintf("y* (fraction in risky portfolio): %.4f = %.2f%%\n",
y_opt, y_opt * 100))## y* (fraction in risky portfolio): 0.0057 = 0.57%## Fraction in risk-free: 0.9943 = 99.43%final_alloc <- data.frame(
Component = c(asset, "Passive Index", "Risk-Free"),
Weight_Overall = c(w_star * w_active * y_opt,
(1 - w_star) * y_opt,
1 - y_opt)
)
cat("\nFull portfolio allocation:\n")##
## Full portfolio allocation:## Component Weight_Overall
## 1 A 0.0002
## 2 B -0.0003
## 3 C 0.0003
## 4 D -0.0005
## 5 Passive Index 0.0060
## 6 Risk-Free 0.99432.11 Chapter 8 – CFA Problem 1
OLS Regression: ABC and XYZ (5-year monthly excess returns)
cfa1 <- data.frame(
Statistic = c("Alpha","Beta","R-squared","Residual SD"),
ABC = c(-3.20, 0.60, 0.35, 13.02),
XYZ = c( 7.30, 0.97, 0.17, 21.45)
)
cat("=== Regression Summary ===\n")## === Regression Summary ===## Statistic ABC XYZ
## 1 Alpha -3.20 7.30
## 2 Beta 0.60 0.97
## 3 R-squared 0.35 0.17
## 4 Residual SD 13.02 21.45##
## === Risk Decomposition ===## ABC: Systematic risk = 35%, Firm-specific = 65%## XYZ: Systematic risk = 17%, Firm-specific = 83%brokerage <- data.frame(
House = c("A","B"),
Beta_ABC = c(0.62, 0.71),
Beta_XYZ = c(1.45, 1.25)
)
cat("\n=== Brokerage Beta Estimates (recent 2-year weekly) ===\n")##
## === Brokerage Beta Estimates (recent 2-year weekly) ===## House Beta_ABC Beta_XYZ
## 1 A 0.62 1.45
## 2 B 0.71 1.25##
## === Interpretation ===## ABC:## - Negative alpha (-3.2%) → underperformed CAPM benchmark over 5 years.## - Low beta (0.60) → below-market systematic exposure.## - R² = 0.35 → 35% of variance explained by market; 65% firm-specific.## - Recent betas (0.62–0.71) suggest beta is stable but slightly rising.## XYZ:## - Positive alpha (+7.3%) → outperformed CAPM benchmark over 5 years.## - Beta ≈ 1 → market-level systematic risk.## - R² = 0.17 → 83% of variance is idiosyncratic (diversified away in a## large portfolio, so the high residual SD is less of a concern).## - Recent betas (1.25–1.45) suggest RISING systematic risk — monitor closely.## Conclusion:## XYZ is more attractive for a diversified portfolio: positive alpha and## the large idiosyncratic risk is diversified away. However, alphas do not## persist indefinitely, and XYZ's rising beta warrants ongoing monitoring.End of Midterm Exam