refactor: allow peakGroups alignment using prefefined anchor matrix

- Support alignment with the peakGroups method using a predefined anchor matrix.

R/XcmsExperiment.R

@@ -1351,35 +1351,28 @@ setMethod(
  "adjustRtime", signature(object = "MsExperiment",
  param = "PeakGroupsParam"),
  function(object, param, msLevel = 1L, ...) {
+ if (!inherits(object, "XcmsExperiment"))
+ object <- as(object, "XcmsExperiment")
  if (hasAdjustedRtime(object)) {
  message("Removing previous alignment results")
  object <- dropAdjustedRtime(object)
  }
  if (any(msLevel != 1L))
  stop("Alignment is currently only supported for MS level 1")
- if (!hasFeatures(object))
- stop("No feature definitions present in 'object'. Please perform ",
- "first a correspondence analysis using 'groupChromPeaks'")
- if (!nrow(peakGroupsMatrix(param)))
+ if (!nrow(peakGroupsMatrix(param))) {
+ if (!hasFeatures(object))
+ stop("No feature definitions present in 'object'. Please ",
+ "perform first a correspondence analysis using ",
+ "'groupChromPeaks'")
  peakGroupsMatrix(param) <- adjustRtimePeakGroups(
  object, param = param)
+ }
  fidx <- as.factor(fromFile(object))
  rt_raw <- split(rtime(object), fidx)
- rt_adj <- do_adjustRtime_peakGroups(
- chromPeaks(object, msLevel = msLevel),
- peakIndex = .update_feature_definitions(
- featureDefinitions(object), rownames(chromPeaks(object)),
- rownames(chromPeaks(object, msLevel = msLevel)))$peakidx,
- rtime = rt_raw,
- minFraction = minFraction(param),
- extraPeaks = extraPeaks(param),
- smooth = smooth(param),
- span = span(param),
- family = family(param),
- peakGroupsMatrix = peakGroupsMatrix(param),
- subset = subset(param),
- subsetAdjust = subsetAdjust(param)
- )
+ rt_adj <- .adjustRtime_peakGroupsMatrix(
+ rt_raw, peakGroupsMatrix(param), smooth = smooth(param),
+ span = span(param), family = family(param),
+ subset = subset(param), subsetAdjust = subsetAdjust(param))
  pt <- vapply(object@processHistory, processType, character(1))
  idx_pg <- .match_last(.PROCSTEP.PEAK.GROUPING, pt, nomatch = -1L)
  if (idx_pg > 0)

R/methods-XCMSnExp.R

@@ -1680,38 +1680,27 @@ setMethod("adjustRtime",
  }
  if (any(msLevel != 1))
  stop("Alignment is currently only supported for MS level 1")
- if (!hasChromPeaks(object))
- stop("No chromatographic peak detection results in 'object'!",
- " Please perform first a peak detection using the ",
- "'findChromPeaks' method.")
- if (!hasFeatures(object))
- stop("No feature definitions found in 'object'! Please ",
- "perform first a peak grouping using the ",
- "'groupChromPeak' method.")
- if (hasChromPeaks(object) & !.has_chrom_peak_data(object))
- object <- updateObject(object)
- startDate <- date()
- ## If param does contain a peakGroupsMatrix extract that one,
- ## otherwise generate it.
  if (nrow(peakGroupsMatrix(param)))
  pkGrpMat <- peakGroupsMatrix(param)
- else
+ else {
+ if (!hasChromPeaks(object))
+ stop("No chromatographic peak detection results in ",
+ "'object'! Please perform first a peak detection ",
+ "using the 'findChromPeaks' method.")
+ if (!hasFeatures(object))
+ stop("No feature definitions found in 'object'! Please ",
+ "perform first a peak grouping using the ",
+ "'groupChromPeak' method.")
  pkGrpMat <- adjustRtimePeakGroups(object, param = param)
- res <- do_adjustRtime_peakGroups(
- chromPeaks(object, msLevel = msLevel),
- peakIndex = .update_feature_definitions(
- featureDefinitions(object), rownames(chromPeaks(object)),
- rownames(chromPeaks(object, msLevel = msLevel)))$peakidx,
- rtime = rtime(object, bySample = TRUE),
- minFraction = minFraction(param),
- extraPeaks = extraPeaks(param),
- smooth = smooth(param),
- span = span(param),
- family = family(param),
- peakGroupsMatrix = pkGrpMat,
- subset = subset(param),
- subsetAdjust = subsetAdjust(param)
- )
+ }
+ if (hasChromPeaks(object) & !.has_chrom_peak_data(object))
+ object <- updateObject(object)
+ startDate <- date()
+ res <- .adjustRtime_peakGroupsMatrix(
+ rtime(object, bySample = TRUE), pkGrpMat,
+ smooth = smooth(param), span = span(param),
+ family = family(param), subset = subset(param),
+ subsetAdjust = subsetAdjust(param))
  ## Add the pkGrpMat that's being used to the param object.
  peakGroupsMatrix(param) <- pkGrpMat
  ## Dropping the peak groups but don't remove its process history

tests/testthat/test_XcmsExperiment.R

@@ -463,6 +463,15 @@ test_that("adjustRtime,MsExperiment,PeakGroupsParam works", {
  expect_true(length(res@processHistory) == 3L)
  expect_true(sum(rtime(res) != rtime(a)) > 1000)
 
+ ## Run with pre-defined anchor peak data
+ p <- res@processHistory[[3]]@param
+ res_2 <- adjustRtime(xmse, param = p)
+ expect_true(hasAdjustedRtime(res_2))
+ expect_equal(rtime(res), rtime(res_2))
+ res_2 <- adjustRtime(mse, param = p)
+ expect_true(hasAdjustedRtime(res_2))
+ expect_equal(rtime(res), rtime(res_2))
+
  ## Subset-based
  p <- PeakGroupsParam(span = 0.4, subset = c(1, 3))
  res_2 <- adjustRtime(a, p)
@@ -472,6 +481,14 @@ test_that("adjustRtime,MsExperiment,PeakGroupsParam works", {
  expect_true(sum(rtime(res_2) != rtime(a)) > 1000)
  expect_true(sum(rtime(res_2) != rtime(res)) > 1000)
 
+ ## Run with pre-defined anchor peak data
+ p <- res_2@processHistory[[3]]@param
+ res_3 <- adjustRtime(xmse, param = p)
+ expect_true(hasAdjustedRtime(res_3))
+ expect_equal(rtime(res_2), rtime(res_3))
+ res_3 <- adjustRtime(mse, param = p)
+ expect_true(hasAdjustedRtime(res_3))
+ expect_equal(rtime(res_2), rtime(res_3))
 })
 
 test_that("findChromPeaks,XcmsExperiment,MatchedFilterParam works", {

tests/testthat/test_methods-XCMSnExp.R

@@ -1622,8 +1622,8 @@ test_that("adjustRtime,peakGroups works", {
  skip_on_os(os = "windows", arch = "i386")
 
  xod <- faahko_xod
- xodg <- groupChromPeaks(xod,
-   param = PeakDensityParam(sampleGroups = rep(1, 3)))
+ xodg <- groupChromPeaks(
+ xod, param = PeakDensityParam(sampleGroups = rep(1, 3)))
  pks <- chromPeaks(xodg)
  expect_true(length(processHistory(xodg,
  type = .PROCSTEP.PEAK.DETECTION)) == 1)