get_RLum() subsetting (RLum.Analysis-method):

+ fx poor subsetting attempt
+ ad NEWS
+ ad tests
+ up manual

NEWS.Rmd

@@ -24,6 +24,11 @@ it shows a warning with instructions and set `plot = FALSE`. This should prevent
 ### `get_RLum()`
 * When the function was used on a list of `RLum.Analysis-class` objects with the argument `null.rm = TRUE` it would 
 remove all `NULL` objects, but not elements that became `list()` (empty list) during the selection; fixed.
+* Fix an edge case that caused a rather non-expected, more visible output problem. When curves were selected via
+`recordType` on `RLum.Analysis-class` objects (or a list of them) and the object contained only a single `RLum.Data-class` object, 
+the function returned the `RLum.Data.Curve-class` object *regardless* of the selection in `recordType`. In other words: 
+If a user tried `recordType = "TL"` on an `RLum.Analysis-class` object that contained only a single IRSL curve, the
+function would still return that single IRSL curve instead of an empty element. The reason for this behaviour was a poor attempt to deal with `NA` in the `recordType` name that led to missing values and unexpected behaviour for a logical comparison. Now, before the subset happens, `NA` values in `recordType` are converted to `"NA"` (a character) and the wiggling around that was causing the lousy subsetting was removed. 
 
 
 ### `plot_RLum.Data.Spectrum()`

NEWS.md

@@ -5,7 +5,7 @@
 
 <!-- NEWS.md was auto-generated by NEWS.Rmd. Please DO NOT edit by hand!-->
 
-# Changes in version 0.9.25.9000-3 (2024-09-16)
+# Changes in version 0.9.25.9000-6 (2024-09-16)
 
 ## New functions
 
@@ -30,6 +30,20 @@
   with the argument `null.rm = TRUE` it would remove all `NULL` objects,
   but not elements that became `list()` (empty list) during the
   selection; fixed.
+- Fix an edge case that caused a rather non-expected, more visible
+  output problem. When curves were selected via `recordType` on
+  `RLum.Analysis-class` objects (or a list of them) and the object
+  contained only a single `RLum.Data-class` object, the function
+  returned the `RLum.Data.Curve-class` object *regardless* of the
+  selection in `recordType`. In other words: If a user tried
+  `recordType = "TL"` on an `RLum.Analysis-class` object that contained
+  only a single IRSL curve, the function would still return that single
+  IRSL curve instead of an empty element. The reason for this behaviour
+  was a poor attempt to deal with `NA` in the `recordType` name that led
+  to missing values and unexpected behaviour for a logical comparison.
+  Now, before the subset happens, `NA` values in `recordType` are
+  converted to `"NA"` (a character) and the wiggling around that was
+  causing the lousy subsetting was removed.
 
 ### `plot_RLum.Data.Spectrum()`
 

R/RLum.Analysis-class.R

@@ -25,7 +25,7 @@ NULL
 #' @section Objects from the Class:
 #' Objects can be created by calls of the form `set_RLum("RLum.Analysis", ...)`.
 #'
-#' @section Class version: 0.4.16
+#' @section Class version: 0.4.17
 #'
 #' @author
 #' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)
@@ -350,7 +350,8 @@ setMethod(
 setMethod("get_RLum",
           signature = ("RLum.Analysis"),
           function(object, record.id = NULL, recordType = NULL, curveType = NULL, RLum.type = NULL,
-                   protocol = "UNKNOWN", get.index = NULL, drop = TRUE, recursive = TRUE, info.object = NULL, subset = NULL, env = parent.frame(2)) {
+                   protocol = "UNKNOWN", get.index = NULL, drop = TRUE, recursive = TRUE,
+                   info.object = NULL, subset = NULL, env = parent.frame(2)) {
 
             if (!is.null(substitute(subset))) {
               # To account for different lengths and elements in the @info slot we first
@@ -513,21 +514,28 @@ setMethod("get_RLum",
               record.id <- 1:length(object@records)
 
               ##select curves according to the chosen parameter
-              if (length(record.id) > 1) {
+              if (length(record.id) >= 1) {
                 temp <- lapply(record.id, function(x) {
                   if (is(object@records[[x]])[1] %in% RLum.type) {
-                    ##as input a vector is allowed
+                      ##as input a vector is allowed
                     temp <- lapply(1:length(recordType), function(k) {
                       ##translate input to regular expression
                       recordType[k] <- glob2rx(recordType[k])
                       recordType[k] <- substr(recordType[k], start = 2, stop = nchar(recordType[k]) - 1)
 
+                      ##handle NA
+                      if(is.na(object@records[[x]]@recordType))
+                        recordType_comp <- "NA"
+                      else
+                        recordType_comp <- object@records[[x]]@recordType
+
                       ## get the results object and if requested, get the index
-                      if (grepl(recordType[k], object@records[[x]]@recordType) &
+                      if (grepl(recordType[k], recordType_comp) &
                           object@records[[x]]@curveType %in% curveType) {
                         if (!get.index) object@records[[x]] else x
 
                       }
+
                     })
 
                     ##remove empty entries and select just one to unlist

tests/testthat/test_get_RLum.R

@@ -7,8 +7,6 @@ temp_RLumDataSpectrum <- set_RLum(class = "RLum.Data.Spectrum")
 temp_RLumAnalysis <- set_RLum(class = "RLum.Analysis")
 temp_RLumResults <- set_RLum(class = "RLum.Results")
 
-
-
 test_that("check class and length of output", {
   testthat::skip_on_cran()
 
@@ -46,6 +44,8 @@ test_that("check get_RLum on a list and NULL", {
   ##check class argument
   a <- list(set_RLum("RLum.Results"), set_RLum("RLum.Analysis", records = list(set_RLum("RLum.Data.Curve"))))
   expect_type(get_RLum(a, class = "test", drop = FALSE), "list")
+  expect_type(get_RLum(a, class = "test", drop = TRUE), "list")
   expect_type(get_RLum(a, class = "RLum.Results", drop = FALSE), "list")
+  expect_type(get_RLum(a, class = "RLum.Analysis", drop = TRUE), "list")
   expect_type(get_RLum(list(temp_RLumResults, temp_RLumAnalysis)), "list")
 })