Steps 1-4: Rebuild the Portfolio

symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")

prices <- tq_get(
  x    = symbols,
  get  = "stock.prices",
  from = "2012-12-01",
  to   = "2018-01-01"
)

asset_returns_tbl <- prices %>%
  group_by(symbol) %>%
  tq_transmute(
    select     = adjusted,
    mutate_fun = periodReturn,
    period     = "monthly",
    type       = "log"
  ) %>%
  slice(-1) %>%
  ungroup() %>%
  set_names(c("asset", "date", "returns"))

symbols_vec <- asset_returns_tbl %>%
  distinct(asset) %>%
  pull()

weights <- c(0.25, 0.25, 0.20, 0.20, 0.10)

w_tbl <- tibble(symbols_vec, weights) %>%
  set_names(c("asset", "weights"))

portfolio_returns_tbl <- asset_returns_tbl %>%
  tq_portfolio(
    assets_col   = asset,
    returns_col  = returns,
    weights      = w_tbl,
    col_rename   = "returns",
    rebalance_on = "months"
  )
## Warning in check_weights(weights, assets_col, map, x): Sum of weights does not
## equal 1.

Step 5: Calculate Capital Asset Pricing Model Beta

5.1 Get Market Returns

We use SPY (the S&P 500 index) as the market. This is the same code as Step 2, but there is no group_by() because there is only one asset (the market), and we rename the column to the more general name returns.

market_returns_tbl <- tq_get(
  x    = "SPY",
  get  = "stock.prices",
  from = "2012-12-01",
  to   = "2018-01-01"
) %>%
  tq_transmute(
    select     = adjusted,
    mutate_fun = periodReturn,
    period     = "monthly",
    type       = "log"
  ) %>%
  slice(-1) %>%
  rename(returns = monthly.returns)

market_returns_tbl
## # A tibble: 60 × 2
##    date       returns
##    <date>       <dbl>
##  1 2013-01-31  0.0499
##  2 2013-02-28  0.0127
##  3 2013-03-28  0.0373
##  4 2013-04-30  0.0190
##  5 2013-05-31  0.0233
##  6 2013-06-28 -0.0134
##  7 2013-07-31  0.0504
##  8 2013-08-30 -0.0305
##  9 2013-09-30  0.0312
## 10 2013-10-31  0.0453
## # ℹ 50 more rows

Both tables should have 60 rows starting January 2013 so they can be joined.

5.2 Join Returns

left_join() matches the two tables on their common key, date. Because both tables have a column called returns, we rename the columns so we can tell them apart.

portfolio_market_returns_tbl <- left_join(
  market_returns_tbl,
  portfolio_returns_tbl,
  by = "date"
) %>%
  set_names(c("date", "market_returns", "portfolio_returns"))

portfolio_market_returns_tbl
## # A tibble: 60 × 3
##    date       market_returns portfolio_returns
##    <date>              <dbl>             <dbl>
##  1 2013-01-31         0.0499           0.0204 
##  2 2013-02-28         0.0127          -0.00239
##  3 2013-03-28         0.0373           0.0121 
##  4 2013-04-30         0.0190           0.0174 
##  5 2013-05-31         0.0233          -0.0128 
##  6 2013-06-28        -0.0134          -0.0247 
##  7 2013-07-31         0.0504           0.0321 
##  8 2013-08-30        -0.0305          -0.0224 
##  9 2013-09-30         0.0312           0.0511 
## 10 2013-10-31         0.0453           0.0301 
## # ℹ 50 more rows

5.3 Calculate the CAPM Beta Coefficient

tq_performance() takes the portfolio returns (Ra) and the baseline market returns (Rb). To see every available metric, run tq_performance_fun_options() in the console. The CAPM beta is CAPM.beta.

portfolio_market_returns_tbl %>%
  tq_performance(
    Ra              = portfolio_returns,
    Rb              = market_returns,
    performance_fun = CAPM.beta
  )
## # A tibble: 1 × 1
##   CAPM.beta.1
##         <dbl>
## 1       0.738

A beta below 1 means the portfolio is less volatile than the market (here, the S&P 500).

Step 6: Plot

Scatterplot of Returns with Regression Line

CAPM is a simple linear regression, so the regression line uses method = "lm". The confidence band is removed with se = FALSE.

