In grfiv/ustreasuries: Treasury Data Download, Fixed-Income Models and Derivative Analyses
Pietro Veronesi's Fixed Income Securities is one of the canonical texts for teaching fixed income analysis; it was my text at MIT and it is frequently cited.
The text has one flaw, however, namely that its examples are very difficult to follow, which is an impediment to learning. (The attempt to derive spot rates for Table 2.2 is a perfect example of how much time is wasted when a result is stated but the process is not explained, spot rates aren't even explicitly defined; plus the process showed that the T=7.0 spot rate in the table was probably wrong given how far off it was from the derivation.)
With this vignette and others to come I hope to remedy the major flaw in the text by deriving every example, table and figure so that the derivation is perfectly clear.
Chapter 2
BASICS OF FIXED INCOME SECURITIES
knitr::opts_chunk$set(collapse=TRUE, # hadley
comment = "#>", # hadley
error=TRUE, purl=FALSE, # to be able to see errors
fig.width=7.25, fig.height=6) # nice-sized pictures
library(ustreasuries)
# magrittr provides the pipe operator %>%
library(magrittr)
# load the CMT data equi-joined to the S&P 500 data
cmt_data <- CMTrates() %>%
dplyr::inner_join(SP500(),
by = c("NEW_DATE" = "Date"))
# internal flag indicating the first columns contain CMTrate data
attr(cmt_data, "data.source") <- "CMT"
Section 2.1 Discount Factors
Example 2.1 Discount Factor Z(t, T)
Function Code
discount_factor
CAGR
Example
issue_price <- 97.477 # PV
face_value <- 100.00 # FV
fractional_years <- 182/365 # T - t
# discount factors use continuous compounding
annual_rate <- CAGR(issue_price, face_value, fractional_years, type="continuous")
discount_factor(annual_rate, fractional_years)
# since this is a period of time less than a year with no coupons paid
issue_price/face_value
Example 2.2 Discount Factor across Maturities
Shorter maturities have higher discount factors
issue_price <- 98.739 # PV
face_value <- 100.00 # FV
fractional_years <- 91/365 # T - t
# discount factors use continuous compounding
annual_rate <- CAGR(issue_price, face_value, fractional_years, type="continuous")
discount_factor(annual_rate, fractional_years)
# since this is a period of time less than a year with no coupons paid
issue_price/face_value
Section 2.1.2 Discount Factors over Time
# extract the historical semi-annual rates, convert to discount factors
three_month_history <- cmt_data$BC_3MONTH/100
three_month_df <- discount_factor(three_month_history, 3/12, 2)
one_year_history <- cmt_data$BC_1YEAR/100
one_year_df <- discount_factor(one_year_history, 1, 2)
three_year_history <- cmt_data$BC_3YEAR/100
three_year_df <- discount_factor(three_year_history, 3, 2)
five_year_history <- cmt_data$BC_5YEAR/100
five_year_df <- discount_factor(five_year_history, 5, 2)
ten_year_history <- cmt_data$BC_10YEAR/100
ten_year_df <- discount_factor(ten_year_history, 10, 2)
thirty_year_history <- cmt_data$BC_30YEAR/100
thirty_year_df <- discount_factor(thirty_year_history, 30, 2)
# plot the discount factors
y_min <- min(three_month_df, one_year_df, three_year_df, na.rm=TRUE)
y_max <- max(three_month_df, one_year_df, three_year_df, na.rm=TRUE)
plot(x = 1:length(three_month_df), y = three_month_df,
type="l", lty=1, col="black",
ylim = c(y_min*.90, y_max*1.05), ylab="Discount Factor",
xlim = c(1,length(three_month_df)),
xaxt="n", xlab='',
main="Figure 2.1 Discount Factors")
# ---------- format the x axis ------------------------------------------
year_vector <- format(cmt_data$NEW_DATE,format="%Y")
axTick_vec <- axTicks(1)+1
axTick_vec[length(axTick_vec)] <- min(which(year_vector==format(Sys.Date(),"%Y")))
axTick_vec[length(axTick_vec)+1] <- axTicks(1)[length(axTicks(1))]
axis(1, at = axTick_vec,
labels = format(cmt_data$NEW_DATE,format="%Y")[axTick_vec])
# ---------- format the x axis ------------------------------------------
grid()
lines(x = 1:length(one_year_df), y = one_year_df, lty = 3)
lines(x = 1:length(three_year_df), y = three_year_df, lty = 2)
legend("bottomleft", legend=c("3-month","1-year","3-year"), lty=c(1,3,2))
Section 2.2 Interest Rates
Example 2.3 Semi-Annual Compounding
Show equivalent methods of calculating Z(t, T)
- Z(0, T) = 1 / (1 + r/2)^(2*T)
- Z(0, T) = PV/FV
investment <- 100 # PV
semi_annual_coupon_rate <- 0.05 # r
years <- 1 # T - t
# FV = PV / Z(0, T)
(payoff_at_T <- investment / discount_factor(semi_annual_coupon_rate, years, 2))
# Z(0, T) = 1 / (1 + r/2)^(2*T)
(payoff_at_T <- investment * ( 1 + (semi_annual_coupon_rate/2))^(2*years))
# Z(0, T) = PV/FV
all.equal(discount_factor(semi_annual_coupon_rate, years, 2),
investment / payoff_at_T)
# Z(0, T) = 1 / (1 + r/2)^(2*T)
all.equal(discount_factor(semi_annual_coupon_rate, years, 2),
1 / (1 + (semi_annual_coupon_rate/2))^(2*years))
Example 2.4 Semi-Annual Compounding
Show continuous vs semi-annual compounding
price <- 95.713 # PV
payoff <- 100 # FV
years <- 1 # T - t
# discount factors use continuous compounding
annual_rate <- CAGR(price, payoff, years, type="continuous")
paste0(
round(
annual_rate
* 100, 2), "%, continuous")
discount_factor(annual_rate, years)
# coupon is semi-annual
paste0(
round(
r_discrete(annual_rate, 2) # convert from continuous
* 100, 2), "%, semi-annual")
Section 2.3 The Term Structure of Interest Rates
par(mfrow=c(2,2))
A <- dplyr::filter(cmt_data, NEW_DATE=="1992-10-30")
B <- dplyr::filter(cmt_data, NEW_DATE=="2000-11-30")
C <- dplyr::filter(cmt_data, NEW_DATE==NEW_DATE[nrow(cmt_data)])
D <- dplyr::filter(cmt_data, NEW_DATE=="1989-07-31")
y_min = min(A[3:13],B[3:13],C[3:13],D[3:13], na.rm=TRUE)*0.90
y_max = max(A[3:13],B[3:13],C[3:13],D[3:13], na.rm=TRUE)*1.05
plot(x = 1:11,
y = A[3:13], ylim=c(y_min,y_max),
type = "l",
main=paste0("A: ", format(A[[2]], '%m/%d/%Y'), " : Increasing"),cex.main=0.90,
ylab="Interest Rate", xaxt="n", xlab='"Normal"')
axis(1, at = axTicks(1),
labels = substr(names(cmt_data[1, 3:13])[axTicks(1)],4,9))
grid()
plot(x = 1:11,
y = B[3:13], ylim=c(y_min,y_max),
type = "l",
main=paste0("B: ", format(B[[2]], '%m/%d/%Y'), " : Decreasing"),cex.main=0.90,
ylab="Interest Rate", xaxt="n", xlab='')
axis(1, at = axTicks(1),
labels = substr(names(cmt_data[1, 3:13])[axTicks(1)],4,9))
grid()
plot(x = 1:11,
y = C[3:13], ylim=c(y_min,y_max),
type = "l",
main=paste0(format(C[[2]], '%m/%d/%Y'), " : Most Recent"),
ylab="Interest Rate", xaxt="n", xlab='')
axis(1, at = axTicks(1),
labels = substr(names(cmt_data[1, 3:13])[axTicks(1)],4,9))
grid()
plot(x = 1:11,
y = D[3:13], ylim=c(y_min,y_max),
type = "l",
main=paste0("D: ", format(D[[2]], '%m/%d/%Y'), " : Inverted Hump"),cex.main=0.90,
ylab="Interest Rate", xaxt="n", xlab='')
axis(1, at = axTicks(1),
labels = substr(names(cmt_data[1, 3:13])[axTicks(1)],4,9))
grid()
title("Figure 2.3 The Shapes of the Term Structure", outer=TRUE, line = -1)
par(mfrow=c(1,1))
Section 2.3.1 The Term Structure of Interest Rates over Time
A <- dplyr::filter(cmt_data, NEW_DATE=="1994-01-31")
B <- dplyr::filter(cmt_data, NEW_DATE=="1994-07-29")
C <- dplyr::filter(cmt_data, NEW_DATE=="1995-01-31")
which_A <- which(cmt_data$NEW_DATE == A$NEW_DATE) # for next graph
y_min <- min(A[3:13], B[3:13], C[3:13], na.rm=TRUE)
y_max <- max(A[3:13], B[3:13], C[3:13], na.rm=TRUE)
plot(x = 1:11,
y = A[3:13],
type="l", lty=1, col="black",
ylim = c(y_min*.90, y_max*1.05), ylab="Interest Rate",
xaxt="n", xlab='',
main="Figure 2.4 The Term Structure of Interest Rates on DIfferent Dates")
axis(1, at = axTicks(1),
labels = substr(names(cmt_data[1, 3:13])[axTicks(1)],4,9))
grid()
lines(x = 1:length(B[3:13]), y = B[3:13], lty = 3)
lines(x = 1:length(C[3:13]), y = C[3:13], lty = 2)
legend("bottomright", legend=c(format(C$NEW_DATE,"%B %Y"),
format(B$NEW_DATE,"%B %Y"),
format(A$NEW_DATE,"%B %Y")), lty=c(2,3,1))
# plot the interest rates over time
y_min <- min(three_month_history, one_year_history, thirty_year_history, na.rm=TRUE)
y_max <- max(three_month_history, one_year_history, thirty_year_history, na.rm=TRUE)
plot(x = 1:length(three_month_history), y = three_month_history,
type="l", lty=3, col="black",
ylim = c(y_min*.90, y_max*1.05), ylab="Interest Rate",
xlim = c(1,length(three_month_history)),
xaxt="n", xlab='The 30-year has been in and out of favor',
main="Figure 2.5 The Term Structure over Time")
# ---------- format the x axis ------------------------------------------
year_vector <- format(cmt_data$NEW_DATE,format="%Y")
axTick_vec <- axTicks(1)+1
axTick_vec[length(axTick_vec)] <- min(which(year_vector==format(Sys.Date(),"%Y")))
axTick_vec[length(axTick_vec)+1] <- axTicks(1)[length(axTicks(1))]
axis(1, at = axTick_vec,
labels = format(cmt_data$NEW_DATE,format="%Y")[axTick_vec])
# ---------- format the x axis ------------------------------------------
grid()
lines(x = 1:length(one_year_history), y = one_year_history, lty = 1, col="blue")
lines(x = 1:length(thirty_year_history), y = thirty_year_history, lty = 4, col="red")
abline(v=which_A, lty=1) # from previous graph
legend("topright", legend=c("3-month","1-year","30-year",paste0(format(A$NEW_DATE,"%b %Y"), ", Fig 2.4")),
lty=c(3,1,4,1), col=c("black","blue","red","black"))
10Year Rates vs S&P 500
y_min <- min(ten_year_history, na.rm=TRUE)
y_max <- max(ten_year_history, na.rm=TRUE)
plot(x = 1:length(ten_year_history), y = ten_year_history,
type="l", lty=3, col="black",
ylim = c(y_min*.90, y_max*1.05), ylab=NA,
xlim = c(1,length(ten_year_history)),
xaxt="n", xlab=NA,
main="Figure 2.5-extra 1 The 10-year vs the S&P 500")
# ---------- format the x axis ------------------------------------------
year_vector <- format(cmt_data$NEW_DATE,format="%Y")
axTick_vec <- axTicks(1)+1
axTick_vec[length(axTick_vec)] <- min(which(year_vector==format(Sys.Date(),"%Y")))
axTick_vec[length(axTick_vec)+1] <- axTicks(1)[length(axTicks(1))]
axis(1, at = axTick_vec,
labels = format(cmt_data$NEW_DATE,format="%Y")[axTick_vec])
# ---------- format the x axis ------------------------------------------
grid()
# ----------------- S&P 500 -----------------
par(new = T)
plot(x = 1:length(cmt_data$Adj.Close), y = log10(cmt_data$Adj.Close),
type="l", axes=F, xlab=NA, ylab=NA, col="green")
axis(side = 4)
legend('topleft',legend=c("10-year Bond","S&P 500 Log10 Scale"),
lty=c(3,1), col=c("black","green"))
10Year/1Year Spread vs S&P 500
spread <- ten_year_history - one_year_history
y_min <- min(spread, na.rm=TRUE)
y_max <- max(spread, na.rm=TRUE)
plot(x = 1:length(spread), y = spread,
type="l", lty=3, col="black",
ylim = c(y_min*.90, y_max*1.05), ylab=NA,
xlim = c(1,length(spread)),
xaxt="n", xlab="Vertical lines are the highs before the crash",
main="Figure 2.5-extra 2 The 10-year/1-year spread vs the S&P 500")
abline(h=0.0, lty=2)
abline(v=6364) # 1987-08-25 high before the crash
abline(v=9510) # 2000-03-24 high before the crash
abline(v=11392) # 2007-10-09 high before the crash
# ---------- format the x axis ------------------------------------------
year_vector <- format(cmt_data$NEW_DATE,format="%Y")
axTick_vec <- axTicks(1)+1
axTick_vec[length(axTick_vec)] <- min(which(year_vector==format(Sys.Date(),"%Y")))
axTick_vec[length(axTick_vec)+1] <- axTicks(1)[length(axTicks(1))]
axis(1, at = axTick_vec,
labels = format(cmt_data$NEW_DATE,format="%Y")[axTick_vec])
# ---------- format the x axis ------------------------------------------
grid()
# ----------------- S&P 500 -----------------
sp500_idx_trim <- SP500() %>%
dplyr::filter(Date>=cmt_data$NEW_DATE[1]) %>%
dplyr::arrange(Date)
par(new = T)
plot(x = 1:length(cmt_data$Adj.Close), y = log10(cmt_data$Adj.Close),
type="l", axes=F, xlab=NA, ylab=NA, col="green")
axis(side = 4)
legend('topleft',legend=c("10-year/1-year spread","S&P 500 Log10 Scale"),
lty=c(3,1), col=c("black","green"))
PrintYieldCurves(dplyr::filter(cmt_data,
cmt_data$NEW_DATE==as.Date("1987-08-25") |
cmt_data$NEW_DATE==as.Date("2000-03-24") |
cmt_data$NEW_DATE==as.Date("2007-10-09") |
cmt_data$NEW_DATE==cmt_data$NEW_DATE[[nrow(cmt_data)]]),
rows=c(1, 2, 3, 4),
title="Yield Curves at Highs Before each Crash + today")
Section 2.4 Coupon Bonds
Example 2.7
$$Price = \frac{coupon}{2}\sum Z(t, T_i) + Z(t, T_n) \times 100$$
coupon <- 0.04375
(df_0.5 <- round(discount_factor(coupon, 0.5, 2), 5))
(df_1.0 <- round(discount_factor(coupon, 1.0, 2), 5))
(df_1.5 <- round(discount_factor(coupon, 1.5, 2), 5))
(df_2.0 <- round(discount_factor(coupon, 2.0, 2), 5))
(price <- (100*coupon)/2 * sum(df_0.5, df_1.0, df_1.5, df_2.0) + 100 * df_2.0)
# Veronesi doesn't give us the yield just the df;
# but why have a yield so minutely off from the coupon?
# Mine's off, too; so chalk it up to these lousy computers.
yld <- jrvFinance::bond.yield(as.Date("01-03-2006","%m-%d-%Y"),
as.Date("10-31-2007","%m-%d-%Y"),
coupon, freq=2, price=99.997, convention="ACT/ACT")
knitr::kable(data.frame(coupon=coupon,yield=yld,difference=coupon-yld))
Example 2.9 Find Discount Factors with Equation Solving
$Ax = b$
$A$ is the cash flows, $b$ is the prices, $x$ is the discount factors
# bond1
p1 <- 98.3607
cash_flow1 = c(100, 0)
# bond2
p2 <- 99.2343
c2 <- 0.0275
cash_flow2 = c(100*c2/2, 100*c2/2 + 100)
b <- c(p1, p2)
names(b) <- c("bond1","bond2")
A <- matrix(c(cash_flow1, cash_flow2), nrow=2, byrow=TRUE)
rownames(A) <- c("bond1", "bond2")
colnames(A) <- c("T_0.5","T_1.0")
x <- solve(A, b)
names(x) <- c("Z(0, 0.5)", "Z(0, 1.0)")
# A: the cash-flow matrix
A
# b: the price vector
b
# x: the Z vector
x
# reconstruct bond1
x[["Z(0, 0.5)"]] * cash_flow1[1] + x[["Z(0, 1.0)"]] * cash_flow1[2]
# reconstruct bond2
x[["Z(0, 0.5)"]] * cash_flow2[1] + x[["Z(0, 1.0)"]] * cash_flow2[2]
Example 2.10 Bootstrap the next Z(0, T)
# bond3 has three cash flows
p3 <- 99.1093
c3 <- 0.03
x[["Z(0, 1.5)"]] <- (p3 - c3/2*100 * sum(x)) / (100 * (1 + c3/2))
x
The Zboostrap Function
Zbootstrap
prices <- c(p1, p2, p3)
coupons <- c(0, c2, c3)
Zbootstrap(prices, coupons)
Example 2.11 YTM
Data setup
# my thanks to
# 1) for OCR
# http://blog.sudobits.com/2013/01/22/
# image-to-text-converter-ocr-for-ubuntu-linux-mint/
#
# 2) for text-to-data.frame:
# http://stackoverflow.com/questions/30496474/
# reading-text-into-data-frame-where-string-values-contain-spaces
#
# Note: I could not get a numbered capture group greater than 9 to work
# it appears to be a failure in R's regex implementation
#
data_raw <-
'4.125 8/15/2008 0.5 100.9844 101.0156 101.0000 98.9590 2.0930 98.1572 98.2027
4.500 2/15/2009 1.0 102.6094 102.6406 102.6250 98.1892 1.8274 96.3484 96.4378
4.875 8/15/2009 1.5 104.4766 104.5078 104.4922 97.3147 1.8147 94.5729 94.7045
4.750 2/15/2010 2.0 105.5078 105.91 105.5234 96.2441 1.9141 92.8301 93.0024
4.125 8/15/2010 2.5 105.0859 105.1172 105.1016 95.0822 2.0172 91.1194 91.3309
5.000 2/15/2011 3.0 108.2344 108.2656 108.2500 93.7612 2.1473 89.4403 89.6895
5.000 8/15/2011 3.5 109.0000 109.0313 109.0156 92.2213 2.3137 87.7920 88.0775
4.875 2/15/2012 4.0 109.1719 109.2031 109.1875 90.6046 2.4666 86.1742 86.4945
4.375 8/15/2012 4.5 107.3281 107.3594 107.3438 88.7259 2.6582 84.5862 84.9400
3.875 2/15/2013 5.0 105.1406 105.1719 105.1563 86.9809 2.7896 83.0274 83.4134
4.250 8/15/2013 5.5 106.8125 106.8438 106.8281 85.0858 2.9365 81.4974 81.9142
4.000 2/15/2014 6.0 105.2344 105.2656 105.2500 83.1241 3.0806 79.9956 80.4420
4.250 8/15/2014 6.5 106.3281 106.3594 106.3438 81.1114 3.2207 78.5214 78.9962
4.000 2/15/2015 7.0 104.750 104.4063 104.3906 79.0613 3.564 77.0744 77.5765
4.250 8/15/2015 7.5 105.4063 105.75 105.4219 76.8759 3.5064 75.6541 76.1822
4.500 2/15/2016 8.0 106.7188 106.7500 106.7344 74.8256 3.6251 74.2600 74.8130
4.875 8/15/2016 8.5 109.0000 109.0313 109.0156 72.6763 3.7548 72.8915 73.4684
4.625 2/15/2017 9.0 106.9375 106.9688 106.9531 70.8392 3.8306 71.5483 72.1480
4.750 8/15/2017 9.5 107.8750 107.9063 107.8906 69.1582 3.8818 70.2298 70.8513
3.500 2/15/2018 10.0 97.8750 97.9063 97.8906 68.1581 3.8334 68.9356 69.5779'
data_parsed <- readLines(textConnection(data_raw))
regexin <- "^ *(.*\\S) +(\\S+) +(\\S+) +(\\S+) +(\\S+) +(\\S+) +(\\S+) +(\\S+) +(\\S+) +(\\S+)$"
regexout <- "\\1,\\2,\\3,\\4,\\5,\\6,\\7,\\8"
#"\\9,\\10"
table2.2 <- read.csv(text = sub(regexin, regexout, data_parsed),
as.is = TRUE, header=FALSE,stringsAsFactors = FALSE)
names(table2.2) <- c("coupon","maturity","time","bid","ask","mid","bootstrap","spot")
#,"y=3.7","y=3.6")
table2.2$maturity <- as.Date(table2.2$maturity, "%m/%d/%Y")
table2.2$date <- as.Date("2008-02-15","%Y-%m-%d")
str(table2.2)
knitr::kable(table2.2)
Where do his spot rates come from?
# it's not YTM
# ============
apply(table2.2, 1, function(x) YTM(as.numeric(x["bootstrap"]),
as.numeric(x["coupon"]),
as.numeric(x["time"])))
# it's not the continuously compounded rate (see Fact 2.7 p37)
# ===============================================
apply(table2.2, 1, function(x) -(log2(as.numeric(x["bootstrap"])/100) /
as.numeric(x["time"])) * 100)
# kinda looks like the n-times compounded annual rate (see Fact 2.6, p36)
# ... but not quite
# ===============================================
apply(table2.2, 1, function(x) {
n <- 2
Z <- as.numeric(x["bootstrap"])/100
t <- as.numeric(x["time"])
Zpow <- Z^(1/(n*t))
invpow <- 1/Zpow
n * (invpow - 1) * 100
})
# how about the continuous CAGR?
# YES!
# (except time=7.0, probably an error in the table)
# ======================================
apply(table2.2, 1, function(x) CAGR(as.numeric(x["bootstrap"]), # PV
100, # FV
as.numeric(x["time"]), # fractional years
type="continuous")*100)
spot_rate
Demonstrate the derivation of the bootstrap data
Why does he multiply the Z(0, T) value by 100?
prices <- table2.2$mid
coupons <- table2.2$coupon/100
Zbootstrap(prices, coupons)
all.equal(Zbootstrap(prices, coupons),
table2.2$bootstrap/100,
tolerance = 1e-3)
grfiv/ustreasuries documentation built on May 17, 2019, 8:36 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Pietro Veronesi's Fixed Income Securities is one of the canonical texts for teaching fixed income analysis; it was my text at MIT and it is frequently cited.
The text has one flaw, however, namely that its examples are very difficult to follow, which is an impediment to learning. (The attempt to derive spot rates for Table 2.2 is a perfect example of how much time is wasted when a result is stated but the process is not explained, spot rates aren't even explicitly defined; plus the process showed that the T=7.0 spot rate in the table was probably wrong given how far off it was from the derivation.)
With this vignette and others to come I hope to remedy the major flaw in the text by deriving every example, table and figure so that the derivation is perfectly clear.
Chapter 2
BASICS OF FIXED INCOME SECURITIES
knitr::opts_chunk$set(collapse=TRUE, # hadley comment = "#>", # hadley error=TRUE, purl=FALSE, # to be able to see errors fig.width=7.25, fig.height=6) # nice-sized pictures
library(ustreasuries) # magrittr provides the pipe operator %>% library(magrittr) # load the CMT data equi-joined to the S&P 500 data cmt_data <- CMTrates() %>% dplyr::inner_join(SP500(), by = c("NEW_DATE" = "Date")) # internal flag indicating the first columns contain CMTrate data attr(cmt_data, "data.source") <- "CMT"
Section 2.1 Discount Factors
Example 2.1 Discount Factor Z(t, T)
Function Code
discount_factor CAGR
Example
issue_price <- 97.477 # PV face_value <- 100.00 # FV fractional_years <- 182/365 # T - t # discount factors use continuous compounding annual_rate <- CAGR(issue_price, face_value, fractional_years, type="continuous") discount_factor(annual_rate, fractional_years) # since this is a period of time less than a year with no coupons paid issue_price/face_value
Example 2.2 Discount Factor across Maturities
Shorter maturities have higher discount factors
issue_price <- 98.739 # PV face_value <- 100.00 # FV fractional_years <- 91/365 # T - t # discount factors use continuous compounding annual_rate <- CAGR(issue_price, face_value, fractional_years, type="continuous") discount_factor(annual_rate, fractional_years) # since this is a period of time less than a year with no coupons paid issue_price/face_value
Section 2.1.2 Discount Factors over Time
# extract the historical semi-annual rates, convert to discount factors three_month_history <- cmt_data$BC_3MONTH/100 three_month_df <- discount_factor(three_month_history, 3/12, 2) one_year_history <- cmt_data$BC_1YEAR/100 one_year_df <- discount_factor(one_year_history, 1, 2) three_year_history <- cmt_data$BC_3YEAR/100 three_year_df <- discount_factor(three_year_history, 3, 2) five_year_history <- cmt_data$BC_5YEAR/100 five_year_df <- discount_factor(five_year_history, 5, 2) ten_year_history <- cmt_data$BC_10YEAR/100 ten_year_df <- discount_factor(ten_year_history, 10, 2) thirty_year_history <- cmt_data$BC_30YEAR/100 thirty_year_df <- discount_factor(thirty_year_history, 30, 2) # plot the discount factors y_min <- min(three_month_df, one_year_df, three_year_df, na.rm=TRUE) y_max <- max(three_month_df, one_year_df, three_year_df, na.rm=TRUE) plot(x = 1:length(three_month_df), y = three_month_df, type="l", lty=1, col="black", ylim = c(y_min*.90, y_max*1.05), ylab="Discount Factor", xlim = c(1,length(three_month_df)), xaxt="n", xlab='', main="Figure 2.1 Discount Factors") # ---------- format the x axis ------------------------------------------ year_vector <- format(cmt_data$NEW_DATE,format="%Y") axTick_vec <- axTicks(1)+1 axTick_vec[length(axTick_vec)] <- min(which(year_vector==format(Sys.Date(),"%Y"))) axTick_vec[length(axTick_vec)+1] <- axTicks(1)[length(axTicks(1))] axis(1, at = axTick_vec, labels = format(cmt_data$NEW_DATE,format="%Y")[axTick_vec]) # ---------- format the x axis ------------------------------------------ grid() lines(x = 1:length(one_year_df), y = one_year_df, lty = 3) lines(x = 1:length(three_year_df), y = three_year_df, lty = 2) legend("bottomleft", legend=c("3-month","1-year","3-year"), lty=c(1,3,2))
Section 2.2 Interest Rates
Example 2.3 Semi-Annual Compounding
Show equivalent methods of calculating Z(t, T)
- Z(0, T) = 1 / (1 + r/2)^(2*T)
- Z(0, T) = PV/FV
investment <- 100 # PV semi_annual_coupon_rate <- 0.05 # r years <- 1 # T - t # FV = PV / Z(0, T) (payoff_at_T <- investment / discount_factor(semi_annual_coupon_rate, years, 2)) # Z(0, T) = 1 / (1 + r/2)^(2*T) (payoff_at_T <- investment * ( 1 + (semi_annual_coupon_rate/2))^(2*years)) # Z(0, T) = PV/FV all.equal(discount_factor(semi_annual_coupon_rate, years, 2), investment / payoff_at_T) # Z(0, T) = 1 / (1 + r/2)^(2*T) all.equal(discount_factor(semi_annual_coupon_rate, years, 2), 1 / (1 + (semi_annual_coupon_rate/2))^(2*years))
Example 2.4 Semi-Annual Compounding
Show continuous vs semi-annual compounding
price <- 95.713 # PV payoff <- 100 # FV years <- 1 # T - t # discount factors use continuous compounding annual_rate <- CAGR(price, payoff, years, type="continuous") paste0( round( annual_rate * 100, 2), "%, continuous") discount_factor(annual_rate, years) # coupon is semi-annual paste0( round( r_discrete(annual_rate, 2) # convert from continuous * 100, 2), "%, semi-annual")
Section 2.3 The Term Structure of Interest Rates
par(mfrow=c(2,2)) A <- dplyr::filter(cmt_data, NEW_DATE=="1992-10-30") B <- dplyr::filter(cmt_data, NEW_DATE=="2000-11-30") C <- dplyr::filter(cmt_data, NEW_DATE==NEW_DATE[nrow(cmt_data)]) D <- dplyr::filter(cmt_data, NEW_DATE=="1989-07-31") y_min = min(A[3:13],B[3:13],C[3:13],D[3:13], na.rm=TRUE)*0.90 y_max = max(A[3:13],B[3:13],C[3:13],D[3:13], na.rm=TRUE)*1.05 plot(x = 1:11, y = A[3:13], ylim=c(y_min,y_max), type = "l", main=paste0("A: ", format(A[[2]], '%m/%d/%Y'), " : Increasing"),cex.main=0.90, ylab="Interest Rate", xaxt="n", xlab='"Normal"') axis(1, at = axTicks(1), labels = substr(names(cmt_data[1, 3:13])[axTicks(1)],4,9)) grid() plot(x = 1:11, y = B[3:13], ylim=c(y_min,y_max), type = "l", main=paste0("B: ", format(B[[2]], '%m/%d/%Y'), " : Decreasing"),cex.main=0.90, ylab="Interest Rate", xaxt="n", xlab='') axis(1, at = axTicks(1), labels = substr(names(cmt_data[1, 3:13])[axTicks(1)],4,9)) grid() plot(x = 1:11, y = C[3:13], ylim=c(y_min,y_max), type = "l", main=paste0(format(C[[2]], '%m/%d/%Y'), " : Most Recent"), ylab="Interest Rate", xaxt="n", xlab='') axis(1, at = axTicks(1), labels = substr(names(cmt_data[1, 3:13])[axTicks(1)],4,9)) grid() plot(x = 1:11, y = D[3:13], ylim=c(y_min,y_max), type = "l", main=paste0("D: ", format(D[[2]], '%m/%d/%Y'), " : Inverted Hump"),cex.main=0.90, ylab="Interest Rate", xaxt="n", xlab='') axis(1, at = axTicks(1), labels = substr(names(cmt_data[1, 3:13])[axTicks(1)],4,9)) grid() title("Figure 2.3 The Shapes of the Term Structure", outer=TRUE, line = -1) par(mfrow=c(1,1))
Section 2.3.1 The Term Structure of Interest Rates over Time
A <- dplyr::filter(cmt_data, NEW_DATE=="1994-01-31") B <- dplyr::filter(cmt_data, NEW_DATE=="1994-07-29") C <- dplyr::filter(cmt_data, NEW_DATE=="1995-01-31") which_A <- which(cmt_data$NEW_DATE == A$NEW_DATE) # for next graph y_min <- min(A[3:13], B[3:13], C[3:13], na.rm=TRUE) y_max <- max(A[3:13], B[3:13], C[3:13], na.rm=TRUE) plot(x = 1:11, y = A[3:13], type="l", lty=1, col="black", ylim = c(y_min*.90, y_max*1.05), ylab="Interest Rate", xaxt="n", xlab='', main="Figure 2.4 The Term Structure of Interest Rates on DIfferent Dates") axis(1, at = axTicks(1), labels = substr(names(cmt_data[1, 3:13])[axTicks(1)],4,9)) grid() lines(x = 1:length(B[3:13]), y = B[3:13], lty = 3) lines(x = 1:length(C[3:13]), y = C[3:13], lty = 2) legend("bottomright", legend=c(format(C$NEW_DATE,"%B %Y"), format(B$NEW_DATE,"%B %Y"), format(A$NEW_DATE,"%B %Y")), lty=c(2,3,1))
# plot the interest rates over time y_min <- min(three_month_history, one_year_history, thirty_year_history, na.rm=TRUE) y_max <- max(three_month_history, one_year_history, thirty_year_history, na.rm=TRUE) plot(x = 1:length(three_month_history), y = three_month_history, type="l", lty=3, col="black", ylim = c(y_min*.90, y_max*1.05), ylab="Interest Rate", xlim = c(1,length(three_month_history)), xaxt="n", xlab='The 30-year has been in and out of favor', main="Figure 2.5 The Term Structure over Time") # ---------- format the x axis ------------------------------------------ year_vector <- format(cmt_data$NEW_DATE,format="%Y") axTick_vec <- axTicks(1)+1 axTick_vec[length(axTick_vec)] <- min(which(year_vector==format(Sys.Date(),"%Y"))) axTick_vec[length(axTick_vec)+1] <- axTicks(1)[length(axTicks(1))] axis(1, at = axTick_vec, labels = format(cmt_data$NEW_DATE,format="%Y")[axTick_vec]) # ---------- format the x axis ------------------------------------------ grid() lines(x = 1:length(one_year_history), y = one_year_history, lty = 1, col="blue") lines(x = 1:length(thirty_year_history), y = thirty_year_history, lty = 4, col="red") abline(v=which_A, lty=1) # from previous graph legend("topright", legend=c("3-month","1-year","30-year",paste0(format(A$NEW_DATE,"%b %Y"), ", Fig 2.4")), lty=c(3,1,4,1), col=c("black","blue","red","black"))
10Year Rates vs S&P 500
y_min <- min(ten_year_history, na.rm=TRUE) y_max <- max(ten_year_history, na.rm=TRUE) plot(x = 1:length(ten_year_history), y = ten_year_history, type="l", lty=3, col="black", ylim = c(y_min*.90, y_max*1.05), ylab=NA, xlim = c(1,length(ten_year_history)), xaxt="n", xlab=NA, main="Figure 2.5-extra 1 The 10-year vs the S&P 500") # ---------- format the x axis ------------------------------------------ year_vector <- format(cmt_data$NEW_DATE,format="%Y") axTick_vec <- axTicks(1)+1 axTick_vec[length(axTick_vec)] <- min(which(year_vector==format(Sys.Date(),"%Y"))) axTick_vec[length(axTick_vec)+1] <- axTicks(1)[length(axTicks(1))] axis(1, at = axTick_vec, labels = format(cmt_data$NEW_DATE,format="%Y")[axTick_vec]) # ---------- format the x axis ------------------------------------------ grid() # ----------------- S&P 500 ----------------- par(new = T) plot(x = 1:length(cmt_data$Adj.Close), y = log10(cmt_data$Adj.Close), type="l", axes=F, xlab=NA, ylab=NA, col="green") axis(side = 4) legend('topleft',legend=c("10-year Bond","S&P 500 Log10 Scale"), lty=c(3,1), col=c("black","green"))
10Year/1Year Spread vs S&P 500
spread <- ten_year_history - one_year_history y_min <- min(spread, na.rm=TRUE) y_max <- max(spread, na.rm=TRUE) plot(x = 1:length(spread), y = spread, type="l", lty=3, col="black", ylim = c(y_min*.90, y_max*1.05), ylab=NA, xlim = c(1,length(spread)), xaxt="n", xlab="Vertical lines are the highs before the crash", main="Figure 2.5-extra 2 The 10-year/1-year spread vs the S&P 500") abline(h=0.0, lty=2) abline(v=6364) # 1987-08-25 high before the crash abline(v=9510) # 2000-03-24 high before the crash abline(v=11392) # 2007-10-09 high before the crash # ---------- format the x axis ------------------------------------------ year_vector <- format(cmt_data$NEW_DATE,format="%Y") axTick_vec <- axTicks(1)+1 axTick_vec[length(axTick_vec)] <- min(which(year_vector==format(Sys.Date(),"%Y"))) axTick_vec[length(axTick_vec)+1] <- axTicks(1)[length(axTicks(1))] axis(1, at = axTick_vec, labels = format(cmt_data$NEW_DATE,format="%Y")[axTick_vec]) # ---------- format the x axis ------------------------------------------ grid() # ----------------- S&P 500 ----------------- sp500_idx_trim <- SP500() %>% dplyr::filter(Date>=cmt_data$NEW_DATE[1]) %>% dplyr::arrange(Date) par(new = T) plot(x = 1:length(cmt_data$Adj.Close), y = log10(cmt_data$Adj.Close), type="l", axes=F, xlab=NA, ylab=NA, col="green") axis(side = 4) legend('topleft',legend=c("10-year/1-year spread","S&P 500 Log10 Scale"), lty=c(3,1), col=c("black","green"))
PrintYieldCurves(dplyr::filter(cmt_data, cmt_data$NEW_DATE==as.Date("1987-08-25") | cmt_data$NEW_DATE==as.Date("2000-03-24") | cmt_data$NEW_DATE==as.Date("2007-10-09") | cmt_data$NEW_DATE==cmt_data$NEW_DATE[[nrow(cmt_data)]]), rows=c(1, 2, 3, 4), title="Yield Curves at Highs Before each Crash + today")
Section 2.4 Coupon Bonds
Example 2.7
$$Price = \frac{coupon}{2}\sum Z(t, T_i) + Z(t, T_n) \times 100$$
coupon <- 0.04375 (df_0.5 <- round(discount_factor(coupon, 0.5, 2), 5)) (df_1.0 <- round(discount_factor(coupon, 1.0, 2), 5)) (df_1.5 <- round(discount_factor(coupon, 1.5, 2), 5)) (df_2.0 <- round(discount_factor(coupon, 2.0, 2), 5)) (price <- (100*coupon)/2 * sum(df_0.5, df_1.0, df_1.5, df_2.0) + 100 * df_2.0) # Veronesi doesn't give us the yield just the df; # but why have a yield so minutely off from the coupon? # Mine's off, too; so chalk it up to these lousy computers. yld <- jrvFinance::bond.yield(as.Date("01-03-2006","%m-%d-%Y"), as.Date("10-31-2007","%m-%d-%Y"), coupon, freq=2, price=99.997, convention="ACT/ACT") knitr::kable(data.frame(coupon=coupon,yield=yld,difference=coupon-yld))
Example 2.9 Find Discount Factors with Equation Solving
$Ax = b$
$A$ is the cash flows, $b$ is the prices, $x$ is the discount factors
# bond1 p1 <- 98.3607 cash_flow1 = c(100, 0) # bond2 p2 <- 99.2343 c2 <- 0.0275 cash_flow2 = c(100*c2/2, 100*c2/2 + 100) b <- c(p1, p2) names(b) <- c("bond1","bond2") A <- matrix(c(cash_flow1, cash_flow2), nrow=2, byrow=TRUE) rownames(A) <- c("bond1", "bond2") colnames(A) <- c("T_0.5","T_1.0") x <- solve(A, b) names(x) <- c("Z(0, 0.5)", "Z(0, 1.0)") # A: the cash-flow matrix A # b: the price vector b # x: the Z vector x # reconstruct bond1 x[["Z(0, 0.5)"]] * cash_flow1[1] + x[["Z(0, 1.0)"]] * cash_flow1[2] # reconstruct bond2 x[["Z(0, 0.5)"]] * cash_flow2[1] + x[["Z(0, 1.0)"]] * cash_flow2[2]
Example 2.10 Bootstrap the next Z(0, T)
# bond3 has three cash flows p3 <- 99.1093 c3 <- 0.03 x[["Z(0, 1.5)"]] <- (p3 - c3/2*100 * sum(x)) / (100 * (1 + c3/2)) x
The Zboostrap Function
Zbootstrap prices <- c(p1, p2, p3) coupons <- c(0, c2, c3) Zbootstrap(prices, coupons)
Example 2.11 YTM
Data setup
# my thanks to # 1) for OCR # http://blog.sudobits.com/2013/01/22/ # image-to-text-converter-ocr-for-ubuntu-linux-mint/ # # 2) for text-to-data.frame: # http://stackoverflow.com/questions/30496474/ # reading-text-into-data-frame-where-string-values-contain-spaces # # Note: I could not get a numbered capture group greater than 9 to work # it appears to be a failure in R's regex implementation # data_raw <- '4.125 8/15/2008 0.5 100.9844 101.0156 101.0000 98.9590 2.0930 98.1572 98.2027 4.500 2/15/2009 1.0 102.6094 102.6406 102.6250 98.1892 1.8274 96.3484 96.4378 4.875 8/15/2009 1.5 104.4766 104.5078 104.4922 97.3147 1.8147 94.5729 94.7045 4.750 2/15/2010 2.0 105.5078 105.91 105.5234 96.2441 1.9141 92.8301 93.0024 4.125 8/15/2010 2.5 105.0859 105.1172 105.1016 95.0822 2.0172 91.1194 91.3309 5.000 2/15/2011 3.0 108.2344 108.2656 108.2500 93.7612 2.1473 89.4403 89.6895 5.000 8/15/2011 3.5 109.0000 109.0313 109.0156 92.2213 2.3137 87.7920 88.0775 4.875 2/15/2012 4.0 109.1719 109.2031 109.1875 90.6046 2.4666 86.1742 86.4945 4.375 8/15/2012 4.5 107.3281 107.3594 107.3438 88.7259 2.6582 84.5862 84.9400 3.875 2/15/2013 5.0 105.1406 105.1719 105.1563 86.9809 2.7896 83.0274 83.4134 4.250 8/15/2013 5.5 106.8125 106.8438 106.8281 85.0858 2.9365 81.4974 81.9142 4.000 2/15/2014 6.0 105.2344 105.2656 105.2500 83.1241 3.0806 79.9956 80.4420 4.250 8/15/2014 6.5 106.3281 106.3594 106.3438 81.1114 3.2207 78.5214 78.9962 4.000 2/15/2015 7.0 104.750 104.4063 104.3906 79.0613 3.564 77.0744 77.5765 4.250 8/15/2015 7.5 105.4063 105.75 105.4219 76.8759 3.5064 75.6541 76.1822 4.500 2/15/2016 8.0 106.7188 106.7500 106.7344 74.8256 3.6251 74.2600 74.8130 4.875 8/15/2016 8.5 109.0000 109.0313 109.0156 72.6763 3.7548 72.8915 73.4684 4.625 2/15/2017 9.0 106.9375 106.9688 106.9531 70.8392 3.8306 71.5483 72.1480 4.750 8/15/2017 9.5 107.8750 107.9063 107.8906 69.1582 3.8818 70.2298 70.8513 3.500 2/15/2018 10.0 97.8750 97.9063 97.8906 68.1581 3.8334 68.9356 69.5779' data_parsed <- readLines(textConnection(data_raw)) regexin <- "^ *(.*\\S) +(\\S+) +(\\S+) +(\\S+) +(\\S+) +(\\S+) +(\\S+) +(\\S+) +(\\S+) +(\\S+)$" regexout <- "\\1,\\2,\\3,\\4,\\5,\\6,\\7,\\8" #"\\9,\\10" table2.2 <- read.csv(text = sub(regexin, regexout, data_parsed), as.is = TRUE, header=FALSE,stringsAsFactors = FALSE) names(table2.2) <- c("coupon","maturity","time","bid","ask","mid","bootstrap","spot") #,"y=3.7","y=3.6") table2.2$maturity <- as.Date(table2.2$maturity, "%m/%d/%Y") table2.2$date <- as.Date("2008-02-15","%Y-%m-%d") str(table2.2) knitr::kable(table2.2)
Where do his spot rates come from?
# it's not YTM # ============ apply(table2.2, 1, function(x) YTM(as.numeric(x["bootstrap"]), as.numeric(x["coupon"]), as.numeric(x["time"]))) # it's not the continuously compounded rate (see Fact 2.7 p37) # =============================================== apply(table2.2, 1, function(x) -(log2(as.numeric(x["bootstrap"])/100) / as.numeric(x["time"])) * 100) # kinda looks like the n-times compounded annual rate (see Fact 2.6, p36) # ... but not quite # =============================================== apply(table2.2, 1, function(x) { n <- 2 Z <- as.numeric(x["bootstrap"])/100 t <- as.numeric(x["time"]) Zpow <- Z^(1/(n*t)) invpow <- 1/Zpow n * (invpow - 1) * 100 }) # how about the continuous CAGR? # YES! # (except time=7.0, probably an error in the table) # ====================================== apply(table2.2, 1, function(x) CAGR(as.numeric(x["bootstrap"]), # PV 100, # FV as.numeric(x["time"]), # fractional years type="continuous")*100) spot_rate
Demonstrate the derivation of the bootstrap data
Why does he multiply the Z(0, T) value by 100?
prices <- table2.2$mid coupons <- table2.2$coupon/100 Zbootstrap(prices, coupons) all.equal(Zbootstrap(prices, coupons), table2.2$bootstrap/100, tolerance = 1e-3)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.