Evaluate Performance using the Capital Asset Pricing Model

Tidy Finance Webinar Series

Christoph Scheuch

Last webinar: modern portfolio theory

Markowitz (1952) introduced Modern Portfolio Theory (MPT)
Focus on diversification to minimize risk for a target return
Slides & recordings of previous & this webinar: talks.tidy-finance.org

Today: Capital Asset Pricing Model (CAPM)

Key questions:

What is the expected return of an asset?
Which portfolios should investors hold?

CAPM is an equilibrium model

Extends MPT by including systematic risk
Adds simplifying assumptions to model rational investors
Developed by: Sharpe (1964), Lintner (1965) & Mossin (1966)

The CAPM in a nutshell

Investors demand a compensation for risk

Expected Return = Risk-Free Rate + Compensation for Market Risk
Risk-Free Rate: return on an investment without risk
Market Risk: how much asset returns co-move with the overall market

Outline of this webinar

Calculate asset returns & volatility
Calculate risk-free asset & Sharpe ratio
Calculate the tangency portfolio
Plot the capital market line
Estimate asset betas
Evaluate asset performance with the CAPM

library(tidyverse)
library(tidyfinance)

symbols <- download_data(
  type = "constituents",
  index = "Dow Jones Industrial Average"
)

prices_daily <- download_data(
    type = "stock_prices", symbol = symbols$symbol,
    start_date = "2019-10-01", end_date = "2024-09-30"
) |> 
  select(symbol, date,  price = adjusted_close)

# A tibble: 37,710 × 3
   symbol date       price
   <chr>  <date>     <dbl>
 1 UNH    2019-10-01  202.
 2 UNH    2019-10-02  201.
 3 UNH    2019-10-03  200.
 4 UNH    2019-10-04  204.
 5 UNH    2019-10-07  206.
 6 UNH    2019-10-08  205.
 7 UNH    2019-10-09  206.
 8 UNH    2019-10-10  208.
 9 UNH    2019-10-11  206.
10 UNH    2019-10-14  205.
# ℹ 37,700 more rows

Calculate daily returns

Code
Data

returns_daily <- prices_daily |>
  group_by(symbol) |> 
  mutate(ret = price / lag(price) - 1) |>
  ungroup() |> 
  select(symbol, date, ret) |> 
  drop_na(ret) |> 
  arrange(symbol, date)

# A tibble: 37,680 × 3
   symbol date             ret
   <chr>  <date>         <dbl>
 1 AAPL   2019-10-02 -0.0251  
 2 AAPL   2019-10-03  0.00849 
 3 AAPL   2019-10-04  0.0280  
 4 AAPL   2019-10-07  0.000220
 5 AAPL   2019-10-08 -0.0117  
 6 AAPL   2019-10-09  0.0117  
 7 AAPL   2019-10-10  0.0135  
 8 AAPL   2019-10-11  0.0266  
 9 AAPL   2019-10-14 -0.00144 
10 AAPL   2019-10-15 -0.00233 
# ℹ 37,670 more rows

Plot risk & return

Code
Plot

assets <- returns_daily |> 
  group_by(symbol) |> 
  summarize(mu = mean(ret), 
            sigma = sd(ret))

fig_vola_return <- assets |> 
  ggplot(aes(x = sigma, y = mu)) +
  geom_point() + 
  ggrepel::geom_label_repel(data = assets |> filter(symbol %in% c("BA", "AAPL")),
                            aes(label = symbol)) +
  scale_x_continuous(labels = scales::percent) +
  scale_y_continuous(labels = scales::percent) + 
  labs(x = "Volatility", y = "Average return",
       title = "Average returns and volatilities of DOW index constituents",
       subtitle = "Points correspond to individual assets")

Does high risk bring high returns?

Boeing (BA) vs Apple (AAPL)

Company-specific events might affect stock prices
Examples: CEO resignation, product launch, earnings report
Idiosyncratic events don’t impact the overall market
This asset-specific risk can be eliminated through diversification

Focus on systematic risk that affects all assets in the market

Systematic vs idiosyncratic risk

Investors dislike risk

Different sources of risk

Systematic risk: all assets are exposed to it, cannot be diversified away
Idiosyncratic risk: unique to particular asset, can be diversified away

Portfolio return & variance

