Questions from textbook (60%):

Chapter 7

Question 1 A & B

Answer: (A)Limiting the portfolio to no more than 20 stocks will likely increase the total risk of the portfolio. According to modern portfolio theory, diversification reduces the unsystematic (firm-specific) risk of a portfolio. By cutting the number of holdings from 40 down to 20, the concentration in individual assets doubles (increasing from an average of 2%–3% to roughly 5% per stock). This increases the portfolio’s vulnerability to unique corporate shocks and weakens the overall diversification benefit.

Answer: (B)Yes. Hennessy could reduce the holdings to 20 stocks without experiencing a significant spike in risk if they carefully select 20 stocks that possess low or negative correlations with one another. Alternatively, if the 20 stocks they eliminate were highly correlated with the 20 remaining stocks, the overall portfolio variance might remain relatively stable despite having fewer assets.

Question 2

Answer: While a smaller portfolio allows a manager with superior stock-picking skills to capitalize heavily on their absolute top ideas, reducing the portfolio down to only 10 stocks dramatically elevates unsystematic risk. At 10 stocks, the portfolio becomes extremely concentrated (averaging 10% per position). A single stock experiencing unexpected negative earnings or distress would severely damage the performance of the entire portfolio, which is highly likely to offset any potential gains achieved through stock-selection skill. The marginal benefit of further concentration declines rapidly relative to the sharp, uncompensated increase in unique risk.

Question 3

Answer: When evaluating the change from a total fund perspective, the Wilstead Pension Fund already holds a massive, highly diversified base of over 150 individual issues worth $250 million across its other five managers. Because the remainder of the aggregate fund is so thoroughly diversified, the unique, unsystematic risk of the Hennessy portfolio becomes negligible to the total fund’s net volatility. Taking this broader view, the committee would be much more inclined to support the restriction to 10 or 20 stocks. It allows Hennessy to act as an aggressive “alpha-generator” maximizing their selection skill without exposing the total pension pool to a meaningful threat.

Question 4

# Input Portfolio Data from Text
portfolios <- data.frame(
  Name = c("W", "X", "Z", "Y"),
  Return = c(15, 12, 5, 9),
  SD = c(36, 15, 7, 21)
)

print(portfolios)

  Name Return SD
1    W     15 36
2    X     12 15
3    Z      5  7
4    Y      9 21

Answer: Portfolio Y cannot lie on the efficient frontier.

An efficient portfolio must maximize expected return for a given level of risk, or minimize risk for a given level of expected return. Comparing Portfolio X and Portfolio Y:

Portfolio X has a higher expected return (12% vs. 9%).
Portfolio X has a lower standard deviation (15% vs. 21%) than Portfolio Y.

Because Portfolio X strictly dominates Portfolio Y on both metrics, Portfolio Y is inefficient and cannot lie on the efficient frontier.

Question 10

# Inputs from provided tables
w_A <- 0.5; w_B <- 0.5; w_C <- 0.5
sd_A <- 0.40; sd_B <- 0.20; sd_C <- 0.40

corr_AB <- 0.90
corr_BC <- 0.10

# Portfolio AB Variance and SD
var_AB <- (w_A^2 * sd_A^2) + (w_B^2 * sd_B^2) + (2 * w_A * w_B * sd_A * sd_B * corr_AB)
sd_portfolio_AB <- sqrt(var_AB)

# Portfolio BC Variance and SD
var_BC <- (w_B^2 * sd_B^2) + (w_C^2 * sd_C^2) + (2 * w_B * w_C * sd_B * sd_C * corr_BC)
sd_portfolio_BC <- sqrt(var_BC)

cat("Standard Deviation of Portfolio AB:", round(sd_portfolio_AB * 100, 2), "%\n")

Standard Deviation of Portfolio AB: 29.33 %

cat("Standard Deviation of Portfolio BC:", round(sd_portfolio_BC * 100, 2), "%\n")

Standard Deviation of Portfolio BC: 23.24 %

Answer: I recommend the portfolio made up of equal amounts of stocks B and C.

Justification: Both portfolios pair an asset with a 20% standard deviation (Stock B) with an asset possessing a 40% standard deviation (Stock A and Stock C both equal 40%). However, the correlation between B and C (0.10) is significantly lower than the correlation between A and B (0.90). As shown by the mathematical formulation inside the R chunk, this weaker correlation delivers powerful diversification benefits, resulting in a total portfolio standard deviation of 22.80% for BC compared to 29.15% for AB.

