small_update to matchLamaChromPeaks() output

sneumann · Oct 1, 2024 · c403cd6 · c403cd6
1 parent 1465d7f
commit c403cd6
Show file tree

Hide file tree

Showing 4 changed files with 13 additions and 102 deletions.
diff --git a/R/XcmsExperiment.R b/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)

diff --git a/R/do_adjustRtime-functions.R b/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

diff --git a/tests/testthat/test_MzTabParam.R b/tests/testthat/test_MzTabParam.R
diff --git a/tests/testthat/test_do_adjustRtime-functions.R b/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))
 })