tests/testthat/test-rcondvinecop.R

In portvine: Vine Based (Un)Conditional Portfolio Risk Measure Estimation

### r1conddvine -----------------------------------------------------
rcondvine_test_input <- data.frame(a = runif(100), b = rbeta(100, 2, 6))
rcondvine_test_input$c <- (rcondvine_test_input$a + rcondvine_test_input$b) / 2
rcondvine_test_input$d <- (rcondvine_test_input$a + rcondvine_test_input$b +
  rcondvine_test_input$c) / 3
rcondvine_test_input$e <- (rcondvine_test_input$d + rcondvine_test_input$b) / 2

rcondvine_test_struct <- rvinecopulib::dvine_structure(c(3, 4, 1, 5, 2))

rcondvine_test_fitted <- rvinecopulib::vinecop(
  data = rcondvine_test_input,
  family_set = "parametric", structure = rcondvine_test_struct,
  presel = FALSE
)


test_that("r1conddvine", {
  r1conddvine_res <- r1conddvine(
    n_samples = 111,
    cond_u = c(0.1, 0.8),
    cond_pre_resid = c(c = 0.2),
    fitted_vine = rcondvine_test_fitted
  )
  expect_true(
    checkmate::test_list(r1conddvine_res, len = 2)
  )
  expect_true(
    checkmate::test_data_table(
      r1conddvine_res$sample_dt,
      types = "numeric", any.missing = FALSE,
      nrows = 111 * 3,
      ncols = ncol(rcondvine_test_input),
      col.names = "unique"
    )
  )
  expect_equal(
    colnames(r1conddvine_res$sample_dt),
    colnames(rcondvine_test_input)
  )
  expect_equal(
    r1conddvine_res$sample_dt[[3]],
    rep(c(0.1, 0.8, 0.2), each = 111)
  )
  expect_equal(
    r1conddvine_res$cond_u_vec,
    rep(c(0.1, 0.8, "prior_resid"), each = 111)
  )
})


### r2conddvine -----------------------------------------------------

test_that("r2conddvine", {
  r2conddvine_res <- r2conddvine(
    n_samples = 111,
    cond_u = c(0.1, 0.8),
    cond_pre_resid = c(d = 0.33, c = 0.44),
    fitted_vine = rcondvine_test_fitted
  )
  expect_true(
    checkmate::test_list(r2conddvine_res, len = 2)
  )
  expect_true(
    checkmate::test_data_table(
      r2conddvine_res$sample_dt,
      types = "numeric", any.missing = FALSE,
      ncols = ncol(rcondvine_test_input),
      nrows = 111 * 3,
      col.names = "unique"
    )
  )
  expect_equal(
    colnames(r2conddvine_res$sample_dt),
    colnames(rcondvine_test_input)
  )
  expect_equal(
    r2conddvine_res$sample_dt[[4]],
    rep(c(0.1, 0.8, 0.33), each = 111)
  )
  expect_equal(
    r2conddvine_res$sample_dt[[3]][seq(111 * 2 + 1, 111 * 3)],
    rep(0.44, 111)
  )
  expect_equal(
    r2conddvine_res$cond_u_vec,
    rep(c(0.1, 0.8, "prior_resid"), each = 111)
  )
})

### rcondvinecop ----------------------------------------------------

test_that("rcondvinecop input checks", {
  expect_error(
    rcondvinecop(
      n_samples = 100, cond_u = c(0.01, 0.1),
      cond_pre_resid = c("a" = 0.4),
      cond_vars = "a",
      fitted_vine = rcondvine_test_fitted,
      vine_type = "rvine"
    )
  )
  expect_error(
    rcondvinecop(
      n_samples = 100, cond_u = c(0.01, 0.1),
      cond_pre_resid = c("a" = 0.4, "b" = 0.9, "c" = 0.3),
      cond_vars = c("a", "b", "c"),
      fitted_vine = rcondvine_test_fitted,
      vine_type = "dvine"
    )
  )
  expect_error(
    rcondvinecop(
      n_samples = 100, cond_u = c(0.01, 0.1),
      cond_pre_resid = c(0.9, 0.3),
      cond_vars = c("a", "b"),
      fitted_vine = rcondvine_test_fitted,
      vine_type = "dvine"
    )
  )
  expect_error(
    rcondvinecop(
      n_samples = 100, cond_u = c(0.01, 0.1),
      cond_pre_resid = c(a = 0.9, c = 0.3),
      cond_vars = c("a", "b"),
      fitted_vine = rcondvine_test_fitted,
      vine_type = "dvine"
    )
  )
  expect_error(
    rcondvinecop(
      n_samples = 100, cond_u = c(0.01, 0.1),
      cond_pre_resid = c(a = 0.9),
      cond_vars = c("a", "b"),
      fitted_vine = rcondvine_test_fitted,
      vine_type = "dvine"
    )
  )
})

test_that("rcondvinecop functionality", {
  # check that the behavior of the function resembles the correct sampling
  # function. First up: single conditional dvine
  rcondvinecop_res <- rcondvinecop(
    n_samples = 100, cond_u = c(0.01, 0.1),
    cond_pre_resid = c(c = 0.4),
    cond_vars = c("c"),
    fitted_vine = rcondvine_test_fitted,
    vine_type = "dvine"
  )
  expect_true(
    checkmate::test_list(rcondvinecop_res, len = 2)
  )
  expect_true(
    checkmate::test_data_table(
      rcondvinecop_res$sample_dt,
      types = "numeric", any.missing = FALSE,
      ncols = ncol(rcondvine_test_input),
      nrows = 3 * 100,
      col.names = "unique"
    )
  )
  expect_true(
    all(rcondvinecop_res$sample_dt <= 1 & rcondvinecop_res$sample_dt >= 0)
  )
  expect_equal(
    colnames(rcondvinecop_res$sample_dt),
    colnames(rcondvine_test_input)
  )
  expect_equal(
    rcondvinecop_res$sample_dt[[3]],
    rep(c(0.01, 0.1, 0.4), each = 100)
  )
  expect_equal(
    rcondvinecop_res$cond_u_vec,
    rep(c(0.01, 0.1, "prior_resid"), each = 100)
  )
  # now 2 conditional dvine
  rcondvinecop_res <- rcondvinecop(
    n_samples = 100, cond_u = c(0.01, 0.1),
    cond_pre_resid = c(d = 0.4, c = 0.44),
    cond_vars = c("c", "d"),
    fitted_vine = rcondvine_test_fitted,
    vine_type = "dvine"
  )
  expect_true(
    checkmate::test_list(rcondvinecop_res, len = 2)
  )
  expect_true(
    checkmate::test_data_table(
      rcondvinecop_res$sample_dt,
      types = "numeric", any.missing = FALSE,
      ncols = ncol(rcondvine_test_input),
      nrows = 100 * 3,
      col.names = "unique"
    )
  )
  expect_true(
    all(rcondvinecop_res$sample_dt <= 1 & rcondvinecop_res$sample_dt >= 0)
  )
  expect_equal(
    colnames(rcondvinecop_res$sample_dt),
    colnames(rcondvine_test_input)
  )
  expect_equal(
    rcondvinecop_res$sample_dt[[4]],
    rep(c(0.01, 0.1, 0.4), each = 100)
  )
  expect_equal(
    rcondvinecop_res$sample_dt[[3]][seq(100 * 2 + 1, 100 * 3)],
    rep(0.44, 100)
  )
  expect_equal(
    rcondvinecop_res$cond_u_vec,
    rep(c(0.01, 0.1, "prior_resid"), each = 100)
  )
})