From d70d78d4dce5d463e7e9e509e75856c27dd91f4f Mon Sep 17 00:00:00 2001 From: RLumSK Date: Mon, 16 Sep 2024 12:28:23 +0200 Subject: [PATCH] get_RLum() subsetting (RLum.Analysis-method): + fx poor subsetting attempt + ad NEWS + ad tests + up manual --- NEWS.Rmd | 5 +++++ NEWS.md | 16 +++++++++++++++- R/RLum.Analysis-class.R | 18 +++++++++++++----- tests/testthat/test_get_RLum.R | 4 ++-- 4 files changed, 35 insertions(+), 8 deletions(-) diff --git a/NEWS.Rmd b/NEWS.Rmd index 748a3ec6f..2c6461332 100644 --- a/NEWS.Rmd +++ b/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()` diff --git a/NEWS.md b/NEWS.md index 8e4cb19ca..872e49e65 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,7 +5,7 @@ -# 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()` diff --git a/R/RLum.Analysis-class.R b/R/RLum.Analysis-class.R index f526898e2..e171fc771 100644 --- a/R/RLum.Analysis-class.R +++ b/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 diff --git a/tests/testthat/test_get_RLum.R b/tests/testthat/test_get_RLum.R index 87da3071b..1c6dd14df 100644 --- a/tests/testthat/test_get_RLum.R +++ b/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") })