required_packages <- c(
"quantmod", "PerformanceAnalytics", "tidyverse",
"moments", "frenchdata", "xts", "zoo", "glmnet"
)
new_packages <- required_packages[
!(required_packages %in% installed.packages()[, "Package"])
]
if (length(new_packages)) install.packages(new_packages, repos = "https://cloud.r-project.org")
lapply(required_packages, library, character.only = TRUE)## [[1]]
## [1] "quantmod" "TTR" "xts" "zoo" "stats" "graphics"
## [7] "grDevices" "utils" "datasets" "methods" "base"
##
## [[2]]
## [1] "PerformanceAnalytics" "quantmod" "TTR"
## [4] "xts" "zoo" "stats"
## [7] "graphics" "grDevices" "utils"
## [10] "datasets" "methods" "base"
##
## [[3]]
## [1] "lubridate" "forcats" "stringr"
## [4] "dplyr" "purrr" "readr"
## [7] "tidyr" "tibble" "ggplot2"
## [10] "tidyverse" "PerformanceAnalytics" "quantmod"
## [13] "TTR" "xts" "zoo"
## [16] "stats" "graphics" "grDevices"
## [19] "utils" "datasets" "methods"
## [22] "base"
##
## [[4]]
## [1] "moments" "lubridate" "forcats"
## [4] "stringr" "dplyr" "purrr"
## [7] "readr" "tidyr" "tibble"
## [10] "ggplot2" "tidyverse" "PerformanceAnalytics"
## [13] "quantmod" "TTR" "xts"
## [16] "zoo" "stats" "graphics"
## [19] "grDevices" "utils" "datasets"
## [22] "methods" "base"
##
## [[5]]
## [1] "frenchdata" "moments" "lubridate"
## [4] "forcats" "stringr" "dplyr"
## [7] "purrr" "readr" "tidyr"
## [10] "tibble" "ggplot2" "tidyverse"
## [13] "PerformanceAnalytics" "quantmod" "TTR"
## [16] "xts" "zoo" "stats"
## [19] "graphics" "grDevices" "utils"
## [22] "datasets" "methods" "base"
##
## [[6]]
## [1] "frenchdata" "moments" "lubridate"
## [4] "forcats" "stringr" "dplyr"
## [7] "purrr" "readr" "tidyr"
## [10] "tibble" "ggplot2" "tidyverse"
## [13] "PerformanceAnalytics" "quantmod" "TTR"
## [16] "xts" "zoo" "stats"
## [19] "graphics" "grDevices" "utils"
## [22] "datasets" "methods" "base"
##
## [[7]]
## [1] "frenchdata" "moments" "lubridate"
## [4] "forcats" "stringr" "dplyr"
## [7] "purrr" "readr" "tidyr"
## [10] "tibble" "ggplot2" "tidyverse"
## [13] "PerformanceAnalytics" "quantmod" "TTR"
## [16] "xts" "zoo" "stats"
## [19] "graphics" "grDevices" "utils"
## [22] "datasets" "methods" "base"
##
## [[8]]
## [1] "glmnet" "Matrix" "frenchdata"
## [4] "moments" "lubridate" "forcats"
## [7] "stringr" "dplyr" "purrr"
## [10] "readr" "tidyr" "tibble"
## [13] "ggplot2" "tidyverse" "PerformanceAnalytics"
## [16] "quantmod" "TTR" "xts"
## [19] "zoo" "stats" "graphics"
## [22] "grDevices" "utils" "datasets"
## [25] "methods" "base"##
## ===== SETUP COMPLETE =====tickers <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
# Download adjusted prices
getSymbols(tickers, from = "2010-01-01", to = "2025-04-30", src = "yahoo")## [1] "SPY" "QQQ" "EEM" "IWM" "EFA" "TLT" "IYR" "GLD"# Merge adjusted prices into one xts object
prices_daily <- do.call(merge, lapply(tickers, function(x) Ad(get(x))))
colnames(prices_daily) <- tickers
# Convert each ticker to monthly individually, then merge.
# This avoids the OHLC column-count ambiguity from to.monthly() on a merged object.
prices_close <- do.call(merge, lapply(tickers, function(tk) {
m <- to.monthly(prices_daily[, tk], indexAt = "lastof", drop.time = TRUE)
# to.monthly returns OHLC; take the Close (3rd) column
cl <- m[, 3]
colnames(cl) <- tk
cl
}))
returns_monthly <- na.omit(Return.calculate(prices_close, method = "discrete"))
colnames(returns_monthly) <- tickers
cat("\nDimensions of monthly returns:", dim(returns_monthly), "\n")##
## Dimensions of monthly returns: 183 8cat("Date range:", as.character(index(returns_monthly)[1]),
"to", as.character(tail(index(returns_monthly), 1)), "\n")## Date range: 2010-02-28 to 2025-04-30# FIX: correct dataset name is "Fama/French 3 Factors" (not the zip filename)
ff_raw <- download_french_data("Fama/French 3 Factors")
ff_data <- ff_raw$subsets$data[[1]]
# FIX: frenchdata returns column named "date" (lowercase), numeric YYYYMM
ff_data$date <- as.yearmon(as.character(ff_data$date), "%Y%m")
ff_xts <- xts(ff_data[, 2:5] / 100,
order.by = as.Date(ff_data$date, frac = 1)) # end-of-month
# FIX: frenchdata names the market factor "Mkt-RF" (with hyphen, backtick-quoted)
# Rename immediately after xts creation to avoid backtick issues downstream
colnames(ff_xts) <- c("MKT_RF", "SMB", "HML", "RF")
# Merge with ETF returns
data_all <- na.omit(merge(returns_monthly, ff_xts))
colnames(data_all)[1:8] <- tickers
# columns 9:12 already named MKT_RF, SMB, HML, RF from ff_xts
cat("\nFama-French Factors Downloaded\n")##
## Fama-French Factors Downloaded## data_all dimensions: 183 12# --- Sample-covariance MVP ---
compute_mvp <- function(R) {
Sigma <- cov(R)
one <- rep(1, ncol(R))
w <- solve(Sigma) %*% one
w <- w / as.numeric(t(one) %*% solve(Sigma) %*% one)
return(as.numeric(w))
}
# --- Factor-model covariance MVP ---
compute_ff_cov <- function(R, factors, rf) {
# FIX: rf is an xts column; convert to numeric vector for arithmetic.
rf_vec <- as.numeric(rf)
betas <- sapply(seq_len(ncol(R)), function(i) {
y <- as.numeric(R[, i]) - rf_vec
coef(lm(y ~ as.matrix(factors)))[-1] # drop intercept
})
betas <- t(betas) # (n_assets x n_factors)
factor_cov <- cov(as.matrix(factors))
resid_var <- diag(sapply(seq_len(ncol(R)), function(i) {
y <- as.numeric(R[, i]) - rf_vec
var(residuals(lm(y ~ as.matrix(factors))))
}))
Sigma <- betas %*% factor_cov %*% t(betas) + resid_var
return(Sigma)
}est_window <- data_all["2020-03/2025-02"]
R_assets <- est_window[, 1:8]
factors <- est_window[, 9:11] # MKT_RF, SMB, HML
rf <- est_window[, 12] # RF
# --- Sample MVP ---
w_sample <- compute_mvp(R_assets)
names(w_sample) <- tickers
# --- Factor-model MVP ---
Sigma_ff <- compute_ff_cov(R_assets, factors, rf)
one <- rep(1, 8)
w_ff_raw <- solve(Sigma_ff) %*% one
w_ff <- as.numeric(w_ff_raw / as.numeric(t(one) %*% solve(Sigma_ff) %*% one))
names(w_ff) <- tickers
cat("\nSample MVP Weights:\n"); print(round(w_sample, 4))##
## Sample MVP Weights:## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.4989 -0.2331 0.1776 0.2010 -0.2075 0.4967 -0.3378 0.4041##
## FF3 Factor MVP Weights:## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.0666 0.0542 0.1283 0.0014 0.1010 0.2530 -0.0067 0.4022##
## Weight sums — Sample: 1 FF3: 1# FIX: data_all may not contain April 2025 (depends on download date).
# Use tryCatch so the code does not error if the month is absent.
march_2025 <- tryCatch(data_all["2025-03", 1:8], error = function(e) NULL)
april_2025 <- tryCatch(data_all["2025-04", 1:8], error = function(e) NULL)
report_return <- function(w, r_xts, label) {
if (is.null(r_xts) || nrow(r_xts) == 0) {
cat(label, ": data not available\n")
return(invisible(NA))
}
ret <- as.numeric(t(w) %*% as.numeric(r_xts))
cat(label, ":", round(ret * 100, 4), "%\n")
invisible(ret)
}
cat("\n===== PART I RESULTS =====\n\n")##
## ===== PART I RESULTS =====## -- March 2025 --## Sample MVP : -0.7661 %## FF3 MVP : 1.3547 %##
## -- April 2025 --## Sample MVP : -1.5425 %## FF3 MVP : -3.157 %# Look up the exact name at runtime — avoids breakage if French renames the file
all_datasets <- get_french_data_list()
all_names <- all_datasets$files_list$name
# Try progressively broader patterns until we get a match
ff6_name <- NA
patterns <- c(
"6 Portfolios Formed on Size and Book-to-Market.*2x3",
"6 Portfolios.*Size.*Book.*2x3",
"6 Portfolios.*2x3",
"^6 Portfolios"
)
for (pat in patterns) {
candidates <- all_names[
grepl(pat, all_names, ignore.case = TRUE) &
!grepl("Daily|Weekly|ex\\.Div|Wout", all_names, ignore.case = TRUE)
]
if (length(candidates) > 0) { ff6_name <- candidates[1]; break }
}
# Last resort: just show all names containing "6 Port" so user can debug
if (is.na(ff6_name)) {
cat("Available 6-portfolio datasets:\n")
print(all_names[grepl("6 Port", all_names, ignore.case = TRUE)])
stop("Could not find a matching 6-portfolio dataset. See names printed above.")
}
cat("Using dataset:", ff6_name, "\n")## Using dataset: 6 Portfolios Formed on Size and Book-to-Market (2 x 3)ff6_raw <- download_french_data(ff6_name)
ff6 <- ff6_raw$subsets$data[[1]]
# FIX: column is "date" (lowercase), numeric YYYYMM
ff6$date <- as.yearmon(as.character(ff6$date), "%Y%m")
ff6_xts <- xts(ff6[, 2:7] / 100,
order.by = as.Date(ff6$date, frac = 1))
# Restrict to 1930-01 through 2018-12
ff6_xts <- ff6_xts["1930-01/2018-12"]
# FIX: Use ceiling instead of floor so both halves together cover all rows.
mid <- floor(nrow(ff6_xts) / 2)
first_half <- ff6_xts[1:mid, ]
second_half <- ff6_xts[(mid + 1):nrow(ff6_xts), ]
stat_fun <- function(x) {
c(Mean = mean(x), SD = sd(x),
Skewness = skewness(x), Kurtosis = kurtosis(x))
}
stats_first <- apply(first_half, 2, stat_fun)
stats_second <- apply(second_half, 2, stat_fun)
cat("\n===== Chapter 5 — First Half Statistics =====\n")##
## ===== Chapter 5 — First Half Statistics =====## SMALL LoBM ME1 BM2 SMALL HiBM BIG LoBM ME2 BM2 BIG HiBM
## Mean 0.0097 0.0117 0.0148 0.0076 0.0081 0.0119
## SD 0.0823 0.0842 0.1021 0.0571 0.0673 0.0891
## Skewness 1.1800 1.5797 2.2875 0.1783 1.7116 1.7694
## Kurtosis 12.0716 15.7404 20.0760 9.8941 20.5352 17.4682##
## ===== Chapter 5 — Second Half Statistics =====## SMALL LoBM ME1 BM2 SMALL HiBM BIG LoBM ME2 BM2 BIG HiBM
## Mean 0.0100 0.0135 0.0142 0.0098 0.0106 0.0114
## SD 0.0669 0.0528 0.0550 0.0470 0.0434 0.0489
## Skewness -0.4086 -0.5330 -0.4642 -0.3337 -0.4729 -0.5172
## Kurtosis 5.1587 6.4246 7.3061 4.9925 5.6534 5.8054A portfolio has E[rP] = 11%, σP = 15%, and the risk-free rate is 5%.
What allocation y to the risky portfolio achieves a target return of 8%?
ErP <- 0.11
sigmaP <- 0.15
rf_rate <- 0.05
target_return <- 0.08
# FIX: Formula is y = (target - rf) / (ErP - rf)
y <- (target_return - rf_rate) / (ErP - rf_rate)
portfolio_sd <- y * sigmaP
cat("\n===== Chapter 6 — Problem 21 =====\n")##
## ===== Chapter 6 — Problem 21 =====## Weight in risky portfolio (y): 0.5## Portfolio standard deviation : 0.075The market has E[rM] = 12%, σM = 20%, rf = 5%.
What expected return does a portfolio with σ = σM/2 earn on the CML?
market_return <- 0.12
market_sd <- 0.20
rf_rate_22 <- 0.05 # FIX: use distinct variable name (rf_rate already used above)
target_sd <- market_sd / 2
# CML: E[r] = rf + (E[rM] - rf) * (σ / σM)
target_return_22 <- rf_rate_22 +
(market_return - rf_rate_22) * (target_sd / market_sd)
cat("\n===== Chapter 6 — Problem 22 =====\n")##
## ===== Chapter 6 — Problem 22 =====## Target σ : 0.1## Expected return (CML): 0.085Equity risk premium = 10%, σ_equity = 14%, rf = 6%.
Investor puts 60% in equities and 40% in T-bills.
risk_premium <- 0.10
sigma_equity <- 0.14
rf_rate_cfa8 <- 0.06
w_equity <- 0.60
# FIX: E[r_equity] = rf + risk_premium, then weight the full portfolio
Er_equity <- rf_rate_cfa8 + risk_premium # 16%
expected_return <- w_equity * Er_equity + (1 - w_equity) * rf_rate_cfa8
portfolio_sd_cfa <- w_equity * sigma_equity # T-bills have zero σ
cat("\n===== CFA Problem 8 =====\n")##
## ===== CFA Problem 8 =====## Expected portfolio return: 0.12## Portfolio standard deviation: 0.084Stock A: E[rA] = 10%, σA = 5%.
Stock B: E[rB] = 15%, σB = 10%.
Correlation = −1. Find the implied risk-free rate.
ErA <- 0.10; sdA <- 0.05
ErB <- 0.15; sdB <- 0.10
# When corr = -1, the zero-variance portfolio weights are:
# wA = sdB / (sdA + sdB), wB = sdA / (sdA + sdB)
wA <- sdB / (sdA + sdB)
wB <- 1 - wA # FIX: ensure weights sum to 1 (= sdA/(sdA+sdB))
rf_implied <- wA * ErA + wB * ErB
cat("\n===== Chapter 7 — Problem 12 =====\n")##
## ===== Chapter 7 — Problem 12 =====## Weight in A: 0.6667 Weight in B: 0.3333## Implied risk-free rate: 0.1167Original portfolio: E[r] = 0.67%/month, σ = 2.37%/month.
Add 10% in ABC stock: E[r] = 1.25%/month, σ = 2.95%/month, corr = 0.40.
w_original <- 0.90
w_abc <- 0.10
Er_orig <- 0.0067
Er_abc <- 0.0125
sd_orig <- 0.0237
sd_abc <- 0.0295
corr <- 0.40
cov_ab <- corr * sd_orig * sd_abc
Er_new <- w_original * Er_orig + w_abc * Er_abc
sd_new <- sqrt(
w_original^2 * sd_orig^2 +
w_abc^2 * sd_abc^2 +
2 * w_original * w_abc * cov_ab
)
cat("\n===== CFA Problem 12 =====\n")##
## ===== CFA Problem 12 =====## New expected return: 0.00728## New standard deviation: 0.022672Macro forecasts: T-bills rf = 8%, Passive equity E[rM] = 16%, σM = 23%
Micro forecasts:
Stock A: E[r]=20%, β=1.3, residual σ=58%
Stock B: E[r]=18%, β=1.8, residual σ=71%
Stock C: E[r]=17%, β=0.7, residual σ=60%
Stock D: E[r]=12%, β=1.0, residual σ=55%
rf_tb <- 0.08
ErM_tb <- 0.16
sigM_tb <- 0.23
ERP <- ErM_tb - rf_tb # = 0.08
stocks <- c("A", "B", "C", "D")
Er_stocks <- c(0.20, 0.18, 0.17, 0.12)
betas <- c(1.3, 1.8, 0.7, 1.0)
resid_sd <- c(0.58, 0.71, 0.60, 0.55)
resid_var <- resid_sd^2
excess_ret <- Er_stocks - rf_tb
CAPM_ret <- rf_tb + betas * ERP
alphas <- Er_stocks - CAPM_ret
cat("\n===== Chapter 8 — Part 1 =====\n\n")##
## ===== Chapter 8 — Part 1 =====df1 <- data.frame(
Stock = stocks,
Excess_Return = paste0(round(excess_ret * 100, 2), "%"),
CAPM_Return = paste0(round(CAPM_ret * 100, 2), "%"),
Alpha = paste0(round(alphas * 100, 2), "%"),
Resid_Var = round(resid_var, 4)
)
print(df1, row.names = FALSE)## Stock Excess_Return CAPM_Return Alpha Resid_Var
## A 12% 18.4% 1.6% 0.3364
## B 10% 22.4% -4.4% 0.5041
## C 9% 13.6% 3.4% 0.3600
## D 4% 16% -4% 0.3025# Initial active weights proportional to alpha / residual variance
w0 <- alphas / resid_var
w0_scaled <- w0 / sum(w0)
alpha_A <- sum(w0_scaled * alphas)
beta_A <- sum(w0_scaled * betas)
resvar_A <- sum(w0_scaled^2 * resid_var)
sd_A <- sqrt(resvar_A)
sigM2 <- sigM_tb^2
# Weight of active portfolio before beta adjustment
w_A0 <- (alpha_A / resvar_A) / (ERP / sigM2)
# Adjusted for beta
w_A_star <- w_A0 / (1 + (1 - beta_A) * w_A0)
w_passive <- 1 - w_A_star
w_stocks <- w_A_star * w0_scaled
cat("\n===== Chapter 8 — Part 2 =====\n")##
## ===== Chapter 8 — Part 2 =====## Active portfolio weights:## A B C D
## -0.6136 1.1261 -1.2185 1.7060cat("\nAlpha_A:", round(alpha_A, 4), " Beta_A:", round(beta_A, 4),
" ResidSD_A:", round(sd_A, 4), "\n")##
## Alpha_A: -0.169 Beta_A: 2.0824 ResidSD_A: 1.4768## w_A* (active in risky): -0.0486## w_passive : 1.0486## Individual stock weights in optimal risky portfolio:## A B C D
## 0.0298 -0.0547 0.0592 -0.0828Er_risky <- w_passive * ErM_tb + sum(w_stocks * Er_stocks)
var_risky <- (w_passive + w_A_star * beta_A)^2 * sigM2 +
w_A_star^2 * resvar_A
sd_risky <- sqrt(var_risky)
SR_passive <- ERP / sigM_tb
SR_optimal <- (Er_risky - rf_tb) / sd_risky
SR_check <- sqrt(SR_passive^2 + (alpha_A / sd_A)^2)
cat("\n===== Chapter 8 — Part 3 =====\n")##
## ===== Chapter 8 — Part 3 =====## E[r] optimal risky: 16.4004 %## σ optimal risky : 22.9408 %## Sharpe (optimal) : 0.3662## Sharpe (formula) : 0.3662##
## ===== Chapter 8 — Part 4 =====## Passive Sharpe : 0.3478## Optimal Sharpe : 0.3662## Improvement : 0.0183## Relative gain : 5.28 %A_ra <- 2.8
y_star <- (Er_risky - rf_tb) / (A_ra * var_risky)
w_rf_c <- 1 - y_star
w_passive_c <- y_star * w_passive
w_stocks_c <- y_star * w_stocks
cat("\n===== Chapter 8 — Part 5 (A = 2.8) =====\n")##
## ===== Chapter 8 — Part 5 (A = 2.8) =====## y* (fraction in risky portfolio): 0.5701cp <- data.frame(
Asset = c("T-bills", "Passive Index", stocks),
Weight = round(c(w_rf_c, w_passive_c, w_stocks_c), 4)
)
print(cp, row.names = FALSE)## Asset Weight
## T-bills 0.4299
## Passive Index 0.5977
## A 0.0170
## B -0.0312
## C 0.0337
## D -0.0472##
## Sum of weights: 0.9999OLS regression of monthly excess returns on market index (5-year period):
Statistic ABC XYZ Alpha -3.20% 7.30% Beta 0.60 0.97 R² 0.35 0.17 Residual σ 13.02% 21.45% Recent 2-year betas — Broker A: ABC=0.62, XYZ=1.45 | Broker B: ABC=0.71, XYZ=1.25
alpha_abc <- -0.0320; alpha_xyz <- 0.073
beta_abc <- 0.60; beta_xyz <- 0.97
r2_abc <- 0.35; r2_xyz <- 0.17
res_abc <- 0.1302; res_xyz <- 0.2145
# Variance decomposition
total_var_abc <- res_abc^2 / (1 - r2_abc)
total_var_xyz <- res_xyz^2 / (1 - r2_xyz)
sys_var_abc <- r2_abc * total_var_abc
sys_var_xyz <- r2_xyz * total_var_xyz
avg_beta_abc <- mean(c(0.62, 0.71))
avg_beta_xyz <- mean(c(1.45, 1.25))
cat("\n===== CFA Problem 1 — Regression Analysis =====\n\n")##
## ===== CFA Problem 1 — Regression Analysis =====## Statistic ABC XYZ## Alpha -0.0320 0.0730## Beta (5-yr) 0.6000 0.9700## R-squared 0.3500 0.1700## Residual sigma 0.1302 0.2145## Total variance 0.0261 0.0554## Systematic variance 0.0091 0.0094## Residual variance 0.0170 0.0460## Avg recent beta 0.6650 1.3500##
## --- Interpretation ---cat(
"ABC (5-yr): alpha = -3.20% => underperformed CAPM on a risk-adjusted basis.\n",
" Beta = 0.60: low systematic risk. R2 = 0.35: 35% systematic, 65%\n",
" idiosyncratic. In a diversified portfolio, firm-specific risk washes\n",
" out; only beta matters for pricing. Recent betas (0.62-0.71) are\n",
" consistent with the 5-yr estimate — beta appears stable. Negative\n",
" alpha likely reflects bad luck or genuine underperformance; past\n",
" alpha is not reliably predictive.\n\n",
"XYZ (5-yr): alpha = +7.3% => outperformed CAPM. Beta = 0.97: near\n",
" market-level systematic risk. R2 = 0.17: only 17% systematic;\n",
" residual sigma = 21.45% is very large. Most XYZ risk is idiosyncratic\n",
" and diversifiable. Recent betas (1.25-1.45) are substantially above\n",
" the 5-yr 0.97 — systematic risk has risen. The positive alpha is\n",
" statistically noisy given high residual variance, and unlikely to\n",
" persist. Forward-looking analysis should use the higher recent beta.\n"
)## ABC (5-yr): alpha = -3.20% => underperformed CAPM on a risk-adjusted basis.
## Beta = 0.60: low systematic risk. R2 = 0.35: 35% systematic, 65%
## idiosyncratic. In a diversified portfolio, firm-specific risk washes
## out; only beta matters for pricing. Recent betas (0.62-0.71) are
## consistent with the 5-yr estimate — beta appears stable. Negative
## alpha likely reflects bad luck or genuine underperformance; past
## alpha is not reliably predictive.
##
## XYZ (5-yr): alpha = +7.3% => outperformed CAPM. Beta = 0.97: near
## market-level systematic risk. R2 = 0.17: only 17% systematic;
## residual sigma = 21.45% is very large. Most XYZ risk is idiosyncratic
## and diversifiable. Recent betas (1.25-1.45) are substantially above
## the 5-yr 0.97 — systematic risk has risen. The positive alpha is
## statistically noisy given high residual variance, and unlikely to
## persist. Forward-looking analysis should use the higher recent beta.##
## ===== ALL CALCULATIONS COMPLETE =====