feat: add parameter drop to chromatograms()

Author: jorainer

R/methods-mzRpwiz.R

@@ -158,31 +158,25 @@ setMethod("chromatograms", "mzRpwiz",
 
 
 setMethod("chromatogram", "mzRpwiz",
-          function(object, chrom) {
+          function(object, chrom, drop = TRUE) {
               ## To avoid confusion, the first chromatogram (at index
               ## 0) is indexed at position 1 in R and the last one (at
               ## index nChrom(object) - 1) is indexed at position
               ## nChrom(object).
               n <- nChrom(object)
               all <- FALSE
-              if (missing(chrom)) {
+              if (missing(chrom))
                   chrom <- 1:n
-                  all <- TRUE
-              }
               stopifnot(is.numeric(chrom))
               chrom <- as.integer(chrom)
               if (min(chrom) < 1 | max(chrom) > n)
                   stop("Index out of bound [", 1, ":", n, "].")
               ## Update index to match original indices at the C-level
               chrom <- chrom - 1L
-              if (length(chrom) == 1 & !all) {
-                  ans <- object@backend$getChromatogramsInfo(chrom)
-              } else {
-                  ans <- lapply(chrom,
-                                function(x)
-                                    object@backend$getChromatogramsInfo(x))
-              }
-              return(ans)
+              if (length(chrom) == 1 && drop)
+                  object@backend$getChromatogramsInfo(chrom)
+              else
+                  lapply(chrom, object@backend$getChromatogramsInfo)
           })
 
 setMethod("chromatogramHeader", "mzRpwiz",

inst/unitTests/test_chromatograms.R

@@ -12,7 +12,11 @@ test_chromatograms1 <- function() {
     checkIdentical(nrow(chromatogram(x, 137L)), 567L)
     checkIdentical(nrow(chromatogram(x, 138L)), 567L)
     chr <- chromatogram(x, 138L)
+    checkTrue(is.data.frame(chr))
     checkIdentical(colnames(chr), c("rtime", "intensity"))
+    chrl <- chromatogram(x, 138L, drop = FALSE)
+    checkTrue(is.list(chrl))
+    checkEquals(chr, chrl[[1L]])
 }
 
 test_chromatograms2 <- function() {

man/peaks.Rd

@@ -84,6 +84,14 @@
     for all chromatograms is returned. 
   }
 
+  \item{drop}{
+    For \code{chromatogram}, \code{chromatograms}: \code{logical(1)}
+    whether the result should always be a \code{list} of
+    \code{data.frame} (\code{drop = FALSE}), even if data from a single
+    chromatogram is requested, or if, in such cases, a \code{data.frame}
+    should be returned (\code{drop = TRUE}, the default).    
+  }
+  
   \item{...}{Other arguments. A \code{scan} parameter can be passed to
     \code{peaks}.}  }