Compare the S&P 500 dividend yield to the 10-year bond yield

library(rvest)
library(dplyr)
library(lubridate)
library(xts)
library(sp500SlidingWindow)

Find S&P 500 Dividend Yield

div_yld_url    <- "http://www.multpl.com/s-p-500-dividend-yield/table"
dividend_yield <- read_html(div_yld_url)

dividend_yields <- dividend_yield %>% 
     html_node("#datatable") %>%
     html_table(header = TRUE) %>%
     mutate(Date=as.Date(Date, format = "%B %d, %Y"))

colnames(dividend_yields) <- c("Date","div")
    
  
# clean up first element "\n estimate"
dividend_yields[1,2] <- unlist(strsplit(dividend_yields[1,2], split='\n', fixed=TRUE))[1]

# convert percent to numeric
dividend_yields[,2] <- as.numeric(sub("%", "", dividend_yields[,2]))

Find the 10-year yield

govt_url <- "https://www.treasury.gov/resource-center/data-chart-center/interest-rates/Pages/TextView.aspx?data=yieldAll"

yc <-
    read_html(govt_url) %>%
    html_node("table.t-chart") %>%
    html_table(header = TRUE, trim = TRUE, fill = TRUE, dec = ".") %>%
    mutate(Date=as.Date(Date, format = "%m/%d/%y"))

# convert to an xts time-series
# replace "N/A" with NA

yield_curve <- xts(select(yc,-Date), order.by=yc$Date)
yield_curve[ yield_curve == "N/A" ] <- NA

# pull out the lastt trading day of each year
last_of_year  <- do.call(rbind, lapply(split(yield_curve, "years"), last))

# create dataframe of 10-year yields
ten_yr <- data.frame(Date=index(last_of_year[,"10 yr"]), as.numeric(coredata(last_of_year[,"10 yr"])))
colnames(ten_yr) <- c("Date","bond")

Get the S&P 500 Index

sp500tr <- SP500TR_1950()
sp500tr_xts <- xts(select(sp500tr,-Date), order.by=sp500tr$Date)
sp500 <- SP500()
sp500_xts <- xts(select(sp500,-Date), order.by=sp500$Date)

# pull out the lastt trading day of each year
sp500tr_xts_last  <- do.call(rbind, lapply(split(sp500tr_xts, "years"), last))
sp500_xts_last    <- do.call(rbind, lapply(split(sp500_xts, "years"), last))

# create dataframe of Adj.Close
sp500tr_adj <- data.frame(Date=index(sp500tr_xts_last[,"Adj.Close"]), as.numeric(coredata(sp500tr_xts_last[,"Adj.Close"])))
colnames(sp500tr_adj) <- c("Date","Adj.Close")

sp500_adj <- data.frame(Date=index(sp500_xts_last[,"Adj.Close"]), as.numeric(coredata(sp500_xts_last[,"Adj.Close"])))
colnames(sp500_adj) <- c("Date","Adj.Close")
# which sp500 to use?
sp500use <- sp500_adj

Merge Dividend Yield, 10-Year Yield and S&P 500 Adj.Close

# coerce the most-recent dates to be the same
dividend_yields[which(dividend_yields[,1] == max(dividend_yields[,1])),1] <- max(ten_yr[,1])
sp500use[which(sp500use[,1] == max(sp500use[,1])),1] <- max(ten_yr[,1])

DIV_YLD <- merge(dividend_yields,ten_yr)
DIV_YLD <- merge(DIV_YLD,sp500use)

# index the values 
idx <- 1
DIV_YLD$dividx  <- DIV_YLD$div/DIV_YLD$div[1]*idx
DIV_YLD$bondidx <- DIV_YLD$bond/DIV_YLD$bond[1]*idx
DIV_YLD$spidx   <- DIV_YLD$Adj.Close/DIV_YLD$Adj.Close[1]*idx

Plot the two “yield curves”

ylim <- c(0, max(DIV_YLD$div,DIV_YLD$bond)*1.1)

plot(DIV_YLD$Date, DIV_YLD$div, type="b", 
     ylim=ylim, pch=20, col="black",
     xlab="Year End", ylab="Yield")
lines(DIV_YLD$Date,  DIV_YLD$bond, pch=1, col="red")
points(DIV_YLD$Date, DIV_YLD$bond, pch=1, col="red")

abline(v=as.numeric(DIV_YLD$Date[DIV_YLD$Date=="2008-12-31"]),lty=2)
title("Dividend Yield vs 10-Year Yield")
legend("top", legend=c("Dividend","10-Year","2008-12-31"), 
       pch=c(20,1,-1), col=c("black","red","black"), lty=c(1,1,2))

Plot the difference between the two “yield curves”

difneg <- DIV_YLD$bond-DIV_YLD$div
plot(DIV_YLD$Date, difneg, type="l", 
     col="black",
     xlab="Year End", ylab="Difference in Yields")
points(DIV_YLD$Date,sapply(difneg, function(x) {if (x>0) {NA} else {x}}), pch=19, col="red")
points(DIV_YLD$Date,sapply(difneg, function(x) {if (x<=0) {NA} else {x}}), pch=20, col="black")

abline(v=as.numeric(DIV_YLD$Date[DIV_YLD$Date=="2008-12-31"]),lty=2)
abline(h=0,col="red")
title("10-Year Yield minus Dividend Yield")
legend("top", legend=c("Stocks pay more than Bonds","2008-12-31"), 
       pch=c(19,-1), col=c("red","black"), lty=c(1,2))

Plot the indexed S&P 500 vs Dividend & Bond Yields

ylim <- c(0, max(DIV_YLD$div,DIV_YLD$bond,DIV_YLD$spidx)*1.1)
plot(DIV_YLD$Date,DIV_YLD$spidx,type="b",
     ylim=ylim, pch=3, col="black",
     xlab="Year End", ylab="SP500TR / Yields")
lines(DIV_YLD$Date,  DIV_YLD$bond, pch=1, col="red")
points(DIV_YLD$Date, DIV_YLD$bond, pch=1, col="red")
lines(DIV_YLD$Date,  DIV_YLD$div, pch=20, col="black")
points(DIV_YLD$Date, DIV_YLD$div, pch=20, col="black")
abline(v=as.numeric(DIV_YLD$Date[DIV_YLD$Date=="2008-12-31"]),lty=2)
title(paste("Dividend Yield vs 10-Year Yield vs SP500 indexed to",idx))
legend("top", legend=c("Dividend","10-Year","2008-12-31","SP500"), 
       pch=c(20,1,-1,3), col=c("black","red","black","black"), lty=c(1,1,2,1))