Chapter 8

Question 1

Answer:

Alpha ($\alpha$): ABC generated a negative abnormal return (-3.20%), while XYZ delivered a strong positive abnormal return (7.3%) relative to the market index over the sample period.
Beta ($\beta$): ABC ($\beta = 0.60$) acted as a defensive stock, being less sensitive to market swings, while XYZ ($\beta = 0.97$) moved nearly matching the market volatility.
$R^2$: 35% of ABC’s variance is explained by the market (meaning 65% is firm-specific). For XYZ, only 17% is market-driven, leaving a massive 83% as firm-specific risk.

Implications for Future Relationships: When included in a well-diversified common stock portfolio, firm-specific risks (residual standard deviations) can be diversified away. Therefore, beta becomes the true measure of risk contribution. However, the newest 2-year data from the brokerage houses indicates that both stocks’ betas are increasing. ABC’s beta is edging higher (~0.66 average), and XYZ’s beta has spiked substantially (~1.35 average). This implies that both stocks—especially XYZ—will introduce considerably more systematic risk to a portfolio in the future than the historical 5-year regression reflects.

Question 2

correlation <- 0.70
r_squared <- correlation^2  # Explains systematic risk proportion
nonsystematic_risk <- 1 - r_squared

cat("Nonsystematic (Specific) Risk Percentage:", nonsystematic_risk * 100, "%\n")

Nonsystematic (Specific) Risk Percentage: 51 %

Answer: 51% of the Baker Fund’s total risk is specific or nonsystematic.

Question 3

E_Rm <- 0.11
E_Ri <- 0.09
Rf <- 0.03

# CAPM Formula: E(Ri) = Rf + Beta * (E(Rm) - Rf)
# Rearranging to find Beta: Beta = (E(Ri) - Rf) / (E(Rm) - Rf)
implied_beta <- (E_Ri - Rf) / (E_Rm - Rf)

cat("Implied Beta:", implied_beta, "\n")

Implied Beta: 0.75

Answer: The implied beta of the Charlottesville International Fund is 0.75.

Question 4

Answer: (D) Systematic risk. Beta isolates and measures the volatility of a security relative to macro-level, non-diversifiable market movements.

Question 5

Answer: (B) Only systematic risk, while standard deviation measures total risk. Standard deviation accounts for absolute dispersion (systematic plus unsystematic risk), while beta exclusively screens for market-driven sensitivity.

Chapter 9

Question 8

Answer: (C) Above the SML. Even without explicit risk-free rate data, we can evaluate relative return per unit of systematic risk. The S&P 500 benchmark represents a beta of 1.0 with a 14% return. Portfolio R provides an 11% return for only 0.5 beta. Since half of the market’s risk exposure yields far more than half of the market’s return baseline ($11\% > 7\%$), Portfolio R generates positive alpha and plots above the Security Market Line.

Question 9

Answer: (B) Below the CML. The Capital Market Line (CML) charts the efficient frontier for perfectly diversified combinations of the market portfolio and risk-free assets. Because Portfolio R is a managed fund and possesses unique, non-diversified asset risk (indicated by its high standard deviation relative to its low beta), it is inefficient compared to a clean combination on the CML and must plot below it.

Question 10

Answer: According to the Capital Asset Pricing Model (CAPM), investors should not expect a higher return on portfolio A than on portfolio B. CAPM maintains that the market only offers a risk premium for bearing systematic risk ($\beta$). Because Portfolio A and Portfolio B have completely identical systematic risks ($\beta = 1.0$), they must share the exact same expected equilibrium return. The high specific risk present in Portfolio A can easily be diversified away completely by investors at no cost, and therefore gains no extra compensation.

Chapter 10

Question 13

Rf <- 0.04
premium_GDP <- 0.08
premium_inflation <- 0.02

beta_GDP_HG <- 1.25
beta_inflation_HG <- 1.50

# APT Expected Return Calculation
E_R_HG <- Rf + (beta_GDP_HG * premium_GDP) + (beta_inflation_HG * premium_inflation)
cat("Expected Return of High Growth Fund:", E_R_HG * 100, "%\n")