\(\text{Expected Portfolio Return} = \omega'\mu\)

\(\omega\): vector of asset weights
\(\mu\): vector of expected return of assets

\(\text{Portfolio Variance} = \omega' \Sigma \omega\)

\(\Sigma\): variance-covariance matrix

Introducing the risk-free asset

Allocate capital between risk-free asset & risky portfolio

\[\mu_c = c \omega'\mu + (1-c)r_f\]

\(\mu_{c}\): combined portfolio return
\(r_f\): return of risk-free asset (e.g. government bond)
\(c\) fraction of capital in risky portfolio

The Capital Allocation Line

Risk-free asset has 0 volatility

Portfolio risk \(\sigma_c\) is measured by volatility of risky asset
\(\sigma_c= c\sqrt{\omega' \Sigma \omega}\) \(\Rightarrow\) \(c = \frac{\sigma_c}{\sqrt{\omega' \Sigma \omega}}\)

Allows us to derive a Capital Allocation Line (CAL)

\[\mu_c = r_f +\sigma_c \frac{\omega'\mu-r_f}{\sqrt{\omega' \Sigma \omega}}\]

The Sharpe ratio

Slope of CAL is called Sharpe ratio

\[\text{Sharpe ratio} = \frac{\omega'\mu-r_f}{\sqrt{\omega' \Sigma \omega}}\]

Measures excess return per unit of risk
Higher ratio indicates more attractive risk-adjusted return

Calculate the risk-free rate

Code
Data

# 13-week T-bill rate (^IRX) is quoted in annualized percentage yields 
risk_free_daily <- download_data(
  type = "stock_prices", symbol = "^IRX", 
  start_date = "2019-10-01", end_date = "2024-09-30"
) |> 
  # Convert annualized to daily rates (252 trading days)
  mutate(
    risk_free = (1 + adjusted_close / 100)^(1 / 252) - 1
  ) |> 
  select(date, risk_free) |> 
  drop_na()

# A tibble: 1,257 × 2
   date       risk_free
   <date>         <dbl>
 1 2019-10-01 0.0000690
 2 2019-10-02 0.0000683
 3 2019-10-03 0.0000655
 4 2019-10-04 0.0000651
 5 2019-10-07 0.0000658
 6 2019-10-08 0.0000651
 7 2019-10-09 0.0000641
 8 2019-10-10 0.0000643
 9 2019-10-11 0.0000639
10 2019-10-14 0.0000637
# ℹ 1,247 more rows

Create example portfolios

Code
Data

mu <- assets$mu
sigma <- returns_daily |> 
  pivot_wider(names_from = symbol, values_from = ret)  |> 
  select(-date) |> 
  cov()

# Portfolio with equal weights
number_of_assets <- nrow(assets)
omega_ew <- rep(1 / number_of_assets, number_of_assets)

summary_ew <- tibble(
  mu = as.numeric(t(omega_ew) %*% mu),
  sigma = as.numeric(sqrt(t(omega_ew) %*% sigma %*% omega_ew)),
  type = "Equal-Weighted Portfolio"
)

# Portfolio with random weights
set.seed(1234)
omega_random <- runif(number_of_assets, -1, 1)
omega_random <- omega_random / sum(omega_random)

summary_random <- tibble(
  mu = as.numeric(t(omega_random) %*% mu),
  sigma = as.numeric(sqrt(t(omega_random) %*% sigma %*% omega_random)),
  type = "Randomly-Weighted Portfolio"
)

# Risk-free asset 
summary_risk_free <- tibble(
  mu =  mean(risk_free_daily$risk_free),
  sigma = 0,
  type = "Risk-Free Asset"
)

summaries <- bind_rows(assets, summary_ew, summary_random, summary_risk_free)

# A tibble: 3 × 4
  symbol        mu  sigma type                       
  <chr>      <dbl>  <dbl> <chr>                      
1 <NA>   0.000595  0.0128 Equal-Weighted Portfolio   
2 <NA>   0.00120   0.0218 Randomly-Weighted Portfolio
3 <NA>   0.0000901 0      Risk-Free Asset

Plot CALs

Code
Figure

calculate_sharpe_ratio <- function(mu, sigma, risk_free) {
  as.numeric(mu - risk_free) / sigma 
}

summaries <- summaries |> 
  mutate(
    sharpe_ratio = if_else(
      str_detect(type, "Portfolio"), 
      calculate_sharpe_ratio(mu, sigma, risk_free = summary_risk_free$mu),
      NA
    ),
    risk_free = summary_risk_free$mu
  )

