Nothing
#' 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, ...)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.