fix: fix the internal .match_last function

- `.match_last` was returning a wrong result if used with `nomatch = -1`. This
  affected removing or adding elements to the processHistory during xcms
  preprocessing.

R/functions-utils.R

@@ -765,7 +765,10 @@ groupOverlaps <- function(xmin, xmax) {
 }
 
 .match_last <- function(x, table, nomatch = NA_integer_) {
- length(table) - match(x, rev(table), nomatch = nomatch) + 1
+ mtch <- match(x, rev(table), nomatch = NA_integer_)
+ mtch <- length(table) - mtch + 1
+ mtch[is.na(mtch)] <- nomatch
+ mtch
 }
 
 #' @description

inst/NEWS

@@ -1,6 +1,7 @@
 Changes in version 4.1.4
 ----------------------
 
+- Fix issue in adjustRtime resulting in corrupt processHistory.
 - Add support to perform peakGroups alignment using pre-defined anchor peak
  matrix (i.e., the numeric matrix with retention times of anchor peaks in
  the samples that can be used to align these samples).

tests/testthat.R

@@ -16,10 +16,9 @@ faahko_3_files <- c(system.file('cdf/KO/ko15.CDF', package = "faahKO"),
  system.file('cdf/KO/ko16.CDF', package = "faahKO"),
  system.file('cdf/KO/ko18.CDF', package = "faahKO"))
 
+cwp <- CentWaveParam(noise = 10000, snthresh = 40, prefilter = c(3, 10000))
 faahko_od <- readMSData(faahko_3_files, mode = "onDisk")
-faahko_xod <- findChromPeaks(
- faahko_od, param = CentWaveParam(noise = 10000, snthresh = 40,
- prefilter = c(3, 10000)))
+faahko_xod <- findChromPeaks(faahko_od, param = cwp)
 od_x <- faahko_od
 mzr <- matrix(c(335, 335, 344, 344), ncol = 2, byrow = TRUE)
 od_chrs <- chromatogram(od_x, mz = mzr)
