feat: support coercing from XcmsExperiment to XCMSnExp

- Support coercing from `XcmsExperiment` to `XCMSnExp` using
  `setAs(object, "XCMSnExp")` (issue #752).

DESCRIPTION

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

NEWS.md

@@ -1,5 +1,10 @@
 # xcms 4.3
 
+## Changes in version 4.3.3
+
+- Support coercing from `XcmsExperiment` to `XCMSnExp` with
+  `as(object, "XCMSnExp")`.
+
 ## Changes in version 4.3.2
 
 - Remove data/results import/export functionality as it is being developed in

R/XcmsExperiment-functions.R

@@ -1136,6 +1136,72 @@ featureArea <- function(object, mzmin = min, mzmax = max, rtmin = min,
 }
 
 #' function to create an empty `XcmsExperiment` object
+#'
+#' @noRd
 XcmsExperiment <- function() {
     as(MsExperiment(), "XcmsExperiment")
 }
+
+#' function to convert an XcmsExperiment into an XCMSnExp.
+#'
+#' @author Johannes Rainer
+#'
+#' @noRd
+.xcms_experiment_to_xcms_n_exp <- function(x) {
+    requireNamespace("MSnbase", quietly = TRUE)
+    n <- new("XCMSnExp")
+    if (!length(x))
+        return(n)
+    m <- new("MsFeatureData")
+    ## works only if we have a MsBackendMzR
+    if (!inherits(spectra(x)@backend, "MsBackendMzR"))
+        stop("Can not convert 'x' to a 'XCMSnExp' object: 'spectra(x)' uses an",
+             " MS backend other than 'MsBackendMzR'. Currently, only coercion",
+             " of an object with a 'MsBackendMzR' is supported.")
+    ## works only if we have an empty processing queue
+    if (length(spectra(x)@processingQueue) > 0)
+        stop("Can not convert 'x' to a 'XCMSnExp' object: processing queue of ",
+             "the Spectra object is not empty.")
+    ## -> OnDiskMSnExp
+    n@processingData <- new("MSnProcess",
+                            processing = paste0("Data converted [", date(), "]"),
+                            files = fileNames(x),
+                            smoothed = NA)
+    n@phenoData <- new("NAnnotatedDataFrame", as.data.frame(sampleData(x)))
+    fd <- as.data.frame(spectra(x)@backend@spectraData)
+    fd$fileIdx <- match(fd$dataStorage, fileNames(x))
+    fd <- fd[, !colnames(fd) %in% c("dataStorage", "dataOrigin")]
+    colnames(fd) <- sub("scanIndex", "spIdx", colnames(fd))
+    colnames(fd) <- sub("rtime", "retentionTime", colnames(fd))
+    colnames(fd) <- sub("precScanNum", "precursorScanNum", colnames(fd))
+    colnames(fd) <- sub("precursorMz", "precursorMZ", colnames(fd))
+    fd$spectrum <- seq_len(nrow(fd))
+    rownames(fd) <- MSnbase:::formatFileSpectrumNames(
+                                  fd$fileIdx, fd$spIdx,
+                                  max(fd$fileIdx), max(fd$spIdx))
+    n@featureData <- new("AnnotatedDataFrame", fd)
+    nf <- length(fileNames(x))
+    n@experimentData <- new("MIAPE",
+                            instrumentManufacturer = rep(NA_character_, nf),
+                            instrumentModel = rep(NA_character_, nf),
+                            ionSource = rep(NA_character_, nf),
+                            analyser = rep(NA_character_, nf),
+                            detectorType = rep(NA_character_, nf))
+    ## -> XCMSnExp
+    if (hasChromPeaks(x)) {
+        chromPeaks(m) <- chromPeaks(x)
+        chromPeakData(m) <- chromPeakData(x)
+    }
+    if (hasAdjustedRtime(x)) {
+        art <- fd$retentionTime_adjusted
+        names(art) <- rownames(fd)
+        adjustedRtime(m) <- split(art, fd$fileIdx)
+    }
+    if (hasFeatures(x))
+        featureDefinitions(m) <- DataFrame(featureDefinitions(x))
+    lockEnvironment(m, bindings = TRUE)
+    n@msFeatureData <- m
+    n@.processHistory <- x@processHistory
+    validObject(n)
+    n
+}

R/methods-XCMSnExp.R

@@ -1439,6 +1439,12 @@ setAs(from = "XCMSnExp", to = "xcmsSet", def = .XCMSnExp2xcmsSet)
 #' @name XcmsExperiment
 setAs(from = "XcmsExperiment", to = "xcmsSet", def = .XCMSnExp2xcmsSet)
 
+#' @rdname XcmsExperiment
+#'
+#' @name XcmsExperiment
+setAs(from = "XcmsExperiment", to = "XCMSnExp",
+      def = .xcms_experiment_to_xcms_n_exp)
+
 #' @rdname XCMSnExp-peak-grouping-results
 setMethod("quantify", "XCMSnExp", function(object, ...) {
     .XCMSnExp2SummarizedExperiment(object, ...)

tests/testthat/test_XcmsExperiment-functions.R

@@ -201,3 +201,32 @@ test_that(".features_ms_region works", {
         xmseg, features = rownames(featureDefinitions(xmseg)))
     expect_equal(rownames(res), rownames(featureDefinitions(xmseg)))
 })
+
+test_that(".xcms_experiment_to_xcms_n_exp works", {
+    a <- XcmsExperiment()
+    res <- xcms:::.xcms_experiment_to_xcms_n_exp(a)
+    expect_s4_class(res, "XCMSnExp")
+    expect_true(length(res) == 0)
+
+    a <- loadXcmsData("xmse")
+    a1 <- a[1]
+    a1@spectra <- Spectra::setBackend(spectra(a1), MsBackendMemory())
+    expect_error(xcms:::.xcms_experiment_to_xcms_n_exp(a1), "MsBackendMzR")
+
+    res <- xcms:::.xcms_experiment_to_xcms_n_exp(a)
+    expect_s4_class(res, "XCMSnExp")
+    expect_equal(unname(rtime(res)), rtime(a))
+    expect_equal(chromPeaks(res), chromPeaks(a))
+    expect_equal(chromPeakData(res), chromPeakData(a))
+    expect_equal(featureDefinitions(res), DataFrame(featureDefinitions(a)))
+    expect_equal(res@.processHistory, a@processHistory)
+
+    ref <- loadXcmsData("xdata")
+    expect_equal(rtime(res), rtime(ref))
+
+    expect_true(hasChromPeaks(res))
+    expect_true(hasAdjustedRtime(res))
+    expect_true(hasFeatures(res))
+
+    expect_equal(mz(res[1:3]), mz(ref[1:3]))
+})