rate_curve: Creates a rate curve instance

Description Usage Arguments Note Examples

View source: R/CurveFuncs.R

Description

Creates a rate curve instance

Usage

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
rate_curve(
  rates = NULL,
  rate_type = "zero_eff",
  pers = 1:length(rates),
  rate_scale = 1,
  fun_d = NULL,
  fun_r = NULL,
  knots = seq.int(from = 1, to = max(pers), by = 1),
  functor = function(x, y) splinefun(x = x, y = y, method = "monoH.FC")
)

Arguments

rates

A rate vector

rate_type

The rate type. Must be on of c("fut", "zero_nom", "zero_eff", "swap", "zero_cont)

pers

The periods the rates correspond to

rate_scale

In how many periods is the rate expressed. For example, when measuring periods in days, and using annual rates, you should use 365. When measuring periods in months, and using annual rates, you should use 12. If no scaling, use 1.

fun_d

A discount factor function. fun_d(x) returns the discount factor for time x, vectorized on x

fun_r

A rate function. fun_r(x) returns the EPR for time x, vectorized on x

knots

The nodes used to bootstrap the rates. This is a mandatory argument if a rate function or discount function is provided

functor

A function with parameters x and y, that returns a function used to interpolate

Note

Currently a rate curve can only be built from one of the following sources

  1. A discount factor function

  2. A rate function and a rate type from the following types: "fut", "zero_nom", "zero_eff", "swap" or "zero_cont

  3. A rate vector, a pers vector and a rate type as before

Examples

1
2
3
rate_curve(rates = c(0.1, 0.2, 0.3), rate_type = "zero_eff")
rate_curve(fun_r = function(x) rep_len(0.1, length(x)), rate_type = "swap", knots = 1:12)
rate_curve(fun_d = function(x) 1 / (1 + x), knots = 1:12)

Example output

$f
function (x, deriv = 0, extrapol = c("linear", "cubic")) 
{
    extrapol <- match.arg(extrapol)
    deriv <- as.integer(deriv)
    if (deriv < 0 || deriv > 3) 
        stop("'deriv' must be between 0 and 3")
    i <- findInterval(x, x0, all.inside = (extrapol == "cubic"))
    if (deriv == 0) 
        interp <- function(x, i) {
            h <- dx[i]
            t <- (x - x0[i])/h
            t1 <- t - 1
            h01 <- t * t * (3 - 2 * t)
            h00 <- 1 - h01
            tt1 <- t * t1
            h10 <- tt1 * t1
            h11 <- tt1 * t
            y0[i] * h00 + h * m[i] * h10 + y0[i + 1] * h01 + 
                h * m[i + 1] * h11
        }
    else if (deriv == 1) 
        interp <- function(x, i) {
            h <- dx[i]
            t <- (x - x0[i])/h
            t1 <- t - 1
            h01 <- -6 * t * t1
            h10 <- (3 * t - 1) * t1
            h11 <- (3 * t - 2) * t
            (y0[i + 1] - y0[i])/h * h01 + m[i] * h10 + m[i + 
                1] * h11
        }
    else if (deriv == 2) 
        interp <- function(x, i) {
            h <- dx[i]
            t <- (x - x0[i])/h
            h01 <- 6 * (1 - 2 * t)
            h10 <- 2 * (3 * t - 2)
            h11 <- 2 * (3 * t - 1)
            ((y0[i + 1] - y0[i])/h * h01 + m[i] * h10 + m[i + 
                1] * h11)/h
        }
    else interp <- function(x, i) {
        h <- dx[i]
        h01 <- -12
        h10 <- 6
        h11 <- 6
        ((y0[i + 1] - y0[i])/h * h01 + m[i] * h10 + m[i + 1] * 
            h11)/h
    }
    if (extrapol == "linear" && any(iXtra <- (iL <- (i == 0)) | 
        (iR <- (i == (n <- length(x0)))))) {
        r <- x
        if (any(iL)) 
            r[iL] <- if (deriv == 0) 
                y0[1L] + m[1L] * (x[iL] - x0[1L])
            else if (deriv == 1) 
                m[1L]
            else 0
        if (any(iR)) 
            r[iR] <- if (deriv == 0) 
                y0[n] + m[n] * (x[iR] - x0[n])
            else if (deriv == 1) 
                m[n]
            else 0
        ini <- !iXtra
        r[ini] <- interp(x[ini], i[ini])
        r
    }
    else {
        interp(x, i)
    }
}
<bytecode: 0x4069660>
<environment: 0x47e0830>

$knots
[1] 1 2 3

$functor
function (x, y) 
splinefun(x = x, y = y, method = "monoH.FC")
<environment: 0x409c150>

$rate_scale
[1] 1

attr(,"class")
[1] "rate_curve"
$f
function (x, deriv = 0, extrapol = c("linear", "cubic")) 
{
    extrapol <- match.arg(extrapol)
    deriv <- as.integer(deriv)
    if (deriv < 0 || deriv > 3) 
        stop("'deriv' must be between 0 and 3")
    i <- findInterval(x, x0, all.inside = (extrapol == "cubic"))
    if (deriv == 0) 
        interp <- function(x, i) {
            h <- dx[i]
            t <- (x - x0[i])/h
            t1 <- t - 1
            h01 <- t * t * (3 - 2 * t)
            h00 <- 1 - h01
            tt1 <- t * t1
            h10 <- tt1 * t1
            h11 <- tt1 * t
            y0[i] * h00 + h * m[i] * h10 + y0[i + 1] * h01 + 
                h * m[i + 1] * h11
        }
    else if (deriv == 1) 
        interp <- function(x, i) {
            h <- dx[i]
            t <- (x - x0[i])/h
            t1 <- t - 1
            h01 <- -6 * t * t1
            h10 <- (3 * t - 1) * t1
            h11 <- (3 * t - 2) * t
            (y0[i + 1] - y0[i])/h * h01 + m[i] * h10 + m[i + 
                1] * h11
        }
    else if (deriv == 2) 
        interp <- function(x, i) {
            h <- dx[i]
            t <- (x - x0[i])/h
            h01 <- 6 * (1 - 2 * t)
            h10 <- 2 * (3 * t - 2)
            h11 <- 2 * (3 * t - 1)
            ((y0[i + 1] - y0[i])/h * h01 + m[i] * h10 + m[i + 
                1] * h11)/h
        }
    else interp <- function(x, i) {
        h <- dx[i]
        h01 <- -12
        h10 <- 6
        h11 <- 6
        ((y0[i + 1] - y0[i])/h * h01 + m[i] * h10 + m[i + 1] * 
            h11)/h
    }
    if (extrapol == "linear" && any(iXtra <- (iL <- (i == 0)) | 
        (iR <- (i == (n <- length(x0)))))) {
        r <- x
        if (any(iL)) 
            r[iL] <- if (deriv == 0) 
                y0[1L] + m[1L] * (x[iL] - x0[1L])
            else if (deriv == 1) 
                m[1L]
            else 0
        if (any(iR)) 
            r[iR] <- if (deriv == 0) 
                y0[n] + m[n] * (x[iR] - x0[n])
            else if (deriv == 1) 
                m[n]
            else 0
        ini <- !iXtra
        r[ini] <- interp(x[ini], i[ini])
        r
    }
    else {
        interp(x, i)
    }
}
<bytecode: 0x4069660>
<environment: 0x47fa788>

$knots
 [1]  1  2  3  4  5  6  7  8  9 10 11 12

$functor
function (x, y) 
splinefun(x = x, y = y, method = "monoH.FC")
<environment: 0x47e6990>

$rate_scale
[1] 1

attr(,"class")
[1] "rate_curve"
$f
function (x) 
1/(1 + x)

$knots
 [1]  1  2  3  4  5  6  7  8  9 10 11 12

$functor
function (x, y) 
splinefun(x = x, y = y, method = "monoH.FC")
<environment: 0x47fe4a8>

$rate_scale
[1] 1

attr(,"class")
[1] "rate_curve"

tvm documentation built on April 21, 2021, 9:07 a.m.