Merge pull request #768 from pablovgd/issue705

added chromPeakSummary method

NAMESPACE

@@ -461,7 +461,8 @@ export("CentWaveParam",
  "CleanPeaksParam",
  "MergeNeighboringPeaksParam",
  "FilterIntensityParam",
- "ChromPeakAreaParam")
+ "ChromPeakAreaParam",
+ "BetaDistributionParam")
 ## Param class methods.
 
 ## New Classes

R/DataClasses.R

@@ -2182,3 +2182,8 @@ setClass("FilterIntensityParam",
  msg
  else TRUE
  })
+
+setClass("BetaDistributionParam",
+ contains = "Param"
+ )
+

R/XcmsExperiment.R

@@ -2013,3 +2013,38 @@ setMethod(
  object[i = sort(unique(file)), keepAdjustedRtime = keepAdjustedRtime,
  keepFeatures = keepFeatures, ...]
  })
+
+#' @rdname chromPeakSummary
+setMethod(
+ "chromPeakSummary",
+ signature(object = "XcmsExperiment", param = "BetaDistributionParam"),
+ function(object, param, msLevel = 1L, chunkSize = 2L, BPPARAM = bpparam()) {
+ if (length(msLevel) != 1)
+ stop("Can only perform peak metrics for one MS level at a time.")
+ if (!hasChromPeaks(object, msLevel = msLevel))
+ stop("No ChromPeaks definitions for MS level ", msLevel, " present.")
+ ## Define region to calculate metrics from for each file
+ cp <- chromPeaks(object)
+ f <- factor(cp[,"sample"],seq_along(object))
+ pal <- split.data.frame(cp[,c("mzmin","mzmax","rtmin","rtmax")],f)
+ names(pal) <- seq_along(pal)
+ ## Manual chunk processing because we have to split `object` and `pal`
+ idx <- seq_along(object)
+ chunks <- split(idx, ceiling(idx / chunkSize))
+ pb <- progress_bar$new(format = paste0("[:bar] :current/:",
+ "total (:percent) in ",
+ ":elapsed"),
+ total = length(chunks) + 1L, clear = FALSE)
+ pb$tick(0)
+ # mzf <- "wMean"
+ res <- lapply(chunks, function(z, ...) {
+ pb$tick()
+ .xmse_integrate_chrom_peaks(
+ .subset_xcms_experiment(object, i = z, keepAdjustedRtime = TRUE,
+ ignoreHistory = TRUE),
+ pal = pal[z], intFun = .chrom_peak_beta_metrics, BPPARAM = BPPARAM)
+ })
+ res <- do.call(rbind, res)
+ pb$tick()
+ res
+ })

R/functions-Params.R

@@ -397,3 +397,8 @@ FilterIntensityParam <- function(threshold = 0, nValues = 1L, value = "maxo") {
  new("FilterIntensityParam", threshold = as.numeric(threshold),
  nValues = as.integer(nValues), value = value)
 }
+
+#' @rdname chromPeakSummary
+BetaDistributionParam <- function() {
+ new("BetaDistributionParam")
+}

tests/testthat/test_Param_classes.R

@@ -1002,3 +1002,12 @@ test_that("FilterIntensityParam works", {
  res@threshold <- c(10, 20)
  expect_error(validObject(res), "length 1")
 })
+
+
+test_that("BetaDistributionParam works", {
+ skip_on_os(os = "windows", arch = "i386")
+
+ res <- BetaDistributionParam()
+ expect_true(is(res, "BetaDistributionParam "))
+
+})

tests/testthat/test_XcmsExperiment.R

@@ -1452,3 +1452,14 @@ test_that("fillChromPeaks,XcmsExperiment works with verboseBetaColumns", {
  pks_fil <- chromPeaks(res)[chromPeakData(res)$is_filled, ]
  expect_true(sum(is.na(pks_fil[, "beta_cor"])) < 4)
 })
+
+test_that("chromPeakSummary,XcmsExperiment works", {
+ p <- CentWaveParam(noise = 10000, snthresh = 40, prefilter = c(3, 10000),
+ verboseBetaColumns = FALSE)
+ xmse <- findChromPeaks(mse, param = p)
+ mat <- chromPeakSummary(xmse,BetaDistributionParam())
+ expect_true(all(c("beta_cor", "beta_snr") %in% colnames(res))).
+ expect_true(is.numeric(mat))
+
+})
+