tests/testthat/test_correct_PMTLinearity.R

In Luminescence: Comprehensive Luminescence Dating Data Analysis

## load data
tmp <- matrix(data = c(seq(0, 1, 0.1), seq(10000, 1000, length.out = 11)),
              ncol = 2)
o0 <- set_RLum("RLum.Analysis",
               records = list(set_RLum("RLum.Data.Curve")))
o1 <- set_RLum("RLum.Analysis",
              records = list(set_RLum("RLum.Data.Curve", data = tmp)))
o2 <- set_RLum("RLum.Analysis",
               records = list(set_RLum("RLum.Data.Curve", data = tmp),
                              set_RLum("RLum.Data.Image")))

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

  expect_error(
      object = correct_PMTLinearity("error", PMT_pulse_pair_resolution = 10),
      regexp = "'object' should be of class 'RLum.Analysis'")
  expect_error(correct_PMTLinearity(set_RLum("RLum.Data.Curve"),
                                    PMT_pulse_pair_resolution = NA),
               "'PMT_pulse_pair_resolution' should be a single positive value or NULL")
})

test_that("Test internals", {
  testthat::skip_on_cran()

  ## try RLum.Data.Curve
  o <- set_RLum("RLum.Data.Curve")
  expect_s4_class(
      object = correct_PMTLinearity(o, PMT_pulse_pair_resolution = 10),
      class = "RLum.Data.Curve")

  ## try special case with zero channel resolution that would create NA values
  data <- structure(c(24.24, 24.24, 24.25, 24.23, 24.24, 24.23, 24.24,
                      24.29, 24.29, 24.29, 24.31, 99, 101.9, 104.8, 107.7, 110.6, 113.5,
                      116.4, 119.3, 122.2, 125.1, 128), dim = c(11L, 2L), dimnames = list(
                        NULL, c("temperature.values", "count.values")))

  object <- set_RLum("RLum.Data.Curve", data = data)
  t <- expect_s4_class(
    correct_PMTLinearity(object, PMT_pulse_pair_resolution = 18),
    "RLum.Data.Curve")
  expect_type(t@data[,2], "double")

  ## nothing done
  expect_equal(correct_PMTLinearity(o),
               o)

  ## run with only one row
  t <- expect_s4_class(
      object = correct_PMTLinearity(o0, PMT_pulse_pair_resolution = 10),
      class = "RLum.Analysis")

  ## intermix different records; the non-RLum.Data.Curve() should be skipped
  t <- expect_s4_class(
      object = correct_PMTLinearity(o2, PMT_pulse_pair_resolution = 10),
      class = "RLum.Analysis")
  expect_length(t, 2)
  expect_equal(t@records[[1]][1,2], 10010, tolerance = 0.001)

  ## test list case
  t <- expect_type(
    object = correct_PMTLinearity(list(o2, o2, "not correct"),
                                  PMT_pulse_pair_resolution = 10),
    type = "list")
  expect_length(t, 2)
})

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

  snapshot.tolerance <- 1.5e-6

  res <- correct_PMTLinearity(o1, PMT_pulse_pair_resolution = 10)
  ## reset originator to avoid failures during the test_coverage workflow in CI
  res@records[[1]]@originator <- NA_character_
  expect_snapshot_RLum(res, tolerance = snapshot.tolerance)
})