read_XYSG2R():

+ ad new argument n_records + ad tests + up docu + ad tests + ad NEWS
R-Lum · Oct 9, 2024 · 44157c0 · 44157c0
1 parent 83d17ce
commit 44157c0
Show file tree

Hide file tree

Showing 6 changed files with 39 additions and 21 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: Luminescence
 Type: Package
 Title: Comprehensive Luminescence Dating Data Analysis
-Version: 0.9.25.9000-12
-Date: 2024-10-08
+Version: 0.9.25.9000-13
+Date: 2024-10-09
 Authors@R: c(
     person("Sebastian", "Kreutzer", role = c("aut", "trl", "cre", "dtc"), email = "[email protected]", comment = c(ORCID = "0000-0002-0734-2199")),
     person("Christoph", "Burow", role = c("aut", "trl", "dtc"), comment = c(ORCID = "0000-0002-5023-4046")),

diff --git a/NEWS.Rmd b/NEWS.Rmd
@@ -69,6 +69,9 @@ fixed in #263).
 * Add support for `lphi` and `ltheta` light direction arguments for `plot.type = "persp"`. 
 * Fix the reason for the unclear warning `In col.unique == col :  longer object length is not a multiple of shorter object length`
 
+### `read_XSYG2R()`
+* Add a new argument `n_records` that enables to limit the number of imported records in case the file was faulty or only a limited number of records is wanted.  
+
 ### `use_DRAC()`
 * Support for DRAC v1.1 XLS/XLSX files has been dropped, users should use
 CSV files according to the DRAC v1.2 CSV template.

diff --git a/NEWS.md b/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-12 (2024-10-08)
+# Changes in version 0.9.25.9000-13 (2024-10-09)
 
 ## New functions
 
@@ -96,6 +96,12 @@
 - Fix the reason for the unclear warning
   `In col.unique == col :  longer object length is not a multiple of shorter object length`
 
+### `read_XSYG2R()`
+
+- Add a new argument `n_records` that enables to limit the number of
+  imported records in case the file was faulty or only a limited number
+  of records is wanted.
+
 ### `use_DRAC()`
 
 - Support for DRAC v1.1 XLS/XLSX files has been dropped, users should

diff --git a/R/read_XSYG2R.R b/R/read_XSYG2R.R
@@ -85,6 +85,9 @@
 #' (see details for more information) Note: The option overwrites the time vs.
 #' count TL curve. Select `FALSE` to import the raw data delivered by the
 #' lexsyg. Works for TL curves and spectra.
+#' 
+#' @param n_records [numeric] (*with default*): set the number of records to be imported; by default
+#' the function attempts ot import all records
 #'
 #' @param fastForward [logical] (*with default*):
 #' if `TRUE` for a more efficient data processing only a list of [RLum.Analysis-class]
@@ -126,7 +129,7 @@
 #' Corresponding values in the XSXG file are skipped.
 #'
 #'
-#' @section Function version: 0.6.12
+#' @section Function version: 0.6.13
 #'
 #'
 #' @author
@@ -177,6 +180,7 @@
 read_XSYG2R <- function(
   file,
   recalculate.TL.curves = TRUE,
+  n_records = NULL,
   fastForward = FALSE,
   import = TRUE,
   pattern = ".xsyg",
@@ -194,6 +198,7 @@ read_XSYG2R <- function(
   ##  - xlum should be general, xsyg should take care about subsequent details
 
   .validate_class(file, c("character", "list"))
+  .validate_class(n_records, c("numeric", "NULL"))
 
   # Self Call -----------------------------------------------------------------------------------
   # Option (a): Input is a list, every element in the list will be treated as file connection
@@ -329,7 +334,7 @@ read_XSYG2R <- function(
 
   ##==========================================================================##
   ##SHOW STRUCTURE
-  if(import == FALSE){
+  if(!import){
     ##sample information
     temp.sample <- as.data.frame(XML::xmlAttrs(temp), stringsAsFactors = FALSE)
 
@@ -374,9 +379,12 @@ read_XSYG2R <- function(
       pb <- txtProgressBar(min=0,max=XML::xmlSize(temp), char = "=", style=3)
     }
 
+    ## set n_records
+    if(is.null(n_records))
+      n_records <- XML::xmlSize(temp)
+
     ##loop over the entire sequence by sequence
-    output <- lapply(1:XML::xmlSize(temp), function(x){
-
+    output <- lapply(1:min(XML::xmlSize(temp),n_records[1]), function(x){
       ##read sequence header
       temp.sequence.header <- as.data.frame(XML::xmlAttrs(temp[[x]]), stringsAsFactors = FALSE)
 
@@ -405,7 +413,6 @@ read_XSYG2R <- function(
 
         ##correct record type in depending on the stimulator
         if(temp.sequence.object.recordType == "OSL"){
-
           if(XML::xmlAttrs(temp[[x]][[i]][[
             XML::xmlSize(temp[[x]][[i]])]])["stimulator"] == "ir_LED_850" |
             XML::xmlAttrs(temp[[x]][[i]][[
@@ -417,10 +424,9 @@ read_XSYG2R <- function(
 
         ##loop 3rd level
         lapply(1:XML::xmlSize(temp[[x]][[i]]), function(j){
-
           ##get values
           temp.sequence.object.curveValue <- temp[[x]][[i]][[j]]
-
+          
           ##get curveType
           temp.sequence.object.curveType <- as.character(
             XML::xmlAttrs(temp[[x]][[i]][[j]])["curveType"])
@@ -444,7 +450,6 @@ read_XSYG2R <- function(
 
           ## TL curve recalculation ============================================
           if(recalculate.TL.curves){
-
             ##TL curve heating values is stored in the 3rd curve of every set
             if(temp.sequence.object.recordType == "TL" && j == 1){
 
@@ -480,9 +485,7 @@ read_XSYG2R <- function(
               temp.sequence.object.curveValue.heating.element <- src_get_XSYG_curve_values(XML::xmlValue(
                 temp[[x]][[i]][[3]]))
 
-
               if("Spectrometer" %in% temp.sequence.object.detector == FALSE){
-
                 #reduce matrix values to values of the detection
                 temp.sequence.object.curveValue.heating.element <-
                   temp.sequence.object.curveValue.heating.element[
@@ -491,7 +494,6 @@ read_XSYG2R <- function(
                       temp.sequence.object.curveValue.heating.element[,1] <=
                       max(temp.sequence.object.curveValue.PMT[,1]), ,drop = FALSE]
               }else{
-
                 #reduce matrix values to values of the detection
                 temp.sequence.object.curveValue.heating.element <-
                   temp.sequence.object.curveValue.heating.element[

diff --git a/man/read_XSYG2R.Rd b/man/read_XSYG2R.Rd
diff --git a/tests/testthat/test_read_XSYG2R.R b/tests/testthat/test_read_XSYG2R.R
@@ -45,6 +45,14 @@ test_that("test import of XSYG files", {
                          type = "list")
   expect_type(results[[1]]@info$file, type = "character")
   expect_output(print(results))
+
+  ## check n_records argument
+  expect_type(read_XSYG2R(xsyg.file, verbose = FALSE, n_records = 1),
+              "list")
+  expect_type(read_XSYG2R(xsyg.file, verbose = FALSE, n_records = 10),
+              "list")
+  expect_error(read_XSYG2R(xsyg.file, verbose = FALSE, n_records = "error"), 
+               regexp = "\\[read\\_XSYG2R\\(\\)\\] 'n\\_records' should be of class")
 
   ## list input
   expect_type(read_XSYG2R(list(xsyg.file), fastForward = TRUE,