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_MzTabParam.R b/tests/testthat/test_MzTabParam.R deleted file mode 100644 index 372f34dc..00000000 --- a/tests/testthat/test_MzTabParam.R +++ /dev/null @@ -1,95 +0,0 @@ -faahko <- loadXcmsData("faahko_sub2") -faahko <- groupChromPeaks( - faahko, PeakDensityParam(sampleGroups = rep(1, length(faahko)))) - -xmse_full <- loadXcmsData() - -test_that(".mztab_metadata works", { - mtd <- .mztab_metadata(xmse_full, study_id = "test", polarity = "negative", - col_phenotype = "sample_type") - - expect_false(all(mtd != "test")) - expect_true(is.matrix(mtd)) - expect_true(is.character(mtd)) - expect_equal(mtd[, "id"], rep("MTD", nrow(mtd))) - expect_equal(ncol(mtd), 3) - expect_equal(length(grep("assay ", mtd[, 2])), length(xmse_full)) - expect_equal(length(grep("negative ", mtd[, 3])), length(xmse_full)) -}) - -test_that(".mztab_small_molecule_feature works", { - a <- .mztab_small_molecule_feature(faahko) - expect_true(is.matrix(a)) - expect_true(is.character(a)) - expect_equal(a[1, 1], "SFH") - expect_equal(nrow(a), nrow(featureDefinitions(faahko)) + 1) - expect_equal(length(grep("abundance_assay", a[1, ])), length(faahko)) - - b <- .mztab_small_molecule_feature( - faahko, opt_columns = c("peakidx", "ms_level"), - method = "sum", value = "maxo") - expect_equal(nrow(a), nrow(b)) - expect_true(ncol(b) > ncol(a)) - expect_true(any(b[1, ] == "opt_peakidx")) - expect_true(any(b[1, ] == "opt_ms_level")) - ## Check that optional parameters are correctly passed - a2 <- a[2:nrow(a), a[1, ] == "abundance_assay[2]"] - a2[a2 == "null"] <- NA - a2 <- as.numeric(a2) - b2 <- b[2:nrow(b), b[1, ] == "abundance_assay[2]"] - b2[b2 == "null"] <- NA - b2 <- as.numeric(b2) - expect_equal(is.na(a2), is.na(b2)) - expect_true(all(a2[!is.na(a2)] != b2[!is.na(b2)])) - ## Check that we don't loose information through import/export - expect_equal(a2, unname(featureValues(faahko)[, 2])) - expect_equal(b2, unname(featureValues( - faahko, method = "sum", value = "maxo")[, 2])) -}) - -test_that(".mztab_study_variables works", { - x <- data.frame(a = 1:3, b = c(1, 1, 2)) - res <- .mztab_study_variables(x, variable = "a") - expect_true(is.character(res)) - expect_true(is.matrix(res)) - expect_true(ncol(res) == 1L) - expect_equal(res[, 1L], c("a:1", "a:2", "a:3")) - - res <- .mztab_study_variables(x, variable = c("a", "b")) - expect_true(is.character(res)) - expect_true(is.matrix(res)) - expect_true(ncol(res) == 2L) - expect_equal(res[, 1L], c("a:1", "a:2", "a:3")) - expect_equal(res[, 2L], c("b:1", "b:1", "b:2")) -}) - -test_that(".mztab_study_variable_entries works", { - x <- data.frame(a = 1:3, b = c(1, 1, 2)) - res <- .mztab_study_variable_entries(x, variable = "a") - expect_true(is.character(res)) - expect_true(is.matrix(res)) - expect_true(ncol(res) == 2L) - expect_equal(unname(res[1, 1]), "study_variable[1]") - expect_equal(unname(res[2, 1]), "study_variable[1]-assay_refs") - expect_equal(unname(res[1, 2]), "a:1") - expect_equal(unname(res[2, 2]), "assay[1]") - - res2 <- .mztab_study_variable_entries(x, variable = c("a", "b")) - expect_true(length(res2) > length(res)) -}) - -test_that("storeResults,MzTabParam works", { - d <- tempdir() - p <- MzTabParam(studyId = "test_study", path = d, - sampleDataColumn = "sample_index", - optionalFeatureColumns = "peakidx") - storeResults(faahko, p) - expect_true(file.exists(file.path(d, "test_study.mztab"))) - res <- readLines(file.path(d, "test_study.mztab")) - expect_true(length(res) > 0L) - expect_true(length(grep("^MTD", res)) > 0) - expect_true(length(grep("^SML", res)) > 0) - expect_true(length(grep("^SMF", res)) > 0) - ## Check for empty lines - expect_true(length(grep(c("^MTD|SML|SMF"), res, invert = TRUE)) == 2) -}) 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)) })