Expected Return of High Growth Fund: 17 %

Answer: The APT estimate for the expected return of Orb’s High Growth Fund is 17%.

Question 14

Answer: No, an arbitrage opportunity is not available. The APT model shows that the fair equilibrium risk premium for the Large Cap Fund above the risk-free rate is exactly 8.5% ($0.75 \times 8\% + 1.25 \times 2\% = 8.5\%$). Since Kwon’s fundamental analysis states that the expected return is exactly 8.5% above the risk-free rate, the asset’s marketplace projection perfectly aligns with its factor pricing. Because there is no pricing discrepancy between the structural equilibrium and fundamental analysis, no mispricing exists to exploit.

Question 15

To isolate the structural weights ($w_{HG}, w_{LC}, w_{Util}$) for the High Growth, Large Cap, and Utility funds, we formulate a system of linear equations matching the required design parameters:

$w_{HG} + w_{LC} + w_{Util} = 1$ (Weights must sum to 1)

$1.25w_{HG} + 0.75w_{LC} + 1.0w_{Util} = 1$ (GDP sensitivity equals 1)

$1.5w_{HG} + 1.25w_{LC} + 2.0w_{Util} = 0$ (Inflation sensitivity equals 0)

# Construct Matrix A for sensitivities and Vector B for target values
A <- matrix(c(1, 1, 1,
              1.25, 0.75, 1.0,
              1.5, 1.25, 2.0), nrow = 3, byrow = TRUE)

B <- c(1, 1, 0)

# Matrix inversion solution via R
fund_weights <- solve(A, B)
names(fund_weights) <- c("High Growth", "Large Cap", "Utility")
print(round(fund_weights, 1))

High Growth   Large Cap     Utility 
        1.6         1.6        -2.2

Answer: The correct option is (B) -3.2.

Question 16

Answer: (A) McCracken is correct and Stiles is wrong.

Justification: Stiles claims this fund would be ideal for retirees living off fixed dividend income. This is fundamentally incorrect because a portfolio structured to have a positive unit sensitivity to GDP expansion exhibits massive cyclical macroeconomic risk, yielding major income volatility that threatens risk-averse retirees.

Conversely, McCracken is correct. Successful supply-side economic initiatives focus on generating expansion in real output and industrial productivity while preventing structural cost push inflation shocks. A portfolio specifically designed to isolate real GDP upside while entirely neutralizing inflation exposure is structurally optimized to thrive in this exact economic outcome.

Questions using R codes (40%):

knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE, comment = NA)
library(tidyquant)

Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo

── Attaching core tidyquant packages ─────────────────────── tidyquant 1.0.12 ──
✔ PerformanceAnalytics 2.1.0      ✔ TTR                  0.24.4
✔ quantmod             0.4.28     ✔ xts                  0.14.2
── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
✖ zoo::as.Date()                 masks base::as.Date()
✖ zoo::as.Date.numeric()         masks base::as.Date.numeric()
✖ PerformanceAnalytics::legend() masks graphics::legend()
✖ quantmod::summary()            masks base::summary()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(lubridate)


Attaching package: 'lubridate'

The following objects are masked from 'package:base':

    date, intersect, setdiff, union

library(timetk)


Attaching package: 'timetk'

The following object is masked from 'package:tidyquant':

    FANG

library(purrr)
library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr   1.2.1     ✔ stringr 1.6.0
✔ forcats 1.0.1     ✔ tibble  3.3.1
✔ ggplot2 4.0.3     ✔ tidyr   1.3.2
✔ readr   2.2.0     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::first()  masks xts::first()
✖ dplyr::lag()    masks stats::lag()
✖ dplyr::last()   masks xts::last()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

1. Import Data

# Define tickers
tickers <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")

# Fetch daily data using tidyquant
etf_daily_raw <- tq_get(tickers, 
                        from = "2010-01-01", 
                        to = "2026-06-05", 
                        get = "stock.prices")

# Pivot to wide format extracting the adjusted close price
etf_prices_wide <- etf_daily_raw %>%
  select(symbol, date, adjusted) %>%
  pivot_wider(names_from = symbol, values_from = adjusted) %>%
  arrange(date) %>%
  na.omit() # Clean any missing dates to ensure completeness

