1 Functions

Tying the value of the S&P500 to its cashflows, growth and risk.

1.1 Packages

library(knitr)
library(kableExtra)
library(dplyr)
library(purrr)
library(tidyr)
library(lubridate)

1.2 Utils

check.length.list.f <- function(x) length(x) > 1

check.nested.list.f <- function(l) {
  if (!is.list(l)) stop("Not a list.")
  !identical(unlist(l, FALSE), unlist(l))  
}

1.3 Fair Value

fair.value.index.f <- function(inputs){
# Written by Rafael Nicolas Fermin Cota 
# Created on Feb 28, 2020
# Reference: https://papers.ssrn.com/sol3/papers.cfm?abstract_id=3378246
  
  # - index_value: current level of the index
  # - earnings_base: trailing 12-month earnings (reported)
  # - dividends_buybacks_base: cash return as % of earnings
  # - earnings_growth: forecast of earnings growth from analysts following stocks in the index.
  # - risk_free: current rate on a long term government bond.
  # - risk_premium: ERP used to compute fair value of index (expected risk premium for investing in stock)
  
  # - earnings_growth_lt: expected growth rate in the long term (after year N): if NA, it will set 
  # this equal to the treasury bond rate.
  
  # - trailing_roe: trailing ROE (four quarters). If NA, it will leave cash_payout at today's value. 
  # Otherwise, it will adjust the payout ratio to sustainable levels in year N (over the next N years in 
  # linear increments to this value.)

  for (j in 1:length(inputs)) assign(names(inputs)[j], inputs[[j]])
  if (is.na(earnings_growth_lt)) earnings_growth_lt=risk_free

  n = length(earnings_growth)
  if (n == 1) {
    earnings_growth=rep(earnings_growth, 5)
    n = length(earnings_growth)
  } else {
    
  }
  cash_returns=dividends_buybacks_base/earnings_base # cash return as % of earnings
  
  period=c(0:n, "TV")
  earnings=earnings_base*cumprod(c(1, 1 + earnings_growth))
  earnings=c(earnings, earnings[n+1]*(1+earnings_growth_lt))
  
  if (!is.na(trailing_roe)){ # The sustainable payout is computed using the stable 
    # growth rate and the trailing 12 month ROE: Sustainable Payout = 1 - g/ ROE
    # If not NA, it will adjust the payout ratio over the next N years in 
    # linear increments to this value. if no, it will leave it at today's value.

    # Cash return as percent of earnings
    cash_returns_tv=1-earnings_growth_lt/trailing_roe
    cash_returns_adj=(cash_returns - cash_returns_tv)/n

    cash_payout=purrr::accumulate(
      .x=rep(cash_returns, n), 
      .f=function(prv,nxt) prv - cash_returns_adj, 
      .init=cash_returns
    )
    # Expected cash payout (dividends + buybacks) as % of earnings
    cash_payout=c(cash_payout, cash_returns_tv)
  } else {
    cash_returns_tv=cash_returns # leave it at today's value
    cash_payout=c(rep(cash_returns, n+1), cash_returns_tv)
  }
  
  dividends_buybacks=earnings*cash_payout
  tv=dividends_buybacks[n+2]/(risk_free+risk_premium-earnings_growth_lt)
  present_value=c(0, (dividends_buybacks[2:(n+1)]+c(rep(0, n-1), tv))*1/(1+risk_free+risk_premium)^(1:n),0)
  fair_value=sum(present_value)
  
  
  list(
    expected_earnings=earnings[2], 
    fair_value=fair_value, 
    percent_under_over_value=index_value/fair_value-1/index_value-1,
    calculations=tibble(period, earnings, cash_payout, dividends_buybacks, present_value)
  )   

}

fair.value.index.report <- function(data){
  if (!check.nested.list.f(data)) data <- list(data) 
  map_dfr(data, function(m) {
    m  %>% 
      modify_if(check.length.list.f, list) %>%  map_dfr(~.x, .id = "model") %>%
      pmap_dfr(function(...) {
        l <- list(...)
        # m <- l %>% erp.solver
        # l <- l %>% list_modify(risk_premium=m$risk_premium)
        m <- l %>% fair.value.index.f
        m <- m %>% modify_if(check.length.list.f, list)
        # m$calculations <- NULL
        l %>% 
          modify_if(check.length.list.f, list) %>%
          bind_cols(m)
      })
  }, 
  .id = "period"
  )
}

1.4 Equity Risk Premium Solver

