Update the do_detectFeatures_centWave function

o Update the do_detectFeatures_centWave function to the latest code. o Fix a bug in the [ method for xcmsRaw.
sneumann · Sep 28, 2016 · baf28d1 · baf28d1
1 parent 8a65c66
commit baf28d1
Show file tree

Hide file tree

Showing 6 changed files with 824 additions and 681 deletions.
diff --git a/R/do_detectFeatures-functions.R b/R/do_detectFeatures-functions.R
diff --git a/R/methods-xcmsRaw.R b/R/methods-xcmsRaw.R
diff --git a/inst/unitTests/runit.splitRaw.R b/inst/unitTests/runit.splitRaw.R
@@ -47,14 +47,16 @@ testSplitRawNone <- function() {
 
 ############################################################
 ## Subset an xcmsRaw object by scan index.
-test_bracked_subset_xcmsRaw <- function() {
+test_bracket_subset_xcmsRaw <- function() {
     ## Get scans 1:10
     xsub <- xraw[1:10]
     checkIdentical(xraw@scantime[1:10], xsub@scantime)
     checkIdentical(xraw@scanindex[1:10], xsub@scanindex[1:10])
     checkIdentical(xraw@env$mz[1:xraw@scanindex[11]], xsub@env$mz)
     checkIdentical(xraw@env$intensity[1:xraw@scanindex[11]], xsub@env$intensity)
 
+    ## Check if mz is sorted:
+
     ## Check using logical
     bm <- rep(FALSE, length(xraw@scanindex))
     bm[1:10] <- TRUE
@@ -74,6 +76,10 @@ test_bracked_subset_xcmsRaw <- function() {
     i <- c(5, 99, 317)
     xsub <- xraw[i]
     checkIdentical(xsub@scantime, xraw@scantime[i])
+    ## scanindex:
+    vps <- diff(c(xraw@scanindex, length(xraw@env$mz)))
+    scnidx <- xcms:::valueCount2ScanIndex(vps[i])
+    checkEquals(scnidx, xsub@scanindex)
     whichIdx <- c(((xraw@scanindex[5] + 1):xraw@scanindex[6]),
     ((xraw@scanindex[99] + 1):xraw@scanindex[100]),
     ((xraw@scanindex[317] + 1):xraw@scanindex[318]))

diff --git a/inst/unitTests/test_do_detectFeatures_centWave.R b/inst/unitTests/test_do_detectFeatures_centWave.R
@@ -31,54 +31,56 @@ test_do_detectFeatures_centWave <- function() {
 ## to evaluate that results are identical.
 dontrun_test_do_detectFeatures_centWave_impl <- function() {
 
-    ppm = 25
-    peakwidth = c(20, 50)
-    snthresh = 10
-    prefilter = c(3, 100)
-    mzCenterFun = "wMean"
-    integrate = 1
-    mzdiff = -0.001
-    fitgauss = FALSE
-    noise = 0
-    verboseColumns = FALSE
-
-    xr <- xcmsRaw(fs[1])
-
-    ## Default settings
-    .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
-                   integrate, mzdiff, fitgauss, noise, verboseColumns)
-    ## xcms: 14.6 sec
-    ## do_ : 13 sec
-
-    ppm <- 10
-    .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
-                   integrate, mzdiff, fitgauss, noise, verboseColumns)
-    ## xcms: 15 sec
-    ## do_ : 13.3 sec
-
-    peakwidth <- c(3, 30)
-    .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
-                   integrate, mzdiff, fitgauss, noise, verboseColumns)
-    ## xcms: 11.4 sec
-    ## do_ :  9.5 sec
-
-    snthresh <- 15
-    .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
-                   integrate, mzdiff, fitgauss, noise, verboseColumns)
-    ## xcms: 10.6 sec
-    ## do_ :  8.8 sec
-
-    fitgauss <- TRUE
-    .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
-                   integrate, mzdiff, fitgauss, noise, verboseColumns)
-    ## xcms: 12.5 sec
-    ## do_ : 10.7 sec
-
-    verboseColumns <- TRUE
-    .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
+    for (i in 1:length(fs)) {
+        ppm = 25
+        peakwidth = c(20, 50)
+        snthresh = 10
+        prefilter = c(3, 100)
+        mzCenterFun = "wMean"
+        integrate = 1
+        mzdiff = -0.001
+        fitgauss = FALSE
+        noise = 0
+        verboseColumns = FALSE
+
+        xr <- xcmsRaw(fs[i])
+
+        ## Default settings
+        .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
+                       integrate, mzdiff, fitgauss, noise, verboseColumns)
+        ## xcms: 14.6 sec
+        ## do_ : 13 sec
+
+        ppm <- 10
+        .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
                    integrate, mzdiff, fitgauss, noise, verboseColumns)
-    ## xcms: 12.2 sec
-    ## do_ : 10.6 sec
+        ## xcms: 15 sec
+        ## do_ : 13.3 sec
+
+        peakwidth <- c(3, 30)
+        .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
+                       integrate, mzdiff, fitgauss, noise, verboseColumns)
+        ## xcms: 11.4 sec
+        ## do_ :  9.5 sec
+
+        snthresh <- 15
+        .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
+                       integrate, mzdiff, fitgauss, noise, verboseColumns)
+        ## xcms: 10.6 sec
+        ## do_ :  8.8 sec
+
+        fitgauss <- TRUE
+        .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
+                       integrate, mzdiff, fitgauss, noise, verboseColumns)
+        ## xcms: 12.5 sec
+        ## do_ : 10.7 sec
+
+        verboseColumns <- TRUE
+        .runAndCompare(xr, ppm, peakwidth, snthresh, prefilter, mzCenterFun,
+                       integrate, mzdiff, fitgauss, noise, verboseColumns)
+        ## xcms: 12.2 sec
+        ## do_ : 10.6 sec
+    }
 }
 
 
