CAPM Beta 

market_returns_xts <- 
    getSymbols("SPY", 
               src = 'yahoo', 
               from = "2012-12-31", 
               to = "2017-12-31",
             auto.assign = TRUE, 
             warnings = FALSE) %>% 
    map(~Ad(get(.))) %>% 
    reduce(merge) %>%
    `colnames<-`("SPY") %>% 
    to.monthly(indexAt = "lastof", 
               OHLC = FALSE) %>% 
  Return.calculate(., 
                   method = "log") %>% 
  na.omit()
market_returns_tidy <-
  market_returns_xts %>% 
    tk_tbl(preserve_index = TRUE,
           rename_index = "date") %>% 
    na.omit() %>%
    select(date, returns = SPY)
portfolio_returns_tq_rebalanced_monthly %>% 
  mutate(market_returns = market_returns_tidy$returns) %>%
  head(3)
## # A tibble: 3 x 3
##   date         returns market_returns
##   <date>         <dbl>          <dbl>
## 1 2013-01-31  0.0308           0.0499
## 2 2013-02-28 -0.000870         0.0127
## 3 2013-03-31  0.0187           0.0373
cov(portfolio_returns_xts_rebalanced_monthly,
    market_returns_tidy$returns)/
  var(market_returns_tidy$returns)
##              [,1]
## returns 0.8916928
beta_assets <- 
  asset_returns_long %>% 
  nest(-asset)

beta_assets
## # A tibble: 5 x 2
##   asset data             
##   <chr> <list>           
## 1 SPY   <tibble [60 × 2]>
## 2 EFA   <tibble [60 × 2]>
## 3 IJS   <tibble [60 × 2]>
## 4 EEM   <tibble [60 × 2]>
## 5 AGG   <tibble [60 × 2]>
beta_assets <- 
  asset_returns_long %>% 
  nest(-asset) %>% 
  mutate(model = 
           map(data, ~ 
                lm(returns ~ market_returns_tidy$returns, 
                          data = .))) 

beta_assets
## # A tibble: 5 x 3
##   asset data              model   
##   <chr> <list>            <list>  
## 1 SPY   <tibble [60 × 2]> <S3: lm>
## 2 EFA   <tibble [60 × 2]> <S3: lm>
## 3 IJS   <tibble [60 × 2]> <S3: lm>
## 4 EEM   <tibble [60 × 2]> <S3: lm>
## 5 AGG   <tibble [60 × 2]> <S3: lm>
library(broom)
beta_assets <- 
  asset_returns_long %>% 
  nest(-asset) %>% 
  mutate(model = 
           map(data, ~ 
                 lm(returns ~ market_returns_tidy$returns, 
                    data = .))) %>%
  mutate(model = map(model, tidy))

beta_assets
## # A tibble: 5 x 3
##   asset data              model           
##   <chr> <list>            <list>          
## 1 SPY   <tibble [60 × 2]> <tibble [2 × 5]>
## 2 EFA   <tibble [60 × 2]> <tibble [2 × 5]>
## 3 IJS   <tibble [60 × 2]> <tibble [2 × 5]>
## 4 EEM   <tibble [60 × 2]> <tibble [2 × 5]>
## 5 AGG   <tibble [60 × 2]> <tibble [2 × 5]>
beta_assets <- 
  asset_returns_long %>% 
  nest(-asset) %>% 
  mutate(model = 
           map(data, ~ 
                 lm(returns ~ market_returns_tidy$returns, 
                    data = .))) %>%
  mutate(model = map(model, tidy)) %>% 
  unnest(model) %>% 
  mutate_if(is.numeric, funs(round(., 4)))

beta_assets
## # A tibble: 10 x 6
##    asset term                        estimate std.error statistic p.value
##    <chr> <chr>                          <dbl>     <dbl>     <dbl>   <dbl>
##  1 SPY   (Intercept)                   0        0       -2.78e+ 0  0.0073
##  2 SPY   market_returns_tidy$returns   1        0        1.53e+16  0     
##  3 EFA   (Intercept)                  -0.0055   0.00290 -1.89e+ 0  0.0632
##  4 EFA   market_returns_tidy$returns   0.941    0.0974   9.66e+ 0  0     
##  5 IJS   (Intercept)                  -0.0017   0.0036  -4.73e- 1  0.638 
##  6 IJS   market_returns_tidy$returns   1.12     0.122    9.19e+ 0  0     
##  7 EEM   (Intercept)                  -0.0084   0.00480 -1.74e+ 0  0.0863
##  8 EEM   market_returns_tidy$returns   0.919    0.162    5.67e+ 0  0     
##  9 AGG   (Intercept)                   0.0017   0.00120  1.40e+ 0  0.165 
## 10 AGG   market_returns_tidy$returns  -0.0109   0.0417  -2.61e- 1  0.795
beta_assets <- 
  asset_returns_long %>% 
  nest(-asset) %>% 
  mutate(model = 
           map(data, ~ 
                 lm(returns ~ market_returns_tidy$returns, 
                    data = .))) %>% 
  unnest(model %>% map(tidy)) %>% 
  filter(term != "(Intercept)") %>% 
  select(-term)

