tests/testthat/test-R-vs-Cpp.R

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

# Check that results from R and C++ agree

## Wiki

wiki <- function(x) x ^ 3 - x - 2
res1 <- itp(wiki, c(1, 2), k1 = 0.1, n0 = 1)
wiki_ptr <- xptr_create("wiki")
res2 <- itp(wiki_ptr, c(1, 2), k1 = 0.1, n0 = 1)
test_that("Wiki: R vs C++", {
  testthat::expect_equal(res1, res2, ignore_attr = TRUE)
})

# Repeat for -wiki, to check for a locally decreasing function
neg_wiki <- function(x) -wiki(x)
res1 <- itp(neg_wiki, c(1, 2), k1 = 0.1, n0 = 1)
neg_wiki_ptr <- xptr_create("neg_wiki")
res2 <- itp(neg_wiki_ptr, c(1, 2), k1 = 0.1, n0 = 1)
test_that("Negated wiki: R vs C++", {
  testthat::expect_equal(res1, res2, ignore_attr = TRUE)
})

## Lambert

lambert <- function(x) x * exp(x) - 1
res1 <- itp(lambert, c(-1, 1))
lambert_ptr <- xptr_create("lambert")
res2 <- itp(lambert_ptr, c(-1, 1))
test_that("Lambert: R vs C++", {
  testthat::expect_equal(res1, res2, ignore_attr = TRUE)
})

## Trig 1

trig1 <- function(x, root) tan(x - root)
res1 <- itp(trig1, c(-1, 1), root = 1 / 10)
trig1_ptr <- xptr_create("trig1")
res2 <- itp(trig1_ptr, c(-1, 1), root = 1 / 10)
test_that("Trig 1: R vs C++", {
  testthat::expect_equal(res1, res2, ignore_attr = TRUE)
})

## Poly 3

poly3 <- function(x) (x * 1e6 - 1) ^ 3
res1 <- itp(poly3, c(-1, 1))
poly3_ptr <- xptr_create("poly3")
res2 <- itp(poly3_ptr, c(-1, 1))
test_that("Poly 3: R vs C++", {
  testthat::expect_equal(res1, res2, ignore_attr = TRUE)
})

# Linear

linear <- function(x) x
res1 <- itp(linear, c(-1, 1))
linear_ptr <- xptr_create("linear")
res2 <- itp(linear_ptr, c(-1, 1))
test_that("Linear: R vs C++", {
  testthat::expect_equal(res1, res2, ignore_attr = TRUE)
})

# Staircase

staircase <- function(x) ceiling(10 * x - 1) + 1 / 2
res1 <- itp(staircase, c(-1, 1))
staircase_ptr <- xptr_create("staircase")
res2 <- itp(staircase_ptr, c(-1, 1))
test_that("Staircase: R vs C++ in (-1,1)", {
  testthat::expect_equal(res1, res2, ignore_attr = TRUE)
})