Merge pull request #292 from R-Lum/validate_positive_scalar

small improvements to .validate_positive_scalar() [skip ci]

R/RLum.Data.Spectrum-class.R

@@ -366,12 +366,12 @@ setMethod("names_RLum",
 setMethod(f = "bin_RLum.Data",
           signature = "RLum.Data.Spectrum",
           function(object, bin_size.col = 1, bin_size.row = 1) {
+            .set_function_name("bin_RLum.Data.Spectrum")
+            on.exit(.unset_function_name(), add = TRUE)
 
             ##make sure that we have no input problems
-            if (!inherits(bin_size.col, "numeric") || !inherits(bin_size.row, "numeric")){
-              stop("[bin_RLum.Data()] 'bin_size.row' and 'bin_size.col' must be of class 'numeric'!",
-                   call. = FALSE)
-            }
+            .validate_class(bin_size.row, c("numeric", "integer"))
+            .validate_class(bin_size.col, c("numeric", "integer"))
 
             ##make sure that we do not get in trouble with negative values
             bin_size.col <- abs(bin_size.col)

R/analyse_Al2O3C_Measurement.R

@@ -322,6 +322,8 @@ analyse_Al2O3C_Measurement <- function(
 
   ## Set Irradiation Time Correction ---------------
   if (!is.null(irradiation_time_correction)) {
+    .validate_class(irradiation_time_correction, c("RLum.Results", "numeric"))
+
     if (is(irradiation_time_correction, "RLum.Results")) {
       if (irradiation_time_correction@originator == "analyse_Al2O3C_ITC") {
         irradiation_time_correction <- get_RLum(irradiation_time_correction)
@@ -341,8 +343,6 @@ analyse_Al2O3C_Measurement <- function(
     } else if (is.numeric(irradiation_time_correction)) {
       if (length(irradiation_time_correction) != 2)
         .throw_error("'irradiation_time_correction' must have length 2")
-    } else {
-      .throw_error("'irradiation_time_correction' must be a numeric vector or an 'RLum.Results' object")
     }
   }
 

R/analyse_IRSAR.RF.R

@@ -516,34 +516,21 @@ analyse_IRSAR.RF<- function(
 
     }else{
       return(results)
-
     }
   }
 
 
-  ##===============================================================================================#
-  ## INTEGRITY TESTS AND SEQUENCE STRUCTURE TESTS
-  ##===============================================================================================#
+  ## Integrity tests --------------------------------------------------------
 
-  ##INPUT OBJECTS
   .validate_class(object, "RLum.Analysis")
-
-  ##CHECK OTHER ARGUMENTS
-  if (!is.character(sequence_structure)) {
-    .throw_error("'sequence_structure' must be of type 'character'")
-  }
-
-  ## method
+  .validate_class(sequence_structure, "character")
   method <- .validate_args(method, c("FIT", "SLIDE", "VSLIDE"))
-
-  ## n.MC
   .validate_positive_scalar(n.MC, int = TRUE, null.ok = TRUE)
 
   ##SELECT ONLY MEASURED CURVES
   ## (this is not really necessary but rather user friendly)
   if(!length(suppressWarnings(get_RLum(object, curveType= "measured"))) == 0){
     object <- get_RLum(object, curveType= "measured", drop = FALSE)
-
   }
 
   ##INVESTIGATE SEQUENCE OBJECT STRUCTURE
@@ -698,9 +685,7 @@ analyse_IRSAR.RF<- function(
 
   ##modify list if necessary
   if(!is.null(method.control)){
-    if(!is(method.control, "list")){
-      .throw_error("'method.control' has to be of type 'list'!")
-    }
+    .validate_class(method.control, "list")
 
     ##check whether this arguments are supported at all
     unsupported.idx <- which(!names(method.control) %in%
@@ -717,7 +702,6 @@ analyse_IRSAR.RF<- function(
       x = method.control.settings,
       val = method.control,
       keep.null = TRUE)
-
   }
 
 
@@ -756,7 +740,6 @@ analyse_IRSAR.RF<- function(
     if (method == "SLIDE" &
         method.control.settings$correct_onset == TRUE) {
       RF_reg[,1] <- RF_reg[,1] - RF_reg[1,1]
-
     }
 
 

R/analyse_SAR.TL.R

@@ -129,9 +129,9 @@ analyse_SAR.TL <- function(
 
   # Self-call -----------------------------------------------------------------------------------
   if(inherits(object, "list")){
-   if(!all(sapply(object, class) == "RLum.Analysis"))
-     stop("[analyse_SAR.TL()] All elements in the input list must be of class 'RLum.Analysis'!",
-          call. = FALSE)
+    lapply(object,
+           function(x) .validate_class(x, "RLum.Analysis",
+                                       name = "All elements of 'object'"))
 
     ##run sequence
     results <- lapply(object, function(o){

R/analyse_portableOSL.R

@@ -210,9 +210,7 @@ analyse_portableOSL <- function(
     coord <- .extract_PSL_coord(object)
 
   } else {
-    if(!inherits(coord, "matrix") && !inherits(coord, "list"))
-      .throw_error("'coord' must be a matrix or a list")
-
+    .validate_class(coord, c("matrix", "list"))
     if(inherits(coord, "list"))
       coord <- do.call(rbind, coord)
 

R/calc_Huntley2006.R

@@ -380,6 +380,8 @@ calc_Huntley2006 <- function(
   }
 
   ## Check 'rhop'
+  .validate_class(rhop, c("numeric", "RLum.Results"))
+
   # check if numeric
   if (is.numeric(rhop)) {
 
@@ -397,8 +399,6 @@ calc_Huntley2006 <- function(
     else
       .throw_error("'rhop' accepts RLum.Results objects only if produced ",
                    "by 'analyse_FadingMeasurement()'")
-  } else {
-    .throw_error("'rhop' must be a numeric vector or an RLum.Results object")
   }
 
   # check if 'rhop' is actually a positive value

R/fit_OSLLifeTimes.R

@@ -303,8 +303,7 @@ if(inherits(object, "list") || inherits(object, "RLum.Analysis")){
 
   ##signal_range
   if(!is.null(signal_range)){
-    if (!is.numeric(signal_range))
-      .throw_error("'signal_range' must be of type numeric")
+    .validate_class(signal_range, "numeric")
 
     ##check lengths
     if(length(signal_range) == 1)

R/fit_SurfaceExposure.R

@@ -224,7 +224,10 @@ fit_SurfaceExposure <- function(
     legend = TRUE,
     error_bars = TRUE,
     coord_flip = FALSE,
-...) {
+    ...
+) {
+  .set_function_name("fit_SurfaceExposure")
+  on.exit(.unset_function_name(), add = TRUE)
 
   ## SETTINGS ----
   settings <- list(
@@ -275,8 +278,7 @@ fit_SurfaceExposure <- function(
   }
 
   # Exit if data type is invalid
-  if (!inherits(data, "data.frame"))
-    stop("'data' must be of class data.frame.", call. = FALSE)
+  .validate_class(data, "data.frame")
 
   # Check which parameters have been provided
   if (!is.null(age) && any(is.na(age))) age <- NULL

R/internal_as.latex.table.R

@@ -133,8 +133,6 @@
       for(i in 1:length(text)){
         text[[i]][grepl(pattern = "Mineral", x = text[[i]], fixed = TRUE)] <-
           "\t\\multicolumn{1}{p{0.5cm}}{\\centering \\textbf{M.}} & "
-
-
       }
 
     ##put things again together (single character)
@@ -156,7 +154,6 @@
     return(text)
 
   }# EndOf::use_DRAC
-
 }
 
 ################################################################################
@@ -175,9 +172,8 @@
   .set_function_name("as.latex.table.data.frame")
   on.exit(.unset_function_name(), add = TRUE)
 
-  ## Integrity checks ----
-  if (!is.data.frame(x))
-    .throw_error("'x' must be a data frame")
+  ## Integrity tests --------------------------------------------------------
+  .validate_class(x, "data.frame")
   if (!is.null(col.names) && length(col.names) != ncol(x))
     .throw_error("Length of 'col.names' does not match the number of columns")
   if (!is.null(row.names) && length(row.names) != nrow(x))
@@ -222,7 +218,6 @@
       colnames(x.chunk) <- names(x[i])
     }
 
-
     ## Comments ----
     tex.comment.usePackage <- ifelse(comments,
                                      "% add usepackage{adjustbox} to latex preamble \n",

R/internals_RLum.R

@@ -1169,13 +1169,13 @@ SW <- function(expr) {
 #' @noRd
 .validate_positive_scalar <- function(val, int = FALSE, null.ok = FALSE,
                                       name = NULL) {
-  if (is.null(val) && null.ok)
+  if (missing(val) || is.null(val) && null.ok)
     return()
   if (!is.numeric(val) || length(val) != 1 || is.na(val) || val <= 0 ||
       (int && val != as.integer(val))) {
     if (is.null(name))
       name <- all.vars(match.call())[1]
-    .throw_error("'", name, "' must be a positive ", if (int) "integer ",
+    .throw_error("'", name, "' should be a positive ", if (int) "integer ",
                  "scalar")
   }
 }

R/plot_RLum.Analysis.R

@@ -178,8 +178,8 @@ plot_RLum.Analysis <- function(
   else
     n.plots <- length_RLum(object)
 
-  if (!missing(nrows)) .validate_positive_scalar(nrows)
-  if (!missing(ncols)) .validate_positive_scalar(ncols)
+  .validate_positive_scalar(nrows)
+  .validate_positive_scalar(ncols)
 
   ## set appropriate values for nrows and ncols if not both specified
   if (missing(ncols) | missing(nrows)) {

R/template_DRAC.R

@@ -99,11 +99,7 @@ template_DRAC <- function(
   # 1 - allow mineral specific presets; new argument 'mineral'
   # 2 - add option to return the DRAC example data set
 
-  ## correct incoming to prevent negative values
-  if (!is.numeric(nrow)) {
-    .throw_error("'nrow' must be a positive integer scalar")
-  }
-  nrow <- max(1, nrow[1])
+  .validate_positive_scalar(nrow, int = TRUE)
 
   ## throw warning
   if (nrow > 5000)

tests/testthat/test_RLum.Data.Spectrum.R

@@ -19,8 +19,10 @@ test_that("check class", {
   expect_type(names(object), "character")
 
   ##test bin_RLum()
-  expect_error(bin_RLum.Data(object, bin_size.col = "test"),
-               "'bin_size.row' and 'bin_size.col' must be of class 'numeric'!")
+  expect_error(bin_RLum.Data(object, bin_size.row = "test"),
+               "'bin_size.row' should be of class 'numeric'")
+  expect_error(bin_RLum.Data(object, bin_size.row = 12, bin_size.col = "test"),
+               "'bin_size.col' should be of class 'numeric'")
   object@data <- matrix(data = rep(1:20, each = 10), ncol = 20)
   rownames(object@data) <- 1:10
   colnames(object@data) <- 1:20

tests/testthat/test_analyse_Al2O3C_Measurement.R

@@ -24,7 +24,7 @@ test_that("input validation", {
                "was created by an unsupported function")
   expect_error(analyse_Al2O3C_Measurement(data_CrossTalk,
                                           irradiation_time_correction = "a"),
-               "must be a numeric vector or an 'RLum.Results' object")
+               "should be of class 'RLum.Results' or 'numeric'")
   expect_error(analyse_Al2O3C_Measurement(data_CrossTalk,
                                           cross_talk_correction = "a"),
                "'cross_talk_correction' was created by an unsupported function")

tests/testthat/test_analyse_IRSAR.RF.R

@@ -8,13 +8,13 @@ test_that("input validation", {
   expect_error(analyse_IRSAR.RF("test"),
                "'object' should be of class 'RLum.Analysis'")
   expect_error(analyse_IRSAR.RF(IRSAR.RF.Data, sequence_structure = FALSE),
-               "'sequence_structure' must be of type 'character'")
+               "'sequence_structure' should be of class 'character'")
   expect_error(analyse_IRSAR.RF(IRSAR.RF.Data, n.MC = 0),
-               "'n.MC' must be a positive integer scalar")
+               "'n.MC' should be a positive integer scalar")
   expect_error(analyse_IRSAR.RF(IRSAR.RF.Data, method = "error"),
                "'method' should be one of 'FIT', 'SLIDE' or 'VSLIDE'")
   expect_error(analyse_IRSAR.RF(IRSAR.RF.Data, method.control = 3),
-               "'method.control' has to be of type 'list'")
+               "'method.control' should be of class 'list'")
   expect_error(analyse_IRSAR.RF(IRSAR.RF.Data,
                                 sequence_struct = c("REGENERATED", "NATURAL")),
                "Number of data channels in RF_nat > RF_reg")

tests/testthat/test_analyse_SAR.TL.R

@@ -17,7 +17,7 @@ test_that("input validation", {
   expect_error(analyse_SAR.TL(object, signal.integral.min = 1),
                "No value set for 'signal.integral.max'")
   expect_error(analyse_SAR.TL(list(object, "test")),
-               "elements in the input list must be of class 'RLum.Analysis'")
+               "All elements of 'object' should be of class 'RLum.Analysis'")
   expect_error(analyse_SAR.TL(object, signal.integral.min = 1,
                               signal.integral.max = 2),
                "Input TL curves are not a multiple of the sequence structure")

tests/testthat/test_analyse_baSAR.R

@@ -19,7 +19,7 @@ test_that("input validation", {
   expect_error(analyse_baSAR(list(data.frame(), matrix()), verbose = FALSE),
                "'object' only accepts a list with objects of similar type")
   expect_error(analyse_baSAR(CWOSL.sub, n.MCMC = NULL),
-               "'n.MCMC' must be a positive integer scalar")
+               "'n.MCMC' should be a positive integer scalar")
 
   expect_error(analyse_baSAR(CWOSL.sub, verbose = FALSE),
                "'source_doserate' is missing, but the current implementation")

tests/testthat/test_analyse_portableOSL.R

@@ -119,7 +119,7 @@ test_that("input validation", {
     ## coordinates not list or matrix
     expect_error(analyse_portableOSL(surface, signal.integral = 1:5,
                                      coord = "error"),
-      "'coord' must be a matrix or a list")
+      "'coord' should be of class 'matrix' or 'list'")
 
     ## coordinates are not of the correct size
     expect_error(analyse_portableOSL(surface, signal.integral = 1:5,

tests/testthat/test_as_latex_table.R

@@ -24,7 +24,7 @@ test_that("Check .as.latex.table.data.frame()", {
   testthat::skip_on_cran()
 
   expect_error(.as.latex.table.data.frame("error"),
-               "'x' must be a data frame")
+               "'x' should be of class 'data.frame'")
 
   df <- data.frame(x = "test", y = 1:10)
   expect_error(.as.latex.table.data.frame(df, col.names = "col1"),

tests/testthat/test_calc_AliquotSize.R

@@ -16,7 +16,7 @@ test_that("consistency checks", {
   expect_error(calc_AliquotSize(grain.size = 100, packing.density = 2),
                "'packing.density' expects values between 0 and 1")
   expect_error(calc_AliquotSize(grain.size = 100, packing.density = 1, sample.diameter = -1),
-               "'sample.diameter' must be a positive scalar")
+               "'sample.diameter' should be a positive scalar")
   expect_error(calc_AliquotSize(grain.size = 100, sample.diameter = 9.8,
                                 MC = TRUE),
                "'grain.size' must be a vector containing the min and max")

tests/testthat/test_calc_AverageDose.R

@@ -11,9 +11,9 @@ test_that("input validation", {
   expect_error(calc_AverageDose(data),
                "\"sigma_m\" is missing, with no default")
   expect_error(calc_AverageDose(data, sigma_m = NULL),
-               "'sigma_m' must be a positive scalar")
+               "'sigma_m' should be a positive scalar")
   expect_error(calc_AverageDose(data, sigma_m = 0.1, Nb_BE = NULL),
-               "'Nb_BE' must be a positive integer scalar")
+               "'Nb_BE' should be a positive integer scalar")
   expect_message(expect_null(
       calc_AverageDose(data[, 1, drop = FALSE], sigma_m = 0.1)),
       "Error: 'data' contains < 2 columns")

tests/testthat/test_calc_FastRatio.R

@@ -9,16 +9,16 @@ test_that("input validation", {
   expect_error(calc_FastRatio("error"),
                "'object' should be of class 'RLum.Analysis', 'RLum.Results'")
   expect_error(calc_FastRatio(obj, Ch_L1 = NULL),
-               "'Ch_L1' must be a positive integer scalar")
+               "'Ch_L1' should be a positive integer scalar")
   expect_error(calc_FastRatio(obj, Ch_L1 = 0),
-               "'Ch_L1' must be a positive integer scalar")
+               "'Ch_L1' should be a positive integer scalar")
   expect_error(calc_FastRatio(obj, Ch_L1 = c(1, 2)),
-               "'Ch_L1' must be a positive integer scalar")
+               "'Ch_L1' should be a positive integer scalar")
 
   expect_error(calc_FastRatio(obj, Ch_L2 = 0),
-               "'Ch_L2' must be a positive integer scalar")
+               "'Ch_L2' should be a positive integer scalar")
   expect_error(calc_FastRatio(obj, Ch_L2 = c(1, 2)),
-               "'Ch_L2' must be a positive integer scalar")
+               "'Ch_L2' should be a positive integer scalar")
 
   expect_error(calc_FastRatio(ExampleData.CW_OSL_Curve,
                               Ch_L3 = 50),
@@ -29,7 +29,7 @@ test_that("input validation", {
   expect_error(calc_FastRatio(obj, Ch_L3 = list(4, 5)),
                "Input for 'Ch_L3' must be a vector of length 2")
   expect_error(calc_FastRatio(obj, Ch_L3 = c(0, 2)),
-               "'Ch_L3[1]' must be a positive integer scalar",
+               "'Ch_L3[1]' should be a positive integer scalar",
                fixed = TRUE)
   expect_error(calc_FastRatio(obj, Ch_L3 = c(5, 2)),
                "Ch_L3[2] must be greater than or equal to Ch_L3[1]",

tests/testthat/test_calc_Huntley2006.R

@@ -48,7 +48,7 @@ test_that("input validation", {
   expect_error(calc_Huntley2006(data, rhop = 1),
                "'rhop' must be a vector of length 2")
   expect_error(calc_Huntley2006(data, rhop = "test"),
-               "'rhop' must be a numeric vector or an RLum.Results object")
+               "'rhop' should be of class 'numeric' or 'RLum.Results'")
   expect_error(calc_Huntley2006(data, rhop = rhop.test),
                "'rhop' accepts RLum.Results objects only if produced by")
   expect_error(calc_Huntley2006(data, rhop = c(-1, 4.9e-7)),

tests/testthat/test_calc_MinDose.R

@@ -22,7 +22,7 @@ test_that("input validation", {
                             init.values = list(p0 = 0, p1 = 1, p2 = 2, mu = 3)),
                "Missing parameters: gamma, sigma")
   expect_error(calc_MinDose(ExampleData.DeValues$CA1, par = "error"),
-               "'par' must be a positive integer scalar")
+               "'par' should be a positive integer scalar")
   expect_error(calc_MinDose(ExampleData.DeValues$CA1, par = 2),
                "'par' can only be set to 3 or 4")
 })