Fix issue in chromPeakSpectra for XcmsExperiment when duplicated chrom peaks are requested

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: xcms
-Version: 4.7.1
+Version: 4.7.2
 Title: LC-MS and GC-MS Data Analysis
 Description: Framework for processing and visualization of chromatographically
     separated and single-spectra mass spectral data. Imports from AIA/ANDI NetCDF,

NAMESPACE

@@ -428,7 +428,8 @@ importMethodsFrom("Spectra", "uniqueMsLevels")
 importMethodsFrom("Spectra", "backendBpparam")
 importMethodsFrom("Spectra", "estimatePrecursorIntensity")
 importMethodsFrom("Spectra", "filterRanges")
-importFrom("Spectra", "MsBackendMemory", "filterEmptySpectra")
+importFrom("Spectra", "MsBackendMemory", "filterEmptySpectra",
+           "concatenateSpectra")
 
 ## MsExperiment things
 importClassesFrom("MsExperiment", "MsExperiment")

NEWS.md

@@ -1,5 +1,10 @@
 # xcms 4.7
 
+## Changes in version 4.7.2
+
+- Fix issue in `chromPeakSpectra` for `XcmsExperiment` with duplicated chrom
+  peak IDs (issue #796).
+
 ## Changes in version 4.7.1
 
 - Change the naming convention of chromatographic peaks to include also the MS

R/XcmsExperiment.R

@@ -1309,7 +1309,7 @@ setMethod(
             pkidx <- .i2index(peaks, rownames(.chromPeaks(object)), "peaks")
         else pkidx <- integer()
         res <- .mse_spectra_for_peaks(object, method, msLevel, expandRt,
-                                      expandMz, ppm, skipFilled, pkidx,
+                                      expandMz, ppm, skipFilled, unique(pkidx),
                                       chromPeakColumns,
                                       BPPARAM)
         if (!length(pkidx))
@@ -1318,7 +1318,7 @@ setMethod(
         if (return.type == "Spectra")
             res[as.matrix(findMatches(peaks, res$chrom_peak_id))[, 2L]]
         else
-            as(split(res, factor(res$chrom_peak_id, levels = peaks)), "List")
+            as(split(res, factor(res$chrom_peak_id))[peaks], "List")
     })
 
 #' @rdname reconstructChromPeakSpectra

R/XcmsExperimentHdf5.R

@@ -1288,17 +1288,17 @@ setMethod(
                 h5f, ids[i], spectra(object[i]),
                 method = method, msLevel = msLevel, expandRt = expandRt,
                 expandMz = expandMz, ppm = ppm, skipFilled = skipFilled,
-                peaks = peaks, chromPeakColumns = chromPeakColumns)
+                peaks = unique(peaks), chromPeakColumns = chromPeakColumns)
         })
-        res <- Spectra:::.concatenate_spectra(res)
+        res <- concatenateSpectra(res)
         if (return.type == "Spectra") {
             if (length(peaks))
                 res[as.matrix(findMatches(peaks, res$chrom_peak_id))[, 2L]]
             else res
         } else {
             if (!length(peaks))
                 peaks <- unique(res$chrom_peak_id)
-            as(split(res, factor(res$chrom_peak_id, levels = peaks)), "List")
+            as(split(res, factor(res$chrom_peak_id))[peaks], "List")
         }
     })
 
@@ -1364,7 +1364,7 @@ setMethod(
                 s
             } else Spectra()
         })
-        res <- Spectra:::.concatenate_spectra(res)
+        res <- concatenateSpectra(res)
         ## add feature columns
         fd <- fd[match(res$feature_id, rownames(fd)),
                  featureColumns, drop = FALSE]

tests/testthat/test_XcmsExperiment.R

@@ -945,7 +945,7 @@ test_that(".mse_spectra_for_peaks works", {
     expect_equal(mz(res)[1], mz(res)[3])
 })
 
