--- title: "Empirical Asset Pricing with FFdownload" output: rmarkdown::html_vignette: toc: true toc_depth: 3 vignette: > %\VignetteIndexEntry{Empirical Asset Pricing with FFdownload} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include=FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 8, fig.height = 5, warning = FALSE, message = FALSE ) ``` > **Note**: This vignette requires a network connection and downloads several > datasets from Kenneth French's data library (~5–10 seconds per dataset). This vignette demonstrates a complete empirical asset-pricing workflow using FFdownload. We cover four topics: 1. **Time-series tests** — Do CAPM or FF3 explain the 25 Size×BM portfolio returns? 2. **GRS test** — Joint test that all pricing errors are zero. 3. **Momentum** — Why the FF3 model is not the last word. 4. **Fama-MacBeth regressions** — Do factor betas price the cross-section? Estimated across 100 Size×BM portfolios under CAPM, FF3, FF4, and FF5. --- ## 1 Data ```{r libraries} library(FFdownload) library(dplyr) library(tidyr) library(purrr) library(ggplot2) ``` ### 1.1 Download We download everything in one call. `na_values` converts French's missing-value codes (−99, −999, −99.99) to `NA`; `return_data = TRUE` gives us the list directly without a separate `load()`. ```{r download, cache=TRUE} outd <- file.path(tempdir(), paste0("ffap_", format(Sys.time(), "%H%M%S"))) outf <- tempfile(fileext = ".RData") inputlist <- c( "25_Portfolios_5x5", "100_Portfolios_10x10", "F-F_Research_Data_Factors", "F-F_Research_Data_5_Factors_2x3", "F-F_Momentum_Factor" ) FFdata <- FFdownload( output_file = outf, tempd = outd, exclude_daily = TRUE, download = TRUE, download_only = FALSE, inputlist = inputlist, format = "tbl", na_values = c(-99, -999, -99.99), return_data = TRUE ) ``` ### 1.2 Extract factors The FF5 file contains all five factors and the risk-free rate. We use it as the single factor source (available from July 1963), then append the momentum factor. ```{r factors} # FF5 factors: Mkt.RF, SMB, HML, RMW, CMA, RF (start: Jul 1963) ff5_raw <- FFdata$`x_F-F_Research_Data_5_Factors_2x3`$monthly$Temp2 # FF3 factors back to Jul 1926 (for time-series tests) ff3_raw <- FFdata$`x_F-F_Research_Data_Factors`$monthly$Temp2 # Momentum factor mom_raw <- FFdata$`x_F-F_Momentum_Factor`$monthly$Temp2 # Combined factor table (full history where all factors are available) factors <- ff5_raw |> select(date, Mkt.RF, SMB, HML, RMW, CMA, RF) |> left_join(mom_raw |> select(date, Mom), by = "date") |> filter(!is.na(Mom)) # Mom starts Jan 1927; FF5 starts Jul 1963 → ~Jul 1963 # Factor table with FF3 history (no RMW/CMA/Mom) factors_ff3hist <- ff3_raw |> select(date, Mkt.RF, SMB, HML, RF) cat("Factor sample:", format(min(factors$date)), "to", format(max(factors$date)), "—", nrow(factors), "months\n") cat("FF3 history :", format(min(factors_ff3hist$date)), "to", format(max(factors_ff3hist$date)), "—", nrow(factors_ff3hist), "months\n") ``` ### 1.3 Extract test portfolios ```{r portfolios} # Helper: find the value-weighted returns sub-table by name pattern find_vw <- function(monthly_list) { nm <- names(monthly_list) vw_nm <- grep("value_weight", nm, ignore.case = TRUE, value = TRUE) if (length(vw_nm) == 0) stop("Cannot find value-weighted sub-table. Available: ", paste(nm, collapse = ", ")) monthly_list[[vw_nm[1]]] } # 25 portfolios pf25_vw <- find_vw(FFdata$x_25_Portfolios_5x5$monthly) pf25_cols <- setdiff(names(pf25_vw), "date") # 25 portfolio column names stopifnot(length(pf25_cols) == 25) # 100 portfolios pf100_vw <- find_vw(FFdata$x_100_Portfolios_10x10$monthly) pf100_cols <- setdiff(names(pf100_vw), "date") # 100 portfolio column names stopifnot(length(pf100_cols) == 100) cat("25-pf column names (first 6):", paste(head(pf25_cols, 6), collapse=", "), "\n") ``` ### 1.4 Build long panels ```{r panels} # Long panel for 25 portfolios — join with FF3 history pf25_long <- pf25_vw |> pivot_longer(-date, names_to = "portfolio", values_to = "ret") |> left_join(factors_ff3hist, by = "date") |> mutate( ret_excess = ret - RF, # Position-based size (S1=small → S5=large) and BM (B1=growth → B5=value) labels pf_pos = as.integer(factor(portfolio, levels = pf25_cols)), size_q = ceiling(pf_pos / 5), bm_q = ((pf_pos - 1) %% 5) + 1, size_lbl = factor(size_q, labels = c("Small","S2","S3","S4","Large")), bm_lbl = factor(bm_q, labels = c("Growth","B2","B3","B4","Value")) ) |> filter(!is.na(ret_excess), !is.na(Mkt.RF)) # Long panel for 100 portfolios — join with FF5+Mom (1963+) pf100_long <- pf100_vw |> pivot_longer(-date, names_to = "portfolio", values_to = "ret") |> left_join(factors, by = "date") |> mutate( ret_excess = ret - RF, pf_pos = as.integer(factor(portfolio, levels = pf100_cols)), size_q = ceiling(pf_pos / 10), bm_q = ((pf_pos - 1) %% 10) + 1 ) |> filter(!is.na(ret_excess), !is.na(Mom)) # FF5+Mom sample (Jul 1963+) cat("25-pf panel: ", nrow(pf25_long), "rows,", n_distinct(pf25_long$portfolio), "portfolios\n") cat("100-pf panel:", nrow(pf100_long), "rows,", n_distinct(pf100_long$portfolio), "portfolios\n") ``` --- ## 2 Time-Series Tests: 25 Size×BM Portfolios ### 2.1 CAPM: large and structured pricing errors ```{r ts_capm} ts_capm <- pf25_long |> nest_by(portfolio, size_q, bm_q, size_lbl, bm_lbl) |> mutate( fit = list(lm(ret_excess ~ Mkt.RF, data = data)), alpha = coef(fit)[["(Intercept)"]], alpha_se = summary(fit)$coefficients["(Intercept)", "Std. Error"], alpha_t = summary(fit)$coefficients["(Intercept)", "t value"], beta_mkt = coef(fit)[["Mkt.RF"]], r2 = summary(fit)$r.squared, n_obs = nrow(data) ) |> ungroup() |> select(-data, -fit) cat("CAPM — mean |alpha|:", round(mean(abs(ts_capm$alpha)), 3), "%/month\n") cat(" significant alphas (|t| > 2):", sum(abs(ts_capm$alpha_t) > 2), "of", nrow(ts_capm), "\n") ``` **CAPM alpha heat map** (% per month; red = positive alpha, blue = negative): ```{r plot_capm_alpha, fig.height=4} ggplot(ts_capm, aes(x = bm_lbl, y = size_lbl, fill = alpha)) + geom_tile(colour = "white", linewidth = 0.5) + geom_text(aes(label = sprintf("%.2f\n(%.1f)", alpha, alpha_t)), size = 2.8, lineheight = 0.9) + scale_fill_gradient2(low = "#4575b4", mid = "white", high = "#d73027", midpoint = 0, name = "α (%/mo)") + scale_x_discrete(position = "top") + labs(title = "CAPM Alphas — 25 Size×BM Portfolios", subtitle = "Cell: alpha (t-stat); sample: Jul 1926 – present", x = "Book-to-Market Quintile", y = "Size Quintile") + theme_minimal(base_size = 11) + theme(axis.text.x = element_text(angle = 0)) ``` The heat map shows a **value tilt** in CAPM alphas: portfolios in the highest BM quintile (value) tend to have positive alphas, while growth portfolios cluster near zero or negative. However, with the full sample stretching back to July 1926, the pattern is noisier than in the original Fama-French (1993) paper, which used only 1963–1991 data — a period when the size and value premia were particularly strong. CAPM cannot account for these premia, but statistical significance is limited: only `r sum(abs(ts_capm$alpha_t) > 2)` of 25 alphas clear the |t| > 2 threshold at conventional levels. ### 2.2 FF3: modest improvement over the full sample ```{r ts_ff3} ts_ff3 <- pf25_long |> nest_by(portfolio, size_q, bm_q, size_lbl, bm_lbl) |> mutate( fit = list(lm(ret_excess ~ Mkt.RF + SMB + HML, data = data)), alpha = coef(fit)[["(Intercept)"]], alpha_se = summary(fit)$coefficients["(Intercept)", "Std. Error"], alpha_t = summary(fit)$coefficients["(Intercept)", "t value"], b_mkt = coef(fit)[["Mkt.RF"]], b_smb = coef(fit)[["SMB"]], b_hml = coef(fit)[["HML"]], r2 = summary(fit)$r.squared ) |> ungroup() |> select(-data, -fit) cat("FF3 — mean |alpha|:", round(mean(abs(ts_ff3$alpha)), 3), "%/month\n") cat(" significant alphas (|t| > 2):", sum(abs(ts_ff3$alpha_t) > 2), "of", nrow(ts_ff3), "\n") ``` ```{r plot_ff3_alpha, fig.height=4} ggplot(ts_ff3, aes(x = bm_lbl, y = size_lbl, fill = alpha)) + geom_tile(colour = "white", linewidth = 0.5) + geom_text(aes(label = sprintf("%.2f\n(%.1f)", alpha, alpha_t)), size = 2.8, lineheight = 0.9) + scale_fill_gradient2(low = "#4575b4", mid = "white", high = "#d73027", midpoint = 0, name = "α (%/mo)") + scale_x_discrete(position = "top") + labs(title = "FF3 Alphas — 25 Size×BM Portfolios", subtitle = "Cell: alpha (t-stat); sample: Jul 1926 – present", x = "Book-to-Market Quintile", y = "Size Quintile") + theme_minimal(base_size = 11) ``` When run over the **full French library sample** (July 1926 to present), the FF3 improvement is more muted than the original 1993 paper suggests. Mean absolute alpha falls from `r round(mean(abs(ts_capm$alpha)), 3)` to `r round(mean(abs(ts_ff3$alpha)), 3)` %/month — a `r round((1 - mean(abs(ts_ff3$alpha)) / mean(abs(ts_capm$alpha))) * 100)`% reduction. Notably, the number of *statistically significant* alphas may increase rather than decrease under FF3: the three factors fit some portfolios well while exposing pricing errors in others that CAPM had masked by a higher residual variance. The **value premium has weakened substantially post-2004**, a well-documented phenomenon (Fama and French 2015; Hou, Xue and Zhang 2015), which attenuates FF3's advantage when the recent decades are included. ### 2.3 Side-by-side comparison ```{r plot_alpha_comparison} bind_rows( ts_capm |> mutate(model = "CAPM"), ts_ff3 |> mutate(model = "FF3") ) |> mutate( sig = ifelse(abs(alpha_t) > 2, "p < 0.05", "n.s."), label = paste0("S", size_q, "B", bm_q) ) |> ggplot(aes(x = reorder(label, bm_q + (size_q - 1) * 5), y = alpha, colour = model, shape = sig)) + geom_hline(yintercept = 0, linetype = "dashed", colour = "grey50") + geom_errorbar(aes(ymin = alpha - 2 * alpha_se, ymax = alpha + 2 * alpha_se), width = 0.3, alpha = 0.5) + geom_point(size = 2.5) + scale_colour_manual(values = c(CAPM = "#e41a1c", FF3 = "#377eb8")) + scale_shape_manual(values = c("p < 0.05" = 16, "n.s." = 1)) + labs(title = "Pricing Errors: CAPM vs FF3", subtitle = "Portfolios ordered by BM within size quintile; bars = ±2 SE", x = "Portfolio (S = size, B = book-to-market quintile)", y = "Alpha (%/month)", colour = "Model", shape = "") + theme_bw(base_size = 10) + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, size = 7)) ``` --- ## 3 GRS Test The **Gibbons, Ross and Shanken (1989)** test checks whether all N pricing errors are jointly zero. The statistic is: $$\text{GRS} = \frac{T - N - K}{N} \cdot \frac{\hat{\boldsymbol{\alpha}}'\hat{\boldsymbol{\Sigma}}^{-1}\hat{\boldsymbol{\alpha}}} {1 + \hat{\boldsymbol{\mu}}_f'\hat{\boldsymbol{\Omega}}_f^{-1}\hat{\boldsymbol{\mu}}_f} \;\sim\; F(N,\; T-N-K)$$ ```{r grs_function} grs_test <- function(returns_xmat, factors_xmat) { # returns_xmat : T × N matrix of excess portfolio returns (no NAs) # factors_xmat : T × K matrix of factor excess returns T <- nrow(returns_xmat); N <- ncol(returns_xmat); K <- ncol(factors_xmat) stopifnot(T > N + K + 1) # OLS: Y = X*B + E where X = [1 | factors] X <- cbind(1, factors_xmat) B <- solve(crossprod(X), crossprod(X, returns_xmat)) # (K+1) × N E <- returns_xmat - X %*% B # T × N residuals alpha <- B[1, ] # N intercepts # MLE residual covariance Sigma <- crossprod(E) / T # Factor Sharpe ratio squared mu_f <- colMeans(factors_xmat) Omega <- crossprod(scale(factors_xmat, center = TRUE, scale = FALSE)) / T sr2 <- as.numeric(t(mu_f) %*% solve(Omega) %*% mu_f) # GRS statistic grs_stat <- ((T - N - K) / N) * as.numeric(t(alpha) %*% solve(Sigma) %*% alpha) / (1 + sr2) p_val <- pf(grs_stat, df1 = N, df2 = T - N - K, lower.tail = FALSE) list(GRS = round(grs_stat, 3), p_value = round(p_val, 4), df1 = N, df2 = T - N - K, mean_abs_alpha = round(mean(abs(alpha)), 4)) } ``` ```{r grs_run} # Build wide matrices aligned to the same dates pf25_wide <- pf25_long |> select(date, portfolio, ret_excess) |> pivot_wider(names_from = portfolio, values_from = ret_excess) # Merge factors on same dates and drop any rows with NAs pf25_merged <- pf25_wide |> left_join(factors_ff3hist |> select(date, Mkt.RF, SMB, HML), by = "date") |> drop_na() ret_mat_25 <- as.matrix(pf25_merged[, pf25_cols]) capm_f_mat <- as.matrix(pf25_merged[, "Mkt.RF", drop = FALSE]) ff3_f_mat <- as.matrix(pf25_merged[, c("Mkt.RF","SMB","HML")]) grs_capm <- grs_test(ret_mat_25, capm_f_mat) grs_ff3 <- grs_test(ret_mat_25, ff3_f_mat) tibble( Model = c("CAPM", "FF3"), `GRS statistic` = c(grs_capm$GRS, grs_ff3$GRS), `p-value` = c(grs_capm$p_value, grs_ff3$p_value), `F(N, T-N-K)` = c(sprintf("F(%d,%d)", grs_capm$df1, grs_capm$df2), sprintf("F(%d,%d)", grs_ff3$df1, grs_ff3$df2)), `Mean |α| (%/mo)` = c(grs_capm$mean_abs_alpha, grs_ff3$mean_abs_alpha) ) |> knitr::kable(digits = 4, align = "lrrrr", caption = "GRS Test — 25 Size×BM Portfolios") ``` Both models are **strongly rejected** by the GRS test (both p-values ≈ 0). Over the full historical sample the two GRS statistics are close in magnitude (`r grs_capm$GRS` for CAPM vs `r grs_ff3$GRS` for FF3), reflecting the fact that the FF3 factors were constructed to price the **1963–1991** period. Extending the sample back to 1926 and forward to the present — where the value premium has weakened considerably — limits how much SMB and HML can reduce the joint pricing errors relative to CAPM. In shorter sub-samples aligned with the original paper, FF3 typically shows a much larger improvement. --- ## 4 Momentum: The Anomaly FF3 Cannot Explain The WML (Winners Minus Losers) factor from Carhart (1997) delivers a large positive return that CAPM and FF3 fail to explain. ```{r momentum} # WML time series wml <- mom_raw |> select(date, Mom) |> left_join(factors_ff3hist, by = "date") |> filter(!is.na(Mom), !is.na(Mkt.RF)) # Average WML return with t-statistic wml_mean <- mean(wml$Mom) wml_t <- t.test(wml$Mom)$statistic # CAPM alpha for WML fit_wml_capm <- lm(Mom ~ Mkt.RF, data = wml) # FF3 alpha for WML fit_wml_ff3 <- lm(Mom ~ Mkt.RF + SMB + HML, data = wml) mom_summary <- tibble( Measure = c("Mean WML return", "CAPM alpha", "FF3 alpha"), `Estimate (%/mo)` = c(wml_mean, coef(fit_wml_capm)["(Intercept)"], coef(fit_wml_ff3) ["(Intercept)"]), `t-statistic` = c(wml_t, summary(fit_wml_capm)$coef["(Intercept)", "t value"], summary(fit_wml_ff3) $coef["(Intercept)", "t value"]) ) knitr::kable(mom_summary, digits = 3, align = "lrr", caption = "Momentum (WML) — Mean Return and Pricing Errors") ``` ```{r momentum_plot, fig.height=4} # Rolling 5-year average WML return wml |> mutate(date_num = as.numeric(as.Date(date)), roll_mean = zoo::rollapply(Mom, width = 60, FUN = mean, fill = NA, align = "right")) |> ggplot(aes(x = as.Date(date))) + geom_col(aes(y = Mom), fill = "grey80", width = 20) + geom_line(aes(y = roll_mean), colour = "#e41a1c", linewidth = 1) + geom_hline(yintercept = 0, linetype = "dashed") + labs(title = "WML Momentum Factor", subtitle = "Bars = monthly return; red line = 60-month rolling average", x = NULL, y = "Return (%/month)") + theme_bw() ``` The FF3 alpha of WML is large and highly significant — the three-factor model has no mechanism to price momentum. This motivates the Carhart four-factor model and, later, the FF5 model (which also fails to explain momentum). --- ## 5 Fama-MacBeth Cross-Sectional Regressions The **Fama and MacBeth (1973)** approach tests whether factor betas are priced in the cross-section: **First pass** — for each portfolio $i$, estimate factor betas via full-sample time-series regression: $$r_{it} - r_{ft} = \alpha_i + \boldsymbol{\beta}_i'\mathbf{f}_t + \varepsilon_{it}$$ **Second pass** — each month $t$, regress cross-sectional excess returns on the estimated betas: $$r_{it} - r_{ft} = \lambda_{0t} + \boldsymbol{\lambda}_t'\hat{\boldsymbol{\beta}}_i + u_{it}$$ Average the monthly $\lambda_t$ estimates and compute **Newey-West standard errors** to account for serial correlation in the pricing errors. ### 5.1 Helper functions ```{r fmb_helpers} # Newey-West standard error for the mean of a time series nw_se <- function(x, lags = NULL) { x <- x[!is.na(x)] T <- length(x) if (is.null(lags)) lags <- floor(4 * (T / 100)^(2/9)) xd <- x - mean(x) v <- sum(xd^2) / T if (lags > 0) { for (l in seq_len(lags)) { v <- v + 2 * (1 - l / (lags + 1)) * sum(xd[(l+1):T] * xd[1:(T-l)]) / T } } sqrt(v / T) } # Full FMB procedure # returns_mat : T × N matrix of excess returns # factors_mat : T × K matrix of factors fmb <- function(returns_mat, factors_mat, factor_names = NULL) { T <- nrow(returns_mat); N <- ncol(returns_mat); K <- ncol(factors_mat) if (is.null(factor_names)) factor_names <- colnames(factors_mat) # ── First pass: full-sample OLS betas ─────────────────────────────────────── X_ts <- cbind(1, factors_mat) B_ts <- solve(crossprod(X_ts), crossprod(X_ts, returns_mat)) betas <- t(B_ts[-1, , drop = FALSE]) # N × K # ── Second pass: monthly cross-sectional regressions ──────────────────────── X_cs <- cbind(1, betas) # N × (K+1) gammas <- matrix(NA_real_, nrow = T, ncol = K + 1) for (t in seq_len(T)) { y_t <- returns_mat[t, ] ok <- !is.na(y_t) if (sum(ok) > K + 1) { gammas[t, ] <- lm.fit(X_cs[ok, , drop = FALSE], y_t[ok])$coefficients } } # ── Average lambdas + Newey-West t-stats ──────────────────────────────────── lambda_names <- c("Intercept", factor_names) lam_mean <- colMeans(gammas, na.rm = TRUE) lam_se <- apply(gammas, 2, nw_se) lam_t <- lam_mean / lam_se tibble( term = lambda_names, lambda = lam_mean, nw_se = lam_se, t_stat = lam_t, signif = case_when( abs(lam_t) > 3.29 ~ "***", abs(lam_t) > 2.58 ~ "**", abs(lam_t) > 1.96 ~ "*", TRUE ~ "" ) ) } ``` ### 5.2 Prepare 100-portfolio matrices ```{r fmb_data} # Wide matrices aligned to the same dates (FF5+Mom sample, Jul 1963+) pf100_wide <- pf100_long |> select(date, portfolio, ret_excess) |> pivot_wider(names_from = portfolio, values_from = ret_excess) pf100_merged <- pf100_wide |> left_join(factors, by = "date") |> drop_na() ret100 <- as.matrix(pf100_merged[, pf100_cols]) f_capm <- as.matrix(pf100_merged[, "Mkt.RF", drop = FALSE]) f_ff3 <- as.matrix(pf100_merged[, c("Mkt.RF","SMB","HML")]) f_ff4 <- as.matrix(pf100_merged[, c("Mkt.RF","SMB","HML","Mom")]) f_ff5 <- as.matrix(pf100_merged[, c("Mkt.RF","SMB","HML","RMW","CMA")]) cat("FMB sample:", format(min(pf100_merged$date)), "to", format(max(pf100_merged$date)), "—", nrow(pf100_merged), "months\n") cat("100 portfolios x", ncol(ret100), "columns (check: should be 100)\n") ``` ### 5.3 Run FMB for all four models ```{r fmb_run} res_capm <- fmb(ret100, f_capm, "Mkt.RF") res_ff3 <- fmb(ret100, f_ff3, c("Mkt.RF","SMB","HML")) res_ff4 <- fmb(ret100, f_ff4, c("Mkt.RF","SMB","HML","Mom")) res_ff5 <- fmb(ret100, f_ff5, c("Mkt.RF","SMB","HML","RMW","CMA")) ``` ### 5.4 Results ```{r fmb_table} # All factor names across all models all_terms <- c("Intercept","Mkt.RF","SMB","HML","Mom","RMW","CMA") fmt_col <- function(res, model_name) { res |> mutate(cell = sprintf("%.3f%s (%.2f)", lambda, signif, t_stat)) |> select(term, cell) |> right_join(tibble(term = all_terms), by = "term") |> mutate(cell = replace_na(cell, "\u2014")) |> rename(!!model_name := cell) } fmb_table <- fmt_col(res_capm, "CAPM") |> left_join(fmt_col(res_ff3, "FF3"), by = "term") |> left_join(fmt_col(res_ff4, "FF4"), by = "term") |> left_join(fmt_col(res_ff5, "FF5"), by = "term") |> rename(Factor = term) knitr::kable(fmb_table, align = "lcccc", caption = paste( "Fama-MacBeth Results — 100 Size x BM Portfolios.", "Entries: lambda estimate (significance stars) (NW t-stat).", "*, **, *** = |t| > 1.96, 2.58, 3.29.")) ``` ```{r fmb_plot, fig.height=5} # Lambda point estimates with 95% NW confidence intervals bind_rows( res_capm |> mutate(model = "CAPM"), res_ff3 |> mutate(model = "FF3"), res_ff4 |> mutate(model = "FF4 (Carhart)"), res_ff5 |> mutate(model = "FF5") ) |> filter(term != "Intercept") |> mutate( lo = lambda - 1.96 * nw_se, hi = lambda + 1.96 * nw_se, term = factor(term, levels = c("Mkt.RF","SMB","HML","Mom","RMW","CMA")), model = factor(model, levels = c("CAPM","FF3","FF4 (Carhart)","FF5")) ) |> ggplot(aes(x = term, y = lambda, colour = model, ymin = lo, ymax = hi)) + geom_hline(yintercept = 0, linetype = "dashed", colour = "grey50") + geom_errorbar(position = position_dodge(width = 0.5), width = 0.25, alpha = 0.7) + geom_point(position = position_dodge(width = 0.5), size = 3) + scale_colour_brewer(palette = "Set1") + labs(title = "FMB Risk Prices λ — 100 Size×BM Portfolios", subtitle = "Point = NW mean; bars = 95% NW confidence interval", x = "Factor", y = "Risk price λ (%/month)", colour = "Model") + theme_bw() ``` ### 5.5 Interpretation The FMB results with the **current full-history data** reveal both the classic findings and their modern limitations: - **CAPM**: The market beta price ($\lambda_{\text{Mkt}}$) is negative and statistically insignificant, while the intercept is significantly positive. A priced factor should have $\lambda \approx$ mean factor return and intercept $\approx 0$; the CAPM fails both conditions — consistent with Fama and MacBeth (1973) and all subsequent replications. - **FF3**: HML retains a borderline-significant positive price of risk, but **SMB's risk price is statistically indistinguishable from zero** in the current sample. The size premium largely disappeared after the 1980s (Hou, Xue and Zhang 2015; Fama and French 2015). This is a known post-publication result: the cross-sectional power of SMB has declined sharply when using data after 1990. - **FF4 (Carhart)**: Momentum contributes additional cross-sectional explanatory power; its price of risk is consistent in sign with the large time-series WML premium documented in Section 4. - **FF5**: RMW (profitability) carries the most robust positive risk price among the new factors — consistent with Fama and French (2015, 2016). CMA's estimate is positive but less precise. As FF (2015) argue, HML becomes partially redundant once RMW and CMA are included, which is visible in a smaller HML coefficient relative to the FF3 model. --- ## 6 Summary | Test | CAPM | FF3 | FF4 | FF5 | |---|---|---|---|---| | Mean \|α\| (25 pf, %/mo) | `r round(grs_capm$mean_abs_alpha,3)` | `r round(grs_ff3$mean_abs_alpha,3)` | — | — | | GRS statistic (25 pf) | `r grs_capm$GRS` | `r grs_ff3$GRS` | — | — | | GRS p-value (25 pf) | `r grs_capm$p_value` | `r grs_ff3$p_value` | — | — | | WML mean return significant? | Yes | Yes | Yes | Yes | | WML alpha significant? | Yes | Yes | By construction | — | | SMB priced in FMB? | N/A | Weak/No | Weak/No | Weak/No | | HML priced in FMB? | N/A | Borderline | Borderline | Attenuated | | RMW priced in FMB? | N/A | N/A | N/A | Yes | | Mom priced in FMB? | N/A | N/A | Yes | N/A | The 25 Size×BM portfolios present a severe challenge to the CAPM; both CAPM and FF3 are rejected by the GRS test. However, with French's data now spanning **`r format(min(factors_ff3hist$date))` to `r format(max(factors_ff3hist$date))`**, the FF3 improvement over CAPM is more modest than in the original 1993 paper. The value and size premia have weakened substantially since the mid-2000s — a textbook example of **post-publication factor decay**. Momentum remains a robust anomaly unexplained by CAPM or FF3. In the FMB cross-section, RMW (profitability) is the most reliably priced factor in the current sample, while SMB's risk price is statistically negligible.