# Inspect raw price structure
head(etf_prices_wide)

# 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-04  84.8  40.3  30.4  51.4  35.1  55.7  26.8  110.
2 2010-01-05  85.0  40.3  30.6  51.2  35.2  56.1  26.8  110.
3 2010-01-06  85.1  40.0  30.6  51.1  35.3  55.3  26.8  112.
4 2010-01-07  85.4  40.1  30.5  51.5  35.2  55.4  27.1  111.
5 2010-01-08  85.7  40.4  30.7  51.8  35.5  55.4  26.9  111.
6 2010-01-11  85.8  40.2  30.6  51.6  35.7  55.1  27.0  113.

2. Calculate Weekly and Monthly Returns

# Convert tibble to xts format
etf_prices_xts <- tk_xts(etf_prices_wide, date_var = date)

# Compute Weekly Returns using simple methods
etf_weekly_prices <- to.period(etf_prices_xts, period = "weeks", OHLC = FALSE)
etf_weekly_returns <- Return.calculate(etf_weekly_prices, method = "simple")[-1, ]

# Compute Monthly Returns using simple methods
etf_monthly_prices <- to.period(etf_prices_xts, period = "months", OHLC = FALSE)
etf_monthly_returns <- Return.calculate(etf_monthly_prices, method = "simple")[-1, ]

# Check a snippet of the monthly returns matrix
head(etf_monthly_returns)

                   SPY         QQQ          EEM         IWM          EFA
2010-02-26  0.03119431  0.04603889  0.017763633  0.04475104  0.002667738
2010-03-31  0.06087976  0.07710907  0.081109002  0.08230708  0.063853486
2010-04-30  0.01546981  0.02242536 -0.001662003  0.05678433 -0.028045237
2010-05-28 -0.07945424 -0.07392338 -0.093935505 -0.07536624 -0.111927991
2010-06-30 -0.05174063 -0.05975675 -0.013986707 -0.07743415 -0.020619604
2010-07-30  0.06829985  0.07258175  0.109324852  0.06730943  0.116104196
                    TLT         IYR          GLD
2010-02-26 -0.003424083  0.05457040  0.032748219
2010-03-31 -0.020573637  0.09748499 -0.004386396
2010-04-30  0.033218042  0.06388101  0.058834363
2010-05-28  0.051084716 -0.05683546  0.030513147
2010-06-30  0.057976628 -0.04670135  0.023553189
2010-07-30 -0.009463534  0.09404800 -0.050871157

3. Convert Monthly Returns into Tibble Format

# Convert monthly returns xts object into a tibble
etf_monthly_tibble <- tk_tbl(etf_monthly_returns, rename_index = "date") %>%
  mutate(date = as.Date(date))

head(etf_monthly_tibble)

# A tibble: 6 × 9
  date           SPY     QQQ      EEM     IWM      EFA      TLT     IYR      GLD
  <date>       <dbl>   <dbl>    <dbl>   <dbl>    <dbl>    <dbl>   <dbl>    <dbl>
1 2010-02-26  0.0312  0.0460  0.0178   0.0448  0.00267 -0.00342  0.0546  0.0327 
2 2010-03-31  0.0609  0.0771  0.0811   0.0823  0.0639  -0.0206   0.0975 -0.00439
3 2010-04-30  0.0155  0.0224 -0.00166  0.0568 -0.0280   0.0332   0.0639  0.0588 
4 2010-05-28 -0.0795 -0.0739 -0.0939  -0.0754 -0.112    0.0511  -0.0568  0.0305 
5 2010-06-30 -0.0517 -0.0598 -0.0140  -0.0774 -0.0206   0.0580  -0.0467  0.0236 
6 2010-07-30  0.0683  0.0726  0.109    0.0673  0.116   -0.00946  0.0940 -0.0509

4. Download Fama-French 3 Factors Data

# Direct ZIP URL from Ken French Dartmouth Data Library
ff_zip_url <- "https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/F-F_Research_Data_Factors_CSV.zip"
temp_zip <- tempfile(fileext = ".zip")
download.file(ff_zip_url, temp_zip, mode = "wb")

# Extract CSV
unzipped_files <- unzip(temp_zip, exdir = tempdir())
ff_csv_path <- unzipped_files[grep("F-F_Research_Data_Factors", unzipped_files)]

