tests/testthat/test-dist_genpareto.R

In reservr: Fit Distributions and Neural Networks to Censored and Truncated Data

test_that("generalized pareto distribution works", {
  set.seed(1337L)

  genpareto <- dist_genpareto()
  test_grid <- expand.grid(
    u = c(1.0, -1.0),
    sigmau = c(1.0, 2.0),
    xi = c(-1.0, 0.0, 0.5)
  )
  xparams <- lapply(seq_len(nrow(test_grid)), function(i) {
    list(u = test_grid$u[i], sigmau = test_grid$sigmau[i], xi = test_grid$xi[i])
  })

  x1 <- genpareto$sample(100L, with_params = list(u = 0, sigmau = 1, xi = 1))
  x2 <- genpareto$sample(100L, with_params = list(u = 0, sigmau = 1, xi = 0))
  x3 <- genpareto$sample(100L, with_params = list(u = 0, sigmau = 1, xi = -1))

  my_pgpd <- function(q, u, sigmau, xi, lower.tail = TRUE, log.p = FALSE) {
    res <- evmix::pgpd(q = q, u = u, sigmau = sigmau, xi = xi,
                       lower.tail = lower.tail)
    if (log.p) log(res) else res
  }

  my_qgpd <- function(p, u, sigmau, xi, lower.tail = TRUE, log.p = FALSE) {
    if (log.p) p <- exp(p)
    evmix::qgpd(p = p, u = u, sigmau = sigmau, xi = xi, lower.tail = lower.tail)
  }

  expect_identical(genpareto$get_type(), "continuous")
  for (i in seq_len(nrow(test_grid))) {
    xx <- genpareto$sample(100L, with_params = xparams[[i]])
    xx_inner <- sort(xx)[6L:94L]
    expect_density(genpareto, evmix::dgpd, xparams[[i]], xx)
    expect_probability(genpareto, my_pgpd, xparams[[i]], xx)
    expect_quantile(genpareto, my_qgpd, xparams[[i]])
    expect_identical(
      genpareto$is_in_support(xx, with_params = xparams[[!!i]]),
      rep_len(TRUE, length(xx))
    )
    expect_diff_density(genpareto, xx_inner, xparams[[i]])
    expect_diff_probability(genpareto, xx_inner, xparams[[i]])
    expect_tf_logdensity(genpareto, xparams[[i]], xx, tolerance = 1.0e-6)
    expect_tf_logprobability(genpareto, xparams[[i]], xx, xx + 1.0)
    expect_tf_logprobability(genpareto, xparams[[i]], 0, xx)
    expect_tf_logprobability(genpareto, xparams[[i]], xx, Inf)

  }
  expect_tf_fit(genpareto, list(u = 0, sigmau = 1, xi = 1), I_POSITIVE_REALS)

  expect_diff_density(genpareto, x1, xparams[[1L]]) # Test out-of-support
  expect_diff_density(genpareto, x2, xparams[[1L]])
  expect_diff_density(genpareto, x3, xparams[[1L]])
  expect_diff_probability(genpareto, x1, xparams[[1L]]) # Test out-of-support
  expect_diff_probability(genpareto, x2, xparams[[1L]])
  expect_diff_probability(genpareto, x3, xparams[[1L]])
})

test_that("constrained generalized pareto distribution works", {
  const_dist <- dist_genpareto1()
  expect_identical(const_dist$get_param_bounds()$xi, I_UNIT_INTERVAL)
})