SP500_fair_value.R

#-------------------------------------------------------------------------------------
# Source: https://gist.github.com/rnfermincota/5ad446853c5580c3cd561198ee94561e
#-------------------------------------------------------------------------------------
# Written by Rafael Nicolas Fermin Cota
# June 19th, 2022
#-------------------------------------------------------------------------------------
# References:
# [1] Interest Rates, Earning Growth and Equity Value: Investment Implications: https://aswathdamodaran.blogspot.com/2021/03/rates-growth-and-value-investment.html
# [2] Data Update 2 for 2022: US Stocks kept winning in 2021: https://aswathdamodaran.blogspot.com/2022/01/data-update-2-for-2022-us-stocks-kept.html
# [3] Global Interest Rates Dynamics and Inflation Expectations: https://rpubs.com/rafael_nicolas/global_interest_rates_dynamics_inflation
# [4] Global Default Spreads & Risk Premiums: https://rpubs.com/rafael_nicolas/crp
# https://www.linkedin.com/posts/rnfc_gsresearch-activity-6702256758372626432-HfbX/
# [5] S&P 500 Valuation Framework: https://rpubs.com/rafael_nicolas/sp500_valuation
#-------------------------------------------------------------------------------------
# The discounted cash flow model is a useful tool to frame the question of what 
# the right value is for the stock market, and what the market is currently 
# discounting.
#-------------------------------------------------------------------------------------
rm(list=ls())
#-------------------------------------------------------------------------------------
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(purrr))
#-------------------------------------------------------------------------------------
INDEX.FAIR.VALUE.f <- function(INPS){
  for (j in 1:length(INPS)) assign(names(INPS)[j], INPS[[j]])
  #-------------------------------------------------------
  l <- length(EARNINGS_VEC)
  #-------------------------------------------------------
  # EPS Growth
  #-------------------------------------------------------
  v <- EARNINGS_VEC[-1]/EARNINGS_VEC[-l]-1
  m <- length(v)
  if(is.na(LT_GROWTH_VAL)){
    T_VAL <- 0
  } else { # gradually reaching LT Growth!
    T_VAL <- -(v[m]-LT_GROWTH_VAL)/l 
  }
  EPS_GROWTH_VEC <- c(
    v[1], 
    accumulate( # https://data-and-the-world.onrender.com/posts/dplyr-accumulate-example/
      .x=rep(T_VAL, l), 
      .f=function(prv,nxt) prv + nxt, 
      .init=v[m]
    )
  )
  CAGR_VAL <- cumprod(EPS_GROWTH_VEC+1)[
    EXCESS_PERIODS
  ]^(1/EXCESS_PERIODS)-1
  
  if(is.na(LT_GROWTH_VAL)){
    EPS_GROWTH_VEC <- c(
      CAGR_VAL,EPS_GROWTH_VEC,
      ifelse(is.na(LT_RISK_FREE_VAL), RISK_FREE_VAL, LT_RISK_FREE_VAL)
    )
  } else {
    EPS_GROWTH_VEC <- c(CAGR_VAL,EPS_GROWTH_VEC,LT_GROWTH_VAL)
  }
  
  #EPS_GROWTH_VEC
  #-------------------------------------------------------
  # Earnings
  #-------------------------------------------------------
  EARNINGS_VEC <- c(
    EARNINGS_VEC,
    accumulate(
      .x=1+EPS_GROWTH_VEC[-(1:l)], 
      .f=function(prv,nxt) prv * nxt, 
      .init=EARNINGS_VEC[l]
    )[-1]
  )
  #EARNINGS_VEC
  #-------------------------------------------------------
  # Cash payout as % of EARNINGS_VEC
  #-------------------------------------------------------
  
  if(is.na(LT_GROWTH_VAL)){
    LT_CASH_PAYOUT_VAL <- CASH_PAYOUT_VAL
    T_VAL <- 0
  } else { # gradually reaching LT payout
    LT_CASH_PAYOUT_VAL <- 1-LT_GROWTH_VAL/LT_ROE_VAL
    T_VAL <- -(CASH_PAYOUT_VAL-LT_CASH_PAYOUT_VAL)/(l+1) # gradually reaching LT payout
  }
  CASH_PAYOUT_VEC <- c(
    rep(CASH_PAYOUT_VAL, 2),
    accumulate(
      .x=rep(T_VAL, l+1), 
      .f=function(prv,nxt) prv + nxt, 
      .init=CASH_PAYOUT_VAL
    )[-1],
    LT_CASH_PAYOUT_VAL
  )
  #CASH_PAYOUT_VEC
  #-------------------------------------------------------
  # Dividends + Buybacks
  #-------------------------------------------------------
  DIVD_BUYBACKS_VEC <- EARNINGS_VEC*CASH_PAYOUT_VEC
  #DIVD_BUYBACKS_VEC
  #-------------------------------------------------------
  # Riskfree Rate
  #-------------------------------------------------------
  if(is.na(LT_RISK_FREE_VAL)){
    T_VAL <- 0
  } else { # gradually reaching LT risk free
    T_VAL <- (LT_RISK_FREE_VAL-RISK_FREE_VAL)/EXCESS_PERIODS
  }
  
  RISK_FREE_VEC <- c(
    RISK_FREE_VAL,
    accumulate(
      .x=rep(T_VAL, EXCESS_PERIODS), 
      .f=function(prv,nxt) prv + nxt, 
      .init=RISK_FREE_VAL
    )[-1],
    ifelse(is.na(LT_RISK_FREE_VAL), RISK_FREE_VAL, LT_RISK_FREE_VAL)
  )
  #RISK_FREE_VEC
  #-------------------------------------------------------
  # Required Return on Stocks
  #-------------------------------------------------------
  REQUIRED_RETURN_VEC <- RISK_FREE_VEC + RISK_PREMIUM_VAL
  # slider::slide_dbl(1+REQUIRED_RETURN_VEC[-c(1, n)], function(x) prod(x), .before = Inf)
  # accumulate(.x=(1+REQUIRED_RETURN_VEC[-c(1, n)]), .f=function(prv,nxt) prv * nxt, .init=1)[-1]
  #-------------------------------------------------------
  # Present Value
  #-------------------------------------------------------
  n <- EXCESS_PERIODS + 2
  PRESENT_VALUE_VEC <- c(
    DIVD_BUYBACKS_VEC[1], 
    DIVD_BUYBACKS_VEC[-c(1, n)] / accumulate(
      .x=(1+REQUIRED_RETURN_VEC[-c(1, n)]), 
      .f=function(prv,nxt) prv * nxt, 
      .init=1
    )[-1],
    (DIVD_BUYBACKS_VEC[n]/(REQUIRED_RETURN_VEC[n]-EPS_GROWTH_VEC[n]))/prod(1+REQUIRED_RETURN_VEC[-c(1, n)])
  )
  tbl=data.frame(
    `Period` = c(0, 1:EXCESS_PERIODS, "TV"),
    `EPS_Growth`=EPS_GROWTH_VEC,
    `Earnings`=EARNINGS_VEC,
    `Cash_Payout`=CASH_PAYOUT_VEC,
    `Dividends_Buybacks`=DIVD_BUYBACKS_VEC,
    `RiskFree_Rate`=RISK_FREE_VEC,
    `Required_Return`=REQUIRED_RETURN_VEC,
    `Present_Value`=PRESENT_VALUE_VEC
  )
  return(list(fair_value=sum(PRESENT_VALUE_VEC[-1]), calculations=tbl))
}
#-------------------------------------------------------------------------------------
#-------------------------------------------------------------------------------------
list(
  EXCESS_PERIODS=5,
  LT_ROE_VAL=0.161,
  RISK_PREMIUM_VAL=0.05,
  RISK_FREE_VAL=0.03231,
  LT_RISK_FREE_VAL=0.03231,
  LT_GROWTH_VAL=NA,
  CASH_PAYOUT_VAL=0.8,
  EARNINGS_VEC=208.53*rep(1.06, 3)^(0:2)
) %>% 
  INDEX.FAIR.VALUE.f %>%
  list %>%
  set_names(c("2022_06_19_SP500"))



#-------------------------------------------------------------------------------------
RATES_VEC <- seq(0.03231, 0.065, 0.005)
map(
  RATES_VEC,
  ~list(
    EXCESS_PERIODS=5,
    LT_ROE_VAL=0.161,
    RISK_PREMIUM_VAL=0.05,
    RISK_FREE_VAL=0.03231,
    LT_RISK_FREE_VAL=.x,
    LT_GROWTH_VAL=NA,
    CASH_PAYOUT_VAL=0.8,
    EARNINGS_VEC=208.53*rep(1.06, 3)^(0:2)
  ) %>% INDEX.FAIR.VALUE.f
) %>% set_names(RATES_VEC)
#-------------------------------------------------------------------------------------