tests/testthat/test_calc_AverageDose.R

In Luminescence: Comprehensive Luminescence Dating Data Analysis

## load data
data(ExampleData.DeValues, envir = environment())
set.seed(1)
ADM <- calc_AverageDose(ExampleData.DeValues$CA1[1:56, ], sigma_m = 0.1,
                        plot = FALSE, verbose = FALSE)

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

  data <- ExampleData.DeValues$CA1
  expect_error(calc_AverageDose(),
               "'data' should be of class 'RLum.Results' or 'data.frame'")
  expect_error(calc_AverageDose("test"),
               "'data' should be of class 'RLum.Results' or 'data.frame'")
  expect_error(calc_AverageDose(data),
               "'sigma_m' should be a single positive value")
  expect_error(calc_AverageDose(data, sigma_m = NULL),
               "'sigma_m' should be a single positive value")
  expect_error(calc_AverageDose(data, sigma_m = 0.1, Nb_BE = NULL),
               "'Nb_BE' should be a single positive integer value")
  expect_message(expect_null(
      calc_AverageDose(data[, 1, drop = FALSE], sigma_m = 0.1)),
      "Error: 'data' contains < 2 columns")
  expect_message(expect_null(
      calc_AverageDose(data[0, ], sigma_m = 0.1)),
      "Error: 'data' contains no data, NULL returned")

  SW({
  expect_warning(calc_AverageDose(cbind(data, data), sigma_m = 0.1),
                 "'data' contains > 2 columns")
  expect_warning(calc_AverageDose(rbind(data, NA), sigma_m = 0.1),
                 "NA values in 'data' detected")
  expect_message(expect_null(
      calc_AverageDose(data.frame(NA, NA), sigma_m = 0.1)),
      "Error: After NA removal, nothing is left from the data set")
  expect_warning(expect_error(
      calc_AverageDose(data * c(1e-12, 1e12), sigma_m = 0.9),
      "Maximum likelihood estimation failed"),
      "Inf/NaN values produced by .mle(), NA returned", fixed = TRUE)
  })
})

test_that("check class and length of output", {
  testthat::skip_on_cran()

  snapshot.tolerance <- 1.5e-6

  expect_snapshot_RLum(ADM,
                       tolerance = snapshot.tolerance)
  expect_snapshot_RLum(
      calc_AverageDose(ExampleData.DeValues$CA1[1:56, ],
                       sigma_m = 0.9,
                       plot = FALSE),
      expect_snapshot_output = TRUE,
      tolerance = snapshot.tolerance)

  results <- get_RLum(ADM)

  expect_equal(round(results$AVERAGE_DOSE, digits = 4), 65.3597)
  expect_equal(round(results$SIGMA_D, digits = 4), 0.3092)
  expect_equal(round(results$L_MAX, digits = 5), -19.25096)

  ## RLum.Results
  expect_warning(calc_AverageDose(ADM, sigma_m = 0.1, verbose = FALSE, col = 1),
                 "'data' contains > 2 columns, only the first 2 columns were used")

  ## non-positive values
  data.zero <- ExampleData.DeValues$CA1
  data.zero[1, 1] <- 0
  expect_warning(calc_AverageDose(data.zero, sigma_m = 0.1, verbose = FALSE),
                 "Non-positive values in 'data' detected, rows removed")

  ## iteration limit reached
  SW({
  set.seed(1)
  expect_warning(calc_AverageDose(ExampleData.DeValues$CA1 * c(1e-2, 1e2),
                                  sigma_m = 0.9),
                 "No convergence reached by .mle() after 10000 iterations",
                 fixed = TRUE)
  })
})

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

  SW({
  vdiffr::expect_doppelganger("abanico",
                              plot_AbanicoPlot(data = ADM, z.0 = ADM$summary$de))
  })
})