R/drawEEM.R

#' Draw contour for EEM data
#' 
#' This function is a wrapper function for \code{\link{filled.contour}} to draw contour for EEM data.
#' 
#' @param x a list of EEM data generated by \code{\link{readEEM}} function or 
#' EEMweight object generated by \code{\link{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 ... (optional) further arguments passed to other methods of \code{\link[graphics]{filled.contour}} 
#' 
#' @return A figure is returned on the graphic device
#' 
#' @examples
#' # method for class "EEM"
#' data(applejuice)
#' drawEEM(applejuice, 1) # draw contour of the first sample
#' drawEEM(applejuice, 1, flipaxis = TRUE) # flip the axis
#' 
#' # method for class "EEMweight"
#' applejuice_uf <- unfold(applejuice) # unfold list into matrix
#' result <- prcomp(applejuice_uf) 
#' drawEEM(getLoading(result), 1) # plot loading of the first PC
#' 
#' @export
#' 
#' @seealso
#' \code{\link{drawEEM}}
#' 
#' @importFrom graphics filled.contour
#' @importFrom colorRamps matlab.like
#' @importFrom reshape2 acast
drawEEM <- function(x, ...) UseMethod("drawEEM", x)

#' @describeIn drawEEM draw contour of EEM data created by \code{\link{readEEM}} function
#' @export
drawEEM.EEM <-
  function(x, n, exlab = "Excitation wavelength [nm]", emlab = "Emission wavelength [nm]", 
           color.palette = matlab.like, nlevels = 50, main = NULL, flipaxis = FALSE, ...){
    
    # check number of argument
    if (nargs() < 2) stop("Not enough inputs. Aborted")
    
      
    # if main is not provided
    if (is.null(main)) {
      main <- names(x)[n] # if main is not provided, call it   
    }
      
    # get information from EEM
    data <- x[[n]]
    xlab <- exlab
    ylab <- emlab
    if (flipaxis) {
      data <- t(data)
      xlab <- emlab
      ylab <- exlab
    }
    X <- as.numeric(colnames(data)) 
    Y <- as.numeric(rownames(data)) 
    Z <- t(as.matrix(data))

    # draw contour
    filled.contour(X, Y, Z, xlab = xlab, ylab = ylab, 
                   color.palette = color.palette, 
                   main = main, nlevels = nlevels, ...) 
  }

#' @describeIn drawEEM draw contours of the output from \code{\link[EEM]{getLoading}} and 
#' \code{\link[EEM]{getReg}}. 
#' @export
drawEEM.EEMweight <- function(x, ncomp, 
                       exlab = "Excitation wavelength [nm]", emlab = "Emission wavelength [nm]", 
                       color.palette = matlab.like, nlevels = 50, main = NULL, flipaxis = FALSE,
                       ...){
    
#     # transpose if not in correct form
#     if (!isTRUE(grepl("EX...EM...", rownames(x$value)[1]))) {
#         x$value <- t(x$value)
#     }
    
    # 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
    value <- x$value[,ncomp]
    id <- rownames(x$value)
    
    # get EX and EM
    EX <- getEX(id)
    EM <- getEM(id)

    data <- data.frame(ex = as.numeric(EX), em = as.numeric(EM), value = value)
    
    # cast data
    castedData <- acast(data, em~ex, value.var = "value")
    
    # main
    if (is.null(main)) {
        main <- x$title # if title is not provided, call it
        main <- paste(main, ncomp)
        if (x$title %in% c("Regression coefficient", "VIP")) {
            main <- paste0(x$title, " (", ncomp, " LV)")
            if (ncomp > 1) main <- sub("LV", "LVs", main)
        } else {
            main <- paste0(x$title, " (ncomp = ", ncomp, ")")
        }
    } 
    
    # prepare data for plotting
    xlab <- exlab
    ylab <- emlab
    if (flipaxis) {
        castedData <- t(castedData)
        xlab <- emlab
        ylab <- exlab
    }
    X <- as.numeric(colnames(castedData))
    Y <- as.numeric(rownames(castedData)) 
    Z <- t(as.matrix(castedData))
    
    # plotting
    filled.contour(X, Y, Z, xlab = xlab, ylab = ylab, 
                   color.palette = color.palette, 
                   nlevels = nlevels, main = main, ...    
    ) 
}

#' @describeIn drawEEM draw contour of unfolded matrix which have column names in 
#' the format of EX...EM...
#' @export
drawEEM.matrix <-
    function(x, n, exlab = "Excitation wavelength [nm]", emlab = "Emission wavelength [nm]", 
             color.palette = matlab.like, nlevels = 50, main = NULL, flipaxis = FALSE, ...){
        
        # fold x into EEM 
        x <- fold(x)
        
        # draw contour
        drawEEM.EEM(x, n = n, exlab = exlab, emlab = emlab, color.palette = color.palette,
                       nlevels = nlevels, main = main, flipaxis = flipaxis, ...)
    }

#' @describeIn drawEEM draw contour of unfolded data.frame which have column names in 
#' the format of EX...EM...
#' @export
drawEEM.data.frame <-
    function(x, n, exlab = "Excitation wavelength [nm]", emlab = "Emission wavelength [nm]", 
             color.palette = matlab.like, nlevels = 50, main = NULL, flipaxis = FALSE, ...){
        
        # fold x into EEM 
        x <- fold(x)
        
        # draw contour
        drawEEM.EEM(x, n, exlab = exlab, emlab = emlab, color.palette = color.palette,
                       nlevels = nlevels, main = main, flipaxis = flipaxis, ...)
    }

#' @describeIn drawEEM draw contour of a vector of numeric values which have names in 
#' the format of EX...EM...
#' @export
drawEEM.numeric <-
    function(x, exlab = "Excitation wavelength [nm]", emlab = "Emission wavelength [nm]", 
             color.palette = matlab.like, nlevels = 50, main = NULL, flipaxis = FALSE, ...){
        
        # fold x into EEM 
        x <- fold(x)
        
        # draw contour
        drawEEM.matrix(x, n = 1, exlab = exlab, emlab = emlab, color.palette = color.palette,
                       nlevels = nlevels, main = main, flipaxis = flipaxis, ...)
    }

Try the EEM package in your browser

Any scripts or data that you put into this service are public.

EEM documentation built on May 2, 2019, 5:58 a.m.