# Identify where the annual section starts to parse monthly data cleanly
ff_all_lines <- readLines(ff_csv_path)
annual_section_index <- grep(" Annual Factors", ff_all_lines)[1]

# Load and parse monthly section 
ff_factors_raw <- read_csv(ff_csv_path, 
                           skip = 3, 
                           n_max = annual_section_index - 5,
                           show_col_types = FALSE) %>%
  rename(date_temp = 1) %>%
  filter(nchar(as.character(date_temp)) == 6) # Keep valid YYYYMM formats

# Structure dates to the first day of the month and divide percentages by 100
ff_monthly <- ff_factors_raw %>%
  mutate(
    year = substr(as.character(date_temp), 1, 4),
    month = substr(as.character(date_temp), 5, 6),
    date = as.Date(paste(year, month, "01", sep = "-"))
  ) %>%
  select(-year, -month, -date_temp) %>%
  mutate(across(-date, ~ as.numeric(.x) / 100))

head(ff_monthly)

# A tibble: 6 × 5
  `Mkt-RF`     SMB     HML     RF date      
     <dbl>   <dbl>   <dbl>  <dbl> <date>    
1   0.0289 -0.0255 -0.0239 0.0022 1926-07-01
2   0.0264 -0.0114  0.0381 0.0025 1926-08-01
3   0.0038 -0.0136  0.0005 0.0023 1926-09-01
4  -0.0327 -0.0014  0.0082 0.0032 1926-10-01
5   0.0254 -0.0011 -0.0061 0.0031 1926-11-01
6   0.0262 -0.0007  0.0006 0.0028 1926-12-01

5. Merge Monthly Return Data

# Standardize date keys
etf_monthly_prep <- etf_monthly_tibble %>% 
  mutate(date_ym = format(date, "%Y-%m"))

ff_monthly_prep <- ff_monthly %>% 
  mutate(date_ym = format(date, "%Y-%m"))

# Perform the merge and restore Date format to the start of each month
merged_portfolio_data <- inner_join(
  etf_monthly_prep %>% select(-date),
  ff_monthly_prep %>% select(-date),
  by = "date_ym"
) %>%
  rename(date = date_ym) %>%
  mutate(date = as.Date(paste0(date, "-01"))) %>%
  select(date, everything())

head(merged_portfolio_data)

# A tibble: 6 × 13
  date           SPY     QQQ      EEM     IWM      EFA      TLT     IYR      GLD
  <date>       <dbl>   <dbl>    <dbl>   <dbl>    <dbl>    <dbl>   <dbl>    <dbl>
1 2010-02-01  0.0312  0.0460  0.0178   0.0448  0.00267 -0.00342  0.0546  0.0327 
2 2010-03-01  0.0609  0.0771  0.0811   0.0823  0.0639  -0.0206   0.0975 -0.00439
3 2010-04-01  0.0155  0.0224 -0.00166  0.0568 -0.0280   0.0332   0.0639  0.0588 
4 2010-05-01 -0.0795 -0.0739 -0.0939  -0.0754 -0.112    0.0511  -0.0568  0.0305 
5 2010-06-01 -0.0517 -0.0598 -0.0140  -0.0774 -0.0206   0.0580  -0.0467  0.0236 
6 2010-07-01  0.0683  0.0726  0.109    0.0673  0.116   -0.00946  0.0940 -0.0509 
# ℹ 4 more variables: `Mkt-RF` <dbl>, SMB <dbl>, HML <dbl>, RF <dbl>

6. CAPM-Based Covariance Matrix & Optimal GMV Allocation

We isolate the training subset from 2010/02 to 2015/01 (60 months). Under the CAPM framework, the covariance matrix $\Sigma_{CAPM}$ of the 8-asset universe is modeled as:

\[\Sigma_{CAPM} = \beta \beta^T \sigma_m^2 + D\]

where $\beta$ represents the sensitivities to the market excess factor ($Mkt-RF$), $\sigma_m^2$ represents the variance of the market excess return, and $D$ represents the diagonal matrix containing the residual variances ($\sigma_{ei}^2$) of each asset’s regression model.

Using this structured matrix, we calculate the unrestricted Global Minimum Variance (GMV) weights for 2015/01:

\[w = \frac{\Sigma^{-1} \mathbf{1}}{\mathbf{1}^T \Sigma^{-1} \mathbf{1}}\]

We then apply these weights to evaluate our realized return in 2015/02.

# Filter training window
training_subset <- merged_portfolio_data %>%
  filter(date >= "2010-02-01" & date <= "2015-01-31")

asset_names <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
n_assets <- length(asset_names)

# Market Excess return variance
mkt_excess_ret <- training_subset$`Mkt-RF`
market_variance <- var(mkt_excess_ret)

# Linear regression for CAPM parameters
capm_betas <- numeric(n_assets)
capm_residuals <- numeric(n_assets)
names(capm_betas) <- asset_names
names(capm_residuals) <- asset_names

for (asset in asset_names) {
  excess_asset_ret <- training_subset[[asset]] - training_subset$RF
  capm_regression <- lm(excess_asset_ret ~ mkt_excess_ret)
  capm_betas[asset] <- coef(capm_regression)[2]
  capm_residuals[asset] <- var(residuals(capm_regression))
}

# Construct the structured CAPM Covariance Matrix
Sigma_CAPM <- (capm_betas %*% t(capm_betas)) * market_variance + diag(capm_residuals)
rownames(Sigma_CAPM) <- asset_names
colnames(Sigma_CAPM) <- asset_names

# Compute GMV optimal weights
ones_vector <- rep(1, n_assets)
inverse_Sigma_CAPM <- solve(Sigma_CAPM)
w_GMV_CAPM <- as.vector(inverse_Sigma_CAPM %*% ones_vector / 
                         as.numeric(t(ones_vector) %*% inverse_Sigma_CAPM %*% ones_vector))
names(w_GMV_CAPM) <- asset_names

# Calculate realized portfolio return in 2015/02
realized_month <- merged_portfolio_data %>% filter(date == "2015-02-01")
realized_returns_Feb15 <- as.numeric(realized_month[asset_names])
realized_ret_CAPM <- sum(w_GMV_CAPM * realized_returns_Feb15)

cat("--- CAPM-Based Allocation Analysis ---\n")

--- CAPM-Based Allocation Analysis ---

print(round(w_GMV_CAPM, 4))

    SPY     QQQ     EEM     IWM     EFA     TLT     IYR     GLD 
 0.7748 -0.0130 -0.0361 -0.2029 -0.0357  0.4131  0.0373  0.0626

cat("\nRealized Portfolio Return on 2015/02:", round(realized_ret_CAPM * 100, 4), "%\n")


Realized Portfolio Return on 2015/02: -0.334 %

7. Fama-French 3-Factor-Based Covariance Matrix & Optimal GMV Allocation

Under the multifactor Fama-French 3-factor setup, we regress each asset’s excess returns on the three factor portfolios:

\[R_{i,t} - R_{f,t} = \alpha_i + \beta_{i,1} F_{1,t} + \beta_{i,2} F_{2,t} + \beta_{i,3} F_{3,t} + e_{i,t}\]

The multifactor covariance matrix $\Sigma_{FF3}$ is expressed as:

\[\Sigma_{FF3} = B \Omega_F B^T + D\]

where $B$ is the $8 \times 3$ matrix of factor loadings, $\Omega_F$ is the $3 \times 3$ covariance matrix of the three factor portfolios ($Mkt-RF$, $SMB$, and $HML$), and $D$ is the diagonal matrix of specific residual variances.

We repeat the weights optimization and evaluate the realized performance on 2015/02.

# Compute the covariance of the three factors
factor_matrix <- training_subset %>% 
  select(`Mkt-RF`, SMB, HML) %>% 
  as.matrix()
Omega_Factors <- cov(factor_matrix)

# Run multifactor regressions
B_matrix <- matrix(0, nrow = n_assets, ncol = 3)
rownames(B_matrix) <- asset_names
colnames(B_matrix) <- c("Mkt-RF", "SMB", "HML")
ff3_residuals <- numeric(n_assets)
names(ff3_residuals) <- asset_names

for (asset in asset_names) {
  excess_asset_ret <- training_subset[[asset]] - training_subset$RF
  ff3_regression <- lm(excess_asset_ret ~ factor_matrix)
  B_matrix[asset, ] <- coef(ff3_regression)[2:4]
  ff3_residuals[asset] <- var(residuals(ff3_regression))
}

