1 Part I — Computer Questions (40%)

1.1 Q1 · Download ETF Daily Price Data

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
cat("Period:", format(start(prices_daily)), "to", format(end(prices_daily)), "\n")
## Period: 2010-01-04 to 2025-12-30

ETF 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

1.2 Q2 · Monthly Discrete Returns

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
cat("Range:", min(ret_df$join_ym), "to", max(ret_df$join_ym), "\n")
## Range: 2010-02 to 2025-12
ret_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)
Monthly Return Summary Statistics (%)
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

1.3 Q3 · Fama-French 3-Factor Data

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 months
head(ff3_monthly, 5) |>
  kable(caption = "Fama-French 3 Factors — first 5 rows (decimal)") |>
  kable_styling(bootstrap_options = c("striped","hover"), full_width = FALSE)
Fama-French 3 Factors — first 5 rows (decimal)
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

1.4 Q4 · Merge ETF Returns with FF3 Factors

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
cat("Range:", min(merged_df$join_ym), "to", max(merged_df$join_ym), "\n")
## Range: 2010-02 to 2025-12
merged_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)
Merged ETF + FF3 — first 3 rows
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

1.5 Q5 · MVP via CAPM Covariance (60-Month Window)

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 60
if (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)
CAPM MVP Weights — window 2020-03 to 2025-02
ETF Weight
SPY 0%
QQQ 0%
EEM 14.01%
IWM 0%
EFA 8.38%
TLT 34.25%
IYR 0%
GLD 43.36%

1.6 Q6 · MVP via FF3 Covariance (60-Month Window)

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)
FF3 MVP Weights — window 2020-03 to 2025-02
ETF Weight
SPY 0%
QQQ 0%
EEM 15.65%
IWM 0%
EFA 8.21%
TLT 33.91%
IYR 0%
GLD 42.23%

1.7 Q7 · Realized Portfolio Returns — March 2025

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)
Realized MVP Returns — March 2025
Model Realized Return
CAPM MVP 3.8576%
FF3 MVP 3.773%

Q7 Results
CAPM MVP: 3.8576%  |  FF3 MVP: 3.773%

1.8 Q8 · Realized Portfolio Returns — April 2025

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 60
ret_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)
Realized MVP Returns — April 2025
Model Realized Return
CAPM MVP 2.1839%
FF3 MVP 2.1333%

Q8 Results
CAPM MVP: 2.1839%  |  FF3 MVP: 2.1333%

2 Part II — Textbook Problems (60%)

2.1 Chapter 5 — Problem 12

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.

2.2 Chapter 6 — Problem 21

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.

2.3 Chapter 6 — Problem 22

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)
Sharpe Ratio Comparison
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.

2.4 Chapter 6 — CFA Problem 4

E(r_M)=12%, σ_M=20%, r_f=5%. Find market Sharpe ratio.

S_mkt <- (0.12-0.05)/0.20
cat("Market Sharpe ratio:", round(S_mkt, 4))
## Market Sharpe ratio: 0.35

Answer: Sharpe = 0.35 — slope of the CML.

2.5 Chapter 6 — CFA Problem 5

Target E(r_C)=10%, E(r_M)=12%, r_f=5%. Find fraction y in market portfolio.

y_c5 <- (0.10-0.05)/(0.12-0.05)
cat(sprintf("y = %.4f = %.2f%%\n", y_c5, y_c5*100))
## y = 0.7143 = 71.43%

Answer: Invest 71.43% in the market portfolio.

2.6 Chapter 6 — CFA Problem 8

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)
CAPM Pricing Check
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.

2.7 Chapter 7 — Problem 11

β=1.2, r_f=4%, E(r_M)=14%. Find E(r).

E_r11 <- 0.04 + 1.2*(0.14-0.04)
cat(sprintf("E(r) = 4%% + 1.2 x 10%% = %.1f%%\n", E_r11*100))
## E(r) = 4% + 1.2 x 10% = 16.0%

Answer: E(r) = 16%

2.8 Chapter 7 — Problem 12

β=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.9 Chapter 7 — CFA Problem 12

α=+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.

2.10 Chapter 8 — Problem 17

β=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)
Variance Decomposition
Component Value
Systematic (β²×σ²_M) 0.0324
Firm-specific (σ²_e) 0.0400
Total variance 0.0724
R-squared 0.4475

2.11 Chapter 8 — CFA Problem 1

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%
cat(sprintf("Correlation rho(A,M) = %.4f\n", rho_c))
## Correlation rho(A,M) = 0.5843

Answer: σ_A = 30.81%, ρ(A,M) = 0.5843

3 Session Info

## 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] gtable_0.3.6       xfun_0.57          bslib_0.10.0       lattice_0.22-9    
##  [5] tzdb_0.5.0         vctrs_0.7.3        tools_4.5.3        generics_0.1.4    
##  [9] parallel_4.5.3     curl_7.0.0         pkgconfig_2.0.3    RColorBrewer_1.1-3
## [13] S7_0.2.1           assertthat_0.2.1   lifecycle_1.0.5    compiler_4.5.3    
## [17] farver_2.1.2       textshaping_1.0.5  codetools_0.2-20   htmltools_0.5.9   
## [21] sass_0.4.10        yaml_2.3.12        crayon_1.5.3       pillar_1.11.1     
## [25] jquerylib_0.1.4    cachem_1.1.0       tidyselect_1.2.1   rvest_1.0.5       
## [29] digest_0.6.39      stringi_1.8.7      fastmap_1.2.0      grid_4.5.3        
## [33] cli_3.6.6          magrittr_2.0.5     withr_3.0.2        scales_1.4.0      
## [37] bit64_4.6.0-1      timechange_0.4.0   rmarkdown_2.31     httr_1.4.8        
## [41] bit_4.6.0          hms_1.1.4          evaluate_1.0.5     viridisLite_0.4.3 
## [45] rlang_1.2.0        glue_1.8.0         selectr_0.5-1      xml2_1.5.2        
## [49] svglite_2.2.2      rstudioapi_0.18.0  vroom_1.7.1        jsonlite_2.0.0    
## [53] R6_2.6.1           systemfonts_1.3.2  fs_2.0.1