From 461a77198506a8cb9f026f96db53c5414bd71c31 Mon Sep 17 00:00:00 2001 From: jorainer Date: Wed, 18 Oct 2023 12:26:22 +0200 Subject: [PATCH] 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 | 2 +- R/MsExperiment.R | 4 ++++ R/functions-XCMSnExp.R | 25 +++++++++++++++---------- R/methods-XCMSnExp.R | 3 +++ inst/NEWS | 9 ++++++++- tests/testthat/test_MsExperiment.R | 5 +++++ tests/testthat/test_XcmsExperiment.R | 6 ++++++ 7 files changed, 42 insertions(+), 12 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d66fea55b..b396f15b7 100644 --- a/DESCRIPTION +++ b/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, diff --git a/R/MsExperiment.R b/R/MsExperiment.R index 9bc554bb9..bb318fda7 100644 --- a/R/MsExperiment.R +++ b/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, diff --git a/R/functions-XCMSnExp.R b/R/functions-XCMSnExp.R index a42f0ade2..142d6218a 100644 --- a/R/functions-XCMSnExp.R +++ b/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.") diff --git a/R/methods-XCMSnExp.R b/R/methods-XCMSnExp.R index ae6a186b7..3fe6293f6 100644 --- a/R/methods-XCMSnExp.R +++ b/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, ...) diff --git a/inst/NEWS b/inst/NEWS index ba0536418..4cfbf372a 100644 --- a/inst/NEWS +++ b/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 diff --git a/tests/testthat/test_MsExperiment.R b/tests/testthat/test_MsExperiment.R index 83f2de3f7..4e122b4d1 100644 --- a/tests/testthat/test_MsExperiment.R +++ b/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", { diff --git a/tests/testthat/test_XcmsExperiment.R b/tests/testthat/test_XcmsExperiment.R index 0b6a31854..c317d71be 100644 --- a/tests/testthat/test_XcmsExperiment.R +++ b/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)) +})