portfolio_market_returns_tbl %>%
  ggplot(aes(x = market_returns, y = portfolio_returns)) +
  geom_point(color = "cornflowerblue") +
  geom_smooth(
    method    = "lm",
    se        = FALSE,
    linewidth = 1.5,
    color     = tidyquant::palette_light()[[3]]
  ) +
  labs(x = "market returns", y = "portfolio returns")
## `geom_smooth()` using formula = 'y ~ x'

The relationship is very close to linear. That is not surprising because SPY is one of the five assets in the portfolio (25% weight).

Line Plot of Actual and Fitted Returns

Step 1 is to transform the data. We run the regression with lm(), use broom::augment() to get the fitted (predicted) values, add the date column back, and then pivot_longer() so there is one type column (actual vs. fitted) and one returns column.

# What the regression looks like (the market_returns coefficient is the beta)
portfolio_market_returns_tbl %>%
  lm(portfolio_returns ~ market_returns, data = .)
## 
## Call:
## lm(formula = portfolio_returns ~ market_returns, data = .)
## 
## Coefficients:
##    (Intercept)  market_returns  
##      -0.003064        0.738393
actual_fitted_long_tbl <- portfolio_market_returns_tbl %>%
  lm(portfolio_returns ~ market_returns, data = .) %>%
  augment() %>%
  mutate(date = portfolio_market_returns_tbl$date) %>%
  select(date, portfolio_returns, .fitted) %>%
  pivot_longer(
    cols      = c(portfolio_returns, .fitted),
    names_to  = "type",
    values_to = "returns"
  )

actual_fitted_long_tbl
## # A tibble: 120 × 3
##    date       type               returns
##    <date>     <chr>                <dbl>
##  1 2013-01-31 portfolio_returns  0.0204 
##  2 2013-01-31 .fitted            0.0338 
##  3 2013-02-28 portfolio_returns -0.00239
##  4 2013-02-28 .fitted            0.00630
##  5 2013-03-28 portfolio_returns  0.0121 
##  6 2013-03-28 .fitted            0.0245 
##  7 2013-04-30 portfolio_returns  0.0174 
##  8 2013-04-30 .fitted            0.0110 
##  9 2013-05-31 portfolio_returns -0.0128 
## 10 2013-05-31 .fitted            0.0142 
## # ℹ 110 more rows

Step 2 is to make the plot. type is mapped to color, which gives two lines.

actual_fitted_long_tbl %>%
  ggplot(aes(x = date, y = returns, color = type)) +
  geom_line() +
  labs(x = "", y = "returns")

The linear model tracks the actual portfolio returns well, but the actual returns are more volatile: the spikes go higher and lower than the predicted returns.

Optional: Calculate CAPM Beta by Asset

This section is optional (it is the extra video). It uses map() from the purrr package (part of the tidyverse) to loop the same regression over each asset. It reuses asset_returns_tbl and market_returns_tbl from above. Note that the market is SPY, so the market’s own beta is 1.

asset_beta_tbl <- asset_returns_tbl %>%
  # nest: one row per asset, with that asset's date and returns in `data`
  nest(data = c(date, returns)) %>%
  # loop: regress each asset's returns on the market returns
  mutate(model = map(data, ~ lm(returns ~ market_returns_tbl$returns, data = .x))) %>%
  # extract the coefficients from each model
  mutate(model = map(model, tidy)) %>%
  select(-data) %>%
  unnest(model) %>%
  # keep only the market coefficient (the beta), not the intercept
  filter(term != "(Intercept)")

asset_beta_tbl
## # A tibble: 5 × 6
##   asset term                       estimate  std.error  statistic   p.value
##   <chr> <chr>                         <dbl>      <dbl>      <dbl>     <dbl>
## 1 AGG   market_returns_tbl$returns  -0.0122 0.0415         -0.294 7.70e-  1
## 2 EEM   market_returns_tbl$returns   0.917  0.162           5.65  5.05e-  7
## 3 EFA   market_returns_tbl$returns   0.942  0.0974          9.67  1.06e- 13
## 4 IJS   market_returns_tbl$returns   1.12   0.122           9.19  6.56e- 13
## 5 SPY   market_returns_tbl$returns   1.000  0.00000153 652345.    8.28e-288
asset_beta_tbl %>%
  ggplot(aes(x = estimate, y = reorder(asset, estimate), fill = asset)) +
  geom_col() +
  scale_fill_tq() +
  theme_tq() +
  theme(legend.position = "none") +
  labs(x = "beta coefficient", y = "",
       title = "Beta Coefficient by Asset")