R/boxcar.R

In lgatto/MSnbaseBoxCar: BoxCar Data Processing with MSnbase

##' This function extracts the box start and end positions for all
##' spectra in an `MSnExp` object. The first box coordinates are not
##' returned, as they corresond to either the full spectrum (for
##' non-boxcar MS1 spectra) or the first start and last end box
##' positions for a boxcar MS1 spectrum. See the *MSnbaseBoxCar*
##' vignette for example code.
##'
##' @title Extract box positions
##' 
##' @param x An `MSnExp` object
##' 
##' @param offset `numeric(1)` defining the offset to remove/add to
##'     the start/end of the box. Default is `0`, i.e. to leave them
##'     as is.
##' 
##' @param fcol The name of the feature variable containing the box
##'     data. Default is `filterString` and is expected to be
##'     `"FTMS + p NSI SIM msx ms [start_1-end_1, start_2-end_2, ..., start_n-end_n]"`
##'     where `start` and `end` are box start and end positions.
##' 
##' @return A list of data frames of length `length(x)` with start and
##'     end box values.
##'
##' @export
##'
##' @import MSnbase
bc_boxes <- function(x,
                     offset = 0L,
                     fcol = "filterString") {
    stopifnot(inherits(x, "MSnExp"))
    stopifnot(fcol %in% fvarLabels(x))
    if (length(offset) != 1)
        warning("Offset must be a `numeric(1)`. Ignoring other values.")
        offset <- offset[1]
    lapply(seq_len(length(x)),
           function(i) {
               bx <- as.character(fData(x)[i, fcol])
               bx <- gsub(".+\\[(.+)\\]", "\\1", bx)
               bx <- strsplit(strsplit(bx, ", ")[[1]], "-")
               bx <- t(sapply(bx, as.numeric))
               if (offset) {
                   bx[, 1] <- bx[, 1] - offset
                   bx[, 2] <- bx[, 2] + offset
               }
               bx[-1, ]
           })}


##' This function uses the identification of boxcar boxes by the
##' `bc_boxes` function to determine if the spectrum is indeed a
##' boxcar spetrum. See the *MSnbaseBoxCar* vignette for example code.
##'
##' @title Identifies boxcar spectra
##' 
##' @param x An `MSnExp` object containing a set of boxcar spectra.
##' 
##' @param fcol The name of the feature variable containing the box
##'     data. Default is `filterString`. See the `bc_boxes` function
##'     for details.
##' 
##' @return A `logical` of length `length(x)` indicating of a spectrum
##'     is a boxcar spectrum.
##' 
##' @author Laurent Gatto
##'
##' @export
bc_is_boxcar <- function(x, fcol = "filterString") {
    stopifnot(inherits(x, "MSnExp"))
    stopifnot(fcol %in% fvarLabels(x))
    bx <- bc_boxes(x, fcol = fcol)
    as.logical(sapply(bx, nrow))
}

##' This function retains only BoxCar spectra in an `MSnExp`
##' instance. BoxCar spectra are defined as those that don't have an
##' `NA` in the feature variable `bc_groups`.
##'
##' @title Filter BoxCar spectra
##' 
##' @param x An instance of class `MSnExp`.
##' 
##' @param fcol `character(1)` indicating the feature variable
##'     defining the BoxCar spectra, typically generated by
##'     `bc_groups()`. Default is `bc_groups`.
##' 
##' @return An `MSnExp` containing only BoxCar spectra.
##' 
##' @author Laurent Gatto
##'
##' @export
filterBoxCar <- function(x, fcol = "bc_groups") {
    stopifnot(inherits(x, "MSnExp"))
    stopifnot(fcol %in% fvarLabels(x))
    x[!is.na(fData(x)[, fcol])]
}


