tests/testthat/test_methods-XCMSnExp.R
In sneumann/xcms: LC-MS and GC-MS Data Analysis
test_that("XCMSnExp, XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
rts <- rtime(faahko_od)
rts_2 <- rtime(od_x)
expect_equal(rts, rts_2)
## Test with bySample.
rts_3 <- rtime(xod_x, bySample = TRUE)
expect_equal(rts_3, split(rts, f = fromFile(faahko_od)))
## Check if rtimes are correctly ordered for bySample
rts_4 <- rtime(filterFile(faahko_od, file = 2))
expect_equal(rts_4, rts_3[[2]])
rts_4 <- rtime(filterFile(faahko_od, file = 3))
expect_equal(rts_4, rts_3[[3]])
})
test_that("mz,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
tmp_od <- filterRt(faahko_od, rt = c(3500, 3800))
tmp_xod <- filterRt(xod_x, rt = c(3500, 3800))
mzs <- mz(tmp_od)
## The check below has to work, since we're calling the mz,OnDiskMSnExp.
mzs_2 <- mz(tmp_xod, bySample = TRUE)
tmp <- split(mzs, fromFile(tmp_od))
expect_equal(lapply(tmp, unlist, use.names = FALSE), mzs_2)
})
test_that("intensity,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
tmp_od <- filterRt(faahko_od, rt = c(3500, 3800))
tmp_xod <- filterRt(xod_x, rt = c(3500, 3800))
ints <- intensity(tmp_od)
## The check below has to work, since we're calling the intensity,OnDiskMSnExp.
## ints_2 <- intensity(od_x)
## expect_equal(ints, ints_2)
ints_2 <- intensity(tmp_xod, bySample = TRUE)
tmp <- split(ints, fromFile(tmp_od))
expect_equal(lapply(tmp, unlist, use.names = FALSE), ints_2)
})
test_that("spectra,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## xod_x
tmp <- filterRt(xod_x, rt = c(2700, 2900))
res <- spectra(tmp)
rts <- unlist(lapply(res, rtime))
expect_equal(rts, rtime(tmp))
## Check with adjusted retention times.
tmp2 <- filterRt(xod_xgr, rt = c(2700, 2900))
res2 <- spectra(tmp2)
rts2 <- unlist(lapply(res2, rtime))
expect_equal(rts2, rtime(tmp2))
## Now do it on one file:
tmp <- filterFile(xod_x, file = 2)
res <- spectra(tmp)
expect_equal(rtime(tmp), unlist(lapply(res, rtime)))
tmp2 <- filterFile(xod_xgr, file = 2, keepAdjustedRtime = TRUE)
res2 <- spectra(tmp2)
expect_equal(rtime(tmp2), unlist(lapply(res2, rtime)))
expect_true(sum(unlist(lapply(res2, rtime)) ==
unlist(lapply(res, rtime))) < length(rtime(tmp)) / 4)
res3 <- spectra(tmp2, adjusted = FALSE)
expect_equal(res, res3)
## adjusted rt
tmp <- filterFile(xod_xgr, file = 2, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp))
expect_true(is.character(all.equal(rtime(tmp, adjusted = FALSE),
adjustedRtime(tmp))))
res <- spectra(tmp)
expect_equal(rtime(tmp), unlist(lapply(res, rtime)))
res <- unlist(spectrapply(tmp, FUN = function(x) {rtime(x)}))
expect_equal(res, adjustedRtime(tmp))
})
test_that("XCMSnExp accessors work", {
skip_on_os(os = "windows", arch = "i386")
## Filling with data...
xod <- as(faahko_od, "XCMSnExp")
## peaks
expect_true(!hasChromPeaks(xod))
chromPeaks(xod) <- chromPeaks(xod_x)
expect_true(hasChromPeaks(xod))
expect_equal(chromPeaks(xod), chromPeaks(xod_x))
expect_error(chromPeaks(xod) <- 4)
tmp <- chromPeaks(xod, bySample = TRUE)
expect_true(length(tmp) == length(fileNames(xod)))
tmp <- do.call(rbind, tmp)
rownames(tmp) <- NULL
pks <- chromPeaks(xod)
rownames(pks) <- NULL
expect_equal(tmp, pks)
## chromPeaks with isFilledColumn
expect_true(all(colnames(pks) != "is_filled"))
pks <- chromPeaks(xod_x, isFilledColumn = TRUE)
expect_true(any(colnames(pks) == "is_filled"))
expect_true(all(pks[, "is_filled"] == 0))
## chromPeaks with rt
all_pks <- chromPeaks(xod_x)
pks <- chromPeaks(xod_x, rt = c(2000, 2600), type = "within")
expect_true(nrow(pks) < nrow(all_pks))
expect_true(all(pks[, "rtmin"] >= 2000 & pks[, "rtmax"] <= 2600))
pks <- chromPeaks(xod_x, rt = c(2000, 2600), bySample = TRUE,
type = "within")
expect_true(nrow(pks[[2]]) == 0)
pks <- chromPeaks(xod_x, rt = c(2000, 2600), type = "any")
expect_true(all(pks[, "rtmax"] >= 2000 & pks[, "rtmin"] <= 2600))
pks <- chromPeaks(xod_x, rt = c(2000, 2200))
expect_true(nrow(pks) == 0)
pks <- chromPeaks(xod_x, rt = c(2000, 2200), bySample = TRUE)
expect_true(all(lengths(pks) == 0))
## chromPeaks with mz
pks <- chromPeaks(xod_x, mz = c(280, 281), type = "within")
expect_true(all(pks[, "mzmin"] >= 280 & pks[, "mzmax"] <= 281))
pks <- chromPeaks(xod_x, mz = c(280, 281), bySample = TRUE, type = "within")
expect_true(nrow(pks[[1]]) == 0)
expect_true(nrow(pks[[3]]) == 0)
expect_true(nrow(pks[[2]]) == 1)
pks <- chromPeaks(xod_x, mz = c(280, 300), bySample = FALSE, type = "within")
expect_true(all(pks[, "mzmin"] >= 280 & pks[, "mzmax"] <= 300))
pks <- chromPeaks(xod_x, mz = c(280, 300), bySample = FALSE, type = "any")
expect_true(all(pks[, "mzmax"] >= 280 & pks[, "mzmin"] <= 300))
pks <- chromPeaks(xod_x, mz = c(200, 210), bySample = FALSE)
expect_true(nrow(pks) == 0)
pks <- chromPeaks(xod_x, mz = c(200, 210), bySample = TRUE)
expect_true(all(lengths(pks) == 0))
## chromPeaks with both
pks <- chromPeaks(xod_x, mz = c(280, 300), rt = c(3000, 3300),
type = "within")
expect_true(all(pks[, "mzmin"] >= 280 & pks[, "mzmax"] <= 300))
expect_true(all(pks[, "rtmin"] >= 3000 & pks[, "rtmax"] <= 3300))
pks <- chromPeaks(xod_x, mz = c(280, 300), rt = c(3000, 3300),
type = "any")
expect_true(all(pks[, "mzmax"] >= 280 & pks[, "mzmin"] <= 300))
expect_true(all(pks[, "rtmax"] >= 3000 & pks[, "rtmin"] <= 3300))
## Wrong assignments.
pks <- chromPeaks(xod_x)
pks[1, "sample"] <- 40
expect_error(chromPeaks(xod) <- pks)
## featureDefinitions
expect_true(!hasFeatures(xod))
fd <- featureDefinitions(xod_xg)
fd$ms_level <- 2L
featureDefinitions(xod) <- fd
expect_true(hasChromPeaks(xod))
expect_true(hasFeatures(xod))
expect_true(hasFeatures(xod, msLevel = 2L))
expect_equal(featureDefinitions(xod), fd)
expect_true(nrow(featureDefinitions(xod, msLevel = 2L)) > 0)
fd$ms_level <- 1L
featureDefinitions(xod) <- fd
expect_true(nrow(featureDefinitions(xod, msLevel = 2L)) == 0)
expect_false(hasFeatures(xod, msLevel = 2L))
## featureDefinitions with mz and/or rt range:
obj <- xod_xgrg
feat_def <- featureDefinitions(obj)
## Within
mzr <- c(300, 330)
keep_mz <- feat_def$mzmin > mzr[1] & feat_def$mzmax < mzr[2]
expect_equal(featureDefinitions(obj, mz = mzr, type = "within"),
feat_def[keep_mz, ])
rtr <- c(3000, 3800)
keep_rt <- feat_def$rtmin > rtr[1] & feat_def$rtmax < rtr[2]
expect_equal(featureDefinitions(obj, rt = rtr, type = "within"),
feat_def[keep_rt, ])
expect_equal(featureDefinitions(obj, rt = rtr, mz = mzr,
type = "within"),
feat_def[keep_rt & keep_mz, ])
## Any
mzr <- range(featureDefinitions(obj)[2, "mzmed"])
## Defining all possible cases; the internal function uses more cleverer
## approach.
keep_mz <- (feat_def$mzmax >= mzr[1] & feat_def$mzmax <= mzr[2]) |
(feat_def$mzmin >= mzr[1] & feat_def$mzmin <= mzr[2]) |
(feat_def$mzmin <= mzr[1] & feat_def$mzmax >= mzr[2])
expect_equal(featureDefinitions(obj, mz = mzr, type = "any"),
feat_def[keep_mz, , drop = FALSE])
rtr <- range(c(3420, 3430))
keep_rt <- (feat_def$rtmax >= rtr[1] & feat_def$rtmax <= rtr[2]) |
(feat_def$rtmin >= rtr[1] & feat_def$rtmin <= rtr[2]) |
(feat_def$rtmin <= rtr[1] & feat_def$rtmax >= rtr[2])
expect_true(nrow(featureDefinitions(obj, rt = rtr, type = "within")) == 1)
expect_equal(featureDefinitions(obj, rt = rtr, type = "any"),
feat_def[keep_rt, , drop = FALSE])
expect_equal(featureDefinitions(obj, rt = rtr, mz = mzr, type = "any"),
feat_def[keep_rt & keep_mz, , drop = FALSE])
## adjustedRtime
expect_true(!hasAdjustedRtime(xod))
expect_true(hasAdjustedRtime(xod_r))
suppressWarnings(expect_equal(adjustedRtime(xod), NULL))
expect_equal(rtime(xod_r, adjusted = FALSE), rtime(xod))
expect_equal(rtime(xod_r), adjustedRtime(xod_r))
expect_true(is.character(all.equal(rtime(xod_r), rtime(xod_r, adjusted = FALSE))))
## Indirect test that the ordering of the adjusted retention times matches
## ordering of rtime.
## From MSnbase version >= 2.3.9 values are ordered first by file then by
## spectrum.
if (grepl("^F", names(rtime(xod_r)[1]))) {
rts_by_sample <- adjustedRtime(xod_r, bySample = TRUE)
rts <- adjustedRtime(xod_r)
expect_equal(unname(rts_by_sample[[2]]),
unname(rts[grep(names(rts), pattern = "F2")]))
expect_equal(unname(unlist(rts_by_sample)),
unname(rts))
}
xod2 <- xod_r
## Wrong assignments.
expect_error(adjustedRtime(xod2) <- faahko_xsg@rt$corrected[1:2])
## bracket subset
tmp <- xod2[1]
expect_true(length(tmp[[1]]) == 1)
expect_true(length(xod2[[1]]) == 1)
})
test_that("findChromPeaks,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## Call findChromPeaks on an XCMSnExp
tmp <- findChromPeaks(filterFile(xod_x, 1),
param = CentWaveParam(noise = 10000,
snthresh = 40,
prefilter = c(3, 10000)))
expect_equal(unname(chromPeaks(tmp)), unname(chromPeaks(filterFile(xod_x, 1))))
## Check that it works also on adjusted retention times:
tmp <- findChromPeaks(xod_r, param = CentWaveParam(noise = 10000,
snthresh = 40,
prefilter = c(3, 10000)))
expect_true(hasAdjustedRtime(tmp))
expect_equal(
length(processHistory(tmp, type = .PROCSTEP.RTIME.CORRECTION)),1)
expect_true(sum(chromPeaks(tmp)[, "rt"] != chromPeaks(xod_x)[, "rt"]) >
ncol(chromPeaks(tmp)))
tmp_sub <- filterFile(xod_r, file = 1, keepAdjustedRtime = TRUE)
expect_equal(rtime(tmp_sub, adjusted = TRUE),
rtime(xod_r, bySample = TRUE, adjusted = TRUE)[[1]])
spctr <- spectra(tmp_sub)
mz_values <- lapply(spctr, mz)
int_values <- unlist(lapply(spctr, intensity))
res_2 <- do_findChromPeaks_centWave(mz = unlist(mz_values),
int = int_values,
scantime = rtime(tmp_sub,
adjusted = TRUE),
valsPerSpect = lengths(mz_values),
noise = 10000, snthresh = 40)
pks <- chromPeaks(tmp)
rownames(pks) <- NULL
pks <- pks[pks[, "sample"] == 1, colnames(res_2)]
expect_equal(res_2, pks)
## Adding peak detection results
res <- findChromPeaks(
xod_x, param = CentWaveParam(noise = 8000, snthresh = 40,
prefilter = c(3, 8000),
verboseColumns = TRUE), add = TRUE)
expect_true(length(processHistory(res)) ==
(length(processHistory(xod_x)) + 1))
expect_true(nrow(chromPeaks(res)) > nrow(chromPeaks(xod_x)))
expect_true(ncol(chromPeaks(res)) > ncol(chromPeaks(xod_x)))
expect_true(length(unique(rownames(chromPeaks(res)))) == nrow(chromPeaks(res)))
})
test_that("processHistory,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
ph <- ProcessHistory(fileIndex. = 2, info. = "For file 2")
ph_2 <- ProcessHistory(fileIndex. = 1:2, info. = "For files 1 to 2")
xod <- as(od_x, "XCMSnExp")
xod@.processHistory <- list(ph, ph_2)
expect_equal(processHistory(xod), list(ph, ph_2))
expect_equal(processHistory(xod, fileIndex = 2), list(ph, ph_2))
expect_equal(processHistory(xod, fileIndex = 1), list(ph_2))
expect_error(processHistory(xod, fileIndex = 5))
ph_3 <- XProcessHistory(fileIndex = 1, param = CentWaveParam())
xod <- addProcessHistory(xod, ph_3)
expect_equal(length(processHistory(xod)), 3)
expect_equal(processHistory(xod)[[3]], ph_3)
expect_equal(processHistory(xod, fileIndex = 1), list(ph_2, ph_3))
expect_true(validObject(xod))
})
test_that("dropChromPeaks,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## 1) dropDetectedFeatures: delete all process history steps and all data.
res <- dropChromPeaks(xod_x)
expect_true(!hasChromPeaks(res))
expect_true(.has_chrom_peak_data(xod_x@msFeatureData))
expect_false(.has_chrom_peak_data(res@msFeatureData))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
##
res <- dropChromPeaks(xod_xg)
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
##
res <- dropChromPeaks(xod_xgr)
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
expect_true(!hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 0)
expect_equal(rtime(res), rtime(od_x))
res <- dropChromPeaks(xod_xgr, keepAdjustedRtime = TRUE)
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
expect_true(hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 1)
expect_equal(rtime(res), rtime(xod_xgr))
##
res <- dropChromPeaks(xod_xgrg)
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.FEATURE.GROUPING)) == 0)
expect_true(!hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 0)
expect_equal(rtime(res), rtime(od_x))
res <- dropChromPeaks(xod_xgrg, keepAdjustedRtime = TRUE)
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
expect_true(hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 1)
expect_equal(rtime(res), rtime(xod_xgrg))
})
test_that("dropFeatureDefinitions,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## 2) dropFeatureDefinitions:
## a) drop the feature groups and the latest related process history
## b) if retention time correction was performed AFTER the latest feature
## grouping, drop also the retention time correction and all related
## process histories.
res <- dropFeatureDefinitions(xod_x)
expect_equal(res, xod_x)
res <- dropFeatureDefinitions(xod_xg)
expect_equal(res, xod_x)
## Remove the latest ones.
res <- dropFeatureDefinitions(xod_xgrg)
expect_equal(res, xod_xgr)
expect_true(!hasFeatures(res))
expect_true(hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 1)
expect_equal(rtime(res, adjusted = FALSE), rtime(od_x))
expect_equal(rtime(res, adjusted = TRUE), rtime(xod_xgr))
})
test_that("dropAdjustedRtime,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## 3) dropAdjustedRtime:
## a) drop the retention time adjustment and related process histories
## b) if grouping has been performed AFTER retention time correction,
## drop the feature alignment and all related process histories.
## c) if grouping has been performed BEFORE retention time correction,
## do nothing.
res <- dropAdjustedRtime(xod_xg)
expect_equal(res, xod_xg)
## This drops also the process history for alignment.
res <- dropAdjustedRtime(xod_xgr)
expect_true(hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 0)
expect_true(!hasAdjustedRtime(res))
expect_equal(chromPeaks(res), chromPeaks(xod_x))
expect_equal(rtime(res), rtime(xod_xgr, adjusted = FALSE))
## expect_equal(res, xod_x)
## This drops also the feature alignment performed later.
res <- dropAdjustedRtime(xod_xgrg)
expect_true(hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 1)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
expect_true(!hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 0)
expect_equal(chromPeaks(res), chromPeaks(xod_x))
## expect_equal(res, xod_x)
expect_equal(rtime(res), rtime(xod_xgrg, adjusted = FALSE))
})
test_that("XCMSnExp inherited methods work", {
skip_on_os(os = "windows", arch = "i386")
## [
tmp_1 <- faahko_od[1:10]
tmp_2 <- xod_x[1:10]
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
expect_error(xod_r[1, 1])
idxs <- c(1432, 1621, 2492, 3001, 3013)
tmp <- xod_r[idxs]
expect_true(length(tmp) == length(idxs))
expect_equal(mz(xod_r)[idxs], mz(tmp))
expect_true(hasAdjustedRtime(xod_r) != hasAdjustedRtime(tmp))
## keeping adjusted retention times:
tmp <- xod_r[idxs, keepAdjustedRtime = TRUE]
expect_true(hasAdjustedRtime(tmp))
expect_equal(rtime(xod_r)[idxs], rtime(tmp))
expect_true(length(processHistory(tmp, type = .PROCSTEP.RTIME.CORRECTION)) == 0)
## Same with object containing also peaks and features
tmp <- xod_xgrg[idxs]
expect_true(!hasAdjustedRtime(tmp))
expect_true(!hasChromPeaks(tmp))
expect_true(!hasFeatures(tmp))
tmp <- xod_xgrg[idxs, keepAdjusted = TRUE]
expect_true(hasAdjustedRtime(tmp))
expect_equal(rtime(xod_xgrg)[idxs], rtime(tmp))
expect_true(length(processHistory(tmp)) == 0)
## [[
spct <- xod_x[[13]]
expect_true(is(spct, "Spectrum1"))
expect_equal(rtime(spct), unname(rtime(xod_x)[13]))
expect_equal(mz(spct), mz(xod_x)[[13]])
## Have to ensure that, if x has adjusted retention times, that these are
## reported in the Spectrum.
spct <- xod_r[[13]]
expect_equal(rtime(spct), unname(rtime(xod_r, adjusted = TRUE)[13]))
expect_true(rtime(spct) != rtime(xod_r, adjusted = FALSE)[13])
## bin
tmp_1 <- bin(faahko_od, binSize = 20)
expect_warning(tmp_2 <- bin(xod_x, binSize = 20))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## clean
tmp_1 <- clean(faahko_od)
expect_warning(tmp_2 <- clean(xod_x))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## filterAcquisitionNum
tmp_1 <- filterAcquisitionNum(faahko_od)
expect_warning(tmp_2 <- filterAcquisitionNum(xod_x))
expect_true(length(tmp_2[[1]]) > 0)
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## filterMsLevel
tmp_1 <- filterMsLevel(faahko_od)
tmp_2 <- filterMsLevel(xod_x)
expect_equal(tmp_2, xod_x)
expect_equal(length(filterMsLevel(xod_x, msLevel = 2)), 0)
## If we've got adjusted retention times, keep them.
tmp_1 <- filterMsLevel(xod_xgr, msLevel = 1)
expect_true(hasAdjustedRtime(tmp_1))
expect_equal(rtime(tmp_1), rtime(xod_xgr)) # adjusted rt present
tmp_1 <- filterMsLevel(xod_xgrg, msLevel = 1,
keepAdjustedRtime = FALSE)
expect_true(!hasAdjustedRtime(tmp_1))
expect_equal(rtime(tmp_1), rtime(xod_xgr, adjusted = FALSE))
## normalize
tmp_1 <- normalize(faahko_od)
expect_warning(tmp_2 <- normalize(xod_x))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## pickPeaks
tmp_1 <- pickPeaks(faahko_od)
expect_warning(tmp_2 <- pickPeaks(xod_x))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## removePeaks
tmp_1 <- removePeaks(faahko_od)
expect_warning(tmp_2 <- removePeaks(xod_x))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## smooth
tmp_1 <- smooth(faahko_od)
expect_warning(tmp_2 <- smooth(xod_x))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
})
test_that("filterFile,XCMSnExp and .filter_file_XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## filterFile
tmp <- filterFile(xod_x, file = 2)
expect_error(tmp@msFeatureData$bla <- 3)
expect_true(!hasAdjustedRtime(tmp))
expect_true(!hasFeatures(tmp))
expect_true(all(chromPeaks(tmp)[, "sample"] == 1))
expect_equal(chromPeaks(tmp)[, colnames(chromPeaks(tmp)) != "sample"],
chromPeaks(xod_x)[chromPeaks(xod_x)[, "sample"] == 2,
colnames(chromPeaks(xod_x)) != "sample"])
expect_true(length(processHistory(tmp)) == 1)
## expect_equal(fileIndex(processHistory(tmp)[[1]]), 1)
## check with other index.
tmp <- filterFile(xod_x, file = c(1, 3))
expect_true(length(tmp[[1]]) == 1)
expect_true(!hasAdjustedRtime(tmp))
expect_true(!hasFeatures(tmp))
expect_true(all(chromPeaks(tmp)[, "sample"] %in% c(1, 2)))
a <- chromPeaks(tmp)
b <- chromPeaks(xod_x)
expect_equal(a[, colnames(a) != "sample"],
b[b[, "sample"] %in% c(1, 3), colnames(b) != "sample"])
expect_true(length(processHistory(tmp)) == 1)
## expect_equal(fileIndex(processHistory(tmp)[[1]]), c(1, 2))
## Errors
expect_error(filterFile(xod_x, file = 5))
expect_error(filterFile(xod_x, file = 1:5))
## Little mockup to check correctness of Process history.
od_2 <- xod_x
od_2 <- addProcessHistory(
od_2, ProcessHistory(type = .PROCSTEP.RTIME.CORRECTION))
od_2 <- addProcessHistory(
od_2, ProcessHistory(type = .PROCSTEP.UNKNOWN,
fileIndex = 2,
info. = "I should be here"))
od_2 <- addProcessHistory(
od_2, ProcessHistory(type = .PROCSTEP.UNKNOWN,
fileIndex = 1, info. = "EEEEEE"))
tmp <- filterFile(od_2, file = 2)
ph <- processHistory(tmp)
expect_true(length(ph) == 4)
expect_equal(processType(ph[[3]]), .PROCSTEP.UNKNOWN)
b <- unlist(lapply(ph, function(z) {
processInfo(z) == "I should be here"
}))
expect_true(any(b))
b <- unlist(lapply(ph, function(z) {
processInfo(z) == "EEEEEE"
}))
## expect_true(!any(b))
## Do filterFile on xod_xg
res <- filterFile(xod_xg, file = 2)
expect_true(hasChromPeaks(res))
expect_true(!hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
tmp <- chromPeaks(xod_xg)
expect_equal(chromPeaks(res)[, colnames(chromPeaks(res)) != "sample"],
tmp[tmp[, "sample"] == 2, colnames(tmp) != "sample"])
expect_equal(rtime(res), rtime(xod_xg, bySample = TRUE)[[2]])
## with keepFeatures = TRUE
res <- .filter_file_XCMSnExp(xod_xg, file = 2, keepFeatures = TRUE)
expect_true(hasChromPeaks(res))
expect_true(hasFeatures(res))
fvals <- featureValues(xod_xg)[, 2, drop = FALSE]
expect_equal(featureValues(res), fvals[!is.na(fvals[,1]), , drop = FALSE])
res <- filterFile(xod_xg, file = c(1, 3), keepFeatures = TRUE)
expect_true(hasFeatures(res))
fvals <- featureValues(xod_xg)[, c(1, 3)]
expect_equal(featureValues(res), fvals)
## Do filterFile on xod_xgr
## Should remove adjusted rts and revert the original peak rts.
res <- .filter_file_XCMSnExp(xod_xgr, keepAdjustedRtime = FALSE, file = 2)
expect_true(hasChromPeaks(res))
tmp <- chromPeaks(xod_xg)
expect_equal(chromPeaks(res)[, colnames(chromPeaks(res)) != "sample"],
tmp[tmp[, "sample"] == 2, colnames(tmp) != "sample"])
expect_equal(rtime(res), rtime(xod_xg, bySample = TRUE)[[2]])
expect_true(!hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 3)
expect_equal(processType(processHistory(res)[[1]]), "Peak detection")
## The same but keep the adjusted retention times.
res <- .filter_file_XCMSnExp(xod_xgr, file = 2, keepAdjustedRtime = TRUE)
expect_true(hasChromPeaks(res))
tmp <- chromPeaks(xod_xgr)
expect_equal(chromPeaks(res)[, colnames(chromPeaks(res)) != "sample"],
tmp[tmp[, "sample"] == 2, colnames(tmp) != "sample"])
## has to be different from the ones in xod_x
tmp <- chromPeaks(xod_x)
expect_true(sum(chromPeaks(res)[, "rt"] == tmp[tmp[, "sample"] == 2, "rt"]) <
nrow(tmp) / 4)
expect_equal(rtime(res), rtime(xod_xgr, bySample = TRUE)[[2]])
expect_equal(adjustedRtime(res), adjustedRtime(xod_xgr, bySample = TRUE)[[2]])
expect_true(hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 3)
expect_equal(processType(processHistory(res)[[1]]), "Peak detection")
expect_equal(processType(processHistory(res)[[2]]), "Peak grouping")
expect_equal(processType(processHistory(res)[[3]]), "Retention time correction")
res <- filterFile(xod_xgr, file = 2:3)
expect_true(hasAdjustedRtime(res))
expect_equal(adjustedRtime(xod_xgr, bySample = TRUE)[[2]],
adjustedRtime(res, bySample = TRUE)[[1]])
expect_equal(adjustedRtime(xod_xgr, bySample = TRUE)[[3]],
adjustedRtime(res, bySample = TRUE)[[2]])
## Do filterFile on xod_xgrg
res <- filterFile(xod_xgrg, keepAdjustedRtime = FALSE, file = c(1, 3))
expect_true(hasChromPeaks(res))
tmp <- chromPeaks(xod_x)
expect_equal(chromPeaks(res)[, colnames(chromPeaks(res)) != "sample"],
tmp[tmp[, "sample"] %in% c(1, 3), colnames(tmp) != "sample"])
expect_equal(unname(rtime(res, bySample = TRUE)),
unname(rtime(xod_xg, bySample = TRUE)[c(1, 3)]))
expect_true(!hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 3)
expect_equal(processType(processHistory(res)[[1]]), "Peak detection")
## keep adjusted rtime
res <- filterFile(xod_xgrg, file = c(1, 3), keepAdjustedRtime = TRUE)
expect_true(hasChromPeaks(res))
tmp <- chromPeaks(xod_xgr)
expect_equal(chromPeaks(res)[, colnames(chromPeaks(res)) != "sample"],
tmp[tmp[, "sample"] %in% c(1, 3), colnames(tmp) != "sample"])
## has to be different from the ones in xod_x
tmp <- chromPeaks(xod_x)
expect_true(sum(chromPeaks(res)[, "rt"] == tmp[tmp[, "sample"] %in% c(1, 3), "rt"]) <
nrow(tmp) / 4)
expect_equal(rtime(res, bySample = TRUE),
rtime(xod_xgr, bySample = TRUE)[c(1, 3)])
expect_equal(adjustedRtime(res, bySample = TRUE),
adjustedRtime(xod_xgr, bySample = TRUE)[c(1, 3)])
expect_true(hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 3)
expect_equal(processType(processHistory(res)[[1]]), "Peak detection")
expect_equal(processType(processHistory(res)[[2]]), "Peak grouping")
expect_equal(processType(processHistory(res)[[3]]), "Retention time correction")
## keep also features
res <- filterFile(xod_xgrg, file = c(1, 3), keepFeatures = TRUE)
expect_true(hasFeatures(res))
expect_equal(featureValues(res), featureValues(xod_xgrg)[, c(1, 3)])
})
test_that("filterMz,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## subset on xod_x
res <- filterMz(xod_x, mz = c(300, 400))
expect_true(length(res[[1]]) == 1)
expect_true(length(res@spectraProcessingQueue) == 1)
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 300 & chromPeaks(res)[, "mz"] <= 400))
expect_true(nrow(chromPeaks(res)) < nrow(chromPeaks(xod_x)))
idx <- which(chromPeaks(xod_x)[, "mzmin"] >= 300 &
chromPeaks(xod_x)[, "mzmax"] <= 400)
expect_equal(chromPeaks(res), chromPeaks(xod_x)[idx, ])
expect_true(!hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
## subset on xod_xg
res <- filterMz(xod_xg, mz = c(300, 400))
expect_true(validObject(res))
expect_true(length(res[[1]]) == 1)
expect_true(length(res@spectraProcessingQueue) == 1)
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 300 & chromPeaks(res)[, "mz"] <= 400))
expect_true(nrow(chromPeaks(res)) < nrow(chromPeaks(xod_x)))
idx <- which(chromPeaks(xod_xg)[, "mzmin"] >= 300 &
chromPeaks(xod_xg)[, "mzmax"] <= 400)
expect_equal(chromPeaks(res), chromPeaks(xod_xg)[idx, ])
expect_true(!hasAdjustedRtime(res))
expect_true(hasFeatures(res))
expect_true(nrow(featureDefinitions(res)) < nrow(featureDefinitions(xod_xg)))
expect_true(all(featureDefinitions(res)[, "mzmed"] >= 300 &
featureDefinitions(res)[, "mzmed"] <= 400))
expect_true(all(featureDefinitions(res)[, "mzmin"] >= 300 &
featureDefinitions(res)[, "mzmin"] <= 400))
expect_true(all(featureDefinitions(res)[, "mzmax"] >= 300 &
featureDefinitions(res)[, "mzmax"] <= 400))
## subset on xod_xgr
## o keep chromPeaks
## o keep adjusted rtime
res <- filterMz(xod_xgr, mz = c(300, 400))
expect_true(validObject(res))
expect_true(length(res[[1]]) == 1)
expect_true(length(res@spectraProcessingQueue) == 1)
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 300 & chromPeaks(res)[, "mz"] <= 400))
expect_true(nrow(chromPeaks(res)) < nrow(chromPeaks(xod_x)))
idx <- which(chromPeaks(xod_xgr)[, "mzmin"] >= 300 &
chromPeaks(xod_xgr)[, "mzmax"] <= 400)
expect_equal(chromPeaks(res), chromPeaks(xod_xgr)[idx, ])
expect_true(hasAdjustedRtime(res))
expect_equal(adjustedRtime(res), adjustedRtime(xod_xgr))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 3)
## subset xod_xgrg
res <- filterMz(xod_xgrg, mz = c(300, 400))
expect_true(validObject(res))
expect_true(length(res[[1]]) == 1)
expect_true(length(res@spectraProcessingQueue) == 1)
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 300 & chromPeaks(res)[, "mz"] <= 400))
expect_true(nrow(chromPeaks(res)) < nrow(chromPeaks(xod_xgrg)))
idx <- which(chromPeaks(xod_xgrg)[, "mzmin"] >= 300 &
chromPeaks(xod_xgrg)[, "mzmax"] <= 400)
expect_equal(chromPeaks(res), chromPeaks(xod_xgrg)[idx, ])
expect_true(hasAdjustedRtime(res))
expect_equal(adjustedRtime(res), adjustedRtime(xod_xgrg))
expect_true(hasFeatures(res))
expect_true(nrow(featureDefinitions(res)) < nrow(featureDefinitions(xod_xgrg)))
expect_true(all(featureDefinitions(res)[, "mzmed"] >= 300 &
featureDefinitions(res)[, "mzmed"] <= 400))
expect_true(all(featureDefinitions(res)[, "mzmin"] >= 300 &
featureDefinitions(res)[, "mzmin"] <= 400))
expect_true(all(featureDefinitions(res)[, "mzmax"] >= 300 &
featureDefinitions(res)[, "mzmax"] <= 400))
## With groups - no groups within this range
mzr <- c(595, 600)
res <- filterMz(xod_xg, mz = mzr)
expect_true(!hasFeatures(res))
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 595 & chromPeaks(res)[, "mz"] <= 600))
res <- filterMz(xod_xgrg, mz = mzr)
expect_true(!hasFeatures(res))
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 595 & chromPeaks(res)[, "mz"] <= 600))
})
test_that("filterRt,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## xod_x
res <- filterRt(xod_x, rt = c(2700, 2900))
## Check if the object is OK:
expect_equal(pData(res), pData(xod_x))
spct <- spectra(res)
expect_true(length(spct) > 0)
## MsFeatureData has to be locked!
expect_error(res@msFeatureData$bla <- 3)
## Retention time has to be within the range.
expect_true(all(rtime(res) >= 2700 & rtime(res) <= 2900))
rtm <- unlist(lapply(spct, rtime))
expect_true(all(rtm >= 2700 & rtm <= 2900))
## peaks have to be within the range.
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_x)[, "rt"] >= 2700 &
chromPeaks(xod_x)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_x)[are_within,])
## Have a feature detection process history.
expect_equal(length(processHistory(res)), 1)
expect_equal(processType(processHistory(res)[[1]]),
.PROCSTEP.PEAK.DETECTION)
## filter such that we keep some spectra but no chromPeaks:
res <- filterRt(xod_x, rt = c(4200, 4400))
expect_true(all(rtime(res) >= 4200 & rtime(res) <= 4400))
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res)) == 0)
## No rt
res <- filterRt(xod_x, rt = c(10, 20))
expect_true(length(res) == 0)
## xod_xg
## o keep also the feature groups that are within the window.
res <- filterRt(xod_xg, rt = c(2700, 2900))
expect_true(all(rtime(res) >= 2700 & rtime(res) <= 2900))
expect_equal(hasChromPeaks(res), hasChromPeaks(xod_xg))
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_x)[, "rt"] >= 2700 &
chromPeaks(xod_x)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_xg)[are_within,])
expect_true(!hasAdjustedRtime(res))
expect_true(hasFeatures(res))
expect_true(all(featureDefinitions(res)$rtmed >= 2700 &
featureDefinitions(res)$rtmed <= 2900))
expect_true(nrow(featureDefinitions(res)) < nrow(featureDefinitions(xod_xg)))
expect_true(length(processHistory(res)) == 2)
expect_true(length(processHistory(res, type = "Peak detection")) == 1)
expect_true(length(processHistory(res, type = "Peak grouping")) == 1)
## All feature idx have to match.
expect_true(all(unlist(featureDefinitions(res)$peakidx) %in%
1:nrow(chromPeaks(res))))
## Filter such that we don't have any chromPeaks.
res <- filterRt(xod_xg, rt = c(4200, 4400))
expect_true(all(rtime(res) >= 4200 & rtime(res) <= 4400))
expect_true(!hasChromPeaks(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 0)
## No rt
res <- filterRt(xod_xg, rt = c(10, 20))
expect_true(length(res) == 0)
## xod_xgr
res <- filterRt(xod_xgr, rt = c(2700, 2900))
expect_true(all(rtime(res) >= 2700 & rtime(res) <= 2900))
expect_equal(hasChromPeaks(res), hasChromPeaks(xod_xg))
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_xgr)[, "rt"] >= 2700 &
chromPeaks(xod_xgr)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_xgr)[are_within,])
expect_true(hasAdjustedRtime(res))
expect_true(all(adjustedRtime(res) >= 2700 & adjustedRtime(res) <= 2900))
expect_true(!all(rtime(res, adjusted = FALSE) >= 2700 &
rtime(res, adjusted = FALSE) <= 2900))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = "Peak detection")) == 1)
expect_true(length(processHistory(res, type = "Peak grouping")) == 1)
expect_true(length(processHistory(res, type = "Retention time correction")) == 1)
## Filter such that we don't have any chromPeaks.
res <- filterRt(xod_xgr, rt = c(4200, 4400), adjusted = TRUE)
expect_true(hasAdjustedRtime(res))
expect_true(all(adjustedRtime(res) >= 4200 & adjustedRtime(res) <= 4400))
expect_true(all(rtime(res) >= 4200 & rtime(res) <= 4400))
expect_true(!all(rtime(res, adjusted = FALSE) >= 4200 &
rtime(res, adjusted = FALSE) <= 4400))
expect_true(!hasChromPeaks(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 1)
expect_true(length(processHistory(res, type = "Retention time correction")) == 1)
## No rt
res <- filterRt(xod_xgr, rt = c(10, 20))
expect_true(length(res) == 0)
## filter using raw rt
res <- filterRt(xod_xgr, rt = c(2700, 2900), adjusted = FALSE)
expect_true(!all(rtime(res) >= 2700 & rtime(res) <= 2900))
expect_equal(hasChromPeaks(res), hasChromPeaks(xod_xg))
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_xgr)[, "rt"] >= 2700 &
chromPeaks(xod_xgr)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_xgr)[are_within,])
expect_true(hasAdjustedRtime(res))
expect_true(!all(adjustedRtime(res) >= 2700 & adjustedRtime(res) <= 2900))
expect_true(all(rtime(res, adjusted = FALSE) >= 2700 &
rtime(res, adjusted = FALSE) <= 2900))
expect_true(!hasFeatures(res))
## xod_xgrg
res <- filterRt(xod_xgrg, rt = c(2700, 2900))
expect_true(all(rtime(res) >= 2700 & rtime(res) <= 2900))
expect_equal(hasChromPeaks(res), hasChromPeaks(xod_xg))
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_xgrg)[, "rt"] >= 2700 &
chromPeaks(xod_xgr)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_xgrg)[are_within,])
expect_true(hasAdjustedRtime(res))
expect_true(all(adjustedRtime(res) >= 2700 & adjustedRtime(res) <= 2900))
expect_true(!all(rtime(res, adjusted = FALSE) >= 2700 &
rtime(res, adjusted = FALSE) <= 2900))
expect_true(length(processHistory(res, type = "Peak detection")) == 1)
expect_true(length(processHistory(res, type = "Peak grouping")) == 2)
expect_true(length(processHistory(res, type = "Retention time correction")) == 1)
expect_true(hasFeatures(res))
expect_true(all(featureDefinitions(res)$rtmed >= 2700 &
featureDefinitions(res)$rtmed <= 2900))
## Filter such that we don't have any chromPeaks.
res <- filterRt(xod_xgrg, rt = c(4200, 4400), adjusted = TRUE)
expect_true(hasAdjustedRtime(res))
expect_true(all(adjustedRtime(res) >= 4200 & adjustedRtime(res) <= 4400))
expect_true(all(rtime(res) >= 4200 & rtime(res) <= 4400))
expect_true(!all(rtime(res, adjusted = FALSE) >= 4200 &
rtime(res, adjusted = FALSE) <= 4400))
expect_true(!hasChromPeaks(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 1)
expect_true(length(processHistory(res, type = "Retention time correction")) == 1)
## No rt
res <- filterRt(xod_xgrg, rt = c(10, 20))
expect_true(length(res) == 0)
## filter using raw rt
res <- filterRt(xod_xgrg, rt = c(2700, 2900), adjusted = FALSE)
expect_true(!all(rtime(res) >= 2700 & rtime(res) <= 2900))
expect_equal(hasChromPeaks(res), hasChromPeaks(xod_xg))
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_xgrg)[, "rt"] >= 2700 &
chromPeaks(xod_xgrg)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_xgrg)[are_within,])
expect_true(hasAdjustedRtime(res))
expect_true(!all(adjustedRtime(res) >= 2700 & adjustedRtime(res) <= 2900))
expect_true(all(rtime(res, adjusted = FALSE) >= 2700 &
rtime(res, adjusted = FALSE) <= 2900))
expect_true(hasFeatures(res))
expect_true(all(featureDefinitions(res)$rtmed >= 2700 &
featureDefinitions(res)$rtmed <= 2900))
})
## Test the coercion method.
test_that("as,XCMSnExp,xcmsSet works", {
skip_on_os(os = "windows", arch = "i386")
od_x <- faahko_xod
res <- .XCMSnExp2xcmsSet(od_x)
res <- as(od_x, "xcmsSet")
## Results should be the same as in xs.
expect_equal(res@peaks, chromPeaks(od_x))
expect_equal(res@.processHistory, processHistory(od_x))
expect_equal(phenoData(res), pData(od_x))
expect_equal(filepaths(res), fileNames(od_x))
expect_equal(res@rt$raw, res@rt$corrected)
expect_equal(res@rt$raw, rtime(od_x, bySample = TRUE))
expect_equal(profMethod(res), "bin")
expect_equal(profStep(res), 0.1)
## Can we further process this?
sampclass(res) <- rep("K", 3)
res <- group.density(res, minfrac = 0.5)
## res <- fillPeaks(res)
## Add groups.
od_2 <- groupChromPeaks(
od_x,
param = PeakDensityParam(sampleGroups =rep(1, length(fileNames(od_x)))))
expect_equal(unname(featureDefinitions(od_2)$peakidx), groupidx(res))
## rt correction
od_3 <- adjustRtime(od_2, param = PeakGroupsParam(minFraction = 1,
span = 0.4))
## With groups.
res <- as(od_2, "xcmsSet")
ftDef <- featureDefinitions(od_2)[, !names(featureDefinitions(od_2))%in%"peakidx"]
ftDef <- S4Vectors::as.matrix(ftDef)
rownames(ftDef) <- NULL
expect_equal(res@groups, ftDef)
expect_equal(res@groupidx, unname(featureDefinitions(od_2)$peakidx))
expect_equivalent(groupval(res), featureValues(od_2, value = "index"))
## With adjusted retention time.
res_2 <- retcor.peakgroups(res, missing = 0, span = 0.4)
res <- as(od_3, "xcmsSet")
expect_true(any(unlist(res@rt$raw) != unlist(res@rt$corrected)))
expect_equal(res@rt$corrected, res_2@rt$corrected)
expect_equal(chromPeaks(od_3), peaks(res))
expect_equal(peaks(res_2), peaks(res))
## Test with different binning methods:
## o binlin
mfp <- MatchedFilterParam(impute = "lin", binSize = 3)
od_2 <- od_x
processParam(od_2@.processHistory[[1]]) <- mfp
res <- as(od_2, "xcmsSet")
expect_equal(profStep(res), 3)
expect_equal(profMethod(res), "binlin")
## o binlinbase
mfp <- MatchedFilterParam(impute = "linbase", binSize = 2)
processParam(od_2@.processHistory[[1]]) <- mfp
expect_warning(res <- as(od_2, "xcmsSet"))
expect_equal(profStep(res), 2)
expect_equal(profMethod(res), "binlinbase")
# Tests for issue https://github.com/sneumann/xcms/issues/464
res <- as(xod_xgrg, "xcmsSet")
expect_type(groups(res), "double")
})
test_that("chromatogram,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## Have: od_x: OnDiskMSNnExp
## xod_x: XCMSnExp, with detected chromPeaks.
## xod_xg: with feature groups.
## xod_xgr: with adjusted retention times (no feature groups)
## xod_xgrg: adjusted rt and feature groups.
## XCMSnExp: TIC - can NOT compare with the reported TIC, as that is
## different! Eventually some background adjustment performed?
## BPC - CDF don't habe a BPC.
rtr <- c(2600, 2700)
tmp_obj <- filterFile(xod_x, file = c(1, 2))
res <- chromatogram(tmp_obj, aggregationFun = "max", rt = rtr)
expect_true(is(res, "XChromatograms"))
chromPeaks(res)
cpks <- chromPeaks(tmp_obj, rt = rtr, type = "apex_within")
expect_equal(cpks, chromPeaks(res)[, 1:ncol(cpks)])
expect_true(all(rtime(res[1, 1]) >= rtr[1]))
expect_true(all(rtime(res[1, 1]) <= rtr[2]))
expect_true(all(rtime(res[1, 2]) >= rtr[1]))
expect_true(all(rtime(res[1, 2]) <= rtr[2]))
tmp <- filterRt(filterFile(xod_x, file = 2), rt = rtr)
expect_equal(rtime(tmp), rtime(res[1, 2]))
ints <- spectrapply(tmp, function(z) return(max(intensity(z))))
expect_equal(unlist(ints), intensity(res[1, 2]))
## Check names
expect_equal(names(rtime(res[1, 1])), names(intensity(res[1, 1])))
## Assure we get the same with an OnDiskMSnExp and grouped XCMSnExp
res_2 <- chromatogram(filterFile(od_x, file = c(1, 2)),
aggregationFun = "max", rt = rtr)
expect_equal(pData(res), pData(res_2))
expect_equal(lapply(res, rtime), lapply(res_2, rtime))
expect_equal(lapply(res, intensity), lapply(res_2, intensity))
res_3 <- chromatogram(filterFile(xod_xg, file = c(1, 2)),
aggregationFun = "max", rt = rtr)
expect_equal(res, res_3)
## XCMSnExp: with mzrange and rtrange:
mzr <- c(120, 130)
tmp <- filterMz(xod_xg, mz = mzr)
expect_warning(fts <- featureDefinitions(tmp))
expect_true(nrow(fts) == 0)
tmp <- filterRt(xod_xg, rt = rtr)
featureDefinitions(tmp)
## no features in mz range
res_2 <- chromatogram(xod_xg, rt = rtr, mz = mzr)
expect_true(nrow(chromPeaks(res_2)) == 0)
expect_true(nrow(featureDefinitions(res_2)) == 0)
##
mzr <- matrix(c(335, 335, 344, 344), ncol = 2, byrow = TRUE)
rtr <- matrix(c(2700, 2900, 2600, 2750), ncol = 2, byrow = TRUE)
xchrs <- chromatogram(xod_chr, mz = mzr, rt = rtr)
expect_equal(nrow(xchrs), 2)
expect_equal(ncol(xchrs), 3)
pks <- chromPeaks(xchrs)
expect_true(all(pks[pks[, "column"] == 1, "sample"] == 1))
expect_true(all(pks[pks[, "column"] == 2, "sample"] == 2))
expect_true(all(pks[pks[, "column"] == 3, "sample"] == 3))
expect_true(all(pks[pks[, "row"] == 1, "rt"] >= rtr[1, 1]))
expect_true(all(pks[pks[, "row"] == 1, "rt"] <= rtr[1, 2]))
expect_true(all(pks[pks[, "row"] == 2, "rt"] >= rtr[2, 1]))
expect_true(all(pks[pks[, "row"] == 2, "rt"] <= rtr[2, 2]))
expect_true(all(pks[pks[, "row"] == 1, "mz"] >= mzr[1, 1]))
expect_true(all(pks[pks[, "row"] == 1, "mz"] <= mzr[1, 2]))
expect_true(all(pks[pks[, "row"] == 2, "mz"] >= mzr[2, 1]))
expect_true(all(pks[pks[, "row"] == 2, "mz"] <= mzr[2, 2]))
## Full rt range
xchrs <- chromatogram(xod_chr, mz = mzr)
pks <- chromPeaks(xchrs)
expect_true(all(pks[pks[, "row"] == 1, "mz"] >= mzr[1, 1]))
expect_true(all(pks[pks[, "row"] == 1, "mz"] <= mzr[1, 2]))
expect_true(all(pks[pks[, "row"] == 2, "mz"] >= mzr[2, 1]))
expect_true(all(pks[pks[, "row"] == 2, "mz"] <= mzr[2, 2]))
expect_equal(chromPeaks(xchrs[1, 1]),
chromPeaks(filterFile(xod_chr, 1), mz = mzr[1, ],
type = "apex_within"))
a <- chromPeaks(xchrs[1, 2])
b <- chromPeaks(filterFile(xod_chr, 2), mz = mzr[1, ], type = "apex_within")
expect_equal(a[, -11], b[, -11])
a <- chromPeaks(xchrs[1, 3])
b <- chromPeaks(filterFile(xod_chr, 3), mz = mzr[1, ], type = "apex_within")
expect_equal(a[, -11], b[, -11])
a <- chromPeaks(xchrs[2, 1])
b <- chromPeaks(filterFile(xod_chr, 1), mz = mzr[2, ], type = "apex_within")
expect_equal(a[, -11], b[, -11])
a <- chromPeaks(xchrs[2, 2])
b <- chromPeaks(filterFile(xod_chr, 2), mz = mzr[2, ], type = "apex_within")
expect_equal(a[, -11], b[, -11])
a <- chromPeaks(xchrs[2, 3])
b <- chromPeaks(filterFile(xod_chr, 3), mz = mzr[2, ], type = "apex_within")
expect_equal(a[, -11], b[, -11])
rtr[1, 1] <- 2785
xchrs <- chromatogram(xod_chr, mz = mzr, rt = rtr)
expect_true(nrow(chromPeaks(xchrs[1, 1])) == 0)
pks <- chromPeaks(xchrs)
expect_true(!any(pks[, "row"] == 1 & pks[, "column"] == 1))
## With filled-in data
mzr <- matrix(c(335, 335, 344, 344), ncol = 2, byrow = TRUE)
rtr <- matrix(c(2700, 2900, 2600, 2750), ncol = 2, byrow = TRUE)
## group
xod_tmp <- groupChromPeaks(
xod_xgr, param = PeakDensityParam(sampleGroups = rep(1, 3),
minFraction = 0.25))
xod_tmpf <- fillChromPeaks(
xod_tmp, param = FillChromPeaksParam(fixedRt = 30))
xchrs <- chromatogram(xod_tmp, mz = mzr[2:1, ], rt = rtr[2:1, ], filled = TRUE)
xchrsf <- chromatogram(xod_tmpf, mz = mzr[2:1, ], rt = rtr[2:1, ], filled = TRUE)
expect_equal(nrow(chromPeaks(xchrs)), 4)
expect_equal(unname(chromPeaks(xchrs)[, "sample"]), c(1, 2, 3, 2))
expect_equal(unname(chromPeaks(xchrs)[, "row"]), c(1, 1, 1, 2))
## With filled-in peaks.
expect_equal(nrow(chromPeaks(xchrsf)), 6)
expect_equal(unname(chromPeaks(xchrsf)[, "sample"]), c(1, 2, 3, 1, 2, 3))
expect_equal(chromPeakData(xchrsf)$is_filled, c(FALSE, FALSE, FALSE, TRUE,
FALSE, TRUE))
expect_true(chromPeakData(xchrsf[2, 1])$is_filled)
expect_false(chromPeakData(xchrsf[2, 2])$is_filled, 0)
expect_true(chromPeakData(xchrsf[2, 3])$is_filled)
expect_false(chromPeakData(xchrsf[1, 2])$is_filled)
## Check feature definitions.
fts <- featureDefinitions(xchrs)
ftsf <- featureDefinitions(xchrsf)
expect_equal(fts$peakidx, list(c(1, 2, 3), 4))
expect_equal(ftsf$peakidx, list(c(1, 2, 3), c(4, 5, 6)))
xchrsf2 <- chromatogram(xod_tmpf, mz = mzr[2:1, ], rt = rtr[2:1, ])
expect_equal(chromPeaks(xchrs), chromPeaks(xchrsf2))
expect_equal(featureDefinitions(xchrs), featureDefinitions(xchrsf2))
## Test with single range.
xchrs <- chromatogram(xod_tmp, mz = mzr[1, ], rt = rtr[1, ], filled = TRUE)
xchrsf <- chromatogram(xod_tmpf, mz = mzr[1, ], rt = rtr[1, ], filled = TRUE)
expect_equal(nrow(chromPeaks(xchrs)), 1)
expect_equal(nrow(chromPeaks(xchrsf)), 3)
expect_equal(chromPeakData(xchrsf)$is_filled, c(TRUE, FALSE, TRUE))
expect_equal(unname(featureDefinitions(xchrsf)$peakidx[[1]]), c(1, 2, 3))
xchrsf2 <- chromatogram(xod_tmpf, mz = mzr[1, ], rt = rtr[1, ])
expect_equal(chromPeaks(xchrsf2), chromPeaks(xchrs))
expect_equal(featureDefinitions(xchrsf2), featureDefinitions(xchrs))
##
mzm <- rbind(305.1 + c(-0.01, 0.01), 496.2 + c(-0.01, 0.01))
xchr <- chromatogram(xod_xgrg, mz = mzm)
expect_equal(featureDefinitions(xchr)$row, c(1L, 1L, 1L, 2L, 2L))
## duplicated ranges.
mzm <- rbind(mzm, mzm[1, ])
xchr_2 <- chromatogram(xod_xgrg, mz = mzm)
expect_equal(featureDefinitions(xchr_2)$row, c(1L, 1L, 1L, 2L, 2L, 3L, 3L, 3L))
cpks <- chromPeaks(xchr_2)
expect_equal(cpks[cpks[, "row"] == 1, "into"], cpks[cpks[, "row"] == 3, "into"])
fts <- featureDefinitions(xchr_2)
expect_true(all(fts$peakidx[[1]] != fts$peakidx[[6]]))
expect_equal(cpks[fts$peakidx[[1]], "into"], cpks[fts$peakidx[[6]], "into"])
})
test_that("signal integration is correct", {
skip_on_os(os = "windows", arch = "i386")
## Testing the signal integration of peaks.
## For centWave
tmp <- xod_xgrg
rtr <- chromPeaks(tmp)[1, c("rtmin", "rtmax")]
mzr <- chromPeaks(tmp)[1, c("mzmin", "mzmax")]
chr <- chromatogram(tmp, rt = rtr, mz = mzr)
pkInt <- sum(intensity(chr[1, 1]) *
((rtr[2] - rtr[1]) / (length(chr[1, 1]) - 1)))
expect_equal(pkInt, unname(chromPeaks(tmp)[1, "into"]))
tmp <- filterFile(xod_xgrg, file = 2, keepAdjustedRtime = FALSE)
idxs <- sample(1:nrow(chromPeaks(tmp)), 5)
## Now, for i = 20, for 6 rt I got an NA. Should I remove these measurements?
## idxs <- 1:nrow(chromPeaks(tmp))
for (i in idxs) {
rtr <- chromPeaks(tmp)[i, c("rtmin", "rtmax")]
mzr <- chromPeaks(tmp)[i, c("mzmin", "mzmax")]
chr <- chromatogram(tmp, rt = rtr, mz = mzr)[1, 1]
ints <- intensity(chr)
pkI <- sum(ints, na.rm = TRUE) * ((rtr[2] - rtr[1]) / (length(ints) - 1))
## cat(" ", chromPeaks(tmp)[i, "into"], " - ", pkI, "\n")
expect_equal(unname(pkI), unname(chromPeaks(tmp)[i, "into"]))
}
## pkI2 <- .getPeakInt2(tmp, chromPeaks(tmp)[idxs, , drop = FALSE])
## expect_equal(unname(pkI2), unname(chromPeaks(tmp)[idxs, "into"]))
## Now for matchedfilter.
tmp <- findChromPeaks(filterFile(od_x, 2), param = MatchedFilterParam())
rtr <- chromPeaks(tmp)[1, c("rtmin", "rtmax")]
mzr <- chromPeaks(tmp)[1, c("mzmin", "mzmax")]
chr <- chromatogram(tmp, rt = rtr, mz = mzr)
pkInt <- sum(intensity(chr[1, 1]) *
((rtr[2] - rtr[1]) / (length(chr[1, 1]) - 1)))
chromPeaks(tmp)[1, "into"]
expect_equal(pkInt, unname(chromPeaks(tmp)[1, "into"]))
idxs <- sample(1:nrow(chromPeaks(tmp)), 5)
## idxs <- 1:nrow(chromPeaks(tmp))
for (i in idxs) {
rtr <- chromPeaks(tmp)[i, c("rtmin", "rtmax")]
mzr <- chromPeaks(tmp)[i, c("mzmin", "mzmax")]
chr <- chromatogram(tmp, rt = rtr, mz = mzr)[1, 1]
ints <- intensity(chr)
pkI <- sum(ints, na.rm = TRUE) * ((rtr[2] - rtr[1]) / (length(ints) - 1))
## cat(" ", chromPeaks(tmp)[i, "into"], " - ", pkI, "\n")
expect_equal(unname(pkI), unname(chromPeaks(tmp)[i, "into"]))
}
## pkI2 <- .getPeakInt2(tmp, chromPeaks(tmp)[idxs, , drop = FALSE])
## expect_equal(unname(pkI2), unname(chromPeaks(tmp)[idxs, "into"]))
## ## matchedFilter with wide mz bins.
## ## For matchedFilter I will have to do this on the profile matrix!
## tmp <- findChromPeaks(filterFile(od_x, 2),
## param = MatchedFilterParam(binSize = 2))
## idxs <- 1:nrow(chromPeaks(tmp))
## pkI2 <- .getPeakInt2(tmp, chromPeaks(tmp)[idxs, , drop = FALSE])
## expect_equal(unname(pkI2), unname(chromPeaks(tmp)[idxs, "into"]))
})
test_that("featureValues,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
fdp <- PeakDensityParam(sampleGroups = rep(1, 3))
od_x <- groupChromPeaks(faahko_xod, param = fdp)
fvs <- featureValues(od_x, value = "into")
expect_equal(rownames(fvs), rownames(featureDefinitions(od_x)))
## Use the internal function
res <- .feature_values(chromPeaks(od_x), featureDefinitions(od_x),
value = "into", method = "medret",
intensity = "into",
colnames = basename(fileNames(od_x)))
expect_equal(featureValues(od_x, value = "into"), res)
res <- .feature_values(chromPeaks(od_x), featureDefinitions(od_x),
value = "into", method = "sum",
intensity = "into",
colnames = basename(fileNames(od_x)))
expect_equal(featureValues(od_x, value = "into", method = "sum"), res)
fsum <- featureSummary(xod_xg)
fv <- featureValues(xod_xg, method = "maxint", value = "into")
## For feature 3 we have 2 peaks in sample 3
idx <- unlist(featureDefinitions(xod_xg)[3, "peakidx"])
pks <- chromPeaks(xod_xg)[idx, ]
expect_equal(max(pks[pks[, "sample"] == 3, "into"]), fv[3, 3])
## For feature 37 we have 2 peaks per sample
idx <- unlist(featureDefinitions(xod_xg)[37, "peakidx"])
pks <- chromPeaks(xod_xg)[idx, ]
expect_equal(max(pks[pks[, "sample"] == 1, "into"]), fv[37, 1])
expect_equal(max(pks[pks[, "sample"] == 2, "into"]), fv[37, 2])
expect_equal(max(pks[pks[, "sample"] == 3, "into"]), fv[37, 3])
## method sum
fv <- featureValues(xod_xg, method = "sum", value = "into")
## For feature 3 we have 2 peaks in sample 3
idx <- unlist(featureDefinitions(xod_xg)[3, "peakidx"])
pks <- chromPeaks(xod_xg)[idx, ]
expect_equal(sum(pks[pks[, "sample"] == 3, "into"]), fv[3, 3])
## For feature 37 we have 2 peaks per sample
idx <- unlist(featureDefinitions(xod_xg)[37, "peakidx"])
pks <- chromPeaks(xod_xg)[idx, ]
expect_equal(sum(pks[pks[, "sample"] == 1, "into"]), fv[37, 1])
expect_equal(sum(pks[pks[, "sample"] == 2, "into"]), fv[37, 2])
expect_equal(sum(pks[pks[, "sample"] == 3, "into"]), fv[37, 3])
## missing
na_num <- sum(is.na(featureValues(od_x, value = "into")))
res <- featureValues(od_x, value = "into", missing = 123)
expect_equal(sum(res == 123), na_num)
res <- featureValues(od_x, value = "into", missing = "rowmin_half")
res_na <- featureValues(od_x, value = "into")
is_na <- is.na(rowMeans(res_na))
for (i in which(is_na)) {
are_na <- is.na(res_na[i, ])
expect_true(all(res[i, are_na] == min(res_na[i, ], na.rm = TRUE) / 2))
}
## Check errors
expect_error(featureValues(od_x, value = "into", missing = "b"))
expect_error(featureValues(od_x, value = "into", missing = TRUE))
## feature values with MS level > 1
expect_error(featureValues(xod_xg, msLevel = 2), "No feature definitions")
## Fake feature definitions for MS level 2
cwp <- CentWaveParam(noise = 10000, snthresh = 40,
prefilter = c(3, 10000))
tmp <- xod_xg
fd <- new("MsFeatureData")
fd@.xData <- .copy_env(tmp@msFeatureData)
chromPeakData(fd)$ms_level <- 2L
fd$featureDefinitions$ms_level <- 2L
lockEnvironment(fd, bindings = TRUE)
tmp@msFeatureData <- fd
expect_true(hasChromPeaks(tmp, msLevel = 2L))
expect_true(hasFeatures(tmp, msLevel = 2L))
expect_equal(featureValues(tmp, msLevel = 2L), featureValues(xod_xg))
tmp <- findChromPeaks(tmp, add = TRUE, param = cwp)
expect_equal(unname(chromPeaks(tmp, msLevel = 1L)[, "into"]),
unname(chromPeaks(tmp, msLevel = 2L)[, "into"]))
## correspondence
pdp <- PeakDensityParam(sampleGroups = rep(1, 3))
tmp <- groupChromPeaks(tmp, param = pdp, msLevel = 1L)
tmp <- groupChromPeaks(tmp, param = pdp, msLevel = 2L, add = TRUE)
expect_true(hasFeatures(tmp, msLevel = 1L))
expect_true(hasFeatures(tmp, msLevel = 2L))
all <- featureValues(tmp)
ms1 <- featureValues(tmp, msLevel = 1L)
ms2 <- featureValues(tmp, msLevel = 2L)
expect_equal(all, rbind(ms1, ms2))
rownames(ms1) <- rownames(ms2) <- NULL
expect_equal(ms1, ms2)
})
test_that("peakIndex,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
pkI <- .peakIndex(xod_xg)
expect_equal(names(pkI), rownames(featureDefinitions(xod_xg)))
expect_equal(unname(pkI), featureDefinitions(xod_xg)$peakidx)
})
test_that("MS1 MS2 data works on XCMSnExp", {
skip_on_os(os = "windows", arch = "i386")
## That's to test stuff for issues #208 and related (also issue #214).
## Set every other spectra in the original files to MS2.
## OnDiskMSnExp: od_x
od_mod <- faahko_od
fDat <- fData(od_mod)
idx_1 <- which(fDat$fileIdx == 1)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 1)))))
fDat[idx_1, "msLevel"] <- 2
idx_1 <- which(fDat$fileIdx == 2)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 2)))))
fDat[idx_1, "msLevel"] <- 2
idx_1 <- which(fDat$fileIdx == 3)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 3)))))
fDat[idx_1, "msLevel"] <- 2
fData(od_mod) <- fDat
res <- adjustRtime(od_mod, param = ObiwarpParam())
res_2 <- adjustRtime(filterMsLevel(od_mod, msLevel = 1),
param = ObiwarpParam())
## Expect:
## - adjusted rtime of any other spectrum is identical to the
## ones performed on the data sub set.
expect_equal(res[msLevel(od_mod) == 1], res_2)
## - difference between raw and adjusted rtime at the end and beginning are
## constant.
res_by_file <- split(res, fromFile(od_mod))
raw_by_file <- split(rtime(od_mod), fromFile(od_mod))
expect_true(raw_by_file[[1]][1] != res_by_file[[1]][1])
expect_true(raw_by_file[[2]][1] != res_by_file[[2]][1])
expect_true(raw_by_file[[3]][1] != res_by_file[[3]][1])
diffs <- tail(res_by_file[[1]]) - tail(raw_by_file[[1]])
expect_equal(unname(diff(diffs)), rep(0, 5))
diffs <- tail(res_by_file[[2]]) - tail(raw_by_file[[2]])
expect_equal(unname(diff(diffs)), rep(0, 5))
diffs <- tail(res_by_file[[3]]) - tail(raw_by_file[[3]])
expect_equal(unname(diff(diffs)), rep(0, 5))
## - adjusted rtime of the MS level 2 are in interpolated between rts of
## MS level 2.
## rtime for 3 should be interpolated between 2 and 4:
adj_fun <- approxfun(x = raw_by_file[[1]][c(2, 4)],
y = res_by_file[[1]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[1]][3]), unname(res_by_file[[1]][3]))
adj_fun <- approxfun(x = raw_by_file[[2]][c(2, 4)],
y = res_by_file[[2]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[2]][3]), unname(res_by_file[[2]][3]))
adj_fun <- approxfun(x = raw_by_file[[3]][c(2, 4)],
y = res_by_file[[3]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[3]][3]), unname(res_by_file[[3]][3]))
## XCMSnExp: xod_x, repeat the stuff above
xod_mod <- xod_x
fDat <- fData(xod_mod)
idx_1 <- which(fDat$fileIdx == 1)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 1)))))
fDat[idx_1, "msLevel"] <- 2
idx_1 <- which(fDat$fileIdx == 2)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 2)))))
fDat[idx_1, "msLevel"] <- 2
idx_1 <- which(fDat$fileIdx == 3)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 3)))))
fDat[idx_1, "msLevel"] <- 2
fData(xod_mod) <- fDat
res <- adjustRtime(xod_mod, param = ObiwarpParam())
suppressWarnings(res_2 <- adjustRtime(filterMsLevel(xod_mod, msLevel = 1),
param = ObiwarpParam()))
## Expect:
## - adjusted rtime of any other spectrum is identical to the
## ones performed on the data sub set.
expect_equal(rtime(res, adjusted = TRUE)[msLevel(res) == 1],
rtime(res_2, adjusted = TRUE))
## - difference between raw and adjusted rtime at the end and beginning are
## constant.
res_by_file <- rtime(res, bySample = TRUE)
raw_by_file <- rtime(xod_mod, bySample = TRUE)
expect_true(raw_by_file[[1]][1] != res_by_file[[1]][1])
expect_true(raw_by_file[[2]][1] != res_by_file[[2]][1])
expect_true(raw_by_file[[3]][1] != res_by_file[[3]][1])
diffs <- tail(res_by_file[[1]]) - tail(raw_by_file[[1]])
expect_equal(unname(diff(diffs)), rep(0, 5))
diffs <- tail(res_by_file[[2]]) - tail(raw_by_file[[2]])
expect_equal(unname(diff(diffs)), rep(0, 5))
diffs <- tail(res_by_file[[3]]) - tail(raw_by_file[[3]])
expect_equal(unname(diff(diffs)), rep(0, 5))
## - adjusted rtime of the MS level 2 are in interpolated between rts of
## MS level 2.
## rtime for 3 should be interpolated between 2 and 4:
adj_fun <- approxfun(x = raw_by_file[[1]][c(2, 4)],
y = res_by_file[[1]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[1]][3]), unname(res_by_file[[1]][3]))
adj_fun <- approxfun(x = raw_by_file[[2]][c(2, 4)],
y = res_by_file[[2]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[2]][3]), unname(res_by_file[[2]][3]))
adj_fun <- approxfun(x = raw_by_file[[3]][c(2, 4)],
y = res_by_file[[3]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[3]][3]), unname(res_by_file[[3]][3]))
})
test_that("extractMsData,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## All the data
## all <- extractMsData(od_x)
## expect_equal(length(all), length(fileNames(od_x)))
## rts <- split(rtime(od_x), f = fromFile(od_x))
## expect_equal(lengths(rts), unlist(lapply(all, nrow)))
## On an OnDiskMSnExp with only mz
mzr <- c(300, 302)
res <- extractMsData(filterFile(od_x, 1:2), mz = mzr)
expect_equal(length(res), 2)
expect_true(all(res[[1]][, "mz"] >= mzr[1] & res[[1]][, "mz"] <= mzr[2]))
expect_true(all(res[[2]][, "mz"] >= mzr[1] & res[[2]][, "mz"] <= mzr[2]))
## On an OnDiskMSnExp with only rt
rtr <- c(2500, 2800)
res <- extractMsData(filterFile(od_x, 1:2), rt = rtr)
expect_true(all(res[[1]][, "rt"] >= rtr[1] & res[[1]][, "rt"] <= rtr[2]))
expect_true(all(res[[2]][, "rt"] >= rtr[1] & res[[2]][, "rt"] <= rtr[2]))
## LLLLL TODO Continue here, and then add example to the extractMsData
## help page.
## On an OnDiskMSnExp with mz and rt
res <- extractMsData(filterFile(od_x, 1:2), rt = rtr, mz = mzr)
expect_true(all(res[[1]][, "rt"] >= rtr[1] & res[[1]][, "rt"] <= rtr[2]))
expect_true(all(res[[2]][, "rt"] >= rtr[1] & res[[2]][, "rt"] <= rtr[2]))
expect_true(all(res[[1]][, "mz"] >= mzr[1] & res[[1]][, "mz"] <= mzr[2]))
expect_true(all(res[[2]][, "mz"] >= mzr[1] & res[[2]][, "mz"] <= mzr[2]))
## XCMSnExp, xod_xgr
## with adjusted retention times
tmp <- filterFile(xod_xgr, 1:2, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp))
res <- extractMsData(tmp, rt = rtr, mz = mzr)
mzs <- mz(tmp)
rts <- rtime(tmp, bySample = TRUE, adjusted = TRUE)
expect_true(all(res[[1]][, "rt"] >= rtr[1] & res[[1]][, "rt"] <= rtr[2]))
expect_true(all(res[[2]][, "rt"] >= rtr[1] & res[[2]][, "rt"] <= rtr[2]))
expect_true(all(res[[1]][, "mz"] >= mzr[1] & res[[1]][, "mz"] <= mzr[2]))
expect_true(all(res[[2]][, "mz"] >= mzr[1] & res[[2]][, "mz"] <= mzr[2]))
tmp_rts <- rts[[1]]
tmp_rts <- tmp_rts[tmp_rts >= rtr[1] & tmp_rts <= rtr[2]]
res_rts <- res[[1]][, 1]
expect_equal(unique(res_rts), unname(tmp_rts))
tmp_rts <- rts[[2]]
tmp_rts <- tmp_rts[tmp_rts >= rtr[1] & tmp_rts <= rtr[2]]
res_rts <- res[[2]][, 1]
expect_equal(unique(res_rts), unname(tmp_rts))
## without adjusted retention times
res_2 <- extractMsData(filterFile(xod_xgr, 1:2), adjustedRtime = FALSE,
rt = rtr, mz = mzr)
expect_true(all(res_2[[1]][, "rt"] >= rtr[1] & res_2[[1]][, "rt"] <= rtr[2]))
expect_true(all(res_2[[2]][, "rt"] >= rtr[1] & res_2[[2]][, "rt"] <= rtr[2]))
expect_true(all(res_2[[1]][, "mz"] >= mzr[1] & res_2[[1]][, "mz"] <= mzr[2]))
expect_true(all(res_2[[2]][, "mz"] >= mzr[1] & res_2[[2]][, "mz"] <= mzr[2]))
## expect_true(nrow(res[[1]]) != nrow(res_2[[1]]))
## expect_true(nrow(res[[2]]) != nrow(res_2[[2]]))
## rt and mzr out of range.
res <- extractMsData(od_x, rt = c(6000, 6300), mz = c(0, 3))
expect_equal(length(res), 3)
expect_true(all(unlist(lapply(res, FUN = nrow)) == 0))
res <- extractMsData(od_x, rt = c(6000, 6300))
expect_equal(length(res), 3)
expect_true(all(unlist(lapply(res, FUN = nrow)) == 0))
## res <- extractMsData(od_x, mz = c(0, 3))
## expect_equal(length(res), 3)
## expect_true(all(unlist(lapply(res, FUN = nrow)) == 0))
})
test_that("spectrapply and spectra,XCMSnExp work", {
skip_on_os(os = "windows", arch = "i386")
## With adjusted retention time
tmp <- filterFile(xod_r, file = 3, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp))
expect_true(is.character(all.equal(rtime(tmp, adjusted = FALSE),
rtime(tmp, adjusted = TRUE))))
sps <- spectra(tmp)
expect_equal(unlist(lapply(sps, rtime)), rtime(tmp, adjusted = TRUE))
expect_equal(unlist(spectrapply(tmp, FUN = function(x) rtime(x))),
rtime(tmp, adjusted = TRUE))
sps_2 <- spectra(tmp, adjusted = FALSE)
expect_equal(unlist(lapply(sps_2, rtime)), rtime(tmp, adjusted = FALSE))
## without adjusted retention time
tmp <- filterFile(xod_x, file = 3)
expect_true(!hasAdjustedRtime(tmp))
sps <- spectra(tmp)
expect_equal(unlist(lapply(sps, rtime)), rtime(tmp))
expect_equal(unlist(lapply(sps, mz)), unlist(mz(tmp)))
expect_equal(unlist(spectrapply(tmp, FUN = function(x) rtime(x))),
rtime(tmp))
})
test_that("processHistory,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
type_peak_det <- .PROCSTEP.PEAK.DETECTION
type_align <- .PROCSTEP.RTIME.CORRECTION
type_corr <- .PROCSTEP.PEAK.GROUPING
expect_true(length(processHistory(xod_x, type = type_corr)) == 0)
ph <- processHistory(xod_x, type = type_peak_det)
expect_equal(as.character(class(processParam(ph[[1]]))), "CentWaveParam")
ph <- processHistory(xod_xgrg)
expect_true(length(ph) == 4)
ph <- processHistory(xod_xgrg, msLevel = 1L)
expect_true(length(ph) == 4)
expect_equal(as.character(class(processParam(ph[[1]]))), "CentWaveParam")
})
test_that("split,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
xod <- as(faahko_od, "XCMSnExp")
tmp <- split(xod_xgr, f = fromFile(xod_xgr))
## Split by file.
expect_equal(spectra(tmp[[1]][7:13]), spectra(filterFile(xod, file = 1)[7:13]))
expect_equal(spectra(tmp[[3]][7:13]), spectra(filterFile(xod, file = 3)[7:13]))
## Split by acquisitionNum.
tmp <- filterRt(xod_xgr, rt = c(2600, 2700))
expect_true(hasChromPeaks(tmp))
expect_true(hasAdjustedRtime(tmp))
tmp_2 <- split(tmp, f = acquisitionNum(tmp))
expect_true(all(acquisitionNum(tmp_2[[1]]) == acquisitionNum(tmp)[1]))
expect_true(all(acquisitionNum(tmp_2[[14]]) == acquisitionNum(tmp)[14]))
## with keepAdjustedRtime
tmp <- split(xod_xgr, f = fromFile(xod_xgr), keepAdjustedRtime = TRUE)
tmp_1 <- filterFile(xod_xgr, file = 1, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp_1))
expect_equal(rtime(tmp[[1]]), rtime(tmp_1))
tmp_2 <- filterFile(xod_xgr, file = 2, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp_2))
expect_equal(rtime(tmp[[2]]), rtime(tmp_2))
tmp_3 <- filterFile(xod_xgr, file = 3, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp_3))
expect_equal(rtime(tmp[[3]]), rtime(tmp_3))
expect_true(!all(rtime(tmp[[3]]) == rtime(tmp[[3]], adjusted = FALSE)))
})
test_that("groupnames,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
gn <- groupnames(xod_xgrg)
expect_error(groupnames(xod_x))
})
test_that("calibrate,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
do_plot <- FALSE
tmp <- filterFile(faahko_xod, file = 1)
## Check shift calibration.
mzs <- chromPeaks(tmp)[c(3, 6, 7, 13, 17, 32, 45)]
mzs_shift <- mzs + 0.0001
prm <- CalibrantMassParam(mz = mzs_shift, method = "shift")
res <- calibrate(tmp, prm)
expect_true(isCalibrated(res))
expect_equal(chromPeaks(tmp)[, -1], chromPeaks(res)[, -1])
expect_equal(chromPeaks(tmp)[, 1] + 0.0001, chromPeaks(res)[, 1])
diffs <- chromPeaks(res)[, "mz"] - chromPeaks(tmp)[, "mz"]
X <- chromPeaks(res)[, "mz"]
if (do_plot)
plot(X, diffs)
## Check linear.
mzs_lin <- mzs + 0.00005 + mzs * 0.000002
max_dif <- max(mzs_lin - mzs)
prm <- CalibrantMassParam(mz = mzs_lin, method = "linear", mzabs = max_dif)
res <- calibrate(tmp, prm)
expect_true(isCalibrated(res))
diffs <- chromPeaks(res)[, "mz"] - chromPeaks(tmp)[, "mz"]
X <- chromPeaks(res)[, "mz"]
if (do_plot)
plot(X, diffs)
res_lm <- lm(diffs ~ X)
expect_equal(unname(coefficients(res_lm)[1]), 0.00005, tolerance = 1e-5)
expect_equal(unname(coefficients(res_lm)[2]), 0.000002, tolerance = 1e-5)
## edgeshift
prm <- CalibrantMassParam(mz = mzs_lin, method = "edgeshift",
mzabs = max_dif)
res <- calibrate(tmp, prm)
expect_true(isCalibrated(res))
diffs <- chromPeaks(res)[, "mz"] - chromPeaks(tmp)[, "mz"]
X <- chromPeaks(res)[, "mz"]
if (do_plot)
plot(X, diffs)
mz_sorted <- chromPeaks(tmp)[, "mz"]
## Diff has to be constant before and after the linear range.
lower_idx <- which(chromPeaks(tmp)[, "mz"] < min(mzs))
expect_true(all(diffs[lower_idx] == diffs[lower_idx][1]))
upper_idx <- which(chromPeaks(tmp)[, "mz"] > max(mzs))
expect_true(all(diffs[upper_idx] == diffs[upper_idx][1]))
lin_idx <- 1:length(diffs)
lin_idx <- lin_idx[!(lin_idx %in% lower_idx)]
lin_idx <- lin_idx[!(lin_idx %in% upper_idx)]
lin_mod <- lm(diffs[lin_idx] ~ X[lin_idx])
expect_equal(unname(coefficients(lin_mod)[1]), 0.00005, tolerance = 1e-5)
expect_equal(unname(coefficients(lin_mod)[2]), 0.000002, tolerance = 1e-5)
## Test with a single mass, fall back to shift.
prm <- CalibrantMassParam(mz = mzs_lin[1], method = "edgeshift",
mzabs = max_dif)
expect_warning(res <- calibrate(tmp, prm))
diffs <- chromPeaks(res)[, "mz"] - chromPeaks(tmp)[, "mz"]
min_diff <- min(abs(chromPeaks(tmp)[, "mz"] - mzs_lin[1]))
expect_equal(unname(diffs), rep(min_diff, length(diffs)))
## Check errors.
expect_error(calibrate(tmp, 4))
expect_error(calibrate(tmp, CalibrantMassParam(mz = list(mzs, mzs))))
})
test_that("adjustRtime,peakGroups works", {
skip_on_os(os = "windows", arch = "i386")
xod <- faahko_xod
xodg <- groupChromPeaks(
xod, param = PeakDensityParam(sampleGroups = rep(1, 3)))
pks <- chromPeaks(xodg)
expect_true(length(processHistory(xodg,
type = .PROCSTEP.PEAK.DETECTION)) == 1)
expect_true(length(processHistory(xodg,
type = .PROCSTEP.PEAK.GROUPING)) == 1)
p <- PeakGroupsParam(minFraction = 1, span = 0.3)
xodr <- adjustRtime(xodg, param = p)
## Check that we've got process histories.
expect_true(validObject(xodr))
expect_true(hasChromPeaks(xodr))
expect_true(!hasFeatures(xodr))
## But we would like to keep the related process history step:
expect_true(hasAdjustedRtime(xodr))
expect_true(hasFeatures(xodg))
## We want to keep the process history step of the feature alignment!
expect_true(length(processHistory(xodr,
type = .PROCSTEP.PEAK.GROUPING)) == 1)
expect_true(length(processHistory(xodr,
type = .PROCSTEP.RTIME.CORRECTION)) == 1)
## Different from original:
expect_true(sum(chromPeaks(xod)[, "rt"] != chromPeaks(xodr)[, "rt"]) > 200)
expect_true(sum(chromPeaks(xod)[, "rtmin"] != chromPeaks(xodr)[, "rtmin"]) > 200)
expect_true(sum(chromPeaks(xod)[, "rtmax"] != chromPeaks(xodr)[, "rtmax"]) > 200)
## Check that we get the same by supplying the peakGroupsMatrix.
pgm <- adjustRtimePeakGroups(xodg, param = p)
p_2 <- p
minFraction(p_2) <- 0.5
extraPeaks(p_2) <- 20
peakGroupsMatrix(p_2) <- pgm
xodr_2 <- adjustRtime(xodg, param = p_2)
expect_equal(adjustedRtime(xodr), adjustedRtime(xodr_2))
expect_equal(chromPeaks(xodr), chromPeaks(xodr_2))
p_got <- processParam(
processHistory(xodr, type = .PROCSTEP.RTIME.CORRECTION)[[1]])
peakGroupsMatrix(p_got) <- matrix(ncol = 0, nrow = 0)
expect_equal(p_got, p)
expect_equal(processParam(
processHistory(xodr_2, type = .PROCSTEP.RTIME.CORRECTION)[[1]]),
p_2)
## Doing an additional grouping
xodrg <- groupChromPeaks(xodr, param = PeakDensityParam(sampleGroups =
rep(1, 3)))
expect_true(length(processHistory(xodrg,
type = .PROCSTEP.PEAK.GROUPING)) == 2)
expect_true(hasAdjustedRtime(xodrg))
expect_true(hasFeatures(xodrg))
## Mod settings:
xodr <- adjustRtime(xodg, param = PeakGroupsParam(minFraction = 1,
span = 1))
xodr <- adjustRtime(xodg, param = PeakGroupsParam(minFraction = 1,
span = 1,
smooth = "linear"))
xodr <- adjustRtime(xodg, param = PeakGroupsParam(minFraction = 1,
span = 1,
family = "symmetric"))
## Dropping results.
tmp <- dropAdjustedRtime(xodr)
expect_equal(tmp, xod)
## With subset.
res_sub <- adjustRtime(
xodg, param = PeakGroupsParam(subset = c(1, 3),
subsetAdjust = "previous"))
expect_true(all(rtime(res_sub, bySample = TRUE)[[1]] !=
rtime(xodg, bySample = TRUE)[[1]]))
expect_true(all(rtime(res_sub, bySample = TRUE)[[2]] !=
rtime(xodg, bySample = TRUE)[[2]]))
expect_true(all(rtime(res_sub, bySample = TRUE)[[3]] !=
rtime(xodg, bySample = TRUE)[[3]]))
expect_equal(unname(rtime(res_sub, bySample = TRUE)[[1]]),
unname(rtime(res_sub, bySample = TRUE)[[2]]))
expect_equal(rtime(res_sub, bySample = TRUE)[[2]],
.applyRtAdjustment(rtime(xodg, bySample = TRUE)[[2]],
rtime(xodg, bySample = TRUE)[[1]],
rtime(res_sub, bySample = TRUE)[[1]]))
res_sub <- adjustRtime(
xodg, param = PeakGroupsParam(subset = c(1, 3),
subsetAdjust = "average"))
expect_true(all(rtime(res_sub, bySample = TRUE)[[1]] !=
rtime(xodg, bySample = TRUE)[[1]]))
expect_true(all(rtime(res_sub, bySample = TRUE)[[2]] !=
rtime(xodg, bySample = TRUE)[[2]]))
expect_true(all(rtime(res_sub, bySample = TRUE)[[3]] !=
rtime(xodg, bySample = TRUE)[[3]]))
expect_true(any(rtime(res_sub, bySample = TRUE)[[1]] !=
rtime(res_sub, bySample = TRUE)[[2]]))
tmp <- adjustRtime(xodg, param = PeakGroupsParam())
## With subsetAdjust = "average" and the left-out being at the end.
res_sub <- adjustRtime(
xodg, param = PeakGroupsParam(subset = 1:2, subsetAdjust = "average"))
res_2 <- adjustRtime(
xodg, param = PeakGroupsParam(subset = 1:2, subsetAdjust = "previous"))
expect_equal(rtime(res_sub), rtime(res_2))
})
test_that("findChromPeaks,MSWParam works", {
skip_on_os(os = "windows", arch = "i386")
od <- microtofq_od
## Restrict to first spectrum
od1 <- od[1]
sp1 <- od[[1]]
res_1 <- do_findPeaks_MSW(mz = mz(sp1), int = intensity(sp1))
mp <- MSWParam()
expect_error(findChromPeaks(od1, param = mp, msLevel = 2))
res_2 <- findChromPeaks(od1, param = mp)
pks <- chromPeaks(res_2)
rownames(pks) <- NULL
expect_equal(res_1, pks[, colnames(res_1), drop = FALSE])
## Changing settings.
snthresh(mp) <- 1
nearbyPeak(mp) <- FALSE
res_1 <- do_findPeaks_MSW(mz = mz(sp1), int = intensity(sp1),
snthresh = 1, nearbyPeak = FALSE)
res_2 <- findChromPeaks(od1, param = mp, return.type = "list")
expect_equal(res_1, res_2[[1]][, colnames(res_1)])
peakThr(mp) <- 200
res_1 <- do_findPeaks_MSW(mz = mz(sp1), int = intensity(sp1),
snthresh = 1, nearbyPeak = FALSE,
peakThr = 200)
res_2 <- findChromPeaks(od1, param = mp, return.type = "list")
expect_equal(res_1, res_2[[1]][, colnames(res_1)])
addParams(mp) <- list(forder = 2)
res_3 <- do_findPeaks_MSW(mz = mz(sp1), int = intensity(sp1),
snthresh = 1, nearbyPeak = FALSE,
peakThr = 200, forder = 2)
res_4 <- findChromPeaks(od1, param = mp, return.type = "list")
expect_equal(res_3, res_4[[1]][, colnames(res_3)])
addParams(mp) <- list(forder = 2, dorder = 1)
res_3 <- do_findPeaks_MSW(mz = mz(sp1), int = intensity(sp1),
snthresh = 1, nearbyPeak = FALSE,
peakThr = 200, forder = 2, dorder = 1)
res_4 <- findChromPeaks(od1, param = mp, return.type = "list")
expect_equal(res_3, res_4[[1]][, colnames(res_3)])
## Compare old vs new:
pks <- chromPeaks(fticr_xod)
rownames(pks) <- NULL
})
test_that("featureValues,XCMSnExp works as with groupval", {
skip_on_os(os = "windows", arch = "i386")
fval <- featureValues(xod_xg)
expect_true(nrow(fval) == nrow(featureDefinitions(xod_xg)))
expect_true(ncol(fval) == length(fileNames(xod_xg)))
expect_true(is.numeric(fval))
fval <- featureValues(xod_xg, value = "index")
## Checking errors
expect_error(featureValues(od_x, value = "bla"))
})
test_that("groupChromPeaks,XCMSnExp,PeakDensityParam works", {
skip_on_os(os = "windows", arch = "i386")
## Check error if no features were found. issue #273
pdp <- PeakDensityParam(sampleGroups = rep(1, 3), minSamples = 30)
expect_warning(groupChromPeaks(faahko_xod, param = pdp), "Unable to group any chromatographic peaks.")
fdp <- PeakDensityParam(sampleGroups = rep(1, 3))
res <- groupChromPeaks(faahko_xod, param = fdp)
expect_true(hasFeatures(res))
expect_true(length(processHistory(res)) == 2)
ph <- processHistory(res, type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), fdp)
expect_equal(rownames(featureDefinitions(res)),
.featureIDs(nrow(featureDefinitions(res))))
fdp2 <- PeakDensityParam(sampleGroups = rep(1, 3), binSize = 2,
minFraction = 0.8)
res_2 <- groupChromPeaks(faahko_xod, param = fdp2)
expect_true(length(processHistory(res_2)) == 2)
ph <- processHistory(res_2, type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), fdp2)
expect_equal(rownames(featureDefinitions(res_2)),
.featureIDs(nrow(featureDefinitions(res_2))))
pdp <- PeakDensityParam(sampleGroups = rep(1, 3))
res <- groupChromPeaks(faahko_xod, param = pdp)
res_2 <- groupChromPeaks(res, param = pdp)
expect_equal(featureDefinitions(res), featureDefinitions(res_2))
res_2 <- groupChromPeaks(res, param = pdp, add = TRUE)
expect_true(nrow(featureDefinitions(res_2)) ==
2 * nrow(featureDefinitions(res)))
nr <- nrow(featureDefinitions(res))
expect_equal(featureDefinitions(res),
featureDefinitions(res_2)[1:nr, ])
expect_equal(featureDefinitions(res)$mzmed,
featureDefinitions(res_2)$mzmed[(nr + 1):(2 * nr)])
expect_equal(featureDefinitions(res)$peakidx,
featureDefinitions(res_2)$peakidx[(nr + 1):(2 * nr)])
expect_error(groupChromPeaks(faahko_xod, param = pdp, msLevel = 2), "MS level 2")
expect_error(groupChromPeaks(faahko_xod, param = pdp, msLevel = 1:4),
"one MS level at a time")
})
test_that("groupPeaks,XCMSnExp,MzClustParam works", {
skip_on_os(os = "windows", arch = "i386")
p <- MzClustParam(sampleGroups = rep(1, length(fileNames(fticr_xod))))
fticr_xod2 <- groupChromPeaks(fticr_xod, param = p)
expect_true(hasFeatures(fticr_xod2))
expect_true(length(processHistory(fticr_xod2)) == 2)
ph <- processHistory(fticr_xod2,
type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), p)
expect_equal(rownames(featureDefinitions(fticr_xod2)),
.featureIDs(nrow(featureDefinitions(fticr_xod2))))
p2 <- MzClustParam(sampleGroups = rep(1, length(fileNames(fticr_xod))),
absMz = 1, minFraction = 0.8)
fticr_xod2 <- groupChromPeaks(fticr_xod, param = p2)
expect_true(length(processHistory(fticr_xod2)) == 2)
ph <- processHistory(fticr_xod2,
type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), p2)
expect_equal(rownames(featureDefinitions(fticr_xod2)),
.featureIDs(nrow(featureDefinitions(fticr_xod2))))
})
test_that("groupChromPeaks,XCMSnExp,NearestPeaksParam works", {
skip_on_os(os = "windows", arch = "i386")
p <- NearestPeaksParam(sampleGroups = rep(1, 3))
res <- groupChromPeaks(faahko_xod, param = p)
expect_true(hasFeatures(res))
expect_true(length(processHistory(res)) == 2)
ph <- processHistory(res, type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), p)
expect_equal(rownames(featureDefinitions(res)),
.featureIDs(nrow(featureDefinitions(res))))
fdp2 <- NearestPeaksParam(sampleGroups = rep(1, 3), kNN = 3)
res <- groupChromPeaks(faahko_xod, param = fdp2)
expect_true(length(processHistory(res)) == 2)
ph <- processHistory(res, type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), fdp2)
expect_equal(rownames(featureDefinitions(res)),
.featureIDs(nrow(featureDefinitions(res))))
expect_error(groupChromPeaks(faahko_xod, param = p, msLevel = 2), "MS level 2")
expect_error(groupChromPeaks(faahko_xod, param = p, msLevel = 1:3), " at a time")
res <- groupChromPeaks(faahko_xod, param = p)
res_2 <- groupChromPeaks(res, param = p)
expect_equal(featureDefinitions(res), featureDefinitions(res_2))
res_2 <- groupChromPeaks(res, param = p, add = TRUE)
expect_true(nrow(featureDefinitions(res_2)) ==
2 * nrow(featureDefinitions(res)))
nr <- nrow(featureDefinitions(res))
expect_equal(featureDefinitions(res), featureDefinitions(res)[1:nr, ])
expect_equal(featureDefinitions(res)$peakidx,
featureDefinitions(res_2)$peakidx[(nr + 1):(2 * nr)])
expect_equal(featureDefinitions(res)$mzmed,
featureDefinitions(res_2)$mzmed[(nr + 1):(2 * nr)])
})
test_that("fillChromPeaks,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## No adjusted retention times
expect_true(!.hasFilledPeaks(xod_xg))
expect_false(hasFilledChromPeaks(xod_xg))
res <- fillChromPeaks(xod_xg)
expect_true(.hasFilledPeaks(res))
expect_true(hasFilledChromPeaks(res))
ph <- processHistory(res, type = xcms:::.PROCSTEP.PEAK.FILLING)
expect_true(length(ph) == 1)
expect_equal(ph[[1]]@param, FillChromPeaksParam())
## Check parameter filled in featureValues (issue #157)
expect_equal(featureValues(res, filled = FALSE), featureValues(xod_xg))
## Check if the signal corresponds to what we expect for some peaks.
fp <- chromPeaks(res)
fp <- fp[chromPeakData(res)$is_filled, ]
idxs <- sample(1:nrow(fp), 5)
for (i in idxs) {
cfp <- fp[i, , drop = FALSE]
tmp <- filterFile(xod_xg, file = cfp[1, "sample"])
chr <- chromatogram(tmp, rt = cfp[1, c("rtmin", "rtmax")],
mz = cfp[1, c("mzmin", "mzmax")])[1, 1]
into <- sum(intensity(chr), na.rm = TRUE) *
(cfp[1, "rtmax"] - cfp[1, "rtmin"]) / (length(chr) - 1)
expect_equal(unname(into), unname(cfp[1, "into"]))
}
## Check if the results are similar that we get with findChromPeaks
for (i in 1:length(fileNames(xod_xg))) {
fnd_pks <- chromPeaks(xod_xg)[chromPeaks(xod_xg)[, "sample"] == i, ]
prm <- processHistory(tmp, type ="Peak detection")[[1]]@param
## Extract the data for these using the internal function.
fld_pks <- .getChromPeakData(filterFile(xod_xg, i),
peakArea = fnd_pks,
sample_idx = i,
cn = colnames(fnd_pks))
## rt
expect_true(cor(fnd_pks[, "rt"], fld_pks[, "rt"]) > 0.99)
## mz
expect_true(cor(fnd_pks[, "mz"], fld_pks[, "mz"]) > 0.99)
expect_equal(unname(fnd_pks[, "mz"]), unname(fld_pks[, "mz"]))
## into
expect_true(cor(fnd_pks[, "into"], fld_pks[, "into"]) > 0.99)
expect_equal(unname(fnd_pks[, "into"]), unname(fld_pks[, "into"]))
## expect_equal(fnd_pks[, "into"], fld_pks[, "into"])
## maxo
expect_equal(unname(fnd_pks[, "maxo"]), unname(fld_pks[, "maxo"]))
expect_equal(unname(fnd_pks[, "maxo"]), unname(fld_pks[, "maxo"]))
}
## Check for the NAs if there is really no signal
gv <- featureValues(res)
feat_i <- which(is.na(gv[, 1]))
tmp <- chromPeaks(res)[featureDefinitions(res)$peakidx[[feat_i]],
c("rtmin", "rtmax", "mzmin", "mzmax")]
## Get the intensities for the first one.
pkArea <- apply(tmp, median, MARGIN = 2)
chr <- chromatogram(res, rt = pkArea[1:2], mz = pkArea[3:4])[1, ]
expect_true(all(unlist(lapply(chr, function(z) is.na(intensity(z))))))
## Get also the spectra:
spctr <- spectra(filterRt(filterFile(xod_xg, file = 1), rt = pkArea[1:2]))
mzs <- unlist(lapply(spctr, mz))
## No spectra for the fiven mz:
expect_equal(sum(mzs >= pkArea[3] & mzs <= pkArea[4]), 0)
## Check increasing the expandRt and expandMz to see whether we get rid of
## the NA.
res_2 <- fillChromPeaks(xod_xg, param = FillChromPeaksParam(expandMz = 1))
## Check if the mzrange is now indeed broader for the integrated ones.
fp <- chromPeaks(res)
fp <- fp[chromPeakData(res)$is_filled, ]
fp2 <- chromPeaks(res_2)
fp2 <- fp2[chromPeakData(res)$is_filled, ]
expect_equal(fp2[, "mzmax"] - fp2[, "mzmin"],
2 * (fp[, "mzmax"] - fp[, "mzmin"]))
res_2 <- fillChromPeaks(xod_xg, param = FillChromPeaksParam(fixedRt = 1))
## Check if the rtrange is now indeed broader for the integrated ones.
fp <- chromPeaks(res)
fp <- fp[chromPeakData(res)$is_filled, ]
fp2 <- chromPeaks(res_2)
fp2 <- fp2[chromPeakData(res)$is_filled, ]
expect_equal(fp[, "rt"], fp2[, "rt"])
expect_equal(fp[, "rtmin"] - 1, fp2[, "rtmin"])
expect_equal(fp[, "rtmax"] + 1, fp2[, "rtmax"])
res_2 <- fillChromPeaks(xod_xg, param = FillChromPeaksParam(expandRt = 1))
## Check if the rtrange is now indeed broader for the integrated ones.
fp <- chromPeaks(res)
fp <- fp[chromPeakData(res)$is_filled, ]
fp2 <- chromPeaks(res_2)
fp2 <- fp2[chromPeakData(res)$is_filled, ]
expect_equal(fp2[, "rtmax"] - fp2[, "rtmin"],
2 * (fp[, "rtmax"] - fp[, "rtmin"]))
## Check using ppm
res_2 <- fillChromPeaks(xod_xg, param = FillChromPeaksParam(ppm = 40,
expandMz = 5,
expandRt = 2))
expect_true(all(!is.na(rowSums(featureValues(res_2)))))
## Drop them.
res_rem <- dropFilledChromPeaks(res)
expect_true(!.hasFilledPeaks(res_rem))
expect_equal(res_rem, xod_xg)
## Drop feature definitions from res -> also filled peaks should be dropped.
res_rem <- dropFeatureDefinitions(res)
expect_true(!.hasFilledPeaks(res_rem))
expect_true(!any(chromPeakData(res_rem)$is_filled))
expect_equal(res_rem, xod_x)
## With adjusted rtime.
res_2 <- fillChromPeaks(xod_xgrg)
## Check if the signal corresponds to what we expect for some peaks.
fp <- chromPeaks(res_2)
fp <- fp[chromPeakData(res_2)$is_filled, ]
## These have to be different from before!
fp_raw <- chromPeaks(res)
fp_raw <- fp_raw[chromPeakData(res)$is_filled, ]
expect_true(all(fp_raw[, "rt"] != fp[, "rt"]))
expect_true(all(fp_raw[, "rtmin"] != fp[, "rtmin"]))
expect_true(all(fp_raw[, "rtmax"] != fp[, "rtmax"]))
expect_equal(fp_raw[, "mz"], fp[, "mz"])
expect_equal(fp_raw[, "mzmin"], fp[, "mzmin"])
expect_equal(fp_raw[, "mzmax"], fp[, "mzmax"])
## Values are expected to be different, but still correlated!
expect_true(all(fp_raw[, "into"] != fp[, "into"]))
expect_true(cor(fp_raw[, "into"], fp[, "into"]) > 0.99)
## Check if we can get the same data using the provided range.
## Use the .rawMat function
first <- filterFile(xod_xgrg, file = 1, keepAdjustedRtime = TRUE)
spctr <- spectra(first)
mzs <- lapply(spctr, mz)
vps <- lengths(mzs)
ints <- unlist(lapply(spctr, intensity), use.names = FALSE)
mzs <- unlist(mzs, use.names = FALSE)
rtim <- rtime(first)
idx <- which(fp[, "sample"] == 1)
for (i in idx) {
mtx <- .rawMat(mz = mzs, int = ints, scantime = rtim,
valsPerSpect = vps,
rtrange = fp[i, c("rtmin", "rtmax")],
mzrange = fp[i, c("mzmin", "mzmax")])
into <- sum(mtx[, 3], na.rm = TRUE) *
((fp[i, "rtmax"] - fp[i, "rtmin"]) /
(sum(rtim >= fp[i, "rtmin"] & rtim <= fp[i, "rtmax"]) - 1))
expect_equal(unname(into), unname(fp[i, "into"]))
}
## Drop them.
res_rem <- dropFilledChromPeaks(res_2)
expect_true(!.hasFilledPeaks(res_rem))
expect_equal(res_rem, xod_xgrg)
expect_error(fillChromPeaks(xod_xgrg, msLevel = 1:2,
param = FillChromPeaksParam()),
"for one MS level at a time")
expect_error(fillChromPeaks(xod_xgrg, param = FillChromPeaksParam(),
msLevel = 2L),
"No feature definitions")
})
test_that("fillChromPeaks,XCMSnExp works with only MS2 data", {
skip_on_os(os = "windows", arch = "i386")
tmp <- xod_xgrg
fData(tmp)[fromFile(tmp) == 2, "msLevel"] <- 2L
res <- fillChromPeaks(tmp, FillChromPeaksParam(fixedRt = 2))
expect_true(!any(chromPeakData(res)$is_filled[chromPeaks(res)[, "sample"] == 2]))
res_2 <- fillChromPeaks(xod_xgrg, FillChromPeaksParam(fixedRt = 2))
expect_true(nrow(chromPeaks(res_2)) > nrow(chromPeaks(res)))
expect_equal(chromPeaks(res)[chromPeaks(res)[, "sample"] == 1, ],
chromPeaks(res_2)[chromPeaks(res_2)[, "sample"] == 1, ])
})
test_that("fillChomPeaks,ChromPeakAreaParam works", {
skip_on_os(os = "windows", arch = "i386")
res <- fillChromPeaks(xod_xgrg, ChromPeakAreaParam())
expect_true(hasFilledChromPeaks(res))
})
test_that("fillChromPeaks,XCMSnExp with MSW works", {
skip_on_os(os = "windows", arch = "i386")
p <- MzClustParam()
fticr_xodg <- groupChromPeaks(fticr_xod, param = p)
expect_error(res <- fillChromPeaks(fticr_xod))
res <- fillChromPeaks(fticr_xodg)
## Got a signal for all of em.
expect_true(!any(is.na(featureValues(res))))
## OK
## 2) Check if the fillChromPeaks returns same/similar data than the
## findChromPeaks does:
fdef <- featureDefinitions(fticr_xodg)
pkArea <- do.call(
rbind,
lapply(
fdef$peakidx, function(z) {
tmp <- chromPeaks(fticr_xodg)[z, c("rtmin", "rtmax",
"mzmin", "mzmax"),
drop = FALSE]
pa <- c(median(tmp[, 1]), median(tmp[, 2]),
median(tmp[, 3]), median(tmp[, 4]))
return(pa)
}
))
colnames(pkArea) <- c("rtmin", "rtmax", "mzmin", "mzmax")
pkArea <- cbind(group_idx = 1:nrow(pkArea), pkArea,
mzmed = fdef$mzmed)
## Get peak data for all peaks in the first file
allPks <- .getMSWPeakData(filterFile(fticr_xodg, file = 1),
peakArea = pkArea,
sample_idx = 1,
cn = colnames(chromPeaks(fticr_xodg)))
curP <- chromPeaks(res)[chromPeaks(res)[, "sample"] == 1, ]
curP <- curP[order(curP[, "mz"]), ]
expect_equal(unname(allPks[, "mz"]), unname(curP[, "mz"]))
expect_equal(unname(allPks[, "maxo"]), unname(curP[, "maxo"]))
expect_true(cor(allPks[, "into"], curP[, "into"]) > 0.99) ## Not exactly the
## same but highly similar.
})
test_that("fillChromPeaks,XCMSnExp with matchedFilter works", {
skip_on_os(os = "windows", arch = "i386")
tmp <- findChromPeaks(faahko_od, param = MatchedFilterParam())
sg <- rep(1, length(fileNames(tmp)))
tmp <- groupChromPeaks(tmp, param = PeakDensityParam(sampleGroups = sg))
tmp_filled <- fillChromPeaks(tmp)
expect_true(sum(is.na(featureValues(tmp_filled))) <
sum(is.na(featureValues(tmp))))
nas <- is.na(featureValues(tmp)[, 1]) | is.na(featureValues(tmp)[, 2])
expect_true(cor(featureValues(tmp, value = "into")[!nas, 1],
featureValues(tmp, value = "into")[!nas, 2]) > 0.97)
expect_true(cor(featureValues(tmp_filled, value = "into")[, 1],
featureValues(tmp_filled, value = "into")[, 2],
use = "complete.obs") > 0.97)
## Check signal generation for already found peaks.
for (i in 1:length(fileNames(tmp))) {
fnd_pks <- chromPeaks(tmp)[chromPeaks(tmp)[, "sample"] == i, ]
prm <- processHistory(tmp, type ="Peak detection")[[1]]@param
## Extract the data for these using the internal function.
fld_pks <- .getChromPeakData_matchedFilter(filterFile(tmp, i),
peakArea = fnd_pks,
sample_idx = i,
param = prm,
cn = colnames(fnd_pks))
## rt can not be the same, since for fillChromPeaks it is the rt of the
## maximum signal and for findChromPeaks it is the rt of the apex of the
## filtered/fitted peak.
expect_true(cor(fnd_pks[, "rt"], fld_pks[, "rt"]) > 0.99)
## mz: also not the same; most likely due to slightly different binning.
diffs <- fnd_pks[, "mz"] - fld_pks[, "mz"]
expect_true(max(diffs) < 1e-4)
## into
expect_equal(unname(fnd_pks[, "into"]), unname(fld_pks[, "into"]))
## maxo
expect_equal(unname(fnd_pks[, "maxo"]), unname(fld_pks[, "maxo"]))
}
## modify fillChromPeaks settings.
tmp_fld_2 <- fillChromPeaks(
tmp, param = FillChromPeaksParam(ppm = 40, expandRt = 1))
expect_true(sum(is.na(featureValues(tmp_filled))) <
sum(is.na(featureValues(tmp))))
expect_true(sum(is.na(featureValues(tmp_fld_2))) <
sum(is.na(featureValues(tmp_filled))))
nas <- is.na(featureValues(tmp)[, 1]) | is.na(featureValues(tmp)[, 2])
expect_true(cor(featureValues(tmp_fld_2, value = "into")[, 1],
featureValues(tmp_fld_2, value = "into")[, 2],
use = "complete.obs") > 0.97)
})
test_that("writeMSData,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## Write adjusted retention times
tmp_path <- tempdir()
nfls <- paste0(tmp_path, "/",
sub(".CDF$", "_2.mzML", basename(fileNames(xod_xgr))))
tmp <- filterRt(xod_xgr, rt = c(2500, 2700))
writeMSData(tmp, file = nfls)
data_in <- readMSData(nfls, mode = "onDisk")
expect_equal(unname(rtime(data_in)), unname(rtime(tmp)))
})
test_that("adjustRtime,XCMSnExp,Obiwarp works", {
skip_on_os(os = "windows", arch = "i386")
prm <- ObiwarpParam(centerSample = 3, subset = c(1, 2), binSize = 10)
expect_error(adjustRtime(xod_x, param = prm))
prm <- ObiwarpParam(centerSample = 2, subset = c(1, 2), binSize = 10)
res <- adjustRtime(xod_x, param = prm)
plotAdjustedRtime(res, col = c("#ff000060", "#00ff0060", "#0000ff60"))
expect_equal(rtime(xod_x, bySample = TRUE)[[2]],
rtime(xod_x, bySample = TRUE)[[2]])
expect_equal(rtime(xod_x, bySample = TRUE)[[3]],
rtime(xod_x, bySample = TRUE)[[3]])
prm <- ObiwarpParam(centerSample = 1, subset = c(1, 3), binSize = 10)
res <- adjustRtime(xod_x, param = prm)
plotAdjustedRtime(res, col = c("#ff000060", "#00ff0060", "#0000ff60"))
expect_equal(rtime(xod_x, bySample = TRUE)[[1]],
rtime(xod_x, bySample = TRUE)[[1]])
})
test_that("dropFilledChromPeaks,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
xod_tmp <- groupChromPeaks(
xod_xgr, param = PeakDensityParam(sampleGroups = rep(1, 3),
minFraction = 0.25))
xod_tmpf <- fillChromPeaks(
xod_tmp, param = FillChromPeaksParam(fixedRt = 30))
res <- dropFilledChromPeaks(xod_tmpf)
expect_equal(chromPeaks(res), chromPeaks(xod_xgr))
})
test_that("updateObject,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
tmp <- faahko_xod
en <- new("MsFeatureData")
en@.xData <- .copy_env(tmp@msFeatureData@.xData)
rownames(en$chromPeaks) <- NULL
tmp@msFeatureData <- en
expect_true(is.null(rownames(chromPeaks(tmp))))
tmp <- updateObject(tmp)
expect_true(!is.null(rownames(chromPeaks(tmp))))
})
test_that("filterMsLevel works with MS>1", {
skip_on_os(os = "windows", arch = "i386")
ms2 <- filterRt(as(pest_dda, "OnDiskMSnExp"), rt = c(200, 600))
res <- findChromPeaks(ms2, param = CentWaveParam(
prefilter = c(3, 1000)),
msLevel = 1)
res_1 <- filterMsLevel(res, msLevel = 1)
res_2 <- filterMsLevel(res, msLevel = 2)
expect_true(all(msLevel(res_1) == 1))
expect_true(all(msLevel(res_2) == 2))
expect_equal(chromPeaks(res_1), chromPeaks(res))
expect_equal(processHistory(res_1), processHistory(res))
expect_true(length(processHistory(res_2)) == 0)
expect_true(hasChromPeaks(res_1))
expect_false(hasChromPeaks(res_1, msLevel = 2L))
expect_false(hasChromPeaks(res_2))
})
test_that("chromPeakData,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
tmp <- xod_x
expect_error(chromPeakData(tmp) <- 5, "'chromPeakData' is supposed")
chromPeakData(tmp)$other_column <- "b"
expect_true(all(chromPeakData(tmp)$other_column == "b"))
res <- filterRt(tmp, rt = c(2800, 3000))
expect_true(hasChromPeaks(res))
expect_true(validObject(res))
expect_true(all(chromPeakData(res)$other_column == "b"))
expect_true(any(colnames(chromPeakData(res)) == "other_column"))
res <- filterMz(tmp, mz = c(400, 500))
expect_true(hasChromPeaks(res))
expect_true(validObject(res))
expect_true(all(chromPeakData(res)$other_column == "b"))
expect_true(any(colnames(chromPeakData(res)) == "other_column"))
res <- filterMsLevel(tmp, msLevel = 2L)
expect_true(length(res) == 0)
expect_false(hasChromPeaks(res))
res <- filterMsLevel(tmp, msLevel = 1L)
expect_equal(chromPeaks(res), chromPeaks(tmp))
expect_equal(chromPeakData(res), chromPeakData(tmp))
res <- filterFile(tmp, 2)
expect_true(hasChromPeaks(res))
expect_true(validObject(res))
expect_true(all(chromPeakData(res)$other_column == "b"))
expect_true(any(colnames(chromPeakData(res)) == "other_column"))
tmp <- groupChromPeaks(tmp, param = PeakDensityParam(sampleGroups = rep(1, 3)))
res <- fillChromPeaks(tmp)
expect_true(hasChromPeaks(res))
expect_true(validObject(res))
expect_true(is.character(chromPeakData(res)$other_column))
expect_true(any(colnames(chromPeakData(res)) == "other_column"))
})
test_that("plot,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
mzr <- c(301.9, 302.1)
rtr <- c(2500, 2650)
tmp <- filterMz(filterRt(xod_x, rtr), mzr)
centroided(tmp) <- TRUE
plot(tmp[1:3], type = "spectra")
plot(tmp, type = "XIC")
})
test_that("refineChromPeaks,CleanPeaksParam works", {
skip_on_os(os = "windows", arch = "i386")
rtw <- chromPeaks(xod_x)[, "rtmax"] - chromPeaks(xod_x)[, "rtmin"]
res <- refineChromPeaks(xod_x, param = CleanPeaksParam(20))
rtw2 <- chromPeaks(res)[, "rtmax"] - chromPeaks(res)[, "rtmin"]
expect_true(all(rtw2 < 20))
res <- refineChromPeaks(xod_x, param = CleanPeaksParam(1))
expect_true(length(chromPeaks(res)) == 0)
expect_true(is(processHistory(res)[[2]]@param, "CleanPeaksParam"))
expect_warning(res <- refineChromPeaks(xod_x, param = CleanPeaksParam(20),
msLevel = 2L))
expect_equal(chromPeaks(res), chromPeaks(xod_x))
res <- refineChromPeaks(xod_xgr, param = CleanPeaksParam(20))
expect_true(hasAdjustedRtime(res))
res <- refineChromPeaks(xod_xgrg, param = CleanPeaksParam(20))
expect_true(hasFeatures(xod_xgrg))
expect_false(hasFeatures(res))
## Fake MS level > 1
tmp <- xod_x
fd <- new("MsFeatureData")
fd@.xData <- .copy_env(tmp@msFeatureData)
chromPeakData(fd)$ms_level <- 2L
lockEnvironment(fd, bindings = TRUE)
tmp@msFeatureData <- fd
expect_true(hasChromPeaks(tmp, msLevel = 2L))
tmp <- findChromPeaks(tmp, add = TRUE,
param = CentWaveParam(prefilter = c(5, 10000),
noise = 10000, sn = 40))
expect_true(hasChromPeaks(tmp, msLevel = 1L))
res <- refineChromPeaks(tmp, msLevel = 1L, param = CleanPeaksParam(20))
expect_equal(chromPeaks(tmp, msLevel = 2L), chromPeaks(res, msLevel = 2L))
expect_true(nrow(chromPeaks(tmp, msLevel = 1L)) >
nrow(chromPeaks(res, msLevel = 1L)))
res_2 <- refineChromPeaks(res, msLevel = 2L, param = CleanPeaksParam(20))
expect_equal(chromPeaks(res, msLevel = 1L), chromPeaks(res_2, msLevel = 1L))
expect_true(nrow(chromPeaks(res, msLevel = 2L)) >
nrow(chromPeaks(res_2, msLevel = 2L)))
})
test_that("refineChromPeaks,MergeNeighboringPeaksParam works", {
skip_on_os(os = "windows", arch = "i386")
prm <- MergeNeighboringPeaksParam(expandRt = 4)
res <- refineChromPeaks(xod_xgr, param = prm)
expect_true(hasAdjustedRtime(res))
expect_equal(rtime(xod_xgr), rtime(res))
pks_old <- chromPeaks(res)[!chromPeakData(res)$merged, ]
expect_equal(chromPeaks(xod_xgr)[rownames(pks_old), ], pks_old)
expect_equal(rownames(chromPeaks(res)), rownames(chromPeakData(res)))
expect_true(nrow(chromPeaks(res)) < nrow(chromPeaks(xod_xgr)))
expect_warning(res <- refineChromPeaks(as(od_x, "XCMSnExp"), param = prm),
"Please run")
prm <- MergeNeighboringPeaksParam(expandRt = 10, ppm = 50)
res <- refineChromPeaks(pest_swth, param = prm)
expect_equal(chromPeaks(res), chromPeaks(pest_swth))
expect_true(all(chromPeakData(res)$merged == FALSE))
res <- refineChromPeaks(pest_swth, param = prm, msLevel = 2L)
expect_equal(chromPeaks(res, msLevel = 1L),
chromPeaks(pest_swth, msLevel = 1L))
expect_true(nrow(chromPeaks(res, msLevel = 2L)) <
nrow(chromPeaks(pest_swth, msLevel = 2L)))
## With fake MS level 2 data.
tmp <- xod_x
fd <- new("MsFeatureData")
fd@.xData <- .copy_env(tmp@msFeatureData)
chromPeakData(fd)$ms_level <- 2L
lockEnvironment(fd, bindings = TRUE)
tmp@msFeatureData <- fd
expect_true(hasChromPeaks(tmp, msLevel = 2L))
tmp <- findChromPeaks(tmp, add = TRUE,
param = CentWaveParam(prefilter = c(5, 10000),
noise = 10000, sn = 40))
prm <- MergeNeighboringPeaksParam(expandRt = 4)
res <- refineChromPeaks(tmp, param = prm, msLevel = 1L)
expect_true(nrow(chromPeaks(res, msLevel = 1L)) <
nrow(chromPeaks(tmp, msLevel = 1L)))
expect_equal(chromPeaks(res, msLevel = 2L), chromPeaks(tmp, msLevel = 2L))
})
test_that("refineChromPeaks,FilterIntensityParam works", {
skip_on_os(os = "windows", arch = "i386")
pks <- chromPeaks(xod_x)
prm <- FilterIntensityParam(nValues = 1, threshold = 50000)
res <- refineChromPeaks(xod_x, param = prm, msLevel = 2L)
expect_equal(chromPeaks(res), chromPeaks(xod_x))
res <- refineChromPeaks(xod_x, param = prm, msLevel = 1L)
x <- filterRt(xod_x, rt = c(2500, 3500))
prm <- FilterIntensityParam(nValues = 2, threshold = 50000)
res <- refineChromPeaks(xod_x, param = prm)
expect_true(all(chromPeaks(res)[, "maxo"] > 50000))
res <- refineChromPeaks(xod_x, param = prm, msLevel = 3)
expect_equal(chromPeaks(res), chromPeaks(xod_x))
## With a real object having MS2.
prm <- FilterIntensityParam(nValues = 2, threshold = 50000)
res <- refineChromPeaks(pest_swth, param = prm, msLevel = 1L)
expect_equal(chromPeaks(res, msLevel = 2L),
chromPeaks(pest_swth, msLevel = 2L))
expect_true(nrow(chromPeaks(res, msLevel = 1L)) == 0)
res <- refineChromPeaks(pest_swth, param = prm, msLevel = 2L)
expect_equal(chromPeaks(res, msLevel = 1L),
chromPeaks(pest_swth, msLevel = 1L))
expect_true(nrow(chromPeaks(res, msLevel = 2L)) == 0)
})
test_that("filterChromPeaks,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
res <- filterChromPeaks(xod_x, keep = c(5, 23, 3))
expect_true(nrow(chromPeaks(res)) == 3)
expect_equal(chromPeaks(res), chromPeaks(xod_x)[c(3, 5, 23), ])
expect_error(filterChromPeaks(xod_x, keep = 1235), "out of bounds")
res <- filterChromPeaks(xod_xg, keep = c(8, 197, 14))
expect_equal(chromPeaks(res), chromPeaks(xod_xg)[c(8, 14, 197), ])
expect_true(nrow(featureDefinitions(res)) == 2)
## chromPeak 14 is part of feature 6
tmp <- featureValues(xod_xg)[6, ]
tmp[3] <- NA
expect_equal(featureValues(res)[1, ], tmp)
## chromPeaks 8 and 197 are part of feature 46
expect_equal(featureValues(res)[2, ], featureValues(xod_xg)[46, ])
})
test_that("manualChromPeaks works", {
skip_on_os(os = "windows", arch = "i386")
cp <- cbind(mzmin = c(453, 301.9, 100),
mzmax = c(453.5, 302.1, 102),
rtmin = c(2400, 2500, 2460),
rtmax = c(2700, 2650, 2500))
## Errors
expect_error(manualChromPeaks(xod_x, msLevel = 1:2), "can only add")
expect_error(manualChromPeaks(xod_x, 1:2), "lacks one or more of the")
expect_error(manualChromPeaks(xod_x, cp, samples = 10), "out of bounds")
## With an XCMSnExp
res <- manualChromPeaks(xod_x, cp)
expect_true(nrow(chromPeaks(res)) > nrow(chromPeaks(xod_x)))
expect_equal(chromPeaks(res)[!is.na(chromPeaks(res)[, "intb"]), ],
chromPeaks(xod_x))
## With an OnDiskMSnExp
res2 <- manualChromPeaks(od_x, cp)
expect_true(is(res2, "XCMSnExp"))
expect_true(hasChromPeaks(res2))
res3 <- manualChromPeaks(od_x, cp, samples = 2)
expect_true(all(chromPeaks(res3)[, "sample"] == 2))
})
test_that("manualFeatures works", {
skip_on_os(os = "windows", arch = "i386")
idx <- list(1:4, c(4, "a"))
## Add features to an XCMSnExp without features.
expect_error(manualFeatures(xod_x, idx), "out of bounds")
idx <- list(1:4, c(5, 500, 500))
expect_error(manualFeatures(xod_x, idx), "out of bounds")
idx <- list(1:5, c(6, 34, 234))
res <- manualFeatures(xod_x, idx)
expect_true(hasFeatures(res))
expect_true(nrow(featureDefinitions(res)) == 2)
expect_equal(featureDefinitions(res)$peakidx, idx)
## Append features to an XCMSnExp.
idx <- featureDefinitions(xod_xg)$peakidx[c(3, 5, 7)]
res <- manualFeatures(xod_xg, idx)
nfd <- nrow(featureDefinitions(xod_xg))
expect_true(nrow(featureDefinitions(res)) == nfd + 3)
expect_equal(featureDefinitions(res)[nfd + 1, "mzmed"],
featureDefinitions(xod_xg)[3, "mzmed"])
expect_equal(featureDefinitions(res)[nfd + 2, "rtmin"],
featureDefinitions(xod_xg)[5, "rtmin"])
})
test_that("featureSpectra works", {
skip_on_os(os = "windows", arch = "i386")
## For now we don't have MS1/MS2 data, so we have to stick to errors etc.
expect_error(ms2_mspectrum_for_features(xod_x, method = "other"))
expect_error(res <- featureSpectra(xod_x))
expect_warning(res <- featureSpectra(xod_xg, return.type = "list"))
expect_true(length(res) == nrow(featureDefinitions(xod_xg)))
expect_equal(names(res), rownames(featureDefinitions(xod_xg)))
expect_warning(res <- featureSpectra(xod_xg, return.type = "MSpectra"))
expect_true(is(res, "MSpectra"))
expect_true(length(res) == 0)
expect_warning(res <- featureSpectra(xod_xg, msLevel = 1L))
expect_true(length(res) == 0)
res <- featureSpectra(xod_xg, method = "closest_rt", msLevel = 1L,
return.type = "List")
expect_equal(length(res), nrow(featureDefinitions(xod_xg)))
for (i in seq_along(res)) {
expect_true(is(res[[i]], "Spectra"))
}
res2 <- featureSpectra(xod_xg, msLevel = 2L, return.type = "Spectra")
expect_true(length(res2) == 0)
})
test_that("filterFeatureDefinitions works", {
skip_on_os(os = "windows", arch = "i386")
tmp <- xod_xgrg
expect_error(filterFeatureDefinitions("a"))
expect_error(filterFeatureDefinitions(xod_xgr, 1:3))
expect_error(filterFeatureDefinitions(tmp, c("FT01", "other")))
expect_error(filterFeatureDefinitions(tmp, 1:4000))
tmp <- filterFeatureDefinitions(tmp, features = 11:30)
expect_equal(nrow(featureDefinitions(tmp)), 20)
expect_equal(rownames(featureDefinitions(tmp)), paste0("FT", 11:30))
## Check if we have the correct process history
ph <- processHistory(tmp)[[length(processHistory(tmp))]]
expect_true(is(processParam(ph), "GenericParam"))
expect_true(processParam(ph)@fun == "filterFeatureDefinitions")
tmp <- dropFeatureDefinitions(tmp)
expect_true(length(processHistory(tmp)) == 3)
ph <- processHistory(tmp)[[length(processHistory(tmp))]]
expect_true(!is(processParam(ph), "GenericParam"))
})
test_that("findChromPeaksIsolationWindow works", {
skip_on_os(os = "windows", arch = "i386")
obj <- filterRt(as(pest_swth, "OnDiskMSnExp"), rt = c(0, 300))
cwp <- CentWaveParam(snthresh = 5, noise = 100, ppm = 10,
peakwidth = c(3, 30), prefilter = c(2, 1000))
res <- findChromPeaksIsolationWindow(obj, param = cwp)
expect_true(is(res, "XCMSnExp"))
expect_equal(length(processHistory(res)), 1)
expect_true(all(c("isolationWindow", "isolationWindowTargetMZ") %in%
colnames(chromPeakData(res))))
expect_true(all(chromPeakData(res)$ms_level == 2L))
## Add to existing peaks
obj <- findChromPeaks(obj, param = cwp)
res_2 <- findChromPeaksIsolationWindow(obj, param = cwp)
expect_equal(chromPeaks(res_2)[1:nrow(chromPeaks(obj)), , drop = FALSE],
chromPeaks(obj))
expect_true(length(processHistory(res_2)) == 2)
## no isolation window/add isolation window
expect_error(findChromPeaksIsolationWindow(od_x), "are NA")
tmp <- od_x
cwp <- CentWaveParam(noise = 10000, snthresh = 40, prefilter = c(3, 10000))
fData(tmp)$my_win <- 1
res_3 <- findChromPeaksIsolationWindow(
tmp, param = cwp, isolationWindow = fData(tmp)$my_win, msLevel = 1L)
expect_equal(chromPeaks(xod_x), chromPeaks(res_3))
expect_true(all(chromPeakData(res_3)$isolationWindow == 1))
res_4 <- findChromPeaksIsolationWindow(
xod_x, param = cwp, isolationWindow = rep(1, length(xod_x)),
msLevel = 1L)
expect_equal(chromPeaks(res_4)[1:nrow(chromPeaks(xod_x)), ],
chromPeaks(xod_x))
})
test_that("reconstructChromPeakSpectra works", {
res <- reconstructChromPeakSpectra(
pest_swth, peakId = rownames(chromPeaks(pest_swth))[5:6])
expect_true(length(res) == 2)
expect_s4_class(res, "Spectra")
expect_true(length(intensity(res)[[2]]) == 2)
## peakId
res_3 <- reconstructChromPeakSpectra(pest_swth, peakId = c("CP06"))
expect_identical(intensity(res_3), intensity(res[2]))
expect_warning(res <- reconstructChromPeakSpectra(
pest_swth, peakId = c("CP06", "other")))
expect_identical(mz(res_3), mz(res))
expect_error(reconstructChromPeakSpectra(pest_swth, peakId = c("a", "b")),
"None of the provided")
})
test_that("fillChromPeaks,XcmsExperiment works with verboseBetaColumns", {
p <- CentWaveParam(noise = 10000, snthresh = 40, prefilter = c(3, 10000),
verboseBetaColumns = TRUE)
res <- findChromPeaks(od_x, param = p)
expect_true(all(c("beta_cor", "beta_snr") %in% colnames(chromPeaks(res))))
p <- PeakDensityParam(sampleGroups = rep(1, 3))
res <- groupChromPeaks(res, param = p)
res <- fillChromPeaks(res, ChromPeakAreaParam())
pks_det <- chromPeaks(res)[!chromPeakData(res)$is_filled, ]
pks_fil <- chromPeaks(res)[chromPeakData(res)$is_filled, ]
expect_true(sum(is.na(pks_fil[, "beta_cor"])) < 4)
})
sneumann/xcms documentation built on April 5, 2024, 2:35 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
test_that("XCMSnExp, XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
rts <- rtime(faahko_od)
rts_2 <- rtime(od_x)
expect_equal(rts, rts_2)
## Test with bySample.
rts_3 <- rtime(xod_x, bySample = TRUE)
expect_equal(rts_3, split(rts, f = fromFile(faahko_od)))
## Check if rtimes are correctly ordered for bySample
rts_4 <- rtime(filterFile(faahko_od, file = 2))
expect_equal(rts_4, rts_3[[2]])
rts_4 <- rtime(filterFile(faahko_od, file = 3))
expect_equal(rts_4, rts_3[[3]])
})
test_that("mz,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
tmp_od <- filterRt(faahko_od, rt = c(3500, 3800))
tmp_xod <- filterRt(xod_x, rt = c(3500, 3800))
mzs <- mz(tmp_od)
## The check below has to work, since we're calling the mz,OnDiskMSnExp.
mzs_2 <- mz(tmp_xod, bySample = TRUE)
tmp <- split(mzs, fromFile(tmp_od))
expect_equal(lapply(tmp, unlist, use.names = FALSE), mzs_2)
})
test_that("intensity,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
tmp_od <- filterRt(faahko_od, rt = c(3500, 3800))
tmp_xod <- filterRt(xod_x, rt = c(3500, 3800))
ints <- intensity(tmp_od)
## The check below has to work, since we're calling the intensity,OnDiskMSnExp.
## ints_2 <- intensity(od_x)
## expect_equal(ints, ints_2)
ints_2 <- intensity(tmp_xod, bySample = TRUE)
tmp <- split(ints, fromFile(tmp_od))
expect_equal(lapply(tmp, unlist, use.names = FALSE), ints_2)
})
test_that("spectra,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## xod_x
tmp <- filterRt(xod_x, rt = c(2700, 2900))
res <- spectra(tmp)
rts <- unlist(lapply(res, rtime))
expect_equal(rts, rtime(tmp))
## Check with adjusted retention times.
tmp2 <- filterRt(xod_xgr, rt = c(2700, 2900))
res2 <- spectra(tmp2)
rts2 <- unlist(lapply(res2, rtime))
expect_equal(rts2, rtime(tmp2))
## Now do it on one file:
tmp <- filterFile(xod_x, file = 2)
res <- spectra(tmp)
expect_equal(rtime(tmp), unlist(lapply(res, rtime)))
tmp2 <- filterFile(xod_xgr, file = 2, keepAdjustedRtime = TRUE)
res2 <- spectra(tmp2)
expect_equal(rtime(tmp2), unlist(lapply(res2, rtime)))
expect_true(sum(unlist(lapply(res2, rtime)) ==
unlist(lapply(res, rtime))) < length(rtime(tmp)) / 4)
res3 <- spectra(tmp2, adjusted = FALSE)
expect_equal(res, res3)
## adjusted rt
tmp <- filterFile(xod_xgr, file = 2, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp))
expect_true(is.character(all.equal(rtime(tmp, adjusted = FALSE),
adjustedRtime(tmp))))
res <- spectra(tmp)
expect_equal(rtime(tmp), unlist(lapply(res, rtime)))
res <- unlist(spectrapply(tmp, FUN = function(x) {rtime(x)}))
expect_equal(res, adjustedRtime(tmp))
})
test_that("XCMSnExp accessors work", {
skip_on_os(os = "windows", arch = "i386")
## Filling with data...
xod <- as(faahko_od, "XCMSnExp")
## peaks
expect_true(!hasChromPeaks(xod))
chromPeaks(xod) <- chromPeaks(xod_x)
expect_true(hasChromPeaks(xod))
expect_equal(chromPeaks(xod), chromPeaks(xod_x))
expect_error(chromPeaks(xod) <- 4)
tmp <- chromPeaks(xod, bySample = TRUE)
expect_true(length(tmp) == length(fileNames(xod)))
tmp <- do.call(rbind, tmp)
rownames(tmp) <- NULL
pks <- chromPeaks(xod)
rownames(pks) <- NULL
expect_equal(tmp, pks)
## chromPeaks with isFilledColumn
expect_true(all(colnames(pks) != "is_filled"))
pks <- chromPeaks(xod_x, isFilledColumn = TRUE)
expect_true(any(colnames(pks) == "is_filled"))
expect_true(all(pks[, "is_filled"] == 0))
## chromPeaks with rt
all_pks <- chromPeaks(xod_x)
pks <- chromPeaks(xod_x, rt = c(2000, 2600), type = "within")
expect_true(nrow(pks) < nrow(all_pks))
expect_true(all(pks[, "rtmin"] >= 2000 & pks[, "rtmax"] <= 2600))
pks <- chromPeaks(xod_x, rt = c(2000, 2600), bySample = TRUE,
type = "within")
expect_true(nrow(pks[[2]]) == 0)
pks <- chromPeaks(xod_x, rt = c(2000, 2600), type = "any")
expect_true(all(pks[, "rtmax"] >= 2000 & pks[, "rtmin"] <= 2600))
pks <- chromPeaks(xod_x, rt = c(2000, 2200))
expect_true(nrow(pks) == 0)
pks <- chromPeaks(xod_x, rt = c(2000, 2200), bySample = TRUE)
expect_true(all(lengths(pks) == 0))
## chromPeaks with mz
pks <- chromPeaks(xod_x, mz = c(280, 281), type = "within")
expect_true(all(pks[, "mzmin"] >= 280 & pks[, "mzmax"] <= 281))
pks <- chromPeaks(xod_x, mz = c(280, 281), bySample = TRUE, type = "within")
expect_true(nrow(pks[[1]]) == 0)
expect_true(nrow(pks[[3]]) == 0)
expect_true(nrow(pks[[2]]) == 1)
pks <- chromPeaks(xod_x, mz = c(280, 300), bySample = FALSE, type = "within")
expect_true(all(pks[, "mzmin"] >= 280 & pks[, "mzmax"] <= 300))
pks <- chromPeaks(xod_x, mz = c(280, 300), bySample = FALSE, type = "any")
expect_true(all(pks[, "mzmax"] >= 280 & pks[, "mzmin"] <= 300))
pks <- chromPeaks(xod_x, mz = c(200, 210), bySample = FALSE)
expect_true(nrow(pks) == 0)
pks <- chromPeaks(xod_x, mz = c(200, 210), bySample = TRUE)
expect_true(all(lengths(pks) == 0))
## chromPeaks with both
pks <- chromPeaks(xod_x, mz = c(280, 300), rt = c(3000, 3300),
type = "within")
expect_true(all(pks[, "mzmin"] >= 280 & pks[, "mzmax"] <= 300))
expect_true(all(pks[, "rtmin"] >= 3000 & pks[, "rtmax"] <= 3300))
pks <- chromPeaks(xod_x, mz = c(280, 300), rt = c(3000, 3300),
type = "any")
expect_true(all(pks[, "mzmax"] >= 280 & pks[, "mzmin"] <= 300))
expect_true(all(pks[, "rtmax"] >= 3000 & pks[, "rtmin"] <= 3300))
## Wrong assignments.
pks <- chromPeaks(xod_x)
pks[1, "sample"] <- 40
expect_error(chromPeaks(xod) <- pks)
## featureDefinitions
expect_true(!hasFeatures(xod))
fd <- featureDefinitions(xod_xg)
fd$ms_level <- 2L
featureDefinitions(xod) <- fd
expect_true(hasChromPeaks(xod))
expect_true(hasFeatures(xod))
expect_true(hasFeatures(xod, msLevel = 2L))
expect_equal(featureDefinitions(xod), fd)
expect_true(nrow(featureDefinitions(xod, msLevel = 2L)) > 0)
fd$ms_level <- 1L
featureDefinitions(xod) <- fd
expect_true(nrow(featureDefinitions(xod, msLevel = 2L)) == 0)
expect_false(hasFeatures(xod, msLevel = 2L))
## featureDefinitions with mz and/or rt range:
obj <- xod_xgrg
feat_def <- featureDefinitions(obj)
## Within
mzr <- c(300, 330)
keep_mz <- feat_def$mzmin > mzr[1] & feat_def$mzmax < mzr[2]
expect_equal(featureDefinitions(obj, mz = mzr, type = "within"),
feat_def[keep_mz, ])
rtr <- c(3000, 3800)
keep_rt <- feat_def$rtmin > rtr[1] & feat_def$rtmax < rtr[2]
expect_equal(featureDefinitions(obj, rt = rtr, type = "within"),
feat_def[keep_rt, ])
expect_equal(featureDefinitions(obj, rt = rtr, mz = mzr,
type = "within"),
feat_def[keep_rt & keep_mz, ])
## Any
mzr <- range(featureDefinitions(obj)[2, "mzmed"])
## Defining all possible cases; the internal function uses more cleverer
## approach.
keep_mz <- (feat_def$mzmax >= mzr[1] & feat_def$mzmax <= mzr[2]) |
(feat_def$mzmin >= mzr[1] & feat_def$mzmin <= mzr[2]) |
(feat_def$mzmin <= mzr[1] & feat_def$mzmax >= mzr[2])
expect_equal(featureDefinitions(obj, mz = mzr, type = "any"),
feat_def[keep_mz, , drop = FALSE])
rtr <- range(c(3420, 3430))
keep_rt <- (feat_def$rtmax >= rtr[1] & feat_def$rtmax <= rtr[2]) |
(feat_def$rtmin >= rtr[1] & feat_def$rtmin <= rtr[2]) |
(feat_def$rtmin <= rtr[1] & feat_def$rtmax >= rtr[2])
expect_true(nrow(featureDefinitions(obj, rt = rtr, type = "within")) == 1)
expect_equal(featureDefinitions(obj, rt = rtr, type = "any"),
feat_def[keep_rt, , drop = FALSE])
expect_equal(featureDefinitions(obj, rt = rtr, mz = mzr, type = "any"),
feat_def[keep_rt & keep_mz, , drop = FALSE])
## adjustedRtime
expect_true(!hasAdjustedRtime(xod))
expect_true(hasAdjustedRtime(xod_r))
suppressWarnings(expect_equal(adjustedRtime(xod), NULL))
expect_equal(rtime(xod_r, adjusted = FALSE), rtime(xod))
expect_equal(rtime(xod_r), adjustedRtime(xod_r))
expect_true(is.character(all.equal(rtime(xod_r), rtime(xod_r, adjusted = FALSE))))
## Indirect test that the ordering of the adjusted retention times matches
## ordering of rtime.
## From MSnbase version >= 2.3.9 values are ordered first by file then by
## spectrum.
if (grepl("^F", names(rtime(xod_r)[1]))) {
rts_by_sample <- adjustedRtime(xod_r, bySample = TRUE)
rts <- adjustedRtime(xod_r)
expect_equal(unname(rts_by_sample[[2]]),
unname(rts[grep(names(rts), pattern = "F2")]))
expect_equal(unname(unlist(rts_by_sample)),
unname(rts))
}
xod2 <- xod_r
## Wrong assignments.
expect_error(adjustedRtime(xod2) <- faahko_xsg@rt$corrected[1:2])
## bracket subset
tmp <- xod2[1]
expect_true(length(tmp[[1]]) == 1)
expect_true(length(xod2[[1]]) == 1)
})
test_that("findChromPeaks,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## Call findChromPeaks on an XCMSnExp
tmp <- findChromPeaks(filterFile(xod_x, 1),
param = CentWaveParam(noise = 10000,
snthresh = 40,
prefilter = c(3, 10000)))
expect_equal(unname(chromPeaks(tmp)), unname(chromPeaks(filterFile(xod_x, 1))))
## Check that it works also on adjusted retention times:
tmp <- findChromPeaks(xod_r, param = CentWaveParam(noise = 10000,
snthresh = 40,
prefilter = c(3, 10000)))
expect_true(hasAdjustedRtime(tmp))
expect_equal(
length(processHistory(tmp, type = .PROCSTEP.RTIME.CORRECTION)),1)
expect_true(sum(chromPeaks(tmp)[, "rt"] != chromPeaks(xod_x)[, "rt"]) >
ncol(chromPeaks(tmp)))
tmp_sub <- filterFile(xod_r, file = 1, keepAdjustedRtime = TRUE)
expect_equal(rtime(tmp_sub, adjusted = TRUE),
rtime(xod_r, bySample = TRUE, adjusted = TRUE)[[1]])
spctr <- spectra(tmp_sub)
mz_values <- lapply(spctr, mz)
int_values <- unlist(lapply(spctr, intensity))
res_2 <- do_findChromPeaks_centWave(mz = unlist(mz_values),
int = int_values,
scantime = rtime(tmp_sub,
adjusted = TRUE),
valsPerSpect = lengths(mz_values),
noise = 10000, snthresh = 40)
pks <- chromPeaks(tmp)
rownames(pks) <- NULL
pks <- pks[pks[, "sample"] == 1, colnames(res_2)]
expect_equal(res_2, pks)
## Adding peak detection results
res <- findChromPeaks(
xod_x, param = CentWaveParam(noise = 8000, snthresh = 40,
prefilter = c(3, 8000),
verboseColumns = TRUE), add = TRUE)
expect_true(length(processHistory(res)) ==
(length(processHistory(xod_x)) + 1))
expect_true(nrow(chromPeaks(res)) > nrow(chromPeaks(xod_x)))
expect_true(ncol(chromPeaks(res)) > ncol(chromPeaks(xod_x)))
expect_true(length(unique(rownames(chromPeaks(res)))) == nrow(chromPeaks(res)))
})
test_that("processHistory,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
ph <- ProcessHistory(fileIndex. = 2, info. = "For file 2")
ph_2 <- ProcessHistory(fileIndex. = 1:2, info. = "For files 1 to 2")
xod <- as(od_x, "XCMSnExp")
xod@.processHistory <- list(ph, ph_2)
expect_equal(processHistory(xod), list(ph, ph_2))
expect_equal(processHistory(xod, fileIndex = 2), list(ph, ph_2))
expect_equal(processHistory(xod, fileIndex = 1), list(ph_2))
expect_error(processHistory(xod, fileIndex = 5))
ph_3 <- XProcessHistory(fileIndex = 1, param = CentWaveParam())
xod <- addProcessHistory(xod, ph_3)
expect_equal(length(processHistory(xod)), 3)
expect_equal(processHistory(xod)[[3]], ph_3)
expect_equal(processHistory(xod, fileIndex = 1), list(ph_2, ph_3))
expect_true(validObject(xod))
})
test_that("dropChromPeaks,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## 1) dropDetectedFeatures: delete all process history steps and all data.
res <- dropChromPeaks(xod_x)
expect_true(!hasChromPeaks(res))
expect_true(.has_chrom_peak_data(xod_x@msFeatureData))
expect_false(.has_chrom_peak_data(res@msFeatureData))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
##
res <- dropChromPeaks(xod_xg)
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
##
res <- dropChromPeaks(xod_xgr)
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
expect_true(!hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 0)
expect_equal(rtime(res), rtime(od_x))
res <- dropChromPeaks(xod_xgr, keepAdjustedRtime = TRUE)
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
expect_true(hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 1)
expect_equal(rtime(res), rtime(xod_xgr))
##
res <- dropChromPeaks(xod_xgrg)
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.FEATURE.GROUPING)) == 0)
expect_true(!hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 0)
expect_equal(rtime(res), rtime(od_x))
res <- dropChromPeaks(xod_xgrg, keepAdjustedRtime = TRUE)
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
expect_true(hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 1)
expect_equal(rtime(res), rtime(xod_xgrg))
})
test_that("dropFeatureDefinitions,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## 2) dropFeatureDefinitions:
## a) drop the feature groups and the latest related process history
## b) if retention time correction was performed AFTER the latest feature
## grouping, drop also the retention time correction and all related
## process histories.
res <- dropFeatureDefinitions(xod_x)
expect_equal(res, xod_x)
res <- dropFeatureDefinitions(xod_xg)
expect_equal(res, xod_x)
## Remove the latest ones.
res <- dropFeatureDefinitions(xod_xgrg)
expect_equal(res, xod_xgr)
expect_true(!hasFeatures(res))
expect_true(hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 1)
expect_equal(rtime(res, adjusted = FALSE), rtime(od_x))
expect_equal(rtime(res, adjusted = TRUE), rtime(xod_xgr))
})
test_that("dropAdjustedRtime,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## 3) dropAdjustedRtime:
## a) drop the retention time adjustment and related process histories
## b) if grouping has been performed AFTER retention time correction,
## drop the feature alignment and all related process histories.
## c) if grouping has been performed BEFORE retention time correction,
## do nothing.
res <- dropAdjustedRtime(xod_xg)
expect_equal(res, xod_xg)
## This drops also the process history for alignment.
res <- dropAdjustedRtime(xod_xgr)
expect_true(hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 0)
expect_true(!hasAdjustedRtime(res))
expect_equal(chromPeaks(res), chromPeaks(xod_x))
expect_equal(rtime(res), rtime(xod_xgr, adjusted = FALSE))
## expect_equal(res, xod_x)
## This drops also the feature alignment performed later.
res <- dropAdjustedRtime(xod_xgrg)
expect_true(hasChromPeaks(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.DETECTION)) == 1)
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = .PROCSTEP.PEAK.GROUPING)) == 0)
expect_true(!hasAdjustedRtime(res))
expect_true(length(processHistory(res, type = .PROCSTEP.RTIME.CORRECTION)) == 0)
expect_equal(chromPeaks(res), chromPeaks(xod_x))
## expect_equal(res, xod_x)
expect_equal(rtime(res), rtime(xod_xgrg, adjusted = FALSE))
})
test_that("XCMSnExp inherited methods work", {
skip_on_os(os = "windows", arch = "i386")
## [
tmp_1 <- faahko_od[1:10]
tmp_2 <- xod_x[1:10]
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
expect_error(xod_r[1, 1])
idxs <- c(1432, 1621, 2492, 3001, 3013)
tmp <- xod_r[idxs]
expect_true(length(tmp) == length(idxs))
expect_equal(mz(xod_r)[idxs], mz(tmp))
expect_true(hasAdjustedRtime(xod_r) != hasAdjustedRtime(tmp))
## keeping adjusted retention times:
tmp <- xod_r[idxs, keepAdjustedRtime = TRUE]
expect_true(hasAdjustedRtime(tmp))
expect_equal(rtime(xod_r)[idxs], rtime(tmp))
expect_true(length(processHistory(tmp, type = .PROCSTEP.RTIME.CORRECTION)) == 0)
## Same with object containing also peaks and features
tmp <- xod_xgrg[idxs]
expect_true(!hasAdjustedRtime(tmp))
expect_true(!hasChromPeaks(tmp))
expect_true(!hasFeatures(tmp))
tmp <- xod_xgrg[idxs, keepAdjusted = TRUE]
expect_true(hasAdjustedRtime(tmp))
expect_equal(rtime(xod_xgrg)[idxs], rtime(tmp))
expect_true(length(processHistory(tmp)) == 0)
## [[
spct <- xod_x[[13]]
expect_true(is(spct, "Spectrum1"))
expect_equal(rtime(spct), unname(rtime(xod_x)[13]))
expect_equal(mz(spct), mz(xod_x)[[13]])
## Have to ensure that, if x has adjusted retention times, that these are
## reported in the Spectrum.
spct <- xod_r[[13]]
expect_equal(rtime(spct), unname(rtime(xod_r, adjusted = TRUE)[13]))
expect_true(rtime(spct) != rtime(xod_r, adjusted = FALSE)[13])
## bin
tmp_1 <- bin(faahko_od, binSize = 20)
expect_warning(tmp_2 <- bin(xod_x, binSize = 20))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## clean
tmp_1 <- clean(faahko_od)
expect_warning(tmp_2 <- clean(xod_x))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## filterAcquisitionNum
tmp_1 <- filterAcquisitionNum(faahko_od)
expect_warning(tmp_2 <- filterAcquisitionNum(xod_x))
expect_true(length(tmp_2[[1]]) > 0)
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## filterMsLevel
tmp_1 <- filterMsLevel(faahko_od)
tmp_2 <- filterMsLevel(xod_x)
expect_equal(tmp_2, xod_x)
expect_equal(length(filterMsLevel(xod_x, msLevel = 2)), 0)
## If we've got adjusted retention times, keep them.
tmp_1 <- filterMsLevel(xod_xgr, msLevel = 1)
expect_true(hasAdjustedRtime(tmp_1))
expect_equal(rtime(tmp_1), rtime(xod_xgr)) # adjusted rt present
tmp_1 <- filterMsLevel(xod_xgrg, msLevel = 1,
keepAdjustedRtime = FALSE)
expect_true(!hasAdjustedRtime(tmp_1))
expect_equal(rtime(tmp_1), rtime(xod_xgr, adjusted = FALSE))
## normalize
tmp_1 <- normalize(faahko_od)
expect_warning(tmp_2 <- normalize(xod_x))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## pickPeaks
tmp_1 <- pickPeaks(faahko_od)
expect_warning(tmp_2 <- pickPeaks(xod_x))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## removePeaks
tmp_1 <- removePeaks(faahko_od)
expect_warning(tmp_2 <- removePeaks(xod_x))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
## smooth
tmp_1 <- smooth(faahko_od)
expect_warning(tmp_2 <- smooth(xod_x))
expect_true(length(processHistory(tmp_2)) == 0)
expect_true(!hasChromPeaks(tmp_2))
tmp_1@processingData <- new("MSnProcess")
tmp_2@processingData <- new("MSnProcess")
expect_equal(tmp_1, as(tmp_2, "OnDiskMSnExp"))
})
test_that("filterFile,XCMSnExp and .filter_file_XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## filterFile
tmp <- filterFile(xod_x, file = 2)
expect_error(tmp@msFeatureData$bla <- 3)
expect_true(!hasAdjustedRtime(tmp))
expect_true(!hasFeatures(tmp))
expect_true(all(chromPeaks(tmp)[, "sample"] == 1))
expect_equal(chromPeaks(tmp)[, colnames(chromPeaks(tmp)) != "sample"],
chromPeaks(xod_x)[chromPeaks(xod_x)[, "sample"] == 2,
colnames(chromPeaks(xod_x)) != "sample"])
expect_true(length(processHistory(tmp)) == 1)
## expect_equal(fileIndex(processHistory(tmp)[[1]]), 1)
## check with other index.
tmp <- filterFile(xod_x, file = c(1, 3))
expect_true(length(tmp[[1]]) == 1)
expect_true(!hasAdjustedRtime(tmp))
expect_true(!hasFeatures(tmp))
expect_true(all(chromPeaks(tmp)[, "sample"] %in% c(1, 2)))
a <- chromPeaks(tmp)
b <- chromPeaks(xod_x)
expect_equal(a[, colnames(a) != "sample"],
b[b[, "sample"] %in% c(1, 3), colnames(b) != "sample"])
expect_true(length(processHistory(tmp)) == 1)
## expect_equal(fileIndex(processHistory(tmp)[[1]]), c(1, 2))
## Errors
expect_error(filterFile(xod_x, file = 5))
expect_error(filterFile(xod_x, file = 1:5))
## Little mockup to check correctness of Process history.
od_2 <- xod_x
od_2 <- addProcessHistory(
od_2, ProcessHistory(type = .PROCSTEP.RTIME.CORRECTION))
od_2 <- addProcessHistory(
od_2, ProcessHistory(type = .PROCSTEP.UNKNOWN,
fileIndex = 2,
info. = "I should be here"))
od_2 <- addProcessHistory(
od_2, ProcessHistory(type = .PROCSTEP.UNKNOWN,
fileIndex = 1, info. = "EEEEEE"))
tmp <- filterFile(od_2, file = 2)
ph <- processHistory(tmp)
expect_true(length(ph) == 4)
expect_equal(processType(ph[[3]]), .PROCSTEP.UNKNOWN)
b <- unlist(lapply(ph, function(z) {
processInfo(z) == "I should be here"
}))
expect_true(any(b))
b <- unlist(lapply(ph, function(z) {
processInfo(z) == "EEEEEE"
}))
## expect_true(!any(b))
## Do filterFile on xod_xg
res <- filterFile(xod_xg, file = 2)
expect_true(hasChromPeaks(res))
expect_true(!hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
tmp <- chromPeaks(xod_xg)
expect_equal(chromPeaks(res)[, colnames(chromPeaks(res)) != "sample"],
tmp[tmp[, "sample"] == 2, colnames(tmp) != "sample"])
expect_equal(rtime(res), rtime(xod_xg, bySample = TRUE)[[2]])
## with keepFeatures = TRUE
res <- .filter_file_XCMSnExp(xod_xg, file = 2, keepFeatures = TRUE)
expect_true(hasChromPeaks(res))
expect_true(hasFeatures(res))
fvals <- featureValues(xod_xg)[, 2, drop = FALSE]
expect_equal(featureValues(res), fvals[!is.na(fvals[,1]), , drop = FALSE])
res <- filterFile(xod_xg, file = c(1, 3), keepFeatures = TRUE)
expect_true(hasFeatures(res))
fvals <- featureValues(xod_xg)[, c(1, 3)]
expect_equal(featureValues(res), fvals)
## Do filterFile on xod_xgr
## Should remove adjusted rts and revert the original peak rts.
res <- .filter_file_XCMSnExp(xod_xgr, keepAdjustedRtime = FALSE, file = 2)
expect_true(hasChromPeaks(res))
tmp <- chromPeaks(xod_xg)
expect_equal(chromPeaks(res)[, colnames(chromPeaks(res)) != "sample"],
tmp[tmp[, "sample"] == 2, colnames(tmp) != "sample"])
expect_equal(rtime(res), rtime(xod_xg, bySample = TRUE)[[2]])
expect_true(!hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 3)
expect_equal(processType(processHistory(res)[[1]]), "Peak detection")
## The same but keep the adjusted retention times.
res <- .filter_file_XCMSnExp(xod_xgr, file = 2, keepAdjustedRtime = TRUE)
expect_true(hasChromPeaks(res))
tmp <- chromPeaks(xod_xgr)
expect_equal(chromPeaks(res)[, colnames(chromPeaks(res)) != "sample"],
tmp[tmp[, "sample"] == 2, colnames(tmp) != "sample"])
## has to be different from the ones in xod_x
tmp <- chromPeaks(xod_x)
expect_true(sum(chromPeaks(res)[, "rt"] == tmp[tmp[, "sample"] == 2, "rt"]) <
nrow(tmp) / 4)
expect_equal(rtime(res), rtime(xod_xgr, bySample = TRUE)[[2]])
expect_equal(adjustedRtime(res), adjustedRtime(xod_xgr, bySample = TRUE)[[2]])
expect_true(hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 3)
expect_equal(processType(processHistory(res)[[1]]), "Peak detection")
expect_equal(processType(processHistory(res)[[2]]), "Peak grouping")
expect_equal(processType(processHistory(res)[[3]]), "Retention time correction")
res <- filterFile(xod_xgr, file = 2:3)
expect_true(hasAdjustedRtime(res))
expect_equal(adjustedRtime(xod_xgr, bySample = TRUE)[[2]],
adjustedRtime(res, bySample = TRUE)[[1]])
expect_equal(adjustedRtime(xod_xgr, bySample = TRUE)[[3]],
adjustedRtime(res, bySample = TRUE)[[2]])
## Do filterFile on xod_xgrg
res <- filterFile(xod_xgrg, keepAdjustedRtime = FALSE, file = c(1, 3))
expect_true(hasChromPeaks(res))
tmp <- chromPeaks(xod_x)
expect_equal(chromPeaks(res)[, colnames(chromPeaks(res)) != "sample"],
tmp[tmp[, "sample"] %in% c(1, 3), colnames(tmp) != "sample"])
expect_equal(unname(rtime(res, bySample = TRUE)),
unname(rtime(xod_xg, bySample = TRUE)[c(1, 3)]))
expect_true(!hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 3)
expect_equal(processType(processHistory(res)[[1]]), "Peak detection")
## keep adjusted rtime
res <- filterFile(xod_xgrg, file = c(1, 3), keepAdjustedRtime = TRUE)
expect_true(hasChromPeaks(res))
tmp <- chromPeaks(xod_xgr)
expect_equal(chromPeaks(res)[, colnames(chromPeaks(res)) != "sample"],
tmp[tmp[, "sample"] %in% c(1, 3), colnames(tmp) != "sample"])
## has to be different from the ones in xod_x
tmp <- chromPeaks(xod_x)
expect_true(sum(chromPeaks(res)[, "rt"] == tmp[tmp[, "sample"] %in% c(1, 3), "rt"]) <
nrow(tmp) / 4)
expect_equal(rtime(res, bySample = TRUE),
rtime(xod_xgr, bySample = TRUE)[c(1, 3)])
expect_equal(adjustedRtime(res, bySample = TRUE),
adjustedRtime(xod_xgr, bySample = TRUE)[c(1, 3)])
expect_true(hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 3)
expect_equal(processType(processHistory(res)[[1]]), "Peak detection")
expect_equal(processType(processHistory(res)[[2]]), "Peak grouping")
expect_equal(processType(processHistory(res)[[3]]), "Retention time correction")
## keep also features
res <- filterFile(xod_xgrg, file = c(1, 3), keepFeatures = TRUE)
expect_true(hasFeatures(res))
expect_equal(featureValues(res), featureValues(xod_xgrg)[, c(1, 3)])
})
test_that("filterMz,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## subset on xod_x
res <- filterMz(xod_x, mz = c(300, 400))
expect_true(length(res[[1]]) == 1)
expect_true(length(res@spectraProcessingQueue) == 1)
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 300 & chromPeaks(res)[, "mz"] <= 400))
expect_true(nrow(chromPeaks(res)) < nrow(chromPeaks(xod_x)))
idx <- which(chromPeaks(xod_x)[, "mzmin"] >= 300 &
chromPeaks(xod_x)[, "mzmax"] <= 400)
expect_equal(chromPeaks(res), chromPeaks(xod_x)[idx, ])
expect_true(!hasAdjustedRtime(res))
expect_true(!hasFeatures(res))
## subset on xod_xg
res <- filterMz(xod_xg, mz = c(300, 400))
expect_true(validObject(res))
expect_true(length(res[[1]]) == 1)
expect_true(length(res@spectraProcessingQueue) == 1)
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 300 & chromPeaks(res)[, "mz"] <= 400))
expect_true(nrow(chromPeaks(res)) < nrow(chromPeaks(xod_x)))
idx <- which(chromPeaks(xod_xg)[, "mzmin"] >= 300 &
chromPeaks(xod_xg)[, "mzmax"] <= 400)
expect_equal(chromPeaks(res), chromPeaks(xod_xg)[idx, ])
expect_true(!hasAdjustedRtime(res))
expect_true(hasFeatures(res))
expect_true(nrow(featureDefinitions(res)) < nrow(featureDefinitions(xod_xg)))
expect_true(all(featureDefinitions(res)[, "mzmed"] >= 300 &
featureDefinitions(res)[, "mzmed"] <= 400))
expect_true(all(featureDefinitions(res)[, "mzmin"] >= 300 &
featureDefinitions(res)[, "mzmin"] <= 400))
expect_true(all(featureDefinitions(res)[, "mzmax"] >= 300 &
featureDefinitions(res)[, "mzmax"] <= 400))
## subset on xod_xgr
## o keep chromPeaks
## o keep adjusted rtime
res <- filterMz(xod_xgr, mz = c(300, 400))
expect_true(validObject(res))
expect_true(length(res[[1]]) == 1)
expect_true(length(res@spectraProcessingQueue) == 1)
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 300 & chromPeaks(res)[, "mz"] <= 400))
expect_true(nrow(chromPeaks(res)) < nrow(chromPeaks(xod_x)))
idx <- which(chromPeaks(xod_xgr)[, "mzmin"] >= 300 &
chromPeaks(xod_xgr)[, "mzmax"] <= 400)
expect_equal(chromPeaks(res), chromPeaks(xod_xgr)[idx, ])
expect_true(hasAdjustedRtime(res))
expect_equal(adjustedRtime(res), adjustedRtime(xod_xgr))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 3)
## subset xod_xgrg
res <- filterMz(xod_xgrg, mz = c(300, 400))
expect_true(validObject(res))
expect_true(length(res[[1]]) == 1)
expect_true(length(res@spectraProcessingQueue) == 1)
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 300 & chromPeaks(res)[, "mz"] <= 400))
expect_true(nrow(chromPeaks(res)) < nrow(chromPeaks(xod_xgrg)))
idx <- which(chromPeaks(xod_xgrg)[, "mzmin"] >= 300 &
chromPeaks(xod_xgrg)[, "mzmax"] <= 400)
expect_equal(chromPeaks(res), chromPeaks(xod_xgrg)[idx, ])
expect_true(hasAdjustedRtime(res))
expect_equal(adjustedRtime(res), adjustedRtime(xod_xgrg))
expect_true(hasFeatures(res))
expect_true(nrow(featureDefinitions(res)) < nrow(featureDefinitions(xod_xgrg)))
expect_true(all(featureDefinitions(res)[, "mzmed"] >= 300 &
featureDefinitions(res)[, "mzmed"] <= 400))
expect_true(all(featureDefinitions(res)[, "mzmin"] >= 300 &
featureDefinitions(res)[, "mzmin"] <= 400))
expect_true(all(featureDefinitions(res)[, "mzmax"] >= 300 &
featureDefinitions(res)[, "mzmax"] <= 400))
## With groups - no groups within this range
mzr <- c(595, 600)
res <- filterMz(xod_xg, mz = mzr)
expect_true(!hasFeatures(res))
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 595 & chromPeaks(res)[, "mz"] <= 600))
res <- filterMz(xod_xgrg, mz = mzr)
expect_true(!hasFeatures(res))
expect_true(hasChromPeaks(res))
expect_true(all(chromPeaks(res)[, "mz"] >= 595 & chromPeaks(res)[, "mz"] <= 600))
})
test_that("filterRt,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## xod_x
res <- filterRt(xod_x, rt = c(2700, 2900))
## Check if the object is OK:
expect_equal(pData(res), pData(xod_x))
spct <- spectra(res)
expect_true(length(spct) > 0)
## MsFeatureData has to be locked!
expect_error(res@msFeatureData$bla <- 3)
## Retention time has to be within the range.
expect_true(all(rtime(res) >= 2700 & rtime(res) <= 2900))
rtm <- unlist(lapply(spct, rtime))
expect_true(all(rtm >= 2700 & rtm <= 2900))
## peaks have to be within the range.
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_x)[, "rt"] >= 2700 &
chromPeaks(xod_x)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_x)[are_within,])
## Have a feature detection process history.
expect_equal(length(processHistory(res)), 1)
expect_equal(processType(processHistory(res)[[1]]),
.PROCSTEP.PEAK.DETECTION)
## filter such that we keep some spectra but no chromPeaks:
res <- filterRt(xod_x, rt = c(4200, 4400))
expect_true(all(rtime(res) >= 4200 & rtime(res) <= 4400))
expect_true(!hasChromPeaks(res))
expect_true(length(processHistory(res)) == 0)
## No rt
res <- filterRt(xod_x, rt = c(10, 20))
expect_true(length(res) == 0)
## xod_xg
## o keep also the feature groups that are within the window.
res <- filterRt(xod_xg, rt = c(2700, 2900))
expect_true(all(rtime(res) >= 2700 & rtime(res) <= 2900))
expect_equal(hasChromPeaks(res), hasChromPeaks(xod_xg))
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_x)[, "rt"] >= 2700 &
chromPeaks(xod_x)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_xg)[are_within,])
expect_true(!hasAdjustedRtime(res))
expect_true(hasFeatures(res))
expect_true(all(featureDefinitions(res)$rtmed >= 2700 &
featureDefinitions(res)$rtmed <= 2900))
expect_true(nrow(featureDefinitions(res)) < nrow(featureDefinitions(xod_xg)))
expect_true(length(processHistory(res)) == 2)
expect_true(length(processHistory(res, type = "Peak detection")) == 1)
expect_true(length(processHistory(res, type = "Peak grouping")) == 1)
## All feature idx have to match.
expect_true(all(unlist(featureDefinitions(res)$peakidx) %in%
1:nrow(chromPeaks(res))))
## Filter such that we don't have any chromPeaks.
res <- filterRt(xod_xg, rt = c(4200, 4400))
expect_true(all(rtime(res) >= 4200 & rtime(res) <= 4400))
expect_true(!hasChromPeaks(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 0)
## No rt
res <- filterRt(xod_xg, rt = c(10, 20))
expect_true(length(res) == 0)
## xod_xgr
res <- filterRt(xod_xgr, rt = c(2700, 2900))
expect_true(all(rtime(res) >= 2700 & rtime(res) <= 2900))
expect_equal(hasChromPeaks(res), hasChromPeaks(xod_xg))
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_xgr)[, "rt"] >= 2700 &
chromPeaks(xod_xgr)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_xgr)[are_within,])
expect_true(hasAdjustedRtime(res))
expect_true(all(adjustedRtime(res) >= 2700 & adjustedRtime(res) <= 2900))
expect_true(!all(rtime(res, adjusted = FALSE) >= 2700 &
rtime(res, adjusted = FALSE) <= 2900))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res, type = "Peak detection")) == 1)
expect_true(length(processHistory(res, type = "Peak grouping")) == 1)
expect_true(length(processHistory(res, type = "Retention time correction")) == 1)
## Filter such that we don't have any chromPeaks.
res <- filterRt(xod_xgr, rt = c(4200, 4400), adjusted = TRUE)
expect_true(hasAdjustedRtime(res))
expect_true(all(adjustedRtime(res) >= 4200 & adjustedRtime(res) <= 4400))
expect_true(all(rtime(res) >= 4200 & rtime(res) <= 4400))
expect_true(!all(rtime(res, adjusted = FALSE) >= 4200 &
rtime(res, adjusted = FALSE) <= 4400))
expect_true(!hasChromPeaks(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 1)
expect_true(length(processHistory(res, type = "Retention time correction")) == 1)
## No rt
res <- filterRt(xod_xgr, rt = c(10, 20))
expect_true(length(res) == 0)
## filter using raw rt
res <- filterRt(xod_xgr, rt = c(2700, 2900), adjusted = FALSE)
expect_true(!all(rtime(res) >= 2700 & rtime(res) <= 2900))
expect_equal(hasChromPeaks(res), hasChromPeaks(xod_xg))
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_xgr)[, "rt"] >= 2700 &
chromPeaks(xod_xgr)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_xgr)[are_within,])
expect_true(hasAdjustedRtime(res))
expect_true(!all(adjustedRtime(res) >= 2700 & adjustedRtime(res) <= 2900))
expect_true(all(rtime(res, adjusted = FALSE) >= 2700 &
rtime(res, adjusted = FALSE) <= 2900))
expect_true(!hasFeatures(res))
## xod_xgrg
res <- filterRt(xod_xgrg, rt = c(2700, 2900))
expect_true(all(rtime(res) >= 2700 & rtime(res) <= 2900))
expect_equal(hasChromPeaks(res), hasChromPeaks(xod_xg))
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_xgrg)[, "rt"] >= 2700 &
chromPeaks(xod_xgr)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_xgrg)[are_within,])
expect_true(hasAdjustedRtime(res))
expect_true(all(adjustedRtime(res) >= 2700 & adjustedRtime(res) <= 2900))
expect_true(!all(rtime(res, adjusted = FALSE) >= 2700 &
rtime(res, adjusted = FALSE) <= 2900))
expect_true(length(processHistory(res, type = "Peak detection")) == 1)
expect_true(length(processHistory(res, type = "Peak grouping")) == 2)
expect_true(length(processHistory(res, type = "Retention time correction")) == 1)
expect_true(hasFeatures(res))
expect_true(all(featureDefinitions(res)$rtmed >= 2700 &
featureDefinitions(res)$rtmed <= 2900))
## Filter such that we don't have any chromPeaks.
res <- filterRt(xod_xgrg, rt = c(4200, 4400), adjusted = TRUE)
expect_true(hasAdjustedRtime(res))
expect_true(all(adjustedRtime(res) >= 4200 & adjustedRtime(res) <= 4400))
expect_true(all(rtime(res) >= 4200 & rtime(res) <= 4400))
expect_true(!all(rtime(res, adjusted = FALSE) >= 4200 &
rtime(res, adjusted = FALSE) <= 4400))
expect_true(!hasChromPeaks(res))
expect_true(!hasFeatures(res))
expect_true(length(processHistory(res)) == 1)
expect_true(length(processHistory(res, type = "Retention time correction")) == 1)
## No rt
res <- filterRt(xod_xgrg, rt = c(10, 20))
expect_true(length(res) == 0)
## filter using raw rt
res <- filterRt(xod_xgrg, rt = c(2700, 2900), adjusted = FALSE)
expect_true(!all(rtime(res) >= 2700 & rtime(res) <= 2900))
expect_equal(hasChromPeaks(res), hasChromPeaks(xod_xg))
expect_true(all(chromPeaks(res)[, "rt"] >= 2700 &
chromPeaks(res)[, "rt"] <= 2900))
are_within <- chromPeaks(xod_xgrg)[, "rt"] >= 2700 &
chromPeaks(xod_xgrg)[, "rt"] <= 2900
expect_equal(chromPeaks(res), chromPeaks(xod_xgrg)[are_within,])
expect_true(hasAdjustedRtime(res))
expect_true(!all(adjustedRtime(res) >= 2700 & adjustedRtime(res) <= 2900))
expect_true(all(rtime(res, adjusted = FALSE) >= 2700 &
rtime(res, adjusted = FALSE) <= 2900))
expect_true(hasFeatures(res))
expect_true(all(featureDefinitions(res)$rtmed >= 2700 &
featureDefinitions(res)$rtmed <= 2900))
})
## Test the coercion method.
test_that("as,XCMSnExp,xcmsSet works", {
skip_on_os(os = "windows", arch = "i386")
od_x <- faahko_xod
res <- .XCMSnExp2xcmsSet(od_x)
res <- as(od_x, "xcmsSet")
## Results should be the same as in xs.
expect_equal(res@peaks, chromPeaks(od_x))
expect_equal(res@.processHistory, processHistory(od_x))
expect_equal(phenoData(res), pData(od_x))
expect_equal(filepaths(res), fileNames(od_x))
expect_equal(res@rt$raw, res@rt$corrected)
expect_equal(res@rt$raw, rtime(od_x, bySample = TRUE))
expect_equal(profMethod(res), "bin")
expect_equal(profStep(res), 0.1)
## Can we further process this?
sampclass(res) <- rep("K", 3)
res <- group.density(res, minfrac = 0.5)
## res <- fillPeaks(res)
## Add groups.
od_2 <- groupChromPeaks(
od_x,
param = PeakDensityParam(sampleGroups =rep(1, length(fileNames(od_x)))))
expect_equal(unname(featureDefinitions(od_2)$peakidx), groupidx(res))
## rt correction
od_3 <- adjustRtime(od_2, param = PeakGroupsParam(minFraction = 1,
span = 0.4))
## With groups.
res <- as(od_2, "xcmsSet")
ftDef <- featureDefinitions(od_2)[, !names(featureDefinitions(od_2))%in%"peakidx"]
ftDef <- S4Vectors::as.matrix(ftDef)
rownames(ftDef) <- NULL
expect_equal(res@groups, ftDef)
expect_equal(res@groupidx, unname(featureDefinitions(od_2)$peakidx))
expect_equivalent(groupval(res), featureValues(od_2, value = "index"))
## With adjusted retention time.
res_2 <- retcor.peakgroups(res, missing = 0, span = 0.4)
res <- as(od_3, "xcmsSet")
expect_true(any(unlist(res@rt$raw) != unlist(res@rt$corrected)))
expect_equal(res@rt$corrected, res_2@rt$corrected)
expect_equal(chromPeaks(od_3), peaks(res))
expect_equal(peaks(res_2), peaks(res))
## Test with different binning methods:
## o binlin
mfp <- MatchedFilterParam(impute = "lin", binSize = 3)
od_2 <- od_x
processParam(od_2@.processHistory[[1]]) <- mfp
res <- as(od_2, "xcmsSet")
expect_equal(profStep(res), 3)
expect_equal(profMethod(res), "binlin")
## o binlinbase
mfp <- MatchedFilterParam(impute = "linbase", binSize = 2)
processParam(od_2@.processHistory[[1]]) <- mfp
expect_warning(res <- as(od_2, "xcmsSet"))
expect_equal(profStep(res), 2)
expect_equal(profMethod(res), "binlinbase")
# Tests for issue https://github.com/sneumann/xcms/issues/464
res <- as(xod_xgrg, "xcmsSet")
expect_type(groups(res), "double")
})
test_that("chromatogram,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## Have: od_x: OnDiskMSNnExp
## xod_x: XCMSnExp, with detected chromPeaks.
## xod_xg: with feature groups.
## xod_xgr: with adjusted retention times (no feature groups)
## xod_xgrg: adjusted rt and feature groups.
## XCMSnExp: TIC - can NOT compare with the reported TIC, as that is
## different! Eventually some background adjustment performed?
## BPC - CDF don't habe a BPC.
rtr <- c(2600, 2700)
tmp_obj <- filterFile(xod_x, file = c(1, 2))
res <- chromatogram(tmp_obj, aggregationFun = "max", rt = rtr)
expect_true(is(res, "XChromatograms"))
chromPeaks(res)
cpks <- chromPeaks(tmp_obj, rt = rtr, type = "apex_within")
expect_equal(cpks, chromPeaks(res)[, 1:ncol(cpks)])
expect_true(all(rtime(res[1, 1]) >= rtr[1]))
expect_true(all(rtime(res[1, 1]) <= rtr[2]))
expect_true(all(rtime(res[1, 2]) >= rtr[1]))
expect_true(all(rtime(res[1, 2]) <= rtr[2]))
tmp <- filterRt(filterFile(xod_x, file = 2), rt = rtr)
expect_equal(rtime(tmp), rtime(res[1, 2]))
ints <- spectrapply(tmp, function(z) return(max(intensity(z))))
expect_equal(unlist(ints), intensity(res[1, 2]))
## Check names
expect_equal(names(rtime(res[1, 1])), names(intensity(res[1, 1])))
## Assure we get the same with an OnDiskMSnExp and grouped XCMSnExp
res_2 <- chromatogram(filterFile(od_x, file = c(1, 2)),
aggregationFun = "max", rt = rtr)
expect_equal(pData(res), pData(res_2))
expect_equal(lapply(res, rtime), lapply(res_2, rtime))
expect_equal(lapply(res, intensity), lapply(res_2, intensity))
res_3 <- chromatogram(filterFile(xod_xg, file = c(1, 2)),
aggregationFun = "max", rt = rtr)
expect_equal(res, res_3)
## XCMSnExp: with mzrange and rtrange:
mzr <- c(120, 130)
tmp <- filterMz(xod_xg, mz = mzr)
expect_warning(fts <- featureDefinitions(tmp))
expect_true(nrow(fts) == 0)
tmp <- filterRt(xod_xg, rt = rtr)
featureDefinitions(tmp)
## no features in mz range
res_2 <- chromatogram(xod_xg, rt = rtr, mz = mzr)
expect_true(nrow(chromPeaks(res_2)) == 0)
expect_true(nrow(featureDefinitions(res_2)) == 0)
##
mzr <- matrix(c(335, 335, 344, 344), ncol = 2, byrow = TRUE)
rtr <- matrix(c(2700, 2900, 2600, 2750), ncol = 2, byrow = TRUE)
xchrs <- chromatogram(xod_chr, mz = mzr, rt = rtr)
expect_equal(nrow(xchrs), 2)
expect_equal(ncol(xchrs), 3)
pks <- chromPeaks(xchrs)
expect_true(all(pks[pks[, "column"] == 1, "sample"] == 1))
expect_true(all(pks[pks[, "column"] == 2, "sample"] == 2))
expect_true(all(pks[pks[, "column"] == 3, "sample"] == 3))
expect_true(all(pks[pks[, "row"] == 1, "rt"] >= rtr[1, 1]))
expect_true(all(pks[pks[, "row"] == 1, "rt"] <= rtr[1, 2]))
expect_true(all(pks[pks[, "row"] == 2, "rt"] >= rtr[2, 1]))
expect_true(all(pks[pks[, "row"] == 2, "rt"] <= rtr[2, 2]))
expect_true(all(pks[pks[, "row"] == 1, "mz"] >= mzr[1, 1]))
expect_true(all(pks[pks[, "row"] == 1, "mz"] <= mzr[1, 2]))
expect_true(all(pks[pks[, "row"] == 2, "mz"] >= mzr[2, 1]))
expect_true(all(pks[pks[, "row"] == 2, "mz"] <= mzr[2, 2]))
## Full rt range
xchrs <- chromatogram(xod_chr, mz = mzr)
pks <- chromPeaks(xchrs)
expect_true(all(pks[pks[, "row"] == 1, "mz"] >= mzr[1, 1]))
expect_true(all(pks[pks[, "row"] == 1, "mz"] <= mzr[1, 2]))
expect_true(all(pks[pks[, "row"] == 2, "mz"] >= mzr[2, 1]))
expect_true(all(pks[pks[, "row"] == 2, "mz"] <= mzr[2, 2]))
expect_equal(chromPeaks(xchrs[1, 1]),
chromPeaks(filterFile(xod_chr, 1), mz = mzr[1, ],
type = "apex_within"))
a <- chromPeaks(xchrs[1, 2])
b <- chromPeaks(filterFile(xod_chr, 2), mz = mzr[1, ], type = "apex_within")
expect_equal(a[, -11], b[, -11])
a <- chromPeaks(xchrs[1, 3])
b <- chromPeaks(filterFile(xod_chr, 3), mz = mzr[1, ], type = "apex_within")
expect_equal(a[, -11], b[, -11])
a <- chromPeaks(xchrs[2, 1])
b <- chromPeaks(filterFile(xod_chr, 1), mz = mzr[2, ], type = "apex_within")
expect_equal(a[, -11], b[, -11])
a <- chromPeaks(xchrs[2, 2])
b <- chromPeaks(filterFile(xod_chr, 2), mz = mzr[2, ], type = "apex_within")
expect_equal(a[, -11], b[, -11])
a <- chromPeaks(xchrs[2, 3])
b <- chromPeaks(filterFile(xod_chr, 3), mz = mzr[2, ], type = "apex_within")
expect_equal(a[, -11], b[, -11])
rtr[1, 1] <- 2785
xchrs <- chromatogram(xod_chr, mz = mzr, rt = rtr)
expect_true(nrow(chromPeaks(xchrs[1, 1])) == 0)
pks <- chromPeaks(xchrs)
expect_true(!any(pks[, "row"] == 1 & pks[, "column"] == 1))
## With filled-in data
mzr <- matrix(c(335, 335, 344, 344), ncol = 2, byrow = TRUE)
rtr <- matrix(c(2700, 2900, 2600, 2750), ncol = 2, byrow = TRUE)
## group
xod_tmp <- groupChromPeaks(
xod_xgr, param = PeakDensityParam(sampleGroups = rep(1, 3),
minFraction = 0.25))
xod_tmpf <- fillChromPeaks(
xod_tmp, param = FillChromPeaksParam(fixedRt = 30))
xchrs <- chromatogram(xod_tmp, mz = mzr[2:1, ], rt = rtr[2:1, ], filled = TRUE)
xchrsf <- chromatogram(xod_tmpf, mz = mzr[2:1, ], rt = rtr[2:1, ], filled = TRUE)
expect_equal(nrow(chromPeaks(xchrs)), 4)
expect_equal(unname(chromPeaks(xchrs)[, "sample"]), c(1, 2, 3, 2))
expect_equal(unname(chromPeaks(xchrs)[, "row"]), c(1, 1, 1, 2))
## With filled-in peaks.
expect_equal(nrow(chromPeaks(xchrsf)), 6)
expect_equal(unname(chromPeaks(xchrsf)[, "sample"]), c(1, 2, 3, 1, 2, 3))
expect_equal(chromPeakData(xchrsf)$is_filled, c(FALSE, FALSE, FALSE, TRUE,
FALSE, TRUE))
expect_true(chromPeakData(xchrsf[2, 1])$is_filled)
expect_false(chromPeakData(xchrsf[2, 2])$is_filled, 0)
expect_true(chromPeakData(xchrsf[2, 3])$is_filled)
expect_false(chromPeakData(xchrsf[1, 2])$is_filled)
## Check feature definitions.
fts <- featureDefinitions(xchrs)
ftsf <- featureDefinitions(xchrsf)
expect_equal(fts$peakidx, list(c(1, 2, 3), 4))
expect_equal(ftsf$peakidx, list(c(1, 2, 3), c(4, 5, 6)))
xchrsf2 <- chromatogram(xod_tmpf, mz = mzr[2:1, ], rt = rtr[2:1, ])
expect_equal(chromPeaks(xchrs), chromPeaks(xchrsf2))
expect_equal(featureDefinitions(xchrs), featureDefinitions(xchrsf2))
## Test with single range.
xchrs <- chromatogram(xod_tmp, mz = mzr[1, ], rt = rtr[1, ], filled = TRUE)
xchrsf <- chromatogram(xod_tmpf, mz = mzr[1, ], rt = rtr[1, ], filled = TRUE)
expect_equal(nrow(chromPeaks(xchrs)), 1)
expect_equal(nrow(chromPeaks(xchrsf)), 3)
expect_equal(chromPeakData(xchrsf)$is_filled, c(TRUE, FALSE, TRUE))
expect_equal(unname(featureDefinitions(xchrsf)$peakidx[[1]]), c(1, 2, 3))
xchrsf2 <- chromatogram(xod_tmpf, mz = mzr[1, ], rt = rtr[1, ])
expect_equal(chromPeaks(xchrsf2), chromPeaks(xchrs))
expect_equal(featureDefinitions(xchrsf2), featureDefinitions(xchrs))
##
mzm <- rbind(305.1 + c(-0.01, 0.01), 496.2 + c(-0.01, 0.01))
xchr <- chromatogram(xod_xgrg, mz = mzm)
expect_equal(featureDefinitions(xchr)$row, c(1L, 1L, 1L, 2L, 2L))
## duplicated ranges.
mzm <- rbind(mzm, mzm[1, ])
xchr_2 <- chromatogram(xod_xgrg, mz = mzm)
expect_equal(featureDefinitions(xchr_2)$row, c(1L, 1L, 1L, 2L, 2L, 3L, 3L, 3L))
cpks <- chromPeaks(xchr_2)
expect_equal(cpks[cpks[, "row"] == 1, "into"], cpks[cpks[, "row"] == 3, "into"])
fts <- featureDefinitions(xchr_2)
expect_true(all(fts$peakidx[[1]] != fts$peakidx[[6]]))
expect_equal(cpks[fts$peakidx[[1]], "into"], cpks[fts$peakidx[[6]], "into"])
})
test_that("signal integration is correct", {
skip_on_os(os = "windows", arch = "i386")
## Testing the signal integration of peaks.
## For centWave
tmp <- xod_xgrg
rtr <- chromPeaks(tmp)[1, c("rtmin", "rtmax")]
mzr <- chromPeaks(tmp)[1, c("mzmin", "mzmax")]
chr <- chromatogram(tmp, rt = rtr, mz = mzr)
pkInt <- sum(intensity(chr[1, 1]) *
((rtr[2] - rtr[1]) / (length(chr[1, 1]) - 1)))
expect_equal(pkInt, unname(chromPeaks(tmp)[1, "into"]))
tmp <- filterFile(xod_xgrg, file = 2, keepAdjustedRtime = FALSE)
idxs <- sample(1:nrow(chromPeaks(tmp)), 5)
## Now, for i = 20, for 6 rt I got an NA. Should I remove these measurements?
## idxs <- 1:nrow(chromPeaks(tmp))
for (i in idxs) {
rtr <- chromPeaks(tmp)[i, c("rtmin", "rtmax")]
mzr <- chromPeaks(tmp)[i, c("mzmin", "mzmax")]
chr <- chromatogram(tmp, rt = rtr, mz = mzr)[1, 1]
ints <- intensity(chr)
pkI <- sum(ints, na.rm = TRUE) * ((rtr[2] - rtr[1]) / (length(ints) - 1))
## cat(" ", chromPeaks(tmp)[i, "into"], " - ", pkI, "\n")
expect_equal(unname(pkI), unname(chromPeaks(tmp)[i, "into"]))
}
## pkI2 <- .getPeakInt2(tmp, chromPeaks(tmp)[idxs, , drop = FALSE])
## expect_equal(unname(pkI2), unname(chromPeaks(tmp)[idxs, "into"]))
## Now for matchedfilter.
tmp <- findChromPeaks(filterFile(od_x, 2), param = MatchedFilterParam())
rtr <- chromPeaks(tmp)[1, c("rtmin", "rtmax")]
mzr <- chromPeaks(tmp)[1, c("mzmin", "mzmax")]
chr <- chromatogram(tmp, rt = rtr, mz = mzr)
pkInt <- sum(intensity(chr[1, 1]) *
((rtr[2] - rtr[1]) / (length(chr[1, 1]) - 1)))
chromPeaks(tmp)[1, "into"]
expect_equal(pkInt, unname(chromPeaks(tmp)[1, "into"]))
idxs <- sample(1:nrow(chromPeaks(tmp)), 5)
## idxs <- 1:nrow(chromPeaks(tmp))
for (i in idxs) {
rtr <- chromPeaks(tmp)[i, c("rtmin", "rtmax")]
mzr <- chromPeaks(tmp)[i, c("mzmin", "mzmax")]
chr <- chromatogram(tmp, rt = rtr, mz = mzr)[1, 1]
ints <- intensity(chr)
pkI <- sum(ints, na.rm = TRUE) * ((rtr[2] - rtr[1]) / (length(ints) - 1))
## cat(" ", chromPeaks(tmp)[i, "into"], " - ", pkI, "\n")
expect_equal(unname(pkI), unname(chromPeaks(tmp)[i, "into"]))
}
## pkI2 <- .getPeakInt2(tmp, chromPeaks(tmp)[idxs, , drop = FALSE])
## expect_equal(unname(pkI2), unname(chromPeaks(tmp)[idxs, "into"]))
## ## matchedFilter with wide mz bins.
## ## For matchedFilter I will have to do this on the profile matrix!
## tmp <- findChromPeaks(filterFile(od_x, 2),
## param = MatchedFilterParam(binSize = 2))
## idxs <- 1:nrow(chromPeaks(tmp))
## pkI2 <- .getPeakInt2(tmp, chromPeaks(tmp)[idxs, , drop = FALSE])
## expect_equal(unname(pkI2), unname(chromPeaks(tmp)[idxs, "into"]))
})
test_that("featureValues,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
fdp <- PeakDensityParam(sampleGroups = rep(1, 3))
od_x <- groupChromPeaks(faahko_xod, param = fdp)
fvs <- featureValues(od_x, value = "into")
expect_equal(rownames(fvs), rownames(featureDefinitions(od_x)))
## Use the internal function
res <- .feature_values(chromPeaks(od_x), featureDefinitions(od_x),
value = "into", method = "medret",
intensity = "into",
colnames = basename(fileNames(od_x)))
expect_equal(featureValues(od_x, value = "into"), res)
res <- .feature_values(chromPeaks(od_x), featureDefinitions(od_x),
value = "into", method = "sum",
intensity = "into",
colnames = basename(fileNames(od_x)))
expect_equal(featureValues(od_x, value = "into", method = "sum"), res)
fsum <- featureSummary(xod_xg)
fv <- featureValues(xod_xg, method = "maxint", value = "into")
## For feature 3 we have 2 peaks in sample 3
idx <- unlist(featureDefinitions(xod_xg)[3, "peakidx"])
pks <- chromPeaks(xod_xg)[idx, ]
expect_equal(max(pks[pks[, "sample"] == 3, "into"]), fv[3, 3])
## For feature 37 we have 2 peaks per sample
idx <- unlist(featureDefinitions(xod_xg)[37, "peakidx"])
pks <- chromPeaks(xod_xg)[idx, ]
expect_equal(max(pks[pks[, "sample"] == 1, "into"]), fv[37, 1])
expect_equal(max(pks[pks[, "sample"] == 2, "into"]), fv[37, 2])
expect_equal(max(pks[pks[, "sample"] == 3, "into"]), fv[37, 3])
## method sum
fv <- featureValues(xod_xg, method = "sum", value = "into")
## For feature 3 we have 2 peaks in sample 3
idx <- unlist(featureDefinitions(xod_xg)[3, "peakidx"])
pks <- chromPeaks(xod_xg)[idx, ]
expect_equal(sum(pks[pks[, "sample"] == 3, "into"]), fv[3, 3])
## For feature 37 we have 2 peaks per sample
idx <- unlist(featureDefinitions(xod_xg)[37, "peakidx"])
pks <- chromPeaks(xod_xg)[idx, ]
expect_equal(sum(pks[pks[, "sample"] == 1, "into"]), fv[37, 1])
expect_equal(sum(pks[pks[, "sample"] == 2, "into"]), fv[37, 2])
expect_equal(sum(pks[pks[, "sample"] == 3, "into"]), fv[37, 3])
## missing
na_num <- sum(is.na(featureValues(od_x, value = "into")))
res <- featureValues(od_x, value = "into", missing = 123)
expect_equal(sum(res == 123), na_num)
res <- featureValues(od_x, value = "into", missing = "rowmin_half")
res_na <- featureValues(od_x, value = "into")
is_na <- is.na(rowMeans(res_na))
for (i in which(is_na)) {
are_na <- is.na(res_na[i, ])
expect_true(all(res[i, are_na] == min(res_na[i, ], na.rm = TRUE) / 2))
}
## Check errors
expect_error(featureValues(od_x, value = "into", missing = "b"))
expect_error(featureValues(od_x, value = "into", missing = TRUE))
## feature values with MS level > 1
expect_error(featureValues(xod_xg, msLevel = 2), "No feature definitions")
## Fake feature definitions for MS level 2
cwp <- CentWaveParam(noise = 10000, snthresh = 40,
prefilter = c(3, 10000))
tmp <- xod_xg
fd <- new("MsFeatureData")
fd@.xData <- .copy_env(tmp@msFeatureData)
chromPeakData(fd)$ms_level <- 2L
fd$featureDefinitions$ms_level <- 2L
lockEnvironment(fd, bindings = TRUE)
tmp@msFeatureData <- fd
expect_true(hasChromPeaks(tmp, msLevel = 2L))
expect_true(hasFeatures(tmp, msLevel = 2L))
expect_equal(featureValues(tmp, msLevel = 2L), featureValues(xod_xg))
tmp <- findChromPeaks(tmp, add = TRUE, param = cwp)
expect_equal(unname(chromPeaks(tmp, msLevel = 1L)[, "into"]),
unname(chromPeaks(tmp, msLevel = 2L)[, "into"]))
## correspondence
pdp <- PeakDensityParam(sampleGroups = rep(1, 3))
tmp <- groupChromPeaks(tmp, param = pdp, msLevel = 1L)
tmp <- groupChromPeaks(tmp, param = pdp, msLevel = 2L, add = TRUE)
expect_true(hasFeatures(tmp, msLevel = 1L))
expect_true(hasFeatures(tmp, msLevel = 2L))
all <- featureValues(tmp)
ms1 <- featureValues(tmp, msLevel = 1L)
ms2 <- featureValues(tmp, msLevel = 2L)
expect_equal(all, rbind(ms1, ms2))
rownames(ms1) <- rownames(ms2) <- NULL
expect_equal(ms1, ms2)
})
test_that("peakIndex,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
pkI <- .peakIndex(xod_xg)
expect_equal(names(pkI), rownames(featureDefinitions(xod_xg)))
expect_equal(unname(pkI), featureDefinitions(xod_xg)$peakidx)
})
test_that("MS1 MS2 data works on XCMSnExp", {
skip_on_os(os = "windows", arch = "i386")
## That's to test stuff for issues #208 and related (also issue #214).
## Set every other spectra in the original files to MS2.
## OnDiskMSnExp: od_x
od_mod <- faahko_od
fDat <- fData(od_mod)
idx_1 <- which(fDat$fileIdx == 1)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 1)))))
fDat[idx_1, "msLevel"] <- 2
idx_1 <- which(fDat$fileIdx == 2)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 2)))))
fDat[idx_1, "msLevel"] <- 2
idx_1 <- which(fDat$fileIdx == 3)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 3)))))
fDat[idx_1, "msLevel"] <- 2
fData(od_mod) <- fDat
res <- adjustRtime(od_mod, param = ObiwarpParam())
res_2 <- adjustRtime(filterMsLevel(od_mod, msLevel = 1),
param = ObiwarpParam())
## Expect:
## - adjusted rtime of any other spectrum is identical to the
## ones performed on the data sub set.
expect_equal(res[msLevel(od_mod) == 1], res_2)
## - difference between raw and adjusted rtime at the end and beginning are
## constant.
res_by_file <- split(res, fromFile(od_mod))
raw_by_file <- split(rtime(od_mod), fromFile(od_mod))
expect_true(raw_by_file[[1]][1] != res_by_file[[1]][1])
expect_true(raw_by_file[[2]][1] != res_by_file[[2]][1])
expect_true(raw_by_file[[3]][1] != res_by_file[[3]][1])
diffs <- tail(res_by_file[[1]]) - tail(raw_by_file[[1]])
expect_equal(unname(diff(diffs)), rep(0, 5))
diffs <- tail(res_by_file[[2]]) - tail(raw_by_file[[2]])
expect_equal(unname(diff(diffs)), rep(0, 5))
diffs <- tail(res_by_file[[3]]) - tail(raw_by_file[[3]])
expect_equal(unname(diff(diffs)), rep(0, 5))
## - adjusted rtime of the MS level 2 are in interpolated between rts of
## MS level 2.
## rtime for 3 should be interpolated between 2 and 4:
adj_fun <- approxfun(x = raw_by_file[[1]][c(2, 4)],
y = res_by_file[[1]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[1]][3]), unname(res_by_file[[1]][3]))
adj_fun <- approxfun(x = raw_by_file[[2]][c(2, 4)],
y = res_by_file[[2]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[2]][3]), unname(res_by_file[[2]][3]))
adj_fun <- approxfun(x = raw_by_file[[3]][c(2, 4)],
y = res_by_file[[3]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[3]][3]), unname(res_by_file[[3]][3]))
## XCMSnExp: xod_x, repeat the stuff above
xod_mod <- xod_x
fDat <- fData(xod_mod)
idx_1 <- which(fDat$fileIdx == 1)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 1)))))
fDat[idx_1, "msLevel"] <- 2
idx_1 <- which(fDat$fileIdx == 2)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 2)))))
fDat[idx_1, "msLevel"] <- 2
idx_1 <- which(fDat$fileIdx == 3)
idx_1 <- idx_1[rep(c(TRUE, FALSE), length.out = length(idx_1))]
idx_1 <- sort(unique(c(idx_1, tail(which(fDat$fileIdx == 3)))))
fDat[idx_1, "msLevel"] <- 2
fData(xod_mod) <- fDat
res <- adjustRtime(xod_mod, param = ObiwarpParam())
suppressWarnings(res_2 <- adjustRtime(filterMsLevel(xod_mod, msLevel = 1),
param = ObiwarpParam()))
## Expect:
## - adjusted rtime of any other spectrum is identical to the
## ones performed on the data sub set.
expect_equal(rtime(res, adjusted = TRUE)[msLevel(res) == 1],
rtime(res_2, adjusted = TRUE))
## - difference between raw and adjusted rtime at the end and beginning are
## constant.
res_by_file <- rtime(res, bySample = TRUE)
raw_by_file <- rtime(xod_mod, bySample = TRUE)
expect_true(raw_by_file[[1]][1] != res_by_file[[1]][1])
expect_true(raw_by_file[[2]][1] != res_by_file[[2]][1])
expect_true(raw_by_file[[3]][1] != res_by_file[[3]][1])
diffs <- tail(res_by_file[[1]]) - tail(raw_by_file[[1]])
expect_equal(unname(diff(diffs)), rep(0, 5))
diffs <- tail(res_by_file[[2]]) - tail(raw_by_file[[2]])
expect_equal(unname(diff(diffs)), rep(0, 5))
diffs <- tail(res_by_file[[3]]) - tail(raw_by_file[[3]])
expect_equal(unname(diff(diffs)), rep(0, 5))
## - adjusted rtime of the MS level 2 are in interpolated between rts of
## MS level 2.
## rtime for 3 should be interpolated between 2 and 4:
adj_fun <- approxfun(x = raw_by_file[[1]][c(2, 4)],
y = res_by_file[[1]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[1]][3]), unname(res_by_file[[1]][3]))
adj_fun <- approxfun(x = raw_by_file[[2]][c(2, 4)],
y = res_by_file[[2]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[2]][3]), unname(res_by_file[[2]][3]))
adj_fun <- approxfun(x = raw_by_file[[3]][c(2, 4)],
y = res_by_file[[3]][c(2, 4)])
expect_equal(adj_fun(raw_by_file[[3]][3]), unname(res_by_file[[3]][3]))
})
test_that("extractMsData,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## All the data
## all <- extractMsData(od_x)
## expect_equal(length(all), length(fileNames(od_x)))
## rts <- split(rtime(od_x), f = fromFile(od_x))
## expect_equal(lengths(rts), unlist(lapply(all, nrow)))
## On an OnDiskMSnExp with only mz
mzr <- c(300, 302)
res <- extractMsData(filterFile(od_x, 1:2), mz = mzr)
expect_equal(length(res), 2)
expect_true(all(res[[1]][, "mz"] >= mzr[1] & res[[1]][, "mz"] <= mzr[2]))
expect_true(all(res[[2]][, "mz"] >= mzr[1] & res[[2]][, "mz"] <= mzr[2]))
## On an OnDiskMSnExp with only rt
rtr <- c(2500, 2800)
res <- extractMsData(filterFile(od_x, 1:2), rt = rtr)
expect_true(all(res[[1]][, "rt"] >= rtr[1] & res[[1]][, "rt"] <= rtr[2]))
expect_true(all(res[[2]][, "rt"] >= rtr[1] & res[[2]][, "rt"] <= rtr[2]))
## LLLLL TODO Continue here, and then add example to the extractMsData
## help page.
## On an OnDiskMSnExp with mz and rt
res <- extractMsData(filterFile(od_x, 1:2), rt = rtr, mz = mzr)
expect_true(all(res[[1]][, "rt"] >= rtr[1] & res[[1]][, "rt"] <= rtr[2]))
expect_true(all(res[[2]][, "rt"] >= rtr[1] & res[[2]][, "rt"] <= rtr[2]))
expect_true(all(res[[1]][, "mz"] >= mzr[1] & res[[1]][, "mz"] <= mzr[2]))
expect_true(all(res[[2]][, "mz"] >= mzr[1] & res[[2]][, "mz"] <= mzr[2]))
## XCMSnExp, xod_xgr
## with adjusted retention times
tmp <- filterFile(xod_xgr, 1:2, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp))
res <- extractMsData(tmp, rt = rtr, mz = mzr)
mzs <- mz(tmp)
rts <- rtime(tmp, bySample = TRUE, adjusted = TRUE)
expect_true(all(res[[1]][, "rt"] >= rtr[1] & res[[1]][, "rt"] <= rtr[2]))
expect_true(all(res[[2]][, "rt"] >= rtr[1] & res[[2]][, "rt"] <= rtr[2]))
expect_true(all(res[[1]][, "mz"] >= mzr[1] & res[[1]][, "mz"] <= mzr[2]))
expect_true(all(res[[2]][, "mz"] >= mzr[1] & res[[2]][, "mz"] <= mzr[2]))
tmp_rts <- rts[[1]]
tmp_rts <- tmp_rts[tmp_rts >= rtr[1] & tmp_rts <= rtr[2]]
res_rts <- res[[1]][, 1]
expect_equal(unique(res_rts), unname(tmp_rts))
tmp_rts <- rts[[2]]
tmp_rts <- tmp_rts[tmp_rts >= rtr[1] & tmp_rts <= rtr[2]]
res_rts <- res[[2]][, 1]
expect_equal(unique(res_rts), unname(tmp_rts))
## without adjusted retention times
res_2 <- extractMsData(filterFile(xod_xgr, 1:2), adjustedRtime = FALSE,
rt = rtr, mz = mzr)
expect_true(all(res_2[[1]][, "rt"] >= rtr[1] & res_2[[1]][, "rt"] <= rtr[2]))
expect_true(all(res_2[[2]][, "rt"] >= rtr[1] & res_2[[2]][, "rt"] <= rtr[2]))
expect_true(all(res_2[[1]][, "mz"] >= mzr[1] & res_2[[1]][, "mz"] <= mzr[2]))
expect_true(all(res_2[[2]][, "mz"] >= mzr[1] & res_2[[2]][, "mz"] <= mzr[2]))
## expect_true(nrow(res[[1]]) != nrow(res_2[[1]]))
## expect_true(nrow(res[[2]]) != nrow(res_2[[2]]))
## rt and mzr out of range.
res <- extractMsData(od_x, rt = c(6000, 6300), mz = c(0, 3))
expect_equal(length(res), 3)
expect_true(all(unlist(lapply(res, FUN = nrow)) == 0))
res <- extractMsData(od_x, rt = c(6000, 6300))
expect_equal(length(res), 3)
expect_true(all(unlist(lapply(res, FUN = nrow)) == 0))
## res <- extractMsData(od_x, mz = c(0, 3))
## expect_equal(length(res), 3)
## expect_true(all(unlist(lapply(res, FUN = nrow)) == 0))
})
test_that("spectrapply and spectra,XCMSnExp work", {
skip_on_os(os = "windows", arch = "i386")
## With adjusted retention time
tmp <- filterFile(xod_r, file = 3, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp))
expect_true(is.character(all.equal(rtime(tmp, adjusted = FALSE),
rtime(tmp, adjusted = TRUE))))
sps <- spectra(tmp)
expect_equal(unlist(lapply(sps, rtime)), rtime(tmp, adjusted = TRUE))
expect_equal(unlist(spectrapply(tmp, FUN = function(x) rtime(x))),
rtime(tmp, adjusted = TRUE))
sps_2 <- spectra(tmp, adjusted = FALSE)
expect_equal(unlist(lapply(sps_2, rtime)), rtime(tmp, adjusted = FALSE))
## without adjusted retention time
tmp <- filterFile(xod_x, file = 3)
expect_true(!hasAdjustedRtime(tmp))
sps <- spectra(tmp)
expect_equal(unlist(lapply(sps, rtime)), rtime(tmp))
expect_equal(unlist(lapply(sps, mz)), unlist(mz(tmp)))
expect_equal(unlist(spectrapply(tmp, FUN = function(x) rtime(x))),
rtime(tmp))
})
test_that("processHistory,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
type_peak_det <- .PROCSTEP.PEAK.DETECTION
type_align <- .PROCSTEP.RTIME.CORRECTION
type_corr <- .PROCSTEP.PEAK.GROUPING
expect_true(length(processHistory(xod_x, type = type_corr)) == 0)
ph <- processHistory(xod_x, type = type_peak_det)
expect_equal(as.character(class(processParam(ph[[1]]))), "CentWaveParam")
ph <- processHistory(xod_xgrg)
expect_true(length(ph) == 4)
ph <- processHistory(xod_xgrg, msLevel = 1L)
expect_true(length(ph) == 4)
expect_equal(as.character(class(processParam(ph[[1]]))), "CentWaveParam")
})
test_that("split,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
xod <- as(faahko_od, "XCMSnExp")
tmp <- split(xod_xgr, f = fromFile(xod_xgr))
## Split by file.
expect_equal(spectra(tmp[[1]][7:13]), spectra(filterFile(xod, file = 1)[7:13]))
expect_equal(spectra(tmp[[3]][7:13]), spectra(filterFile(xod, file = 3)[7:13]))
## Split by acquisitionNum.
tmp <- filterRt(xod_xgr, rt = c(2600, 2700))
expect_true(hasChromPeaks(tmp))
expect_true(hasAdjustedRtime(tmp))
tmp_2 <- split(tmp, f = acquisitionNum(tmp))
expect_true(all(acquisitionNum(tmp_2[[1]]) == acquisitionNum(tmp)[1]))
expect_true(all(acquisitionNum(tmp_2[[14]]) == acquisitionNum(tmp)[14]))
## with keepAdjustedRtime
tmp <- split(xod_xgr, f = fromFile(xod_xgr), keepAdjustedRtime = TRUE)
tmp_1 <- filterFile(xod_xgr, file = 1, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp_1))
expect_equal(rtime(tmp[[1]]), rtime(tmp_1))
tmp_2 <- filterFile(xod_xgr, file = 2, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp_2))
expect_equal(rtime(tmp[[2]]), rtime(tmp_2))
tmp_3 <- filterFile(xod_xgr, file = 3, keepAdjustedRtime = TRUE)
expect_true(hasAdjustedRtime(tmp_3))
expect_equal(rtime(tmp[[3]]), rtime(tmp_3))
expect_true(!all(rtime(tmp[[3]]) == rtime(tmp[[3]], adjusted = FALSE)))
})
test_that("groupnames,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
gn <- groupnames(xod_xgrg)
expect_error(groupnames(xod_x))
})
test_that("calibrate,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
do_plot <- FALSE
tmp <- filterFile(faahko_xod, file = 1)
## Check shift calibration.
mzs <- chromPeaks(tmp)[c(3, 6, 7, 13, 17, 32, 45)]
mzs_shift <- mzs + 0.0001
prm <- CalibrantMassParam(mz = mzs_shift, method = "shift")
res <- calibrate(tmp, prm)
expect_true(isCalibrated(res))
expect_equal(chromPeaks(tmp)[, -1], chromPeaks(res)[, -1])
expect_equal(chromPeaks(tmp)[, 1] + 0.0001, chromPeaks(res)[, 1])
diffs <- chromPeaks(res)[, "mz"] - chromPeaks(tmp)[, "mz"]
X <- chromPeaks(res)[, "mz"]
if (do_plot)
plot(X, diffs)
## Check linear.
mzs_lin <- mzs + 0.00005 + mzs * 0.000002
max_dif <- max(mzs_lin - mzs)
prm <- CalibrantMassParam(mz = mzs_lin, method = "linear", mzabs = max_dif)
res <- calibrate(tmp, prm)
expect_true(isCalibrated(res))
diffs <- chromPeaks(res)[, "mz"] - chromPeaks(tmp)[, "mz"]
X <- chromPeaks(res)[, "mz"]
if (do_plot)
plot(X, diffs)
res_lm <- lm(diffs ~ X)
expect_equal(unname(coefficients(res_lm)[1]), 0.00005, tolerance = 1e-5)
expect_equal(unname(coefficients(res_lm)[2]), 0.000002, tolerance = 1e-5)
## edgeshift
prm <- CalibrantMassParam(mz = mzs_lin, method = "edgeshift",
mzabs = max_dif)
res <- calibrate(tmp, prm)
expect_true(isCalibrated(res))
diffs <- chromPeaks(res)[, "mz"] - chromPeaks(tmp)[, "mz"]
X <- chromPeaks(res)[, "mz"]
if (do_plot)
plot(X, diffs)
mz_sorted <- chromPeaks(tmp)[, "mz"]
## Diff has to be constant before and after the linear range.
lower_idx <- which(chromPeaks(tmp)[, "mz"] < min(mzs))
expect_true(all(diffs[lower_idx] == diffs[lower_idx][1]))
upper_idx <- which(chromPeaks(tmp)[, "mz"] > max(mzs))
expect_true(all(diffs[upper_idx] == diffs[upper_idx][1]))
lin_idx <- 1:length(diffs)
lin_idx <- lin_idx[!(lin_idx %in% lower_idx)]
lin_idx <- lin_idx[!(lin_idx %in% upper_idx)]
lin_mod <- lm(diffs[lin_idx] ~ X[lin_idx])
expect_equal(unname(coefficients(lin_mod)[1]), 0.00005, tolerance = 1e-5)
expect_equal(unname(coefficients(lin_mod)[2]), 0.000002, tolerance = 1e-5)
## Test with a single mass, fall back to shift.
prm <- CalibrantMassParam(mz = mzs_lin[1], method = "edgeshift",
mzabs = max_dif)
expect_warning(res <- calibrate(tmp, prm))
diffs <- chromPeaks(res)[, "mz"] - chromPeaks(tmp)[, "mz"]
min_diff <- min(abs(chromPeaks(tmp)[, "mz"] - mzs_lin[1]))
expect_equal(unname(diffs), rep(min_diff, length(diffs)))
## Check errors.
expect_error(calibrate(tmp, 4))
expect_error(calibrate(tmp, CalibrantMassParam(mz = list(mzs, mzs))))
})
test_that("adjustRtime,peakGroups works", {
skip_on_os(os = "windows", arch = "i386")
xod <- faahko_xod
xodg <- groupChromPeaks(
xod, param = PeakDensityParam(sampleGroups = rep(1, 3)))
pks <- chromPeaks(xodg)
expect_true(length(processHistory(xodg,
type = .PROCSTEP.PEAK.DETECTION)) == 1)
expect_true(length(processHistory(xodg,
type = .PROCSTEP.PEAK.GROUPING)) == 1)
p <- PeakGroupsParam(minFraction = 1, span = 0.3)
xodr <- adjustRtime(xodg, param = p)
## Check that we've got process histories.
expect_true(validObject(xodr))
expect_true(hasChromPeaks(xodr))
expect_true(!hasFeatures(xodr))
## But we would like to keep the related process history step:
expect_true(hasAdjustedRtime(xodr))
expect_true(hasFeatures(xodg))
## We want to keep the process history step of the feature alignment!
expect_true(length(processHistory(xodr,
type = .PROCSTEP.PEAK.GROUPING)) == 1)
expect_true(length(processHistory(xodr,
type = .PROCSTEP.RTIME.CORRECTION)) == 1)
## Different from original:
expect_true(sum(chromPeaks(xod)[, "rt"] != chromPeaks(xodr)[, "rt"]) > 200)
expect_true(sum(chromPeaks(xod)[, "rtmin"] != chromPeaks(xodr)[, "rtmin"]) > 200)
expect_true(sum(chromPeaks(xod)[, "rtmax"] != chromPeaks(xodr)[, "rtmax"]) > 200)
## Check that we get the same by supplying the peakGroupsMatrix.
pgm <- adjustRtimePeakGroups(xodg, param = p)
p_2 <- p
minFraction(p_2) <- 0.5
extraPeaks(p_2) <- 20
peakGroupsMatrix(p_2) <- pgm
xodr_2 <- adjustRtime(xodg, param = p_2)
expect_equal(adjustedRtime(xodr), adjustedRtime(xodr_2))
expect_equal(chromPeaks(xodr), chromPeaks(xodr_2))
p_got <- processParam(
processHistory(xodr, type = .PROCSTEP.RTIME.CORRECTION)[[1]])
peakGroupsMatrix(p_got) <- matrix(ncol = 0, nrow = 0)
expect_equal(p_got, p)
expect_equal(processParam(
processHistory(xodr_2, type = .PROCSTEP.RTIME.CORRECTION)[[1]]),
p_2)
## Doing an additional grouping
xodrg <- groupChromPeaks(xodr, param = PeakDensityParam(sampleGroups =
rep(1, 3)))
expect_true(length(processHistory(xodrg,
type = .PROCSTEP.PEAK.GROUPING)) == 2)
expect_true(hasAdjustedRtime(xodrg))
expect_true(hasFeatures(xodrg))
## Mod settings:
xodr <- adjustRtime(xodg, param = PeakGroupsParam(minFraction = 1,
span = 1))
xodr <- adjustRtime(xodg, param = PeakGroupsParam(minFraction = 1,
span = 1,
smooth = "linear"))
xodr <- adjustRtime(xodg, param = PeakGroupsParam(minFraction = 1,
span = 1,
family = "symmetric"))
## Dropping results.
tmp <- dropAdjustedRtime(xodr)
expect_equal(tmp, xod)
## With subset.
res_sub <- adjustRtime(
xodg, param = PeakGroupsParam(subset = c(1, 3),
subsetAdjust = "previous"))
expect_true(all(rtime(res_sub, bySample = TRUE)[[1]] !=
rtime(xodg, bySample = TRUE)[[1]]))
expect_true(all(rtime(res_sub, bySample = TRUE)[[2]] !=
rtime(xodg, bySample = TRUE)[[2]]))
expect_true(all(rtime(res_sub, bySample = TRUE)[[3]] !=
rtime(xodg, bySample = TRUE)[[3]]))
expect_equal(unname(rtime(res_sub, bySample = TRUE)[[1]]),
unname(rtime(res_sub, bySample = TRUE)[[2]]))
expect_equal(rtime(res_sub, bySample = TRUE)[[2]],
.applyRtAdjustment(rtime(xodg, bySample = TRUE)[[2]],
rtime(xodg, bySample = TRUE)[[1]],
rtime(res_sub, bySample = TRUE)[[1]]))
res_sub <- adjustRtime(
xodg, param = PeakGroupsParam(subset = c(1, 3),
subsetAdjust = "average"))
expect_true(all(rtime(res_sub, bySample = TRUE)[[1]] !=
rtime(xodg, bySample = TRUE)[[1]]))
expect_true(all(rtime(res_sub, bySample = TRUE)[[2]] !=
rtime(xodg, bySample = TRUE)[[2]]))
expect_true(all(rtime(res_sub, bySample = TRUE)[[3]] !=
rtime(xodg, bySample = TRUE)[[3]]))
expect_true(any(rtime(res_sub, bySample = TRUE)[[1]] !=
rtime(res_sub, bySample = TRUE)[[2]]))
tmp <- adjustRtime(xodg, param = PeakGroupsParam())
## With subsetAdjust = "average" and the left-out being at the end.
res_sub <- adjustRtime(
xodg, param = PeakGroupsParam(subset = 1:2, subsetAdjust = "average"))
res_2 <- adjustRtime(
xodg, param = PeakGroupsParam(subset = 1:2, subsetAdjust = "previous"))
expect_equal(rtime(res_sub), rtime(res_2))
})
test_that("findChromPeaks,MSWParam works", {
skip_on_os(os = "windows", arch = "i386")
od <- microtofq_od
## Restrict to first spectrum
od1 <- od[1]
sp1 <- od[[1]]
res_1 <- do_findPeaks_MSW(mz = mz(sp1), int = intensity(sp1))
mp <- MSWParam()
expect_error(findChromPeaks(od1, param = mp, msLevel = 2))
res_2 <- findChromPeaks(od1, param = mp)
pks <- chromPeaks(res_2)
rownames(pks) <- NULL
expect_equal(res_1, pks[, colnames(res_1), drop = FALSE])
## Changing settings.
snthresh(mp) <- 1
nearbyPeak(mp) <- FALSE
res_1 <- do_findPeaks_MSW(mz = mz(sp1), int = intensity(sp1),
snthresh = 1, nearbyPeak = FALSE)
res_2 <- findChromPeaks(od1, param = mp, return.type = "list")
expect_equal(res_1, res_2[[1]][, colnames(res_1)])
peakThr(mp) <- 200
res_1 <- do_findPeaks_MSW(mz = mz(sp1), int = intensity(sp1),
snthresh = 1, nearbyPeak = FALSE,
peakThr = 200)
res_2 <- findChromPeaks(od1, param = mp, return.type = "list")
expect_equal(res_1, res_2[[1]][, colnames(res_1)])
addParams(mp) <- list(forder = 2)
res_3 <- do_findPeaks_MSW(mz = mz(sp1), int = intensity(sp1),
snthresh = 1, nearbyPeak = FALSE,
peakThr = 200, forder = 2)
res_4 <- findChromPeaks(od1, param = mp, return.type = "list")
expect_equal(res_3, res_4[[1]][, colnames(res_3)])
addParams(mp) <- list(forder = 2, dorder = 1)
res_3 <- do_findPeaks_MSW(mz = mz(sp1), int = intensity(sp1),
snthresh = 1, nearbyPeak = FALSE,
peakThr = 200, forder = 2, dorder = 1)
res_4 <- findChromPeaks(od1, param = mp, return.type = "list")
expect_equal(res_3, res_4[[1]][, colnames(res_3)])
## Compare old vs new:
pks <- chromPeaks(fticr_xod)
rownames(pks) <- NULL
})
test_that("featureValues,XCMSnExp works as with groupval", {
skip_on_os(os = "windows", arch = "i386")
fval <- featureValues(xod_xg)
expect_true(nrow(fval) == nrow(featureDefinitions(xod_xg)))
expect_true(ncol(fval) == length(fileNames(xod_xg)))
expect_true(is.numeric(fval))
fval <- featureValues(xod_xg, value = "index")
## Checking errors
expect_error(featureValues(od_x, value = "bla"))
})
test_that("groupChromPeaks,XCMSnExp,PeakDensityParam works", {
skip_on_os(os = "windows", arch = "i386")
## Check error if no features were found. issue #273
pdp <- PeakDensityParam(sampleGroups = rep(1, 3), minSamples = 30)
expect_warning(groupChromPeaks(faahko_xod, param = pdp), "Unable to group any chromatographic peaks.")
fdp <- PeakDensityParam(sampleGroups = rep(1, 3))
res <- groupChromPeaks(faahko_xod, param = fdp)
expect_true(hasFeatures(res))
expect_true(length(processHistory(res)) == 2)
ph <- processHistory(res, type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), fdp)
expect_equal(rownames(featureDefinitions(res)),
.featureIDs(nrow(featureDefinitions(res))))
fdp2 <- PeakDensityParam(sampleGroups = rep(1, 3), binSize = 2,
minFraction = 0.8)
res_2 <- groupChromPeaks(faahko_xod, param = fdp2)
expect_true(length(processHistory(res_2)) == 2)
ph <- processHistory(res_2, type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), fdp2)
expect_equal(rownames(featureDefinitions(res_2)),
.featureIDs(nrow(featureDefinitions(res_2))))
pdp <- PeakDensityParam(sampleGroups = rep(1, 3))
res <- groupChromPeaks(faahko_xod, param = pdp)
res_2 <- groupChromPeaks(res, param = pdp)
expect_equal(featureDefinitions(res), featureDefinitions(res_2))
res_2 <- groupChromPeaks(res, param = pdp, add = TRUE)
expect_true(nrow(featureDefinitions(res_2)) ==
2 * nrow(featureDefinitions(res)))
nr <- nrow(featureDefinitions(res))
expect_equal(featureDefinitions(res),
featureDefinitions(res_2)[1:nr, ])
expect_equal(featureDefinitions(res)$mzmed,
featureDefinitions(res_2)$mzmed[(nr + 1):(2 * nr)])
expect_equal(featureDefinitions(res)$peakidx,
featureDefinitions(res_2)$peakidx[(nr + 1):(2 * nr)])
expect_error(groupChromPeaks(faahko_xod, param = pdp, msLevel = 2), "MS level 2")
expect_error(groupChromPeaks(faahko_xod, param = pdp, msLevel = 1:4),
"one MS level at a time")
})
test_that("groupPeaks,XCMSnExp,MzClustParam works", {
skip_on_os(os = "windows", arch = "i386")
p <- MzClustParam(sampleGroups = rep(1, length(fileNames(fticr_xod))))
fticr_xod2 <- groupChromPeaks(fticr_xod, param = p)
expect_true(hasFeatures(fticr_xod2))
expect_true(length(processHistory(fticr_xod2)) == 2)
ph <- processHistory(fticr_xod2,
type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), p)
expect_equal(rownames(featureDefinitions(fticr_xod2)),
.featureIDs(nrow(featureDefinitions(fticr_xod2))))
p2 <- MzClustParam(sampleGroups = rep(1, length(fileNames(fticr_xod))),
absMz = 1, minFraction = 0.8)
fticr_xod2 <- groupChromPeaks(fticr_xod, param = p2)
expect_true(length(processHistory(fticr_xod2)) == 2)
ph <- processHistory(fticr_xod2,
type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), p2)
expect_equal(rownames(featureDefinitions(fticr_xod2)),
.featureIDs(nrow(featureDefinitions(fticr_xod2))))
})
test_that("groupChromPeaks,XCMSnExp,NearestPeaksParam works", {
skip_on_os(os = "windows", arch = "i386")
p <- NearestPeaksParam(sampleGroups = rep(1, 3))
res <- groupChromPeaks(faahko_xod, param = p)
expect_true(hasFeatures(res))
expect_true(length(processHistory(res)) == 2)
ph <- processHistory(res, type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), p)
expect_equal(rownames(featureDefinitions(res)),
.featureIDs(nrow(featureDefinitions(res))))
fdp2 <- NearestPeaksParam(sampleGroups = rep(1, 3), kNN = 3)
res <- groupChromPeaks(faahko_xod, param = fdp2)
expect_true(length(processHistory(res)) == 2)
ph <- processHistory(res, type = .PROCSTEP.PEAK.GROUPING)[[1]]
expect_equal(processParam(ph), fdp2)
expect_equal(rownames(featureDefinitions(res)),
.featureIDs(nrow(featureDefinitions(res))))
expect_error(groupChromPeaks(faahko_xod, param = p, msLevel = 2), "MS level 2")
expect_error(groupChromPeaks(faahko_xod, param = p, msLevel = 1:3), " at a time")
res <- groupChromPeaks(faahko_xod, param = p)
res_2 <- groupChromPeaks(res, param = p)
expect_equal(featureDefinitions(res), featureDefinitions(res_2))
res_2 <- groupChromPeaks(res, param = p, add = TRUE)
expect_true(nrow(featureDefinitions(res_2)) ==
2 * nrow(featureDefinitions(res)))
nr <- nrow(featureDefinitions(res))
expect_equal(featureDefinitions(res), featureDefinitions(res)[1:nr, ])
expect_equal(featureDefinitions(res)$peakidx,
featureDefinitions(res_2)$peakidx[(nr + 1):(2 * nr)])
expect_equal(featureDefinitions(res)$mzmed,
featureDefinitions(res_2)$mzmed[(nr + 1):(2 * nr)])
})
test_that("fillChromPeaks,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## No adjusted retention times
expect_true(!.hasFilledPeaks(xod_xg))
expect_false(hasFilledChromPeaks(xod_xg))
res <- fillChromPeaks(xod_xg)
expect_true(.hasFilledPeaks(res))
expect_true(hasFilledChromPeaks(res))
ph <- processHistory(res, type = xcms:::.PROCSTEP.PEAK.FILLING)
expect_true(length(ph) == 1)
expect_equal(ph[[1]]@param, FillChromPeaksParam())
## Check parameter filled in featureValues (issue #157)
expect_equal(featureValues(res, filled = FALSE), featureValues(xod_xg))
## Check if the signal corresponds to what we expect for some peaks.
fp <- chromPeaks(res)
fp <- fp[chromPeakData(res)$is_filled, ]
idxs <- sample(1:nrow(fp), 5)
for (i in idxs) {
cfp <- fp[i, , drop = FALSE]
tmp <- filterFile(xod_xg, file = cfp[1, "sample"])
chr <- chromatogram(tmp, rt = cfp[1, c("rtmin", "rtmax")],
mz = cfp[1, c("mzmin", "mzmax")])[1, 1]
into <- sum(intensity(chr), na.rm = TRUE) *
(cfp[1, "rtmax"] - cfp[1, "rtmin"]) / (length(chr) - 1)
expect_equal(unname(into), unname(cfp[1, "into"]))
}
## Check if the results are similar that we get with findChromPeaks
for (i in 1:length(fileNames(xod_xg))) {
fnd_pks <- chromPeaks(xod_xg)[chromPeaks(xod_xg)[, "sample"] == i, ]
prm <- processHistory(tmp, type ="Peak detection")[[1]]@param
## Extract the data for these using the internal function.
fld_pks <- .getChromPeakData(filterFile(xod_xg, i),
peakArea = fnd_pks,
sample_idx = i,
cn = colnames(fnd_pks))
## rt
expect_true(cor(fnd_pks[, "rt"], fld_pks[, "rt"]) > 0.99)
## mz
expect_true(cor(fnd_pks[, "mz"], fld_pks[, "mz"]) > 0.99)
expect_equal(unname(fnd_pks[, "mz"]), unname(fld_pks[, "mz"]))
## into
expect_true(cor(fnd_pks[, "into"], fld_pks[, "into"]) > 0.99)
expect_equal(unname(fnd_pks[, "into"]), unname(fld_pks[, "into"]))
## expect_equal(fnd_pks[, "into"], fld_pks[, "into"])
## maxo
expect_equal(unname(fnd_pks[, "maxo"]), unname(fld_pks[, "maxo"]))
expect_equal(unname(fnd_pks[, "maxo"]), unname(fld_pks[, "maxo"]))
}
## Check for the NAs if there is really no signal
gv <- featureValues(res)
feat_i <- which(is.na(gv[, 1]))
tmp <- chromPeaks(res)[featureDefinitions(res)$peakidx[[feat_i]],
c("rtmin", "rtmax", "mzmin", "mzmax")]
## Get the intensities for the first one.
pkArea <- apply(tmp, median, MARGIN = 2)
chr <- chromatogram(res, rt = pkArea[1:2], mz = pkArea[3:4])[1, ]
expect_true(all(unlist(lapply(chr, function(z) is.na(intensity(z))))))
## Get also the spectra:
spctr <- spectra(filterRt(filterFile(xod_xg, file = 1), rt = pkArea[1:2]))
mzs <- unlist(lapply(spctr, mz))
## No spectra for the fiven mz:
expect_equal(sum(mzs >= pkArea[3] & mzs <= pkArea[4]), 0)
## Check increasing the expandRt and expandMz to see whether we get rid of
## the NA.
res_2 <- fillChromPeaks(xod_xg, param = FillChromPeaksParam(expandMz = 1))
## Check if the mzrange is now indeed broader for the integrated ones.
fp <- chromPeaks(res)
fp <- fp[chromPeakData(res)$is_filled, ]
fp2 <- chromPeaks(res_2)
fp2 <- fp2[chromPeakData(res)$is_filled, ]
expect_equal(fp2[, "mzmax"] - fp2[, "mzmin"],
2 * (fp[, "mzmax"] - fp[, "mzmin"]))
res_2 <- fillChromPeaks(xod_xg, param = FillChromPeaksParam(fixedRt = 1))
## Check if the rtrange is now indeed broader for the integrated ones.
fp <- chromPeaks(res)
fp <- fp[chromPeakData(res)$is_filled, ]
fp2 <- chromPeaks(res_2)
fp2 <- fp2[chromPeakData(res)$is_filled, ]
expect_equal(fp[, "rt"], fp2[, "rt"])
expect_equal(fp[, "rtmin"] - 1, fp2[, "rtmin"])
expect_equal(fp[, "rtmax"] + 1, fp2[, "rtmax"])
res_2 <- fillChromPeaks(xod_xg, param = FillChromPeaksParam(expandRt = 1))
## Check if the rtrange is now indeed broader for the integrated ones.
fp <- chromPeaks(res)
fp <- fp[chromPeakData(res)$is_filled, ]
fp2 <- chromPeaks(res_2)
fp2 <- fp2[chromPeakData(res)$is_filled, ]
expect_equal(fp2[, "rtmax"] - fp2[, "rtmin"],
2 * (fp[, "rtmax"] - fp[, "rtmin"]))
## Check using ppm
res_2 <- fillChromPeaks(xod_xg, param = FillChromPeaksParam(ppm = 40,
expandMz = 5,
expandRt = 2))
expect_true(all(!is.na(rowSums(featureValues(res_2)))))
## Drop them.
res_rem <- dropFilledChromPeaks(res)
expect_true(!.hasFilledPeaks(res_rem))
expect_equal(res_rem, xod_xg)
## Drop feature definitions from res -> also filled peaks should be dropped.
res_rem <- dropFeatureDefinitions(res)
expect_true(!.hasFilledPeaks(res_rem))
expect_true(!any(chromPeakData(res_rem)$is_filled))
expect_equal(res_rem, xod_x)
## With adjusted rtime.
res_2 <- fillChromPeaks(xod_xgrg)
## Check if the signal corresponds to what we expect for some peaks.
fp <- chromPeaks(res_2)
fp <- fp[chromPeakData(res_2)$is_filled, ]
## These have to be different from before!
fp_raw <- chromPeaks(res)
fp_raw <- fp_raw[chromPeakData(res)$is_filled, ]
expect_true(all(fp_raw[, "rt"] != fp[, "rt"]))
expect_true(all(fp_raw[, "rtmin"] != fp[, "rtmin"]))
expect_true(all(fp_raw[, "rtmax"] != fp[, "rtmax"]))
expect_equal(fp_raw[, "mz"], fp[, "mz"])
expect_equal(fp_raw[, "mzmin"], fp[, "mzmin"])
expect_equal(fp_raw[, "mzmax"], fp[, "mzmax"])
## Values are expected to be different, but still correlated!
expect_true(all(fp_raw[, "into"] != fp[, "into"]))
expect_true(cor(fp_raw[, "into"], fp[, "into"]) > 0.99)
## Check if we can get the same data using the provided range.
## Use the .rawMat function
first <- filterFile(xod_xgrg, file = 1, keepAdjustedRtime = TRUE)
spctr <- spectra(first)
mzs <- lapply(spctr, mz)
vps <- lengths(mzs)
ints <- unlist(lapply(spctr, intensity), use.names = FALSE)
mzs <- unlist(mzs, use.names = FALSE)
rtim <- rtime(first)
idx <- which(fp[, "sample"] == 1)
for (i in idx) {
mtx <- .rawMat(mz = mzs, int = ints, scantime = rtim,
valsPerSpect = vps,
rtrange = fp[i, c("rtmin", "rtmax")],
mzrange = fp[i, c("mzmin", "mzmax")])
into <- sum(mtx[, 3], na.rm = TRUE) *
((fp[i, "rtmax"] - fp[i, "rtmin"]) /
(sum(rtim >= fp[i, "rtmin"] & rtim <= fp[i, "rtmax"]) - 1))
expect_equal(unname(into), unname(fp[i, "into"]))
}
## Drop them.
res_rem <- dropFilledChromPeaks(res_2)
expect_true(!.hasFilledPeaks(res_rem))
expect_equal(res_rem, xod_xgrg)
expect_error(fillChromPeaks(xod_xgrg, msLevel = 1:2,
param = FillChromPeaksParam()),
"for one MS level at a time")
expect_error(fillChromPeaks(xod_xgrg, param = FillChromPeaksParam(),
msLevel = 2L),
"No feature definitions")
})
test_that("fillChromPeaks,XCMSnExp works with only MS2 data", {
skip_on_os(os = "windows", arch = "i386")
tmp <- xod_xgrg
fData(tmp)[fromFile(tmp) == 2, "msLevel"] <- 2L
res <- fillChromPeaks(tmp, FillChromPeaksParam(fixedRt = 2))
expect_true(!any(chromPeakData(res)$is_filled[chromPeaks(res)[, "sample"] == 2]))
res_2 <- fillChromPeaks(xod_xgrg, FillChromPeaksParam(fixedRt = 2))
expect_true(nrow(chromPeaks(res_2)) > nrow(chromPeaks(res)))
expect_equal(chromPeaks(res)[chromPeaks(res)[, "sample"] == 1, ],
chromPeaks(res_2)[chromPeaks(res_2)[, "sample"] == 1, ])
})
test_that("fillChomPeaks,ChromPeakAreaParam works", {
skip_on_os(os = "windows", arch = "i386")
res <- fillChromPeaks(xod_xgrg, ChromPeakAreaParam())
expect_true(hasFilledChromPeaks(res))
})
test_that("fillChromPeaks,XCMSnExp with MSW works", {
skip_on_os(os = "windows", arch = "i386")
p <- MzClustParam()
fticr_xodg <- groupChromPeaks(fticr_xod, param = p)
expect_error(res <- fillChromPeaks(fticr_xod))
res <- fillChromPeaks(fticr_xodg)
## Got a signal for all of em.
expect_true(!any(is.na(featureValues(res))))
## OK
## 2) Check if the fillChromPeaks returns same/similar data than the
## findChromPeaks does:
fdef <- featureDefinitions(fticr_xodg)
pkArea <- do.call(
rbind,
lapply(
fdef$peakidx, function(z) {
tmp <- chromPeaks(fticr_xodg)[z, c("rtmin", "rtmax",
"mzmin", "mzmax"),
drop = FALSE]
pa <- c(median(tmp[, 1]), median(tmp[, 2]),
median(tmp[, 3]), median(tmp[, 4]))
return(pa)
}
))
colnames(pkArea) <- c("rtmin", "rtmax", "mzmin", "mzmax")
pkArea <- cbind(group_idx = 1:nrow(pkArea), pkArea,
mzmed = fdef$mzmed)
## Get peak data for all peaks in the first file
allPks <- .getMSWPeakData(filterFile(fticr_xodg, file = 1),
peakArea = pkArea,
sample_idx = 1,
cn = colnames(chromPeaks(fticr_xodg)))
curP <- chromPeaks(res)[chromPeaks(res)[, "sample"] == 1, ]
curP <- curP[order(curP[, "mz"]), ]
expect_equal(unname(allPks[, "mz"]), unname(curP[, "mz"]))
expect_equal(unname(allPks[, "maxo"]), unname(curP[, "maxo"]))
expect_true(cor(allPks[, "into"], curP[, "into"]) > 0.99) ## Not exactly the
## same but highly similar.
})
test_that("fillChromPeaks,XCMSnExp with matchedFilter works", {
skip_on_os(os = "windows", arch = "i386")
tmp <- findChromPeaks(faahko_od, param = MatchedFilterParam())
sg <- rep(1, length(fileNames(tmp)))
tmp <- groupChromPeaks(tmp, param = PeakDensityParam(sampleGroups = sg))
tmp_filled <- fillChromPeaks(tmp)
expect_true(sum(is.na(featureValues(tmp_filled))) <
sum(is.na(featureValues(tmp))))
nas <- is.na(featureValues(tmp)[, 1]) | is.na(featureValues(tmp)[, 2])
expect_true(cor(featureValues(tmp, value = "into")[!nas, 1],
featureValues(tmp, value = "into")[!nas, 2]) > 0.97)
expect_true(cor(featureValues(tmp_filled, value = "into")[, 1],
featureValues(tmp_filled, value = "into")[, 2],
use = "complete.obs") > 0.97)
## Check signal generation for already found peaks.
for (i in 1:length(fileNames(tmp))) {
fnd_pks <- chromPeaks(tmp)[chromPeaks(tmp)[, "sample"] == i, ]
prm <- processHistory(tmp, type ="Peak detection")[[1]]@param
## Extract the data for these using the internal function.
fld_pks <- .getChromPeakData_matchedFilter(filterFile(tmp, i),
peakArea = fnd_pks,
sample_idx = i,
param = prm,
cn = colnames(fnd_pks))
## rt can not be the same, since for fillChromPeaks it is the rt of the
## maximum signal and for findChromPeaks it is the rt of the apex of the
## filtered/fitted peak.
expect_true(cor(fnd_pks[, "rt"], fld_pks[, "rt"]) > 0.99)
## mz: also not the same; most likely due to slightly different binning.
diffs <- fnd_pks[, "mz"] - fld_pks[, "mz"]
expect_true(max(diffs) < 1e-4)
## into
expect_equal(unname(fnd_pks[, "into"]), unname(fld_pks[, "into"]))
## maxo
expect_equal(unname(fnd_pks[, "maxo"]), unname(fld_pks[, "maxo"]))
}
## modify fillChromPeaks settings.
tmp_fld_2 <- fillChromPeaks(
tmp, param = FillChromPeaksParam(ppm = 40, expandRt = 1))
expect_true(sum(is.na(featureValues(tmp_filled))) <
sum(is.na(featureValues(tmp))))
expect_true(sum(is.na(featureValues(tmp_fld_2))) <
sum(is.na(featureValues(tmp_filled))))
nas <- is.na(featureValues(tmp)[, 1]) | is.na(featureValues(tmp)[, 2])
expect_true(cor(featureValues(tmp_fld_2, value = "into")[, 1],
featureValues(tmp_fld_2, value = "into")[, 2],
use = "complete.obs") > 0.97)
})
test_that("writeMSData,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
## Write adjusted retention times
tmp_path <- tempdir()
nfls <- paste0(tmp_path, "/",
sub(".CDF$", "_2.mzML", basename(fileNames(xod_xgr))))
tmp <- filterRt(xod_xgr, rt = c(2500, 2700))
writeMSData(tmp, file = nfls)
data_in <- readMSData(nfls, mode = "onDisk")
expect_equal(unname(rtime(data_in)), unname(rtime(tmp)))
})
test_that("adjustRtime,XCMSnExp,Obiwarp works", {
skip_on_os(os = "windows", arch = "i386")
prm <- ObiwarpParam(centerSample = 3, subset = c(1, 2), binSize = 10)
expect_error(adjustRtime(xod_x, param = prm))
prm <- ObiwarpParam(centerSample = 2, subset = c(1, 2), binSize = 10)
res <- adjustRtime(xod_x, param = prm)
plotAdjustedRtime(res, col = c("#ff000060", "#00ff0060", "#0000ff60"))
expect_equal(rtime(xod_x, bySample = TRUE)[[2]],
rtime(xod_x, bySample = TRUE)[[2]])
expect_equal(rtime(xod_x, bySample = TRUE)[[3]],
rtime(xod_x, bySample = TRUE)[[3]])
prm <- ObiwarpParam(centerSample = 1, subset = c(1, 3), binSize = 10)
res <- adjustRtime(xod_x, param = prm)
plotAdjustedRtime(res, col = c("#ff000060", "#00ff0060", "#0000ff60"))
expect_equal(rtime(xod_x, bySample = TRUE)[[1]],
rtime(xod_x, bySample = TRUE)[[1]])
})
test_that("dropFilledChromPeaks,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
xod_tmp <- groupChromPeaks(
xod_xgr, param = PeakDensityParam(sampleGroups = rep(1, 3),
minFraction = 0.25))
xod_tmpf <- fillChromPeaks(
xod_tmp, param = FillChromPeaksParam(fixedRt = 30))
res <- dropFilledChromPeaks(xod_tmpf)
expect_equal(chromPeaks(res), chromPeaks(xod_xgr))
})
test_that("updateObject,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
tmp <- faahko_xod
en <- new("MsFeatureData")
en@.xData <- .copy_env(tmp@msFeatureData@.xData)
rownames(en$chromPeaks) <- NULL
tmp@msFeatureData <- en
expect_true(is.null(rownames(chromPeaks(tmp))))
tmp <- updateObject(tmp)
expect_true(!is.null(rownames(chromPeaks(tmp))))
})
test_that("filterMsLevel works with MS>1", {
skip_on_os(os = "windows", arch = "i386")
ms2 <- filterRt(as(pest_dda, "OnDiskMSnExp"), rt = c(200, 600))
res <- findChromPeaks(ms2, param = CentWaveParam(
prefilter = c(3, 1000)),
msLevel = 1)
res_1 <- filterMsLevel(res, msLevel = 1)
res_2 <- filterMsLevel(res, msLevel = 2)
expect_true(all(msLevel(res_1) == 1))
expect_true(all(msLevel(res_2) == 2))
expect_equal(chromPeaks(res_1), chromPeaks(res))
expect_equal(processHistory(res_1), processHistory(res))
expect_true(length(processHistory(res_2)) == 0)
expect_true(hasChromPeaks(res_1))
expect_false(hasChromPeaks(res_1, msLevel = 2L))
expect_false(hasChromPeaks(res_2))
})
test_that("chromPeakData,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
tmp <- xod_x
expect_error(chromPeakData(tmp) <- 5, "'chromPeakData' is supposed")
chromPeakData(tmp)$other_column <- "b"
expect_true(all(chromPeakData(tmp)$other_column == "b"))
res <- filterRt(tmp, rt = c(2800, 3000))
expect_true(hasChromPeaks(res))
expect_true(validObject(res))
expect_true(all(chromPeakData(res)$other_column == "b"))
expect_true(any(colnames(chromPeakData(res)) == "other_column"))
res <- filterMz(tmp, mz = c(400, 500))
expect_true(hasChromPeaks(res))
expect_true(validObject(res))
expect_true(all(chromPeakData(res)$other_column == "b"))
expect_true(any(colnames(chromPeakData(res)) == "other_column"))
res <- filterMsLevel(tmp, msLevel = 2L)
expect_true(length(res) == 0)
expect_false(hasChromPeaks(res))
res <- filterMsLevel(tmp, msLevel = 1L)
expect_equal(chromPeaks(res), chromPeaks(tmp))
expect_equal(chromPeakData(res), chromPeakData(tmp))
res <- filterFile(tmp, 2)
expect_true(hasChromPeaks(res))
expect_true(validObject(res))
expect_true(all(chromPeakData(res)$other_column == "b"))
expect_true(any(colnames(chromPeakData(res)) == "other_column"))
tmp <- groupChromPeaks(tmp, param = PeakDensityParam(sampleGroups = rep(1, 3)))
res <- fillChromPeaks(tmp)
expect_true(hasChromPeaks(res))
expect_true(validObject(res))
expect_true(is.character(chromPeakData(res)$other_column))
expect_true(any(colnames(chromPeakData(res)) == "other_column"))
})
test_that("plot,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
mzr <- c(301.9, 302.1)
rtr <- c(2500, 2650)
tmp <- filterMz(filterRt(xod_x, rtr), mzr)
centroided(tmp) <- TRUE
plot(tmp[1:3], type = "spectra")
plot(tmp, type = "XIC")
})
test_that("refineChromPeaks,CleanPeaksParam works", {
skip_on_os(os = "windows", arch = "i386")
rtw <- chromPeaks(xod_x)[, "rtmax"] - chromPeaks(xod_x)[, "rtmin"]
res <- refineChromPeaks(xod_x, param = CleanPeaksParam(20))
rtw2 <- chromPeaks(res)[, "rtmax"] - chromPeaks(res)[, "rtmin"]
expect_true(all(rtw2 < 20))
res <- refineChromPeaks(xod_x, param = CleanPeaksParam(1))
expect_true(length(chromPeaks(res)) == 0)
expect_true(is(processHistory(res)[[2]]@param, "CleanPeaksParam"))
expect_warning(res <- refineChromPeaks(xod_x, param = CleanPeaksParam(20),
msLevel = 2L))
expect_equal(chromPeaks(res), chromPeaks(xod_x))
res <- refineChromPeaks(xod_xgr, param = CleanPeaksParam(20))
expect_true(hasAdjustedRtime(res))
res <- refineChromPeaks(xod_xgrg, param = CleanPeaksParam(20))
expect_true(hasFeatures(xod_xgrg))
expect_false(hasFeatures(res))
## Fake MS level > 1
tmp <- xod_x
fd <- new("MsFeatureData")
fd@.xData <- .copy_env(tmp@msFeatureData)
chromPeakData(fd)$ms_level <- 2L
lockEnvironment(fd, bindings = TRUE)
tmp@msFeatureData <- fd
expect_true(hasChromPeaks(tmp, msLevel = 2L))
tmp <- findChromPeaks(tmp, add = TRUE,
param = CentWaveParam(prefilter = c(5, 10000),
noise = 10000, sn = 40))
expect_true(hasChromPeaks(tmp, msLevel = 1L))
res <- refineChromPeaks(tmp, msLevel = 1L, param = CleanPeaksParam(20))
expect_equal(chromPeaks(tmp, msLevel = 2L), chromPeaks(res, msLevel = 2L))
expect_true(nrow(chromPeaks(tmp, msLevel = 1L)) >
nrow(chromPeaks(res, msLevel = 1L)))
res_2 <- refineChromPeaks(res, msLevel = 2L, param = CleanPeaksParam(20))
expect_equal(chromPeaks(res, msLevel = 1L), chromPeaks(res_2, msLevel = 1L))
expect_true(nrow(chromPeaks(res, msLevel = 2L)) >
nrow(chromPeaks(res_2, msLevel = 2L)))
})
test_that("refineChromPeaks,MergeNeighboringPeaksParam works", {
skip_on_os(os = "windows", arch = "i386")
prm <- MergeNeighboringPeaksParam(expandRt = 4)
res <- refineChromPeaks(xod_xgr, param = prm)
expect_true(hasAdjustedRtime(res))
expect_equal(rtime(xod_xgr), rtime(res))
pks_old <- chromPeaks(res)[!chromPeakData(res)$merged, ]
expect_equal(chromPeaks(xod_xgr)[rownames(pks_old), ], pks_old)
expect_equal(rownames(chromPeaks(res)), rownames(chromPeakData(res)))
expect_true(nrow(chromPeaks(res)) < nrow(chromPeaks(xod_xgr)))
expect_warning(res <- refineChromPeaks(as(od_x, "XCMSnExp"), param = prm),
"Please run")
prm <- MergeNeighboringPeaksParam(expandRt = 10, ppm = 50)
res <- refineChromPeaks(pest_swth, param = prm)
expect_equal(chromPeaks(res), chromPeaks(pest_swth))
expect_true(all(chromPeakData(res)$merged == FALSE))
res <- refineChromPeaks(pest_swth, param = prm, msLevel = 2L)
expect_equal(chromPeaks(res, msLevel = 1L),
chromPeaks(pest_swth, msLevel = 1L))
expect_true(nrow(chromPeaks(res, msLevel = 2L)) <
nrow(chromPeaks(pest_swth, msLevel = 2L)))
## With fake MS level 2 data.
tmp <- xod_x
fd <- new("MsFeatureData")
fd@.xData <- .copy_env(tmp@msFeatureData)
chromPeakData(fd)$ms_level <- 2L
lockEnvironment(fd, bindings = TRUE)
tmp@msFeatureData <- fd
expect_true(hasChromPeaks(tmp, msLevel = 2L))
tmp <- findChromPeaks(tmp, add = TRUE,
param = CentWaveParam(prefilter = c(5, 10000),
noise = 10000, sn = 40))
prm <- MergeNeighboringPeaksParam(expandRt = 4)
res <- refineChromPeaks(tmp, param = prm, msLevel = 1L)
expect_true(nrow(chromPeaks(res, msLevel = 1L)) <
nrow(chromPeaks(tmp, msLevel = 1L)))
expect_equal(chromPeaks(res, msLevel = 2L), chromPeaks(tmp, msLevel = 2L))
})
test_that("refineChromPeaks,FilterIntensityParam works", {
skip_on_os(os = "windows", arch = "i386")
pks <- chromPeaks(xod_x)
prm <- FilterIntensityParam(nValues = 1, threshold = 50000)
res <- refineChromPeaks(xod_x, param = prm, msLevel = 2L)
expect_equal(chromPeaks(res), chromPeaks(xod_x))
res <- refineChromPeaks(xod_x, param = prm, msLevel = 1L)
x <- filterRt(xod_x, rt = c(2500, 3500))
prm <- FilterIntensityParam(nValues = 2, threshold = 50000)
res <- refineChromPeaks(xod_x, param = prm)
expect_true(all(chromPeaks(res)[, "maxo"] > 50000))
res <- refineChromPeaks(xod_x, param = prm, msLevel = 3)
expect_equal(chromPeaks(res), chromPeaks(xod_x))
## With a real object having MS2.
prm <- FilterIntensityParam(nValues = 2, threshold = 50000)
res <- refineChromPeaks(pest_swth, param = prm, msLevel = 1L)
expect_equal(chromPeaks(res, msLevel = 2L),
chromPeaks(pest_swth, msLevel = 2L))
expect_true(nrow(chromPeaks(res, msLevel = 1L)) == 0)
res <- refineChromPeaks(pest_swth, param = prm, msLevel = 2L)
expect_equal(chromPeaks(res, msLevel = 1L),
chromPeaks(pest_swth, msLevel = 1L))
expect_true(nrow(chromPeaks(res, msLevel = 2L)) == 0)
})
test_that("filterChromPeaks,XCMSnExp works", {
skip_on_os(os = "windows", arch = "i386")
res <- filterChromPeaks(xod_x, keep = c(5, 23, 3))
expect_true(nrow(chromPeaks(res)) == 3)
expect_equal(chromPeaks(res), chromPeaks(xod_x)[c(3, 5, 23), ])
expect_error(filterChromPeaks(xod_x, keep = 1235), "out of bounds")
res <- filterChromPeaks(xod_xg, keep = c(8, 197, 14))
expect_equal(chromPeaks(res), chromPeaks(xod_xg)[c(8, 14, 197), ])
expect_true(nrow(featureDefinitions(res)) == 2)
## chromPeak 14 is part of feature 6
tmp <- featureValues(xod_xg)[6, ]
tmp[3] <- NA
expect_equal(featureValues(res)[1, ], tmp)
## chromPeaks 8 and 197 are part of feature 46
expect_equal(featureValues(res)[2, ], featureValues(xod_xg)[46, ])
})
test_that("manualChromPeaks works", {
skip_on_os(os = "windows", arch = "i386")
cp <- cbind(mzmin = c(453, 301.9, 100),
mzmax = c(453.5, 302.1, 102),
rtmin = c(2400, 2500, 2460),
rtmax = c(2700, 2650, 2500))
## Errors
expect_error(manualChromPeaks(xod_x, msLevel = 1:2), "can only add")
expect_error(manualChromPeaks(xod_x, 1:2), "lacks one or more of the")
expect_error(manualChromPeaks(xod_x, cp, samples = 10), "out of bounds")
## With an XCMSnExp
res <- manualChromPeaks(xod_x, cp)
expect_true(nrow(chromPeaks(res)) > nrow(chromPeaks(xod_x)))
expect_equal(chromPeaks(res)[!is.na(chromPeaks(res)[, "intb"]), ],
chromPeaks(xod_x))
## With an OnDiskMSnExp
res2 <- manualChromPeaks(od_x, cp)
expect_true(is(res2, "XCMSnExp"))
expect_true(hasChromPeaks(res2))
res3 <- manualChromPeaks(od_x, cp, samples = 2)
expect_true(all(chromPeaks(res3)[, "sample"] == 2))
})
test_that("manualFeatures works", {
skip_on_os(os = "windows", arch = "i386")
idx <- list(1:4, c(4, "a"))
## Add features to an XCMSnExp without features.
expect_error(manualFeatures(xod_x, idx), "out of bounds")
idx <- list(1:4, c(5, 500, 500))
expect_error(manualFeatures(xod_x, idx), "out of bounds")
idx <- list(1:5, c(6, 34, 234))
res <- manualFeatures(xod_x, idx)
expect_true(hasFeatures(res))
expect_true(nrow(featureDefinitions(res)) == 2)
expect_equal(featureDefinitions(res)$peakidx, idx)
## Append features to an XCMSnExp.
idx <- featureDefinitions(xod_xg)$peakidx[c(3, 5, 7)]
res <- manualFeatures(xod_xg, idx)
nfd <- nrow(featureDefinitions(xod_xg))
expect_true(nrow(featureDefinitions(res)) == nfd + 3)
expect_equal(featureDefinitions(res)[nfd + 1, "mzmed"],
featureDefinitions(xod_xg)[3, "mzmed"])
expect_equal(featureDefinitions(res)[nfd + 2, "rtmin"],
featureDefinitions(xod_xg)[5, "rtmin"])
})
test_that("featureSpectra works", {
skip_on_os(os = "windows", arch = "i386")
## For now we don't have MS1/MS2 data, so we have to stick to errors etc.
expect_error(ms2_mspectrum_for_features(xod_x, method = "other"))
expect_error(res <- featureSpectra(xod_x))
expect_warning(res <- featureSpectra(xod_xg, return.type = "list"))
expect_true(length(res) == nrow(featureDefinitions(xod_xg)))
expect_equal(names(res), rownames(featureDefinitions(xod_xg)))
expect_warning(res <- featureSpectra(xod_xg, return.type = "MSpectra"))
expect_true(is(res, "MSpectra"))
expect_true(length(res) == 0)
expect_warning(res <- featureSpectra(xod_xg, msLevel = 1L))
expect_true(length(res) == 0)
res <- featureSpectra(xod_xg, method = "closest_rt", msLevel = 1L,
return.type = "List")
expect_equal(length(res), nrow(featureDefinitions(xod_xg)))
for (i in seq_along(res)) {
expect_true(is(res[[i]], "Spectra"))
}
res2 <- featureSpectra(xod_xg, msLevel = 2L, return.type = "Spectra")
expect_true(length(res2) == 0)
})
test_that("filterFeatureDefinitions works", {
skip_on_os(os = "windows", arch = "i386")
tmp <- xod_xgrg
expect_error(filterFeatureDefinitions("a"))
expect_error(filterFeatureDefinitions(xod_xgr, 1:3))
expect_error(filterFeatureDefinitions(tmp, c("FT01", "other")))
expect_error(filterFeatureDefinitions(tmp, 1:4000))
tmp <- filterFeatureDefinitions(tmp, features = 11:30)
expect_equal(nrow(featureDefinitions(tmp)), 20)
expect_equal(rownames(featureDefinitions(tmp)), paste0("FT", 11:30))
## Check if we have the correct process history
ph <- processHistory(tmp)[[length(processHistory(tmp))]]
expect_true(is(processParam(ph), "GenericParam"))
expect_true(processParam(ph)@fun == "filterFeatureDefinitions")
tmp <- dropFeatureDefinitions(tmp)
expect_true(length(processHistory(tmp)) == 3)
ph <- processHistory(tmp)[[length(processHistory(tmp))]]
expect_true(!is(processParam(ph), "GenericParam"))
})
test_that("findChromPeaksIsolationWindow works", {
skip_on_os(os = "windows", arch = "i386")
obj <- filterRt(as(pest_swth, "OnDiskMSnExp"), rt = c(0, 300))
cwp <- CentWaveParam(snthresh = 5, noise = 100, ppm = 10,
peakwidth = c(3, 30), prefilter = c(2, 1000))
res <- findChromPeaksIsolationWindow(obj, param = cwp)
expect_true(is(res, "XCMSnExp"))
expect_equal(length(processHistory(res)), 1)
expect_true(all(c("isolationWindow", "isolationWindowTargetMZ") %in%
colnames(chromPeakData(res))))
expect_true(all(chromPeakData(res)$ms_level == 2L))
## Add to existing peaks
obj <- findChromPeaks(obj, param = cwp)
res_2 <- findChromPeaksIsolationWindow(obj, param = cwp)
expect_equal(chromPeaks(res_2)[1:nrow(chromPeaks(obj)), , drop = FALSE],
chromPeaks(obj))
expect_true(length(processHistory(res_2)) == 2)
## no isolation window/add isolation window
expect_error(findChromPeaksIsolationWindow(od_x), "are NA")
tmp <- od_x
cwp <- CentWaveParam(noise = 10000, snthresh = 40, prefilter = c(3, 10000))
fData(tmp)$my_win <- 1
res_3 <- findChromPeaksIsolationWindow(
tmp, param = cwp, isolationWindow = fData(tmp)$my_win, msLevel = 1L)
expect_equal(chromPeaks(xod_x), chromPeaks(res_3))
expect_true(all(chromPeakData(res_3)$isolationWindow == 1))
res_4 <- findChromPeaksIsolationWindow(
xod_x, param = cwp, isolationWindow = rep(1, length(xod_x)),
msLevel = 1L)
expect_equal(chromPeaks(res_4)[1:nrow(chromPeaks(xod_x)), ],
chromPeaks(xod_x))
})
test_that("reconstructChromPeakSpectra works", {
res <- reconstructChromPeakSpectra(
pest_swth, peakId = rownames(chromPeaks(pest_swth))[5:6])
expect_true(length(res) == 2)
expect_s4_class(res, "Spectra")
expect_true(length(intensity(res)[[2]]) == 2)
## peakId
res_3 <- reconstructChromPeakSpectra(pest_swth, peakId = c("CP06"))
expect_identical(intensity(res_3), intensity(res[2]))
expect_warning(res <- reconstructChromPeakSpectra(
pest_swth, peakId = c("CP06", "other")))
expect_identical(mz(res_3), mz(res))
expect_error(reconstructChromPeakSpectra(pest_swth, peakId = c("a", "b")),
"None of the provided")
})
test_that("fillChromPeaks,XcmsExperiment works with verboseBetaColumns", {
p <- CentWaveParam(noise = 10000, snthresh = 40, prefilter = c(3, 10000),
verboseBetaColumns = TRUE)
res <- findChromPeaks(od_x, param = p)
expect_true(all(c("beta_cor", "beta_snr") %in% colnames(chromPeaks(res))))
p <- PeakDensityParam(sampleGroups = rep(1, 3))
res <- groupChromPeaks(res, param = p)
res <- fillChromPeaks(res, ChromPeakAreaParam())
pks_det <- chromPeaks(res)[!chromPeakData(res)$is_filled, ]
pks_fil <- chromPeaks(res)[chromPeakData(res)$is_filled, ]
expect_true(sum(is.na(pks_fil[, "beta_cor"])) < 4)
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.