beta_assets
## # A tibble: 5 x 5
##   asset estimate std.error statistic  p.value
##   <chr>    <dbl>     <dbl>     <dbl>    <dbl>
## 1 SPY     1.      6.53e-17  1.53e+16 0.      
## 2 EFA     0.941   9.74e- 2  9.66e+ 0 1.08e-13
## 3 IJS     1.12    1.22e- 1  9.19e+ 0 6.47e-13
## 4 EEM     0.919   1.62e- 1  5.67e+ 0 4.81e- 7
## 5 AGG    -0.0109  4.17e- 2 -2.61e- 1 7.95e- 1
beta_assets %>% 
  select(asset, estimate) %>% 
  filter(asset == "SPY")
## # A tibble: 1 x 2
##   asset estimate
##   <chr>    <dbl>
## 1 SPY         1.
beta_byhand <- 
  w[1] * beta_assets$estimate[1] + 
  w[2] * beta_assets$estimate[2] + 
  w[3] * beta_assets$estimate[3] +
  w[4] * beta_assets$estimate[4] +
  w[5] * beta_assets$estimate[5]

beta_byhand
## [1] 0.8916928
beta_builtin_xts <- 
  CAPM.beta(portfolio_returns_xts_rebalanced_monthly, 
            market_returns_xts)
beta_builtin_xts
## [1] 0.8916928
beta_dplyr_byhand <-
  portfolio_returns_tq_rebalanced_monthly %>% 
  do(model = 
       lm(returns ~ market_returns_tidy$returns, 
          data = .)) %>% 
  tidy(model) %>% 
  mutate(term = c("alpha", "beta")) %>% 
  select(estimate)

beta_dplyr_byhand$estimate[2]
## [1] 0.8916928
beta_builtin_tq <- 
  portfolio_returns_tq_rebalanced_monthly %>% 
  mutate(market_return = 
           market_returns_tidy$returns) %>% 
  na.omit() %>% 
  tq_performance(Ra = returns, 
                 Rb = market_return, 
                 performance_fun = CAPM.beta) %>% 
  `colnames<-`("beta_tq")
beta_builtin_tq %>% 
  mutate(dplyr_beta = beta_dplyr_byhand$estimate[2],
         byhand_beta = beta_byhand,
         xts_beta = coredata(beta_builtin_xts)) %>% 
  round(3)
## # A tibble: 1 x 4
##   beta_tq dplyr_beta byhand_beta xts_beta
##     <dbl>      <dbl>       <dbl>    <dbl>
## 1   0.892      0.892       0.892    0.892
portfolio_returns_tq_rebalanced_monthly %>% 
  mutate(market_returns = 
           market_returns_tidy$returns) %>% 
  ggplot(aes(x = market_returns, 
             y = returns)) + 
  geom_point(color = "cornflowerblue") +
  ylab("portfolio returns") +
  xlab("market returns")
Scatter Portfolio v. Market

Figure 1: Scatter Portfolio v. Market 

portfolio_returns_tq_rebalanced_monthly %>% 
  mutate(market_returns = 
           market_returns_tidy$returns) %>% 
  ggplot(aes(x = market_returns,
             y = returns)) + 
  geom_point(color = "cornflowerblue") +
  geom_smooth(method = "lm", 
              se = FALSE, 
              color = "green") +
  ylab("portfolio returns") +
  xlab("market returns")
Scatter with Regression Line from ggplot

Figure 2: Scatter with Regression Line from ggplot 

portfolio_returns_tq_rebalanced_monthly %>% 
  mutate(market_returns = market_returns_tidy$returns) %>% 
  ggplot(aes(x = market_returns, y = returns)) + 
  geom_point(color = "cornflowerblue") +
  geom_abline(aes(
    intercept = beta_dplyr_byhand$estimate[1], 
    slope = beta_dplyr_byhand$estimate[2]), 
              color = "purple") +
  ylab("portfolio returns") +
  xlab("market returns")