@@ -90,18 +92,29 @@ dontrun_test_do_detectFeatures_centWave_impl <- function() {
     scantime <- xr@scantime
     scanindex <- xr@scanindex
     a <- system.time(
-        xrDo <- xcms:::do_detectFeatures_centWave(mz, int, scantime,
-                                                  diff(c(scanindex, length(mz))),
-                                                  ppm = ppm,
-                                                  peakwidth = peakwidth,
-                                                  snthresh = snthresh,
-                                                  prefilter = prefilter,
-                                                  mzCenterFun = mzCenterFun,
-                                                  integrate = integrate,
-                                                  mzdiff = mzdiff,
-                                                  fitgauss = fitgauss,
-                                                  noise = noise,
-                                                  verboseColumns = verboseColumns)
+        ## xrDo <- xcms:::do_detectFeatures_centWave(mz, int, scantime,
+        ##                                           diff(c(scanindex, length(mz))),
+        ##                                           ppm = ppm,
+        ##                                           peakwidth = peakwidth,
+        ##                                           snthresh = snthresh,
+        ##                                           prefilter = prefilter,
+        ##                                           mzCenterFun = mzCenterFun,
+        ##                                           integrate = integrate,
+        ##                                           mzdiff = mzdiff,
+        ##                                           fitgauss = fitgauss,
+        ##                                           noise = noise,
+        ##                                           verboseColumns = verboseColumns)
+        xrDo <- xcms:::.centWave_orig(mz = mz, int = int, scantime = scantime,
+                                      valsPerSpect = diff(c(scanindex, length(mz))),
+                                      ppm = ppm, peakwidth = peakwidth,
+                                      snthresh = snthresh,
+                                      prefilter = prefilter,
+                                      mzCenterFun = mzCenterFun,
+                                      integrate = integrate,
+                                      mzdiff = mzdiff,
+                                      fitgauss = fitgauss,
+                                      noise = noise,
+                                      verboseColumns = verboseColumns)
     ) ## 12.7
     ## Run the findPeaks.centWave on the xcmsRaw.
     b <- system.time(

diff --git a/inst/unitTests/test_new_scanrange_subsetting.R b/inst/unitTests/test_new_scanrange_subsetting.R
@@ -0,0 +1,43 @@
+############################################################
+## This test file is supposed to be removed once the subsetting
+## of xcmsRaw objects in the findPeaks methods prior to feature
+## detection has been tested and is working as expected.
+## issue #62
+library(faahKO)
+fs <- system.file('cdf/KO/ko15.CDF', package = "faahKO")
+xraw <- xcmsRaw(fs, profstep = 0)
+
+test_scanrange_centWave <- function() {
+    ## Without sub-setting
+    res_1 <- findPeaks.centWave(xraw)
+    res_2 <- xcms:::.findPeaks.centWave_scanrange(xraw)
+    checkIdentical(res_1, res_2)
+
+    scnr <- c(90, 345)
+    res_1 <- findPeaks.centWave(xraw, scanrange = scnr)
+    res_2 <- xcms:::.findPeaks.centWave_scanrange(xraw, scanrange = scnr)
+    ## checkIdentical(res_1, res_2)
+    ## Does NOT work: scalerange e.g. depends on scantime.
+
+    scnr <- c(1, 400)
+    res_1 <- findPeaks.centWave(xraw, scanrange = scnr)
+    res_2 <- xcms:::.findPeaks.centWave_scanrange(xraw, scanrange = scnr)
+    ## checkIdentical(res_1, res_2)
+    ## Does NOT work: scalerange e.g. depends on scantime.
+}
+
+test_scanrange_matchedFilter <- function() {
+    ## Without sub-setting
+    res_1 <- findPeaks.matchedFilter(xraw)
+    res_2 <- xcms:::.findPeaks.matchedFilter_scanrange(xraw)
+    checkIdentical(res_1, res_2)
+
+    scnr <- c(90, 345)
+    res_1 <- findPeaks.matchedFilter(xraw, scanrange = scnr)
+    res_2 <- xcms:::.findPeaks.matchedFilter_scanrange(xraw, scanrange = scnr)
+    ## checkIdentical(res_1, res_2)
+    ## WHY??
+}
+
+test_scanrange_massifquant <- function() {
+}
diff --git a/man/do_detectFeatures_centWave.Rd b/man/do_detectFeatures_centWave.Rd