tests/testthat/test-ChangePos.R

In carbondate: Calibration and Summarisation of Radiocarbon Dates

test_that("ChangePos gives expected outcomes", {

  set.seed(14)
  rate_s <- initial_rate_s <- c(0, 2, 5, 7, 10)
  rate_h <- initial_rate_h <- c(5, 2, 4, 6)
  n_changepoints <- length(rate_s)
  integrated_rate <- .FindIntegral(
    initial_rate_s,
    initial_rate_h)

  n_theta <- 2 * integrated_rate # Double expected number

  calendar_ages <- stats::runif(
    n_theta,
    min = min(initial_rate_s),
    max = max(initial_rate_s))

  for(i in 1:1000) {
    return_val <- .ChangePos(
      theta = calendar_ages,
      rate_s = rate_s,
      rate_h = rate_h,
      integrated_rate = integrated_rate)

    rate_s <- return_rate_s <- return_val$rate_s
    integrated_rate <- return_integrated_rate <- return_val$integrated_rate
  }

  # Tests that changepoints are strictly increasing
  expect_true( all(diff(return_rate_s) > 0) )

  # Tests that number of changepoints hasn't varied
  expect_equal(
    length(return_rate_s),
    n_changepoints)

  # Test that first and last value of rate_s have remained same
  expect_equal(return_rate_s[1], initial_rate_s[1])
  expect_equal(
    return_rate_s[n_changepoints],
    initial_rate_s[n_changepoints])

  # Test that have updated integrated rate correctly
  expect_equal(
    return_integrated_rate,
    .FindIntegral(return_rate_s, rate_h)
  )

  # Test as to whether it has updated the positions
  expect_false(identical(return_rate_s, initial_rate_s))

})


### Second test
test_that("ChangePos gives same as legacy code", {

  set.seed(14)
  rate_s <- initial_rate_s <- c(0, 2, 5, 7, 10)
  rate_h <- initial_rate_h <- c(5, 2, 4, 6)
  n_changepoints <- length(rate_s)
  integrated_rate <- initial_integrated_rate <- .FindIntegral(
    initial_rate_s,
    initial_rate_h)

  n_theta <- 2 * integrated_rate # Double expected number

  calendar_ages <- stats::runif(
    n_theta,
    min = min(initial_rate_s),
    max = max(initial_rate_s))

  set.seed(11)
  for(i in 1:1000) {
    return_val <- .ChangePos(
      theta = calendar_ages,
      rate_s = rate_s,
      rate_h = rate_h,
      integrated_rate = integrated_rate)

    rate_s <- revised_rate_s <- return_val$rate_s
    integrated_rate <- revised_integrated_rate <- return_val$integrated_rate
  }

  set.seed(11)
  source(test_path("fixtures", "LegacyChangePos.R"))
  # Reset the starting values
  rate_h <- initial_rate_h
  rate_s <- initial_rate_s
  integrated_rate <- initial_integrated_rate
  for(i in 1:1000) {
    return_val <- LegacyChangePos(
      th = calendar_ages,
      s = rate_s,
      h = rate_h,
      intrate = integrated_rate)

    rate_s <- legacy_rate_s <- return_val$s
    integrated_rate <- legacy_integrated_rate <- return_val$intrate
  }

  # Test revised code gives same rate_s after running multiple time
  expect_identical(revised_rate_s, legacy_rate_s)

  # Test revised code gives same integrated rate after running multiple time
  expect_identical(revised_integrated_rate, legacy_integrated_rate)

})