Merge pull request #397 from R-Lum/issue_396

Consider also VSLIDE when preparing some arguments for method = SLIDE [skip ci]

Author: mcol

NEWS.Rmd

@@ -51,6 +51,8 @@ above, the function now only accepts CSV files as input (#237, fixed in #270).
 ### `analyse_IRSAR.RF()`
 * The function is more robust against `sequence_structure` misspecifications
 (#393, fixed in #394).
+* Some data preparation steps where not correctly applied for `method = VSLIDE`
+(#396, fixed in #397).
 
 ### `analyse_pIRIRSequence()`
 * The function crashed with a object merge error if run in a loop because of a `merge_RLum()` error. This

R/analyse_IRSAR.RF.R

@@ -533,7 +533,7 @@ analyse_IRSAR.RF<- function(
   ##check whether both curve have the same length, in this case we cannot proceed (sliding
   ##is not allowed)
   if(length(unique(temp.sequence_structure[["x.max"]])) == 1 &&
-     method == "SLIDE" &&
+     grepl("SLIDE", method) &&
      (is.null(RF_nat.lim) & is.null(RF_reg.lim))) {
     .throw_error("There is no further sliding space left. All curves have ",
                  "the same length and no limitation was set")
@@ -724,27 +724,24 @@ analyse_IRSAR.RF<- function(
     temp.sequence_structure[temp.sequence_structure$protocol.step=="REGENERATED","id"]]]@data)
 
     ##correct of the onset of detection by using the first time value
-    if (method == "SLIDE" &
+    if (grepl("SLIDE", method) &&
         method.control.settings$correct_onset == TRUE) {
       RF_reg[,1] <- RF_reg[,1] - RF_reg[1,1]
     }
 
-
   RF_reg.x <- RF_reg[RF_reg.lim[1]:RF_reg.lim[2],1]
   RF_reg.y <- RF_reg[RF_reg.lim[1]:RF_reg.lim[2],2]
 
-
   ##grep values from natural signal
   RF_nat <- as.data.frame(object@records[[
     temp.sequence_structure[temp.sequence_structure$protocol.step=="NATURAL","id"]]]@data)
 
-    ##correct of the onset of detection by using the first time value
-  if (method == "SLIDE" &
+  ## correct the onset of detection by using the first time value
+  if (grepl("SLIDE", method) &&
       method.control.settings$correct_onset == TRUE) {
     RF_nat[,1] <- RF_nat[,1] - RF_nat[1,1]
   }
 
-
   ##limit values to fit range (at least to the minimum)
   RF_nat.limited<- RF_nat[min(RF_nat.lim):max(RF_nat.lim),]
 
@@ -766,7 +763,7 @@ analyse_IRSAR.RF<- function(
         -lambda * x
       )) ^ beta)))
 
-    ##stretched expontial function according to Erfurt et al. (2003)
+    ## stretched exponential function according to Erfurt et al. (2003)
     ## + phi.0 >> initial IR-RF flux
     ## + delta.phi >> dose dependent change of the IR-RF flux
     ## + lambda >> exponential parameter
@@ -960,9 +957,6 @@ analyse_IRSAR.RF<- function(
 
       ##(1) calculate sum of residual squares using internal Rcpp function
 
-      #pre-allocate object
-      temp.sum.residuals <- vector("numeric", length = t_max.id - t_max_nat.id)
-
       ##initialise slide range for specific conditions, namely NULL and "auto"
       if (is.null(vslide_range)) {
         vslide_range <- 0

tests/testthat/_snaps/analyse_IRSAR.RF.md

@@ -48,6 +48,13 @@ test_that("input validation", {
                  "'RF_reg.lim' defines too short an interval, reset to")
   )
 
+  ## curves of the same length
+  expect_error(analyse_IRSAR.RF(set_RLum("RLum.Analysis",
+                                         records = list(IRSAR.RF.Data[[1]],
+                                                        IRSAR.RF.Data[[1]])),
+                                method = "VSLIDE"),
+               "There is no further sliding space left")
+
   SW({
   expect_warning(analyse_IRSAR.RF(IRSAR.RF.Data,
                                   method.control = list(unknown = "test")),
@@ -153,7 +160,7 @@ test_that("test edge cases", {
 
   SW({
   expect_warning(expect_s4_class(analyse_IRSAR.RF(
-    object,
+    list(object),
     method = "SLIDE",
     method.control = list(vslide_range = 'auto', correct_onset = FALSE,
                           show_fit = TRUE, trace = TRUE, n.MC = 2,