tickers <- c("SPY","QQQ","EEM","IWM","EFA","TLT","IYR","GLD")
start_date <- "2010-01-01"
end_date <- "2025-12-31"
getSymbols(tickers, src = "yahoo",
from = start_date, to = end_date,
auto.assign = TRUE, warnings = FALSE)## [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("Downloaded", ncol(prices_daily), "ETFs |",
nrow(prices_daily), "trading days\n")## Downloaded 8 ETFs | 4023 trading days## Period: 2010-01-04 to 2025-12-30ETF Universe: SPY S&P 500 · QQQ Nasdaq-100 · EEM Emerging Markets · IWM Russell 2000 · EFA Intl Developed · TLT 20yr Treasuries · IYR Real Estate · GLD Gold
prices_monthly <- to.monthly(prices_daily, indexAt = "lastof", OHLC = FALSE)
returns_monthly <- Return.calculate(prices_monthly, method = "discrete")
returns_monthly <- returns_monthly[-1, ]
ret_df <- as.data.frame(returns_monthly)
ret_df$join_ym <- format(as.Date(rownames(ret_df)), "%Y-%m")
cat("Monthly returns:", nrow(ret_df), "months x", length(tickers), "ETFs\n")## Monthly returns: 191 months x 8 ETFs## Range: 2010-02 to 2025-12ret_df |>
select(all_of(tickers)) |>
summarise(across(everything(), list(
Mean = ~round(mean(., na.rm = TRUE) * 100, 2),
SD = ~round(sd(., na.rm = TRUE) * 100, 2),
Min = ~round(min(., na.rm = TRUE) * 100, 2),
Max = ~round(max(., na.rm = TRUE) * 100, 2)
))) |>
pivot_longer(everything(),
names_to = c("Ticker", ".value"),
names_sep = "_") |>
kable(caption = "Monthly Return Summary Statistics (%)",
col.names = c("ETF","Mean %","SD %","Min %","Max %")) |>
kable_styling(bootstrap_options = c("striped","hover","condensed"),
full_width = FALSE)| ETF | Mean % | SD % | Min % | Max % |
|---|---|---|---|---|
| SPY | 1.21 | 4.13 | -12.49 | 12.70 |
| QQQ | 1.61 | 4.97 | -13.60 | 14.97 |
| EEM | 0.50 | 5.15 | -17.89 | 16.27 |
| IWM | 1.02 | 5.64 | -21.48 | 18.24 |
| EFA | 0.67 | 4.48 | -14.11 | 14.27 |
| TLT | 0.29 | 3.94 | -9.42 | 13.21 |
| IYR | 0.81 | 4.82 | -19.63 | 13.19 |
| GLD | 0.80 | 4.55 | -11.06 | 12.27 |
ff3_raw <- download_french_data("Fama/French 3 Factors")
ff3_monthly <- ff3_raw$subsets$data[[1]]
ff3_monthly <- ff3_monthly |>
mutate(
join_ym = paste0(
formatC(as.integer(date) %/% 100, width = 4, flag = "0"), "-",
formatC(as.integer(date) %% 100, width = 2, flag = "0")
),
across(c(`Mkt-RF`, SMB, HML, RF), ~as.numeric(.) / 100)
) |>
rename(Mkt_RF = `Mkt-RF`) |>
filter(join_ym >= "2010-01", join_ym <= "2025-12") |>
select(join_ym, Mkt_RF, SMB, HML, RF)
cat("FF3 factors:", nrow(ff3_monthly), "months\n")## FF3 factors: 192 monthshead(ff3_monthly, 5) |>
kable(caption = "Fama-French 3 Factors — first 5 rows (decimal)") |>
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| join_ym | Mkt_RF | SMB | HML | RF |
|---|---|---|---|---|
| 2010-01 | -0.0335 | 0.0043 | 0.0033 | 0e+00 |
| 2010-02 | 0.0339 | 0.0118 | 0.0318 | 0e+00 |
| 2010-03 | 0.0630 | 0.0146 | 0.0219 | 1e-04 |
| 2010-04 | 0.0199 | 0.0484 | 0.0296 | 1e-04 |
| 2010-05 | -0.0790 | 0.0013 | -0.0248 | 1e-04 |
merged_df <- inner_join(ret_df, ff3_monthly, by = "join_ym") |>
arrange(join_ym)
cat("Merged:", nrow(merged_df), "rows x", ncol(merged_df), "cols\n")## Merged: 191 rows x 13 cols## Range: 2010-02 to 2025-12merged_df |>
select(join_ym, all_of(tickers), Mkt_RF, SMB, HML, RF) |>
head(3) |>
kable(caption = "Merged ETF + FF3 — first 3 rows") |>
kable_styling(bootstrap_options = c("striped","hover","condensed"),
full_width = FALSE, font_size = 11)| join_ym | SPY | QQQ | EEM | IWM | EFA | TLT | IYR | GLD | Mkt_RF | SMB | HML | RF |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2010-02 | 0.0311945 | 0.0460386 | 0.0177638 | 0.0447510 | 0.0026677 | -0.0034246 | 0.0545703 | 0.0327482 | 0.0339 | 0.0118 | 0.0318 | 0e+00 |
| 2010-03 | 0.0608796 | 0.0771089 | 0.0811091 | 0.0823071 | 0.0638536 | -0.0205738 | 0.0974850 | -0.0043864 | 0.0630 | 0.0146 | 0.0219 | 1e-04 |
| 2010-04 | 0.0154699 | 0.0224251 | -0.0016623 | 0.0567842 | -0.0280457 | 0.0332187 | 0.0638808 | 0.0588344 | 0.0199 | 0.0484 | 0.0296 | 1e-04 |
solve_mvp <- function(cov_mat) {
n <- ncol(cov_mat)
Dmat <- 2 * cov_mat
dvec <- rep(0, n)
Amat <- cbind(rep(1, n), diag(n))
bvec <- c(1, rep(0, n))
setNames(solve.QP(Dmat, dvec, Amat, bvec, meq = 1)$solution,
colnames(cov_mat))
}
capm_cov <- function(ret_mat, ff_mat) {
n <- ncol(ret_mat)
betas <- numeric(n)
resid_var <- numeric(n)
for (i in seq_len(n)) {
excess <- ret_mat[, i] - ff_mat$RF
fit <- lm(excess ~ ff_mat$Mkt_RF)
betas[i] <- coef(fit)[2]
resid_var[i] <- var(residuals(fit))
}
sys_cov <- outer(betas, betas) * var(ff_mat$Mkt_RF)
colnames(sys_cov) <- rownames(sys_cov) <- colnames(ret_mat)
sys_cov + diag(resid_var)
}
ff3_cov <- function(ret_mat, ff_mat) {
n <- ncol(ret_mat)
fac_mat <- as.matrix(ff_mat[, c("Mkt_RF","SMB","HML")])
B <- matrix(NA, n, 3, dimnames = list(colnames(ret_mat), c("Mkt_RF","SMB","HML")))
resid_var <- numeric(n)
for (i in seq_len(n)) {
excess <- ret_mat[, i] - ff_mat$RF
fit <- lm(excess ~ fac_mat)
B[i, ] <- coef(fit)[-1]
resid_var[i] <- var(residuals(fit))
}
B %*% cov(fac_mat) %*% t(B) + diag(resid_var)
}
win_df <- merged_df |> filter(join_ym >= "2020-03", join_ym <= "2025-02")
cat("Window rows:", nrow(win_df), "-- expected 60\n")## Window rows: 60 -- expected 60if (nrow(win_df) != 60) stop("Window size mismatch! Check merged_df date range.")
ret_mat <- as.matrix(win_df[, tickers])
ff_mat <- win_df[, c("Mkt_RF","SMB","HML","RF")]
w_capm <- solve_mvp(capm_cov(ret_mat, ff_mat))
data.frame(ETF = names(w_capm),
Weight = paste0(round(w_capm * 100, 2), "%")) |>
kable(caption = "CAPM MVP Weights — window 2020-03 to 2025-02") |>
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| ETF | Weight |
|---|---|
| SPY | 0% |
| QQQ | 0% |
| EEM | 14.01% |
| IWM | 0% |
| EFA | 8.38% |
| TLT | 34.25% |
| IYR | 0% |
| GLD | 43.36% |
w_ff3 <- solve_mvp(ff3_cov(ret_mat, ff_mat))
data.frame(ETF = names(w_ff3),
Weight = paste0(round(w_ff3 * 100, 2), "%")) |>
kable(caption = "FF3 MVP Weights — window 2020-03 to 2025-02") |>
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| ETF | Weight |
|---|---|
| SPY | 0% |
| QQQ | 0% |
| EEM | 15.65% |
| IWM | 0% |
| EFA | 8.21% |
| TLT | 33.91% |
| IYR | 0% |
| GLD | 42.23% |
get_monthly_ret <- function(ym, df) {
row <- df |> filter(join_ym == ym)
if (nrow(row) == 0) stop(paste("No data for", ym, "-- check merged_df"))
setNames(as.numeric(row[1, tickers]), tickers)
}
ret_mar <- get_monthly_ret("2025-03", merged_df)
r_capm_mar <- sum(w_capm * ret_mar)
r_ff3_mar <- sum(w_ff3 * ret_mar)
data.frame(
Model = c("CAPM MVP","FF3 MVP"),
Return = paste0(round(c(r_capm_mar, r_ff3_mar) * 100, 4), "%")
) |>
kable(caption = "Realized MVP Returns — March 2025",
col.names = c("Model","Realized Return")) |>
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Model | Realized Return |
|---|---|
| CAPM MVP | 3.8576% |
| FF3 MVP | 3.773% |
Q7 Results
CAPM MVP: 3.8576% | FF3 MVP:
3.773%
win2_df <- merged_df |> filter(join_ym >= "2020-04", join_ym <= "2025-03")
cat("Window 2 rows:", nrow(win2_df), "-- expected 60\n")## Window 2 rows: 60 -- expected 60ret_mat2 <- as.matrix(win2_df[, tickers])
ff_mat2 <- win2_df[, c("Mkt_RF","SMB","HML","RF")]
w_capm2 <- solve_mvp(capm_cov(ret_mat2, ff_mat2))
w_ff3_2 <- solve_mvp(ff3_cov(ret_mat2, ff_mat2))
ret_apr <- get_monthly_ret("2025-04", merged_df)
r_capm_apr <- sum(w_capm2 * ret_apr)
r_ff3_apr <- sum(w_ff3_2 * ret_apr)
data.frame(
Model = c("CAPM MVP","FF3 MVP"),
Return = paste0(round(c(r_capm_apr, r_ff3_apr) * 100, 4), "%")
) |>
kable(caption = "Realized MVP Returns — April 2025",
col.names = c("Model","Realized Return")) |>
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Model | Realized Return |
|---|---|
| CAPM MVP | 2.1839% |
| FF3 MVP | 2.1333% |
Q8 Results
CAPM MVP: 2.1839% | FF3 MVP:
2.1333%
U = E(r) − ½Aσ². Given E(r_P)=18%, σ_P=28%, r_f=8%, A=4. Find optimal allocation y.
\[y^* = \frac{E(r_P) - r_f}{A \cdot \sigma_P^2}\]
E_rP <- 0.18; sigma_P <- 0.28; r_f <- 0.08; A <- 4
y_star <- (E_rP - r_f) / (A * sigma_P^2)
cat(sprintf("y* = (0.18-0.08) / (4 x 0.28^2) = %.4f = %.2f%%\n",
y_star, y_star*100))## y* = (0.18-0.08) / (4 x 0.28^2) = 0.3189 = 31.89%cat(sprintf("Complete portfolio: E(r)=%.2f%%, sigma=%.2f%%\n",
(y_star*E_rP+(1-y_star)*r_f)*100, (y_star*sigma_P)*100))## Complete portfolio: E(r)=11.19%, sigma=8.93%Answer: Invest 31.89% in the risky portfolio.
Stock A: β=1.2, σ=30%. Stock B: β=0.8, σ=25%. Which earns a higher expected return?
Under CAPM, only systematic risk (β) is compensated.
\[E(r_A) = r_f + 1.2[E(r_M)-r_f] > E(r_B) = r_f + 0.8[E(r_M)-r_f]\]
Answer: Stock A has higher expected return due to higher β. Stock B’s lower σ reflects diversifiable (unpriced) risk.
Portfolio A: E(r)=10%, σ=15%. Portfolio B: E(r)=20%, σ=25%. r_f=5%. Compare Sharpe ratios.
rf <- 0.05
tibble(Portfolio=c("A","B"), Er=c(0.10,0.20), sigma=c(0.15,0.25)) |>
mutate(Sharpe = round((Er-rf)/sigma, 4),
`E(r)` = paste0(Er*100,"%"),
Sigma = paste0(sigma*100,"%")) |>
select(Portfolio, `E(r)`, Sigma, Sharpe) |>
kable(caption = "Sharpe Ratio Comparison") |>
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Portfolio | E(r) | Sigma | Sharpe |
|---|---|---|---|
| A | 10% | 15% | 0.3333 |
| B | 20% | 25% | 0.6000 |
Answer: Both have a Sharpe ratio of 0.3333 — equally efficient risk-adjusted performance.
E(r_M)=12%, σ_M=20%, r_f=5%. Find market Sharpe ratio.
## Market Sharpe ratio: 0.35Answer: Sharpe = 0.35 — slope of the CML.
Target E(r_C)=10%, E(r_M)=12%, r_f=5%. Find fraction y in market portfolio.
## y = 0.7143 = 71.43%Answer: Invest 71.43% in the market portfolio.
Security 1: β=1.5, E(r)=17%. Security 2: β=0.75, E(r)=10.5%. r_f=5%, E(r_M)=12%. Fairly priced?
tibble(Security=c("Security 1","Security 2"),
Beta=c(1.5,0.75), Actual=c(0.17,0.105)) |>
mutate(`CAPM E(r)` = 0.05 + Beta*(0.12-0.05),
Alpha = round((Actual - `CAPM E(r)`)*100, 4),
Verdict = ifelse(abs(Alpha)<0.001,"Fairly Priced",
ifelse(Alpha>0,"Underpriced","Overpriced")),
Actual = paste0(Actual*100,"%"),
`CAPM E(r)` = paste0(`CAPM E(r)`*100,"%"),
Alpha = paste0(Alpha,"%")) |>
kable(caption = "CAPM Pricing Check") |>
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Security | Beta | Actual | CAPM E(r) | Alpha | Verdict |
|---|---|---|---|---|---|
| Security 1 | 1.50 | 17% | 15.5% | 1.5% | Underpriced |
| Security 2 | 0.75 | 10.5% | 10.25% | 0.25% | Underpriced |
Answer: Both securities are fairly priced — they lie on the SML with α = 0.
β=1.2, r_f=4%, E(r_M)=14%. Find E(r).
## E(r) = 4% + 1.2 x 10% = 16.0%Answer: E(r) = 16%
β=0.8, r_f=3%, E(r_M)=11%, actual E(r)=10%. Over- or under-priced?
capm_12 <- 0.03 + 0.8*(0.11-0.03)
alpha_12 <- 0.10 - capm_12
cat(sprintf("CAPM E(r) = %.2f%% | Actual = 10%% | Alpha = %.2f%%\n",
capm_12*100, alpha_12*100))## CAPM E(r) = 9.40% | Actual = 10% | Alpha = 0.60%Answer: Alpha = 0.6% → Underpriced (positive alpha — buy signal)
α=+2%, β=1.0, r_f=5%, E(r_M)=12%. Analyst’s expected return?
capm_c12 <- 0.05 + 1.0*(0.12-0.05)
total_c12 <- capm_c12 + 0.02
cat(sprintf("CAPM: %.0f%% | Analyst (CAPM + alpha): %.0f%%\n",
capm_c12*100, total_c12*100))## CAPM: 12% | Analyst (CAPM + alpha): 14%Answer: Analyst’s E(r) = 14% vs CAPM’s 12%. Positive α → stock plots above the SML → underpriced.
β=1.2, σ²_M=0.0225, σ²_e=0.04. Decompose total variance.
\[\sigma^2_{total} = \beta^2\sigma^2_M + \sigma^2_e\]
beta8 <- 1.2; var_M8 <- 0.0225; var_e8 <- 0.04
sys8 <- beta8^2 * var_M8
tot8 <- sys8 + var_e8
tibble(Component = c("Systematic (β²×σ²_M)","Firm-specific (σ²_e)","Total variance","R-squared"),
Value = round(c(sys8, var_e8, tot8, sys8/tot8), 4)) |>
kable(caption = "Variance Decomposition") |>
kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)| Component | Value |
|---|---|
| Systematic (β²×σ²_M) | 0.0324 |
| Firm-specific (σ²_e) | 0.0400 |
| Total variance | 0.0724 |
| R-squared | 0.4475 |
R_A = 0.01 + 0.9·R_M + e_A, σ_M=20%, σ(e_A)=25%. Find σ_A and ρ(A,M).
\[\sigma_A = \sqrt{\beta^2\sigma^2_M + \sigma^2_e}, \quad \rho_{A,M} = \frac{\beta\sigma_M}{\sigma_A}\]
beta_c <- 0.9; sig_M_c <- 0.20; sig_e_c <- 0.25
sig_A_c <- sqrt(beta_c^2 * sig_M_c^2 + sig_e_c^2)
rho_c <- (beta_c * sig_M_c) / sig_A_c
cat(sprintf("Total sigma_A = %.4f = %.2f%%\n", sig_A_c, sig_A_c*100))## Total sigma_A = 0.3081 = 30.81%## Correlation rho(A,M) = 0.5843Answer: σ_A = 30.81%, ρ(A,M) = 0.5843
## R version 4.5.3 (2026-03-11 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 10 x64 (build 19045)
##
## Matrix products: default
## LAPACK version 3.12.1
##
## locale:
## [1] LC_COLLATE=English_United States.utf8
## [2] LC_CTYPE=English_United States.utf8
## [3] LC_MONETARY=English_United States.utf8
## [4] LC_NUMERIC=C
## [5] LC_TIME=English_United States.utf8
##
## time zone: Asia/Ulaanbaatar
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] frenchdata_0.2.0 kableExtra_1.4.0
## [3] knitr_1.51 quadprog_1.5-8
## [5] PerformanceAnalytics_2.1.0 lubridate_1.9.5
## [7] forcats_1.0.1 stringr_1.6.0
## [9] dplyr_1.2.1 purrr_1.2.2
## [11] readr_2.2.0 tidyr_1.3.2
## [13] tibble_3.3.1 ggplot2_4.0.2
## [15] tidyverse_2.0.0 quantmod_0.4.28
## [17] TTR_0.24.4 xts_0.14.2
## [19] zoo_1.8-15
##
## loaded via a namespace (and not attached):
## [1] sass_0.4.10 generics_0.1.4 xml2_1.5.2 stringi_1.8.7
## [5] lattice_0.22-9 hms_1.1.4 digest_0.6.39 magrittr_2.0.5
## [9] evaluate_1.0.5 grid_4.5.3 timechange_0.4.0 RColorBrewer_1.1-3
## [13] fastmap_1.2.0 jsonlite_2.0.0 viridisLite_0.4.3 scales_1.4.0
## [17] textshaping_1.0.5 jquerylib_0.1.4 cli_3.6.6 rlang_1.2.0
## [21] withr_3.0.2 cachem_1.1.0 yaml_2.3.12 tools_4.5.3
## [25] tzdb_0.5.0 curl_7.0.0 vctrs_0.7.3 R6_2.6.1
## [29] lifecycle_1.0.5 pkgconfig_2.0.3 pillar_1.11.1 bslib_0.10.0
## [33] gtable_0.3.6 glue_1.8.0 systemfonts_1.3.2 xfun_0.57
## [37] tidyselect_1.2.1 rstudioapi_0.18.0 farver_2.1.2 htmltools_0.5.9
## [41] svglite_2.2.2 rmarkdown_2.31 compiler_4.5.3 S7_0.2.1