fix: add method to coerce XcmsExperiment to xcmsSet

- Add method to coerce a `XcmsExperiment` to a `xcmsSet` (issue #696).
- Fix `chromatogram,MsExperiment` to support also defining either `mz` or `rt`.

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: xcms
-Version: 3.99.5
+Version: 3.99.6
 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,

R/MsExperiment.R

@@ -99,6 +99,10 @@ setMethod(
             rt <- matrix(rt, ncol = 2L)
         if (!is.matrix(mz))
             mz <- matrix(mz, ncol = 2L)
+        if (nrow(mz) && !nrow(rt))
+            rt <- cbind(rep(-Inf, nrow(mz)), rep(Inf, nrow(mz)))
+        if (nrow(rt) && !nrow(mz))
+            mz <- cbind(rep(-Inf, nrow(rt)), rep(Inf, nrow(rt)))
         .mse_chromatogram(
             object, rt = rt, mz = mz, aggregationFun = aggregationFun,
             msLevel = msLevel, isolationWindow = isolationWindowTargetMz,

R/functions-XCMSnExp.R

@@ -29,12 +29,13 @@ dropGenericProcessHistory <- function(x, fun) {
 #'
 #' @noRd
 .XCMSnExp2xcmsSet <- function(from) {
-    if (any(msLevel(from) > 1))
-        stop("Coercing an XCMSnExp with MS level > 1 is not yet supported!")
     xs <- new("xcmsSet")
-    ## @peaks <- chromPeaks
-    if (hasChromPeaks(from))
+    if (hasChromPeaks(from)) {
+        if (any(chromPeakData(from)$ms_level) > 1)
+            stop("Coercing from an ", class(from)[1L],
+                 " with results on MS levels > 1 is not supported.")
         xs@peaks <- chromPeaks(from)
+    }
     ## @groups <- part of featureDefinitions
     ## @groupidx <- featureDefinitions(x)$peakidx
     if (hasFeatures(from)){
@@ -46,15 +47,17 @@ dropGenericProcessHistory <- function(x, fun) {
     ## @rt combination from rtime(x) and adjustedRtime(x)
     rts <- list()
     ## Ensure we're getting the raw rt
-    rts$raw <- rtime(from, bySample = TRUE, adjusted = FALSE)
+    rts$raw <- split(rtime(from, adjusted = FALSE), fromFile(from))
     if (hasAdjustedRtime(from))
-        rts$corrected <- adjustedRtime(from, bySample = TRUE)
+        rts$corrected <- split(rtime(from, adjusted = TRUE), fromFile(from))
     else
         rts$corrected <- rts$raw
     xs@rt <- rts
 
     ## @phenoData
-    pd <- pData(from)
+    if (inherits(from, "XcmsExperiment"))
+        pd <- as.data.frame(sampleData(from))
+    else  pd <- pData(from)
     if (nrow(pd) != length(fileNames(from))) {
         pd <- data.frame(file_name = basename(fileNames(from)))
         rownames(pd) <- pd$file_name
@@ -88,10 +91,12 @@ dropGenericProcessHistory <- function(x, fun) {
     profinfo(xs) <- c(list(method = profMethod, step = profStep), profParam)
 
     ## @mslevel <- msLevel?
-    xs@mslevel <- unique(msLevel(from))
+    xs@mslevel <- 1L
 
     ## @scanrange
-    xs@scanrange <- range(scanIndex(from))
+    if (inherits(from, "XcmsExperiment"))
+        xs@scanrange <- range(scanIndex(spectra(from)))
+    else xs@scanrange <- range(scanIndex(from))
 
     ## .processHistory: just take the processHistory as is.
     xs@.processHistory <- processHistory(from)
@@ -108,7 +113,7 @@ dropGenericProcessHistory <- function(x, fun) {
     ## @dataCorrection (numeric) ? in xcmsSet function, if lockMassFreq.
     ## @progressInfo skip
     ## @progressCallback skip
-    if (!any(colnames(pData(from)) == "class"))
+    if (!any(colnames(xs@phenoData) == "class"))
         message("Note: you might want to set/adjust the",
                 " 'sampclass' of the returned xcmSet object",
                 " before proceeding with the analysis.")

R/methods-XCMSnExp.R

@@ -1459,6 +1459,9 @@ setMethod("smooth", "XCMSnExp", function(x, method = c("SavitzkyGolay",
 #' @name XCMSnExp-class
 setAs(from = "XCMSnExp", to = "xcmsSet", def = .XCMSnExp2xcmsSet)
 
+#' @rdname XcmsExperiment
+setAs(from = "XcmsExperiment", to = "xcmsSet", def = .XCMSnExp2xcmsSet)
+
 #' @rdname XCMSnExp-peak-grouping-results
 setMethod("quantify", "XCMSnExp", function(object, ...) {
     .XCMSnExp2SummarizedExperiment(object, ...)

inst/NEWS

@@ -1,7 +1,14 @@
+Changes in version 3.99.6
+----------------------
+
+- Add method to coerce a `XcmsExperiment` to a `xcmsSet` (issue #696).
+- Support providing only `mz` or `rt` also for `chromatogram,MsExperiment`.
+
+
 Changes in version 3.99.5
 ----------------------
 
-- Only `mz` or `rt` need to be provided for `chromatograms`.
+- Only `mz` or `rt` need to be provided for `chromatogram`.
 
 
 Changes in version 3.99.4

tests/testthat/test_MsExperiment.R

@@ -77,6 +77,11 @@ test_that("chromatogram,MsExperiment works", {
     expect_equal(intensity(res[1, 1]), numeric())
     expect_equal(intensity(res[1, 2]), numeric())
     expect_equal(intensity(res[1, 2]), numeric())
+
+    res <- chromatogram(mse, rt = rbind(c(3000, 3500), c(4000, 4500)))
+    expect_equal(nrow(res), 2)
+    res <- chromatogram(mse, mz = rbind(c(200, 210), c(330, 331)))
+    expect_equal(nrow(res), 2)
 })
 
 test_that("uniqueMsLevels,MsExperiment works", {

tests/testthat/test_XcmsExperiment.R

@@ -1320,3 +1320,9 @@ test_that("chromPeaksChromatograms,XcmsExperiment works", {
     ints <- vapply(res, function(z) sum(intensity(z), na.rm = TRUE), numeric(1))
     expect_true(cor(chromPeaks(res)[, "into"], ints) >= 0.97)
 })
+
+test_that("setAs,XcmsExperiment,xcmsSet works", {
+    res <- as(xmseg, "xcmsSet")
+    expect_s4_class(res, "xcmsSet")
+    expect_equal(peaks(res), chromPeaks(xmseg))
+})