R/drawEEMgg.R

In chengvt/EEM: Read and Preprocess Fluorescence Excitation-Emission Matrix (EEM) Data

#' Draw contour for EEM data using ggplot2
#' 
#' This function draw contour for EEM data using ggplot2. Use `ggsave` to save the contours.
#' 
#' @aliases drawEEMgg_internal
#' 
#' @param textsize (optional) text size
#' @param x a list of EEM data generated by \code{\link[EEM]{readEEM}} function or 
#' EEMweight object generated by \code{\link[EEM]{extract}}-related functions.
#' @param n sample number. The number should not exceed \code{length(EEM)}
#' @param ncomp number of components
#' @param exlab (optional) excitation-axis label
#' @param emlab (optional) emission-axis label
#' @param color.palette (optional) contour color palette. See \code{\link[grDevices]{palette}} for more details
#' @param nlevels (optional) number of levels used to separate range of intensity value
#' @param main (optional) plot title
#' @param flipaxis (optional) flip axis
#' @param has_legend logical value for legend
#' @param zlim zlim = c(min, max)
#' @param breaks breaks
#' @param ... arguments for other methods
#' 
#' @return A figure is returned on the graphic device
#' 
#' @details \code{\link{drawEEM}} is faster and should be used. 
#' 
#' @examples
#' \dontrun{
#' require(EEM)
#' require(ggplot2)
#' data(applejuice)
#' drawEEMgg(applejuice, 1) # draw EEM of sample no.1
#' drawEEMgg(applejuice, 1, color.palette = cm.colors) # draw EEM of sample no.31 with different color
#' drawEEMgg(applejuice, 1, nlevels = 10) # change nlevels
#' 
#' # manually define legend values
#' drawEEMgg(applejuice, 1, breaks = seq(from = 1000, to = 6000, by = 1000))
#' 
#' # can be combined with other ggplot2 commands
#' # add point to the plot
#' drawEEMgg(applejuice, 1) + geom_point(aes(x = 350, y = 500), pch = 17, cex = 10)
#' 
#' # add grid line to the plot
#' drawEEMgg(applejuice, 1) + theme(panel.grid = element_line(color = "grey"), 
#' panel.grid.major = element_line(colour = "grey"))
#' 
#' # add bg color
#' drawEEMgg(applejuice, 1, has_legend = FALSE) + geom_raster(aes(fill = value)) +
#' geom_contour(colour = "white")
#' 
#' }
#' 
#' @seealso
#' \code{\link{drawEEM}}
#'
#' @import ggplot2
#' @importFrom colorRamps matlab.like
#' @importFrom reshape2 melt 
#' 
#' @export
#' 
drawEEMgg <- function(x, ...) UseMethod("drawEEMgg", x)

#' @describeIn drawEEMgg draw EEM of EEM data created by \code{\link{readEEM}} function
#' 
#' @export
#'
drawEEMgg.EEM <-
    function(x, n, textsize = 20, color.palette = matlab.like, 
             nlevels = 20, exlab = "Excitation wavelength [nm]", emlab = "Emission wavelength [nm]", main = NULL,
             has_legend = TRUE, zlim = NULL, breaks = waiver(), flipaxis = FALSE, ...){
        
        # retrieve data 
        data <- x[[n]] # data is a matrix 
        
        # if main is not provided, call it  
        if (is.null(main)) main <- names(x)[n]
        
        # melt data 
        data.melted <- melt(data)
        names(data.melted) <- c("em", "ex", "value")
        
        # plot melted data
        drawEEMgg_internal(x = data.melted, n = n, textsize = textsize, 
                           color.palette = color.palette,  
                           nlevels = nlevels, exlab = exlab, emlab = emlab, 
                           main = main, has_legend = has_legend, zlim = zlim, breaks = breaks,
                           flipaxis = flipaxis)
    }