fig_cal <- summaries |> 
  ggplot(aes(x = sigma, y = mu)) +
  geom_abline(aes(intercept = risk_free, slope = sharpe_ratio, color = type),
              linetype = "dashed", linewidth = 1) +
  geom_point(data = summaries |> filter(is.na(type))) +
  geom_point(data = summaries |> filter(!is.na(type)), shape = 4, size = 4) + 
  ggrepel::geom_label_repel(aes(label = type)) + 
  scale_x_continuous(labels = scales::percent) +
  scale_y_continuous(labels = scales::percent) + 
  labs(x = "Volatility", y = "Average return",
       title = "Average returns and volatilities of DOW index constituents with capital allocation lines",
       subtitle = "Points correspond to individual assets, crosses to portfolios")

The tangency portfolio

The portfolio that maximizes Sharpe ratio

\[\max_w \frac{\omega' \mu - r_f}{\sqrt{\omega' \Sigma \omega}}\] while staying fully invested

\[ \omega'\iota = 1\]

is called the tangency portfolio

Calculate the tangency portfolio

Analytic solution for tangency portfolio (see here)

\[\omega_{tan}=\frac{\Sigma^{-1}(\mu-r_f)}{\iota'\Sigma^{-1}(\mu-r_f)}\]

omega_tangency <- solve(sigma) %*% (mu - summary_risk_free$mu)
omega_tangency <- as.vector(omega_tangency / sum(omega_tangency))

summary_tangency <- tibble(
  mu = as.numeric(t(omega_tangency) %*% mu),
  sigma = as.numeric(sqrt(t(omega_tangency) %*% sigma %*% omega_tangency)),
  type = "Tangency Portfolio",
  sharpe_ratio = calculate_sharpe_ratio(mu, sigma, risk_free = summary_risk_free$mu),
  risk_free = summary_risk_free$mu
)

The Capital Market Line (CML)

Combination of risk-free asset & the tangency portfolio \(\omega_{tan}\)

\[\mu_{c} = r_f +\sigma_c \frac{\omega_{tan}'\mu-r_f}{\sqrt{\omega_{tan}' \Sigma \omega_{tan}}}\]

is called the Capital Market Line (CML)

CML describes best risk-return trade-off for portfolios that contain risk-free asset & tangency portfolio

Plot the CML

Code
Figure

summaries <- bind_rows(summaries, summary_tangency)

fig_cml <- summaries |> 
  ggplot(aes(x = sigma, y = mu)) +
  geom_abline(aes(intercept = risk_free, slope = sharpe_ratio, color = type),
              linetype = "dashed", linewidth = 1) +
  geom_point(data = summaries |> filter(is.na(type))) +
  geom_point(data = summaries |> filter(!is.na(type)), shape = 4, size = 4) + 
  ggrepel::geom_label_repel(aes(label = type)) + 
  scale_x_continuous(labels = scales::percent) +
  scale_y_continuous(labels = scales::percent) + 
  labs(x = "Volatility", y = "Average return",
       title = "Average returns and volatilities of DOW index constituents",
       subtitle = "Points correspond to individual assets, crosses to portfolios")

Portfolios vs individual assets

In the CAPM model:

Investors prefer to hold any portfolio on the CML over individual assets or any other portfolio
All rational investors hold the tangency portfolio
Return of an individual asset can be compared to efficient tangency weight
Risk of an asset is proportional to covariance with tangency portfolio weight

Expected excess returns vs tangency weights

Expected excess return of asset \(i\) is

\[\mu_i - r_f = \beta_i \cdot (\omega_{tan}'\mu - r_f)\]

where

\[\beta_i = \frac{\text{Cov}(r_i, \omega_{tan}r)}{\omega_{tan}' \Sigma \omega_{tan}}\]

is called the asset beta

Calculate excess returns

Code
Data

tangency_weights <- tibble(
  symbol = assets$symbol, 
  omega_tangency = omega_tangency
)

returns_tangency_daily <- returns_daily |> 
  left_join(tangency_weights, join_by(symbol)) |> 
  group_by(date) |> 
  summarize(mkt_ret = weighted.mean(ret, omega_tangency))

returns_excess_daily <- returns_daily |> 
  left_join(returns_tangency_daily, join_by(date)) |> 
  left_join(risk_free_daily, join_by(date)) |> 
  mutate(ret_excess = ret - risk_free,
         mkt_excess = mkt_ret - risk_free) |> 
  select(symbol, date, ret_excess, mkt_excess)

returns_excess_daily

# A tibble: 37,680 × 4
   symbol date       ret_excess mkt_excess
   <chr>  <date>          <dbl>      <dbl>
 1 AAPL   2019-10-02  -0.0251     -0.0381 
 2 AAPL   2019-10-03   0.00843    -0.0138 
 3 AAPL   2019-10-04   0.0280      0.0315 
 4 AAPL   2019-10-07   0.000154   -0.0258 
 5 AAPL   2019-10-08  -0.0118      0.0196 
 6 AAPL   2019-10-09   0.0117      0.0386 
 7 AAPL   2019-10-10   0.0134      0.0633 
 8 AAPL   2019-10-11   0.0265      0.0314 
 9 AAPL   2019-10-14  -0.00150     0.00594
10 AAPL   2019-10-15  -0.00240     0.0456 
# ℹ 37,670 more rows

Estimate asset betas

Code
Data

estimate_beta <- function(data) {
  fit <- lm("ret_excess ~ mkt_excess - 1", data = data)
  coefficients(fit)
}
  
beta_results <- returns_excess_daily |> 
  nest(data = -symbol) |> 
  mutate(beta = map_dbl(data, estimate_beta))

# A tibble: 30 × 3
   symbol data                    beta
   <chr>  <list>                 <dbl>
 1 AAPL   <tibble [1,256 × 3]>  0.234 
 2 AMGN   <tibble [1,256 × 3]>  0.107 
 3 AMZN   <tibble [1,256 × 3]>  0.145 
 4 AXP    <tibble [1,256 × 3]>  0.173 
 5 BA     <tibble [1,256 × 3]> -0.0487
 6 CAT    <tibble [1,256 × 3]>  0.212 
 7 CRM    <tibble [1,256 × 3]>  0.135 
 8 CSCO   <tibble [1,256 × 3]>  0.0503
 9 CVX    <tibble [1,256 × 3]>  0.0974
10 DIS    <tibble [1,256 × 3]> -0.0168
# ℹ 20 more rows

Plot asset betas

Code
Plot

fig_betas <- beta_results |> 
  ggplot(aes(x = beta, y = fct_reorder(symbol, beta))) +
  geom_col() +
  labs(x = "Estimated asset beta", y = "Symbol", 
       title = "Estimated asset betas based on the tangency portfolio for Dow Industrial Average constituents")

Asset returns vs systematic risk

Code
Plot

assets <- assets |> 
  mutate(mu_excess = mu - summary_risk_free$mu) |> 
  left_join(beta_results, join_by(symbol))
  
fig_betas_returns <- assets |> 
  ggplot(aes(x = beta, y = mu_excess)) + 
  geom_abline(intercept = 0, 
              slope = summary_tangency$mu - summary_risk_free$mu) + 
  geom_point() +
  ggrepel::geom_label_repel(data = assets |> filter(symbol %in% c("BA", "AAPL")),
                            aes(label = symbol)) + 
  scale_y_continuous(labels = scales::percent) + 
  labs(x = "Estimated asset beta", y = "Average return", 
       title = "Estimated CAPM-betas and average returns for Dow Industrial Average constituents")

How to estimate betas in practice?

Calculating the tangency portfolio can be cumbersome

What is the correct asset universe?
How to estimate \(\mu\) and \(\Sigma\) for many assets?

In the CAPM: market portfolio = tangency portfolio

Skip calculation of tangency portfolio weights
Use portfolios weighted by market capitalization

Assumptions behind CAPM

Equilibrium model in a single-period economy
No transaction costs or taxes
Risk-free borrowing and lending are available to all investors
Investors share homogeneous expectations
Investors maximize returns for limited level of risk

CAPM is a foundation for other models because of its simplicity

The Security Market Line (SML)

Expected return of asset \(i\) is

\[\mu_i = r_f + \beta_i \cdot (\mu_m - r_f)\]

where

\[\beta_i = \frac{\sigma_{im}}{\sigma_m^2}\]

\(\mu_m\): expected market returns
\(\sigma_{im}\): covariance of asset \(i\) with market
\(\sigma_m\): market volatility

Evaluate asset performance with the SML

Alpha is difference between actual excess return & expected return

\[\mu_i - r_f = \alpha_i + \beta_i \cdot (\mu_m - r_f)\]

Alpha is performance adjusted for market risk

Positive alpha: outperformance relative to market
Negative alpha: underperformance relative to market

Estimate asset alphas & beta

Regression model:

\[r_{i,t} - r_{f,t} = \hat{\alpha}_i + \hat{\beta}_i \cdot (r_{m,t} - r_{f,t} ) + \hat{\varepsilon}_{i,t} \]

\(r_{i,t}\): actual returns of asset \(i\) on day \(t\)
\(r_{m,t}\): actual market returns on day \(t\)

Download excess market returns

Code
Data

factors <- download_data(
  type = "factors_ff_5_2x3_daily", 
  start_date = "2019-10-01", end_date = "2024-09-30"
)

# A tibble: 1,238 × 3
   date       mkt_excess risk_free
   <date>          <dbl>     <dbl>
 1 2019-10-01    -0.0131   0.00007
 2 2019-10-02    -0.0173   0.00007
 3 2019-10-03     0.008    0.00007
 4 2019-10-04     0.0139   0.00007
 5 2019-10-07    -0.0041   0.00007
 6 2019-10-08    -0.0161   0.00007
 7 2019-10-09     0.0092   0.00007
 8 2019-10-10     0.0059   0.00007
 9 2019-10-11     0.0123   0.00007
10 2019-10-14    -0.0018   0.00007
# ℹ 1,228 more rows

Estimate alphas & betas

Code
Data

returns_excess_daily <- returns_daily |> 
  left_join(factors, join_by(date)) |> 
  mutate(ret_excess = ret - risk_free) |> 
  select(symbol, date, ret_excess, mkt_excess)

estimate_capm <- function(data) {
  fit <- lm("ret_excess ~ mkt_excess", data = data)
  tibble(
    coefficient = c("alpha", "beta"),
    estimate = coefficients(fit),
    t_statistic = summary(fit)$coefficients[, "t value"]
  )
}
  
capm_results <- returns_excess_daily |> 
  nest(data = -symbol) |> 
  mutate(capm = map(data, estimate_capm)) |> 
  unnest(capm)

# A tibble: 60 × 4
   symbol coefficient  estimate t_statistic
   <chr>  <chr>           <dbl>       <dbl>
 1 AAPL   alpha        0.000611       1.74 
 2 AAPL   beta         1.15          45.0  
 3 AMGN   alpha        0.000261       0.654
 4 AMGN   beta         0.600         20.8  
 5 AMZN   alpha        0.000130       0.269
 6 AMZN   beta         1.06          30.3  
 7 AXP    alpha        0.000163       0.343
 8 AXP    beta         1.27          36.8  
 9 BA     alpha       -0.00102       -1.41 
10 BA     beta         1.44          27.5  
# ℹ 50 more rows

Plot asset alphas

Code
Figure

fig_alpha <- capm_results |> 
  filter(coefficient == "alpha") |> 
  mutate(is_significant = abs(t_statistic) >= 1.96) |> 
  ggplot(aes(x = estimate, y = fct_reorder(symbol, estimate), fill = is_significant)) +
  geom_col() +
  scale_x_continuous(labels = scales::percent) + 
  labs(x = "Estimated asset alphas", y = "Symbol", fill = "Significant at 95%?",
       title = "Estimated CAPM alphas for Dow Industrial Average constituents")

Popular shortcomings of CAPM

Impossible to create universal measure for market
- Market definition might depend on context (e.g. S&P 500, DAX, TOPIX)
Beta might not be stable over time
- Company operations, leverage or competitive environment might change beta
Systematic risk might not be the only factor
- Poor empirical performance in explaining small-cap or high-growth returns
Many more: behavioral biases, heterogeneous preferences, liquidity, etc.

Alternatives & extensions

Fama-French 3-Factor model extends CAPM

Outperformance of small vs big companies (see tidy-finance.org)
Outperformance of high vs low value companies (see tidy-finance.org)

Fama-French 5-Factor model extends 3-factor model (see tidy-finance.org)

Outperformance of companies with robust vs weak operating profitability
Outperformance of companies with conservative vs aggressive investment

Many more: consumption CAPM, conditional CAPM, Carhart Four-Factor Model, Q-Factor Model & ivnestment CAPM

Key takeways

CAPM is an equilibrium model in a frictionless economy
Investors hold mix of market portfolio & risk-free asset
Expected return of a stock is a linear function of its beta
Beta is the sensitivity of a stock to market movements
Beta estimation via linear regression using historical data

Play around with alpha estimation using Alpha Estimator app

Next webinar: Analyze Companies using Financial Ratios