tests/testthat/test-estimation.R

In FinYang/ycevo: Nonparametric Estimation of the Yield Curve Evolution

set.seed(1)
bonds <- ycevo_data(n = 10)
res_both <- ycevo(bonds, x = lubridate::ymd(c("2023-03-01"), c("2023-06-01")))
res <- res_both[1,]

test_that("Simulation example", {
  expect_equal(
    head(res$.est[[1]])$tau,
    c(0.0821917808219178, 0.164383561643836, 0.246575342465753, 0.328767123287671,
      0.410958904109589, 0.493150684931507)
  )
  expect_equal(
    tail(res$.est[[1]])$tau,
    c(14.1369863013699, 15.7808219178082, 16.1095890410959, 16.4383561643836,
      18.0821917808219, 18.4109589041096)
  )
  expect_equal(
    head(res$.est[[1]])$.discount,
    c(0.986225688985458, 0.997535179957893, 0.987335706233562, 0.981574003055008,
      0.986434647687132, 0.984658120829134)
  )
  expect_equal(
    tail(res$.est[[1]])$.discount,
    c(0.25173267449438, 0.169062343884191, 0.166603074969578, 0.160818163510621,
      0.100182473682101, 0.0998222330332958)
  )
  expect_equal(
    head(res$.est[[1]])$.yield,
    c(0.168752361106433, 0.0150128314968472, 0.0516887429025604,
      0.0565685218322941, 0.0332349590672765, 0.0313510332302356)
  )
  expect_equal(
    tail(res$.est[[1]])$.yield,
    c(0.0975729579577046, 0.11263594143703, 0.111246853513618, 0.111171759097201,
      0.127239111655866, 0.125162646692807)
  )
})

augmented_res <- augment(res, loess = FALSE)

test_that("Augmentation without loess", {
  expect_equal(
    head(augmented_res)$tau,
    c(0.0821917808219178, 0.164383561643836, 0.246575342465753, 0.328767123287671,
      0.410958904109589, 0.493150684931507)
  )
  expect_equal(
    tail(augmented_res)$tau,
    c(14.1369863013699, 15.7808219178082, 16.1095890410959, 16.4383561643836,
      18.0821917808219, 18.4109589041096)
  )
  expect_equal(
    head(augmented_res)$.discount,
    c(0.986225688985458, 0.997535179957893, 0.987335706233562, 0.981574003055008,
      0.986434647687132, 0.984658120829134)
  )
  expect_equal(
    tail(augmented_res)$.discount,
    c(0.25173267449438, 0.169062343884191, 0.166603074969578, 0.160818163510621,
      0.100182473682101, 0.0998222330332958)
  )
  expect_equal(
    head(augmented_res)$.yield,
    c(0.168752361106433, 0.0150128314968472, 0.0516887429025604,
      0.0565685218322941, 0.0332349590672765, 0.0313510332302356)
  )
  expect_equal(
    tail(augmented_res)$.yield,
    c(0.0975729579577046, 0.11263594143703, 0.111246853513618, 0.111171759097201,
      0.127239111655866, 0.125162646692807)
  )
})

loess_res <- augment(res, loess = TRUE)
test_that("Augmentation with loess", {
  expect_equal(
    head(loess_res)$tau,
    c(0.0821917808219178, 0.164383561643836, 0.246575342465753, 0.328767123287671,
      0.410958904109589, 0.493150684931507)
  )
  expect_equal(
    tail(loess_res)$tau,
    c(14.1369863013699, 15.7808219178082, 16.1095890410959, 16.4383561643836,
      18.0821917808219, 18.4109589041096)
  )
  expect_equal(
    head(loess_res)$.discount,
    c(0.988883162893306, 0.987501222017339, 0.986055618108189, 0.984546532186519,
      0.982974149614928, 0.981338672708148)
  )
  expect_equal(
    tail(loess_res)$.discount,
    c(0.244210089032949, 0.175654062323753, 0.1638048559747, 0.15255635355698,
      0.104834023072191, 0.0968784681344841)
  )
  expect_equal(
    head(loess_res)$.yield,
    c(0.136012273194597, 0.0765133970570866, 0.0569502125082803,
      0.0473712732385921, 0.0417863111143431, 0.0381985617233583)
  )
  expect_equal(
    tail(loess_res)$.yield,
    c(0.0997190188541892, 0.110212179202032, 0.112298299952432, 0.114380124196802,
      0.124729177717189, 0.126788506997888)
  )
})

