diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 72a0aeb9..b8fb0a76 100644 --- a/R/AllGenerics.R +++ b/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<-")) diff --git a/R/XcmsExperiment.R b/R/XcmsExperiment.R index db3efa05..a094a716 100644 --- 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 index c45b0940..1fe5282c 100644 --- 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_do_adjustRtime-functions.R b/tests/testthat/test_do_adjustRtime-functions.R index 1f90ec84..2d36e101 100644 --- 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,7 +323,7 @@ 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)) @@ -328,7 +331,7 @@ test_that(".match_reference_anchors works", { ## 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)) })