##' This function takes an `MSnExp` as input and defines the boxcar
##' groups, i.e. the set of boxcar spectra that match the same full
##' MS1 spectrum. Grouping for full (non-boxcar) spectra are set the
##' `NA`. Note that the presence of full (non-boxcar) spectra is
##' required to define the groups, and it is assumed that boxcar
##' spectra following a full MS1 spectrum below to the same group. The
##' output of this function is best used to create a new feature
##' variable column used when merging boxcar spectra. See the
##' *MSnbaseBoxCar* vignette for example code.
##' 
##' @title Define boxcar groups
##' 
##' @param x An `MSnExp` object containing a set of boxcar spectra.
##'
##' @param bc_groups `character(1)` indicating the feature variable in
##'     which to store the BoxCar groups. Default is `bc_groups`.
##' 
##' @param fcol `character(1)` indicating the name of the feature
##'     variable containing the box data. Default is
##'     `filterString`. See the `bc_boxes()` function for details.
##' 
##' @return A `numeric` of length `length(x)` with the boxcar groups.
##' 
##' @author Laurent Gatto
##'
##' @export
bc_groups <- function(x, bc_groups = "bc_groups", fcol = "filterString") {
    bx <- bc_is_boxcar(x, fcol = fcol)
    if (all(bx))
        stop("No non-boxcar spectra found. Can't assign boxcar groups.")
    grps <- rep(NA_integer_, length(bx))
    k <- 0
    for (i in seq_along(bx)) {
        if (!bx[i]) k <- k + 1
        else grps[i] <- k
    }
    fData(x)[, bc_groups] <- grps
    x
}


##' A function to be passed to `combineSpectra` to combine boxcar
##' spectra. This function simply sums intensities and is provided as
##' an example. See the *MSnbaseBoxCar* vignette for example code.
##'
##' @title Combine boxcar spectra
##' 
##' @param x A list of spectra
##'
##' @export
boxcarCombine <- function(x)
    meanMzInts(x, intensityFun = base::sum, mzd = 0)

##' Takes an MS experiment with boxcar spectra and sets any peak
##' outside of the boxes (+/- an optional offset) to zero. If the
##' spectrum is a fill, non-boxcar spectrum, it is left as is. See the
##' *MSnbaseBoxCar* vignette for example code.
##'
##' @title Set peaks outside of boxes to zero
##' 
##' @param x x An `MSnExp` object containing a set of boxcar spectra.
##' 
##' @param offset `numeric(1)` defining the offset to remove/add to
##'     the start/end of the box. Default is `0`, i.e. to leave them
##'     as is.
##' 
##' @return An object of class `Spectra` with processed spectra.
##' 
##' @author Laurent Gatto
##'
##' @importFrom S4Vectors DataFrame
##'
##' @export
bc_zero_out_box <- function(x, offset = 0L) {
    stopifnot(inherits(x, "MSnExp"))
    bx <- bc_boxes(x, offset)
    mzs <- mz(x)
    ints <- intensity(x)
    .rt <- rtime(x)
    .centroided <- centroided(x)
    .smoothed <- smoothed(x)
    .fromFile <- fromFile(x)
    .polarity <- polarity(x)
    l <- lapply(seq_along(ints),
                function(i) {
                    ## Only do the following if there are any boxes,
                    ## i.e. it's a boxcar msx scan. Otherwise, the
                    ## output of bc_boxes() is an empty matrix and we
                    ## return the intensities as they are.
                    if (nrow(bx[[i]])) {
                        itvl <- findInterval(mzs[[i]], as.numeric(t(bx[[i]])))
                        ## keep odd intervals
                        out_box <- itvl %% 2 == 0
                        ints[[i]][out_box] <- 0
                    }
                    MSnbase:::Spectrum1(mz = mzs[[i]],
                                        intensity = ints[[i]],
                                        rt = .rt[[i]],
                                        centroided = .centroided[[i]],
                                        smoothed = .smoothed[[i]],
                                        fromFile = .fromFile[[i]],
                                        polarity = .polarity[[i]])
                })
    names(l) <- featureNames(x)
    ans <- Spectra(l, elementMetadata = DataFrame(fData(x)))
    ans <- as(ans, "MSnExp")
    MSnbase:::logging(ans, "BoxCar processed")
}