#' @describeIn drawEEMgg draw contours of the output from \code{\link[EEM]{getLoading}} and 
#' \code{\link[EEM]{getReg}}. 
#' @export
drawEEMgg.EEMweight <-
    function(x, ncomp, textsize = 25, color.palette = matlab.like,  
             nlevels = 20, exlab = "Excitation wavelength [nm]", emlab = "Emission wavelength [nm]", main = NULL,
             has_legend = TRUE, zlim = NULL, breaks = waiver(), flipaxis = FALSE, ...){
        
        # check inputs such that ncomp cannot exceed totalcomp
        totalcomp <- dim(x$value)[2]
        if (ncomp > totalcomp) stop("ncomp cannot exceed totalcomp.")
        
        # extract data from x
        data <- x$value[,ncomp]
        id <- names(data)
        
        # extract ex and em information from colnames
        if (isTRUE(grepl("^EX...EM...", id[1]))){
            ex <- substring(id, 3, 5)
            em <- substring(id, 8, 10)
        } else if (isTRUE(grepl("EX...EM...", id[1]))){
            pattern <- "EX...EM..."
            m <- regexpr(pattern, id)
            id <- regmatches(id, m)
            ex <- substring(id, 3, 5)
            em <- substring(id, 8, 10)
        } else {
            stop("Input did not follow the format.")
        }
        
        # melt data
        data.melted <- data.frame(em = as.numeric(em), ex = as.numeric(ex), 
                                  value = data, row.names = NULL)
        
        # main
        if (is.null(main)) {
            main <- x$title #if title is not provided, call it
            main <- paste(main, " (", ncomp, " LV)", sep = "")
            if (ncomp > 1) main <- sub("LV", "LVs", main)
        } 
        
        # plot melted data
        drawEEMgg_internal(x = data.melted, n = ncomp, textsize = textsize, 
                           color.palette = color.palette,  
                           nlevels = nlevels, exlab = exlab, emlab = emlab, 
                           main = main, has_legend = has_legend, zlim = zlim,
                           breaks = breaks, flipaxis = flipaxis)
    }

#' @export
drawEEMgg_internal <-
    function(x, n = n, textsize = textsize, 
             color.palette = color.palette, 
             nlevels = nlevels, exlab = exlab, emlab = emlab, 
             main = main, has_legend = has_legend, zlim = zlim, breaks = breaks, flipaxis = flipaxis, ...){
        
        # x is melted data frame
        
        # get ranges
        ex.range <- range(x$ex, na.rm = TRUE)
        em.range <- range(x$em, na.rm = TRUE)
        if (is.null(zlim)) zlim <- range(x$value, na.rm = TRUE)
        
        # applease cran check
        ..level.. <- NULL
        
        # create ggplot
        v <- ggplot(x, aes_string(x = "ex", y = "em", z = "value")) + 
            geom_contour(aes(colour = ..level..), bins = nlevels) +
            scale_colour_gradientn(colours = color.palette(nlevels), limits = c(zlim[1], zlim[2]), breaks = breaks) +
            coord_cartesian(xlim = c(ex.range[1],ex.range[2]),
                            ylim = c(em.range[1],em.range[2]), expand = FALSE) 
        
        # add some themes to the plot
        w <- v +   
            xlab(exlab) +
            ylab(emlab) +
            ggtitle(main) + 
            theme(panel.grid = element_blank(),  # delete grid lines 
                  text = element_text(size = textsize),  # change all text size
                  panel.background = element_rect(fill = 'white'),  # white bg +
                  legend.title = element_blank(),
                  panel.border = element_rect(colour = "black", fill = NA),
                  axis.text = element_text(colour = "black"),
                  axis.ticks = element_line(colour = "black"),
                  axis.title.x = element_text(vjust = -0.1),
                  axis.title.y = element_text(vjust = 1)) 
        
        if (!has_legend) w <- w + guides(color = "none") 
        if (flipaxis) w <- w + coord_flip() 
        
        return(w)
    }