Scatter with Regression Line from Beta Estimate

Figure 3: Scatter with Regression Line from Beta Estimate 

portfolio_returns_tq_rebalanced_monthly %>% 
  mutate(market_returns =
           market_returns_tidy$returns) %>% 
  ggplot(aes(x = market_returns, 
             y = returns)) + 
  geom_point(color = "cornflowerblue") +
  geom_abline(
    aes(intercept = 
          beta_dplyr_byhand$estimate[1], 
          slope = beta_dplyr_byhand$estimate[2]), 
              color = "purple") +
  geom_smooth(method = "lm", 
              se = FALSE, 
              color = "green") +
  ylab("portfolio returns") +
  xlab("market returns")
Scatter with Both Regression Lines

Figure 4: Scatter with Both Regression Lines 

portfolio_model_augmented <- 
portfolio_returns_tq_rebalanced_monthly %>% 
  do(model = 
       lm(returns ~ 
          market_returns_tidy$returns, data = .)) %>% 
  augment(model) %>% 
  rename(mkt_rtns = market_returns_tidy.returns) %>% 
  select(returns, mkt_rtns, .fitted) %>% 
  mutate(date = portfolio_returns_tq_rebalanced_monthly$date)

head(portfolio_model_augmented, 3)
## # A tibble: 3 x 4
##     returns mkt_rtns .fitted date      
##       <dbl>    <dbl>   <dbl> <date>    
## 1  0.0308     0.0499 0.0413  2013-01-31
## 2 -0.000870   0.0127 0.00810 2013-02-28
## 3  0.0187     0.0373 0.0300  2013-03-31
portfolio_model_augmented %>% 
  ggplot(aes(x = date)) + 
  geom_line(aes(y = returns), 
            color = "cornflowerblue") + 
  geom_line(aes(y = .fitted), 
            color = "green") +
  xlab("date")
Actual v. Fitted Returns

Figure 5: Actual v. Fitted Returns 

highchart() %>% 
  hc_title(text = "Portfolio v. Market Returns Scatter") %>%
  hc_add_series(portfolio_model_augmented, 
                type = "scatter",
                color = "cornflowerblue",
                hcaes(x = round(mkt_rtns, 4), 
                      y = round(returns, 4)), 
                name = "Returns") %>%
  hc_xAxis(title = list(text = "Market Returns")) %>% 
  hc_yAxis(title = list(text = "Portfolio Returns")) %>% 
  hc_add_theme(hc_theme_flat()) %>%
  hc_exporting(enabled = TRUE)
highchart() %>% 
  hc_title(text = "Portfolio v. Market Returns Scatter w/Date") %>%
  hc_add_series(portfolio_model_augmented, 
                type = "scatter",
                color = "cornflowerblue",
                hcaes(x = round(mkt_rtns, 4), 
                      y = round(returns, 4),
                      date = date), 
                name = "Returns") %>%
  hc_xAxis(title = list(text = "Market Returns")) %>% 
  hc_yAxis(title = list(text = "Portfolio Returns")) %>% 
  hc_tooltip(formatter = JS("function(){
    return ('port return: ' + this.y + ' <br> mkt return: ' + this.x +  
    ' <br> date: ' + this.point.date)}")) %>% 
  hc_add_theme(hc_theme_flat()) %>%
  hc_exporting(enabled = TRUE)
highchart() %>% 
  hc_title(text = "Scatter with Regression Line") %>% 
  hc_add_series(portfolio_model_augmented, 
                type = "scatter", 
                color = "cornflowerblue",
                hcaes(x = round(mkt_rtns, 4), 
                      y = round(returns, 4),
                      date = date), 
                name = "Returns") %>%
  hc_add_series(portfolio_model_augmented, 
                type = "line", 
                hcaes(x = mkt_rtns, y = .fitted), 
                name = "CAPM Beta = Regression Slope") %>% 
  hc_xAxis(title = list(text = "Market Returns")) %>% 
  hc_yAxis(title = list(text = "Portfolio Returns")) %>% 
  hc_tooltip(formatter = JS("function(){
     return ('port return: ' + this.y + ' <br> mkt return: ' + this.x +  
     ' <br> date: ' + this.point.date)}"))%>% 
  hc_add_theme(hc_theme_flat()) %>%
  hc_exporting(enabled = TRUE)
Share Comments capm · beta capm · beta