# Construct the structured Fama-French Covariance Matrix
Sigma_FF3 <- B_matrix %*% Omega_Factors %*% t(B_matrix) + diag(ff3_residuals)
rownames(Sigma_FF3) <- asset_names
colnames(Sigma_FF3) <- asset_names

# Compute GMV optimal weights
inverse_Sigma_FF3 <- solve(Sigma_FF3)
w_GMV_FF3 <- as.vector(inverse_Sigma_FF3 %*% ones_vector / 
                        as.numeric(t(ones_vector) %*% inverse_Sigma_FF3 %*% ones_vector))
names(w_GMV_FF3) <- asset_names

# Calculate realized portfolio return in 2015/02
realized_ret_FF3 <- sum(w_GMV_FF3 * realized_returns_Feb15)

cat("--- Fama-French 3-Factor-Based Allocation Analysis ---\n")

--- Fama-French 3-Factor-Based Allocation Analysis ---

print(round(w_GMV_FF3, 4))

    SPY     QQQ     EEM     IWM     EFA     TLT     IYR     GLD 
 0.8828 -0.1425 -0.0431 -0.1153 -0.1037  0.4159  0.0368  0.0691

cat("\nRealized Portfolio Return on 2015/02:", round(realized_ret_FF3 * 100, 4), "%\n")


Realized Portfolio Return on 2015/02: -0.6559 %

8. Portfolio Backtesting & Cumulative Return Performance

We implement a systematic, rolling-window backtest simulation over the entire historical window from 2015/02 to 2026/05. For each month $t$ within the evaluation period, we:

Isolate the preceding 60 months ($t-60$ to $t-1$) of historical data.
Estimate the structured covariance matrices ($\Sigma_{CAPM}$ and $\Sigma_{FF3}$).
Solve for the respective optimal GMV allocation weights.
Apply the weights to evaluate the realized portfolio returns in month $t$.
Compile and plot the cumulative performance of both strategies.

# Ensure the dataset dates are properly sequenced and sorted
chronological_dates <- sort(unique(merged_portfolio_data$date))

evaluation_start <- as.Date("2015-02-01")
evaluation_end <- as.Date("2026-05-01")

backtest_dates <- chronological_dates[chronological_dates >= evaluation_start & 
                                      chronological_dates <= evaluation_end]

# Pre-allocate vectors to store realized monthly returns
realized_returns_CAPM <- numeric(length(backtest_dates))
realized_returns_FF3 <- numeric(length(backtest_dates))

# Execute the rolling window portfolio backtest
for (i in seq_along(backtest_dates)) {
  current_date <- backtest_dates[i]
  current_index <- which(chronological_dates == current_date)
  
  # Set the 60-month training index window (t-60 to t-1)
  train_indexes <- (current_index - 60):(current_index - 1)
  rolling_train_set <- merged_portfolio_data[train_indexes, ]
  
  # --- CAPM Co-estimation Loop ---
  mkt_series <- rolling_train_set$`Mkt-RF`
  rolling_mkt_var <- var(mkt_series)
  rolling_betas <- numeric(n_assets)
  rolling_residuals <- numeric(n_assets)
  names(rolling_betas) <- asset_names
  names(rolling_residuals) <- asset_names # FIX: Set names to prevent unwanted size expansion
  
  for (asset in asset_names) {
    ex_ret <- rolling_train_set[[asset]] - rolling_train_set$RF
    fit_model <- lm(ex_ret ~ mkt_series)
    rolling_betas[asset] <- coef(fit_model)[2]
    rolling_residuals[asset] <- var(residuals(fit_model))
  }
  
  Sigma_C <- (rolling_betas %*% t(rolling_betas)) * rolling_mkt_var + diag(rolling_residuals)
  inv_Sigma_C <- solve(Sigma_C)
  w_C <- as.vector(inv_Sigma_C %*% ones_vector / as.numeric(t(ones_vector) %*% inv_Sigma_C %*% ones_vector))
  
  # --- Fama-French 3-Factor Co-estimation Loop ---
  rolling_factors <- rolling_train_set %>% select(`Mkt-RF`, SMB, HML) %>% as.matrix()
  rolling_omega_f <- cov(rolling_factors)
  rolling_B <- matrix(0, nrow = n_assets, ncol = 3)
  rownames(rolling_B) <- asset_names
  rolling_residuals_ff3 <- numeric(n_assets)
  names(rolling_residuals_ff3) <- asset_names
  
  for (asset in asset_names) {
    ex_ret <- rolling_train_set[[asset]] - rolling_train_set$RF
    fit_model_ff3 <- lm(ex_ret ~ rolling_factors)
    rolling_B[asset, ] <- coef(fit_model_ff3)[2:4]
    rolling_residuals_ff3[asset] <- var(residuals(fit_model_ff3))
  }
  
  Sigma_FF <- rolling_B %*% rolling_omega_f %*% t(rolling_B) + diag(rolling_residuals_ff3)
  inv_Sigma_FF <- solve(Sigma_FF)
  w_FF <- as.vector(inv_Sigma_FF %*% ones_vector / as.numeric(t(ones_vector) %*% inv_Sigma_FF %*% ones_vector))
  
  # --- Realized Returns Calculation ---
  actual_returns_t <- as.numeric(merged_portfolio_data[current_index, asset_names])
  realized_returns_CAPM[i] <- sum(w_C * actual_returns_t)
  realized_returns_FF3[i]  <- sum(w_FF * actual_returns_t)
}