-test_that("chromPeakSpectra works", {
+test_that("chromPeakSpectra,XcmsExperiment works", {
     ## input errors
     expect_error(chromPeakSpectra(xmse, method = "other"), "'arg' should be")
     expect_error(chromPeakSpectra(xmse, return.type = "list"), "'arg' should")
@@ -1005,6 +1005,51 @@ test_that("chromPeakSpectra works", {
                     precursorMz(res[[1L]]) <= chromPeaks(tmp)[1, "mzmax"]))
     expect_equal(rtime(chromPeakSpectra(tmp, peaks = c("CP7", "CP1", "CP3"))),
                  rtime(chromPeakSpectra(tmp, peaks = c(7, 1, 3))))
+    ## single spectrum, selected chrom peaks
+    a <- chromPeakSpectra(tmp, msLevel = 1L, method = "closest_rt",
+                          peaks = c("CP1", "CP2"))
+    expect_s4_class(a, "Spectra")
+    expect_equal(length(a), 2)
+    expect_equal(a$chrom_peak_id, c("CP1", "CP2"))
+    b <- chromPeakSpectra(tmp, msLevel = 1L, method = "closest_rt",
+                          peaks = c("CP2", "CP1"))
+    expect_equal(b$chrom_peak_id, c("CP2", "CP1"))
+    expect_equal(b$rtime, a$rtime[2:1])
+    d <- chromPeakSpectra(tmp, msLevel = 1L, method = "closest_rt",
+                          peaks = c("CP1", "CP2", "CP1"))
+    expect_equal(length(d), 3L)
+    expect_equal(d$chrom_peak_id, c("CP1", "CP2", "CP1"))
+    expect_equal(d$rtime, c(a$rtime, a$rtime[1L]))
+    ## As a List
+    a <- chromPeakSpectra(tmp, msLevel = 1L, method = "closest_rt",
+                          peaks = c("CP1", "CP2"), return.type = "List")
+    expect_s4_class(a, "List")
+    expect_equal(length(a), 2)
+    expect_equal(vapply(a, function(z) z$chrom_peak_id, NA_character_),
+                 c(CP1 = "CP1", CP2 = "CP2"))
+    b <- chromPeakSpectra(tmp, msLevel = 1L, method = "closest_rt",
+                          peaks = c("CP2", "CP1"), return.type = "List")
+    expect_equal(vapply(b, function(z) z$chrom_peak_id, NA_character_),
+                 c(CP2 = "CP2", CP1 = "CP1"))
+    expect_equal(vapply(b, function(z) z$rtime, NA_real_),
+                 vapply(a, function(z) z$rtime, NA_real_)[2:1])
+    d <- chromPeakSpectra(tmp, msLevel = 1L, method = "closest_rt",
+                          peaks = c("CP1", "CP2", "CP1"), return.type = "List")
+    expect_equal(length(d), 3L)
+    expect_equal(names(d), c("CP1", "CP2", "CP1"))
+    expect_equal(vapply(d, function(z) z$chrom_peak_id, NA_character_),
+                 c(CP1 = "CP1", CP2 = "CP2", CP1 = "CP1"))
+    expect_equal(vapply(d, function(z) z$rtime, NA_real_),
+                 c(CP1 = a[[1L]]$rtime, CP2 = a[[2L]]$rtime[1L],
+                   CP1 = a[[1L]]$rtime[1L]))
+
+    ## Getting all spectra.
+    a <- chromPeakSpectra(tmp, msLevel = 1L, peaks = c("CP1", "CP2"))
+    expect_true(all(a$chrom_peak_id %in% c("CP1", "CP2")))
+    b <- chromPeakSpectra(tmp, msLevel = 1L, peaks = c("CP1", "CP2", "CP1"))
+    expect_true(length(b) > length(a))
+    a_1 <- a[a$chrom_peak_id == "CP1"]
+    expect_equal(rtime(b), c(rtime(a), rtime(a_1)))
 })
 
 test_that("manualChromPeaks,XcmsExperiment works", {

tests/testthat/test_XcmsExperimentHdf5.R

@@ -863,6 +863,24 @@ test_that("chromPeakSpectra,XcmsExperimentHdf5 works", {
     expect_s4_class(s_all, "Spectra")
     expect_true(all(msLevel(s_all) == 2L))
     expect_false(all(rownames(cp) %in% s_all$chrom_peak_id))
+
+    ## single spectrum, selected peaks
+    s_all <- chromPeakSpectra(xmse_h5, msLevel = 1L, method = "closest_rt")
+    pids <- c("CP1S3000006", "CP1S3000003", "CP1S1000060", "CP1S3000048")
+    s_sel <- chromPeakSpectra(xmse_h5, msLevel = 1L, peaks = pids,
+                              method = "closest_rt")
+    expect_s4_class(s_sel, "Spectra")
+    expect_equal(s_sel$chrom_peak_id, pids)
+    expect_equal(rtime(s_sel), rtime(s_all[match(pids, s_all$chrom_peak_id)]))
+
+    ## Duplicated peaks
+    pids <- c("CP1S3000006", "CP1S3000003", "CP1S1000060",
+              "CP1S3000048", "CP1S3000006")
+    s_sel2 <- chromPeakSpectra(xmse_h5, msLevel = 1L, peaks = pids,
+                               method = "closest_rt")
+    expect_s4_class(s_sel2, "Spectra")
+    expect_equal(s_sel2$chrom_peak_id, pids)
+    expect_equal(s_sel2$rtime, c(s_sel$rtime, s_sel$rtime[1]))
 })
 
 test_that("featureSpectra,XcmsExperimentHdf5 works", {

tests/testthat/test_functions-XCMSnExp.R

@@ -190,7 +190,6 @@ test_that("exportMetaboAnalyst works", {
 })
 
 test_that("chromPeakSpectra works", {
-    skip_on_os(os = "windows", arch = "i386")
 
     ## For now we don't have MS1/MS2 data, so we have to stick to errors etc.
     expect_error(ms2_mspectrum_for_all_peaks(xod_x, method = "other"))
@@ -242,6 +241,24 @@ test_that("chromPeakSpectra works", {
         res <- chromPeakSpectra(pest_dda, msLevel = 2L, return.type = "List")
         expect_true(is(res, "List"))
         expect_true(length(res) == nrow(chromPeaks(pest_dda)))
+
+        ## chrom peak IDs in any order
+        a <- chromPeakSpectra(
+            pest_dda, msLevel = 1L, return.type = "Spectra",
+            method = "closest_rt", peaks = c("CP01", "CP02"))
+        expect_equal(a$peak_id, c("CP01", "CP02"))
+        b <- chromPeakSpectra(
+            pest_dda, msLevel = 1L, return.type = "Spectra",
+            method = "closest_rt", peaks = c("CP02", "CP01"))
+        expect_equal(b$peak_id, c("CP02", "CP01"))
+        expect_equal(a$rtime, b$rtime[2:1])
+        ## duplicated chrom peak IDs
+        d <- chromPeakSpectra(
+            pest_dda, msLevel = 1L, return.type = "Spectra",
+            method = "closest_rt", peaks = c("CP01", "CP02", "CP01"))
+        expect_equal(length(d), 3)
+        expect_equal(d$peak_id, c("CP01", "CP02", "CP01"))
+        expect_equal(d$scanIndex, c(a$scanIndex, a$scanIndex[1L]))
     }
 })