R/specOverlay.R

In kimsche/MetaboMate: All you need for NMR-based metabolic profiling with R!

#' Higher level plotting function to overlay NMR spectra (ggplot2 based)
#' @aliases specOverlay
#' @export
#' @param X Input NMR data matrix with row representing spectra.
#' @param ppm ppm vector with its length equals to \code{nrow(X)}.
#' @param shift Chemical shift area to be plotted. This should be kept as small as possible (see Details).
#' @param an List with one to three elements specifying facetting, colour and linetype (see Details).
#' @param alp Alpha value for lines (number between 0 and 1 whereas 0 is fully transparent and 1 is fully opaque).
#' @param title Plot title.
#' @param size Line width (0.5 is a good start).
#' @param ... Additional paramters passed on to ggplot's facet function.
#' @description  Plotting overlayed NMR specra. This function is based on ggplot2, a high-level plotting R package. For large ppm ranges the computation time is relatively long, so the chemical \code{shift} range should be as small as possible. For list argument \code{an}, the first element describes the colour and must be defined (even if it is only a single value). If colour and line width are specified, then at least one list elements of \code{an} must have the same length as \code{X}.
#' @seealso \code{\link{readBruker}}
#' @author Torben Kimhofer \email{tkimhofer@@gmail.com}
#' @importFrom reshape2 melt
#' @importFrom ggplot2 aes_string scale_x_reverse ggtitle xlab facet_grid theme_bw theme element_text geom_line
#' @importFrom colorRamps matlab.like2
#' @importFrom scales pretty_breaks
#' @importFrom stats as.formula
#' @seealso \code{\link{facet_grid}}
specOverlay <- function(X, ppm, shift = c(-0.01, 0.01), an = list("facet", "col", "ltype"), alp = 0.7, size = 0.5, title = "", ...) {
    if (is.null(names(an))) {
        cat("No facet, colour and linetype names given. See an argument in ?specOverlay\n")
        names(an) <- paste("an", 1:length(an), sep = "")
    }
    le.arg <- paste(length(an))
    if ("" %in% names(an)) {
        idx <- which(names(an) == "")
        names(an)[idx] <- paste("an", idx, sep = "")
    }
    names(an) <- gsub(" ", ".", names(an))
    idx <- get.idx(shift, ppm)
    specs <- X[, idx]
    colnames(specs) <- paste("Idx", idx, sep = "_")
    # create dataframe for ggplot function
    df <- data.frame(do.call(cbind.data.frame, an), ID = 1:nrow(specs), alp, specs)
    colnames(df)[1:le.arg] <- names(an)
    df <- melt(df, id.vars = c("alp", "ID", names(an)))
    df$variable <- ppm[as.numeric(gsub("Idx_", "", df$variable))]
    # initiate generic ggplot object
    g <- ggplot() + scale_x_reverse(breaks = seq(shift[1], shift[2], by = abs(diff(shift))/20), name = expression(delta ~ {
    }^1 * H ~ "(ppm)")) + scale_y_continuous(breaks = pretty_breaks(), name = "Intensity") + ggtitle(title) + facet_grid(as.formula(paste(names(an)[1],
        "~ ."))) + theme_bw() + theme(axis.text = element_text(colour = "black"), axis.text.x = element_text(angle = 45, hjust = 1))
    # add colour and line type
    switch(le.arg, `1` = {
        g <- g + geom_line(data = df, aes_string(x = "variable", y = "value", group = "ID"), colour = "black", alpha = alp, size = size)
    }, `2` = {
        g <- g + geom_line(data = df, aes_string(x = "variable", y = "value", group = "ID", colour = names(an)[2]), alpha = alp, size = size)
        # add multi-colour gradient if colour vector is not factor/char
        col.cat <- is.factor(an[[2]]) | is.character(an[[2]]) | is.logical(an[[2]])
        if (col.cat == F) {
            g <- g + scale_colour_gradientn(colors = matlab.like2(length(an[[2]])))
        }
    }, `3` = {
        an[[3]] <- factor(an[[3]])
        g <- g + geom_line(data = df, aes_string(x = "variable", y = "value", group = "ID", colour = names(an)[2], linetype = names(an)[3]), alpha = alp,
            size = size)
        # add multi-colour gradient if colour vector is not factor/char
        col.cat <- is.factor(an[[2]]) | is.character(an[[2]]) | is.logical(an[[2]])
        if (col.cat == F) {
            g <- g + scale_colour_gradientn(colors = matlab.like2(length(an[[2]])))
        }
    })
    return(g)
}