# Consolidate backtest metrics and calculate cumulative wealth ratios
backtest_results <- tibble(
  Date = backtest_dates,
  CAPM_GMV = realized_returns_CAPM,
  FF3_GMV = realized_returns_FF3
) %>%
  mutate(
    CAPM_Cumulative = cumprod(1 + CAPM_GMV) - 1,
    FF3_Cumulative = cumprod(1 + FF3_GMV) - 1
  )

# Preview final performance metrics
tail(backtest_results)

# A tibble: 6 × 5
  Date       CAPM_GMV FF3_GMV CAPM_Cumulative FF3_Cumulative
  <date>        <dbl>   <dbl>           <dbl>          <dbl>
1 2025-11-01  0.0213   0.0220            1.18          0.575
2 2025-12-01  0.0145   0.0121            1.21          0.594
3 2026-01-01  0.0686   0.0710            1.37          0.707
4 2026-02-01  0.0667   0.0659            1.52          0.819
5 2026-03-01 -0.0842  -0.0818            1.31          0.670
6 2026-04-01  0.00753  0.0107            1.33          0.688

Visualization of Cumulative Returns Performance

# Transform to long format for clean ggplot2 visualization
plot_data <- backtest_results %>%
  select(Date, CAPM_Cumulative, FF3_Cumulative) %>%
  pivot_longer(cols = -Date, names_to = "Strategy", values_to = "CumulativeReturn") %>%
  mutate(Strategy = ifelse(Strategy == "CAPM_Cumulative", "CAPM GMV", "Fama-French 3-Factor GMV"))

ggplot(plot_data, aes(x = Date, y = CumulativeReturn, color = Strategy)) +
  geom_line(size = 1.2) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(
    title = "Historical Portfolio Backtest: GMV Model Performance Comparison",
    subtitle = "Rolling 60-Month Evaluation Window (2015/02 - 2026/05)",
    x = "Timeline",
    y = "Cumulative Return (%)",
    color = "Structured Strategy"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    legend.position = "top",
    plot.title = element_text(face = "bold", size = 15),
    panel.grid.minor = element_blank()
  )

Final eXAM

CHRIST

2026-06-10

Questions from textbook (60%):

Chapter 7

Question 1 A & B

Question 2

Question 3

Question 4

Question 10

Chapter 8

Question 1

Question 2

Question 3

Question 4

Question 5

Chapter 9

Question 8

Question 9

Question 10

Chapter 10

Question 13

Question 14

Question 15

Question 16

Questions using R codes (40%):

1. Import Data

2. Calculate Weekly and Monthly Returns

3. Convert Monthly Returns into Tibble Format

4. Download Fama-French 3 Factors Data

5. Merge Monthly Return Data

6. CAPM-Based Covariance Matrix & Optimal GMV Allocation

7. Fama-French 3-Factor-Based Covariance Matrix & Optimal GMV Allocation

8. Portfolio Backtesting & Cumulative Return Performance

Visualization of Cumulative Returns Performance