@@ -50,14 +49,14 @@ fticr_xod <- findChromPeaks(fticr, MSWParam(scales = c(1, 7),
 ## Pesticide data
 fl <- system.file("TripleTOF-SWATH", "PestMix1_SWATH.mzML", package = "msdata")
 pest_swth <- readMSData(fl, mode = "onDisk")
-cwp <- CentWaveParam(snthresh = 5, noise = 100, ppm = 10,
- peakwidth = c(3, 20), prefilter = c(3, 1000))
-pest_swth <- findChromPeaks(pest_swth, param = cwp)
-pest_swth <- findChromPeaksIsolationWindow(pest_swth, param = cwp)
+cwp2 <- CentWaveParam(snthresh = 5, noise = 100, ppm = 10,
+  peakwidth = c(3, 20), prefilter = c(3, 1000))
+pest_swth <- findChromPeaks(pest_swth, param = cwp2)
+pest_swth <- findChromPeaksIsolationWindow(pest_swth, param = cwp2)
 
 fl <- system.file("TripleTOF-SWATH", "PestMix1_DDA.mzML", package = "msdata")
 pest_dda <- readMSData(fl, mode = "onDisk")
-pest_dda <- findChromPeaks(pest_dda, param = cwp)
+pest_dda <- findChromPeaks(pest_dda, param = cwp2)
 
 ## Sciex test data.
 ## fl <- dir(system.file("sciex", package = "msdata"), full.names = TRUE)
@@ -70,11 +69,11 @@ df <- data.frame(mzML_file = basename(fls),
  dataOrigin = fls,
  sample = c("ko15", "ko16", "ko18"))
 mse <- readMsExperiment(spectraFiles = fls, sampleData = df)
-p <- CentWaveParam(noise = 10000, snthresh = 40, prefilter = c(3, 10000))
-xmse <- findChromPeaks(mse, param = p)
+xmse <- findChromPeaks(mse, param = cwp)
+expect_true(length(processHistory(xmse)) == 1L)
 pdp <- PeakDensityParam(sampleGroups = rep(1, 3))
 xmseg <- groupChromPeaks(xmse, param = pdp, add = FALSE)
-
+expect_true(length(processHistory(xmseg)) == 2L)
 test_check("xcms")
 
 bpstop(prm)

tests/testthat/test_XcmsExperiment.R

@@ -30,16 +30,17 @@ test_that("XcmsExperiment validation works", {
 ## - chromPeaks
 ## - chromPeakData
 test_that("findChromPeaks,MsExperiment et al works", {
- expect_error(findChromPeaks(MsExperiment(), param = p), "No spectra")
+ expect_error(findChromPeaks(MsExperiment(), param = cwp), "No spectra")
 
  a <- MsExperiment()
  spectra(a) <- spectra(mse)
- expect_error(findChromPeaks(a, param = p), "No link")
+ expect_error(findChromPeaks(a, param = cwp), "No link")
 
  res <- xmse
  expect_equal(res@chromPeaks, chromPeaks(faahko_xod))
  expect_equal(res@chromPeakData, as.data.frame(chromPeakData(faahko_xod)))
  expect_true(hasChromPeaks(res))
+ expect_true(length(processHistory(res)) == 1L)
 
  ## chromPeaks
  expect_equal(chromPeaks(res), res@chromPeaks)
@@ -66,22 +67,22 @@ test_that("findChromPeaks,MsExperiment et al works", {
  expect_true(nrow(rres@chromPeaks) == 0)
  expect_false(hasChromPeaks(rres))
 
- res2 <- findChromPeaks(mse, param = p, msLevel = 2L)
+ res2 <- findChromPeaks(mse, param = cwp, msLevel = 2L)
  expect_true(nrow(res2@chromPeaks) == 0)
  expect_false(hasChromPeaks(res2))
 
- res2 <- findChromPeaks(res, param = p, msLevel = 2L, add = TRUE)
+ res2 <- findChromPeaks(res, param = cwp, msLevel = 2L, add = TRUE)
  expect_equal(res@chromPeaks, res2@chromPeaks)
  expect_equal(res@chromPeakData, res2@chromPeakData)
  expect_true(length(res2@processHistory) == 2)
  expect_true(is.integer(chromPeakData(res2)$ms_level))
 
- res2 <- findChromPeaks(res, param = p, msLevel = 2L, add = FALSE)
+ res2 <- findChromPeaks(res, param = cwp, msLevel = 2L, add = FALSE)
  expect_equal(nrow(res2@chromPeaks), 0)
  expect_true(length(res2@processHistory) == 1)
  expect_true(is.integer(chromPeakData(res2)$ms_level))
 
- res2 <- findChromPeaks(mse, param = p, chunkSize = -1)
+ res2 <- findChromPeaks(mse, param = cwp, chunkSize = -1)
  expect_equal(res@chromPeaks, res2@chromPeaks)
  expect_true(is.integer(chromPeakData(res2)$ms_level))
 
@@ -299,7 +300,7 @@ test_that("adjustRtime,MsExperiment,XcmsExperiment,ObiwarpParam works", {
  expect_equal(rtime(res3, adjusted = TRUE), rtime(res2, adjusted = TRUE))
 
  ## Order: alignment, peak detection.
- res3 <- findChromPeaks(res, param = p)
+ res3 <- findChromPeaks(res, param = cwp)
  expect_true(hasChromPeaks(res3))
  expect_true(hasAdjustedRtime(res3))
  expect_true(length(res3@processHistory) == 2L)
@@ -347,9 +348,9 @@ test_that(".empty_feature_definitions works", {
 
 ## That's from XcmsExperiment-functions.R
 test_that(".xmse_group_cpeaks works", {
- expect_error(.xmse_group_cpeaks(chromPeaks(xmse), p), "No correspondence")
- ## Just for PeakDensityParam.
  pdp <- PeakDensityParam(sampleGroups = rep(1, 3))
+ expect_error(.xmse_group_cpeaks(chromPeaks(xmse), cwp), "No correspondence")
+ ## Just for PeakDensityParam.
  cp <- chromPeaks(xmse, msLevel = 1L)
  res <- .xmse_group_cpeaks(cp, pdp)
  expect_true(is.data.frame(res))
@@ -451,6 +452,7 @@ test_that("groupChromPeaks,XcmsExperiment and related things work", {
 test_that("adjustRtime,MsExperiment,PeakGroupsParam works", {
  a <- groupChromPeaks(xmse, param = PeakDensityParam(
  sampleGroups = c(1, 1, 1)))
+ expect_true(length(processHistory(a)) == 2L)
 
  pgp <- PeakGroupsParam(span = 0.4)
  expect_false(hasAdjustedRtime(a))
@@ -466,11 +468,14 @@ test_that("adjustRtime,MsExperiment,PeakGroupsParam works", {
  ## Run with pre-defined anchor peak data
  p <- res@processHistory[[3]]@param
  res_2 <- adjustRtime(xmse, param = p)
+ expect_true(length(processHistory(res_2)) ==
+ (length(processHistory(xmse)) + 1))
  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))
+ expect_true(length(processHistory(res_2)) == 1L)
 
  ## Subset-based
  p <- PeakGroupsParam(span = 0.4, subset = c(1, 3))
@@ -486,9 +491,12 @@ test_that("adjustRtime,MsExperiment,PeakGroupsParam works", {
  res_3 <- adjustRtime(xmse, param = p)
  expect_true(hasAdjustedRtime(res_3))
  expect_equal(rtime(res_2), rtime(res_3))
+ expect_true(length(processHistory(res_3)) ==
+ (length(processHistory(xmse)) + 1L))
  res_3 <- adjustRtime(mse, param = p)
  expect_true(hasAdjustedRtime(res_3))
  expect_equal(rtime(res_2), rtime(res_3))
+ expect_true(length(processHistory(res_3)) == 1L)
 })
 
 test_that("findChromPeaks,XcmsExperiment,MatchedFilterParam works", {

tests/testthat/test_functions-utils.R

@@ -493,3 +493,15 @@ test_that(".rawMat, .getEIC etc", {
  expect_true(ncol(res3) == 2)
  expect_true(any(res3[, "intensity"] == 0))
 })
+
+test_that(".match_last works", {
+ a <- c("a", "b", "c", "a", "b")
+ res <- .match_last("a", a)
+ expect_equal(res, 4)
+
+ res <- .match_last("d", a)
+ expect_equal(res, NA_integer_)
+
+ res <- .match_last(c("c", "a", "d"), a)
+ expect_equal(res, c(3L, 4L, NA_integer_))
+})