Nothing
R/Step1_YieldCurveGeneration.R
In vamc: A Monte Carlo Valuation Framework for Variable Annuities
Defines functions
checkDCC
checkBDC
checkCalendar
checkHolidays
isLeapYear
leapYearDays
fracYear
isWeekend
isHolidayNY
isBusinessDay
rollDate
genSchedule
Initialize
logLinear
pvSwap
solve_rate
buildCurve
Documented in
buildCurve
# ------------------------------------------------------------------------------
# ----- Step1_YieldCurveGeneration.R -------------------------------------------
# ------------------------------------------------------------------------------
checkDCC <- function(dcc){
if (!(dcc == "Thirty360" || dcc == "ACT360"
|| dcc == "ACT365" || dcc == "ACTACT")){
errstr <- gsub("[\r\n]", "",
sprintf("dcc should be one of Thirty360, ACT360, ACT365, or ACTACT. Given %s.", dcc))
stop (errstr)
}
}
checkBDC <- function(bdc){
# Check if the business day convention bdc is a valid input ----------------
if (bdc != "Actual" && bdc != "Following" && bdc != "Preceding"
&& bdc != "Modified_Prec" && bdc != "Modified_Foll") {
errstr <- sprintf("Business day convention should be one of Actual, Following,
Preceding, Modified_Prec, or Modified_Foll.
Given %s.", bdc)
stop (errstr)
}
}
checkCalendar <- function(calendar){
# Check if the holiday calendar is a valid input -----------------
if (calendar != "General" && calendar != "NY"){
errstr <- sprintf("calendar should be one of General or NY. Given %s.",
calendar)
stop (errstr)
}
}
checkHolidays <- function(holidays){
# Check if the user-defined holidays is a valid input ------------------
if ((!is.null(holidays)) && (!inherits(holidays, "Date")) ) {
errstr <- sprintf("Holidays should be date type, given %s type.", typeof(holidays))
stop (errstr)
}
}
# ------------------------------------------------------------------------------
isLeapYear <- function(date){
# Indicate if the given date is in a leap year ----------------------------
# Input -------------------------------------------------------------------
# -- date: string "YYYY-MM-DD" or a Date data type -------------------------
# Output -------------------------------------------------------------------
# -- Binary, TRUE if date is in a leap year or FALSE otherwise -------------
date <- as.Date(date)
year <- as.numeric(format(date, format = "%Y"))
bres <- FALSE
if (year %% 4 == 0 && year %% 100 != 0) {
bres <- TRUE
}
if (year %% 400 == 0) {
bres <- TRUE
}
return(bres)
}
# ------------------------------------------------------------------------------
leapYearDays <- function(dateA, dateB){
# Calculate the number of days in leap years between dateA and dateB
# Input
# -- dateA: string "YYYY-MM-DD" or a Date data type
# -- dateB: string "YYYY-MM-DD" or a Date data type
# Output
# -- Integer number of days in leap years between dateA and dateB
dateA <- as.Date(dateA)
dateB <- as.Date(dateB)
if (dateA > dateB) {
return(leapYearDays(dateB, dateA))
}
# Then we can assume datA is before datB
yearA <- as.numeric(format(dateA, format = "%Y"))
yearB <- as.numeric(format(dateB, format = "%Y"))
days <- 0
for (y in yearA:yearB) {
dateTemp <- as.Date(paste(y, 1, 1, sep = "-"))
if (isLeapYear(dateTemp)) {
days <- days + as.Date(paste(y + 1, 1, 1, sep = "-")) - dateTemp
}
}
if (isLeapYear(dateA)) {
days <- days + (as.Date(paste(yearA - 1, 12, 31, sep = "-")) - dateA)
}
if (isLeapYear(dateB)) {
days <- days + (dateB - as.Date(paste(yearB, 12, 31, sep = "-")))
}
return(as.numeric(days))
}
# ------------------------------------------------------------------------------
fracYear <- function(dateA, dateB, dcc){
# Calculates the year fraction between dateA and dateB according to day
# count convention dcc
# Input
# -- dateA: string "YYYY-MM-DD" or a Date data type
# -- dateB: string "YYYY-MM-DD" or a Date data type
# -- dcc: string, day count convention
# -- Thirty360: 30 days a month, 360 days a year
# -- ACT360: actual day count, 360 days a year
# -- ACT365: actual day count, 365 days a year
# -- ACTACT: actual day count, actual days in a year
# Output
# -- double, year fraction between two dates
dateA <- as.Date(dateA)
dateB <- as.Date(dateB)
checkDCC(dcc)
if (dateB < dateA) {
return (fracYear(dateB, dateA, dcc))
}
yearA <- as.numeric(format(dateA, format = "%Y"))
yearB <- as.numeric(format(dateB, format = "%Y"))
monthA <- as.numeric(format(dateA, format = "%m"))
monthB <- as.numeric(format(dateB, format = "%m"))
dayA <- as.numeric(format(dateA, format = "%d"))
dayB <- as.numeric(format(dateB, format = "%d"))
if (dcc == "Thirty360") {
dayA <- min(dayA, 30)
if (dayB == 31 && dayA == 30) {
dayB <- 30
}
frac <- (yearB - yearA) + (monthB - monthA) / 12 + (dayB - dayA) / 360
}
else if (dcc == "ACT360") {
frac <- as.numeric((dateB - dateA)) / 360
}
else if (dcc == "ACT365") {
frac <- as.numeric((dateB - dateA)) / 365
}
else if (dcc == "ACTACT") {
leapDays <- leapYearDays(dateA, dateB)
nonLeapDays <- abs(as.numeric(dateB - dateA)) - leapDays
frac <- leapDays / 366 + nonLeapDays / 365
}
return (frac)
}
# ------------------------------------------------------------------------------
isWeekend <- function(date){
# Indicate whether the given date is a weekend
# Input:
# -- date: string "YYYY-MM-DD" or a Date data type
# Output:
# -- binary output, TRUE if date is a weekend or FALSE otherwise
date <- as.Date(date)
w <- weekdays(date)
if (w == "Saturday" || w == "Sunday"){
return (TRUE)
}else{
return (FALSE)
}
}
# ------------------------------------------------------------------------------
isHolidayNY <- function(date){
# Indicate whether the given date is a holiday based on New York holiday
# schedule
# Input:
# -- date: string "YYYY-MM-DD" or a Date data type
# Output:
# -- binary output, TRUE if holiday or FALSE otherwise
date <- as.Date(date)
w <- weekdays(date) # day of the week as string
d <- as.numeric(format(date, format = "%d")) # day in a month as numeric
m <- as.numeric(format(date, format = "%m")) # month in a year as numeric
if (# MLK day, third Mon in Jan
((d >= 15 && d <= 21) && w == "Monday" && m == 1)
# Washington's birthday, 3rd Mon in Feb
|| ((d >= 15 && d <= 21) && w == "Monday" && m == 2)
# Mamorial day, last Mon in may
|| (d >= 25 && w == "Monday" && m == 5)
# National day (Fri/Mon before/after)
|| ((d == 4 && m == 7) || (d == 5 && w == "Monday" && m == 7)
|| (d == 3 && w == "Friday" && m == 7))
# Labor day, 1st Mon in Sep
|| (d <= 7 && w == "Monday" && m == 9)
# Columbus day, 2nd Mon in Oct
|| ((d >= 8 && d <= 14) && w == "Monday" && m == 10)
# Veteran's day
|| ((d == 11 && m == 11) || (d == 12 && w == "Monday" && m == 11)
|| (d == 10 && w == "Friday" && m == 11))
# US thanksgiving, 4th Thu in Nov
|| ((d >= 22 && d <= 28) && w == "Thursday" && m == 11)
# Christmas (Fri/Mon before/after)
|| ((d == 25 && m == 12) || (d == 26 && w == "Monday" && m == 12)
|| (d == 24 && w == "Friday" && m == 12))
# New Year (Fri/Mon before/after)
|| ((d == 1 && m == 1) || (d == 2 && w == "Monday" && m == 1)
|| ((d == 31 && w == "Friday" && m == 12)))
){
return (TRUE)
} else {
return (FALSE)
}
}
# ------------------------------------------------------------------------------
isBusinessDay <- function(date, calendar, holidays){
# Indicates whether date is a business day based on calendar
# Input
# -- date: string "YYYY-MM-DD" or a Date data type
# -- calendar: string, indicate the desired calendar
# -- NY: New York holiday calendar
# -- General: all weekdays are business days
# Output
# -- Binary output, indicating whether the given date is a business day
date <- as.Date(date)
checkCalendar(calendar)
if(!is.null(holidays) && date >= min(holidays) && date <= max(holidays)){
return(date %in% holidays)
}
else if (calendar == "NY") {
return(!isWeekend(date) && !isHolidayNY(date))
}
else if (calendar == "General") {
return(!isWeekend(date))
}
}
# ------------------------------------------------------------------------------
rollDate <- function(date, bdc, calendar, holidays){
# Roll the given date to the nearest business day based on a a given
# business day convention bdc and holiday calendar calendar
# Input
# -- date: string "YYYY-MM-DD" or a Date data type
# -- bdc: string, business day convention
# -- Actual: No rolling on the date applied even if it is a non-business day
# -- Preceding: 1st business day before holiday
# -- Following: 1st business day after holiday
# -- Modified_Prec: Same as "Preceding" unless it belongs to a different
# month, in which case 1st business day after holiday
# -- Modified_Foll: Same as "Following" unless it belongs to a different
# month, in which case 1st business day before holiday
# -- calendar: string, indicate the desired calendar
# -- NY: New York holiday calendar
# -- General: all weekdays are business days
date <- as.Date(date)
checkCalendar(calendar)
checkBDC(bdc)
dateTemp <- date
while ( !bdc == "Actual" && !isBusinessDay(dateTemp, calendar, holidays)) {
if (bdc == "Following") {
dateTemp <- dateTemp + 1
} else if (bdc == "Preceding") {
dateTemp <- dateTemp - 1
} else if (bdc == "Modified_Prec") {
dateTemp <- rollDate(date, bdc = "Preceding", calendar, holidays)
if (format(dateTemp, format = "%m")
!= format(date, format = "%m")){
dateTemp <- rollDate(date, bdc = "Following", calendar, holidays)
}
}else if (bdc == "Modified_Foll") {
dateTemp <- rollDate(date, bdc = "Following", calendar, holidays)
if (format(dateTemp, format = "%m")
!= format(date, format = "%m")){
dateTemp <- rollDate(date, bdc = "Preceding", calendar, holidays)
}
}
}
return(dateTemp)
}
# -----------------------------------------------------------------------------
genSchedule <- function(settleDate, freq, tenor, calendar, bdc, holidays){
# Calculates an array of dates, spaced by freq months until tenor years.
# All dates are business days according to holiday calendar calendar and
# adjusted according to business day count convention bdc.
# Input
# -- settleDate: string "YYYY-MM-DD" or a Date data type,
# the settlement date
# -- freq: integer, frequency of payment in months, e.g., 3 for quarterly
# -- tenor: integer, number of years until maturity
# -- bdc: string, business day convention
# -- Actual: No rolling on the date applied even if it is a non-business day
# -- Preceding: 1st business day before holiday
# -- Following: 1st business day after holiday
# -- Modified_Prec: Same as "Preceding" unless it belongs to a different
# month, in which case 1st business day after holiday
# -- Modified_Foll: Same as "Following" unless it belongs to a different
# month, in which case 1st business day before holiday
# -- calendar: string, indicate the desired calendar
# -- NY: New York holiday calendar
# -- General: all weekdays are business days
settleDate <- as.Date(settleDate)
checkCalendar(calendar)
checkBDC(bdc)
count <- tenor * 12 / freq
month <- paste(toString(freq), "months", sep = " ")
schedule <- seq.Date(settleDate, length.out = count + 1, by = month)
for (i in 1:length(schedule)){
schedule[i] <- rollDate(schedule[i], bdc = bdc, calendar = calendar, holidays = holidays)
}
return (schedule)
}
# ------------------------------------------------------------------------------
Initialize <- function(rate, tenor, fixFreq, fixDCC, fltFreq, fltDCC,
calendar, bdc, curveDate, numSetDay, yieldCurveDCC, holidays){
# Rolls the settlement date based on yield curve observation date
# curveDateAnd and number of settlement dates numSetDay
# the first entry of discount vector to 1.
# Input
# -- rate: vector of doubles of zero coupon rates
# -- tenor: vector of integers corresponding tenors
# -- fixFreq: integer, fixed leg frequency of payment in months
# -- fixDCC: string, fixed leg DCC
# -- fltFreq: integer, floating leg frequency of payment in months
# -- fltDCC: string, floating leg DCC
# -- bdc: string, business day convention
# -- Actual: No rolling on the date applied even if it is a non-business day
# -- Preceding: 1st business day before holiday
# -- Following: 1st business day after holiday
# -- Modified_Prec: Same as "Preceding" unless it belongs to a different
# month, in which case 1st business day after holiday
# -- Modified_Foll: Same as "Following" unless it belongs to a different
# month, in which case 1st business day before holiday
# -- calendar: string, indicate the desired calendar
# -- NY: New York holiday calendar
# -- General: all weekdays are business days
# -- curveDate: string "YYYY-MM-DD" or a Date data type, yield curve date
# -- numSetDay: integer, number of settlement days from yield curve date
# -- yieldCurveDCC: Yield curve DCC
checkBDC(bdc)
checkCalendar(calendar)
checkDCC(fixDCC)
checkDCC(fltDCC)
checkDCC(yieldCurveDCC)
curveDate <- as.Date(curveDate)
settleDate <- curveDate
for (i in 1:numSetDay) {
settleDate <- rollDate(settleDate + 1, bdc = "Following",
calendar = calendar, holidays)
}
# initialize curveDate to curveDate and df to 1
curveDate <- c(curveDate)
df <- c(1)
return (data.frame(curveDate, df, settleDate))
}
# ------------------------------------------------------------------------------
logLinear <- function(dateIn, obsDate, discountFac, curveDate, yieldCurveDCC){
# Calculates the log-linearly interpolated/extrapolated discount factor at
# dateIn given the yield curve specified by the vector of discount factors
# discountFac and their corresponding tenors. The yield curve date is
# curveDate and the yield curve day count convention is yieldCurveDCC.
# Input
# -- dateIn: string "YYYY-MM-DD" or a Date data type, date of interest
# -- obsDate: vector of curveDate, tenors on observed yield curve
# -- discountFac: vector of doubles, discount factors on observe yield curve
# -- curveDate: string "YYYY-MM-DD" or a Date data type, yield curve date
# -- yieldCurveDCC: Yield curve DCC
checkDCC(yieldCurveDCC)
dateIn <- as.Date(dateIn)
obsDate <- as.Date(obsDate)
curveDate <- as.Date(curveDate)
N <- length(obsDate)
if (N < 2){
stop("Need at least two observed values to interpolate")
}
if (dateIn < min(obsDate)){
stop("Date is ealier than the curve date")
}
# if dateIn is already in obsDate, return its equivalent discount rate
if (dateIn %in% obsDate){
return (discountFac[which(obsDate == dateIn)])
}
# coding convenience: obsDate in the last interval unless identified
# otherwise
date1 <- obsDate[N - 1]
date2 <- obsDate[N]
dDF1 <- discountFac[N - 1]
dDF2 <- discountFac[N]
for (i in 1:(N - 1)) {
if (dateIn > obsDate[i] && dateIn < obsDate[i + 1]){
date1 <- obsDate[i]
date2 <- obsDate[i + 1]
dDF1 <- discountFac[i]
dDF2 <- discountFac[i + 1]
break
}
}
date1Frac <- fracYear(curveDate, date1, yieldCurveDCC)
date2Frac <- fracYear(curveDate, date2, yieldCurveDCC)
dInFrac <- fracYear(curveDate, dateIn, yieldCurveDCC)
# log-scale linear interpolation of discount factors
temp <- log(dDF2) * (dInFrac - date1Frac) + log(dDF1) *
(date2Frac - dInFrac)
return (exp(temp / (date2Frac - date1Frac)))
}
# ------------------------------------------------------------------------------
pvSwap <- function(rate, tenor, fixFreq, fixDCC, fltFreq, fltDCC,
calendar, bdc, curveDate, numSetDay, yieldCurveDCC,
paymentDate, discountFac, settleDate, holidays){
# Calculates the present value of an Interest rate Swap (IRS) by subtracting
# the present value of floating leg from that of fix leg under specified
# day count convention and holiday calendar.
# Input
# -- rate: double, given swap rate (fixed leg)
# -- tenor: integer, given tenor of swap
# -- fixFreq: integer, fixed leg frequency of payment in months
# -- fixDCC: string, fixed leg DCC
# -- fltFreq: integer, floating leg frequency of payment in months
# -- fltDCC: string, floating leg DCC
# -- bdc: string, business day convention
# -- Actual: No rolling on the date applied even if it is a non-business day
# -- Preceding: 1st business day before holiday
# -- Following: 1st business day after holiday
# -- Modified_Prec: Same as "Preceding" unless it belongs to a different
# month, in which case 1st business day after holiday
# -- Modified_Foll: Same as "Following" unless it belongs to a different
# month, in which case 1st business day before holiday
# -- calendar: string, indicate the desired calendar
# -- NY: New York holiday calendar
# -- General: all weekdays are business days
# -- curveDate: string "YYYY-MM-DD" or a Date data type, yield curve date
# -- numSetDay: integer, number of settlement days from yield curve date
# -- yieldCurveDCC: Yield curve DCC
# -- paymentDate: payment dates
# -- discountFac: discount factors on payment curveDate
# -- settleDate: settlement date
checkBDC(bdc)
checkCalendar(calendar)
checkDCC(fixDCC)
checkDCC(fltDCC)
checkDCC(yieldCurveDCC)
curveDate <- as.Date(curveDate)
settleDate <- as.Date(settleDate)
# Calculates the present value of fixed leg
fixSchedule <- genSchedule(settleDate, fixFreq, tenor, calendar, bdc, holidays)
fixPV <- 0
numFix <- length(fixSchedule)
if (numFix < 2) {
stop("Fixed leg has only one payment date.")
}
for (i in 2:numFix){
df <- logLinear(fixSchedule[i], paymentDate, discountFac,
curveDate, yieldCurveDCC)
fixPV <- fixPV + fracYear(fixSchedule[i - 1],
fixSchedule[i], fixDCC) * rate * df
}
# Calculates the present value of floating leg
fltSchedule <- genSchedule(settleDate, fltFreq, tenor, calendar, bdc, holidays)
fltPV <- 0
numFlt <- length(fltSchedule)
if (numFlt < 2) {
stop("Floating leg has only one payment date.")
}
for (i in 2:numFlt){
df <- logLinear(fltSchedule[i], paymentDate, discountFac,
curveDate, yieldCurveDCC)
dt <- fracYear(fltSchedule[i - 1], fltSchedule[i], fltDCC)
dfr <- (logLinear(fltSchedule[i - 1], paymentDate, discountFac,
curveDate, yieldCurveDCC) /
logLinear(fltSchedule[i], paymentDate, discountFac,
curveDate, yieldCurveDCC) - 1) / dt
fltPV <- fltPV + dt * dfr * df
}
return (fixPV - fltPV)
}
# ------------------------------------------------------------------------------
solve_rate <- function(index, swapRates, tenors, fixFreq, fixDCC,
fltFreq, fltDCC, calendar, bdc, curveDate,
numSetDay, yieldCurveDCC, paymentDate,
discountFac, settleDate, holidays){
# Secant method to solve for the discount rate such that the present value
# of a IRS equals zero
# Input
# -- index: integer, index of the input swap rate
# -- swapRates: vector of doubles of swap rates
# -- tenors: vector of integers of corresponding tenors
# -- fixFreq: integer, fixed leg frequency of payment in months
# -- fixDCC: string, fixed leg DCC
# -- fltFreq: integer, floating leg frequency of payment in months
# -- fltDCC: string, floating leg DCC
# -- bdc: string, business day convention
# -- calendar: string, indicate the desired calendar
# -- curveDate: string "YYYY-MM-DD" or a Date data type, yield curve date
# -- numSetDay: integer, number of settlement days from yield curve date
# -- yieldCurveDCC: Yield curve DCC
# -- paymentDate: payment dates
# -- discountFac: discount factors on payment dates
# -- settleDate: settlement date
# -- holidays: user-defined holidays
checkBDC(bdc)
checkCalendar(calendar)
checkDCC(fixDCC)
checkDCC(fltDCC)
checkDCC(yieldCurveDCC)
curveDate <- as.Date(curveDate)
settleDate <- as.Date(settleDate)
# pick the first initial discount rate rate0
rate0 <- exp(-swapRates[index] *
fracYear(as.Date(curveDate),
as.Date(paymentDate[index + 1]),
yieldCurveDCC))
discountFac[index + 1] <- rate0
df0 <- pvSwap(swapRates[index], tenors[index],
fixFreq, fixDCC, fltFreq, fltDCC,
calendar, bdc, curveDate, numSetDay, yieldCurveDCC,
paymentDate, discountFac, settleDate, holidays)
# pick the second initial discount rate rate1
rate1 <- rate0 + 0.001
discountFac[index + 1] <- rate1
df1 <- pvSwap(swapRates[index], tenors[index],
fixFreq, fixDCC, fltFreq, fltDCC,
calendar, bdc, curveDate, numSetDay, yieldCurveDCC,
paymentDate, discountFac, settleDate, holidays)
# apply Secant method with threshold 1e-10
while (abs(rate1 - rate0) >= 1e-10){
dx <- rate0 - df0 * (rate1 - rate0) / (df1 - df0)
discountFac[index + 1] <- dx
df <- pvSwap(swapRates[index], tenors[index],
fixFreq, fixDCC, fltFreq, fltDCC,
calendar, bdc, curveDate, numSetDay, yieldCurveDCC,
paymentDate, discountFac, settleDate, holidays)
rate0 <- rate1
df0 <- df1
rate1 <- dx
df1 <- df
}
return (discountFac[index + 1])
}
# ------------------------------------------------------------------------------
#' Build Curve
#'
#' @description Bootstrap discount factors from a yield curve.
#'
#' @param swapRates A vector of doubles of swap rates.
#' @param tenors A vector of integers of corresponding tenors.
#' @param fixFreq An integer of fixed leg frequency of payment in months.
#'
#' Default is 6, semi-annual payments.
#' @param fixDCC A string of fixed leg day count convention from four options:
#' "Thirty360", "ACT360", "ACT365", or "ACTACT".
#'
#' Default is "Thirty360".
#' @param fltFreq An integer of floating leg frequency of payment in months.
#'
#' Default is 6, semi-annual payments.
#' @param fltDCC A string of floating leg day count convention from four options:
#' "Thirty360", "ACT360", "ACT365", or "ACTACT".
#'
#' Default is "Thirty360".
#' @param bdc A string of business day convention from five options:
#' \itemize{
#' \item "Actual": No rolling on the date applied even if it is a non-business day
#' \item "Preceding": 1st business day before holiday
#' \item "Following": 1st business day after holiday
#' \item "Modified_Prec": Same as "Preceding" unless it belongs to a different
#' month, in which case 1st business day after holiday
#' \item "Modified_Foll": Same as "Following" unless it belongs to a different
#' month, in which case 1st business day before holiday
#' }
#' Default is "Actual".
#' @param calendar A string of the desired calendar convention
#' from two options:
#' \itemize{
#' \item "NY": New York holiday calendar
#' \item "General": all weekdays are business days
#' }
#' @param curveDate A string in the format of "YYYY-MM-DD" of yield curve date.
#' @param numSetDay An integer of settlement days from yield curve date.
#' @param yieldCurveDCC A string of yield curve day count convention from four options:
#' "Thirty360", "ACT360", "ACT365", or "ACTACT". Default is "Thirty360".
#' @param holidays An optional vector dates of user-defined holidays. If provided,
#' within the given holidays range, the calendar provided in the parameter "calendar"
#' will not be applied;
#'
#' If the date is not in the given holidays range, it will follow the calendar provided in
#' the "calendar" parameter
#'
#'
#' @return Outputs a data frame of strings of discount dates and doubles of
#' discount factors.
#' @examples
#' rate <- c(0.69, 0.77, 0.88, 1.01, 1.14, 1.38, 1.66, 2.15) * 0.01
#' tenor <- c(1, 2, 3, 4, 5, 7, 10, 30)
#' fixFreq <- 6
#' fixDCC <- "Thirty360"
#' fltFreq <- 6
#' fltDCC <- "ACT360"
#' calendar <- "NY"
#' bdc <- "Modified_Foll"
#' curveDate <- "2016-02-08"
#' numSetDay <- 2
#' yieldCurveDCC <- "Thirty360"
#' holidays <- NULL
#' buildCurve(rate, tenor, fixFreq, fixDCC, fltFreq, fltDCC, calendar, bdc,
#' curveDate, numSetDay, yieldCurveDCC, holidays)
#' @export
buildCurve <- function(swapRates,
tenors,
fixFreq = 6,
fixDCC = "Thirty360",
fltFreq = 6,
fltDCC = "Thirty360",
calendar = "General",
bdc = c("Actual", "Preceding", "Following", "Modified_Prec", "Modified_Foll"),
curveDate,
numSetDay,
yieldCurveDCC = "Thirty360",
holidays = NULL){
checkBDC(bdc)
checkCalendar(calendar)
checkDCC(fixDCC)
checkDCC(fltDCC)
checkDCC(yieldCurveDCC)
curveDate <- as.Date(curveDate)
checkHolidays(holidays)
if (length(swapRates) != length(tenors)){
stop("Number of discount factors is different from the number of
observation dates")
}
# temporary output: yield curve date dates, discount factor discountFac,
# and settlement date settleDate ---------------------------------------
outTemp <- Initialize(swapRates, tenors, fixFreq, fixDCC,
fltFreq, fltDCC, calendar, bdc,
curveDate, numSetDay, yieldCurveDCC, holidays)
settleDate <- outTemp$settleDate
numTenor <- length(tenors)
obsDate <- rep(outTemp$curveDate, numTenor + 1)
discountFac <- rep(outTemp$df, numTenor + 1)
# Set up maturity dates in the form of "YYYY-MM-DD"
for (i in 1:numTenor){
posixDate <- as.POSIXlt(settleDate)
posixDate$year <- posixDate$year + tenors[i]
obsDate[i + 1] <- as.Date(posixDate)
}
# Discount factors
for (i in 1:numTenor){
discountFac[i + 1] <- solve_rate(i, swapRates, tenors, fixFreq,
fixDCC, fltFreq, fltDCC, calendar,
bdc, curveDate, numSetDay, yieldCurveDCC,
obsDate[1:(i + 1)], discountFac[1:(i + 1)],
settleDate, holidays)
}
# Zero rate
zeroRate <- mat.or.vec(nr = numTenor + 1, nc = 1)
dayCount <- mat.or.vec(nr = numTenor + 1, nc = 1)
for (i in 1:(numTenor + 1)){
dayCount[i] <- fracYear(curveDate, obsDate[i], yieldCurveDCC)
if (dayCount[i] == 0) {
zeroRate[i] <- 0
} else {
zeroRate[i] <- -log(discountFac[i]) / dayCount[i]
}
}
# Forward Curve
forwardCurve <- mat.or.vec(nr = numTenor + 1, nc = 1)
for (i in 1:numTenor){
forwardCurve[i] <- (logLinear(obsDate[i], obsDate, discountFac,
curveDate, yieldCurveDCC) /
logLinear(obsDate[i + 1], obsDate, discountFac,
curveDate, yieldCurveDCC) - 1) /
fracYear(obsDate[i], obsDate[i + 1], yieldCurveDCC)
}
forwardCurve[numTenor + 1] <- forwardCurve[numTenor]
return (data.frame(obsDate, discountFac, zeroRate, forwardCurve, dayCount))
}
Try the vamc package in your browser
Any scripts or data that you put into this service are public.
vamc documentation built on Feb. 28, 2020, 5:08 p.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.
Defines functions checkDCC checkBDC checkCalendar checkHolidays isLeapYear leapYearDays fracYear isWeekend isHolidayNY isBusinessDay rollDate genSchedule Initialize logLinear pvSwap solve_rate buildCurve
Documented in buildCurve
# ------------------------------------------------------------------------------
# ----- Step1_YieldCurveGeneration.R -------------------------------------------
# ------------------------------------------------------------------------------
checkDCC <- function(dcc){
if (!(dcc == "Thirty360" || dcc == "ACT360"
|| dcc == "ACT365" || dcc == "ACTACT")){
errstr <- gsub("[\r\n]", "",
sprintf("dcc should be one of Thirty360, ACT360, ACT365, or ACTACT. Given %s.", dcc))
stop (errstr)
}
}
checkBDC <- function(bdc){
# Check if the business day convention bdc is a valid input ----------------
if (bdc != "Actual" && bdc != "Following" && bdc != "Preceding"
&& bdc != "Modified_Prec" && bdc != "Modified_Foll") {
errstr <- sprintf("Business day convention should be one of Actual, Following,
Preceding, Modified_Prec, or Modified_Foll.
Given %s.", bdc)
stop (errstr)
}
}
checkCalendar <- function(calendar){
# Check if the holiday calendar is a valid input -----------------
if (calendar != "General" && calendar != "NY"){
errstr <- sprintf("calendar should be one of General or NY. Given %s.",
calendar)
stop (errstr)
}
}
checkHolidays <- function(holidays){
# Check if the user-defined holidays is a valid input ------------------
if ((!is.null(holidays)) && (!inherits(holidays, "Date")) ) {
errstr <- sprintf("Holidays should be date type, given %s type.", typeof(holidays))
stop (errstr)
}
}
# ------------------------------------------------------------------------------
isLeapYear <- function(date){
# Indicate if the given date is in a leap year ----------------------------
# Input -------------------------------------------------------------------
# -- date: string "YYYY-MM-DD" or a Date data type -------------------------
# Output -------------------------------------------------------------------
# -- Binary, TRUE if date is in a leap year or FALSE otherwise -------------
date <- as.Date(date)
year <- as.numeric(format(date, format = "%Y"))
bres <- FALSE
if (year %% 4 == 0 && year %% 100 != 0) {
bres <- TRUE
}
if (year %% 400 == 0) {
bres <- TRUE
}
return(bres)
}
# ------------------------------------------------------------------------------
leapYearDays <- function(dateA, dateB){
# Calculate the number of days in leap years between dateA and dateB
# Input
# -- dateA: string "YYYY-MM-DD" or a Date data type
# -- dateB: string "YYYY-MM-DD" or a Date data type
# Output
# -- Integer number of days in leap years between dateA and dateB
dateA <- as.Date(dateA)
dateB <- as.Date(dateB)
if (dateA > dateB) {
return(leapYearDays(dateB, dateA))
}
# Then we can assume datA is before datB
yearA <- as.numeric(format(dateA, format = "%Y"))
yearB <- as.numeric(format(dateB, format = "%Y"))
days <- 0
for (y in yearA:yearB) {
dateTemp <- as.Date(paste(y, 1, 1, sep = "-"))
if (isLeapYear(dateTemp)) {
days <- days + as.Date(paste(y + 1, 1, 1, sep = "-")) - dateTemp
}
}
if (isLeapYear(dateA)) {
days <- days + (as.Date(paste(yearA - 1, 12, 31, sep = "-")) - dateA)
}
if (isLeapYear(dateB)) {
days <- days + (dateB - as.Date(paste(yearB, 12, 31, sep = "-")))
}
return(as.numeric(days))
}
# ------------------------------------------------------------------------------
fracYear <- function(dateA, dateB, dcc){
# Calculates the year fraction between dateA and dateB according to day
# count convention dcc
# Input
# -- dateA: string "YYYY-MM-DD" or a Date data type
# -- dateB: string "YYYY-MM-DD" or a Date data type
# -- dcc: string, day count convention
# -- Thirty360: 30 days a month, 360 days a year
# -- ACT360: actual day count, 360 days a year
# -- ACT365: actual day count, 365 days a year
# -- ACTACT: actual day count, actual days in a year
# Output
# -- double, year fraction between two dates
dateA <- as.Date(dateA)
dateB <- as.Date(dateB)
checkDCC(dcc)
if (dateB < dateA) {
return (fracYear(dateB, dateA, dcc))
}
yearA <- as.numeric(format(dateA, format = "%Y"))
yearB <- as.numeric(format(dateB, format = "%Y"))
monthA <- as.numeric(format(dateA, format = "%m"))
monthB <- as.numeric(format(dateB, format = "%m"))
dayA <- as.numeric(format(dateA, format = "%d"))
dayB <- as.numeric(format(dateB, format = "%d"))
if (dcc == "Thirty360") {
dayA <- min(dayA, 30)
if (dayB == 31 && dayA == 30) {
dayB <- 30
}
frac <- (yearB - yearA) + (monthB - monthA) / 12 + (dayB - dayA) / 360
}
else if (dcc == "ACT360") {
frac <- as.numeric((dateB - dateA)) / 360
}
else if (dcc == "ACT365") {
frac <- as.numeric((dateB - dateA)) / 365
}
else if (dcc == "ACTACT") {
leapDays <- leapYearDays(dateA, dateB)
nonLeapDays <- abs(as.numeric(dateB - dateA)) - leapDays
frac <- leapDays / 366 + nonLeapDays / 365
}
return (frac)
}
# ------------------------------------------------------------------------------
isWeekend <- function(date){
# Indicate whether the given date is a weekend
# Input:
# -- date: string "YYYY-MM-DD" or a Date data type
# Output:
# -- binary output, TRUE if date is a weekend or FALSE otherwise
date <- as.Date(date)
w <- weekdays(date)
if (w == "Saturday" || w == "Sunday"){
return (TRUE)
}else{
return (FALSE)
}
}
# ------------------------------------------------------------------------------
isHolidayNY <- function(date){
# Indicate whether the given date is a holiday based on New York holiday
# schedule
# Input:
# -- date: string "YYYY-MM-DD" or a Date data type
# Output:
# -- binary output, TRUE if holiday or FALSE otherwise
date <- as.Date(date)
w <- weekdays(date) # day of the week as string
d <- as.numeric(format(date, format = "%d")) # day in a month as numeric
m <- as.numeric(format(date, format = "%m")) # month in a year as numeric
if (# MLK day, third Mon in Jan
((d >= 15 && d <= 21) && w == "Monday" && m == 1)
# Washington's birthday, 3rd Mon in Feb
|| ((d >= 15 && d <= 21) && w == "Monday" && m == 2)
# Mamorial day, last Mon in may
|| (d >= 25 && w == "Monday" && m == 5)
# National day (Fri/Mon before/after)
|| ((d == 4 && m == 7) || (d == 5 && w == "Monday" && m == 7)
|| (d == 3 && w == "Friday" && m == 7))
# Labor day, 1st Mon in Sep
|| (d <= 7 && w == "Monday" && m == 9)
# Columbus day, 2nd Mon in Oct
|| ((d >= 8 && d <= 14) && w == "Monday" && m == 10)
# Veteran's day
|| ((d == 11 && m == 11) || (d == 12 && w == "Monday" && m == 11)
|| (d == 10 && w == "Friday" && m == 11))
# US thanksgiving, 4th Thu in Nov
|| ((d >= 22 && d <= 28) && w == "Thursday" && m == 11)
# Christmas (Fri/Mon before/after)
|| ((d == 25 && m == 12) || (d == 26 && w == "Monday" && m == 12)
|| (d == 24 && w == "Friday" && m == 12))
# New Year (Fri/Mon before/after)
|| ((d == 1 && m == 1) || (d == 2 && w == "Monday" && m == 1)
|| ((d == 31 && w == "Friday" && m == 12)))
){
return (TRUE)
} else {
return (FALSE)
}
}
# ------------------------------------------------------------------------------
isBusinessDay <- function(date, calendar, holidays){
# Indicates whether date is a business day based on calendar
# Input
# -- date: string "YYYY-MM-DD" or a Date data type
# -- calendar: string, indicate the desired calendar
# -- NY: New York holiday calendar
# -- General: all weekdays are business days
# Output
# -- Binary output, indicating whether the given date is a business day
date <- as.Date(date)
checkCalendar(calendar)
if(!is.null(holidays) && date >= min(holidays) && date <= max(holidays)){
return(date %in% holidays)
}
else if (calendar == "NY") {
return(!isWeekend(date) && !isHolidayNY(date))
}
else if (calendar == "General") {
return(!isWeekend(date))
}
}
# ------------------------------------------------------------------------------
rollDate <- function(date, bdc, calendar, holidays){
# Roll the given date to the nearest business day based on a a given
# business day convention bdc and holiday calendar calendar
# Input
# -- date: string "YYYY-MM-DD" or a Date data type
# -- bdc: string, business day convention
# -- Actual: No rolling on the date applied even if it is a non-business day
# -- Preceding: 1st business day before holiday
# -- Following: 1st business day after holiday
# -- Modified_Prec: Same as "Preceding" unless it belongs to a different
# month, in which case 1st business day after holiday
# -- Modified_Foll: Same as "Following" unless it belongs to a different
# month, in which case 1st business day before holiday
# -- calendar: string, indicate the desired calendar
# -- NY: New York holiday calendar
# -- General: all weekdays are business days
date <- as.Date(date)
checkCalendar(calendar)
checkBDC(bdc)
dateTemp <- date
while ( !bdc == "Actual" && !isBusinessDay(dateTemp, calendar, holidays)) {
if (bdc == "Following") {
dateTemp <- dateTemp + 1
} else if (bdc == "Preceding") {
dateTemp <- dateTemp - 1
} else if (bdc == "Modified_Prec") {
dateTemp <- rollDate(date, bdc = "Preceding", calendar, holidays)
if (format(dateTemp, format = "%m")
!= format(date, format = "%m")){
dateTemp <- rollDate(date, bdc = "Following", calendar, holidays)
}
}else if (bdc == "Modified_Foll") {
dateTemp <- rollDate(date, bdc = "Following", calendar, holidays)
if (format(dateTemp, format = "%m")
!= format(date, format = "%m")){
dateTemp <- rollDate(date, bdc = "Preceding", calendar, holidays)
}
}
}
return(dateTemp)
}
# -----------------------------------------------------------------------------
genSchedule <- function(settleDate, freq, tenor, calendar, bdc, holidays){
# Calculates an array of dates, spaced by freq months until tenor years.
# All dates are business days according to holiday calendar calendar and
# adjusted according to business day count convention bdc.
# Input
# -- settleDate: string "YYYY-MM-DD" or a Date data type,
# the settlement date
# -- freq: integer, frequency of payment in months, e.g., 3 for quarterly
# -- tenor: integer, number of years until maturity
# -- bdc: string, business day convention
# -- Actual: No rolling on the date applied even if it is a non-business day
# -- Preceding: 1st business day before holiday
# -- Following: 1st business day after holiday
# -- Modified_Prec: Same as "Preceding" unless it belongs to a different
# month, in which case 1st business day after holiday
# -- Modified_Foll: Same as "Following" unless it belongs to a different
# month, in which case 1st business day before holiday
# -- calendar: string, indicate the desired calendar
# -- NY: New York holiday calendar
# -- General: all weekdays are business days
settleDate <- as.Date(settleDate)
checkCalendar(calendar)
checkBDC(bdc)
count <- tenor * 12 / freq
month <- paste(toString(freq), "months", sep = " ")
schedule <- seq.Date(settleDate, length.out = count + 1, by = month)
for (i in 1:length(schedule)){
schedule[i] <- rollDate(schedule[i], bdc = bdc, calendar = calendar, holidays = holidays)
}
return (schedule)
}
# ------------------------------------------------------------------------------
Initialize <- function(rate, tenor, fixFreq, fixDCC, fltFreq, fltDCC,
calendar, bdc, curveDate, numSetDay, yieldCurveDCC, holidays){
# Rolls the settlement date based on yield curve observation date
# curveDateAnd and number of settlement dates numSetDay
# the first entry of discount vector to 1.
# Input
# -- rate: vector of doubles of zero coupon rates
# -- tenor: vector of integers corresponding tenors
# -- fixFreq: integer, fixed leg frequency of payment in months
# -- fixDCC: string, fixed leg DCC
# -- fltFreq: integer, floating leg frequency of payment in months
# -- fltDCC: string, floating leg DCC
# -- bdc: string, business day convention
# -- Actual: No rolling on the date applied even if it is a non-business day
# -- Preceding: 1st business day before holiday
# -- Following: 1st business day after holiday
# -- Modified_Prec: Same as "Preceding" unless it belongs to a different
# month, in which case 1st business day after holiday
# -- Modified_Foll: Same as "Following" unless it belongs to a different
# month, in which case 1st business day before holiday
# -- calendar: string, indicate the desired calendar
# -- NY: New York holiday calendar
# -- General: all weekdays are business days
# -- curveDate: string "YYYY-MM-DD" or a Date data type, yield curve date
# -- numSetDay: integer, number of settlement days from yield curve date
# -- yieldCurveDCC: Yield curve DCC
checkBDC(bdc)
checkCalendar(calendar)
checkDCC(fixDCC)
checkDCC(fltDCC)
checkDCC(yieldCurveDCC)
curveDate <- as.Date(curveDate)
settleDate <- curveDate
for (i in 1:numSetDay) {
settleDate <- rollDate(settleDate + 1, bdc = "Following",
calendar = calendar, holidays)
}
# initialize curveDate to curveDate and df to 1
curveDate <- c(curveDate)
df <- c(1)
return (data.frame(curveDate, df, settleDate))
}
# ------------------------------------------------------------------------------
logLinear <- function(dateIn, obsDate, discountFac, curveDate, yieldCurveDCC){
# Calculates the log-linearly interpolated/extrapolated discount factor at
# dateIn given the yield curve specified by the vector of discount factors
# discountFac and their corresponding tenors. The yield curve date is
# curveDate and the yield curve day count convention is yieldCurveDCC.
# Input
# -- dateIn: string "YYYY-MM-DD" or a Date data type, date of interest
# -- obsDate: vector of curveDate, tenors on observed yield curve
# -- discountFac: vector of doubles, discount factors on observe yield curve
# -- curveDate: string "YYYY-MM-DD" or a Date data type, yield curve date
# -- yieldCurveDCC: Yield curve DCC
checkDCC(yieldCurveDCC)
dateIn <- as.Date(dateIn)
obsDate <- as.Date(obsDate)
curveDate <- as.Date(curveDate)
N <- length(obsDate)
if (N < 2){
stop("Need at least two observed values to interpolate")
}
if (dateIn < min(obsDate)){
stop("Date is ealier than the curve date")
}
# if dateIn is already in obsDate, return its equivalent discount rate
if (dateIn %in% obsDate){
return (discountFac[which(obsDate == dateIn)])
}
# coding convenience: obsDate in the last interval unless identified
# otherwise
date1 <- obsDate[N - 1]
date2 <- obsDate[N]
dDF1 <- discountFac[N - 1]
dDF2 <- discountFac[N]
for (i in 1:(N - 1)) {
if (dateIn > obsDate[i] && dateIn < obsDate[i + 1]){
date1 <- obsDate[i]
date2 <- obsDate[i + 1]
dDF1 <- discountFac[i]
dDF2 <- discountFac[i + 1]
break
}
}
date1Frac <- fracYear(curveDate, date1, yieldCurveDCC)
date2Frac <- fracYear(curveDate, date2, yieldCurveDCC)
dInFrac <- fracYear(curveDate, dateIn, yieldCurveDCC)
# log-scale linear interpolation of discount factors
temp <- log(dDF2) * (dInFrac - date1Frac) + log(dDF1) *
(date2Frac - dInFrac)
return (exp(temp / (date2Frac - date1Frac)))
}
# ------------------------------------------------------------------------------
pvSwap <- function(rate, tenor, fixFreq, fixDCC, fltFreq, fltDCC,
calendar, bdc, curveDate, numSetDay, yieldCurveDCC,
paymentDate, discountFac, settleDate, holidays){
# Calculates the present value of an Interest rate Swap (IRS) by subtracting
# the present value of floating leg from that of fix leg under specified
# day count convention and holiday calendar.
# Input
# -- rate: double, given swap rate (fixed leg)
# -- tenor: integer, given tenor of swap
# -- fixFreq: integer, fixed leg frequency of payment in months
# -- fixDCC: string, fixed leg DCC
# -- fltFreq: integer, floating leg frequency of payment in months
# -- fltDCC: string, floating leg DCC
# -- bdc: string, business day convention
# -- Actual: No rolling on the date applied even if it is a non-business day
# -- Preceding: 1st business day before holiday
# -- Following: 1st business day after holiday
# -- Modified_Prec: Same as "Preceding" unless it belongs to a different
# month, in which case 1st business day after holiday
# -- Modified_Foll: Same as "Following" unless it belongs to a different
# month, in which case 1st business day before holiday
# -- calendar: string, indicate the desired calendar
# -- NY: New York holiday calendar
# -- General: all weekdays are business days
# -- curveDate: string "YYYY-MM-DD" or a Date data type, yield curve date
# -- numSetDay: integer, number of settlement days from yield curve date
# -- yieldCurveDCC: Yield curve DCC
# -- paymentDate: payment dates
# -- discountFac: discount factors on payment curveDate
# -- settleDate: settlement date
checkBDC(bdc)
checkCalendar(calendar)
checkDCC(fixDCC)
checkDCC(fltDCC)
checkDCC(yieldCurveDCC)
curveDate <- as.Date(curveDate)
settleDate <- as.Date(settleDate)
# Calculates the present value of fixed leg
fixSchedule <- genSchedule(settleDate, fixFreq, tenor, calendar, bdc, holidays)
fixPV <- 0
numFix <- length(fixSchedule)
if (numFix < 2) {
stop("Fixed leg has only one payment date.")
}
for (i in 2:numFix){
df <- logLinear(fixSchedule[i], paymentDate, discountFac,
curveDate, yieldCurveDCC)
fixPV <- fixPV + fracYear(fixSchedule[i - 1],
fixSchedule[i], fixDCC) * rate * df
}
# Calculates the present value of floating leg
fltSchedule <- genSchedule(settleDate, fltFreq, tenor, calendar, bdc, holidays)
fltPV <- 0
numFlt <- length(fltSchedule)
if (numFlt < 2) {
stop("Floating leg has only one payment date.")
}
for (i in 2:numFlt){
df <- logLinear(fltSchedule[i], paymentDate, discountFac,
curveDate, yieldCurveDCC)
dt <- fracYear(fltSchedule[i - 1], fltSchedule[i], fltDCC)
dfr <- (logLinear(fltSchedule[i - 1], paymentDate, discountFac,
curveDate, yieldCurveDCC) /
logLinear(fltSchedule[i], paymentDate, discountFac,
curveDate, yieldCurveDCC) - 1) / dt
fltPV <- fltPV + dt * dfr * df
}
return (fixPV - fltPV)
}
# ------------------------------------------------------------------------------
solve_rate <- function(index, swapRates, tenors, fixFreq, fixDCC,
fltFreq, fltDCC, calendar, bdc, curveDate,
numSetDay, yieldCurveDCC, paymentDate,
discountFac, settleDate, holidays){
# Secant method to solve for the discount rate such that the present value
# of a IRS equals zero
# Input
# -- index: integer, index of the input swap rate
# -- swapRates: vector of doubles of swap rates
# -- tenors: vector of integers of corresponding tenors
# -- fixFreq: integer, fixed leg frequency of payment in months
# -- fixDCC: string, fixed leg DCC
# -- fltFreq: integer, floating leg frequency of payment in months
# -- fltDCC: string, floating leg DCC
# -- bdc: string, business day convention
# -- calendar: string, indicate the desired calendar
# -- curveDate: string "YYYY-MM-DD" or a Date data type, yield curve date
# -- numSetDay: integer, number of settlement days from yield curve date
# -- yieldCurveDCC: Yield curve DCC
# -- paymentDate: payment dates
# -- discountFac: discount factors on payment dates
# -- settleDate: settlement date
# -- holidays: user-defined holidays
checkBDC(bdc)
checkCalendar(calendar)
checkDCC(fixDCC)
checkDCC(fltDCC)
checkDCC(yieldCurveDCC)
curveDate <- as.Date(curveDate)
settleDate <- as.Date(settleDate)
# pick the first initial discount rate rate0
rate0 <- exp(-swapRates[index] *
fracYear(as.Date(curveDate),
as.Date(paymentDate[index + 1]),
yieldCurveDCC))
discountFac[index + 1] <- rate0
df0 <- pvSwap(swapRates[index], tenors[index],
fixFreq, fixDCC, fltFreq, fltDCC,
calendar, bdc, curveDate, numSetDay, yieldCurveDCC,
paymentDate, discountFac, settleDate, holidays)
# pick the second initial discount rate rate1
rate1 <- rate0 + 0.001
discountFac[index + 1] <- rate1
df1 <- pvSwap(swapRates[index], tenors[index],
fixFreq, fixDCC, fltFreq, fltDCC,
calendar, bdc, curveDate, numSetDay, yieldCurveDCC,
paymentDate, discountFac, settleDate, holidays)
# apply Secant method with threshold 1e-10
while (abs(rate1 - rate0) >= 1e-10){
dx <- rate0 - df0 * (rate1 - rate0) / (df1 - df0)
discountFac[index + 1] <- dx
df <- pvSwap(swapRates[index], tenors[index],
fixFreq, fixDCC, fltFreq, fltDCC,
calendar, bdc, curveDate, numSetDay, yieldCurveDCC,
paymentDate, discountFac, settleDate, holidays)
rate0 <- rate1
df0 <- df1
rate1 <- dx
df1 <- df
}
return (discountFac[index + 1])
}
# ------------------------------------------------------------------------------
#' Build Curve
#'
#' @description Bootstrap discount factors from a yield curve.
#'
#' @param swapRates A vector of doubles of swap rates.
#' @param tenors A vector of integers of corresponding tenors.
#' @param fixFreq An integer of fixed leg frequency of payment in months.
#'
#' Default is 6, semi-annual payments.
#' @param fixDCC A string of fixed leg day count convention from four options:
#' "Thirty360", "ACT360", "ACT365", or "ACTACT".
#'
#' Default is "Thirty360".
#' @param fltFreq An integer of floating leg frequency of payment in months.
#'
#' Default is 6, semi-annual payments.
#' @param fltDCC A string of floating leg day count convention from four options:
#' "Thirty360", "ACT360", "ACT365", or "ACTACT".
#'
#' Default is "Thirty360".
#' @param bdc A string of business day convention from five options:
#' \itemize{
#' \item "Actual": No rolling on the date applied even if it is a non-business day
#' \item "Preceding": 1st business day before holiday
#' \item "Following": 1st business day after holiday
#' \item "Modified_Prec": Same as "Preceding" unless it belongs to a different
#' month, in which case 1st business day after holiday
#' \item "Modified_Foll": Same as "Following" unless it belongs to a different
#' month, in which case 1st business day before holiday
#' }
#' Default is "Actual".
#' @param calendar A string of the desired calendar convention
#' from two options:
#' \itemize{
#' \item "NY": New York holiday calendar
#' \item "General": all weekdays are business days
#' }
#' @param curveDate A string in the format of "YYYY-MM-DD" of yield curve date.
#' @param numSetDay An integer of settlement days from yield curve date.
#' @param yieldCurveDCC A string of yield curve day count convention from four options:
#' "Thirty360", "ACT360", "ACT365", or "ACTACT". Default is "Thirty360".
#' @param holidays An optional vector dates of user-defined holidays. If provided,
#' within the given holidays range, the calendar provided in the parameter "calendar"
#' will not be applied;
#'
#' If the date is not in the given holidays range, it will follow the calendar provided in
#' the "calendar" parameter
#'
#'
#' @return Outputs a data frame of strings of discount dates and doubles of
#' discount factors.
#' @examples
#' rate <- c(0.69, 0.77, 0.88, 1.01, 1.14, 1.38, 1.66, 2.15) * 0.01
#' tenor <- c(1, 2, 3, 4, 5, 7, 10, 30)
#' fixFreq <- 6
#' fixDCC <- "Thirty360"
#' fltFreq <- 6
#' fltDCC <- "ACT360"
#' calendar <- "NY"
#' bdc <- "Modified_Foll"
#' curveDate <- "2016-02-08"
#' numSetDay <- 2
#' yieldCurveDCC <- "Thirty360"
#' holidays <- NULL
#' buildCurve(rate, tenor, fixFreq, fixDCC, fltFreq, fltDCC, calendar, bdc,
#' curveDate, numSetDay, yieldCurveDCC, holidays)
#' @export
buildCurve <- function(swapRates,
tenors,
fixFreq = 6,
fixDCC = "Thirty360",
fltFreq = 6,
fltDCC = "Thirty360",
calendar = "General",
bdc = c("Actual", "Preceding", "Following", "Modified_Prec", "Modified_Foll"),
curveDate,
numSetDay,
yieldCurveDCC = "Thirty360",
holidays = NULL){
checkBDC(bdc)
checkCalendar(calendar)
checkDCC(fixDCC)
checkDCC(fltDCC)
checkDCC(yieldCurveDCC)
curveDate <- as.Date(curveDate)
checkHolidays(holidays)
if (length(swapRates) != length(tenors)){
stop("Number of discount factors is different from the number of
observation dates")
}
# temporary output: yield curve date dates, discount factor discountFac,
# and settlement date settleDate ---------------------------------------
outTemp <- Initialize(swapRates, tenors, fixFreq, fixDCC,
fltFreq, fltDCC, calendar, bdc,
curveDate, numSetDay, yieldCurveDCC, holidays)
settleDate <- outTemp$settleDate
numTenor <- length(tenors)
obsDate <- rep(outTemp$curveDate, numTenor + 1)
discountFac <- rep(outTemp$df, numTenor + 1)
# Set up maturity dates in the form of "YYYY-MM-DD"
for (i in 1:numTenor){
posixDate <- as.POSIXlt(settleDate)
posixDate$year <- posixDate$year + tenors[i]
obsDate[i + 1] <- as.Date(posixDate)
}
# Discount factors
for (i in 1:numTenor){
discountFac[i + 1] <- solve_rate(i, swapRates, tenors, fixFreq,
fixDCC, fltFreq, fltDCC, calendar,
bdc, curveDate, numSetDay, yieldCurveDCC,
obsDate[1:(i + 1)], discountFac[1:(i + 1)],
settleDate, holidays)
}
# Zero rate
zeroRate <- mat.or.vec(nr = numTenor + 1, nc = 1)
dayCount <- mat.or.vec(nr = numTenor + 1, nc = 1)
for (i in 1:(numTenor + 1)){
dayCount[i] <- fracYear(curveDate, obsDate[i], yieldCurveDCC)
if (dayCount[i] == 0) {
zeroRate[i] <- 0
} else {
zeroRate[i] <- -log(discountFac[i]) / dayCount[i]
}
}
# Forward Curve
forwardCurve <- mat.or.vec(nr = numTenor + 1, nc = 1)
for (i in 1:numTenor){
forwardCurve[i] <- (logLinear(obsDate[i], obsDate, discountFac,
curveDate, yieldCurveDCC) /
logLinear(obsDate[i + 1], obsDate, discountFac,
curveDate, yieldCurveDCC) - 1) /
fracYear(obsDate[i], obsDate[i + 1], yieldCurveDCC)
}
forwardCurve[numTenor + 1] <- forwardCurve[numTenor]
return (data.frame(obsDate, discountFac, zeroRate, forwardCurve, dayCount))
}
Try the vamc package in your browser
Any scripts or data that you put into this service are public.
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.