erp.solver <- function(inputs){
  rss <- function(x) {
    params <- purrr::list_modify(inputs, risk_premium=x)
    optim <- fair.value.index.f(params)
    abs(inputs$index_value-optim$fair_value)^2
  }
  opt <- optim(
    c(0.01), 
    rss, 
    method = "Brent",
    lower = c(0.01), 
    upper = c(0.1)
  ) # optimize with some sensible conditions
  # opt$message
  params <- setNames(opt$par, c("risk_premium"))
  return(list(risk_premium=params[[1]], err=rss(params)))
}

2 Assumptions

⁃ Earnings will drop between 20% and 30%. Between 25% and 50% will be recouped.

⁃ Companies will scale the percent of the earnings that they return to stockholders from the 92% that they were returning prior to the coronavirus to 80%, which is below the ten-year average of 85%.

⁃ Regarding the discount rate dynamics, I assumed rates between 0-0.5%, and a risk premium (as captured in the rise in the VIX) between 5.5-6.5%.

n=5
earnings_base=163 #  trailing 12-month earnings (reported)
post_index_value=2711.02 # March 13, 2020
post_base_dividends_buybacks=earnings_base*0.80 # cash return as percent of earnings

# See http://aswathdamodaran.blogspot.com/2020/02/a-viral-market-meltdown-fear-or.html
pre_earnings_growth_1=0.0552
pre_earnings_growth_n=0.0336
pre_earnings_growth_v=c(
  pre_earnings_growth_1, 
  rep(pre_earnings_growth_n, n-1)
)

post_earnings_growth_1=-0.2 # Expected growth rate in earnings next year
earnings_recouped=0.5


post.earnings.growth.f <- function(
  earnings_base, 
  pre_earnings_growth_1, 
  pre_earnings_growth_n,
  post_earnings_growth_1,
  earnings_recouped, 
  n
){
  # earnings_recouped=0.5 # Percentage of 2020 lost earnngs recouped by 2025
  pre_earnings_expected_n = earnings_base*(1+pre_earnings_growth_1)*(1+pre_earnings_growth_n)^(n-1)
  post_earnings_expected_1 = earnings_base*(1+post_earnings_growth_1)
  post.earnings.growth.f = (
    (
      earnings_base*(1+post_earnings_growth_1)*(1+pre_earnings_growth_n)^n+
        (pre_earnings_expected_n-earnings_base*(1+post_earnings_growth_1)*
           (1+pre_earnings_growth_n)^n)*earnings_recouped
    )/post_earnings_expected_1
  )^(1/(n-1))-1
}


post_earnings_growth_n=post.earnings.growth.f(
  earnings_base, pre_earnings_growth_1, pre_earnings_growth_n,
  post_earnings_growth_1, earnings_recouped, n
)
post_earnings_growth_v=c(post_earnings_growth_1, rep(post_earnings_growth_n, n-1))

post_risk_free=0.0077 # current rate on a long term government bond.
post_risk_premium=list( # march_2020
  index_value=2711.02, # March 13, 2020
  earnings_base=163, #  trailing 12-month earnings (reported)
  dividends_buybacks_base=150.504357469543, # = 0.9233396 * 163 # cash return as % of earnings
  earnings_growth=0.0336206957026053, # forecast of earnings growth from analysts following 
  # stocks in the index.
  risk_free=0.0113, # current rate on a long term government bond.
  risk_premium=0.05578, # ERP used to compute fair value of index (expected 
  # risk premium for investing in stock)
  earnings_growth_lt=NA, # expected growth rate in the long term (after year N): 
  # if NA, it will set this equal to the treasury bond rate.
  trailing_roe=NA # # Trailing ROE (four quarters): # If NA, it will leave 
  #cash_payout at today's value. Otherwise, it will adjust the payout ratio to 
  # sustainable levels in year N (over the next N years in linear increments to this value.)
) %>% 
  erp.solver %>% 
  pluck("risk_premium") %>%
  round(4)

inputs <- list(
  index_value=post_index_value, # current level of the index
  earnings_base=earnings_base, #  trailing 12-month earnings (reported)
  dividends_buybacks_base=post_base_dividends_buybacks, # cash return as % of earnings
  earnings_growth=post_earnings_growth_v, # forecast of earnings growth from 
  # analysts following stocks in the index.
  risk_free=post_risk_free, # current rate on a long term government bond.
  risk_premium=post_risk_premium, # ERP used to compute fair value of index 
  # (expected risk premium for investing in stock)
  earnings_growth_lt=NA,
  trailing_roe=0.15
)

3 Valuation

I computed the fair value of the S&P 500 (which stood at 2711 as of March 13th) as a function of the biggest uncertainties: the effect that the coronavirus will have on earnings in 2020, the percentage that will be recouped by 2025, the percent that will be returned as cash flows and the equity risk premium.

