Merge Nils Hoffmann's PR #302

Author: sneumann

DESCRIPTION

@@ -2,7 +2,7 @@ Package: mzR
 Type: Package
 Title: parser for netCDF, mzXML and mzML and mzIdentML files
        (mass spectrometry data)
-Version: 2.41.2
+Version: 2.41.3
 Author: Bernd Fischer, Steffen Neumann, Laurent Gatto, Qiang Kou, Johannes Rainer
 Authors@R: c(
     person("Steffen", "Neumann", email="[email protected]", role=c("aut","cre")),

NEWS

@@ -1,3 +1,7 @@
+CHANGES IN VERSION 2.41.3
+-------------------------
+o Fixed off-by-one indexing issue with index access for chromatogramHeader vs chromatogram. Fixes #302. Thanks Nils Hoffmann !
+
 CHANGES IN VERSION 2.41.2
 -------------------------
 o Report also electron beam energy (MS:1003410) for EAD data.

R/methods-mzRpwiz.R

@@ -150,7 +150,7 @@ setMethod("tic", "mzRpwiz",
           function(object, ...) {
               if (nChrom(object) < 1)
                   stop("No chromatogram data available.")
-              object@backend$getChromatogramsInfo(0L)
+              object@backend$getChromatogramsInfo(1L)
           })
 
 setMethod("chromatograms", "mzRpwiz",
@@ -173,8 +173,7 @@ setMethod("chromatogram", "mzRpwiz",
               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
+              # chromatogram index is adjusted in the backend function
               if (length(chrom) == 1 & !all) {
                   ans <- object@backend$getChromatogramsInfo(chrom)
               } else {
@@ -192,10 +191,11 @@ setMethod("chromatogramHeader", "mzRpwiz",
               } else {
                   stopifnot(is.numeric(chrom))
                   n <- nChrom(object)
-                  if (min(chrom) < 1 || max(chrom) > n)
-                      stop("Index out of bound [", 1, ":", n, "]")
-                  chrom <- chrom -1L
-                  res <- object@backend$getChromatogramHeaderInfo(chrom)
+
+                  if (min(chrom) < 1 | max(chrom) > n)
+                    stop("Index out of bound [", 1, ":", n, "]")
+                  # chromatogram index is adjusted in the backend function
+                  res <- object@backend$getChromatogramHeaderInfo(as.integer(chrom))
               }
               res$chromatogramId <- as.character(res$chromatogramId)
               res

inst/unitTests/test_chromatograms.R

@@ -11,22 +11,69 @@ test_chromatograms1 <- function() {
     checkIdentical(nrow(chromatogram(x, 136L)), 527L)
     checkIdentical(nrow(chromatogram(x, 137L)), 567L)
     checkIdentical(nrow(chromatogram(x, 138L)), 567L)
+    close(x)
 }
 
 test_chromatograms2 <- function() {
     f <- proteomics(full.names = TRUE,
                     pattern = "TMT_Erwinia_1uLSike_Top10HCD_isol2_45stepped_60min_01.mzML.gz")
     x <- openMSfile(f, backend = "pwiz")
-    checkIdentical(nChrom(x), 1L)   
+    checkIdentical(nChrom(x), 1L)
     checkIdentical(tic(x), chromatogram(x, 1L))
     checkIdentical(nrow(tic(x)), 7534L)
+    close(x)
+}
+
+test_chromatogramHeader_indexing <- function() {
+    f <- proteomics(full.names = TRUE, pattern = "MRM")
+    x <- openMSfile(f, backend = "pwiz")
+    tic <- chromatogramHeader(x, 1)
+    tic1 <- chromatogramHeader(x, 1:1)
+    # next chromatogram after TIC (if we assume TIC is always at index 1)
+    ch2 <- chromatogramHeader(x, 2)
+    checkEquals(colnames(ch2), c("chromatogramId", "chromatogramIndex", "polarity",
+                                "precursorIsolationWindowTargetMZ",
+                                "precursorIsolationWindowLowerOffset",
+                                "precursorIsolationWindowUpperOffset",
+                                "precursorCollisionEnergy",
+                                "productIsolationWindowTargetMZ",
+                                "productIsolationWindowLowerOffset",
+                                "productIsolationWindowUpperOffset"))
+    checkEquals(tic$chromatogramId, "TIC")
+    checkEquals(tic1$chromatogramId, "TIC")
+    checkTrue(!is.na(ch2$precursorIsolationWindowTargetMZ))
+    checkTrue(!is.na(ch2$productIsolationWindowTargetMZ))
+    checkEquals(nrow(ch2), 1)
+    # test index below lower bound should raise error
+    tryCatch({
+        chromatogramHeader(x, 0)
+        checkTrue(FALSE)
+    }, error = function(e) {
+        checkTrue(grepl("Index out of bound", e$message))
+    })
+    # check last chromatogram in bounds
+    ch138 <- chromatogramHeader(x, 138)
+    checkTrue(startsWith(ch138$chromatogramId, "- SRM SIC Q1=808.1 Q3=407.996"))
+    # test index above upper bound should raise error
+    tryCatch({
+        chromatogramHeader(x, 139)
+        checkTrue(FALSE)
+    }, error = function(e) {
+        checkTrue(grepl("Index out of bound", e$message))
+    })
+
+    chrom2 <- chromatogram(x, 2)
+    ch2SafeChromId <- make.names(ch2$chromatogramId)
+    checkEquals(ch2SafeChromId, colnames(chrom2)[2])
+
+    close(x)
 }
 
 test_chromatogramHeader <- function() {
     library(mzR)
     library(RUnit)
     library(msdata)
-    
+
     f <- proteomics(full.names = TRUE, pattern = "MRM")
     x <- openMSfile(f)
 
@@ -42,7 +89,7 @@ test_chromatogramHeader <- function() {
                                 "productIsolationWindowUpperOffset"))
     checkEquals(ch$chromatogramId[1], "TIC")
     checkEquals(sum(is.na(ch$precursorIsolationWindowTargetMZ)), 1)
-    checkEquals(sum(is.na(ch$productIsolationWindowTargetMZ)), 1)    
+    checkEquals(sum(is.na(ch$productIsolationWindowTargetMZ)), 1)
     checkEquals(length(chrs), nrow(ch))
     close(x)
 

src/RcppPwiz.cpp

@@ -845,7 +845,9 @@ void RcppPwiz::addSpectrumList(MSData& msd,
     spct.defaultArrayLength = spct_mz->data.size();
   }
 }
-
+// get the chromatogram data arrays.
+// whichChrom - 1-based index of chromatogram to extract.
+//
 Rcpp::DataFrame RcppPwiz::getChromatogramsInfo( int whichChrom )
 {
   if (msd != NULL) {
@@ -856,13 +858,14 @@ Rcpp::DataFrame RcppPwiz::getChromatogramsInfo( int whichChrom )
     } else if (clp->size() == 0) {
       Rf_warningcall(R_NilValue, "No available chromatogram info.");
       return Rcpp::DataFrame::create();
-    } else if ( (whichChrom < 0) || (whichChrom > clp->size()) ) {
-      Rprintf("Index whichChrom out of bounds [0 ... %d].\n", (clp->size())-1);
+    } else if ( (whichChrom < 1) || (whichChrom > clp->size()) ) {
+      Rprintf("Index whichChrom out of bounds [1 ... %d].\n", (clp->size()));
       return Rcpp::DataFrame::create( );
     } else {
       std::vector<double> time;
       std::vector<double> intensity;
-      ChromatogramPtr c = clp->chromatogram(whichChrom, true);
+      // correct index from 1-based (R) to 0-based indexing (C++)
+      ChromatogramPtr c = clp->chromatogram(whichChrom - 1, true);
       vector<TimeIntensityPair> pairs;
       c->getTimeIntensityPairs (pairs);
 
@@ -915,12 +918,13 @@ Rcpp::DataFrame RcppPwiz::getChromatogramHeaderInfo (Rcpp::IntegerVector whichCh
 
     for (int i = 0; i < N_chrom; i++) {
       int current_chrom = whichChrom[i];
-      if (current_chrom < 0 || current_chrom > N) {
+      if (current_chrom < 1 || current_chrom > N) {
 	Rf_warningcall(R_NilValue, "Provided index out of bounds.");
 	Rcpp::Rcerr << "Provided index out of bounds" << std::endl;
       }
       ChromatogramPtr ch = clp->chromatogram(current_chrom - 1, false);
       chromatogramId[i] = ch->id;
+      // retain 1-based index for the chromatogram to return to R
       chromatogramIndex[i] = current_chrom;
       CVParam param = ch->cvParamChild(MS_scan_polarity);
       polarity[i] = (param.cvid==MS_negative_scan ? 0 : (param.cvid==MS_positive_scan ? +1 : -1 ) );

vignettes/mzR.Rmd

@@ -80,8 +80,10 @@ matrices or a single matrix if one spectrum is queried.
 
 Access to the chromatogram(s) is done using the `chromatogram` (or
 `chromatograms`) function, that return one (or a list of)
-data.frames. See `?chromatogram` for details. This functionality is
-only available with the `pwiz` backend.
+data.frames. See `?chromatogram` for details. Chromatogram header information 
+is available via the `chromatogramHeader` function that returns one (or
+a list of) data.frames. See `?chromatogramHeader` for details. This 
+functionality is only available with the `pwiz` backend.
 
 ## Identification result access