Nothing
#' 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)
}
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.