tests/testthat/test_calc_CentralDose.R

In Luminescence: Comprehensive Luminescence Dating Data Analysis

## load data
data(ExampleData.DeValues, envir = environment())

temp <- calc_CentralDose(
  ExampleData.DeValues$CA1,
  plot = FALSE,
  verbose = FALSE)

set.seed(1)
temp_NA <- data.frame(rnorm(10)+5, rnorm(10)+5)
temp_NA[1,1] <- NA

test_that("input validation", {
  testthat::skip_on_cran()

  expect_error(calc_CentralDose(data = "error"),
               "'data' should be of class 'data.frame' or 'RLum.Results'")
  expect_error(calc_CentralDose(temp, sigmab = -10),
               "'sigmab' should be a single non-negative value")
  expect_error(calc_CentralDose(temp, sigmab = 10),
               "'sigmab' should be a value between 0 and 1 if log = TRUE")
  expect_error(calc_CentralDose(data.frame()),
               "should have at least two columns and two rows")
  expect_error(calc_CentralDose(iris, iris),
               "'sigmab' should be a single non-negative value")
  expect_error(calc_CentralDose(iris, log = NA),
               "'log' should be a single logical value")
  expect_error(calc_CentralDose(iris, plot = NA),
               "'plot' should be a single logical value")
  expect_error(calc_CentralDose(iris, verbose = NA),
               "'verbose' should be a single logical value")

  SW({
  expect_s4_class(calc_CentralDose(temp_NA), "RLum.Results")
  expect_warning(calc_CentralDose(temp, na.rm = FALSE),
                 "'na.rm' is deprecated, missing values are always")
  expect_message(calc_CentralDose(temp_NA),
                 "NA values removed from dataset")
  expect_error(calc_CentralDose(temp_NA[1:2, ]),
               "After NA removal, 'data' was left with fewer than two rows")
  expect_error(expect_message(calc_CentralDose(data.frame(a = -1:1, b = Inf)),
                              "Inf values found in 'data', replaced by NA"),
               "After NA removal, 'data' was left with fewer than two rows")
  })
})

test_that("check functionality", {
  testthat::skip_on_cran()

  SW({
  ## negative De values
  neg_vals <- data.frame(De = c(-0.56, -0.16, 0.0, 0.04),
                         De.err = c(0.15, 0.1, 0.12, 0.1))
  expect_warning(calc_CentralDose(neg_vals, log = TRUE),
                 "'data' contains non-positive De values, 'log' set to FALSE")

  ## negative De errors
  neg_errs <- data.frame(De = c(0.56, 0.16, 0.1, 0.04),
                         De.err = c(-0.15, -0.1, 0.12, -0.1))
  res1 <- calc_CentralDose(neg_errs)
  res2 <- calc_CentralDose(abs(neg_errs))
  res1@info$call <- res2@info$call <- NULL
  res1@.uid <- res2@.uid <- NA_character_
  expect_equal(res1, res2)
  })
})

test_that("snapshot tests", {
  testthat::skip_on_cran()

  snapshot.tolerance <- 1.5e-6
  expect_snapshot_RLum(temp,
                       tolerance = snapshot.tolerance)
  SW({
  expect_snapshot_RLum(calc_CentralDose(ExampleData.DeValues$CA1,
                                        log = FALSE, trace = TRUE),
                       tolerance = snapshot.tolerance)

  expect_snapshot_RLum(calc_CentralDose(temp_NA, log = FALSE),
                       expect_snapshot_output = TRUE,
                       tolerance = snapshot.tolerance)

  ## more coverage
  df <- data.frame(De = c(1e-160, 1e-156, 1e-120, 4e-22),
                   De.err = c(1e5, 1e40, 1e12, 1e28))
  expect_snapshot_RLum(calc_CentralDose(df),
                       expect_snapshot_output = TRUE,
                       tolerance = snapshot.tolerance)
  })
})

test_that("graphical snapshot tests", {
  testthat::skip_on_cran()
  testthat::skip_if_not_installed("vdiffr")

  SW({
  vdiffr::expect_doppelganger("default",
                              calc_CentralDose(ExampleData.DeValues$CA1))
  vdiffr::expect_doppelganger("log = FALSE",
                              calc_CentralDose(ExampleData.DeValues$CA1,
                                               log = FALSE))
  vdiffr::expect_doppelganger("sigmab 0.2",
                              calc_CentralDose(ExampleData.DeValues$CA1,
                                               sigmab = 0.2))
  vdiffr::expect_doppelganger("sigmab 0.3",
                              calc_CentralDose(ExampleData.DeValues$CA1,
                                               sigmab = 0.3))
  })
})

test_that("regression tests", {
  testthat::skip_on_cran()

  ## issue 1628
  expect_s4_class(calc_CentralDose(data.frame(De = rep(10, 3), err = 1:3),
                                   log = FALSE, verbose = FALSE),
                  "RLum.Results")
})