tests/testthat/test_verify_SingleGrainData.R

In Luminescence: Comprehensive Luminescence Dating Data Analysis

## load data
data(ExampleData.BINfileData, envir = environment())
data(ExampleData.XSYG, envir = environment())
object <- get_RLum(OSL.SARMeasurement$Sequence.Object,
                   recordType = "OSL (UVVIS)", drop = FALSE)

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

  expect_error(verify_SingleGrainData("test"),
               "'object' should be of class 'Risoe.BINfileData', 'RLum.Analysis'")
  expect_error(verify_SingleGrainData(object, threshold = "error"),
               "'threshold' should be a single positive value")
  expect_error(verify_SingleGrainData(object, threshold = integer(0)),
               "'threshold' should be a single positive value")
  expect_error(verify_SingleGrainData(object, use_fft = "error"),
               "'use_fft' should be a single logical value")
  expect_error(verify_SingleGrainData(object, cleanup = "error"),
               "'cleanup' should be a single logical value")
  expect_error(verify_SingleGrainData(object, cleanup_level = "error"),
               "'cleanup_level' should be one of 'aliquot' or 'curve'")
  expect_error(verify_SingleGrainData(object, verbose = "error"),
               "'verbose' should be a single logical value")

  object@originator <- "error"
  expect_error(verify_SingleGrainData(object),
               "'object' has an unsupported originator")
})

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

  ## RLum.Analysis object
  expect_message(res <- verify_SingleGrainData(object, cleanup = TRUE,
                                              cleanup_level = "curve",
                                              threshold = 10),
                "RLum.Analysis object reduced to records: 1, 3, 5:10, 12:14")
  expect_s4_class(res, "RLum.Analysis")
  expect_equal(res@originator, "verify_SingleGrainData")
  expect_length(res@records, 11)

  ## threshold too high, empty object generated
  expect_message(res <- verify_SingleGrainData(object, cleanup = TRUE,
                                              cleanup_level = "curve",
                                              threshold = 10000),
                "RLum.Analysis object reduced to records: <none>")
  expect_length(res@records, 0)
  expect_s4_class(res, "RLum.Analysis")
  expect_equal(res@originator, "read_XSYG2R")
  expect_length(res@records, 0)

  ## check for empty object in a list
  object_empty <- list(
    set_RLum(class = "RLum.Analysis", originator = "Risoe.BINfileData2RLum.Analysis"),
    set_RLum(
      class = "RLum.Analysis",
      originator = "Risoe.BINfileData2RLum.Analysis",
      records = list(set_RLum(
        "RLum.Data.Curve",
        data = matrix(1:100, ncol = 2),
        info = list(POSITION = 1, GRAIN = 1)
      ))
    )
  )
  expect_warning(verify_SingleGrainData(object_empty),
                 "Cannot process empty RLum.Analysis objects, NULL returned")

  ## threshold too high on a list
  expect_message(res <- verify_SingleGrainData(list(object), cleanup = TRUE,
                                               cleanup_level = "curve",
                                               threshold = 2000),
                 "RLum.Analysis object reduced to records")
  expect_type(res, "list")
  expect_s4_class(res[[1]], "RLum.Analysis")
  expect_equal(res[[1]]@originator, "read_XSYG2R")
  expect_length(res[[1]]@records, 0)

  ## check for cleanup
  t <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data)
  expect_warning(
    object = verify_SingleGrainData(t, cleanup = TRUE, threshold = 20000),
    regexp = "Verification and cleanup removed all records, NULL returned")
  expect_null(suppressWarnings(verify_SingleGrainData(t, cleanup = TRUE, threshold = 20000)))

  ## Risoe.BINfileData
  expect_message(res <- verify_SingleGrainData(CWOSL.SAR.Data, cleanup = TRUE,
                                               cleanup_level = "curve"),
                 "Risoe.BINfileData object reduced to records: 1:3, 5:600, 625:696, record index reset")
  expect_s4_class(res, "Risoe.BINfileData")

  ## use_fft
  expect_s4_class(verify_SingleGrainData(CWOSL.SAR.Data, cleanup = TRUE, use_fft = TRUE, verbose = FALSE),
                "Risoe.BINfileData")

  obj.risoe <- Risoe.BINfileData2RLum.Analysis(CWOSL.SAR.Data, pos = 1)
  res <- expect_silent(verify_SingleGrainData(obj.risoe))
  expect_s4_class(verify_SingleGrainData(obj.risoe, use_fft = TRUE), "RLum.Results")

  ## remove all and cleanup
  expect_warning(
    object = verify_SingleGrainData(CWOSL.SAR.Data, cleanup = TRUE, threshold = 20000),
    regexp = "Verification and cleanup removed all records, NULL returned")
  expect_null(suppressWarnings(verify_SingleGrainData(CWOSL.SAR.Data, cleanup = TRUE, threshold = 20000)))

  ## empty list
  expect_s4_class(res <- verify_SingleGrainData(list()),
                  "RLum.Results")
  expect_length(res@data, 0)
  expect_equal(res@originator, "verify_SingleGrainData")

  expect_s4_class(res <- verify_SingleGrainData(list(), cleanup = TRUE),
                  "RLum.Analysis")
  expect_length(res@records, 0)
  expect_equal(res@originator, "verify_SingleGrainData")

  expect_s4_class(res <- verify_SingleGrainData(list(), cleanup = NA),
                  "RLum.Results")
  expect_length(res@data, 0)
  expect_equal(res@originator, "verify_SingleGrainData")

  ## list
  expect_silent(suppressWarnings(verify_SingleGrainData(list(object))))
})

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

  snapshot.tolerance <- 1.5e-6

  expect_warning(expect_snapshot_RLum(verify_SingleGrainData(object),
                                      tolerance = snapshot.tolerance),
                 "'selection_id' is NA, everything tagged for removal")

  expect_snapshot_RLum(verify_SingleGrainData(object, cleanup_level = "curve"),
                       tolerance = snapshot.tolerance)
})

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

  SW({
  vdiffr::expect_doppelganger("default",
                              verify_SingleGrainData(object,
                                                     plot = TRUE))
  vdiffr::expect_doppelganger("Risoe.BINfileData",
                              verify_SingleGrainData(subset(CWOSL.SAR.Data,
                                                            POSITION <= 3),
                                                     plot = TRUE))
  })
})

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

  ## issue 740
  object@records[[1]]@info$position <- "123"
  expect_s4_class(verify_SingleGrainData(object),
                  "RLum.Results")
})