newdata <- data.frame(
  qdate = lubridate::ymd(c("2023-02-01", "2023-03-01","2023-04-01", "2023-06-01", "2023-07-01")),
  tau = c(10)
)
predict_res <- augment(res_both, newdata = newdata)
test_that("Prediction", {
  expect_equal(predict_res$qdate, newdata$qdate)
  expect_equal(predict_res$tau, rep(10, 5))
  expect_equal(predict_res$.discount,
               c(0.48348414263405, 0.48348414263405, 0.495452546406272, 0.519875259439203,
                 0.519875259439203))
  expect_equal(predict_res$.yield,
               c(0.0726736761660645, 0.0726736761660645, 0.0702283698907689,
                 0.065416638187768, 0.065416638187768))
})

data <- structure(list(mat_days = c(180, 360, 360, 540, 540, 540, 720,
                                    720, 720, 720), qdate = structure(c(18262, 18262, 18262, 18262,
                                                                        18262, 18262, 18262, 18262, 18262, 18262), class = "Date"), issue_date = structure(c(18262,
                                                                                                                                                             18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262, 18262
                                                                        ), class = "Date"), coupon = c(0, 1, 1, 1, 1, 1, 1, 1, 1, 1),
                       id = c(1L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 4L), mat_date = structure(c(18442,
                                                                                                  18622, 18622, 18802, 18802, 18802, 18982, 18982, 18982, 18982
                       ), class = "Date"), paydates = structure(c(18442, 18622,
                                                                  18442, 18802, 18622, 18442, 18982, 18802, 18622, 18442), class = "Date"),
                       pdint = c(100, 101, 1, 101, 1, 1, 101, 1, 1, 1), tumat = c(180,
                                                                                  360, 360, 540, 540, 540, 720, 720, 720, 720), tupq = c(180,
                                                                                                                                         360, 180, 540, 360, 180, 720, 540, 360, 180), accint = c(0,
                                                                                                                                                                                                  0, 0, 0, 0, 0, 0, 0, 0, 0), discount = c(0.980188189018042,
                                                                                                                                                                                                                                           0.965437020388093, 0.980188189018042, 0.951556097548637,
                                                                                                                                                                                                                                           0.965437020388093, 0.980188189018042, 0.936504311580234,
                                                                                                                                                                                                                                           0.951556097548637, 0.965437020388093, 0.980188189018042),
                       price = c(98.0188189018042, 98.4893272482154, 98.4893272482154,
                                     98.0527910618185, 98.0527910618185, 98.0527910618185, 97.4841167765584,
                                     97.4841167765584, 97.4841167765584, 97.4841167765584)), class = c("tbl_df",
                                                                                                       "tbl", "data.frame"), row.names = c(NA, -10L))

mat_weights_qdatetime <- get_weights(1,1, length(unique(data$qdate)))
tupq_idx <- structure(c(2L, 182L, 362L, 542L, 358L, 538L, 718L, 720L), dim = c(4L, 2L))
mat_weights_tau <- get_weights(
  c(0.493150684931507, 0.986301369863014, 1.47945205479452, 1.97260273972603),
  c(0.493150684931507, 0.493150684931507, 0.49315068493151, 0.49315068493151),
  len = as.integer(max(data$tupq)),
  units = 365)
cfp_slist <- ycevo:::get_cfp_slist(data)
price_slist <- cfp_slist$price_slist
cf_slist <- cfp_slist$cf_slist
test_that("Simplest example cpp", {
  expect_equal(
    calc_dbar_c(4L,
                structure(c(1L, 1L), dim = 1:2),
                tupq_idx,
                mat_weights_tau, mat_weights_qdatetime, price_slist, cf_slist),
    structure(c(5678.94832046269, 5705.41441494833, 5625.45900788638,
                5538.31638436822, 5626.6875, 5739.1875, 5738.625, 5738.0625), dim = c(4L, 2L)))
})