Merge pull request #773 from sneumann/phili

addition of chromPeaksId to `matchLamaChromPeaks()` output

.github/workflows/check-bioc.yml

@@ -222,7 +222,7 @@ jobs:
           rcmdcheck::rcmdcheck(
               args = c("--no-build-vignettes", "--no-manual", "--timings"),
               build_args = c("--no-manual", "--no-resave-data"),
-              error_on = "warning",
+              error_on = "error",
               check_dir = "check"
           )
         shell: Rscript {0}

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: xcms
-Version: 4.3.3
+Version: 4.3.4
 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,14 @@
 # xcms 4.3
 
+## Changes in version 4.3.4
+
+- Small update to the `matchLamaChromPeaks()` function to get the chromPeaksId
+  of the chromPeaks matched with Lamas. 
+- Small fix to the .yml file for the github actions, so they do not crash on 
+  warnings.
+
+
+
 ## Changes in version 4.3.3
 
 - Fix issue #755: `chromatogram()` with `msLevel = 2` fails to extract

R/AllGenerics.R

@@ -2050,7 +2050,6 @@ setGeneric("stitch", function(object, lockMass, ...) standardGeneric("stitch"))
 setGeneric("stitch.xml", function(object, lockMass) standardGeneric("stitch.xml"))
 setGeneric("stitch.netCDF", function(object, lockMass) standardGeneric("stitch.netCDF"))
 setGeneric("stitch.netCDF.new", function(object, lockMass) standardGeneric("stitch.netCDF.new"))
-
 setGeneric("subset<-", function(object, value) standardGeneric("subset<-"))
 setGeneric("subsetAdjust", function(object, ...) standardGeneric("subsetAdjust"))
 setGeneric("subsetAdjust<-", function(object, value) standardGeneric("subsetAdjust<-"))

R/XcmsExperiment.R

@@ -1391,7 +1391,7 @@ setMethod(
         rt_adj <- bpmapply(rtMap, rt_raw, idx, FUN = function(x, y, i, param) {
             if (nrow(x) >= 10) { # too strict ? Gam always throws error when less than that and loess does not work that well either.
                 .adjust_rt_model(y, method = param@method,
-                                 rt_map = x, span = param@span,
+                                 rt_map = x[, c("ref","obs")], span = param@span,
                                  resid_ratio = param@outlierTolerance,
                                  zero_weight = param@zeroWeight,
                                  bs = param@bs)

R/do_adjustRtime-functions.R

@@ -788,7 +788,9 @@ NULL
 #'
 #' @return a `data.frame` with columns `"ref"` and `"obs"` with the retention
 #'     times of the pairs of matched peaks. This `data.frame` can be used
-#'     in `.adjust_rt_model`'s parameter `rt_raw`.
+#'     in `.adjust_rt_model`'s parameter `rt_raw`. The column `chromPeaksId`
+#'     contains the rownames of the `obs_peaks` matrix. This can be used to
+#'     identify the peaks that were matched.
 #'
 #' @author Johannes Rainer, Philippine Louail
 #'
@@ -804,7 +806,8 @@ NULL
     dups <- idx[duplicated(idx[, 2L]), 2L]
     idx <- idx[!idx[, 2L] %in% dups, , drop = FALSE]
     data.frame(ref = ref_anchors[idx[, 2L], 2L],
-               obs = obs_peaks[idx[, 1L], 2L])
+               obs = obs_peaks[idx[, 1L], 2L],
+               chromPeaksId = rownames(obs_peaks[idx[, 1L], ,drop = FALSE]))
 }
 
 #' @description

tests/testthat/test_do_adjustRtime-functions.R

@@ -293,13 +293,16 @@ test_that(".match_reference_anchors works", {
                rt = c(100, 150.1, 190, 190, 190, 192))
     b <- cbind(mz = c(200.2, 232, 233.1, 234),
                rt = c(150, 190.4, 193, 240))
+    rownames(a) <- rep("a", nrow(a))
+    rownames(b) <- rep("b", nrow(b))
 
     res <- .match_reference_anchors(a, b)
     expect_true(is.data.frame(res))
-    expect_equal(colnames(res), c("ref", "obs"))
+    expect_equal(colnames(res), c("ref", "obs", "chromPeaksId"))
     expect_true(nrow(res) == 1L)
     expect_equal(res$ref, 193.0)
     expect_equal(res$obs, 190.0)
+    expect_equal(res$chromPeaksId, "a")
 
     ## no matches:
     res <- .match_reference_anchors(a, b, tolerance = 0, toleranceRt = 0)
@@ -311,7 +314,7 @@ test_that(".match_reference_anchors works", {
     ## rows 5 and 6 from `a` match row 3 from `b`
     res <- .match_reference_anchors(a, b, tolerance = 0.1, toleranceRt = 52)
     expect_true(is.data.frame(res))
-    expect_equal(colnames(res), c("ref", "obs"))
+    expect_equal(colnames(res),c("ref", "obs", "chromPeaksId"))
     expect_equal(res$ref, 190.4)
     expect_equal(res$obs, 190.0)
 
@@ -320,15 +323,15 @@ test_that(".match_reference_anchors works", {
     ## `b` and should thus not be reported.
     res <- .match_reference_anchors(a, b, tolerance = 0.1, toleranceRt = 5)
     expect_true(is.data.frame(res))
-    expect_equal(colnames(res), c("ref", "obs"))
+    expect_equal(colnames(res), c("ref", "obs", "chromPeaksId"))
     expect_equal(res$ref, c(150, 190.4))
     expect_equal(res$obs, c(150.1, 190.0))
 
     ## Same but reducing toleranceRt to have also a match between row 6 in `a`
     ## with row 3 in `b`.
     res <- .match_reference_anchors(a, b, tolerance = 0.1, toleranceRt = 2)
     expect_true(is.data.frame(res))
-    expect_equal(colnames(res), c("ref", "obs"))
+    expect_equal(colnames(res), c("ref", "obs", "chromPeaksId"))
     expect_equal(res$ref, c(150, 190.4, 193.0))
     expect_equal(res$obs, c(150.1, 190.0, 192.0))
 })