output <- inputs %>%
  modify_if(check.length.list.f, list) %>%
  list_modify(risk_premium=NULL, risk_free=NULL) %>%
  bind_rows %>%
  expand_grid(
    post_earnings_growth_1=c(-0.2, -0.3), # seq(-0.05, -0.2, -0.05),
    earnings_recouped=c(0.25, 0.5), # seq(0, 1, 0.25),
    risk_premium=c(0.055, 0.065), #seq(0.053, 0.06, 0.001)
    risk_free=c(0, 0.005),
    cash_return=c(0.80) # cash return as percent of earnings
  ) %>% mutate(
    post_earnings_growth_n=post.earnings.growth.f(
      earnings_base, 
      pre_earnings_growth_1, 
      pre_earnings_growth_n, 
      post_earnings_growth_1, 
      earnings_recouped, 
      n
    )
  ) %>%
  pmap_dfr(function(...) {
    inputs <- list(...)
    
    n=length(inputs$earnings_growth)
    
    inputs$earnings_growth=NULL
    inputs$earnings_growth=c(inputs$post_earnings_growth_1, rep(inputs$post_earnings_growth_n, n-1))
    
    inputs$dividends_buybacks_base=NULL
    inputs$dividends_buybacks_base=inputs$earnings_base*inputs$cash_return
    
    output <- inputs %>% fair.value.index.f
    output <- output %>% modify_if(check.length.list.f, list)
    
    output$calculations <- NULL
    inputs$earnings_growth <- NULL
    
    inputs %>% 
      modify_if(check.length.list.f, list) %>%
      bind_cols(output)
  }) %>% 
  select(-earnings_growth_lt, -trailing_roe) %>%
  select(index_value, earnings_base, cash_return, dividends_buybacks_base, 
         post_earnings_growth_n, expected_earnings, post_earnings_growth_1, 
         earnings_recouped, risk_premium, risk_free, fair_value, 
         percent_under_over_value)

output <- output %>% arrange(fair_value)
output[c(1, 7:12)] %>% 
  kable() %>% 
  kable_styling(latex_options = c("striped", "scale_down"))
index_value post_earnings_growth_1 earnings_recouped risk_premium risk_free fair_value percent_under_over_value
2711 -0.3 0.25 0.065 0.005 2079 0.303
2711 -0.3 0.25 0.065 0.000 2183 0.241
2711 -0.3 0.50 0.065 0.005 2269 0.194
2711 -0.2 0.25 0.065 0.005 2290 0.183
2711 -0.3 0.50 0.065 0.000 2383 0.137
2711 -0.2 0.25 0.065 0.000 2404 0.127
2711 -0.2 0.50 0.065 0.005 2421 0.119
2711 -0.3 0.25 0.055 0.005 2475 0.095
2711 -0.2 0.50 0.065 0.000 2542 0.066
2711 -0.3 0.25 0.055 0.000 2600 0.042
2711 -0.3 0.50 0.055 0.005 2705 0.002
2711 -0.2 0.25 0.055 0.005 2724 -0.005
2711 -0.3 0.50 0.055 0.000 2843 -0.047
2711 -0.2 0.25 0.055 0.000 2862 -0.053
2711 -0.2 0.50 0.055 0.005 2882 -0.060
2711 -0.2 0.50 0.055 0.000 3029 -0.105 
output[1:6] %>% 
  kable() %>% 
  kable_styling(latex_options = c("striped", "scale_down"))
index_value earnings_base cash_return dividends_buybacks_base post_earnings_growth_n expected_earnings
2711 163 0.8 130 0.071 114
2711 163 0.8 130 0.071 114
2711 163 0.8 130 0.097 114
2711 163 0.8 130 0.060 130
2711 163 0.8 130 0.097 114
2711 163 0.8 130 0.060 130
2711 163 0.8 130 0.076 130
2711 163 0.8 130 0.071 114
2711 163 0.8 130 0.076 130
2711 163 0.8 130 0.071 114
2711 163 0.8 130 0.097 114
2711 163 0.8 130 0.060 130
2711 163 0.8 130 0.097 114
2711 163 0.8 130 0.060 130
2711 163 0.8 130 0.076 130
2711 163 0.8 130 0.076 130

4 Reference

Damodaran A, 2020. Equity risk premiums (ERP): Determinants, estimation and implications - The 2020 edition. New York Univ, Stern School of Business. https://papers.ssrn.com/sol3/papers.cfm?abstract_id=3378246