tests/testthat/test-errors-itpC.R

In itp: The Interpolate, Truncate, Project (ITP) Root-Finding Algorithm

# Check that errors are triggered in itp_c()

wrap_itp_c <- function(f, interval, ..., epsilon = 1e-10,
                      k1 = 0.2 / (interval[2] - interval[1]), k2 = 2, n0 = 1) {
  itp_c(f = f, pars = list(...), a = interval[1], b = interval[2],
       epsilon = epsilon, k1 = k1, k2 = k2, n0 = n0)
}

# Log
log_ptr <- xptr_create("log")

# f not finite at both end points
test_that("f(a) or f(b) not finite", {
  testthat::expect_error(wrap_itp_c(f = log_ptr, c(0, 1)))
})

# Lambert
lambert_ptr <- xptr_create("lambert")

# a >= b
test_that("Lambert: a >= b", {
  testthat::expect_error(wrap_itp_c(lambert_ptr, c(1, -1)))
})

# End point error
test_that("Lambert: end point error", {
  testthat::expect_error(wrap_itp_c(lambert_ptr, c(-1, 0)))
})

# Missing interval
test_that("Lambert: missing interval", {
  testthat::expect_error(wrap_itp_c(lambert_ptr))
})

# Interval the wrong length
test_that("Lambert: interval length 1", {
  testthat::expect_error(wrap_itp_c(lambert_ptr, -1))
})
test_that("Lambert: interval length 3", {
  testthat::expect_error(wrap_itp_c(lambert_ptr, c(-1, 0, 1)))
})

# a >= b
test_that("Lambert: a >= b", {
  testthat::expect_error(wrap_itp_c(lambert_ptr, a = 1, b = -1))
})

# Inappropriate k2, not in [ 1, 1 + (1 + sqrt(5)) / 2 )
test_that("Lambert: k2 = 0.99", {
  testthat::expect_error(wrap_itp_c(lambert_ptr, c(-1, 1), k2 = 0.99))
})
test_that("Lambert: k2 = upper limit + 0.01", {
  testthat::expect_error(wrap_itp_c(lambert_ptr, c(-1, 1),
                             k2 = 1 + (1 + sqrt(5)) / 2 + 0.01))
})

# n0 < 0
test_that("Lambert: n0 < 0", {
  testthat::expect_error(wrap_itp_c(lambert_ptr, c(-1, 1), n0 = -1))
})

# f not an R function or an external pointer
test_that("Wrong f", {
  testthat::expect_error(wrap_itp_c(f = "lambert_ptr", c(-1, 1)))
})