Metabolomics Society Forum

plotXIC_MSnExp_ex <- function(x, ...) {
  ## Restrict to MS level 1
  x <- filterMsLevel(x, 1L)
  if (!length(x))
    stop("No MS1 data available")
  fns <- basename(fileNames(x))
  if (isMSnbaseVerbose())
    message("Retrieving data ...", appendLF = FALSE)
  x <- as(x, "data.frame")
  x <- split(x, x$file)
  if (isMSnbaseVerbose())
    message("OK")
  ## Check if we are greedy and plot a too large area
  if (any(unlist(lapply(x, nrow)) > 20000))
    warning("The MS area to be plotted seems rather large. It is suggested",
            " to restrict the data first using 'filterRt' and 'filterMz'. ",
            "See also ?chromatogram and ?Chromatogram for more efficient ",
            "functions to plot a total ion chromatogram or base peak ",
            "chromatogram.",
            immediate = TRUE, call = FALSE)
  ## Define the layout.
  dots <- list(...)
  if (any(names(dots) == "layout")) {
    if (!is.null(dots$layout))
      layout(layout)
    dots$layout <- NULL
  } else
    layout(.vertical_sub_layout_ex(length(x)))
  tmp <- mapply(x, fns, FUN = function(z, main, ...) {
    .plotXIC_ex(x = z, main = main, layout = NULL, ...)
  }, MoreArgs = dots)
}


.plotXIC_ex <- function(x, main = "", col = "grey", colramp = topo.colors,
                     grid.color = "lightgrey", pch = 21,
                     layout = matrix(1:2, ncol = 1), ...) {
  # start edit
  plot_strip<-function(..., v, h) plot(...)
  dots <- list(...)
  # end edit
  
  print(list(...))
  if (is.matrix(layout))
    layout(layout)
  ## Chromatogram.
  bpi <- unlist(lapply(split(x$i, x$rt), max, na.rm = TRUE))
  brks <- lattice::do.breaks(range(x$i), nint = 256)
  par(mar = c(0, 4, 2, 1))
  
  # start edit
  plot_strip(as.numeric(names(bpi)), bpi, xaxt = "n", col = col, main = main, 
       bg = lattice::level.colors(bpi, at = brks, col.regions = colramp), xlab = "",
       pch = pch, ylab = "", las = 2, ...)
  # end edit
  
  if(!is.null(dots$v)) abline(v=dots$v,col='red',lty=2)
  
  mtext(side = 4, line = 0, "Intensity", cex = par("cex.lab"))
  grid(col = grid.color)
  par(mar = c(3.5, 4, 0, 1))
  
  # start edit
  plot_strip(x$rt, x$mz, main = "", pch = pch, col = col, xlab = "", ylab = "",
       yaxt = "n", bg = lattice::level.colors(x$i, at = brks, col.regions = colramp),
       ...)
  
  if(!is.null(dots$h)) abline(h=dots$h,col='red',lty=2)
  if(!is.null(dots$v)) abline(v=dots$v,col='red',lty=2)
  # end edit
  
  axis(side = 2, las = 2)
  grid(col = grid.color)
  mtext(side = 1, line = 2.5, "Retention time", cex = par("cex.lab"))
  mtext(side = 4, line = 0, "m/z", cex = par("cex.lab"))
}

.vertical_sub_layout_ex <- function(x, sub_plot = 2) {
  sqrt_x <- sqrt(x)
  ncol <- ceiling(sqrt_x)
  nrow <- round(sqrt_x)
  rws <- split(1:(ncol * nrow * sub_plot), f = rep(1:nrow,
                                                   each = sub_plot * ncol))
  do.call(rbind, lapply(rws, matrix, ncol = ncol))
}