Add possibility to fill the signal area of detected peaks

- Add option type = "polygon" that allows to fill the signal area of detected chromatographic peaks (issue #324). - Add related unit tests and update documentation and vignette. - Use transparent colors in the vignette.
sneumann · Oct 26, 2018 · 928b049 · 928b049
1 parent a26a40e
commit 928b049
Show file tree

Hide file tree

Showing 7 changed files with 128 additions and 42 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: xcms
-Version: 3.3.5
+Version: 3.3.6
 Date: 2018-10-26
 Title: LC/MS and GC/MS Data Analysis
 Author: Colin A. Smith <csmith@scripps.edu>,

diff --git a/R/functions-XCMSnExp.R b/R/functions-XCMSnExp.R
@@ -1093,21 +1093,25 @@ plotChromPeakDensity <- function(object, mz, rt, param, simulate = TRUE,
 #' @param mz \code{numeric(2)} with the mz range from which the peaks should
 #'     be extracted and plotted.
 #'
-#' @param border colors to be used to color the border of the rectangles. Has to
-#'     be equal to the number of samples in \code{x}.
+#' @param border colors to be used to color the border of the rectangles/peaks.
+#'     Has to be equal to the number of samples in \code{x}.
 #' 
 #' @param lwd \code{numeric(1)} defining the width of the line/border.
 #'
 #' @param col For \code{highlightChromPeaks}: color to be used to fill the
-#'     rectangle.
+#'     rectangle (if \code{type = "rect"}) or the peak
+#'     (for \code{type = "polygon"}).
 #'
 #' @param type the plotting type. See \code{\link{plot}} in base grapics for
 #'     more details.
 #'     For \code{highlightChromPeaks}: \code{character(1)} defining how the peak
 #'     should be highlighted: \code{type = "rect"} draws a rectangle
 #'     representing the peak definition, \code{type = "point"} indicates a
 #'     chromatographic peak with a single point at the position of the peak's
-#'     \code{"rt"} and \code{"maxo"}.
+#'     \code{"rt"} and \code{"maxo"} and \code{type = "polygon"} will highlight
+#'     the peak shape. For \code{type = "polygon"} the color of the border and
+#'     area can be defined with parameters \code{"border"} and \code{"col"},
+#'     respectively.
 #'
 #' @param whichPeaks \code{character(1)} specifying how peaks are called to be
 #'     located within the region defined by \code{mz} and \code{rt}. Can be
@@ -1146,10 +1150,16 @@ plotChromPeakDensity <- function(object, mz, rt, param, simulate = TRUE,
 #' chromPeaks(xod, rt = c(2700, 2900), mz = 335)
 #' 
 #' ## Highlight the chromatographic peaks in the area
+#' ## Show the peak definition with a rectangle
 #' highlightChromPeaks(xod, rt = c(2700, 2900), mz = 335)
+#'
+#' ## Color the actual peak
+#' highlightChromPeaks(xod, rt = c(2700, 2900), mz = 335,
+#'     col = c("#ff000020", "#00ff0020"), type = "polygon")
 highlightChromPeaks <- function(x, rt, mz,
                                 border = rep("00000040", length(fileNames(x))),
-                                lwd = 1, col = NA, type = c("rect", "point"),
+                                lwd = 1, col = NA,
+                                type = c("rect", "point", "polygon"),
                                 whichPeaks = c("any", "within", "apex_within"),
                                 ...) {
     type <- match.arg(type)
@@ -1169,32 +1179,52 @@ highlightChromPeaks <- function(x, rt, mz,
     if (length(border) != n_samples)
         border <- rep(border[1], n_samples)
     if (length(pks)) {
-        if (type == "rect")
-            rect(xleft = pks[, "rtmin"], xright = pks[, "rtmax"],
-                 ybottom = rep(0, nrow(pks)), ytop = pks[, "maxo"],
-                 border = border[pks[, "sample"]], lwd = lwd,
-                 col = col[pks[, "sample"]])
-        if (type == "point") {
-            ## Fix assignment of point types for each sample.
-            dots <- list(...)
-            if (any(names(dots) == "bg")) {
-                bg <- dots$bg
-                if (length(bg) != n_samples)
-                    bg <- rep_len(bg[1], n_samples)
-                dots$bg <- bg[pks[, "sample"]]
-            }
-            if (any(names(dots) == "pch")) {
-                pch <- dots$pch
-                if (length(pch) != n_samples)
-                    pch <- rep_len(pch[1], n_samples)
-                dots$pch <- pch[pks[, "sample"]]
-            }
-            if (any(is.na(col)))
-                col <- border
-            ## Draw a point at the position defined by the "rt" column
-            do.call("points", args = c(list(x = pks[, "rt"], y = pks[, "maxo"],
-                                            col = col[pks[, "sample"]]), dots))
-        }
+        switch(type,
+               rect = rect(xleft = pks[, "rtmin"], xright = pks[, "rtmax"],
+                           ybottom = rep(0, nrow(pks)), ytop = pks[, "maxo"],
+                           border = border[pks[, "sample"]], lwd = lwd,
+                           col = col[pks[, "sample"]]),
+               point = {
+                   ## Fix assignment of point types for each sample.
+                   dots <- list(...)
+                   if (any(names(dots) == "bg")) {
+                       bg <- dots$bg
+                       if (length(bg) != n_samples)
+                           bg <- rep_len(bg[1], n_samples)
+                       dots$bg <- bg[pks[, "sample"]]
+                   }
+                   if (any(names(dots) == "pch")) {
+                       pch <- dots$pch
+                       if (length(pch) != n_samples)
+                           pch <- rep_len(pch[1], n_samples)
+                       dots$pch <- pch[pks[, "sample"]]
+                   }
+                   if (any(is.na(col)))
+                       col <- border
+                       ## Draw a point at the position defined by the "rt" column
+                       do.call("points",
+                               args = c(list(x = pks[, "rt"],
+                                             y = pks[, "maxo"],
+                                             col = col[pks[, "sample"]]), dots))
+               },
+               polygon = {
+                   if (nrow(pks)) {
+                       chrs <- chromatogram(x, rt = rt, mz = mz)
+                       pks <- pks[order(pks[, "maxo"], decreasing = TRUE), ,
+                                  drop = FALSE]
+                       for (j in seq_len(nrow(pks))) {
+                           i <- pks[j, "sample"]
+                           chr <- filterRt(chrs[1, i],
+                                           rt = pks[j, c("rtmin", "rtmax")])
+                           xs <- rtime(chr)
+                           xs <- c(xs, xs[length(xs)], xs[1])
+                           ys <- c(intensity(chr), 0, 0)
+                           nona <- !is.na(ys)
+                           polygon(xs[nona], ys[nona], border = border[i],
+                                   col = col[i])
+                       }
+                   }
+               })
     }
 }
 

diff --git a/inst/NEWS b/inst/NEWS
@@ -1,3 +1,9 @@
+Changes in version 3.3.6
+
+- Add type = "polygon" to highlightChromPeaks allowing to fill the actual
+  signal area of identified chromatographic peaks.
+
+
 Changes in version 3.3.5
 
 - Performance enhancement of the chromPeakSpectra and featureSpectra functions.

diff --git a/man/highlightChromPeaks.Rd b/man/highlightChromPeaks.Rd
diff --git a/tests/testthat/test_functions-XCMSnExp.R b/tests/testthat/test_functions-XCMSnExp.R
@@ -265,3 +265,13 @@ test_that("featureChromatograms works", {
     expect_error(featureChromatograms(xod_xgrg, features = c("a", "FT02")))
 })
 
+test_that("highlightChromPeaks works", {
+    mzr <- c(279, 279)
+    rtr <- c(2700, 2850)
+    chr <- chromatogram(xod_xgrg, mz = mzr, rt = rtr)
+    plot(chr)
+    pks <- chromPeaks(xod_xgrg, mz = mzr, rt = rtr, type = "apex_within")
+    highlightChromPeaks(xod_xgrg, mz = mzr, rt = rtr)
+    highlightChromPeaks(xod_xgrg, mz = mzr, rt = rtr, type = "polygon",
+                        col = c("#ff000020", "#00ff0020", "#0000ff20"))
+})
diff --git a/vignettes/xcms.Rmd b/vignettes/xcms.Rmd
@@ -153,7 +153,7 @@ could set `aggregationFun` to `sum`.
 ## Get the base peak chromatograms. This reads data from the files.
 bpis <- chromatogram(raw_data, aggregationFun = "max")
 ## Define colors for the two groups
-group_colors <- brewer.pal(3, "Set1")[1:2]
+group_colors <- paste0(brewer.pal(3, "Set1")[1:2], "60")
 names(group_colors) <- c("KO", "WT")
 
 ## Plot all chromatograms.
@@ -322,7 +322,22 @@ appropriate and correctly identified the expected peaks.
 ```{r  peak-detection-highlight-chrom-peaks-plot, message = FALSE, fig.align = "center", fig.width = 10, fig.height = 8, fig.cap = "Signal for an example peak. Red and blue colors represent KO and wild type samples, respectively. The rectangles indicate the identified chromatographic peaks per sample." }
 plot(chr_raw, col = group_colors[chr_raw$sample_group], lwd = 2)
 highlightChromPeaks(xdata, border = group_colors[chr_raw$sample_group],
-		    lty = 3, rt = rtr, mz = mzr) 
+		    lty = 3, rt = rtr, mz = mzr, type = "rect") 
+```
+
+In the plot above the peak definitions are indicated with rectangles containing
+the full peak. In addition it is possible to represent the apex position of each
+peak with a single point (passing argument `type = "point"` to the function), or
+draw the actually identified peak by specifying `type = "polygon"`. Below we use
+this option to fill the peak area for each identified chromatographic peak in
+each sample. Whether individual peaks can be still identified in such a plot
+depends however on the number of samples from which peaks are drawn.
+
+```{r  peak-detection-highlight-chrom-peaks-plot-polygon, message = FALSE, fig.align = "center", fig.width = 10, fig.height = 8, fig.cap = "Signal for an example peak. Red and blue colors represent KO and wild type samples, respectively. The signal area of identified chromatographic peaks are filled with a color." }
+plot(chr_raw, col = group_colors[chr_raw$sample_group], lwd = 2)
+highlightChromPeaks(xdata, col = group_colors[chr_raw$sample_group],
+		    lty = 3, rt = rtr, mz = mzr, border = NA,
+		    type = "polygon") 
 ```
 
 Note that we can also specifically extract identified chromatographic peaks for

diff --git a/vignettes/xcms.org b/vignettes/xcms.org
@@ -172,7 +172,7 @@ could set =aggregationFun= to =sum=.
   ## Get the base peak chromatograms. This reads data from the files.
   bpis <- chromatogram(raw_data, aggregationFun = "max")
   ## Define colors for the two groups
-  group_colors <- brewer.pal(3, "Set1")[1:2]
+  group_colors <- paste0(brewer.pal(3, "Set1")[1:2], "60")
   names(group_colors) <- c("KO", "WT")
 
   ## Plot all chromatograms.
@@ -350,7 +350,23 @@ appropriate and correctly identified the expected peaks.
 #+BEGIN_SRC R :ravel message = FALSE, fig.align = "center", fig.width = 10, fig.height = 8, fig.cap = "Signal for an example peak. Red and blue colors represent KO and wild type samples, respectively. The rectangles indicate the identified chromatographic peaks per sample."
   plot(chr_raw, col = group_colors[chr_raw$sample_group], lwd = 2)
   highlightChromPeaks(xdata, border = group_colors[chr_raw$sample_group],
-		      lty = 3, rt = rtr, mz = mzr)
+		      lty = 3, rt = rtr, mz = mzr, type = "rect")
+#+END_SRC
+
+In the plot above the peak definitions are indicated with rectangles containing
+the full peak. In addition it is possible to represent the apex position of each
+peak with a single point (passing argument =type = "point"= to the function), or
+draw the actually identified peak by specifying =type = "polygon"=. Below we use
+this option to fill the peak area for each identified chromatographic peak in
+each sample. Whether individual peaks can be still identified in such a plot
+depends however on the number of samples from which peaks are drawn.
+
+#+NAME: peak-detection-highlight-chrom-peaks-plot-polygon
+#+BEGIN_SRC R :ravel message = FALSE, fig.align = "center", fig.width = 10, fig.height = 8, fig.cap = "Signal for an example peak. Red and blue colors represent KO and wild type samples, respectively. The signal area of identified chromatographic peaks are filled with a color."
+  plot(chr_raw, col = group_colors[chr_raw$sample_group], lwd = 2)
+  highlightChromPeaks(xdata, col = group_colors[chr_raw$sample_group],
+		      lty = 3, rt = rtr, mz = mzr, border = NA,
+		      type = "polygon")
 #+END_SRC
 
 Note that we can also specifically extract identified chromatographic peaks for