R/plot_fns.R
In pmartR/pmartR: Panomics Marketplace - Quality Control and Statistical Analysis for Panomics Data
Defines functions
plot.cvFilt
plot.rmdFilt
plot.proteomicsFilt
plot.imdanovaFilt
plot.RNAFilt
plot.totalCountFilt
plot.moleculeFilt
plot.corRes
plot.SPANSRes
plot.nmrnormRes
prime_iso
plot.isobaricnormRes
plot.dataRes
Documented in
plot.corRes
plot.cvFilt
plot.dataRes
plot.imdanovaFilt
plot.isobaricnormRes
plot.moleculeFilt
plot.nmrnormRes
plot.proteomicsFilt
plot.rmdFilt
plot.RNAFilt
plot.SPANSRes
plot.totalCountFilt
#' Plot dataRes object
#'
#' For plotting an S3 object of type dataRes
#'
#' @param x object of class dataRes, created by the
#' \code{\link{edata_summary}} function
#' @param metric character string indicating which metric to use in plot:
#' 'mean', 'median', 'sd, 'pct_obs', 'min', or 'max'
#' @param density logical value, defaults to FALSE. If TRUE, a density plot of
#' the specified metric is returned.
#' @param ncols integer value specifying the number columns for the histogram
#' facet_wrap. This argument is used when \code{metric} is not null. The
#' default is NULL.
#' @param interactive logical value. If TRUE, produces an interactive plot.
#' @param x_lab character string specifying the x-axis label when the metric
#' argument is NULL. The default is NULL in which case the x-axis label will
#' be "count".
#' @param x_lab_sd character string used for the x-axis label for the
#' mean/standard deviation plot when the \code{metric} argument is not NULL.
#' @param x_lab_median character string used for the x-axis label for the
#' mean/median plot when the \code{metric} argument is not NULL.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param y_lab_sd character string used for the y-axis label for the
#' mean/standard deviation plot when the \code{metric} argument is not NULL.
#' @param y_lab_median character string used for the y-axis label for the
#' mean/median plot when the \code{metric} argument is not NULL.
#' @param x_lab_size integer value indicating the font size for the x-axis. The
#' default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis. The
#' default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels
#' @param title_lab character string specifying the plot title when the
#' \code{metric} argument is NULL.
#' @param title_lab_sd character string used for the plot title for the
#' mean/standard deviation plot when the \code{metric} argument is not NULL.
#' @param title_lab_median character string used for the plot title for the
#' mean/median plot when the \code{metric} argument is not NULL.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", or "bottom". The default is
#' "right".
#' @param point_size integer specifying the size of the points. The default is
#' 2.
#' @param bin_width integer indicating the bin width in a histogram. The default
#' is 0.5.
#' @param bw_theme logical value. If TRUE, uses the ggplot2 black and white
#' theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @details This function can only create plots for dataRes objects whose 'by' =
#' 'molecule' and 'groupvar' attribute is non NULL
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mylipid <- edata_transform(omicsData = lipid_pos_object, data_scale = "log2")
#' result <- edata_summary(
#' omicsData = mylipid,
#' by = "molecule",
#' groupvar = "Virus"
#' )
#' plot(result)
#'
#' @rdname plot-dataRes
#'
#' @export
#'
plot.dataRes <- function(x, metric = NULL, density = FALSE,
ncols = NULL, interactive = FALSE, x_lab = NULL,
x_lab_sd = NULL, x_lab_median = NULL, y_lab = NULL,
y_lab_sd = NULL, y_lab_median = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = NULL, title_lab = NULL,
title_lab_sd = NULL, title_lab_median = NULL,
title_lab_size = 14, legend_lab = NULL,
legend_position = "right", point_size = 2,
bin_width = 1, bw_theme = TRUE, palette = NULL, ...) {
dataRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# check that attr(dataRes_obj, "by") == "molecule"
if (attr(dataRes_obj, "by") != "molecule") {
# My name is Evan Martin. You killed my plot. Prepare to die.
stop(paste("can only plot a dataRes object if its 'by' attribute is equal",
"to 'molecule'",
sep = " "
))
}
# check that attr(dataRes_obj, "groupvar") is not NULL
if (is.null(attr(dataRes_obj, "groupvar"))) {
# My name is Evan Martin. You killed my plot. Prepare to die.
stop(paste("can only plot a dataRes object if its 'groupvar' attribute is",
"not NULL",
sep = " "
))
}
# Check if the data is on a log scale. If it is not the histograms will not
# work properly when metric = mean, sd, ... because of the wide range of
# abundance values.
if (attr(dataRes_obj, "data_scale") == "abundance") {
# My name is Evan Martin. You killed my plot. Prepare to die.
stop("Data must be on the log scale to plot.")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# extract molecule name
edata_cname = attr(dataRes_obj, "cnames")$edata_cname
# Make labels for various aspects of the plot. (Super tedious!!!)
xLabelSd <- if (is.null(x_lab_sd)) "mean" else x_lab_sd
yLabelSd <- if (is.null(y_lab_sd)) "sd" else y_lab_sd
xLabelMedian <- if (is.null(x_lab_median)) "mean" else x_lab_median
yLabelMedian <- if (is.null(y_lab_median)) "median" else y_lab_median
plotTitleSd <- if (is.null(title_lab_sd))
"Mean x Standard Deviation" else
title_lab_sd
plotTitleMedian <- if (is.null(title_lab_median))
"Mean x Median" else
title_lab_median
legendLabel <- if (is.null(legend_lab)) "Group" else legend_lab
# Build beautiful plots ------------------------------------------------------
if (is.null(metric)) {
# scatterplots
# subseting dataRes_obj object
mean <- dataRes_obj$mean
median <- dataRes_obj$median
sd <- dataRes_obj$sd
# melting data frames from dataRes object
mean_melt <- tidyr::pivot_longer(
mean, -!!edata_cname,
cols_vary = "slowest",
names_to = "variable",
values_to = "mean"
)
sd_melt <- tidyr::pivot_longer(
sd, -!!edata_cname,
cols_vary = "slowest",
names_to = "variable",
values_to = "sd"
)
median_melt <- tidyr::pivot_longer(
median, -!!edata_cname,
cols_vary = "slowest",
names_to = "variable",
values_to = "median"
)
data_mean_sd <- merge(mean_melt,
sd_melt,
by = c(edata_cname, "variable")
)
data_mean_median <- merge(mean_melt,
median_melt,
by = c(edata_cname, "variable")
)
q <- ggplot2::ggplot(
dplyr::filter(
data_mean_sd,
dplyr::if_all(dplyr::one_of(c("mean", "sd")), ~!is.na(.x))
),
ggplot2::aes(
x = mean,
y = sd,
color = variable
)
) +
ggplot2::geom_point(size = point_size) +
ggplot2::xlab(xLabelSd) +
ggplot2::ylab(yLabelSd) +
ggplot2::ggtitle(plotTitleSd)
p <- ggplot2::ggplot(
dplyr::filter(
data_mean_median,
dplyr::if_all(dplyr::one_of(c("mean", "median")), ~!is.na(.x))
),
ggplot2::aes(
x = mean,
y = median,
color = variable
)
) +
ggplot2::geom_point(size = point_size) +
ggplot2::xlab(xLabelMedian) +
ggplot2::ylab(yLabelMedian) +
ggplot2::ggtitle(plotTitleMedian)
# Want the black and white theme? As you wish.
if (bw_theme) {
q <- q + ggplot2::theme_bw()
p <- p + ggplot2::theme_bw()
}
# Create a generic theme that will be used for both plot.
the_theme <- ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Add information to the plot from theme. Must be done after theme_bw()
# otherwise the black and white theme overwrites everything that was
# specified.
q <- q +
ggplot2::labs(color = legendLabel) +
the_theme
p <- p +
ggplot2::labs(color = legendLabel) +
the_theme
# Want a plot with beautiful colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_color_brewer(
palette = palette,
name = legendLabel
)
q <- q +
ggplot2::scale_color_brewer(
palette = palette,
name = legendLabel
)
}
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) {
q <- plotly::ggplotly(q)
p <- plotly::ggplotly(p)
plotly::subplot(q, p, nrows = 1)
} else {
# Combine the plots into one plot when interactive is FALSE.
patchwork::wrap_plots(q, p)
}
} else if (!is.null(metric)) {
if (!(metric %in% c('mean', 'median', 'sd', 'pct_obs', 'min', 'max'))) {
# There is a shortage of perfect plots in the world. It is a shame to ruin
# this one.
stop("metric must be one of mean, median, sd, pct_obs, min or max")
}
if (!is.logical(density)) stop("density must be either TRUE or FALSE")
# if density == F, will plot faceted histograms.
if (density == FALSE) {
# More tedious label creating .... (deep sigh).
xlabel <- if (is.null(x_lab)) metric else x_lab
ylabel <- if (is.null(y_lab)) "count" else y_lab
plotTitle <- if (is.null(title_lab))
paste("Histograms for ", metric, sep = "") else
title_lab
# subsetting dataRes object
data = dataRes_obj[[metric]]
data_melt = tidyr::pivot_longer(
data, -!!edata_cname,
cols_vary = "slowest",
names_to = "variable",
values_to = "value"
)
r <- ggplot2::ggplot(
data_melt,
ggplot2::aes(
x = value,
fill = variable
)
) +
ggplot2::geom_histogram(binwidth = bin_width, colour = "white") +
ggplot2::facet_wrap(~variable, ncol = ncols)
# Create a density plot. Following code runs when density = TRUE.
} else {
# More tedious label creating .... (defeated sigh).
xlabel <- if (is.null(x_lab)) metric else x_lab
ylabel <- if (is.null(y_lab)) "density" else y_lab
plotTitle <- if (is.null(title_lab))
paste("Density plots for ", metric, sep = "") else
title_lab
# if density == TRUE, will plot geom_density
data = dataRes_obj[[metric]]
data_melt = tidyr::pivot_longer(
data, -!!edata_cname,
cols_vary = "slowest",
names_to = "variable",
values_to = "value"
)
r <- ggplot2::ggplot(
data_melt,
ggplot2::aes(
x = value,
colour = variable
)
) +
ggplot2::geom_density()
}
# Want the black and white theme? As you wish.
if (bw_theme) r <- r + ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
# Add the remaining labels and text sizes/orientation to the plot.
r <- r +
ggplot2::ggtitle(plotTitle) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::labs(color = legendLabel) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Want a plot with gorgeous colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
r <- r +
ggplot2::scale_fill_brewer(
palette = palette,
name = legendLabel
)
}
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) r <- plotly::ggplotly(r)
return(r)
}
}
#' Plot isobaricnormRes object
#'
#' Creates box plots for an S3 object of type 'isobaricnormRes'
#'
#' @param x an object of type isobaricnormRes, created by
#' \code{\link{normalize_isobaric}} with apply_norm = FALSE
#' @param order logical value. If TRUE the samples will be ordered by the column
#' of f_data containing the experiment/plate information.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label
#' @param x_lab_size integer value indicating the font size for the x-axis. The
#' default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis. The
#' default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white
#' theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true") & requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' myiso <- edata_transform(omicsData = isobaric_object, data_scale = "log2")
#' result <- normalize_isobaric(myiso,
#' exp_cname = "Plex",
#' apply_norm = FALSE,
#' refpool_cname = "Virus",
#' refpool_notation = "Pool"
#' )
#' plot(result)
#'
#' @importFrom dplyr .data
#'
#' @rdname plot-isobaricnormRes
#'
#' @export
#'
plot.isobaricnormRes <- function(x, order = FALSE,
interactive = FALSE, x_lab = NULL,
y_lab = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = NULL,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "none",
bw_theme = TRUE, palette = NULL, ...) {
isobaricnormRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Check if input is an isobaricnormRes class object.
if (!inherits(isobaricnormRes_obj, "isobaricnormRes")) {
stop("object must be of class 'isobaricnormRes'")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# extracting attributes from isobaricnormRes_obj
exp_cname = attr(isobaricnormRes_obj, "isobaric_info")$exp_cname
fdata_cname = attr(isobaricnormRes_obj, "cnames")$fdata_cname
edata_cname <- attr(isobaricnormRes_obj, "cnames")$edata_cname
# Transform the isobaricnormRes data frames into a format usable by ggplot2.
tall_data <- prime_iso(
isonormRes = isobaricnormRes_obj,
exp_cname = exp_cname,
fdata_cname = fdata_cname,
edata_cname = edata_cname
)
# Do all the tedious plot label crap.
xlabel <- if (is.null(x_lab)) "Reference Sample" else x_lab
ylabel <- if (is.null(y_lab)) "Log Abundance" else y_lab
plot_title <- if (is.null(title_lab))
"Reference Sample Profile" else
title_lab
legendLabel <- if (is.null(legend_lab)) "Sample" else legend_lab
# Create pretty plots --------------------------------------------------------
# If order is TRUE order the box plots by experiment name/value.
if (order == TRUE) {
xlabel <- if (is.null(x_lab)) exp_cname else x_lab
p <- ggplot2::ggplot(
data = dplyr::filter(tall_data, !is.na(values)),
ggplot2::aes(
x = .data[[exp_cname]],
y = values,
fill = .data[[exp_cname]]
)
)
# Otherwise separate the box plots by sample name.
} else {
p <- ggplot2::ggplot(
data = dplyr::filter(tall_data, !is.na(values)),
ggplot2::aes(
x = .data[[fdata_cname]],
y = values,
fill = .data[[exp_cname]]
)
)
}
# Want your plot to have a black and white background? As you wish.
# The black and white theme needs to come before the code that creates the box
# plot. If the theme_bw code follows the code that creates the box plot it
# will add the legend back to the graph (if legend_position = "none").
if (bw_theme == TRUE) p <- p + ggplot2::theme_bw()
# Create the box plot with all of the users input.
p <- p +
ggplot2::geom_boxplot() +
ggplot2::ggtitle(plot_title) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::labs(color = legendLabel) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle),
legend.position = legend_position
)
# Want to use beautiful non-default colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_fill_brewer(
palette = palette,
name = legendLabel
)
}
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
# Takes the isobaricnormRes object and returns a data frame in the correct
# format for plotting in ggplot2.
prime_iso <- function(isonormRes, exp_cname,
fdata_cname, edata_cname) {
# Find the column in e_data pertaining to the peptide IDs.
id_col <- which(names(isonormRes$e_data) == edata_cname)
# Stack the columns of e_data. This will include the sample names as an
# additional column.
tall_data <- stack(isonormRes$e_data[, -id_col])
# Change the name of the column containing sample names to match the
# corresponding column name in f_data.
names(tall_data)[2] <- fdata_cname
# Include the experiment column in tall_data.
tall_data <- dplyr::inner_join(tall_data,
isonormRes$f_data[, c(fdata_cname, exp_cname)],
by = fdata_cname
)
# Extract the indices for each column in tall_data.
exp_cname_ind <- which(names(tall_data) == exp_cname)
fdata_cname_ind <- which(names(tall_data) == fdata_cname)
values_col_ind <- which(names(tall_data) == "values")
# Convert the experiment column into a factor.
tall_data[[exp_cname]] <- factor(tall_data[[exp_cname]])
# Return the tall data!
return(tall_data)
}
#' Plot nmrnormRes Object
#'
#' Creates a scatter plot for an S3 object of type 'nmrnormRes'
#'
#' @param x an object of type nmrnormRes, created by
#' \code{\link{normalize_nmr}}
#' @param nmrData An nmrData object.
#' @param order_by A character string specifying a column in f_data by which to
#' order the samples.
#' @param color_by A character string specifying a column in f_data by which to
#' color the points.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label
#' @param x_lab_size integer value indicating the font size for the x-axis. The
#' default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis. The
#' default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param point_size integer specifying the size of the points. The default is
#' 2.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white
#' theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mynmr <- edata_transform(omicsData = nmr_identified_object, data_scale = "log2")
#' mynmrnorm <- normalize_nmr(
#' omicsData = mynmr,
#' apply_norm = FALSE,
#' metabolite_name = "unkm1.53"
#' )
#' plot(mynmrnorm)
#'
#' mynmrnorm2 <- normalize_nmr(
#' omicsData = mynmr,
#' apply_norm = FALSE,
#' sample_property_cname = "Concentration"
#' )
#' plot(mynmrnorm2)
#'
#' @rdname plot-nmrnormRes
#' @export
#'
plot.nmrnormRes <- function(x, nmrData = NULL, order_by = NULL,
color_by = NULL, interactive = FALSE,
x_lab = NULL, y_lab = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "none",
point_size = 2, bw_theme = TRUE, palette = NULL,
...) {
nmrnormRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
if (!inherits(nmrnormRes_obj, "nmrnormRes")) {
# My name is Evan Martin. You defiled pmart. Prepare to die.
stop("object must be of class 'nmrnormRes'")
}
if (!is.null(order_by)) {
# Farm boy, make sure an nmrData object is provided. As you wish.
if (is.null(nmrData)) {
# To the pain!
stop("An nmrData object must be provided if order_by is not NULL.")
}
# Farm boy, make sure order_by exists in f_data. As you wish.
if (!order_by %in% names(nmrData$f_data)) {
# Do you hear that user? Those are the shrieking eels!
stop("order_by must be a column in f_data.")
}
}
if (!is.null(color_by)) {
# Farm boy, make sure an nmrData object is provided. As you wish.
if (is.null(nmrData)) {
# To the pain!
stop("An nmrData object must be provided if color_by is not NULL.")
}
# Farm boy, make sure color_by exists in f_data. As you wish.
if (!color_by %in% names(nmrData$f_data)) {
# Fezzik rip his arms off. Oh, you mean these column names.
stop("color_by must be a column in f_data.")
}
}
# extracting attributes from nmrnormRes_obj
sample_property_cname <- attr(
nmrnormRes_obj,
"nmr_info"
)$sample_property_cname
metabolite_name <- attr(nmrnormRes_obj, "nmr_info")$metabolite_name
fdata_cname <- attr(nmrnormRes_obj, "cnames")$fdata_cname
# organize nmrnormRes_obj
data <- data.frame(
Sample = nmrnormRes_obj$Sample,
value = nmrnormRes_obj$value
)
# Check if order_by is NULL and update the plot data object accordingly.
if (!is.null(order_by)) {
# Reorder the rows of data so the plot will be displayed in the correct
# order. Dread Pirate Roberts only likes plots that are ordered. What Dread
# Pirate Roberts doesn't like doesn't get plotted. Savvy?
#
# ggplot thinks it knows what is best for everyone in every situation. I
# disagree. However, we must follow ggplot convention. ggplot orders the
# data how they want to unless you explicitly give them the order you want.
# The code below is telling ggplot to shove it and to plot it in the order
# we want. BAM!!
data$Sample <- factor(
data$Sample,
levels = data$Sample[order(nmrData$f_data[, order_by])],
ordered = TRUE
)
}
# Check if color_by is NULL and update the plot data accordingly.
if (!is.null(color_by)) {
# Create factors to color by according to the input of color_by.
color_levels <- unique(factor(nmrData$f_data[[color_by]]))
# Farm boy, add a variable specifying the color for each point.
data$Color <- factor(nmrData$f_data[[color_by]],
levels = sort(color_levels))
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Do all the tedious plot label crap.
xlabel <- if (is.null(x_lab)) "Sample ID" else x_lab
legendLabel <- if (is.null(legend_lab)) "Sample" else legend_lab
# Create y-axis and plot title labels when a reference metabolite is used.
if (!is.null(metabolite_name)) {
ylabel <- if (is.null(y_lab)) metabolite_name else y_lab
plot_title <- if (is.null(title_lab))
"Reference Metabolite Profile" else
title_lab
# Create y-axis and plot title labels when the sample property is used.
} else if (!is.null(sample_property_cname)) {
ylabel <- if (is.null(y_lab)) sample_property_cname else y_lab
plot_title <- if (is.null(title_lab))
"Sample Property Profile" else
title_lab
}
# Generate dazzling plots ----------------------------------------------------
# Create the plot skeleton according to the color_by argument.
if (!is.null(color_by)) {
p <- ggplot2::ggplot(
data = data,
ggplot2::aes(
x = Sample,
y = value,
color = Color
)
)
# Check if palette is NULL or not. Hopefully it isn't so the plot will be
# created with colors other than the super hideous default ggplot2 colors.
if (!is.null(palette)) {
# Create a color from the color brewer package if a palette is provided.
colas <- RColorBrewer::brewer.pal(5, palette)
}
} else {
p <- ggplot2::ggplot(
data = data,
ggplot2::aes(
x = Sample,
y = value
)
)
}
# Want your plot to have a black and white background? As you wish. The black
# and white theme needs to come before the code that creates the scatter plot.
# If the theme_bw code follows the code that creates the scatter plot it will
# add the legend back to the graph (if legend_position = "none").
if (bw_theme == TRUE) p <- p + ggplot2::theme_bw()
# Add the points and labels to the dazzling plot.
p <- p +
ggplot2::geom_point(size = point_size) +
ggplot2::ggtitle(plot_title) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::labs(color = legendLabel) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Farm boy, make me a plot with beautiful colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_color_brewer(
palette = palette,
name = legendLabel
)
}
# Farm boy, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot SPANSRes Object
#'
#' For plotting an S3 object of type 'SPANSRes'
#'
#' @param x an object of the class 'SPANSRes', created by
#' \code{\link{spans_procedure}}
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is NULL.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param color_low character string specifying the color of the gradient for
#' low values.
#' @param color_high character string specifying the color of the gradient for
#' high values
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' \donttest{
#' library(pmartRdata)
#' data(pep_object)
#' mypep <- edata_transform(omicsData = pep_object, data_scale = "log2")
#' mypep <- group_designation(omicsData = mypep, main_effects = "Phenotype")
#' myspans <- spans_procedure(omicsData = mypep)
#' plot(myspans)
#' }
#' @rdname plot-SPANSRes
#'
#' @export
#'
plot.SPANSRes <- function(x, interactive = FALSE,
x_lab = NULL, y_lab = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = NULL,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
color_low = NULL, color_high = NULL,
bw_theme = TRUE, ...) {
SPANSRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
if (!inherits(SPANSRes_obj, "SPANSRes")) {
# Suffer the wrath of Dread Pirate Roberts!!!!!
stop("object must be of class 'SPANSRes'")
}
# plotting object with numeric SPANS_score, the normalization method, and a
# modified string specifying the subset method + parameters for that method
SPANSRes_obj <- SPANSRes_obj %>%
dplyr::mutate(
ss_par = paste(subset_method, parameters, sep = " | "),
SPANS_score = as.numeric(SPANS_score)
) %>%
dplyr::left_join(attr(SPANSRes_obj, "method_selection_pvals"),
by = c(
"subset_method",
"normalization_method",
"parameters"
)
)
# Farm boy, fix all the problems. As you wish. Filter rows with the highest
# SPANS score. This subsetted/filtered data frame will be used to add points
# to the plot for the best scoring methods. The best methods are those with
# the highest SPANS_score. The slice_max function will select ALL rows where
# the highest score occurs.
da_best <- SPANSRes_obj %>%
dplyr::slice_max(SPANS_score)
# Do all the tedious plot label crap.
xlabel <- if (is.null(x_lab)) "Normalization Method" else x_lab
ylabel <- if (is.null(y_lab)) "Subset Parameters" else y_lab
plot_title <- if (is.null(title_lab)) NULL else title_lab
legendLabel <- if (is.null(legend_lab)) "Score" else legend_lab
# Produce magnificent plots --------------------------------------------------
p <- ggplot2::ggplot(data = SPANSRes_obj) +
ggplot2::geom_tile(
ggplot2::aes(
x = normalization_method,
y = ss_par,
alpha = 1
),
color = 'black'
) +
ggplot2::geom_tile(
ggplot2::aes(
x = normalization_method,
y = ss_par,
fill = SPANS_score
),
color = 'black'
) +
ggplot2::geom_point(
data = da_best,
ggplot2::aes(
x = normalization_method,
y = ss_par,
shape = '1'
)
) +
ggplot2::scale_alpha_continuous(
name = 'Not Scored',
labels = ''
) +
ggplot2::scale_shape_discrete(
name = 'Best Scores',
labels = ''
) +
ggplot2::scale_fill_gradient(
low = if (is.null(color_low)) "#132B43" else color_low,
high = if (is.null(color_high)) "#56B1F7" else color_high,
) +
ggplot2::ggtitle(plot_title) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel)
# Want the black and white theme? As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
p <- p +
ggplot2::labs(fill = legendLabel) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle),
legend.position = legend_position,
panel.border = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
axis.line = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank()
)
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) {
p <- plotly::plot_ly(
SPANSRes_obj,
x = ~normalization_method,
y = ~ss_par,
z = ~SPANS_score,
hoverinfo = 'text',
text = ~ paste(
'</br> F(-Log10(HSmPV)):',
F_log_HSmPV,
'</br> F(Log10(NSmPV)): ',
F_log_NSmPV,
'</br> Scale p-value: ',
scale_p_value,
'</br> Location p-value',
location_p_value
),
colors = grDevices::colorRamp(
c(
if (is.null(color_low)) "#132B43" else color_low,
if (is.null(color_high)) "#56B1F7" else color_high
)
),
type = "heatmap"
) %>%
plotly::add_trace(
x = da_best$normalization_method,
y = da_best$ss_par,
type = 'scatter',
mode = "markers",
marker = list(color = "black"),
name = "Top SPANS scores",
inherit = FALSE
) %>%
plotly::colorbar(title = "SPANS score") %>%
plotly::layout(
plot_bgcolor = 'black',
xaxis = list(title = "Normalization Method"),
yaxis = list(title = "Subset Method"),
showlegend = TRUE
)
}
return(p)
}
#' Plot naRes Object
#'
#' For plotting an S3 object of type 'naRes'
#'
#' @param x list of two data frames, one containing the number of
#' missing values by sample, and the other containing missing values by
#' molecule
#' @param omicsData object of class 'pepData', 'proData', 'metabData',
#' 'lipidData', nmrData', or 'seqData', created by \code{\link{as.pepData}},
#' \code{\link{as.proData}}, \code{\link{as.metabData}},
#' \code{\link{as.lipidData}}, \code{\link{as.nmrData}}, or \code{\link{as.seqData}}, respectively.
#' @param plot_type character string specifying which type of plot to produce.
#' The two options are 'bar' or 'scatter'.
#' @param nonmissing logical value. When FALSE, plots missing values. When TRUE,
#' plots non-missing values.
#' @param proportion logical value. When TRUE, plots the proportion of missing
#' (or non-missing if \code{nonmissing} is TRUE) to the total number of
#' values. Only works with a plot type of 'bar'.
#' @param order_by A character string specifying a column in f_data by which to
#' order the samples. Specifying "Group" will use the "Group" column of the
#' object's \code{group_DF} attribute to order the samples. Only works with a
#' plot type of 'bar'.
#' @param color_by A character string specifying a column in f_data by which to
#' color the bars or the points depending on the \code{plot_type}. Specifying
#' "Group" will use the "Group" column of the object's \code{group_DF}
#' attribute to color the samples. Only works with a plot type of 'bar'.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab_bar character string used for the x-axis label for the bar
#' plot
#' @param x_lab_scatter character string used for the x-axis label for the
#' scatter plot
#' @param y_lab_bar character string used for the y-axis label for the bar
#' plot
#' @param y_lab_scatter character string used for the y-axis label for the
#' scatter plot
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' @param title_lab_bar character string used for the plot title when
#' \code{plot_type} is 'bar'.
#' @param title_lab_scatter character string used for the plot title when
#' \code{plot_type} is 'scatter'.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab_bar character string specifying the legend title when
#' creating a bar plot.
#' @param legend_lab_scatter character string specifying the legend title when
#' creating a scatter plot.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", or "bottom". The default is
#' "right".
#' @param point_size An integer specifying the size of the points. The default
#' is 2.
#' @param text_size An integer specifying the size of the text (number of
#' missing values by sample) within the bar plot. The default is 3.
#' @param bar_width An integer indicating the width of the bars in the bar plot.
#' The default is 0.8.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param display_count logical value. Indicates whether the missing value
#' counts by sample will be displayed on the bar plot. The default is TRUE.
#' @param coordinate_flip logical value. Indicates whether the x and y axes will
#' be flipped. The default is FALSE.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @details This function takes in an object of class naRes and creates either a
#' bar or scatter plot of missing values. When plot_type = 'bar', a sample
#' name by missing values count bar chart is returned. When plot_type =
#' 'scatter' a mean intensity vs number of missing values (per molecule)
#' scatter plot is returned. Note: If the omicsData object has had
#' \code{\link{group_designation}} applied to it, the points in the plot will
#' be colored by group.
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mylipid <- group_designation(omicsData = lipid_neg_object, main_effects = "Virus")
#' result <- missingval_result(omicsData = mylipid)
#' plot(result, omicsData = mylipid, plot_type = "bar",
#' x_lab_angle = 50, order_by = "Virus", color_by = "Virus")
#' plot(result, omicsData = mylipid, plot_type = "scatter",
#' x_lab_angle = 50, color_by = "Virus")
#'
#' result <- missingval_result(omicsData = rnaseq_object)
#' plot(result, omicsData = rnaseq_object, plot_type = "bar")
#'
#' @rdname plot-naRes
#'
#' @export
#'
plot.naRes <- function (x, omicsData, plot_type = "bar",
nonmissing = FALSE, proportion = FALSE,
order_by = NULL, color_by = NULL,
interactive = FALSE, x_lab_bar = NULL,
x_lab_scatter = NULL, y_lab_bar = NULL,
y_lab_scatter = NULL, x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 60, title_lab_bar = NULL,
title_lab_scatter = NULL, title_lab_size = 14,
legend_lab_bar = NULL, legend_lab_scatter = NULL,
legend_position = "right", point_size = 2,
text_size = 3, bar_width = 0.8, bw_theme = TRUE,
palette = NULL, display_count = TRUE,
coordinate_flip = FALSE, use_VizSampNames = FALSE,
...) {
naRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# check for a naRes object #
if (!inherits(naRes_obj, "naRes")) stop("object must be of class 'naRes'")
# Check that omicsData is the correct class.
if (!inherits(omicsData, c(
"proData", "pepData", "lipidData",
"metabData", "nmrData", "seqData"
))) {
# Fezzik, tear his arms off.
stop("omicsData is not an appropriate class")
}
# Check that type is either bar or scatter.
if (!(plot_type %in% c("bar", "scatter"))) {
# My name is Evan Martin. You killed my plot. Prepare to die.
stop("plot_type must be either 'bar' or 'scatter'")
}
# Check to make sure proportion is only used with bar plot
if (proportion && plot_type != "bar") {
stop("plot_type must be 'bar' if proportion is TRUE")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Farm boy, make sure order_by exists in f_data. As you wish.
if (!is.null(order_by) && order_by != "Group") {
if (!order_by %in% names(omicsData$f_data)) {
# I'm a pmartR developer. You killed my plot. Prepare to receive an error.
stop ("order_by: column '", order_by, "' not found in f_data.")
}
}
# Farm boy, make sure color_by exists in f_data. As you wish.
if (!is.null(color_by) && color_by != "Group") {
if (!color_by %in% names(omicsData$f_data)) {
# Clearly you cannot choose a column name in f_data!
stop ("color_by: column '", color_by, "' not found in f_data.")
}
}
# Extract info from naRes_obj
if (inherits(omicsData, "seqData")) {
na.by.sample <- naRes_obj$zeros.by.sample
na.by.molecule <- naRes_obj$zeros.by.molecule
num_missing_vals <- na.by.molecule$num_zeros
num_nonmissing_vals <- na.by.molecule$num_nonzeros
missing_proportion <- na.by.molecule$zeros_proportion
names(na.by.sample)[which(names(na.by.sample) == "num_zeros")] <- "num_NA"
names(na.by.molecule)[which(names(na.by.molecule) == "num_zeros")] <- "num_NA"
names(na.by.sample)[which(names(na.by.sample) == "num_nonzeros")] <- "num_non_NA"
names(na.by.molecule)[which(names(na.by.molecule) == "num_nonzeros")] <- "num_non_NA"
} else {
na.by.sample <- naRes_obj$na.by.sample
na.by.molecule <- naRes_obj$na.by.molecule
num_missing_vals <- na.by.molecule$num_NA
num_nonmissing_vals <- na.by.molecule$num_non_NA
}
# Get the proportion of missing/nonmissing to total (missing + nonmissing)
target_NA_column <- ifelse(nonmissing, "num_non_NA", "num_NA")
na.by.molecule$NA_proportion <- na.by.molecule[[target_NA_column]] /
(na.by.molecule$num_NA + na.by.molecule$num_non_NA)
na.by.sample$NA_proportion <- na.by.sample[[target_NA_column]] /
(na.by.sample$num_NA + na.by.sample$num_non_NA)
edata_cname <- attr(naRes_obj, "cnames")$edata_cname
fdata_cname <- attr(naRes_obj, "cnames")$fdata_cname
# Extract info from omicsData
edata <- omicsData$e_data
edata_cname_id <- which(names(edata) == edata_cname)
group_df <- get_group_DF(omicsData)
# Bar plot order_by and group_by crap ---------------
# Check if order_by is NULL and update the plot_data object accordingly.
if (!is.null(order_by)) {
if (order_by == "Group") {
na.by.sample <- na.by.sample[order(na.by.sample$Group), ]
na.by.sample[[fdata_cname]] <- factor(
na.by.sample[[fdata_cname]],
levels = na.by.sample[[fdata_cname]],
ordered = TRUE
)
} else {
# Reorder the rows of na.by.sample so the bar plot will be displayed in the
# correct order.
na.by.sample <- na.by.sample[order(na.by.sample[, order_by]), ]
na.by.sample[[fdata_cname]] <- factor(
na.by.sample[[fdata_cname]],
levels = na.by.sample[[fdata_cname]],
ordered = TRUE
)
}
}
# Check if color_by is NULL and update na.by.sample accordingly.
if (!is.null(color_by)) {
# Create factors to color by according to the input of color_by.
color_levels <- if (color_by != "Group")
unique(factor(omicsData$f_data[[color_by]])) else
unique(factor(attr(omicsData, "group_DF")[["Group"]]))
na.by.sample[[color_by]] <- factor(na.by.sample[[color_by]],
levels = sort(color_levels))
}
# Fashion astonishing plots --------------------------------------------------
# Make me a bar plot. As you wish.
if (plot_type == "bar") {
p <- na_bar(na.by.sample = na.by.sample, x_lab_bar = x_lab_bar,
y_lab_bar = y_lab_bar, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab_bar = title_lab_bar, title_lab_size = title_lab_size,
legend_lab_bar = legend_lab_bar,
legend_position = legend_position, text_size = text_size,
bar_width = bar_width, bw_theme = bw_theme, palette = palette,
display_count = display_count,
coordinate_flip = coordinate_flip,
use_VizSampNames = use_VizSampNames, interactive = interactive,
fdata_cname = fdata_cname, color_by = color_by,
nonmissing = nonmissing, proportion = proportion)
}
# Make me a scatter plot. As you wish.
if (plot_type == "scatter") {
p <- na_scatter(edata = edata, group_df = group_df,
na.by.molecule = na.by.molecule,
edata_cname = edata_cname, edata_cname_id = edata_cname_id,
fdata_cname = fdata_cname, x_lab_scatter = x_lab_scatter,
y_lab_scatter = y_lab_scatter,
title_lab_scatter = title_lab_scatter,
legend_lab_scatter = legend_lab_scatter,
legend_position = legend_position,
title_lab_size = title_lab_size, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, text_size = text_size,
bw_theme = bw_theme, palette = palette,
x_lab_angle = x_lab_angle,
coordinate_flip = coordinate_flip,
interactive = interactive, point_size = point_size,
nonmissing = nonmissing)
}
return(p)
}
na_bar <- function (na.by.sample, x_lab_bar, y_lab_bar, x_lab_size, y_lab_size,
x_lab_angle, title_lab_bar, title_lab_size, legend_lab_bar,
legend_position, text_size, bar_width, bw_theme, palette,
display_count, coordinate_flip, use_VizSampNames,
interactive, fdata_cname, color_by, nonmissing,
proportion) {
# Select which column of na.by.sample will be used
if (proportion) {
y_axis = "NA_proportion"
} else if (nonmissing) {
y_axis = "num_non_NA"
} else {
y_axis = "num_NA"
}
# Farm boy, color the plots based on the input. As you wish.
if (!is.null(color_by)) {
# Forge the basic sample bar plot with group info. More details will be
# added according to the users input later.
samp <- ggplot2::ggplot(
data = na.by.sample,
ggplot2::aes(
x = .data[[fdata_cname]],
y = .data[[y_axis]],
fill = !!dplyr::sym(color_by)
)
) +
ggplot2::geom_bar(stat = "identity", width = bar_width)
} else {
# Check if palette is NULL or not. Hopefully it isn't so the plot will be
# created with colors other than the super hideous default ggplot2 colors.
if (!is.null(palette)) {
# Create a color from the color brewer package if a palette is provided.
colas <- RColorBrewer::brewer.pal(5, palette)
}
# Create an object for the first default ggplot2 color.
hideous <- grDevices::hcl(h = 15,
c = 100,
l = 65)
# Forge the basic sample bar plot without group info. More details will be
# added according to the users input later.
samp <- ggplot2::ggplot(data = na.by.sample,
ggplot2::aes(x = .data[[fdata_cname]],
y = .data[[y_axis]])) +
ggplot2::geom_bar(stat = "identity",
width = bar_width,
fill = if (is.null(palette))
hideous else
colas[[3]])
}
# Add the counts to the bar plot and histogram if the user so desires.
if (display_count) {
samp <- samp +
ggplot2::geom_text(ggplot2::aes(label = round(.data[[y_axis]], digits=4)),
vjust = 2,
color = "black",
size = text_size)
}
# Want the black and white theme? As you wish.
if (bw_theme) samp <- samp + ggplot2::theme_bw()
# Make labels for both the plot by sample and plot by molecule.
xLabelBar <- if (is.null(x_lab_bar))
"Sample Name" else
x_lab_bar
yLabelBar <- if (is.null(y_lab_bar))
sprintf(
"%s of %s values",
ifelse(proportion, "Proportion", "Number"),
ifelse(nonmissing, "non-missing", "missing")
) else
y_lab_bar
plotTitleBar <- if (is.null(title_lab_bar))
sprintf(
"%s values by sample",
ifelse(nonmissing, "Non-missing", "Missing")
) else
title_lab_bar
legendLabelBar <- if (is.null(legend_lab_bar))
color_by else
legend_lab_bar
# Add labels to the plots. Even more tedious work to do. Will it ever end!?!
samp <- samp +
ggplot2::xlab(xLabelBar) +
ggplot2::ylab(yLabelBar) +
ggplot2::ggtitle(plotTitleBar) +
ggplot2::labs(fill = legendLabelBar) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Want to use beautiful non-default colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
samp <- samp +
ggplot2::scale_fill_brewer(
palette = palette,
name = legendLabelBar
)
}
# Want to use short sample names? As you wish.
if (use_VizSampNames) {
samp <- samp +
ggplot2::scale_x_discrete(labels = na.by.sample$VizSampNames)
}
# Want to be bass ackwards? As you wish. (This is for the crazies.)
if (coordinate_flip) samp <- samp + ggplot2::coord_flip()
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) samp <- plotly::ggplotly(samp)
return(samp)
}
na_scatter <- function (edata, group_df, na.by.molecule, edata_cname,
edata_cname_id, fdata_cname, x_lab_scatter,
y_lab_scatter, title_lab_scatter, legend_lab_scatter,
legend_position, title_lab_size, x_lab_size, y_lab_size,
text_size, bw_theme, palette, x_lab_angle,
coordinate_flip, interactive, point_size,
nonmissing) {
# Select missing/nonmissing
if (nonmissing)
num_missing_vals <- na.by.molecule$num_non_NA
else
num_missing_vals <- na.by.molecule$num_NA
# More tedious label making.
xLabelScatter <- if (is.null(x_lab_scatter))
"Mean Intensity" else
x_lab_scatter
yLabelScatter <- if (is.null(y_lab_scatter))
"Number of Missing Values (per molecule)" else
y_lab_scatter
plotTitleScatter <- if (is.null(title_lab_scatter))
"Mean Intensity vs NA per Molecule" else
title_lab_scatter
legendLabelScatter <- if (is.null(legend_lab_scatter))
"Group" else
legend_lab_scatter
if (is.null(group_df)) {
# Calculate the mean intensity for each molecule when the group_DF attribute
# is NULL.
mean_intensity <- rowMeans(edata[, -edata_cname_id], na.rm = TRUE)
plot_data <- as.data.frame(cbind(mean_intensity, num_missing_vals))
# Start the scatter plot when the group_DF attribute is NULL.
p <- ggplot2::ggplot(
plot_data,
ggplot2::aes(
mean_intensity,
num_missing_vals
)
) +
ggplot2::geom_point(size = point_size)
} else {
# Extract group information to calculate the group-wise mean for each
# molecule.
levels <- unique(group_df$Group)
indices_list <- vector(
mode = "list",
length = length(levels)
)
for (i in 1:length(levels)) {
# Extract the column indices for the ith group. This will be used to
# subset e_data.
inds <- which(group_df$Group == levels[i])
indices_list[[i]] <- inds
}
# Calculate the mean intensity for each molecule by group. NaN can appear if
# an entire row has all NA values.
mean_by_group <- lapply(indices_list,
function(x, temp_edata) rowMeans(temp_edata[x],
na.rm = TRUE
),
temp_edata = edata[, -edata_cname_id]
)
names(mean_by_group) <- levels
mean_intensity <- do.call(cbind, mean_by_group)
plot_data <- cbind(num_missing_vals, mean_intensity)
plot_data <- as.data.frame(plot_data)
plot_data <- plot_data %>%
tidyr::pivot_longer(
-num_missing_vals,
cols_vary = "slowest",
names_to = "variable",
values_to = "value"
) %>% dplyr::mutate(
variable = factor(
variable,
levels = names(plot_data)[
-which(names(plot_data) == "num_missing_vals")
]
)
) %>% data.frame
# Start the scatter plot when the group_DF attribute is present.
p <- ggplot2::ggplot(
dplyr::filter(plot_data, !is.na(value)),
ggplot2::aes(
value,
num_missing_vals
)
) +
ggplot2::geom_point(ggplot2::aes(color = variable),
size = point_size
)
}
# Add the x, y, and title labels.
p <- p +
ggplot2::xlab(xLabelScatter) +
ggplot2::ylab(yLabelScatter) +
ggplot2::ggtitle(plotTitleScatter)
# Want the black and white theme? As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Want to be bass ackwards? As you wish.
if (coordinate_flip) p <- p + ggplot2::coord_flip()
# Add all of the theme crap now that the theme_bw crap is out of the way.
p <- p +
ggplot2::labs(color = legendLabelScatter) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Want to use beautiful non-default colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_color_brewer(
palette = palette,
name = legendLabelScatter
)
}
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot corRes Object
#'
#' For plotting an S3 object of type 'corRes'
#'
#' @param x An object of class "corRes" created via \code{cor_result}
#' @param omicsData an object of the class 'pepData', 'isobaricpepData',
#' 'proData', 'lipidData', 'metabData', 'nmrData' or 'seqData' created via
#' \code{\link{as.pepData}}, \code{\link{as.isobaricpepData}},
#' \code{\link{as.proData}}, \code{\link{as.lipidData}},
#' \code{\link{as.metabData}}, \code{\link{as.nmrData}}, or
#' \code{\link{as.seqData}}, respectively.
#' @param order_by A character string specifying a column in f_data by which to
#' order the samples.
#' @param x_text logical value. Indicates whether the x-axis will be labeled
#' with the sample names. The default is TRUE.
#' @param y_text logical value. Indicates whether the y-axis will be labeled
#' with the sample names. The default is TRUE.
#' @param colorbar_lim A pair of numeric values specifying the minimum and
#' maximum values to use in the heat map color bar. Defaults to 'c(NA, NA)',
#' in which case ggplot2 automatically sets the minimum and maximum values
#' based on the correlation values in the data.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 90.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param color_low character string specifying the color of the gradient for
#' low values
#' @param color_high character string specifying the color of the gradient for
#' high values
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @rdname plot-corRes
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mymetab <- edata_transform(omicsData = metab_object, data_scale = "log2")
#' mymetab <- group_designation(omicsData = mymetab, main_effects = "Phenotype")
#' my_correlation <- cor_result(omicsData = mymetab)
#' plot(my_correlation, omicsData = mymetab, order_by = "Phenotype")
#'
#' \donttest{
#' myseq_correlation <- cor_result(omicsData = rnaseq_object)
#' plot(myseq_correlation)
#' }
#'
#' @export
#'
plot.corRes <- function(x, omicsData = NULL, order_by = NULL,
colorbar_lim = c(NA, NA), x_text = TRUE,
y_text = TRUE, interactive = FALSE, x_lab = NULL,
y_lab = NULL, x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 90, title_lab = NULL,
title_lab_size = 14, legend_lab = NULL,
legend_position = "right", color_low = NULL,
color_high = NULL, bw_theme = TRUE,
use_VizSampNames = FALSE, ...) {
corRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# check for a corRes object #
if (!inherits(corRes_obj, "corRes")) {
# You will be given iocane powder due to your carelessness.
stop("corRes_obj must be of class 'corRes'")
}
if (!all(is.na(colorbar_lim))) {
if (!is.numeric(colorbar_lim) || length(colorbar_lim) != 2) {
# I can clearly not choose the arguments in front of you!
stop("colorbar_lim must be a numeric vector of length 2")
}
}
# check that omicsData is of appropriate class #
if (!is.null(omicsData)) {
if (!inherits(omicsData, c(
"pepData", "proData", "metabData",
"lipidData", "nmrData", "seqData"
))) {
stop("omicsData is not an appropriate class")
}
}
if (!is.null(order_by)) {
# Farm boy, make sure order_by exists in f_data. As you wish.
if (!order_by %in% names(omicsData$f_data)) {
# I do not think that input means what you think it means.
stop("order_by must be a column in f_data.")
}
}
# Create plot data matrix ----------------------------------------------------
# Workaround for certain "check" warnings
Var1 <- Var2 <- value <- NULL
# Nab groupDF when omicsData is available and order_by is specified. BOOM!
if (!is.null(order_by)) {
# Farm boy, extract the group_DF attribute. As you wish.
groupDF <- attr(omicsData, "group_DF")
# If order_by is not "Group" then run group designation with the specified
# variable as the main effect.
if (order_by != "Group") {
# Fish out the group_DF data frame from omicsData after creating the
# group_DF attribute with the order_by input. This will be combined with
# the plot_data object so the samples can be ordered by the main effect.
orderDF <- attr(
group_designation(omicsData = omicsData, main_effects = order_by),
"group_DF"
)
} else {
# Use the original group_DF attribute for ordering the samples. This
# occurs when order_by = "group_DF".
orderDF <- groupDF
}
# Reorder the orderDF according to the order_by input. We can subset using
# "Group" because it will always be the column we are after. If the input to
# order_by = "Group" we will use the Group column from the group_DF
# attribute from the original input. If order_by is a variable other than
# group, we will run the group_designation function and the name of this
# variable will be changed to Group.
orderDF <- orderDF[order(orderDF$Group), ]
# Save the original is_normalized attribute. This attribute is erased when
# the rows and columns are reordered based on the orderDF object. This
# attribute is needed later in the function to correctly label the plot.
normal_attr <- attr(corRes_obj, "is_normalized")
# Reorder the rows and columns of the corRes object to match the order of
# the groups in orderDF. We can hard-code the first column of orderDF
# because this will always be the column containing the sample names.
# 1. Reorder the columns of corRes_obj to match the order of orderDF.
corRes_obj <- corRes_obj[, match(orderDF[, 1], colnames(corRes_obj))]
# 2. Reorder the rows of corRes_obj to match the order of orderDF.
corRes_obj <- corRes_obj[match(orderDF[, 1], rownames(corRes_obj)), ]
# Add the lost attributes back to the corRes_obj because they are needed
# later on.
attr(corRes_obj, "is_normalized") <- normal_attr
}
# Create the data frame that will be used to produce the correlation heat map.
corRes_obj_df <- data.frame(corRes_obj, check.names = FALSE)
corRes_obj_df <- cbind(Var1 = rownames(corRes_obj_df), corRes_obj_df)
rownames(corRes_obj_df) <- 1:nrow(corRes_obj_df)
corRes_melt <- corRes_obj_df %>%
tidyr::pivot_longer(
-Var1,
names_to = "Var2",
cols_vary = "slowest"
) %>%
dplyr::mutate(
Var1 = factor(
abbreviate(Var1, minlength = 20),
levels = abbreviate(rownames(corRes_obj), minlength = 20)
),
Var2 = factor(
abbreviate(Var2, minlength = 20),
levels = abbreviate(rownames(corRes_obj), minlength = 20)
)
) %>%
data.frame(check.names = FALSE)
# Create all the plot labels. Life is pain!!!
xlabel <- if (is.null(x_lab)) "" else x_lab
ylabel <- if (is.null(y_lab)) "" else y_lab
legendLabel <- if (is.null(legend_lab)) "Correlation" else legend_lab
if (is.null(title_lab)) {
# include correlation method in title
plotTitle <- paste0(
"Correlations Among Samples (",
stringr::str_to_title(attr(corRes_obj, "cor_method")),
")"
)
# Runs when title_lab is not NULL (the user specified title).
} else {
plotTitle <- title_lab
}
# Design spectacular plots ---------------------------------------------------
# Start the skeleton of the heat map. Other aspects are forthcoming.
hm <- ggplot2::ggplot(
corRes_melt,
ggplot2::aes(
x = Var2,
y = Var1
)
) +
ggplot2::geom_tile(ggplot2::aes(fill = value))
# Farm boy, make me a plot with the black and white theme. As you wish.
if (bw_theme) hm <- hm + ggplot2::theme_bw()
# Add plot and axis labels and theme elements.
hm <- hm +
ggplot2::ggtitle(plotTitle) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position,
panel.border = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
axis.line = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank()
)
# Farm boy, make me a plot with a custom correlation range. As you wish.
if (all(is.na(colorbar_lim))) {
# Use default range for the color gradient.
hm <- hm +
ggplot2::scale_fill_gradient(
legendLabel,
low = if (is.null(color_low)) "#132B43" else color_low,
high = if (is.null(color_high)) "#56B1F7" else color_high,
)
} else {
# Use the user specified range for the color gradient.
hm <- hm +
ggplot2::scale_fill_gradient(
legendLabel,
limits = colorbar_lim,
low = if (is.null(color_low)) "#132B43" else color_low,
high = if (is.null(color_high)) "#56B1F7" else color_high,
)
}
# If there are too many samples don't display the sample names on the plot.
if (nrow(corRes_obj) > 40) {
hm <- hm +
ggplot2::theme(
axis.text.x = ggplot2::element_blank(),
axis.text.y = ggplot2::element_blank()
)
}
# Farm boy, make me a plot without the x-axis sample labels. As you wish.
if (!x_text) hm <- hm + ggplot2::theme(axis.text.x = ggplot2::element_blank())
# Farm boy, make me a plot without the y-axis sample labels. As you wish.
if (!y_text) hm <- hm + ggplot2::theme(axis.text.y = ggplot2::element_blank())
# Farm boy, make me a plot with short sample names. As you wish.
if (use_VizSampNames) {
if (is.null(omicsData))
stop("If using custom sample names omicsData must not be NULL.")
hm <- hm +
ggplot2::scale_x_discrete(
labels = omicsData$f_data$VizSampNames,
breaks = levels(omicsData$f_data[, get_fdata_cname(omicsData)])
) +
ggplot2::scale_y_discrete(
labels = omicsData$f_data$VizSampNames,
breaks = levels(omicsData$f_data[, get_fdata_cname(omicsData)])
)
}
# Farm boy, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) hm <- plotly::ggplotly(hm)
return(hm)
}
#' Plot dimRes Object
#'
#' For plotting an S3 object of type 'dimRes'
#'
#' @param x object of class dimRes created by the \code{dim_reduction}
#' function
#' @param omicsData optional omicsData for use in specifying a column name in
#' fdata when using \code{color_by} or \code{shape_by}.
#' @param color_by character string specifying which column to use to control
#' the color for plotting. NULL indicates the default value of the main effect
#' levels (if present). "Group" uses the "Group" column of group_DF. NA
#' indicates no column will be used, and will use the default theme color. If
#' an omicsData object is passed, any other value will use the specified
#' column of f_data.
#' @param shape_by character string specifying which column to use to control
#' the shape for plotting. NULL indicates the default value of the second main
#' effect levels (if present). "Group" uses the "Group" column of group_DF. NA
#' indicates no column will be used, and will use the default theme shape. If
#' an omicsData object is passed, any other value will use the specified
#' column of f_data.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param point_size An integer specifying the size of the points. The default
#' is 4.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#'
#' mylipid <- edata_transform(omicsData = lipid_neg_object, data_scale = "log2")
#' mylipid <- group_designation(omicsData = mylipid, main_effects = "Virus")
#' pca_lipids <- dim_reduction(omicsData = mylipid)
#' plot(pca_lipids)
#'
#' \donttest{
#' myseq <- group_designation(omicsData = rnaseq_object, main_effects = "Virus")
#' pca_seq <- dim_reduction(omicsData = myseq)
#' plot(pca_seq)
#' }
#'
#' @rdname plot-dimRes
#'
#' @export
#'
plot.dimRes <- function (x, omicsData = NULL,
color_by = NULL, shape_by = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 0,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
point_size = 4, bw_theme = TRUE, palette = NULL, ...) {
dimRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Evan, make sure the input is the correct class. As you wish.
if (!inherits(dimRes_obj, "dimRes")) {
# Welcome to the pit of despair!
stop("dimRes_obj must be of class 'dimRes'")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
plotdata <- data.frame(SampleID = dimRes_obj$SampleID,
PC1 = dimRes_obj$PC1,
PC2 = dimRes_obj$PC2)
plotdata_name <- names(plotdata)[1]
# if there is a group designation #
if (!is.null(attr(dimRes_obj, "group_DF"))) {
group_DF <- attr(dimRes_obj, "group_DF")
fdata_cname <- names(group_DF)[1]
# if there's two main effects #
if (ncol(group_DF) == 4) {
main_eff_names <- names(group_DF[, 3:4])
# function for shortening long main effect names #
abbrev_fun <- function(string) {
if (nchar(string) > 25) string = paste0(substr(string, 1, 23), "...")
return(string)
}
# manage the length of legend titles #
display_names <- sapply(main_eff_names, abbrev_fun)
if (!identical(
as.character(plotdata[[plotdata_name]]),
as.character(group_DF[[fdata_cname]])
)) {
group_DF <- group_DF[match(
plotdata[[plotdata_name]],
group_DF[[fdata_cname]]
), ]
plotdata <- merge.data.frame(plotdata,
group_DF,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE
)
} else {
plotdata <- merge.data.frame(plotdata,
group_DF,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE
)
plotdata[[fdata_cname]] <- plotdata[[plotdata_name]]
}
color_var <- main_eff_names[1]
pch_var <- main_eff_names[2]
if (length(legend_lab) > length(main_eff_names)) {
warning(paste("legend_lab length is greater than the number of main",
"effects. Only the first two entries will be used.",
sep = " "
))
}
} else {
if (!identical(
as.character(plotdata[[plotdata_name]]),
as.character(group_DF[[fdata_cname]])
)) {
group_DF <- group_DF[match(
plotdata[[plotdata_name]],
group_DF[[fdata_cname]]
), ]
plotdata <- merge.data.frame(plotdata,
group_DF,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE
)
} else {
plotdata <- merge.data.frame(plotdata,
group_DF,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE
)
plotdata[[fdata_cname]] <- plotdata[[plotdata_name]]
}
color_var <- "Group"
pch_var <- NULL
display_names <- c("Group", NULL)
if (length(legend_lab) > 1) {
warning(paste("legend_lab length is greater than the number of main",
"effects. Only the first entry will be used.",
sep = " "
))
}
}
# Add any columns from f_data to the plotdata if present (for color_by
# and shape_by)
if (!is.null(omicsData)) {
if (is.null(omicsData$f_data)) {
stop("omicsData does not have f_data")
}
fdata_concat <- omicsData$f_data[
c(
which(colnames(omicsData$f_data) == fdata_cname),
which(!colnames(omicsData$f_data) %in% colnames(plotdata))
)
]
plotdata <- merge.data.frame(plotdata,
fdata_concat,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE)
plotdata[[fdata_cname]] <- plotdata[[plotdata_name]]
}
# Runs when there is no group information.
} else {
color_var <- NULL
pch_var <- NULL
display_names <- c(NULL, NULL)
if (!is.null(legend_lab)) {
warning("There is no group designation, so legend_lab will go unused.")
}
# Add any columns from f_data to the plotdata if present (for color_by
# and shape_by)
if (!is.null(omicsData)) {
if (is.null(omicsData$f_data)) {
stop("omicsData does not have f_data")
}
fdata_cname <- get_fdata_cname(omicsData)
fdata_concat <- omicsData$f_data[
c(
which(colnames(omicsData$f_data) == fdata_cname),
which(!colnames(omicsData$f_data) %in% colnames(plotdata))
)
]
plotdata <- merge.data.frame(plotdata,
fdata_concat,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE)
plotdata[[fdata_cname]] <- plotdata[[plotdata_name]]
}
}
if (!is.null(color_by)) {
if (is.na(color_by)) {
color_var <- NULL
} else if (color_by == "Group") {
color_var <- "Group"
display_names[1] <- "Group"
} else {
if(is.null(omicsData)) {
stop("color_by value is invalid. Did you mean to add an omicsData?")
}
if (!color_by %in% colnames(omicsData$f_data)) {
if (is.null(omicsData)) {
} else {
stop("color_by: column '", color_by, "' not found in f_data.")
}
}
color_var <- color_by
display_names[1] <- color_by
plotdata[[color_by]] <- as.factor(plotdata[[color_by]])
}
}
if (!is.null(shape_by)) {
if (is.na(shape_by)) {
pch_var <- NULL
} else if (shape_by == "Group") {
pch_var <- "Group"
display_names[2] <- "Group"
} else {
if(is.null(omicsData)) {
stop("shape_by value is invalid. Did you mean to add an omicsData?")
}
if (!shape_by %in% colnames(omicsData$f_data)) {
if (is.null(omicsData)) {
} else {
stop("shape_by: column '", shape_by, "' not found in f_data.")
}
}
pch_var <- shape_by
display_names[2] <- shape_by
plotdata[[shape_by]] <- as.factor(plotdata[[shape_by]])
}
}
# custom legend names #
if (!is.null(legend_lab)) {
# make the vector at least length 2 to avoid errors in the plot
display_names[1:length(legend_lab)] <- legend_lab[1:min(
2,
length(legend_lab)
)]
}
# title #
title_default <- ifelse(is.null(attr(dimRes_obj, "R2")),
"Principal Components (GLM-PCA)",
"Principal Components"
)
plot_title <- ifelse(is.null(title_lab), title_default, title_lab)
# Construct impressive plots -------------------------------------------------
# Create the bare bones plot.
p <- ggplot2::ggplot(
plotdata,
ggplot2::aes(
x = PC1,
y = PC2,
text = paste("Sample name: ", SampleID)
)
) +
ggplot2::geom_point(
ggplot2::aes(
col = if(!is.null(color_var)) .data[[color_var]] else NULL,
pch = if(!is.null(pch_var)) .data[[pch_var]] else NULL
),
size = point_size
) + ggplot2::labs(col = color_var, pch = pch_var)
# Evan, make me a plot with the black and white theme. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
if (is.null(attr(dimRes_obj, "R2"))) {
x_lab <- ifelse(is.null(x_lab), "PC1", x_lab)
y_lab <- ifelse(is.null(y_lab), "PC2", y_lab)
} else {
# Create objects for the percent variation for PC1 and PC2
pc1 <- round(attr(dimRes_obj, "R2")[1], 3)
pc2 <- round(attr(dimRes_obj, "R2")[2], 3)
# Tedious label making crap.
# These two lines don't currently work as intended. They display R^2 without
# the 2 as a superscript. However, the label cannot be created with substitute
# because it throws an error when converting to an interactive plot.
x_lab <- if (is.null(x_lab)) paste0(
"PC1 (",
expression(R^2),
" = ",
pc1,
")"
) else x_lab
y_lab <- if (is.null(y_lab)) paste0(
"PC2 (",
expression(R^2),
" = ",
pc2,
")"
) else y_lab
}
# Add labels and thematic elements.
p <- p +
ggplot2::ggtitle(plot_title) +
ggplot2::xlab(x_lab) +
ggplot2::ylab(y_lab) +
ggplot2::scale_shape_discrete(display_names[2])
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, make me a plot with dazzling colors. As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_color_brewer(
palette = palette,
name = display_names[1]
)
# Evan, make me a plot with hideous default ggplot2 colors. As you wish.
} else {
p <- p +
ggplot2::scale_color_discrete(display_names[1])
}
# Evan, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot moleculeFilt Object
#'
#' For plotting an S3 object of type 'moleculeFilt':
#'
#' @param x object of class moleculeFilt that contains the molecule
#' identifier and the number of samples for which the molecule was measured
#' (not NA)
#' @param min_num An integer specifying the minimum number of samples in which a
#' biomolecule must appear. If a value is specified, a horizontal line will be
#' drawn when \code{cumulative=TRUE}, and bars will be colored appropriately
#' if \code{cumulative=FALSE}. Defaults to NULL.
#' @param cumulative logical indicating whether the number of biomolecules
#' observed in \emph{at least} (TRUE) x number of samples or \emph{exactly}
#' (FALSE) x number of samples should be plotted. Defaults to TRUE.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param text_size integer specifying the size of the text (number of
#' biomolecules by sample) within the bar plot. The default is 3.
#' @param bar_width integer indicating the width of the bars in the bar plot.
#' The default is 0.8.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param display_count logical value. Indicates whether the missing value counts by
#' sample will be displayed on the bar plot. The default is TRUE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' data(pep_object)
#' molfilt <- molecule_filter(omicsData = pep_object)
#' plot(molfilt, min_num = 5)
#' plot(molfilt, min_num = 3, cumulative = FALSE)
#'
#' @rdname plot-moleculeFilt
#'
#' @export
#'
plot.moleculeFilt <- function(x, min_num = NULL, cumulative = TRUE,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 0, title_lab = NULL,
title_lab_size = 14, legend_lab = NULL,
legend_position = "right", text_size = 3,
bar_width = 0.8, bw_theme = TRUE,
palette = NULL, display_count = TRUE, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "moleculeFilt")) {
# Fezzik, tear his arms off.
stop("filter_object must be of class moleculeFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Forge sensational plots ----------------------------------------------------
# make counts, colors, and plot shape based on value of cumulative
# values that will be updated depending on input
fill <- 0
hline <- NULL
# create a TRUE/FALSE for if we are working with batch or not
use_batch <- attributes(filter_object)$use_batch
use_groups <- attributes(filter_object)$use_groups
if (cumulative) {
# cumulative counts (>=)
counts <- sapply(1:max(filter_object$Num_Observations), function(i) {
filter_object[filter_object$Num_Observations >= i, ]$Num_Observations %>% length()
})
# append 1 to extend last step (looks awkward without this)
counts <- c(counts, counts[length(counts)])
# 1 appended step
num_obs <- 1:(max(filter_object$Num_Observations) + 1)
# shape is a step function with fixed color
shape <- ggplot2::geom_step(
ggplot2::aes(
x = num_observations,
y = counts
),
color = "red"
)
# draw a horizontal line if min_num is specified
hline <- if (!is.null(min_num)) ggplot2::geom_hline(
yintercept = counts[min_num],
linetype = "dashed"
) else NULL
xlabel <- if (is.null(x_lab)) {
if (!use_batch & !use_groups) "Number of Samples"
else if (use_batch & !use_groups) "Number of Samples per Batch"
else if (!use_batch & use_groups) "Number of Samples per Group"
else "Number of Samples per Batch per Group"
}
ylabel <- ifelse(is.null(y_lab), "Count of Biomolecules", y_lab)
plot_title <- if (is.null(title_lab)) {
if (!use_batch & !use_groups) "Count of biomolecules observed in at least X number of samples"
else if (use_batch & !use_groups) "Minimum count of biomolecules observed in at least X number of samples per batch"
else if (!use_batch & use_groups) "Minimum count of biomolecules observed in at least X number of samples per group"
else "Minimum count of biomolecules observed in at least X number of samples per batch per group"
} else
title_lab
} else if (!cumulative) {
# counts for a specific number of nonmissing biomolecules (==)
counts <- sapply(1:max(filter_object$Num_Observations), function(i) {
filter_object[filter_object$Num_Observations == i, ]$Num_Observations %>%
length()
})
# color by which values are kept if min_num is specified
if (!is.null(min_num)) {
fill <- ifelse(1:max(filter_object$Num_Observations) >= min_num,
"retained",
"dropped"
)
shape <- ggplot2::geom_bar(
ggplot2::aes(
x = num_observations,
y = counts,
fill = fill
),
stat = "identity",
width = bar_width
)
} else {
# Check if palette is NULL or not. Hopefully it isn't so the plot will be
# created with colors other than the super hideous default ggplot2 colors.
if (!is.null(palette)) {
# Create a color from the color brewer package if a palette is provided.
colas <- RColorBrewer::brewer.pal(5, palette)
}
# Create an object for the first default ggplot2 color.
hideous <- grDevices::hcl(
h = 15,
c = 100,
l = 65
)
shape <- ggplot2::geom_bar(
ggplot2::aes(
x = num_observations,
y = counts
),
fill = if (is.null(palette))
hideous else
colas[[3]],
stat = "identity",
width = bar_width
)
}
num_obs <- 1:max(filter_object$Num_Observations)
xlabel <- if (is.null(x_lab)) "Number of samples" else x_lab
ylabel <- ifelse(is.null(y_lab), "Count of Biomolecules", y_lab)
plot_title <- ifelse(
is.null(title_lab),
"Count of biomolecules observed in exactly X number of samples",
title_lab
)
}
# create plotting dataframe
pep_observation_counts <- data.frame(
num_observations = num_obs,
frequency_counts = counts,
fill = fill
)
# plot #
p <- ggplot2::ggplot(pep_observation_counts) +
shape +
hline +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::ggtitle(plot_title) +
ggplot2::scale_x_continuous(breaks = max(filter_object$Num_Observations):1)
# Evan, make me a plot with the black and white theme. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Evan, display the biomolecule counts on the graph. As you wish.
if (display_count) p <- p + ggplot2::geom_text(
data = pep_observation_counts[1:max(filter_object$Num_Observations), ],
ggplot2::aes(
x = num_observations,
y = frequency_counts,
label = frequency_counts
),
vjust = -0.5,
nudge_x = ifelse(cumulative, 0.5, 0),
size = text_size
)
# Add the theme elements to the plot.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = ifelse(use_batch | use_groups, 11, title_lab_size)),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, make me a plot with beautiful colors. As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_fill_brewer(
palette = palette,
name = legend_lab
)
} else {
p <- p + ggplot2::scale_fill_manual(
name = legend_lab,
values = c(
"dropped" = "red",
"retained" = "green"
)
)
}
# Evan, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot totalCountFilt Object
#'
#' For plotting an S3 object of type 'totalCountFilt':
#'
#' @param x object of class totalCountFilt that contains the molecule
#' identifier and the number of total counts for which the molecule was measured
#' (not NA).
#' @param min_count integer specifying the minimum number of samples in which a
#' biomolecule must appear. Defaults to NULL.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param text_size integer specifying the size of the text (number of
#' biomolecules by sample) within the bar plot. The default is 3.
#' @param bar_width integer indicating the width of the bars in the bar plot.
#' The default is 0.8.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' \donttest{
#' library(pmartRdata)
#' seqfilt <- total_count_filter(omicsData = rnaseq_object)
#' plot(seqfilt, min_count = 15)
#' }
#'
#' @rdname plot-totalCountFilt
#'
#' @export
#'
plot.totalCountFilt <- function(x, min_count = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 0, title_lab = NULL,
title_lab_size = 14, legend_lab = "",
legend_position = "right", text_size = 3,
bar_width = 0.8, bw_theme = TRUE,
palette = NULL, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "totalCountFilt")) {
# Fezzik, tear his arms off.
stop("filter_object must be of class totalCountFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
## Checks for min_count as single numeric
if (!is.null(min_count) &&
(length(min_count) > 1 ||
!is.numeric(min_count))) stop("min_count must be numeric of length 1")
# Forge sensational plots ----------------------------------------------------
plot_data <- attr(filter_object, "e_data_lcpm")
title_default <- "Observation Density by LCPM"
if (!is.null(min_count)) {
biomols <- filter_object[[1]][filter_object$Total_Counts >= min_count]
if (length(biomols) == 0) stop(
"min_count exceeds maximum total count (",
max(filter_object$Total_Counts), ")"
)
plot_data <- plot_data[plot_data[[1]] %in% biomols, ]
subtitle <- paste0(min_count, "+ total counts per transcript")
} else subtitle <- NULL
xlabel <- if (is.null(x_lab)) "Log Counts per Million" else x_lab
ylabel <- ifelse(is.null(y_lab), "Observation Density", y_lab)
plot_title <- ifelse(
is.null(title_lab),
title_default,
title_lab
)
# Use the ColorBrewer color
values <- if (!is.null(palette)) {
c(
"Samples" = RColorBrewer::brewer.pal(5, palette)[[3]],
"Average Density" = RColorBrewer::brewer.pal(5, palette)[[5]]
)
} else {
c("Samples" = "grey", "Average Density" = "black")
}
# Plot
p <- ggplot2::ggplot(plot_data, ggplot2::aes(x = lcpm)) +
ggplot2::geom_density(ggplot2::aes(
group = !!dplyr::sym(colnames(plot_data)[2]),
color = !!dplyr::sym(colnames(plot_data)[2])
)) +
ggplot2::geom_density(ggplot2::aes(color = "Average Density")) +
ggplot2::scale_color_manual(
name = legend_lab,
values = values,
aesthetics = c("color")
) +
ggplot2::labs(
title = plot_title,
subtitle = subtitle,
x = xlabel, y = ylabel
)
# Evan, make me a plot with the black and white theme. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Add the theme elements to the plot.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot RNAFilt Object
#'
#' For plotting an S3 object of type 'RNAFilt'
#'
#' @param x object of class RNAFilt that contains the sample
#' identifier, library size, number of non-zero biomolecules, and proportion
#' of non-zero biomolecules
#' @param plot_type character string, specified as "library" or "biomolecule".
#' "library" displays library size for each sample, "biomolecule" displays the
#' number of unique biomolecules with non-zero counts per sample.
#' @param min_nonzero integer or float between 0 and 1. Cut-off for number of
#' unique biomolecules with non-zero counts or as a proportion of total
#' biomolecules. Defaults to NULL.
#' @param size_library integer cut-off for sample library size (i.e. number
#' of reads). Defaults to NULL.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param text_size An integer specifying the size of the text (number of
#' biomolecules by sample) within the bar plot. The default is 3.
#' @param bar_width An integer indicating the width of the bars in the bar plot.
#' The default is 0.8.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' seqfilt <- RNA_filter(omicsData = rnaseq_object)
#' plot(seqfilt)
#'
#' @rdname plot-RNAFilt
#'
#' @export
#'
plot.RNAFilt <- function(x, plot_type = "library",
size_library = NULL, min_nonzero = NULL,
interactive = FALSE,
x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 90, title_lab = NULL,
title_lab_size = 14, legend_lab = "",
legend_position = "right", text_size = 3,
bar_width = 0.8, bw_theme = TRUE,
palette = NULL, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "RNAFilt")) {
# Fezzik, tear his arms off.
stop("filter_object must be of class RNAFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
## Checks for plot_type as single string
if (is.null(plot_type) ||
length(plot_type) > 1 ||
!(plot_type %in% c('library', 'biomolecule'))) stop(
"plot_type must be either 'library' or 'biomolecule'"
)
## Checks for size_library as single integer
if (!is.null(size_library) &&
(length(size_library) > 1 ||
size_library %% 1 != 0 ||
size_library > max(filter_object$LibrarySize)
)
) stop(
paste0(
"size_library must be integer of length 1 less than max library size (",
max(filter_object$LibrarySize),
")"
)
)
## Checks for min_nonzero as single numeric
if (!is.null(min_nonzero)) {
## Length
if (length(min_nonzero) > 1) stop("min_nonzero must be length 1")
## proportion or int
if (!(min_nonzero %% 1 == 0 || (min_nonzero > 0 && min_nonzero < 1))) stop(
"min_nonzero must be integer or numeric between 0 and 1."
)
## Within appropriate bounds
if (min_nonzero %% 1 == 0 && min_nonzero > max(filter_object$NonZero)) stop(
paste0(
"min_nonzero exceeds maximum number of non-zero biomolecules (",
max(filter_object$NonZero),
")"
)
)
if (min_nonzero %% 1 != 0 &&
min_nonzero > max(filter_object$ProportionNonZero)) stop(
paste0(
"min_nonzero exceeds maximum proportion of non-zero biomolecules (",
signif(max(filter_object$ProportionNonZero)),
")"
)
)
}
# Forge sensational plots ----------------------------------------------------
## Set labels
xlabel <- if (is.null(x_lab)) "SampleID" else x_lab
plot_title <- ifelse(is.null(title_lab), "Library Size by Sample", title_lab)
if (plot_type == "library") {
ylabel <- ifelse(is.null(y_lab), "Library Size (Total Reads)", y_lab)
} else {
ylabel <- ifelse(is.null(y_lab), "N Non-zero Biomolecules", y_lab)
}
subtitle <- ""
if (!is.null(min_nonzero)) {
subtitle <- paste0(
subtitle,
ifelse(min_nonzero %% 1 == 0,
paste0("At least ", min_nonzero, " non-zero biomolecules"),
paste0("At least ", min_nonzero * 100, "% non-zero biomolecules")
)
)
}
if (!is.null(size_library)) {
subtitle <- paste0(
subtitle,
ifelse(subtitle == "",
"",
"\n"
),
paste0("At least ", size_library, " reads in sample library")
)
}
# Use the ColorBrewer color
values <- if (!is.null(palette)) {
RColorBrewer::brewer.pal(5, palette)[2, 4]
} else {
c(Keep = "deepskyblue3", Remove = "tomato")
}
temp_obj <- filter_object
temp_obj$keep_nz <- T
temp_obj$keep_sz <- T
if (!is.null(min_nonzero)) {
column_use <- ifelse(min_nonzero %% 1 == 0,
"NonZero", "ProportionNonZero"
)
temp_obj$keep_nz <- temp_obj[[column_use]] >= min_nonzero
}
if (!is.null(size_library)) {
temp_obj$keep_sz <- temp_obj[["LibrarySize"]] >= size_library
}
temp_obj$color <- as.character(Reduce("&", list(temp_obj$keep_nz, temp_obj$keep_sz)))
temp_obj$color <- gsub("FALSE", "Remove", gsub("TRUE", "Keep", temp_obj$color))
# Plot
if (plot_type == "library") {
p <- ggplot2::ggplot(
temp_obj, ggplot2::aes(x = !!dplyr::sym(colnames(temp_obj)[1]), y = LibrarySize, fill = color)
) +
ggplot2::geom_col(show.legend = F) +
ggplot2::scale_fill_manual(
name = legend_lab,
values = values,
aesthetics = c("fill")
) +
ggplot2::labs(
title = plot_title,
subtitle = subtitle,
x = xlabel, y = ylabel
)
if (!is.null(size_library)) {
p <- p + ggplot2::geom_segment(
y = size_library, yend = size_library,
xend = length(unique(temp_obj[[colnames(temp_obj)[1]]])) + .5,
x = 0, linetype = "dashed"
)
}
} else {
mt <- round(filter_object$NonZero[[1]] / filter_object$ProportionNonZero[[1]])
p <- ggplot2::ggplot(
temp_obj, ggplot2::aes(x = !!dplyr::sym(colnames(temp_obj)[1]), y = NonZero, fill = color)
) +
ggplot2::scale_y_continuous(
sec.axis = ggplot2::sec_axis(
trans = ~ . / mt,
name = "Proportion of all biomolecules"
)
) +
ggplot2::geom_col(show.legend = F) +
ggplot2::scale_fill_manual(
name = legend_lab,
values = values,
aesthetics = c("fill")
) +
ggplot2::labs(
title = plot_title,
subtitle = subtitle,
x = xlabel, y = ylabel
)
if (!is.null(min_nonzero)) {
p <- p + ggplot2::geom_segment(
y = min_nonzero, yend = min_nonzero,
xend = length(unique(temp_obj[[colnames(temp_obj)[1]]])) + .5,
x = 0, linetype = "dashed"
)
}
}
# Evan, make me a plot with the black and white theme. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Add the theme elements to the plot.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot imdanovaFilt Object
#'
#' For plotting an S3 object of type 'imdanovaFilt'
#'
#' @param x Object of class imdanovaFilt (also a data frame) containing
#' the molecule identifier and number of samples in each group with
#' non-missing values for that molecule
#' @param min_nonmiss_gtest An integer indicating the minimum number of
#' non-missing feature values allowed per group for \code{gtest_filter}.
#' Suggested value is 3.
#' @param min_nonmiss_anova An integer indicating the minimum number of
#' non-missing feature values allowed per group for \code{anova_filter}.
#' Suggested value is 2.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param point_size integer specifying the size of the points. The default
#' is 3.
#' @param line_size integer specifying the thickness of the line. The default
#' is 0.75.
#' @param text_size integer specifying the size of the text (number of
#' biomolecules per group). The default is 3.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param display_count logical value. Indicates whether the missing value counts by
#' sample will be displayed on the bar plot. The default is TRUE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' data(pep_object)
#' mypep <- group_designation(omicsData = pep_object, main_effects = "Phenotype")
#' to_filter <- imdanova_filter(omicsData = mypep)
#' plot(to_filter, min_nonmiss_anova = 2, min_nonmiss_gtest = 3)
#'
#' @rdname plot-imdanovaFilt
#'
#' @export
#'
plot.imdanovaFilt <- function(x, min_nonmiss_anova = NULL,
min_nonmiss_gtest = NULL, interactive = FALSE,
x_lab = NULL, y_lab = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = 0,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
point_size = 3, line_size = 0.75, text_size = 3,
bw_theme = TRUE, palette = NULL,
display_count = TRUE, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "imdanovaFilt")) {
# You used the wrong input for filter_object. Savvy?
stop("filter_object must be of class imdanovaFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Nab group size minimum that is not a singleton
group_sizes <- attr(filter_object, "group_sizes")$n_group
group_sizes_valid <- group_sizes[group_sizes > 1]
max_x <- min(group_sizes_valid)
obs <- as.data.frame(filter_object)[-1]
# Count number of groups in each row of the obs data frame that have > 0, > 1,
# ..., > max_x non-missing values. For ANOVA we need at least two groups that
# meet this criteria unless the data are paired and there are no main effects.
n_biomolecules_anova <- purrr::map_int(0:max_x, function(num) {
# Number of groups greater than num
n_greater_obs <- apply(obs, 1, function(row) sum(!(row < num)))
# If there are no main effects we need to count differently (in this case we
# do not need at least two groups to run ANOVA).
if ("paired_diff" %in% names(obs)) {
# biomolecules with 1+ group > num
n_greater_obs <- sum(apply(obs, 1, function(row) any(!(row < num))))
} else {
# Biomolecules with 2+ group > num.
sum(n_greater_obs > 1)
}
})
# Count number of groups in each row of the obs data frame that have > 0, > 1,
# ..., > max_x non-missing values. For G-Test we need at least one group that
# meets this criteria.
n_biomolecules_gtest <- purrr::map_int(0:max_x, function(num) {
# biomolecules with 1+ group > num
n_greater_obs <- sum(apply(obs, 1, function(row) any(!(row < num))))
})
# ANOVA table
plotter1 <- data.frame(
Min_obs = c(0:max_x),
Count_biomolecules = c(n_biomolecules_anova),
Statistic = c(rep("Within 2+ groups (ANOVA)", length(0:max_x)))
)
# G-test table
plotter2 <- data.frame(
Min_obs = c(0:max_x),
Count_biomolecules = c(n_biomolecules_gtest),
Statistic = c(rep("Within 1+ groups (G-Test)", length(0:max_x)))
)
# Evan, get me the colors of my choosing. As you wish.
if (!is.null(palette)) colas <- RColorBrewer::brewer.pal(5, palette)
# More monotonous label making code.
xlabel <- if (is.null(x_lab)) "Number of biomolecules" else x_lab
ylabel <- if (is.null(y_lab))
"Minimum number of observations per group" else
y_lab
titleLabel <- if (is.null(title_lab)) "IMD-ANOVA filter" else title_lab
# Fabricate glorious plots ---------------------------------------------------
# Construct the ggplot skeleton.
p <- ggplot2::ggplot() +
ggplot2::xlim(0, ceiling(max(n_biomolecules_gtest) * 1.25)) +
ggplot2::ylim(0, max_x)
# Evan, make the background black and white. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Evan, add title and axis labels. As you wish.
p <- p +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::ggtitle(titleLabel)
# Evan, add the gtest points to the plot. As you wish.
p <- p +
ggplot2::geom_point(
data = plotter2,
ggplot2::aes(
x = Count_biomolecules,
y = Min_obs,
color = Statistic
),
size = point_size
)
# Evan, display the counts on the plot. As you wish.
if (display_count) p <- p +
ggplot2::geom_text(
data = plotter2,
ggplot2::aes(
x = Count_biomolecules,
y = Min_obs,
label = Count_biomolecules
),
size = text_size,
hjust = -0.5
)
# Evan, add the anova points to the plot. As you wish.
p <- p +
ggplot2::geom_point(
data = plotter1,
ggplot2::aes(
x = Count_biomolecules,
y = Min_obs,
color = Statistic
),
size = point_size
)
# Evan, display the counts on the plot. As you wish.
if (display_count) p <- p +
ggplot2::geom_text(
data = plotter1,
ggplot2::aes(
x = Count_biomolecules,
y = Min_obs,
label = Count_biomolecules
),
size = text_size,
hjust = -0.5
)
# Evan, add gtest threshold to the plot. As you wish.
if (!is.null(min_nonmiss_gtest)) {
# Evan, add a vertical line for the gtest threshold. As you wish.
p <- p +
ggplot2::geom_hline(
ggplot2::aes(
yintercept = min_nonmiss_gtest,
color = "G-test applied filter"
),
linetype = "dashed",
linewidth = if (is.null(line_size)) 1 else line_size
)
}
# Evan, add anova threshold to the plot. As you wish.
if (!is.null(min_nonmiss_anova)) {
# Evan, add a vertical line for the anova threshold. As you wish.
p <- p +
ggplot2::geom_hline(
ggplot2::aes(
yintercept = min_nonmiss_anova,
color = "ANOVA applied filter"
),
linetype = "dotted",
size = if (is.null(line_size)) 1 else line_size
)
}
# Evan, add a custom legend according to anova and gtest inputs. As you wish.
# A minimum for gtest IS supplied and a minimum for anova IS NOT supplied.
if (!is.null(min_nonmiss_gtest) && is.null(min_nonmiss_anova)) {
# Add a customized legend when min_nonmiss_gtest is not NULL and
# min_nonmiss_anova is NULL.
p <- p +
ggplot2::scale_color_manual(
name = if (is.null(legend_lab)) "" else legend_lab,
values = c(
`Within 1+ groups (G-Test)` = if (is.null(palette))
"#FFC107" else
colas[[2]],
`G-test applied filter` = if (is.null(palette))
"#FFC107" else
colas[[2]],
`Within 2+ groups (ANOVA)` = if (is.null(palette))
"#004D40" else
colas[[3]]
),
breaks = c(
plotter2$Statistic[[1]], "G-test applied filter",
plotter1$Statistic[[1]], "ANOVA applied filter"
),
guide = ggplot2::guide_legend(
override.aes = list(
linetype = c(0, 2, 0),
shape = c(16, NA, 16),
color = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]]
)
)
)
)
} else if (is.null(min_nonmiss_gtest) && !is.null(min_nonmiss_anova)) {
# Add a customized legend when min_nonmiss_gtest is NULL and
# min_nonmiss_anova is not NULL.
p <- p +
ggplot2::scale_color_manual(
name = if (is.null(legend_lab)) "" else legend_lab,
values = c(
`Within 1+ groups (G-Test)` = if (is.null(palette))
"#FFC107" else
colas[[2]],
`Within 2+ groups (ANOVA)` = if (is.null(palette))
"#004D40" else
colas[[3]],
`ANOVA applied filter` = if (is.null(palette))
"#004D40" else
colas[[3]]
),
breaks = c(
plotter2$Statistic[[1]], "G-test applied filter",
plotter1$Statistic[[1]], "ANOVA applied filter"
),
guide = ggplot2::guide_legend(
override.aes = list(
linetype = c(0, 0, 3),
shape = c(16, 16, NA),
color = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]],
if (is.null(palette)) "#004D40" else colas[[3]]
)
)
)
)
# A minimum for gtest AND anova IS supplied.
} else if (!is.null(min_nonmiss_gtest) && !is.null(min_nonmiss_anova)) {
# Add a customized legend when both min_nonmiss_gtest and min_nonmiss_anova
# are not NULL.
p <- p +
ggplot2::scale_color_manual(
name = if (is.null(legend_lab)) "" else legend_lab,
values = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]],
if (is.null(palette)) "#004D40" else colas[[3]]
),
breaks = c(
plotter2$Statistic[[1]], "G-test applied filter",
plotter1$Statistic[[1]], "ANOVA applied filter"
),
guide = ggplot2::guide_legend(
override.aes = list(
linetype = c(0, 2, 0, 3),
shape = c(16, NA, 16, NA),
color = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]],
if (is.null(palette)) "#004D40" else colas[[3]]
)
)
)
)
# Neither a minimum for gtest nor anova is supplied.
} else {
# Add a customized legend when both min_nonmiss_gtest and min_nonmiss_anova
# are NULL.
p <- p +
ggplot2::scale_color_manual(
name = if (is.null(legend_lab)) "" else legend_lab,
values = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]]
),
guide = ggplot2::guide_legend(
override.aes = list(
shape = c(16, 16),
color = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]]
)
)
)
)
}
# Evan, add thematic elements to the plot. As you wish.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot proteomicsFilt Object
#'
#' For plotting an S3 object of type 'proteomicsFilt':
#'
#' @param x object of class proteomicsFilt, which is a list with two
#' elements. The first element is a data frame of counts for each unique
#' peptide. The second element is a data frame with the counts for the number
#' of peptides that map to each unique protein.
#' @param plot_type character string specifying the type of plot to be
#' displayed. The available options are "num_peps" or "redundancy". If
#' "num_peps" the plot is displayed that shows the counts of proteins that
#' have a specific number of peptides mapping to them. If "redundancy" the
#' plot showing the counts of peptides that map to a specific number of
#' proteins is displayed.
#' @param min_num_peps an optional integer value between 1 and the maximum
#' number of peptides that map to a protein in the data. The value specifies
#' the minimum number of peptides that must map to a protein. Any protein with
#' less than \code{min_num_peps} mapping to it will be returned as a protein
#' that should be filtered. Default value is NULL.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab_pep character string used for the x-axis label for the
#' num_peps plot. The default is NULL in which case the default x-axis label
#' will be used.
#' @param x_lab_pro character string used for the x-axis label for the
#' redundancy plot. The default is NULL in which case the default x-axis label
#' will be used.
#' @param y_lab_pep character string used for the y-axis label for the
#' num_peps plot. The default is NULL in which case the default y-axis label
#' will be used.
#' @param y_lab_pro character string used for the y-axis label for the
#' redundancy plot. The default is NULL in which case the default y-axis label
#' will be used.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab_pep character string specifying the num_peps plot title.
#' The default is NULL in which case the default title will be used.
#' @param title_lab_pro character string specifying the redundancy plot title.
#' The default is NULL in which case the default title will be used.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param text_size An integer specifying the size of the text (number of
#' peptides or proteins depending on the plot) within the bar plot. The
#' default is 3.
#' @param bar_width An integer indicating the width of the bars in the bar plot.
#' The default is 0.8.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param display_count logical value. Indicates whether the peptide or protein counts
#' will be displayed on the bar plot. The default is TRUE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' data(pep_object)
#' my_filter <- proteomics_filter(omicsData = pep_object)
#' plot(my_filter, min_num_peps = 3)
#' plot(my_filter, plot_type = "redundancy")
#'
#' @rdname plot-proteomicsFilt
#'
#' @export
#'
plot.proteomicsFilt <- function(x,
plot_type = "num_peps",
min_num_peps = NULL,
interactive = FALSE, x_lab_pep = NULL,
x_lab_pro = NULL, y_lab_pep = NULL,
y_lab_pro = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = 0,
title_lab_pep = NULL, title_lab_pro = NULL,
title_lab_size = 14, legend_lab = NULL,
legend_position = "right", text_size = 3,
bar_width = 0.8, bw_theme = TRUE,
palette = NULL, display_count = TRUE,
...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "proteomicsFilt")) {
# The filter object is the wrong class. Savvy?
stop("filter_object must be of class proteomicsFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Error Checks
if (!is.null(min_num_peps)) {
# check that min_num_peps is numeric and >=1 #
if (!inherits(min_num_peps, "numeric") || min_num_peps < 1)
stop("min_num_peps must be an integer greater than or equal to 1")
# check that min_num_peps is an integer #
if (min_num_peps %% 1 != 0)
stop("min_num_peps must be an integer greater than or equal to 1")
# check that min_num_peps is of length 1 #
if (length(min_num_peps) != 1)
stop("min_num_peps must be of length 1")
# check that min_num_peps is less than the total number of peptides #
if (min_num_peps > max(filter_object$counts_by_pro$n))
stop(paste("min_num_peps cannot be greater than the maximum number of",
"peptides that map to a protein.",
sep = " "
))
}
if (!plot_type %in% c("num_peps", "redundancy")) {
stop("plot_type must be either 'num_peps' or 'redundancy'.")
}
# Seize unique values for peptide to protein and protein to peptide counts:
# These bins represent the number of PROTEINS each peptide maps to. Unless
# there are degenerate peptides this will be a vector with one value: 1.
pep_bins <- sort(unique(filter_object$counts_by_pep$n))
# These bins represent the number of PEPTIDES each protein maps to.
pro_bins <- sort(unique(filter_object$counts_by_pro$n))
# get counts of peptides that are mapped to by EXACTLY the number of
# proteins given in pep_bins
pep_counts <- sapply(pep_bins, function(x) {
filter_object$counts_by_pep[filter_object$counts_by_pep$n == x, ] %>% nrow()
})
# get counts of proteins that are mapped to by EXACTLY the number of
# peptides given in pro_bins
pro_counts <- sapply(pro_bins, function(x) {
filter_object$counts_by_pro[filter_object$counts_by_pro$n == x, ] %>% nrow()
})
# fill value and fill labels that will be given real values if certain
# arguments are supplied.
fill <- 0
fill_format <- NULL
# Mind numbing label making bit.
xlabel_pep <- if (is.null(x_lab_pep))
"Number of Proteins" else
x_lab_pep
ylabel_pep <- if (is.null(y_lab_pep)) "Count of Peptides" else y_lab_pep
titleLabelPep <- if (is.null(title_lab_pep))
"Y peptides map to exactly X proteins" else
title_lab_pep
xlabel_pro <- if (is.null(x_lab_pro))
"Number of Peptides" else
x_lab_pro
ylabel_pro <- if (is.null(y_lab_pro)) "Count of Proteins" else y_lab_pro
titleLabelPro <- if (is.null(title_lab_pro))
"Y proteins mapped to by exactly X peptides" else
title_lab_pro
# create plotting dataframe
pro_counts_df <- data.frame(
counts = pro_counts,
bins = pro_bins
)
pep_counts_df <- data.frame(
counts = pep_counts,
bins = pep_bins
)
# Manufacture phenomenal plots -----------------------------------------------
# !#!#!#! p represents the protein plot (num_peps) #!#!#!#!
# !#!#!#! q represents the pepe plot (redundancy) #!#!#!#!
# Create the bare bones protein and peptide plots.
p <- ggplot2::ggplot(pro_counts_df)
q <- ggplot2::ggplot(pep_counts_df)
# Create an object for the first default ggplot2 color.
hideous <- grDevices::hcl(
h = 15,
c = 100,
l = 65
)
# Check if palette is NULL or not. Hopefully it isn't so the plot will be
# created with colors other than the super hideous default ggplot2 colors.
if (!is.null(palette)) {
# Create a color from the color brewer package if a palette is provided.
# This color will be used if the plot only has one color. For example, when
# redundancy is selected or if num_peps is selected but
# min_num_peps is not specified.
colas <- RColorBrewer::brewer.pal(5, palette)
}
# If min_num_peps is specified, add a coloring variable that shows whether a
# peptide will be retained or dropped based on the input provided.
if (!is.null(min_num_peps)) {
fill <- ifelse(pro_bins >= min_num_peps, "retained", "dropped")
# Add the fill column in pro_counts_df to reflect the retained and
# dropped proteins.
pro_counts_df$fill <- fill
# We change bins to a factor so the x-axis tick labels are the value in bins
# but the width of the bars and x-axis does not change according to the
# numeric value of bins.
p <- p +
ggplot2::geom_bar(
ggplot2::aes(
x = as.factor(bins),
y = counts,
fill = fill
),
stat = "identity",
width = bar_width
)
# Creates bar charts when there is only one group (all bars will have the
# same color). These bar charts are created when min_num_peps is NOT
# specified. Color palettes must be defined here because there are no groups
# to fill by later in the script (when color palettes are defined for bar
# charts with groups).
} else {
# We change bins to a factor so the x-axis tick labels are the value in bins
# but the width of the bars and x-axis does not change according to the
# numeric value of bins.
p <- p +
ggplot2::geom_bar(
ggplot2::aes(
x = as.factor(bins),
y = counts
),
fill = if (is.null(palette))
hideous else
colas[[3]],
stat = "identity",
width = bar_width
)
}
# Evan, deal with all the issues when we ask you to make seemingly small
# changes to functions. AS YOU WISH.
# The q plot (redundant plot) has to be created outside the if else statement
# above because this plot does not change based on the input to min_num_peps.
# I tried to be smooth and leave the function mostly the same and add changes
# to the q plot together with the p plot when min_num_peps is specified.
# However, that turned out to be a nightmare. This attempt better work without
# any issues. Maybe I was too wishful: This attempt better not have the same
# completely ridiculous and unsolvable errors as the last attempt.
q <- q +
ggplot2::geom_bar(
ggplot2::aes(
x = as.factor(bins),
y = counts
),
fill = if (is.null(palette)) hideous else colas[[3]],
stat = "identity",
width = bar_width
)
# Evan, add plot labels for me. As you wish.
p <- p +
ggplot2::xlab(xlabel_pro) +
ggplot2::ylab(ylabel_pro) +
ggplot2::ggtitle(titleLabelPro)
q <- q +
ggplot2::xlab(xlabel_pep) +
ggplot2::ylab(ylabel_pep) +
ggplot2::ggtitle(titleLabelPep)
# Evan, make the plot theme black and white. As you wish.
if (bw_theme) {
p <- p + ggplot2::theme_bw()
q <- q + ggplot2::theme_bw()
}
# Evan, make me a plot with beautiful colors. As you wish.
# NOTE: This code only changes colors if not all bars will have the same color
# in the num_peps plot. If a plot has bars with all the same color, the
# coloring (according to whether palette was specified) was taken care of
# previously.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_fill_brewer(
palette = palette,
name = legend_lab
)
} else {
p <- p + ggplot2::scale_fill_manual(
name = legend_lab,
values = c(
"dropped" = "red",
"retained" = "green"
)
)
}
# Evan, add the protein counts to the plot. As you wish.
if (display_count) p <- p + ggplot2::geom_text(
data = pro_counts_df,
ggplot2::aes(
x = as.factor(bins),
y = counts,
label = counts
),
vjust = -0.5,
size = text_size
)
# Create generic theme settings.
axs <- ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, add thematic elements to the plot. As you wish.
p <- p + axs
q <- q + axs
# Evan, just display the num_peps plot. As you wish.
if (plot_type == "num_peps") {
# Evan, make me an interactive num_peps plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
# Evan, just display the redundancy plot. As you wish.
} else if (plot_type == "redundancy") {
# Evan, make me an interactive redundancy plot. As you wish.
if (interactive && requirePlotly()) q <- plotly::ggplotly(q)
return(q)
}
}
#' Plot rmdFilt Object
#'
#' For plotting an S3 object of type 'rmdFilt'
#'
#' @param x object of class rmdFilt created via \code{\link{rmd_filter}}
#' @param pvalue_threshold numeric threshold for the Robust Mahalanobis Distance (RMD)
#' p-value. If \code{sampleID} is NULL (see \code{sampleID} below), a
#' horizontal line is plotted at the RMD value that corresponds with the
#' threshold, and all samples above the line have a p-value below the
#' threshold. If \code{sampleID} is not NULL, \code{pvalue_threshold} will do
#' nothing. Default value is NULL.
#' @param sampleID character vector specifying the sample names to be plotted.
#' If specified, the plot function produces a boxplot instead of a
#' scatterplot. A point, colored by sample, will be placed on each boxplot for
#' that sample's value for the given metric. The default value is NULL.
#' @param order_by character string specifying a variable by which to order
#' the samples in the plot. This variable must be found in the column names of
#' fdata from the rmdFilt object. If \code{order_by} is "Group", the plot will
#' be ordered by the group variable from the group_designation function. If
#' NULL (default), the samples will be displayed in the order in which they
#' first appear.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 90.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param point_size An integer specifying the size of the points. The default
#' is 3.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mymetab <- edata_transform(omicsData = metab_object, data_scale = "log2")
#' mymetab <- group_designation(omicsData = mymetab, main_effects = "Phenotype")
#' rmd_results <- rmd_filter(omicsData = mymetab, metrics = c("MAD", "Skewness", "Correlation"))
#' plot(rmd_results, pvalue_threshold = 0.0001, order_by = "Phenotype")
#'
#' @rdname plot-rmdFilt
#'
#' @export
#'
plot.rmdFilt <- function(x, pvalue_threshold = NULL, sampleID = NULL,
order_by = NULL, interactive = FALSE, x_lab = NULL,
y_lab = NULL, x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 90, title_lab = NULL,
title_lab_size = 14, legend_lab = NULL,
legend_position = "right", point_size = 3,
bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "rmdFilt")) {
# The filter object is the wrong class. Savvy?
stop("filter_object must be of class rmdFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Check if order_by is present. If it is additional checks need to be
# performed to make sure it is a valid input.
if (!is.null(order_by)) {
# Make sure order_by is either "Group" or is in f_data.
if (order_by != "Group" &&
!(order_by %in% names(attr(filter_object, "fdata")))) {
# Your plot is only mostly dead! There is still a slim hope that you can
# save it.
stop(paste("order_by must either be 'Group' or the name of a column",
"from f_data.",
sep = " "
))
}
}
# Have a looksie at the sampleID argument.
if (!is.null(sampleID)) {
# Make sure the sample IDs provided actually exist.
if (!all(sampleID %in% attr(filter_object, "sample_names")))
stop("The sample IDs provided do not match the sample IDs in the data.")
}
samp_id <- names(attr(filter_object, "group_DF"))[1]
metrics <- attributes(filter_object)$metrics
# determine how to melt based on the number of main effects
group_df <- attributes(filter_object)$group_DF
# determine the main effects, then melt the df #
if (ncol(group_df) == 2) {
main_eff_names <- "Group"
dfmelt <- filter_object %>%
tidyr::pivot_longer(
-dplyr::all_of(c(!!samp_id, !!main_eff_names)),
names_to = "variable",
cols_vary = "slowest"
) %>% data.frame
} else if (ncol(group_df) > 2) {
## put main effect with more levels first, for plotting aesthetics ##
temp <- droplevels(group_df[, -(1:2)])
numlevels <- sapply(1:2, function(j) length(levels(as.factor(temp[, j]))))
main_eff_names <- names(temp)[order(numlevels, decreasing = TRUE)]
dfmelt <- tidyr::pivot_longer(
filter_object[, -2],
-dplyr::all_of(c(!!samp_id, !!main_eff_names)),
names_to = "variable",
cols_vary = "slowest"
) %>% data.frame
}
# Data frame that has information to create rmd box plots.
dfsub <- dfmelt[dfmelt$variable %in% metrics, ]
# legend labels #
## function for shortening long main effect names ##
abbrev_fun <- function(string) {
if (nchar(string) > 25) string = paste0(substr(string, 1, 23), "...")
return(string)
}
# Shorten the names of the main effects (if they are over 25 characters). This
# vector will have more than one element if there is more than one main
# effect.
display_names <- sapply(main_eff_names, abbrev_fun)
# Create the title for the legend that describes differences by color.
legend_title_color <- ifelse(is.null(legend_lab),
display_names[1],
legend_lab[1]
)
# Initialize the title for the legend that describes differences by point
# shape to NULL. It will only be used if there is more than one main effect.
legend_title_shape <- NULL
# Use the legend label (if it is provided in the input) for the legend
# describing the differences by point shape. The user must specify a legend
# label with more than one element. It is not created within the function.
if (length(display_names) > 1) {
if (length(legend_lab) > 1) {
legend_title_shape <- legend_lab[2]
} else {
legend_title_shape <- display_names[2]
}
}
# Assemble captivating plots -------------------------------------------------
# Order the samples according to the order_argument. If order_by is not
# provided order the samples according to the order they appear in the filter
# object.
if (!is.null(order_by)) {
if (order_by == "Group") {
# Order the samples by the Group column from group_DF.
filter_object[[samp_id]] <- factor(
filter_object[[samp_id]],
levels = filter_object[[samp_id]][order(attr(
filter_object,
"group_DF"
)$Group)],
ordered = TRUE
)
} else {
# Order the samples by the specified column from f_data.
filter_object[[samp_id]] <- factor(
filter_object[[samp_id]],
levels = filter_object[[samp_id]][order(attr(
filter_object,
"fdata"
)[[order_by]])],
ordered = TRUE
)
}
} else {
# Order the data in the order the samples appear in the samp_id column.
filter_object[[samp_id]] <- factor(
filter_object[[samp_id]],
levels = unique(filter_object[[samp_id]]),
)
}
# Beautiful box plots ---------------
# Check is sampleID is NULL. Generate box plots if it is not NULL.
if (!is.null(sampleID)) {
levels(dfsub$variable)[levels(dfsub$variable) == "Fraction_Missing"] <-
"Prop_missing"
plot_title <- ifelse(is.null(title_lab),
"Summary of RMD metrics used",
title_lab
)
xlabel <- ifelse(is.null(x_lab), " ", x_lab)
ylabel <- ifelse(is.null(y_lab), "Value", y_lab)
p <- ggplot2::ggplot(dfsub) +
ggplot2::geom_boxplot(ggplot2::aes(
x = rep(1, length(value)),
y = value
)) +
ggplot2::facet_wrap(~variable,
scales = "free",
ncol = length(metrics)
) +
ggplot2::geom_point(
data = dfsub[dfsub[, samp_id] %in% sampleID, ],
ggplot2::aes(
x = rep(1, length(value)),
y = value,
color = !!dplyr::sym(samp_id)
),
size = point_size
) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::ggtitle(plot_title)
# Stunning scatter plots: no threshold ---------------
} else if (is.null(pvalue_threshold)) {
# Start scatter plot skeleton when there is no p-value threshold.
p <- ggplot2::ggplot(filter_object)
# Start plot when there is only one main effect.
if (length(main_eff_names) == 1) {
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
color = !!dplyr::sym(main_eff_names[1])
),
size = point_size
)
# Start plot when there are two main effects.
} else {
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
color = !!dplyr::sym(main_eff_names[1]),
shape = !!dplyr::sym(main_eff_names[2])
),
size = point_size
)
}
plot_title <- ifelse(is.null(title_lab),
"Sample Outlier Results",
title_lab
)
xlabel <- ifelse(is.null(x_lab), "Samples", x_lab)
ylabel <- ifelse(is.null(y_lab), "log2(Robust Mahalanobis Distance)", y_lab)
p <- p +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::ggtitle(plot_title) +
ggplot2::labs(
color = legend_title_color,
shape = legend_title_shape
)
# Stunning scatter plots: with threshold ---------------
} else {
# Determine which samples fall below the p-value threshold. This is a
# logical vector that will be used to find pairs that are split (one sample
# is filtered and the other is not) and to change the transparency of the
# point in the plot.
goodies_alpha <- filter_object$pvalue < pvalue_threshold
# If data are paired make sure no sample is left behind!
if (!is.null(attr(attr(filter_object, "group_DF"), "pair_id"))) {
# Find the corresponding sample(s) if one sample from a pair is below the
# p-value threshold and the other sample is not.
if (sum(goodies_alpha) > 0) {
# Snatch the sample name and pair name as they will be used in multiple
# places. It will save some typing. ... However, all the typing I just
# saved has probably been undone by writing this comment.
sample_name <- attr(filter_object, "fdata_cname")
pair_name <- attr(attr(filter_object, "group_DF"), "pair_id")
# Grab the names of filtered samples.
filtad <- as.character(filter_object[goodies_alpha, sample_name])
# !#!#!#!#!#!#!#!#!#!
# The following code checks if the samples in a pair will be split. For
# example, one sample in a pair will be filtered and another sample in
# the pair will not be filtered. If a pair is split remove ALL samples
# associated with that pair.
# !#!#!#!#!#!#!#!#!#!
# Snag the associated pair IDs for the samples that will be filtered.
filtad_pairs <- attr(filter_object, "fdata") %>%
dplyr::filter(!!dplyr::sym(sample_name) %in% filtad) %>%
dplyr::pull(!!dplyr::sym(pair_name))
# Go back to f_data and nab all the sample names corresponding to the
# pair IDs associated with the original samples that were selected for
# removal. These sample names will be used to change the point shape.
# The points that will be different are the ones corresponding to the
# samples that belong to pair where only one sample falls below the
# threshold.
filtad_too <- attr(filter_object, "fdata") %>%
dplyr::filter(!!dplyr::sym(pair_name) %in% filtad_pairs) %>%
dplyr::pull(!!dplyr::sym(sample_name)) %>%
as.character()
# Update the goodies_alpha vector to reflect the additional samples that
# will be filtered.
goodies_alpha <- filter_object[, sample_name] %in% filtad_too
# Create a vector of samples who are guilty by association. (They do not
# fall below the threshold but their partners do.)
condemned <- setdiff(filtad_too, filtad)
# Create a logical vector that will determine the point shape.
goodies_pch <- filter_object[, sample_name] %in% condemned
} else goodies_pch <- rep(FALSE, nrow(filter_object))
} else {
# The data are not paired so all points should be a solid circle.
goodies_pch <- rep(FALSE, nrow(filter_object))
}
# get y-intercept for line
df <- attributes(filter_object)$df
yint <- log(qchisq(1 - pvalue_threshold, df = df), base = 2)
# make title
if (is.null(title_lab)) {
plot_title <- "Sample Outlier Results"
subtitle <- paste("p-value threshold = ", pvalue_threshold)
} else {
plot_title <- title_lab
subtitle <- ggplot2::waiver()
}
xlabel <- ifelse(is.null(x_lab), "Samples", x_lab)
ylabel <- ifelse(is.null(y_lab), "log2(Robust Mahalanobis Distance)", y_lab)
# Start scatter plot skeleton when a p-value threshold is specified.
p <- ggplot2::ggplot(filter_object)
# Start scatter plot skeleton when a p-value threshold has been provided.
if (length(main_eff_names) == 1) {
# we need separate plots for if we have pair id or not
if (!is.null(attr(attr(filter_object, "group_DF"), "pair_id"))) {
# if !null then we need to include pair fill information
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names),
# Add a fill layer that will not affect how the plot looks. This
# layer is used to create a legend when one sample from a pair is
# an outlier but the other sample belonging to the pair is not.
fill = "Removed because paired with outlier"
),
alpha = ifelse(goodies_alpha, 1, 0.5),
size = point_size,
shape = ifelse(goodies_pch, 15, 16)
)
} else {
# if null pair id then we do not need to account for fill
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names)
),
alpha = ifelse(goodies_alpha, 1, 0.5),
size = point_size,
shape = ifelse(goodies_pch, 15, 16)
)
}
} else {
if (!is.null(attr(attr(filter_object, "group_DF"), "pair_id"))) {
# if !null then we need to include pair fill information
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names[1]),
shape = !!dplyr::sym(main_eff_names[2]),
# Add a fill layer that will not affect how the plot looks. This
# layer is used to create a legend when one sample from a pair is
# an outlier but the other sample belonging to the pair is not.
fill = "Removed because paired with outlier"
),
alpha = ifelse(goodies_alpha, 1, 0.5),
# Make guilty-by-association points really small because we will
# plot a square point over them with the next lines of code. We
# don't want the edges of a circle or triangle peeking out from
# behind a square. That would make a hideous and confusing plot if
# that happened.
size = ifelse(goodies_pch, 0, point_size)
) +
# Add another layer of points with guilty-by-association samples
# plotted as a square.
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names[1])
),
size = ifelse(goodies_pch, point_size, 0),
shape = ifelse(goodies_pch, 15, 16)
)
} else {
# if null pair id then we do not need to account for fill
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names[1]),
shape = !!dplyr::sym(main_eff_names[2])
),
alpha = ifelse(goodies_alpha, 1, 0.5),
# Make guilty-by-association points really small because we will
# plot a square point over them with the next lines of code. We
# don't want the edges of a circle or triangle peeking out from
# behind a square. That would make a hideous and confusing plot if
# that happened.
size = ifelse(goodies_pch, 0, point_size)
) +
# Add another layer of points with guilty-by-association samples
# plotted as a square.
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names[1])
),
size = ifelse(goodies_pch, point_size, 0),
shape = ifelse(goodies_pch, 15, 16)
)
}
}
# Add title, axis labels, and other crap.
p <- p +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::ggtitle(plot_title,
subtitle = subtitle
) +
ggplot2::geom_hline(yintercept = yint) +
ggplot2::guides(
color = ggplot2::guide_legend(ncol = 1),
shape = ggplot2::guide_legend(ncol = 1)
) +
ggplot2::labs(
color = legend_title_color,
shape = legend_title_shape
)
# Add a manual legend that describes the shape of the points that are
# removed because they belong to a pair with one sample being an outlier.
if (sum(goodies_pch > 0)) {
p <- p +
ggplot2::scale_fill_manual(
name = NULL,
values = 1,
breaks = "Removed because paired with outlier",
guide = ggplot2::guide_legend(
override.aes = list(
linetype = 0,
shape = 15,
color = "black"
)
)
)
}
}
# Farm boy, make me a plot with beautiful colors. As you wish.
if (!is.null(palette)) p <- p +
ggplot2::scale_color_brewer(
name = legend_title_color,
palette = palette
)
# Farm boy, create thematic elements for the plot. As you wish.
mytheme <- ggplot2::theme(
axis.ticks.x = ggplot2::element_blank(),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
plot.title = ggplot2::element_text(size = title_lab_size),
plot.subtitle = ggplot2::element_text(face = 'italic'),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
legend.position = legend_position
)
# Farm boy, remove useless box plot x-axis labels. As you wish.
if (!is.null(sampleID)) {
mytheme <- mytheme +
ggplot2::theme(axis.text.x = ggplot2::element_blank())
}
# Farm boy, add the black and white theme to the plot. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
# Farm boy, add the thematic elements you created to the plot. As you wish.
p <- p + mytheme
# Farm boy, use my custom sample names in the plot. As you wish.
if (use_VizSampNames) {
# Change the sample names of the scatter plot.
p <- p +
ggplot2::scale_x_discrete(labels = attr(filter_object, "VizSampNames"))
# We only want to change the legend if the box plots are created.
if (!is.null(sampleID)) {
# Nab the indices of the samples that will be highlighted in the box
# plots.
idx <- which(attr(filter_object, "sample_names") %in% sampleID)
# Change the names in the legend of the box plots.
p <- p +
ggplot2::scale_color_hue(
labels = attr(filter_object, "VizSampNames")[idx]
)
}
}
# Farm boy, remove the default legend(s) if the data are paired and there are
# no main effects. As you wish.
# If there are no main effects do not print a legend.
if ("paired_diff" %in% attr(filter_object, "group_DF")$Group) {
# Remove the color legend. This legend is automatically created because we
# specified a variable to color by in aes().
p <- p +
ggplot2::guides(color = "none")
}
# Farm boy, make the plot interactive. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
# Farm boy, return the plot so the entire world can enjoy it. As you wish.
return(p)
}
#' Plot cvFilt Object
#'
#' For plotting an S3 object of type 'cvFilt'
#'
#' @param x object of class cvFilt generated via
#' \code{\link{cv_filter}}
#' @param cv_threshold numeric value for cv threshold above which to remove the
#' corresponding biomolecules
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param log_scale logical value. Indicates whether to use a log2 transformed x-axis.
#' The default is TRUE.
#' @param n_bins integer value specifying the number of bins to draw in the
#' histogram. The default is 30.
#' @param n_breaks integer value specifying the number of breaks to use. You
#' may get less breaks if rounding causes certain values to become non-unique.
#' The default is 15.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' data(pep_object)
#' mypep <- group_designation(
#' omicsData = pep_object,
#' main_effects = "Phenotype"
#' )
#'
#' cvfilt <- cv_filter(omicsData = mypep)
#'
#' plot(cvfilt, cv_threshold = 20)
#' plot(cvfilt, cv_threshold = 10, log_scale = FALSE)
#'
#' @rdname plot-cvFilt
#'
#' @export
#'
plot.cvFilt <- function(x, cv_threshold = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 0,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
log_scale = TRUE, n_breaks = 15, n_bins = 30,
bw_theme = TRUE, palette = NULL, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# checks for cv_threshold if not null
if (!is.null(cv_threshold)) {
# check that cv_threshold is numeric
if (!is.numeric(cv_threshold))
stop("cv_threshold must be numeric of length 1")
# chack that cv_threshold is of length 1
if (length(cv_threshold) > 1)
stop("cv_threshold must be numeric of length 1")
# check that cv_threshold is more than 1 and less than max CV value
if (cv_threshold <= 1 || cv_threshold >= max(filter_object$CV, na.rm = TRUE))
stop("cv_threshold must be greater than 1 and less than the max CV value")
}
if (!is.logical(log_scale)) stop("log_scale must be logical: TRUE or FALSE")
if (!(n_breaks %% 1 == 0)) stop("n_breaks must be integer valued")
if (!(n_bins %% 1 == 0)) stop("n_bins must be integer valued")
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# plotting object
new_object <- filter_object[!is.na(filter_object$CV), ]
max_x_val <- attributes(filter_object)$max_x_val
# Check if any CV values are zero. If there are any zero values the log_scale
# input must be changed to FALSE.
if (any(new_object$CV == 0)) {
log_scale <- FALSE
message(paste("Because there are CV values = 0 the x-axis cannot be",
"converted to the log2 scale.",
"The original scale will be used.",
sep = " "
))
}
# labels
plot_title <- ifelse(is.null(title_lab),
"Coefficient of Variation (CV)",
title_lab
)
ylabel <- ifelse(is.null(y_lab), "Count", y_lab)
# Label x-axis according to whether group_designation() was run.
if (is.null(x_lab)) {
xlabel <- if (attributes(filter_object)$pooled) "Pooled CV" else "CV"
}
### Store ggplot2 layers
# scale transform and breaks depending on x-axis scale
if (log_scale) {
trans <- "log2"
i <- log2(min(new_object$CV, na.rm = TRUE))
breaks <- 0
# define a step value that is evenly spaced in the log2 scale
step = (max(log2(new_object$CV), na.rm = TRUE) -
min(log2(new_object$CV), na.rm = TRUE)) / n_breaks
# create the normal scale labels that will be log2 transformed when passed
# to ggplot
while (2^i < max(new_object$CV, na.rm = TRUE)) {
breaks <- c(breaks, 2^i)
i <- i + step
}
# rounding for plot purposes
breaks <- round(breaks, 2)
} else {
breaks <- scales::pretty_breaks(n = n_breaks)
trans <- "identity"
}
# change default title and draw a vertical line if cv_thresh specified
if (!is.null(cv_threshold)) {
if (is.null(title_lab)) {
plot_title <- bquote(paste(
"Coefficient of Variation (CV): ",
italic(paste(
"CV Threshold = ",
.(cv_threshold)
)),
""
))
}
cutoff <- ggplot2::geom_vline(xintercept = cv_threshold)
} else {
cutoff <- NULL
}
# Make magnificent plots -----------------------------------------------------
# Farm boy, start the plot for me. As you wish.
p <- ggplot2::ggplot(new_object)
# Check if palette is NULL or not. Hopefully it isn't so the plot will be
# created with colors other than the super hideous default ggplot2 colors.
if (!is.null(palette)) {
# Farm boy, make colors to replace the default color. As you wish.
colas <- RColorBrewer::brewer.pal(5, palette)
# Farm boy, add the beautiful color to the histogram. As you wish.
p <- p +
ggplot2::geom_histogram(ggplot2::aes(x = CV),
bins = n_bins,
fill = colas[[3]]
)
# Runs when palette is NULL.
} else {
# Farm boy, make the histogram with default colors. As you wish.
p <- p +
ggplot2::geom_histogram(ggplot2::aes(x = CV),
bins = n_bins
)
}
# Farm boy, add the cutoff and make the histogram pretty. As you wish.
p <- p +
cutoff +
ggplot2::scale_x_continuous(
breaks = breaks,
trans = trans
) +
ggplot2::scale_y_continuous(breaks = scales::pretty_breaks(n = 5))
# Farm boy, add labels to the plot. As you wish.
p <- p +
ggplot2::ggtitle(plot_title) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel)
# Farm boy, make the plot black and white. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Farm boy, add thematic elements to the plot. As you wish.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1)
)
# Farm boy, send my plot into the world. As you wish.
return(p)
}
#' Plot customFilt Object
#'
#' Currently plotting a customFilt object is not supported
#'
#' @param x An object of class customFilt.
#' @param ... further arguments passed to or from other methods.
#'
#' @return No return value, implemented to provide information to user.
#'
#' @rdname plot-customFilt
#'
#' @export
#'
plot.customFilt <- function(x, ...) {
message(paste("There is no plot method for objects of class 'customFilt'.",
"See summary.customFilt instead.",
sep = " "
))
}
#' Plot normRes Object
#'
#' For plotting an S3 object of type 'normRes'
#'
#' @param x normRes object created by the normalize_global function
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mymetab <- edata_transform(
#' omicsData = metab_object,
#' data_scale = "log2"
#' )
#' mymetab <- group_designation(
#' omicsData = mymetab,
#' main_effects = "Phenotype"
#' )
#' norm_object <- normalize_global(
#' omicsData = mymetab,
#' subset_fn = "all",
#' norm_fn = "median"
#' )
#' plot(norm_object, order_by = "Phenotype", color_by = "Phenotype")
#'
#' @rdname plot-normRes
#'
#' @export
#'
plot.normRes <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
normRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Create the raw and normalized omicsData objects.
omicsRaw <- attr(normRes_obj, "omicsData")
# e_data will be updated after applying the normalization.
omicsNorm <- attr(normRes_obj, "omicsData")
# Extricate the ID column index.
id_col <- which(names(omicsRaw$e_data) == get_edata_cname(omicsRaw))
# Apply normalization depending on the location, scale, and backtransform
# values.
if (is.null(normRes_obj$parameters$normalization$scale)) {
# Normalize with just the location parameter (no backtransform). There isn't
# a section where backtransform is TRUE because the normalize_global
# function will not calculate backtransform parameters if the data are not
# normalized.
omicsNorm$e_data[, -id_col] <- (
omicsNorm$e_data[, -id_col] -
rep(normRes_obj$parameters$normalization$location,
each = nrow(omicsNorm$e_data)
)
)
# Backtransmute if there is a location backtransform parameter.
if (!is.null(normRes_obj$parameters$backtransform$location)) {
omicsNorm$e_data[, -id_col] <- (
omicsNorm$e_data[, -id_col] +
normRes_obj$parameters$backtransform$location
)
}
} else {
# Normalize with the location and scale parameters (no backtransform). There
# isn't a section where backtransform is TRUE because the normalize_global
# function will not calculate backtransform parameters if the data are not
# normalized.
omicsNorm$e_data[, -id_col] <- (
omicsNorm$e_data[, -id_col] -
rep(normRes_obj$parameters$normalization$location,
each = nrow(omicsNorm$e_data)
) /
rep(normRes_obj$parameters$normalization$scale,
each = nrow(omicsNorm$e_data)
)
)
# Backtransmute if there are location and scale backtransform parameters.
if (!is.null(normRes_obj$parameters$backtransform$location) &&
!is.null(normRes_obj$parameters$backtransform$scale)) {
omicsNorm$e_data[, -id_col] <- (
omicsNorm$e_data[, -id_col] *
normRes_obj$parameters$backtransform$scale +
normRes_obj$parameters$backtransform$location
)
}
}
# Update the norm_info element of the data_info attribute for the omicsNorm
# object.
attributes(omicsNorm)$data_info$norm_info$is_normalized <- TRUE
# Generate majestic plots ----------------------------------------------------
# Farm boy, make me a plot with a raw object. As you wish.
p_raw <- plot_omicsData(
omicsData = omicsRaw, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab,
title_lab_size = title_lab_size,
legend_lab = legend_lab,
legend_position = legend_position, ylimit = ylimit,
bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
# Farm boy, make me a plot with a normalized object. As you wish.
p_norm <- plot_omicsData(
omicsData = omicsNorm, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab,
x_lab_size = x_lab_size, y_lab_size = y_lab_size,
x_lab_angle = x_lab_angle, title_lab = title_lab,
title_lab_size = title_lab_size,
legend_lab = legend_lab,
legend_position = legend_position, ylimit = ylimit,
bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
# Farm boy, combine the plots and send them into the world. As you wish.
if (interactive && requirePlotly()) {
# Return the interactive plots side-by-side.
plotly::subplot(p_raw, p_norm, nrows = 1)
} else {
# Return the regular plots side-by-side.
p_raw + p_norm
}
}
#' Plot isobaricpepData Object
#'
#' For plotting isobaricpepData S3 objects
#'
#' @param x An isobaricpepData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true") & requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' myiso <- edata_transform(omicsData = isobaric_object, data_scale = "log2")
#' plot(myiso)
#'
#' @rdname plot-isobaricpepData
#'
#' @export
#'
plot.isobaricpepData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL,
y_lab = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE,
palette = NULL, use_VizSampNames = FALSE,
...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with an isobaricpepData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
#' Plot lipidData Object
#'
#' For plotting lipidData S3 objects
#'
#' @param x lipidData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mylipid <- edata_transform(omicsData = lipid_pos_object, data_scale = "log2")
#' plot(mylipid, order_by = "Virus", color_by = "Virus")
#'
#' @rdname plot-lipidData
#'
#' @export
#'
plot.lipidData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a lipidData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
#' Plot metabData Object
#'
#' For plotting metabData S3 objects
#'
#' @param x metabData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mymetab <- edata_transform(omicsData = metab_object, data_scale = "log2")
#' plot(mymetab, order_by = "Phenotype", color_by = "Phenotype")
#'
#' @rdname plot-metabData
#'
#' @export
#'
plot.metabData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a metabData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
#' Plot nmrData Object
#'
#' For plotting nmrData S3 objects
#'
#' @param x nmrData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols An optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit A numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mynmr <- edata_transform(omicsData = nmr_identified_object, data_scale = "log2")
#' plot(mynmr)
#'
#' @rdname plot-nmrData
#'
#' @export
#'
plot.nmrData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a nmrData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
#' Plot seqData Object
#'
#' For plotting seqData S3 objects
#'
#' @param x seqData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param transformation character string. String of length 1 defining a
#' transformation for visualizing count data. Valid options are 'lcpm',
#' 'upper', and 'median'. 'lcpm' - For each column: scale column intensities by
#' (total column sum/1 million), then log2 transform. 'median' - For each
#' column: scale column intensities by median column intensities, then
#' back-transform to original scale. 'upper' - For each column: scale column
#' intensities by 75th quantile column intensities, then back-transform to
#' original scale. For 'median' and 'upper' options, all zeros are converted
#' to NAs.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true") & requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' plot(rnaseq_object, transformation = "lcpm")
#'
#' @rdname plot-seqData
#'
#' @export
#'
plot.seqData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, transformation = NULL,
...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a seqData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames,
transformation = transformation
)
}
#' Plot pepData Object
#'
#' For plotting pepData S3 objects
#'
#' @param x pepData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols An optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true") & requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' data(pep_object)
#' mypep <- edata_transform(omicsData = pep_object, data_scale = "log2")
#' plot(mypep, order_by = "Phenotype", color_by = "Phenotype")
#'
#' @rdname plot-pepData
#'
#' @export
#'
plot.pepData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a pepData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
#' Plot proData Object
#'
#' For plotting proData S3 objects
#'
#' @param x proData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' plot(pro_object, order_by = "Phenotype", color_by = "Phenotype")
#'
#' @rdname plot-proData
#'
#' @export
#'
plot.proData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a proData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
# The function that does all the heavy lifting for the isobaricpepData,
# lipidData, metabData, nmrData, pepData, proData, and normRes plot methods.
plot_omicsData <- function(omicsData, order_by, color_by, facet_by, facet_cols,
interactive, x_lab, y_lab, x_lab_size, y_lab_size,
x_lab_angle, title_lab, title_lab_size, legend_lab,
legend_position, ylimit, bw_theme, palette,
use_VizSampNames, transformation = NULL) {
# Preliminaries --------------------------------------------------------------
# Keeping the user honest ---------------
# Farm boy, make sure the data is the correct class. As you wish.
# check that omicsData is of appropriate class #
if (!inherits(omicsData, c(
"pepData", "proData", "metabData",
"lipidData", "nmrData", "seqData"
))) {
# INCONCEIVABLE!!!
stop(paste("omicsData must be of class 'isobaricpepData', 'lipidData'",
"'metabData', 'nmrData', 'pepData', 'proData', or 'seqData'.",
sep = " "
))
}
if (inherits(omicsData, "seqData")) {
if (!is.null(transformation)) {
if (!(transformation %in% c('lcpm', 'upper', 'median'))) {
# Tell the user that the input to data_scale is an abomination!
stop(paste(transformation, "is not a valid option for 'transformation'.",
"Refer to ?seqData.plot for specific seqData options.",
sep = " "
))
}
} else {
warning(paste0(
"Using transformation argument for plotting on counts",
" is recommended for seqData visualization. See ?seqData.plot for details."
))
}
}
if (!inherits(omicsData, "seqData") && !is.null(transformation)) {
warning("Transformation agrument is only applicable for seqData -- this argument is otherwise ignored.")
}
if (!is.null(order_by)) {
if (!is.character(order_by) || length(order_by) > 1)
stop("order_by must be a character vector of length 1")
}
if (!is.null(color_by)) {
if (!is.character(color_by) || length(color_by) > 1)
stop("color_by must be a character vector of length 1")
}
if (!is.null(facet_by)) {
if (!is.character(facet_by) || length(facet_by) > 1)
stop("facet_by must be a character vector of length 1")
}
if (!is.null(facet_cols)) {
if (is.null(facet_by))
stop("facet_by cannot be NULL when facet_cols is specified")
if (length(facet_cols) > 1)
stop("facet_cols must be of length 1")
if (!is.numeric(facet_cols))
stop("facet_cols must be an integer greater than zero")
if (facet_cols %% 1 != 0 || facet_cols <= 0)
stop("facet_cols must be an integer greater than zero")
}
if (!is.null(ylimit)) {
if (!is.numeric(ylimit) || length(ylimit) != 2)
stop("ylimit must be a numeric vector of length 2")
}
# Checking for NAs ---------------
# Check for samples with all NAs and return message to user that these will
# not be plotted.
sample_nas <- colSums(is.na(omicsData$e_data))
if (any(sample_nas == nrow(omicsData$e_data))) {
empties <- names(omicsData$e_data)[which(
sample_nas == nrow(omicsData$e_data)
)]
message(paste("The following sample(s) are comprised entirely of missing",
"data and will not be included in the plot: ",
empties,
sep = " "
))
}
# Label crap ---------------
datatype_text <- switch(class(omicsData)[1],
isobaricpepData = "Isobaric Peptide ",
pepData = "Peptide ",
proData = "Protein ",
lipidData = "Lipid ",
metabData = "Metabolite ",
nmrData = "NMR ",
seqData = "Transcript "
)
norm_info <- get_data_norm(omicsData)
norm_text <- ifelse(norm_info, "Normalized ", "Un-Normalized ")
ref_info <- if (inherits(omicsData, c("isobaricpepData", "nmrData"))) {
infos <- c("isobaric_info", "nmr_info")
res <- sapply(infos, function(info) {
norm <- attr(omicsData, info)$norm_info$is_normalized
!is.null(norm) && norm
})
any(res)
} else FALSE
ref_text <- if(ref_info) "Reference Standardized " else NULL
maintitle <- paste0(
"Boxplots of ", ref_text, norm_text, datatype_text, "Data"
)
######## Is this right? This should be separate from statistical normalization? #########
# Farm boy, make me a title depending on data type and norm_info. As you wish.
# if (inherits(omicsData, "isobaricpepData")) {
# maintitle <- if (attr(omicsData, "isobaric_info")$norm_info$is_normalized)
# "Boxplots of Normalized Isobaric Peptide Data" else
# "Boxplots of Un-Normalized Isobaric Peptide Data"
# } else if(inherits(omicsData, "pepData")){
# maintitle <- if (attr(omicsData, "data_info")$norm_info$is_normalized)
# "Boxplots of Normalized Peptide Data" else
# "Boxplots of Un-Normalized Peptide Data"
# } else if(inherits(omicsData, "proData")){
# maintitle <- if (attr(omicsData, "data_info")$norm_info$is_normalized)
# "Boxplots of Normalized Protein Data" else
# "Boxplots of Un-Normalized Protein Data"
# } else if(inherits(omicsData, "lipidData")){
# maintitle <- if (attr(omicsData, "data_info")$norm_info$is_normalized)
# "Boxplots of Normalized Lipid Data" else
# "Boxplots of Un-Normalized Lipid Data"
# } else if(inherits(omicsData, "metabData")){
# maintitle <- if (attr(omicsData, "data_info")$norm_info$is_normalized)
# "Boxplots of Normalized Metabolite Data" else
# "Boxplots of Un-Normalized Metabolite Data"
# } else if(inherits(omicsData, "nmrData")){
# maintitle <- if (attr(omicsData, "nmr_info")$norm_info$is_normalized)
# "Boxplots of Normalized NMR Data" else
# "Boxplots of Un-Normalized NMR Data"
# }
# Farm boy, create an plot subtitle object. As you wish.
subtitle <- NULL
# Farm boy, fashion plot, axis, and legend title objects. As you wish.
title <- if (is.null(title_lab)) maintitle else title_lab
xlabel <- if (is.null(x_lab)) "Sample" else x_lab
ylabel <- if (is.null(y_lab)) {
# Abundance based
if (get_data_scale(omicsData) == "abundance") {
out <- "Abundance"
} else if (get_data_scale(omicsData) %in% c("log", "log2", "log10")) {
out <- paste(get_data_scale(omicsData), "Abundance", sep = " ")
} else if (get_data_scale(omicsData) == "counts") {
if (is.null(transformation)) {
out <- "Counts"
} else {
out <- switch(transformation,
lcpm = "Log Counts per Million",
upper = "Upper-quantile transformed Counts",
median = "Median Counts"
)
}
}
out
} else y_lab
legend_title <- if (is.null(legend_lab)) color_by else legend_lab
# Data crap ---------------
# Farm boy, melt the data for me. As you wish.
e_data_cname <- get_edata_cname(omicsData)
temp_data <- omicsData$e_data
iCol <- which(names(omicsData$e_data) == get_edata_cname(omicsData))
if (!is.null(transformation)) {
transform_data <- temp_data[, -iCol]
if (transformation == 'lcpm') {
## log cpm, limma voom method and a similar method used for visualizations in edgeR
## EdgeR
# First scales the prior.count/pseudo-count and adds 2x the scaled prior count to the libsize
# prior.count.scaled <- lib.size/mean(lib.size)*prior.count
# lib.size <- lib.size+2*prior.count.scaled
# lib.size <- 1e-6*lib.size
# Calculates log2 log2(t( (t(x)+prior.count.scaled) / lib.size ))
# sum library size
samp_sum <- apply(transform_data,
2,
sum,
na.rm = TRUE
) + 1
# divide adjusted (ensure non-zero) counts by library size
div_sum <- sweep((transform_data + .5), 2, samp_sum, `/`)
# Apply per million multiplier and log2
temp_data[, -iCol] <- log2(div_sum * 10^6)
} else if (transformation == 'upper') {
warning("Zeros will be regarded as NA for 'upper' transformation")
transform_data[transform_data == 0] <- NA
# Grab non-zero upper quantile of data
samp_upper <- apply(transform_data,
2,
quantile,
na.rm = TRUE,
probs = .75
)
g.q <- quantile(unlist(transform_data), probs = .75, na.rm = TRUE)
# Divide each count by the upper quantile in respective columns
div_75 <- sweep(transform_data, 2, samp_upper, `/`)
# Set new data
temp_data[, -iCol] <- div_75 * g.q # back transform
} else if (transformation == 'median') {
warning("Zeros will be regarded as NA for 'median' transformation")
transform_data[transform_data == 0] <- NA
# Grab non-zero median of data
samp_med <- apply(transform_data,
2,
median,
na.rm = TRUE
)
# Divide each count by the upper quantile in respective columns
div_med <- sweep(transform_data, 2, samp_med, `/`)
g.q <- median(unlist(transform_data), na.rm = TRUE)
# Set new data
temp_data[, -iCol] <- div_med * g.q
}
}
plot_data <- temp_data %>%
tidyr::pivot_longer(
-!!e_data_cname,
names_to = "variable",
values_drop_na = TRUE,
cols_vary = "slowest"
) %>% dplyr::mutate(
variable = factor(
variable,
levels = names(temp_data)[
-which(names(temp_data) == e_data_cname)
]
)
) %>% data.frame
# Farm boy, extract the group_DF attribute. As you wish.
# groupDF <- attr(omicsData, "group_DF")
groupDF <- get_group_DF(omicsData)
# If facet_by is not null and isn't the same as either order_by or color_by.
if (!is.null(facet_by)) {
if (!(facet_by %in% c(order_by, color_by))) {
# Extract the group_DF attribute. This will be used to facet the plots
# later in the function.
# facetDF <- attr(
# group_designation(omicsData = omicsData, main_effects = facet_by),
# "group_DF"
# )
facetDF <- get_group_DF(
group_designation(omicsData = omicsData, main_effects = facet_by)
)
# Rename the columns so they can be merged with the plot_data object and
# referred to by name when plotting.
colnames(facetDF) <- c("variable", facet_by)
plot_data <- merge(plot_data, facetDF, by = "variable")
}
}
# Check if order_by is NULL and update the plot_data object accordingly.
if (!is.null(order_by)) {
# If order_by is not "group_DF" then run group designation with the
# specified variable as the main effect.
if (order_by != "Group") {
# Select the column in f_data containing the sample name as well as the
# column corresponding to the order_by input.
orderDF <- dplyr::select(
omicsData$f_data,
!!dplyr::sym(get_fdata_cname(omicsData)),
!!dplyr::sym(order_by)
)
} else {
# Use the original group_DF attribute for ordering the samples. This
# occurs when order_by = "Group".
orderDF <- groupDF
}
# Rename the columns so they can be merged with the plot_data object and
# referred to by name when plotting.
colnames(orderDF)[1:2] <- c("variable", order_by)
# Add the variables to plot_data that will be used to order the box plots.
plot_data <- merge(plot_data, orderDF, by = "variable")
# Reorder the rows of plot_data so the box plots will be displayed in the
# correct order.
plot_data <- plot_data[order(plot_data[, order_by]), ]
plot_data$variable <- factor(plot_data$variable,
levels = unique(plot_data$variable),
ordered = TRUE
)
# Farm boy, update the subtitle object. As you wish.
subtitle <- paste('Ordered by ', order_by)
}
# Check if color_by is NULL and update plot_data accordingly.
if (!is.null(color_by)) {
# If color_by is not "group_DF" then run group designation with the
# specified variable as the main effect.
if (color_by != "Group") {
# Extricate the group_DF data frame from omicsData after creating the
# group_DF attribute with the color_by input. This will be combined with
# the plot_data object so the samples can be colored by the main effect.
# colorDF <- attr(
# group_designation(omicsData = omicsData, main_effects = color_by),
# "group_DF"
# )
colorDF <- get_group_DF(
group_designation(omicsData = omicsData, main_effects = color_by)
)
} else {
# Use the original group_DF attribute for coloring the samples. This
# occurs when color_by = "group_DF".
colorDF <- groupDF
}
# Rename the columns so they can be merged with the plot_data object and
# referred to by name when plotting.
colnames(colorDF)[1:2] <- c("variable", color_by)
# Check the status of order_by. If order_by is not NULL AND it is different
# from color_by OR if order_by is NULL AND color_by is not NULL the colorDF
# object needs to be merged with plot_data.
if ((!is.null(order_by) && order_by != color_by) ||
(is.null(order_by) && !is.null(color_by))) {
# Merge the colorDF object with plot_data so the samples can be colored
# correctly.
plot_data <- merge(plot_data, colorDF, by = "variable")
}
# Create factors to color by according to the input of color_by.
color_levels <- if (color_by != "Group")
unique(factor(omicsData$f_data[[color_by]])) else
unique(factor(attr(omicsData, "group_DF")[["Group"]]))
plot_data[[color_by]] <- factor(plot_data[[color_by]],
levels = sort(color_levels))
}
# Form awe-inspiring plots ---------------------------------------------------
# Farm boy, make the graph skeleton. As you wish.
p <- ggplot2::ggplot(plot_data)
# Farm boy, color the plots based on the input. As you wish.
if (is.null(color_by)) {
p <- p +
ggplot2::geom_boxplot(ggplot2::aes(
x = variable,
y = value
))
} else {
p <- p +
ggplot2::geom_boxplot(ggplot2::aes(
x = variable,
y = value,
fill = !!dplyr::sym(color_by)
))
}
# Farm boy, use my custom sample names in the plot. As you wish.
if (use_VizSampNames) p <- p + ggplot2::scale_x_discrete(
labels = omicsData$f_data$VizSampNames,
breaks = unique(omicsData$f_data[, get_fdata_cname(omicsData)])
)
# Farm boy, add the black and white theme to my plot. As you wish.
if (bw_theme) {
p <- p + ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
}
# Farm boy, group my plots for me. As you wish.
if (!is.null(facet_by)) {
if (is.null(facet_cols)) {
p <- p + ggplot2::facet_wrap(formula(paste("~", facet_by)),
scales = "free_x"
)
} else {
p <- p + ggplot2::facet_wrap(formula(paste("~", facet_by)),
scales = "free_x",
ncol = facet_cols
)
}
}
# Farm boy, add thematic elements to my plot. As you wish.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
plot.subtitle = ggplot2::element_text(face = 'italic')
)
# Farm boy, add labels to my plot. As you wish.
p <- p +
ggplot2::ggtitle(title, subtitle) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::scale_color_discrete(legend_title)
# Farm boy, add limits to my plot. As you wish.
if (!is.null(ylimit)) {
p <- p + ggplot2::scale_y_continuous(limits = ylimit)
}
# Farm boy, make me a plot with beautiful colors. As you wish.
if (!is.null(palette)) p <- p +
ggplot2::scale_fill_brewer(
name = legend_title,
palette = palette
)
# Farm boy, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
# Farm boy, send my plot into the world to be adored by all. As you wish.
return(p)
}
#' Plot statRes Object
#'
#' Produces plots that summarize the results contained in a `statRes` object.
#'
#' @param x `statRes` object to be plotted, usually the result of `imd_anova`
#' @param plot_type defines which plots to be produced, options are "bar",
#' "volcano", "gheatmap", "fcheatmap"; defaults to "bar". See details for
#' plot descriptions.
#' @param fc_threshold optional threshold value for fold change estimates.
#' Modifies the volcano plot as follows: Vertical lines are added at
#' (+/-)\code{fc_threshold} and all observations that have absolute fold
#' change less than \code{abs(fc_threshold)} are colored as 'non-significant'
#' (as specified by \code{fc_colors}).
#' @param fc_colors vector of length three with character color values
#' interpretable by ggplot. i.e. c("orange", "black", "blue") with the values
#' being used to color negative, non-significant, and positive fold changes
#' respectively
#' @param stacked TRUE/FALSE for whether to stack positive and negative fold
#' change sections in the barplot, defaults to TRUE
#' @param show_sig This input is used when \code{plot_type = "gheatmap"}. A
#' logical value. If TRUE a visual indicator that a certain bin combination is
#' significant by the g-test is shown.
#' @param color_low This input is used when \code{plot_type = "gheatmap"}. A
#' character string specifying the color of the gradient for low count values.
#' @param color_high This input is used when \code{plot_type = "gheatmap"}. A
#' character string specifying the color of the gradient for high count
#' values.
#' @param plotly_layout This input is used when \code{plot_type = "gheatmap"}. A
#' list of arguments, not including the plot, to be passed to
#' \code{plotly::layout} if \code{interactive = TRUE}.
#' @param interactive TRUE/FALSE for whether to create an interactive plot using
#' plotly. Not valid for all plots.
#' @param x_lab character string specifying the x-axis label.
#' @param x_lab_size integer value indicating the font size for the x-axis. The
#' default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' @param y_lab character string specifying the y-axis label.
#' @param y_lab_size integer value indicating the font size for the y-axis. The
#' default is 11.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param text_size integer specifying the size of the text (number of
#' non-missing values) within the plot. The default is 3.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white
#' theme.
#' @param display_count logical value. Indicates whether the non-missing counts
#' will be displayed on the bar plot. The default is TRUE.
#' @param custom_theme a ggplot `theme` object to be applied to non-interactive
#' plots, or those converted by plotly::ggplotly().
#' @param cluster logical for heatmaps; TRUE will cluster biomolecules on X
#' axis. defaults to TRUE for seqData statistics and FALSE for all others.
#' @param free_y_axis Logical. If TRUE the y axis for each bar plot can have its
#' own range. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @details Plot types:
#' \itemize{
#' \item{"bar"} \code{?pmartR::statres_barplot} Bar-chart with bar heights
#' indicating the number of significant biomolecules, grouped by test type and
#' fold change direction.
#' \item{"volcano"} \code{?pmartR::statres_volcano_plot} Scatter plot showing
#' negative-log-pvalues against fold change. Colored by statistical
#' significance and fold change.
#' \item{"gheatmap"} \code{?pmartR::gtest_heatmap} Heatmap with x and y axes
#' indicating the number of nonmissing values for two groups. Colored by
#' number of biomolecules that fall into that combination of nonmissing values.
#' \item{"fcheatmap"} Heatmap showing all biomolecules across comparisons,
#' colored by fold change.
#' }
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @export
#' @method plot statRes
#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true") & requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' # Group the data by condition
#' mypro <- group_designation(
#' omicsData = pro_object,
#' main_effects = c("Phenotype")
#' )
#'
#' # Apply the IMD ANOVA filter
#' imdanova_Filt <- imdanova_filter(omicsData = mypro)
#' mypro <- applyFilt(
#' filter_object = imdanova_Filt,
#' omicsData = mypro,
#' min_nonmiss_anova = 2
#' )
#'
#' # Implement the IMD ANOVA method and compuate all pairwise comparisons
#' # (i.e. leave the `comparisons` argument NULL)
#' anova_res <- imd_anova(omicsData = mypro, test_method = 'anova')
#' plot(anova_res)
#' plot(anova_res, plot_type = "volcano")
#'
#' imd_res <- imd_anova(omicsData = mypro, test_method = 'gtest')
#' plot(imd_res)
#'
#' imd_anova_res <- imd_anova(
#' omicsData = mypro,
#' test_method = 'comb',
#' pval_adjust_a_multcomp = 'bon',
#' pval_adjust_g_multcomp = 'bon'
#' )
#' plot(imd_anova_res, bw_theme = TRUE)
#' plot(imd_anova_res, plot_type = "volcano", bw_theme = TRUE)
#'
plot.statRes <- function(x,
plot_type = "bar",
fc_threshold = NULL,
fc_colors = c("red", "black", "green"),
stacked = TRUE,
show_sig = TRUE,
color_low = NULL,
color_high = NULL,
plotly_layout = NULL,
interactive = FALSE,
x_lab = NULL,
x_lab_size = 11,
x_lab_angle = NULL,
y_lab = NULL,
y_lab_size = 11,
title_lab = NULL,
title_lab_size = 14,
legend_lab = NULL,
legend_position = "right",
text_size = 3,
bw_theme = TRUE,
display_count = TRUE,
custom_theme = NULL,
cluster = FALSE,
free_y_axis = FALSE,
...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, fix all the problems. As you wish.
# Most plots are based on "number_significant" data frame so pull it out
comp_df <- attr(x, "number_significant")
## --------##
# Go through the given plot_types and remove any that aren't currently avilable
plt_tyj <- try(
match.arg(
tolower(plot_type),
c(
"bar",
"volcano",
"gheatmap",
"fcheatmap",
"ma"
)
),
silent = TRUE
)
if (inherits(plt_tyj, 'try-error')) {
warning(paste0(
"Plot type '",
plot_type,
"' is not currently available, defaulting to bar plot."
))
plot_type <- "bar"
} else {
plot_type <- plt_tyj
}
# Don't make biomolecule heatmaps if there's only one comparison
if (plot_type %in% c("fcheatmap") & nrow(comp_df) == 1) {
stop(paste("Fold change heatmaps not supported when only one comparison",
"is being made.",
sep = " "
))
}
if (plot_type %in% c("ma") && attr(x, "data_class") != "seqData") {
stop("MA plots are only supported for transcriptomic data.",
sep = " "
)
}
# specified theme parameters
if (!is.null(custom_theme)) {
if (bw_theme)
warning(paste("Setting both bw_theme to TRUE and specifying a custom",
"theme may cause undesirable results",
sep = " "
))
if (!inherits(custom_theme, c("theme", "gg")))
stop("custom_theme must be a valid 'theme' object as used in ggplot")
mytheme = custom_theme
} else mytheme = ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle),
legend.position = legend_position
)
# Both the volcano plot and heatmaps need a dataframe of fold changes by
# comparison/biomolecule
if (plot_type %in% c("volcano", "gheatmap", "fcheatmap")) {
volcano <- make_volcano_plot_df(x)
}
# Bar plot -------------------------------------------------------------------
if ("bar" %in% plot_type) {
p <- statres_barplot(
x = x,
stacked = stacked,
fc_colors = fc_colors,
text_size = text_size,
display_count = display_count,
x_lab = x_lab,
y_lab = y_lab,
title_lab = title_lab,
legend_lab = legend_lab,
free_y_axis = free_y_axis
)
if (bw_theme) p <- p +
ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
return(p + mytheme)
}
# Volcano plot
else if ("volcano" %in% plot_type) {
if (!attr(x, "statistical_test") %in% c(
"anova", "combined", "EdgeR_F", "Voom_T", "DESeq_Wald", "DESeq_LRT"
)
) {
stop(paste("imd_anova must have been run with test_method = 'anova' or",
"'combined' to make the volcano plot. For seqData,",
"DE_wrapper must have been run.",
sep = " "
))
}
# still returns a ggplot, even if interactive = T
p <-
statres_volcano_plot(
volcano = volcano,
data_scale = attr(x, "data_info")$data_scale,
pval_thresh = attr(x, "pval_thresh"),
fc_colors = fc_colors,
fc_threshold = fc_threshold,
interactive = interactive,
x_lab = x_lab,
y_lab = y_lab,
title_lab = title_lab,
legend_lab = legend_lab
)
if (bw_theme) p <- p +
ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
p <- p + mytheme
if (interactive && requirePlotly())
return(plotly::ggplotly(p, tooltip = c("text"))) else
return(p)
}
# g-test heat map ------------------------------------------------------------
else if ("gheatmap" %in% plot_type) {
if (!attr(x, "statistical_test") %in% c("gtest", "combined")) {
stop(paste("imd_anova must have been run with test_method = 'gtest' or",
"'combined' to make the g-test heatmap. Not valid for seqData.",
sep = " "
))
}
p <-
gtest_heatmap(
volcano = volcano,
pval_thresh = attr(x, "pval_thresh"),
show_sig = show_sig,
interactive = interactive,
color_low = color_low,
color_high = color_high,
plotly_layout = plotly_layout,
text_size = text_size,
display_count = display_count,
x_lab = x_lab,
y_lab = y_lab,
title_lab = title_lab,
legend_lab = legend_lab
)
if (!interactive) {
p <- p + mytheme
}
}
# biomolecule fold change heatmap
else if ("fcheatmap" %in% plot_type) {
# Farm boy, do all the tedious label crap. As you wish.
the_x_label <- if (is.null(x_lab))
"Biomolecule" else
x_lab
the_y_label <- if (is.null(y_lab))
"Comparison" else
y_lab
the_title_label <- if (is.null(title_lab))
"Log Fold Change" else
title_lab
the_legend_label <- if (is.null(legend_lab))
"Fold Change" else
legend_lab
# For now just consider biomolecules significant with respect to ANOVA
volcano <- dplyr::filter(volcano, Type %in% c(
"ANOVA", "EdgeR_F",
"Voom_T", "DESeq_Wald",
"DESeq_LRT"
))
volcano_sigs <- dplyr::filter(volcano, P_value < attr(x, "pval_thresh"))
if (!(nrow(volcano_sigs)) > 0)
warning("No molecules significant at the provided p-value threshold")
colnames(volcano_sigs)[1] <- "Biomolecule"
if (cluster) {
wide <- volcano_sigs %>%
tidyr::pivot_wider(
id_cols = Biomolecule,
names_from = Comparison,
values_from = Fold_change
) %>% data.frame
wide <- wide[!is.na(wide$Biomolecule), ]
row.names(wide) <- wide$Biomolecule
dist_mat <- dist(wide[-1])
res_hclust <- hclust(dist_mat)
order_biom <- rev(res_hclust$labels[res_hclust$order])
volcano_sigs$Biomolecule <- as.character(volcano_sigs$Biomolecule)
volcano_sigs$Biomolecule <- factor(
volcano_sigs$Biomolecule,
levels = unique(paste0(order_biom, volcano_sigs$Biomolecule))
)
} else {
volcano_sigs$Biomolecule <- as.factor(volcano_sigs$Biomolecule)
}
p <- ggplot2::ggplot(
volcano_sigs,
ggplot2::aes(Biomolecule,
Comparison,
text = paste(
"ID:",
Biomolecule,
"<br>",
"Pval:",
P_value
)
)
) +
ggplot2::geom_tile(ggplot2::aes(fill = Fold_change), color = "white") +
ggplot2::scale_fill_gradient(
low = fc_colors[1],
high = fc_colors[3],
name = the_legend_label
) +
ggplot2::xlab(the_x_label) +
ggplot2::ylab(the_y_label) +
ggplot2::ggtitle(the_title_label) +
mytheme
if (interactive && requirePlotly())
return(plotly::ggplotly(p, tooltip = c("text"))) else
return(p)
} else if ("ma" %in% plot_type) {
## Color by significance
comps <- strsplit(attr(x, "comparisons"), "_vs_")
plotter <- purrr::map_dfr(1:length(comps), function(n_comp) {
label <- attr(x, "comparisons")[n_comp]
comp <- comps[[n_comp]]
mean_df <- attr(x, "MA_means")
pval <- grep(paste0("^P_value_", label), colnames(x), value = T)
v1 <- mean_df[[comp[1]]]
v2 <- mean_df[[comp[2]]]
v3 <- x[[pval]]
if (length(v1) == 0) {
v1 <- NA
v2 <- NA
v3 <- NA
}
data.frame(var1 = v1, var2 = v2, pval = v3, comp = label)
})
p <- ggplot2::ggplot(
plotter,
ggplot2::aes(
x = log2((var1 + var2) / 2),
y = log2(var1 / var2), ## where mean is 0 or na in a group, goes to Inf
color = pval < attr(x, "pval_thresh")
)
) +
ggplot2::geom_point() +
ggplot2::facet_wrap(~comp) +
ggplot2::geom_segment(
y = 0, yend = 0, linetype = "dashed", color = "red",
x = min(log2((plotter$var1 + plotter$var2) / 2), na.rm = TRUE),
xend = max(log2((plotter$var1 + plotter$var2) / 2), na.rm = TRUE)
) +
ggplot2::labs(
x = "A (Log2 Average Expression)",
y = "M (Log2 Fold change)",
color = paste("Significance < ", attr(x, "pval_thresh"))
)
if (bw_theme) p <- p +
ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
p <- p + mytheme
if (interactive && requirePlotly())
return(plotly::ggplotly(p, tooltip = c("text"))) else
return(p)
}
return(p)
}
#' Extract flag columns from a statRes object
#'
#' Changes the flags columns from a statRes object into a format that the
#' statRes plot funcitons can handle. pmartR is an unruly beast that cannot be
#' tamed!!
#'
#' @param x A statRes object.
#' @param test character string indicating the type of test run.
#'
#' @return A data frame with the sample IDs and significance flags from a statistical test.
#'
prep_flags <- function(x, test) {
if (test == "anova") {
# Assemble a data frame with the sample IDs and anova flags.
da_flag <- data.frame(
x[, 1, drop = FALSE],
x[, grep("^Flag_A_", colnames(x))],
check.names = FALSE
)
# Remove "Flag_A_" from column names. The first column name is removed
# because it corresponds to the biomolecule ID column.
colnames(da_flag)[-1] <- gsub(
"^Flag_A_",
"",
colnames(x)[grep("^Flag_A_", colnames(x))]
)
} else if (test == "gtest") {
# Throw an error at the user like Fezzik throwing rocks at the Dread Pirate
# Roberts. It doesn't make sense to create a volcano plot with Gtest flags.
# Coding would take so much less time if we didn't have to think of all the
# ways a user can mess things up.
stop("A volcano plot cannot be created with Gtest flags.")
} else if (test %in% c("EdgeR_LRT", "EdgeR_F", "Voom_T", "DESeq_Wald", "DESeq_LRT")) {
# Assemble a data frame with the sample IDs and flags.
flag_cols <- grep("^Flag_", colnames(x))
da_flag <- x[c(1, flag_cols)]
# Remove "Flag_A_" from column names. The first column name is removed
# because it corresponds to the biomolecule ID column.
colnames(da_flag)[-1] <- gsub("^Flag_", "", colnames(da_flag)[-1])
# Runs when the "combined" option was used.
} else {
# NOTE: It does not make sense to have Gtest flags present when creating a
# volcano plot. For this reason we will only use the ANOVA flags when the
# test is "combined".
# Assemble a data frame with the sample IDs and anova flags.
da_flag <- data.frame(
x[, 1, drop = FALSE],
x[, grep("^Flag_A_", colnames(x))],
check.names = FALSE
)
# Remove "Flag_A_" from column names. The first column name is removed
# because it corresponds to the biomolecule ID column.
colnames(da_flag)[-1] <- gsub(
"^Flag_A_",
"",
colnames(x)[grep("^Flag_A_", colnames(x))]
)
}
return(da_flag)
}
#' Create a plotting dataframe for volcano plots and heatmaps
#'
#' A function internal to pmartR:::\link{plot.statRes} which creates the
#' dataframe necessary to construct volcano plots and heatmaps.
#'
#' @param x `statRes` object to be plotted, usually the result of `imd_anova`
#'
#' @returns `data.frame` object with plotting information about each biomolecule
#' such as missing counts per group, and p-values for t and g-tests.
#'
#' @keywords internal
#'
make_volcano_plot_df <- function(x) {
# fold change values for volcano plot
fc_data <- x[, c(1, grep("^Fold_change", colnames(x)))]
colnames(fc_data) <-
gsub(
pattern = "^Fold_change_",
replacement = "",
x = colnames(fc_data)
)
fc_data <- fc_data %>%
tidyr::pivot_longer(
-1,
names_to = "Comparison",
values_to = "Fold_change",
cols_vary = "slowest"
) %>% data.frame
# Run the cmbn_flags function here.
# fold change flags for coloring
fc_flags <- prep_flags(
x = x,
test = attr(x, "statistical_test")
)
fc_flags <- fc_flags %>%
tidyr::pivot_longer(
-1,
names_to = "Comparison",
values_to = "Fold_change_flag",
cols_vary = "slowest"
) %>%
dplyr::mutate(
Fold_change_flag = as.character(Fold_change_flag)
) %>%
data.frame
# p values for labeling and y axis in anova volcano plot
p_data <- x[, c(1, grep("^P_value", colnames(x)))]
pvals <- p_data %>%
tidyr::pivot_longer(
-1,
names_to = "Comparison",
values_to = "P_value",
cols_vary = "slowest"
) %>% data.frame
# grouping column based on test type
if (attr(x, "statistical_test") == "combined") {
pvals$Type <- "G-test"
pvals$Type[grep(pattern = "^P_value_A_", x = pvals$Comparison)] <-
"ANOVA"
pvals$Comparison <-
gsub(
pattern = "^P_value_(G|A)_",
replacement = "",
pvals$Comparison,
perl = T
)
} else if (attr(x, "statistical_test") == "gtest") {
pvals$Type <- "G-test"
pvals$Comparison <-
gsub(
pattern = "^P_value_G_",
replacement = "",
pvals$Comparison,
perl = T
)
} else if (attr(x, "statistical_test") == "anova") {
pvals$Type <- "ANOVA"
pvals$Comparison <-
gsub(
pattern = "^P_value_A_",
replacement = "",
pvals$Comparison,
perl = T
)
} else {
pvals$Type <- attr(x, "statistical_test")
pvals$Comparison <-
gsub(
pattern = "^P_value_",
replacement = "",
pvals$Comparison,
perl = T
)
}
volcano <-
merge(merge(fc_data, pvals, all = TRUE), fc_flags, all = TRUE)
# levels of comparison now of the form 'GROUPNAME_X vs GROUPNAME_Y'
volcano$Comparison <-
gsub(
pattern = "_vs_",
replacement = " vs ",
volcano$Comparison
)
# create counts for gtest plot (number present in each group)
if (attr(x, "statistical_test") %in% c("gtest", "combined")) {
counts <-
x[c(1, grep("^Count_", colnames(x)))]
# trim column names so they are just group names
colnames(counts) <-
gsub("^Count_", replacement = "", colnames(counts))
counts_df <- data.frame()
for (comp in as.character(unique(volcano$Comparison))) {
# create a vector of the two group names being compared
groups = strsplit(comp, " vs ")[[1]]
gsize_1 = nrow(attr(x, "group_DF") %>% dplyr::filter(Group == groups[1]))
gsize_2 = nrow(attr(x, "group_DF") %>% dplyr::filter(Group == groups[2]))
# will contain ID column and count column corresponding to the two groups
temp_df <-
counts[c(
1,
which(colnames(counts) == groups[1]),
which(colnames(counts) == groups[2])
)]
temp_df$Comparison <- comp
# rename the columns to something static so they can be rbind-ed
colnames(temp_df)[which(colnames(temp_df) == groups[1])] <- "Count_First_Group"
colnames(temp_df)[which(colnames(temp_df) == groups[2])] <- "Count_Second_Group"
# store proportion of nonmissing to color g-test values in volcano plot
temp_df$Prop_First_Group <- temp_df$Count_First_Group / gsize_1
temp_df$Prop_Second_Group <- temp_df$Count_Second_Group / gsize_2
counts_df <- rbind(counts_df, temp_df)
}
# should automatically left join by ID AND Comparison
suppressWarnings(volcano <-
volcano %>% dplyr::left_join(counts_df))
}
return(volcano)
}
#' Fold change barplots for statres objects
#'
#' Plots a bar-chart with bar heights indicating the number of significant
#' biomolecules, grouped by test type and fold change direction.
#'
#' @param x,stacked,fc_colors passed from
#' \code{\link[pmartR:plot.statRes]{pmartR::plot.statRes()}}
#' @param text_size An integer specifying the size of the text (number of
#' non-missing values) within the plot. The default is 3.
#' @param display_count logical value. Indicates whether the non-missing counts will
#' be displayed on the bar plot. The default is TRUE.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label.
#' @param title_lab character string specifying the plot title.
#' @param legend_lab character string specifying the legend title.
#'
#' @return `ggplot` object - barplot.
#'
#' @keywords internal
#'
statres_barplot <- function(x,
stacked,
fc_colors,
text_size,
display_count,
x_lab,
y_lab,
title_lab,
legend_lab,
free_y_axis) {
# If free_y_axis is true then each bar plot can have its own y axis range.
if (free_y_axis) {
da_scales <- "free"
} else {
da_scales <- NULL
}
# Farm boy, do all the tedious label crap. As you wish.
the_x_label <- if (is.null(x_lab))
"Statistical test, by group comparison" else
x_lab
the_y_label <- if (is.null(y_lab))
"Count of Biomolecules" else
y_lab
the_title_label <- if (is.null(title_lab))
"Number of DE Biomolecules Between Groups" else
title_lab
the_legend_label <- if (is.null(legend_lab))
"Fold Change Sign" else
legend_lab
comp_df <- attr(x, "number_significant")
comp_df_melt <- comp_df %>%
tidyr::pivot_longer(
-Comparison,
values_to = "Count",
names_to = "Direction",
cols_vary = "slowest"
) %>% data.frame
levels(comp_df_melt$Comparison) <- gsub(
pattern = "_",
replacement = " ",
levels(comp_df_melt$Comparison)
)
# Bar plots side-by-side, both going up
# ggplot(data=comp_df_melt,aes(Comparison,Count,fill=Direction))+
# geom_bar(stat='identity',position='dodge')
## Up direction is positive, down direction is negative
if (stacked)
comp_df_melt[grep("Down", comp_df_melt$Direction), ]$Count <- (
-comp_df_melt[grep("Down", comp_df_melt$Direction), ]$Count
)
# add whichtest, and posneg columns used for plot grouping and label
# adjustment
comp_df_melt <- comp_df_melt %>%
dplyr::mutate(
whichtest = ifelse(grepl("anova", Direction),
"anova",
ifelse(grepl("gtest", Direction),
"gtest",
"total"
)
),
posneg = ifelse(grepl("Up", Direction),
"Positive",
"Negative"
)
) %>%
dplyr::arrange(desc(posneg))
# get only anova or only g-test rows if user did not specify combined
if (attr(x, "statistical_test") %in% c("anova", "gtest")) {
comp_df_melt <- comp_df_melt %>%
dplyr::filter(whichtest == "total") %>%
dplyr::mutate(whichtest = attr(x, "statistical_test"))
}
p <- ggplot2::ggplot(data = comp_df_melt, ggplot2::aes(Comparison, Count)) +
ggplot2::geom_bar(
ggplot2::aes(
x = whichtest,
fill = posneg
),
stat = 'identity',
position = if (stacked) {
ggplot2::position_identity()
} else {
ggplot2::position_dodge(0.9)
}
) +
ggplot2::geom_hline(ggplot2::aes(yintercept = 0), colour = 'gray50') +
ggplot2::scale_fill_manual(
values = c(fc_colors[1], fc_colors[3]),
labels = c("Negative", "Positive"),
name = the_legend_label
) +
ggplot2::facet_wrap(~Comparison, scales = da_scales) +
ggplot2::xlab(the_x_label) +
ggplot2::ylab(the_y_label) +
ggplot2::ggtitle(the_title_label)
# Farm boy, display the counts on the plot. As you wish
if (display_count) {
p <- p +
ggplot2::geom_text(
ggplot2::aes(
x = whichtest,
group = posneg,
label = abs(Count)
),
size = text_size,
position = if (stacked) {
ggplot2::position_identity()
} else {
ggplot2::position_dodge(0.9)
}
)
}
return(p)
}
#' Plot a heatmap for the g-test results of imd-anova
#'
#' Plots a heatmap showing bins for combinations of # of biomolecules present
#' across groups. Bins are colored by the number of biomolecules falling into
#' each bin, and have indicators for significance by g-test.
#'
#' @param volcano `data.frame` produced by pmartR:::\link{make_volcano_plot_df}
#' @param pval_thresh numeric value indicating the p-value threshold for
#' significance.
#' @param show_sig Boolean whether to show the visual indicator that a certain
#' bin combination is significant by the g-test
#' @param interactive passed from
#' \code{\link[pmartR:plot.statRes]{pmartR::plot.statRes()}}. If T, will build
#' a plotly version of the plot. Defaults to FALSE.
#' @param color_low character string specifying the color of the gradient for
#' low count values.
#' @param color_high character string specifying the color of the gradient for
#' high count values.
#' @param plotly_layout A list of arguments, not including the plot, to be
#' passed to plotly::layout if interactive = T.
#' @param text_size An integer specifying the size of the text (number of
#' non-missing values) within the plot. The default is 3.
#' @param display_count logical value. Indicates whether the non-missing counts
#' will be displayed on the bar plot. The default is TRUE.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label.
#' @param title_lab character string specifying the plot title.
#' @param legend_lab character string specifying the legend title.
#'
#' @return `ggplot or plotly` object, depending on if \code{interactive} is set
#' to TRUE or FALSE respectively. A g-test heatmap
#'
#' @keywords internal
#'
gtest_heatmap <-
function(volcano,
pval_thresh,
show_sig,
interactive,
color_low,
color_high,
plotly_layout,
text_size,
display_count,
x_lab,
y_lab,
title_lab,
legend_lab) {
# Farm boy, do all the tedious label crap. As you wish.
the_x_label <- if (is.null(x_lab))
"Nonmissing (first group)" else
x_lab
the_y_label <- if (is.null(y_lab))
"Nonmissing (second group)" else
y_lab
the_title_label <- if (is.null(title_lab))
"Count of non-missing values in each group" else
title_lab
the_legend_label <- if (is.null(legend_lab))
"Number of biomolecules \nin this bin" else
legend_lab
temp_data_gtest <- volcano %>%
dplyr::filter(Type == "G-test") %>%
dplyr::mutate(
Fold_change_flag = dplyr::case_when(
Prop_First_Group > Prop_Second_Group &
P_value <= pval_thresh ~ "2",
Prop_First_Group < Prop_Second_Group &
P_value <= pval_thresh ~ "-2",
is.na(Fold_change) ~ "0",
TRUE ~ Fold_change_flag
)
)
# summarized data frame of # of biomolecules per count combination.
gtest_counts <- temp_data_gtest %>%
dplyr::group_by(Count_First_Group, Count_Second_Group, Comparison) %>%
dplyr::summarise(n = dplyr::n(), sig = all(P_value < 0.05)) %>%
dplyr::mutate(
Count_First_Group = as.character(Count_First_Group),
Count_Second_Group = as.character(Count_Second_Group)
)
g1_counts <- unique(as.numeric(gtest_counts$Count_First_Group))
g2_counts <- unique(as.numeric(gtest_counts$Count_Second_Group))
all_counts <- expand.grid(
as.character(g1_counts),
as.character(g2_counts),
unique(gtest_counts$Comparison),
stringsAsFactors = F
) %>%
`colnames<-`(c("Count_First_Group", "Count_Second_Group", "Comparison"))
gtest_counts <- all_counts %>% dplyr::left_join(gtest_counts) %>%
dplyr::mutate(
Count_First_Group = factor(
Count_First_Group,
levels = sort(unique(as.numeric(Count_First_Group)))
),
Count_Second_Group = factor(
Count_Second_Group,
levels = sort(unique(as.numeric(Count_Second_Group)))
)
)
if (interactive && requirePlotly()) {
comps <- unique(gtest_counts$Comparison)
subplot_list <- list()
limits = range(gtest_counts$n)
# legend entry will not appear for a single plot, so putting info in title
subtext = if (length(comps) == 1)
"\n(star indicates statistical significance)" else
""
for (i in 1:length(comps)) {
data <- gtest_counts %>% dplyr::filter(Comparison == comps[i])
p <- plotly::plot_ly() %>%
plotly::add_trace(
data = data,
x = ~ as.numeric(Count_First_Group),
y = ~ as.numeric(Count_Second_Group),
z = ~n,
type = "heatmap",
hoverinfo = 'text',
text = ~ sprintf("%s biomolecules in this bin.", n),
colors = grDevices::colorRamp(
c(
if (is.null(color_low))
"#132B43" else
color_low,
if (is.null(color_high))
"#56B1F7" else
color_high
)
),
showscale = i == length(comps),
xgap = 0.6, ygap = 0.6
) %>%
plotly::add_trace(
data = data %>% dplyr::filter(sig),
x = ~ as.numeric(Count_First_Group),
y = ~ as.numeric(Count_Second_Group),
type = 'scatter',
mode = "markers",
showlegend = i == length(comps),
name = "Statistically significant",
marker = list(
symbol = "star",
color = "white",
line = list(color = "black", width = 0.5)
),
inherit = FALSE
) %>%
plotly::add_annotations(
text = comps[[i]],
x = 0.5,
y = 1,
xref = "paper",
yref = "paper",
showarrow = FALSE,
yanchor = "bottom",
font = list(size = 14)
)
if (i == length(comps)) {
p <- p %>% plotly::colorbar(
title = "Count biomolecules \nin this bin.", limits = limits
)
}
if (is.null(plotly_layout)) {
p <- p %>%
plotly::layout(
plot_bgcolor = 'grey',
title = list(
text = paste(the_title_label, subtext),
font = list(size = 14),
y = 0.95, yanchor = "top"
),
margin = list(t = 65),
xaxis = list(tickvals = g1_counts, zeroline = F),
yaxis = list(tickvals = g2_counts, zeroline = F)
)
} else {
p <- do.call(plotly::layout, c(list(p), plotly_layout))
}
subplot_list[[length(subplot_list) + 1]] <- p
}
p <- plotly::subplot(subplot_list, shareY = TRUE) %>%
plotly::layout(
xaxis = list(title = the_x_label),
yaxis = list(title = the_y_label)
)
} else {
p <- ggplot2::ggplot(gtest_counts) +
ggplot2::theme_minimal() +
ggplot2::geom_tile(
ggplot2::aes(Count_First_Group,
Count_Second_Group,
fill = n
),
color = "black"
)
if(show_sig) {
sig_data <- gtest_counts %>% dplyr::filter(sig)
if(nrow(sig_data) > 0) {
p <- p + ggplot2::geom_point(
data = sig_data,
ggplot2::aes(Count_First_Group, Count_Second_Group, shape = "1"),
fill = "white"
) +
ggplot2::scale_shape_manual(name = "Statistically significant",
labels = "",
values = 21)
}
}
if (display_count) {
p <- p + ggplot2::geom_text(
ggplot2::aes(Count_First_Group, Count_Second_Group, label = n),
nudge_x = -0.5, nudge_y = 0.5, hjust = -0.1, vjust = 1.5,
color = "white", size = text_size
)
}
p <- p +
ggplot2::facet_wrap(~Comparison) +
ggplot2::scale_fill_gradient(
name = the_legend_label,
low = if (is.null(color_low)) "#132B43" else color_low,
high = if (is.null(color_high)) "#56B1F7" else color_high
) +
ggplot2::xlab(the_x_label) +
ggplot2::ylab(the_y_label) +
ggplot2::ggtitle(the_title_label)
}
return(p)
}
#' Volcano plot for the anova results of imd-anova
#'
#' Plots a volcano plot showing negative log10 p-values on the y axis and fold
#' change on the x axis. Each point is colored by fold change direction and
#' whether or not it was significant by ANOVA.
#'
#' @param volcano data frame produced by pmartR:::\link{make_volcano_plot_df}
#' @param pval_thresh numeric value between 0 and 1 for the alpha level to
#' determine significance. Any values that are significant at this level will
#' be colored based on fc_colors.
#' @param data_scale One of c("log2","log","log10"), for labeling purposes.
#' @param fc_colors,fc_threshold,interactive passed from
#' \code{\link[pmartR:plot.statRes]{pmartR::plot.statRes()}}
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label.
#' @param title_lab character string specifying the plot title.
#' @param legend_lab character string specifying the legend title.
#'
#' @return `ggplot` object. A volcano plot.
#'
#' @keywords internal
#'
statres_volcano_plot <-
function(volcano,
data_scale,
pval_thresh,
fc_colors,
fc_threshold,
interactive,
x_lab,
y_lab,
title_lab,
legend_lab) {
# Farm boy, do all the tedious label crap. As you wish.
the_x_label <- if (is.null(x_lab))
paste("Fold-change (", data_scale, ")", sep = "") else
x_lab
the_y_label <- if (is.null(y_lab))
"-log[10](p-value)" else
y_lab
the_title_label <- if (is.null(title_lab))
"" else
title_lab
the_legend_label <- if (is.null(legend_lab))
"Fold Change" else
legend_lab
# color vector which assigns black to gtest flag values (-2, 2)
cols_anova <-
c(
"-2" = fc_colors[2],
"-1" = fc_colors[1],
"0" = fc_colors[2],
"1" = fc_colors[3],
"2" = fc_colors[2]
)
# temp data with rows only for ANOVA
temp_data_anova <- volcano %>%
dplyr::filter(Type %in% c(
"ANOVA", "EdgeR_F", "Voom_T", "DESeq_Wald", "DESeq_LRT"
)) %>%
dplyr::mutate(
Fold_change_flag = dplyr::case_when(
is.na(Fold_change) |
abs(Fold_change) < ifelse(length(fc_threshold) == 0,
0,
abs(fc_threshold)
) ~ "0",
Fold_change > 0 &
P_value <= pval_thresh ~ "1",
Fold_change < 0 &
P_value <= pval_thresh ~ "-1",
TRUE ~ Fold_change_flag
)
)
# interactive plots need manual text applied to prepare for ggplotly
# conversion
if (interactive && requirePlotly()) {
p <-
ggplot2::ggplot(temp_data_anova, ggplot2::aes(
Fold_change,
-log(P_value, base = 10),
text = paste(
"ID:",
!!dplyr::sym(colnames(volcano)[1]),
"<br>",
"Pval:",
round(P_value, 4)
)
))
} else {
p <-
ggplot2::ggplot(
data = temp_data_anova,
ggplot2::aes(
Fold_change,
-log(P_value, base = 10)
)
)
}
# draw vertical lines at +- fc threshold
if (length(fc_threshold) > 0) {
p <- p +
ggplot2::geom_vline(ggplot2::aes(xintercept = abs(fc_threshold)),
lty = 2
) +
ggplot2::geom_vline(ggplot2::aes(xintercept = abs(fc_threshold) * (-1)),
lty = 2
)
}
p <- p +
ggplot2::geom_point(ggplot2::aes(color = Fold_change_flag), shape = 1) +
ggplot2::facet_wrap(~Comparison) +
ggplot2::ylab(the_y_label) +
ggplot2::xlab(the_x_label) +
ggplot2::ggtitle(the_title_label) +
ggplot2::scale_color_manual(
values = cols_anova,
name = the_legend_label,
labels = c(
paste0("Neg(", unique(temp_data_anova$Type), ")"),
"0", paste0("Pos(", unique(temp_data_anova$Type), ")")
),
breaks = c("-1", "0", "1")
)
return(p)
}
#' Require Plotly
#'
#' Loads plotly if installed, else prints a message telling the user to install
#' plotly.
#'
#' @return whether plotly is installed
#'
#' @keywords internal
#'
#' @noRd
requirePlotly <- function() {
if (requireNamespace("plotly", quietly = TRUE)) {
return(TRUE)
}
warning("Package 'plotly' is not installed. Please install it to use interactive plots.")
return(FALSE)
}
pmartR/pmartR documentation built on April 24, 2024, 10:22 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions plot.cvFilt plot.rmdFilt plot.proteomicsFilt plot.imdanovaFilt plot.RNAFilt plot.totalCountFilt plot.moleculeFilt plot.corRes plot.SPANSRes plot.nmrnormRes prime_iso plot.isobaricnormRes plot.dataRes
Documented in plot.corRes plot.cvFilt plot.dataRes plot.imdanovaFilt plot.isobaricnormRes plot.moleculeFilt plot.nmrnormRes plot.proteomicsFilt plot.rmdFilt plot.RNAFilt plot.SPANSRes plot.totalCountFilt
#' Plot dataRes object
#'
#' For plotting an S3 object of type dataRes
#'
#' @param x object of class dataRes, created by the
#' \code{\link{edata_summary}} function
#' @param metric character string indicating which metric to use in plot:
#' 'mean', 'median', 'sd, 'pct_obs', 'min', or 'max'
#' @param density logical value, defaults to FALSE. If TRUE, a density plot of
#' the specified metric is returned.
#' @param ncols integer value specifying the number columns for the histogram
#' facet_wrap. This argument is used when \code{metric} is not null. The
#' default is NULL.
#' @param interactive logical value. If TRUE, produces an interactive plot.
#' @param x_lab character string specifying the x-axis label when the metric
#' argument is NULL. The default is NULL in which case the x-axis label will
#' be "count".
#' @param x_lab_sd character string used for the x-axis label for the
#' mean/standard deviation plot when the \code{metric} argument is not NULL.
#' @param x_lab_median character string used for the x-axis label for the
#' mean/median plot when the \code{metric} argument is not NULL.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param y_lab_sd character string used for the y-axis label for the
#' mean/standard deviation plot when the \code{metric} argument is not NULL.
#' @param y_lab_median character string used for the y-axis label for the
#' mean/median plot when the \code{metric} argument is not NULL.
#' @param x_lab_size integer value indicating the font size for the x-axis. The
#' default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis. The
#' default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels
#' @param title_lab character string specifying the plot title when the
#' \code{metric} argument is NULL.
#' @param title_lab_sd character string used for the plot title for the
#' mean/standard deviation plot when the \code{metric} argument is not NULL.
#' @param title_lab_median character string used for the plot title for the
#' mean/median plot when the \code{metric} argument is not NULL.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", or "bottom". The default is
#' "right".
#' @param point_size integer specifying the size of the points. The default is
#' 2.
#' @param bin_width integer indicating the bin width in a histogram. The default
#' is 0.5.
#' @param bw_theme logical value. If TRUE, uses the ggplot2 black and white
#' theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @details This function can only create plots for dataRes objects whose 'by' =
#' 'molecule' and 'groupvar' attribute is non NULL
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mylipid <- edata_transform(omicsData = lipid_pos_object, data_scale = "log2")
#' result <- edata_summary(
#' omicsData = mylipid,
#' by = "molecule",
#' groupvar = "Virus"
#' )
#' plot(result)
#'
#' @rdname plot-dataRes
#'
#' @export
#'
plot.dataRes <- function(x, metric = NULL, density = FALSE,
ncols = NULL, interactive = FALSE, x_lab = NULL,
x_lab_sd = NULL, x_lab_median = NULL, y_lab = NULL,
y_lab_sd = NULL, y_lab_median = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = NULL, title_lab = NULL,
title_lab_sd = NULL, title_lab_median = NULL,
title_lab_size = 14, legend_lab = NULL,
legend_position = "right", point_size = 2,
bin_width = 1, bw_theme = TRUE, palette = NULL, ...) {
dataRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# check that attr(dataRes_obj, "by") == "molecule"
if (attr(dataRes_obj, "by") != "molecule") {
# My name is Evan Martin. You killed my plot. Prepare to die.
stop(paste("can only plot a dataRes object if its 'by' attribute is equal",
"to 'molecule'",
sep = " "
))
}
# check that attr(dataRes_obj, "groupvar") is not NULL
if (is.null(attr(dataRes_obj, "groupvar"))) {
# My name is Evan Martin. You killed my plot. Prepare to die.
stop(paste("can only plot a dataRes object if its 'groupvar' attribute is",
"not NULL",
sep = " "
))
}
# Check if the data is on a log scale. If it is not the histograms will not
# work properly when metric = mean, sd, ... because of the wide range of
# abundance values.
if (attr(dataRes_obj, "data_scale") == "abundance") {
# My name is Evan Martin. You killed my plot. Prepare to die.
stop("Data must be on the log scale to plot.")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# extract molecule name
edata_cname = attr(dataRes_obj, "cnames")$edata_cname
# Make labels for various aspects of the plot. (Super tedious!!!)
xLabelSd <- if (is.null(x_lab_sd)) "mean" else x_lab_sd
yLabelSd <- if (is.null(y_lab_sd)) "sd" else y_lab_sd
xLabelMedian <- if (is.null(x_lab_median)) "mean" else x_lab_median
yLabelMedian <- if (is.null(y_lab_median)) "median" else y_lab_median
plotTitleSd <- if (is.null(title_lab_sd))
"Mean x Standard Deviation" else
title_lab_sd
plotTitleMedian <- if (is.null(title_lab_median))
"Mean x Median" else
title_lab_median
legendLabel <- if (is.null(legend_lab)) "Group" else legend_lab
# Build beautiful plots ------------------------------------------------------
if (is.null(metric)) {
# scatterplots
# subseting dataRes_obj object
mean <- dataRes_obj$mean
median <- dataRes_obj$median
sd <- dataRes_obj$sd
# melting data frames from dataRes object
mean_melt <- tidyr::pivot_longer(
mean, -!!edata_cname,
cols_vary = "slowest",
names_to = "variable",
values_to = "mean"
)
sd_melt <- tidyr::pivot_longer(
sd, -!!edata_cname,
cols_vary = "slowest",
names_to = "variable",
values_to = "sd"
)
median_melt <- tidyr::pivot_longer(
median, -!!edata_cname,
cols_vary = "slowest",
names_to = "variable",
values_to = "median"
)
data_mean_sd <- merge(mean_melt,
sd_melt,
by = c(edata_cname, "variable")
)
data_mean_median <- merge(mean_melt,
median_melt,
by = c(edata_cname, "variable")
)
q <- ggplot2::ggplot(
dplyr::filter(
data_mean_sd,
dplyr::if_all(dplyr::one_of(c("mean", "sd")), ~!is.na(.x))
),
ggplot2::aes(
x = mean,
y = sd,
color = variable
)
) +
ggplot2::geom_point(size = point_size) +
ggplot2::xlab(xLabelSd) +
ggplot2::ylab(yLabelSd) +
ggplot2::ggtitle(plotTitleSd)
p <- ggplot2::ggplot(
dplyr::filter(
data_mean_median,
dplyr::if_all(dplyr::one_of(c("mean", "median")), ~!is.na(.x))
),
ggplot2::aes(
x = mean,
y = median,
color = variable
)
) +
ggplot2::geom_point(size = point_size) +
ggplot2::xlab(xLabelMedian) +
ggplot2::ylab(yLabelMedian) +
ggplot2::ggtitle(plotTitleMedian)
# Want the black and white theme? As you wish.
if (bw_theme) {
q <- q + ggplot2::theme_bw()
p <- p + ggplot2::theme_bw()
}
# Create a generic theme that will be used for both plot.
the_theme <- ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Add information to the plot from theme. Must be done after theme_bw()
# otherwise the black and white theme overwrites everything that was
# specified.
q <- q +
ggplot2::labs(color = legendLabel) +
the_theme
p <- p +
ggplot2::labs(color = legendLabel) +
the_theme
# Want a plot with beautiful colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_color_brewer(
palette = palette,
name = legendLabel
)
q <- q +
ggplot2::scale_color_brewer(
palette = palette,
name = legendLabel
)
}
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) {
q <- plotly::ggplotly(q)
p <- plotly::ggplotly(p)
plotly::subplot(q, p, nrows = 1)
} else {
# Combine the plots into one plot when interactive is FALSE.
patchwork::wrap_plots(q, p)
}
} else if (!is.null(metric)) {
if (!(metric %in% c('mean', 'median', 'sd', 'pct_obs', 'min', 'max'))) {
# There is a shortage of perfect plots in the world. It is a shame to ruin
# this one.
stop("metric must be one of mean, median, sd, pct_obs, min or max")
}
if (!is.logical(density)) stop("density must be either TRUE or FALSE")
# if density == F, will plot faceted histograms.
if (density == FALSE) {
# More tedious label creating .... (deep sigh).
xlabel <- if (is.null(x_lab)) metric else x_lab
ylabel <- if (is.null(y_lab)) "count" else y_lab
plotTitle <- if (is.null(title_lab))
paste("Histograms for ", metric, sep = "") else
title_lab
# subsetting dataRes object
data = dataRes_obj[[metric]]
data_melt = tidyr::pivot_longer(
data, -!!edata_cname,
cols_vary = "slowest",
names_to = "variable",
values_to = "value"
)
r <- ggplot2::ggplot(
data_melt,
ggplot2::aes(
x = value,
fill = variable
)
) +
ggplot2::geom_histogram(binwidth = bin_width, colour = "white") +
ggplot2::facet_wrap(~variable, ncol = ncols)
# Create a density plot. Following code runs when density = TRUE.
} else {
# More tedious label creating .... (defeated sigh).
xlabel <- if (is.null(x_lab)) metric else x_lab
ylabel <- if (is.null(y_lab)) "density" else y_lab
plotTitle <- if (is.null(title_lab))
paste("Density plots for ", metric, sep = "") else
title_lab
# if density == TRUE, will plot geom_density
data = dataRes_obj[[metric]]
data_melt = tidyr::pivot_longer(
data, -!!edata_cname,
cols_vary = "slowest",
names_to = "variable",
values_to = "value"
)
r <- ggplot2::ggplot(
data_melt,
ggplot2::aes(
x = value,
colour = variable
)
) +
ggplot2::geom_density()
}
# Want the black and white theme? As you wish.
if (bw_theme) r <- r + ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
# Add the remaining labels and text sizes/orientation to the plot.
r <- r +
ggplot2::ggtitle(plotTitle) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::labs(color = legendLabel) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Want a plot with gorgeous colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
r <- r +
ggplot2::scale_fill_brewer(
palette = palette,
name = legendLabel
)
}
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) r <- plotly::ggplotly(r)
return(r)
}
}
#' Plot isobaricnormRes object
#'
#' Creates box plots for an S3 object of type 'isobaricnormRes'
#'
#' @param x an object of type isobaricnormRes, created by
#' \code{\link{normalize_isobaric}} with apply_norm = FALSE
#' @param order logical value. If TRUE the samples will be ordered by the column
#' of f_data containing the experiment/plate information.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label
#' @param x_lab_size integer value indicating the font size for the x-axis. The
#' default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis. The
#' default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white
#' theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true") & requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' myiso <- edata_transform(omicsData = isobaric_object, data_scale = "log2")
#' result <- normalize_isobaric(myiso,
#' exp_cname = "Plex",
#' apply_norm = FALSE,
#' refpool_cname = "Virus",
#' refpool_notation = "Pool"
#' )
#' plot(result)
#'
#' @importFrom dplyr .data
#'
#' @rdname plot-isobaricnormRes
#'
#' @export
#'
plot.isobaricnormRes <- function(x, order = FALSE,
interactive = FALSE, x_lab = NULL,
y_lab = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = NULL,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "none",
bw_theme = TRUE, palette = NULL, ...) {
isobaricnormRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Check if input is an isobaricnormRes class object.
if (!inherits(isobaricnormRes_obj, "isobaricnormRes")) {
stop("object must be of class 'isobaricnormRes'")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# extracting attributes from isobaricnormRes_obj
exp_cname = attr(isobaricnormRes_obj, "isobaric_info")$exp_cname
fdata_cname = attr(isobaricnormRes_obj, "cnames")$fdata_cname
edata_cname <- attr(isobaricnormRes_obj, "cnames")$edata_cname
# Transform the isobaricnormRes data frames into a format usable by ggplot2.
tall_data <- prime_iso(
isonormRes = isobaricnormRes_obj,
exp_cname = exp_cname,
fdata_cname = fdata_cname,
edata_cname = edata_cname
)
# Do all the tedious plot label crap.
xlabel <- if (is.null(x_lab)) "Reference Sample" else x_lab
ylabel <- if (is.null(y_lab)) "Log Abundance" else y_lab
plot_title <- if (is.null(title_lab))
"Reference Sample Profile" else
title_lab
legendLabel <- if (is.null(legend_lab)) "Sample" else legend_lab
# Create pretty plots --------------------------------------------------------
# If order is TRUE order the box plots by experiment name/value.
if (order == TRUE) {
xlabel <- if (is.null(x_lab)) exp_cname else x_lab
p <- ggplot2::ggplot(
data = dplyr::filter(tall_data, !is.na(values)),
ggplot2::aes(
x = .data[[exp_cname]],
y = values,
fill = .data[[exp_cname]]
)
)
# Otherwise separate the box plots by sample name.
} else {
p <- ggplot2::ggplot(
data = dplyr::filter(tall_data, !is.na(values)),
ggplot2::aes(
x = .data[[fdata_cname]],
y = values,
fill = .data[[exp_cname]]
)
)
}
# Want your plot to have a black and white background? As you wish.
# The black and white theme needs to come before the code that creates the box
# plot. If the theme_bw code follows the code that creates the box plot it
# will add the legend back to the graph (if legend_position = "none").
if (bw_theme == TRUE) p <- p + ggplot2::theme_bw()
# Create the box plot with all of the users input.
p <- p +
ggplot2::geom_boxplot() +
ggplot2::ggtitle(plot_title) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::labs(color = legendLabel) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle),
legend.position = legend_position
)
# Want to use beautiful non-default colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_fill_brewer(
palette = palette,
name = legendLabel
)
}
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
# Takes the isobaricnormRes object and returns a data frame in the correct
# format for plotting in ggplot2.
prime_iso <- function(isonormRes, exp_cname,
fdata_cname, edata_cname) {
# Find the column in e_data pertaining to the peptide IDs.
id_col <- which(names(isonormRes$e_data) == edata_cname)
# Stack the columns of e_data. This will include the sample names as an
# additional column.
tall_data <- stack(isonormRes$e_data[, -id_col])
# Change the name of the column containing sample names to match the
# corresponding column name in f_data.
names(tall_data)[2] <- fdata_cname
# Include the experiment column in tall_data.
tall_data <- dplyr::inner_join(tall_data,
isonormRes$f_data[, c(fdata_cname, exp_cname)],
by = fdata_cname
)
# Extract the indices for each column in tall_data.
exp_cname_ind <- which(names(tall_data) == exp_cname)
fdata_cname_ind <- which(names(tall_data) == fdata_cname)
values_col_ind <- which(names(tall_data) == "values")
# Convert the experiment column into a factor.
tall_data[[exp_cname]] <- factor(tall_data[[exp_cname]])
# Return the tall data!
return(tall_data)
}
#' Plot nmrnormRes Object
#'
#' Creates a scatter plot for an S3 object of type 'nmrnormRes'
#'
#' @param x an object of type nmrnormRes, created by
#' \code{\link{normalize_nmr}}
#' @param nmrData An nmrData object.
#' @param order_by A character string specifying a column in f_data by which to
#' order the samples.
#' @param color_by A character string specifying a column in f_data by which to
#' color the points.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label
#' @param x_lab_size integer value indicating the font size for the x-axis. The
#' default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis. The
#' default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param point_size integer specifying the size of the points. The default is
#' 2.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white
#' theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mynmr <- edata_transform(omicsData = nmr_identified_object, data_scale = "log2")
#' mynmrnorm <- normalize_nmr(
#' omicsData = mynmr,
#' apply_norm = FALSE,
#' metabolite_name = "unkm1.53"
#' )
#' plot(mynmrnorm)
#'
#' mynmrnorm2 <- normalize_nmr(
#' omicsData = mynmr,
#' apply_norm = FALSE,
#' sample_property_cname = "Concentration"
#' )
#' plot(mynmrnorm2)
#'
#' @rdname plot-nmrnormRes
#' @export
#'
plot.nmrnormRes <- function(x, nmrData = NULL, order_by = NULL,
color_by = NULL, interactive = FALSE,
x_lab = NULL, y_lab = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "none",
point_size = 2, bw_theme = TRUE, palette = NULL,
...) {
nmrnormRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
if (!inherits(nmrnormRes_obj, "nmrnormRes")) {
# My name is Evan Martin. You defiled pmart. Prepare to die.
stop("object must be of class 'nmrnormRes'")
}
if (!is.null(order_by)) {
# Farm boy, make sure an nmrData object is provided. As you wish.
if (is.null(nmrData)) {
# To the pain!
stop("An nmrData object must be provided if order_by is not NULL.")
}
# Farm boy, make sure order_by exists in f_data. As you wish.
if (!order_by %in% names(nmrData$f_data)) {
# Do you hear that user? Those are the shrieking eels!
stop("order_by must be a column in f_data.")
}
}
if (!is.null(color_by)) {
# Farm boy, make sure an nmrData object is provided. As you wish.
if (is.null(nmrData)) {
# To the pain!
stop("An nmrData object must be provided if color_by is not NULL.")
}
# Farm boy, make sure color_by exists in f_data. As you wish.
if (!color_by %in% names(nmrData$f_data)) {
# Fezzik rip his arms off. Oh, you mean these column names.
stop("color_by must be a column in f_data.")
}
}
# extracting attributes from nmrnormRes_obj
sample_property_cname <- attr(
nmrnormRes_obj,
"nmr_info"
)$sample_property_cname
metabolite_name <- attr(nmrnormRes_obj, "nmr_info")$metabolite_name
fdata_cname <- attr(nmrnormRes_obj, "cnames")$fdata_cname
# organize nmrnormRes_obj
data <- data.frame(
Sample = nmrnormRes_obj$Sample,
value = nmrnormRes_obj$value
)
# Check if order_by is NULL and update the plot data object accordingly.
if (!is.null(order_by)) {
# Reorder the rows of data so the plot will be displayed in the correct
# order. Dread Pirate Roberts only likes plots that are ordered. What Dread
# Pirate Roberts doesn't like doesn't get plotted. Savvy?
#
# ggplot thinks it knows what is best for everyone in every situation. I
# disagree. However, we must follow ggplot convention. ggplot orders the
# data how they want to unless you explicitly give them the order you want.
# The code below is telling ggplot to shove it and to plot it in the order
# we want. BAM!!
data$Sample <- factor(
data$Sample,
levels = data$Sample[order(nmrData$f_data[, order_by])],
ordered = TRUE
)
}
# Check if color_by is NULL and update the plot data accordingly.
if (!is.null(color_by)) {
# Create factors to color by according to the input of color_by.
color_levels <- unique(factor(nmrData$f_data[[color_by]]))
# Farm boy, add a variable specifying the color for each point.
data$Color <- factor(nmrData$f_data[[color_by]],
levels = sort(color_levels))
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Do all the tedious plot label crap.
xlabel <- if (is.null(x_lab)) "Sample ID" else x_lab
legendLabel <- if (is.null(legend_lab)) "Sample" else legend_lab
# Create y-axis and plot title labels when a reference metabolite is used.
if (!is.null(metabolite_name)) {
ylabel <- if (is.null(y_lab)) metabolite_name else y_lab
plot_title <- if (is.null(title_lab))
"Reference Metabolite Profile" else
title_lab
# Create y-axis and plot title labels when the sample property is used.
} else if (!is.null(sample_property_cname)) {
ylabel <- if (is.null(y_lab)) sample_property_cname else y_lab
plot_title <- if (is.null(title_lab))
"Sample Property Profile" else
title_lab
}
# Generate dazzling plots ----------------------------------------------------
# Create the plot skeleton according to the color_by argument.
if (!is.null(color_by)) {
p <- ggplot2::ggplot(
data = data,
ggplot2::aes(
x = Sample,
y = value,
color = Color
)
)
# Check if palette is NULL or not. Hopefully it isn't so the plot will be
# created with colors other than the super hideous default ggplot2 colors.
if (!is.null(palette)) {
# Create a color from the color brewer package if a palette is provided.
colas <- RColorBrewer::brewer.pal(5, palette)
}
} else {
p <- ggplot2::ggplot(
data = data,
ggplot2::aes(
x = Sample,
y = value
)
)
}
# Want your plot to have a black and white background? As you wish. The black
# and white theme needs to come before the code that creates the scatter plot.
# If the theme_bw code follows the code that creates the scatter plot it will
# add the legend back to the graph (if legend_position = "none").
if (bw_theme == TRUE) p <- p + ggplot2::theme_bw()
# Add the points and labels to the dazzling plot.
p <- p +
ggplot2::geom_point(size = point_size) +
ggplot2::ggtitle(plot_title) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::labs(color = legendLabel) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Farm boy, make me a plot with beautiful colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_color_brewer(
palette = palette,
name = legendLabel
)
}
# Farm boy, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot SPANSRes Object
#'
#' For plotting an S3 object of type 'SPANSRes'
#'
#' @param x an object of the class 'SPANSRes', created by
#' \code{\link{spans_procedure}}
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is NULL.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param color_low character string specifying the color of the gradient for
#' low values.
#' @param color_high character string specifying the color of the gradient for
#' high values
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' \donttest{
#' library(pmartRdata)
#' data(pep_object)
#' mypep <- edata_transform(omicsData = pep_object, data_scale = "log2")
#' mypep <- group_designation(omicsData = mypep, main_effects = "Phenotype")
#' myspans <- spans_procedure(omicsData = mypep)
#' plot(myspans)
#' }
#' @rdname plot-SPANSRes
#'
#' @export
#'
plot.SPANSRes <- function(x, interactive = FALSE,
x_lab = NULL, y_lab = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = NULL,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
color_low = NULL, color_high = NULL,
bw_theme = TRUE, ...) {
SPANSRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
if (!inherits(SPANSRes_obj, "SPANSRes")) {
# Suffer the wrath of Dread Pirate Roberts!!!!!
stop("object must be of class 'SPANSRes'")
}
# plotting object with numeric SPANS_score, the normalization method, and a
# modified string specifying the subset method + parameters for that method
SPANSRes_obj <- SPANSRes_obj %>%
dplyr::mutate(
ss_par = paste(subset_method, parameters, sep = " | "),
SPANS_score = as.numeric(SPANS_score)
) %>%
dplyr::left_join(attr(SPANSRes_obj, "method_selection_pvals"),
by = c(
"subset_method",
"normalization_method",
"parameters"
)
)
# Farm boy, fix all the problems. As you wish. Filter rows with the highest
# SPANS score. This subsetted/filtered data frame will be used to add points
# to the plot for the best scoring methods. The best methods are those with
# the highest SPANS_score. The slice_max function will select ALL rows where
# the highest score occurs.
da_best <- SPANSRes_obj %>%
dplyr::slice_max(SPANS_score)
# Do all the tedious plot label crap.
xlabel <- if (is.null(x_lab)) "Normalization Method" else x_lab
ylabel <- if (is.null(y_lab)) "Subset Parameters" else y_lab
plot_title <- if (is.null(title_lab)) NULL else title_lab
legendLabel <- if (is.null(legend_lab)) "Score" else legend_lab
# Produce magnificent plots --------------------------------------------------
p <- ggplot2::ggplot(data = SPANSRes_obj) +
ggplot2::geom_tile(
ggplot2::aes(
x = normalization_method,
y = ss_par,
alpha = 1
),
color = 'black'
) +
ggplot2::geom_tile(
ggplot2::aes(
x = normalization_method,
y = ss_par,
fill = SPANS_score
),
color = 'black'
) +
ggplot2::geom_point(
data = da_best,
ggplot2::aes(
x = normalization_method,
y = ss_par,
shape = '1'
)
) +
ggplot2::scale_alpha_continuous(
name = 'Not Scored',
labels = ''
) +
ggplot2::scale_shape_discrete(
name = 'Best Scores',
labels = ''
) +
ggplot2::scale_fill_gradient(
low = if (is.null(color_low)) "#132B43" else color_low,
high = if (is.null(color_high)) "#56B1F7" else color_high,
) +
ggplot2::ggtitle(plot_title) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel)
# Want the black and white theme? As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
p <- p +
ggplot2::labs(fill = legendLabel) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle),
legend.position = legend_position,
panel.border = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
axis.line = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank()
)
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) {
p <- plotly::plot_ly(
SPANSRes_obj,
x = ~normalization_method,
y = ~ss_par,
z = ~SPANS_score,
hoverinfo = 'text',
text = ~ paste(
'</br> F(-Log10(HSmPV)):',
F_log_HSmPV,
'</br> F(Log10(NSmPV)): ',
F_log_NSmPV,
'</br> Scale p-value: ',
scale_p_value,
'</br> Location p-value',
location_p_value
),
colors = grDevices::colorRamp(
c(
if (is.null(color_low)) "#132B43" else color_low,
if (is.null(color_high)) "#56B1F7" else color_high
)
),
type = "heatmap"
) %>%
plotly::add_trace(
x = da_best$normalization_method,
y = da_best$ss_par,
type = 'scatter',
mode = "markers",
marker = list(color = "black"),
name = "Top SPANS scores",
inherit = FALSE
) %>%
plotly::colorbar(title = "SPANS score") %>%
plotly::layout(
plot_bgcolor = 'black',
xaxis = list(title = "Normalization Method"),
yaxis = list(title = "Subset Method"),
showlegend = TRUE
)
}
return(p)
}
#' Plot naRes Object
#'
#' For plotting an S3 object of type 'naRes'
#'
#' @param x list of two data frames, one containing the number of
#' missing values by sample, and the other containing missing values by
#' molecule
#' @param omicsData object of class 'pepData', 'proData', 'metabData',
#' 'lipidData', nmrData', or 'seqData', created by \code{\link{as.pepData}},
#' \code{\link{as.proData}}, \code{\link{as.metabData}},
#' \code{\link{as.lipidData}}, \code{\link{as.nmrData}}, or \code{\link{as.seqData}}, respectively.
#' @param plot_type character string specifying which type of plot to produce.
#' The two options are 'bar' or 'scatter'.
#' @param nonmissing logical value. When FALSE, plots missing values. When TRUE,
#' plots non-missing values.
#' @param proportion logical value. When TRUE, plots the proportion of missing
#' (or non-missing if \code{nonmissing} is TRUE) to the total number of
#' values. Only works with a plot type of 'bar'.
#' @param order_by A character string specifying a column in f_data by which to
#' order the samples. Specifying "Group" will use the "Group" column of the
#' object's \code{group_DF} attribute to order the samples. Only works with a
#' plot type of 'bar'.
#' @param color_by A character string specifying a column in f_data by which to
#' color the bars or the points depending on the \code{plot_type}. Specifying
#' "Group" will use the "Group" column of the object's \code{group_DF}
#' attribute to color the samples. Only works with a plot type of 'bar'.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab_bar character string used for the x-axis label for the bar
#' plot
#' @param x_lab_scatter character string used for the x-axis label for the
#' scatter plot
#' @param y_lab_bar character string used for the y-axis label for the bar
#' plot
#' @param y_lab_scatter character string used for the y-axis label for the
#' scatter plot
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' @param title_lab_bar character string used for the plot title when
#' \code{plot_type} is 'bar'.
#' @param title_lab_scatter character string used for the plot title when
#' \code{plot_type} is 'scatter'.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab_bar character string specifying the legend title when
#' creating a bar plot.
#' @param legend_lab_scatter character string specifying the legend title when
#' creating a scatter plot.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", or "bottom". The default is
#' "right".
#' @param point_size An integer specifying the size of the points. The default
#' is 2.
#' @param text_size An integer specifying the size of the text (number of
#' missing values by sample) within the bar plot. The default is 3.
#' @param bar_width An integer indicating the width of the bars in the bar plot.
#' The default is 0.8.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param display_count logical value. Indicates whether the missing value
#' counts by sample will be displayed on the bar plot. The default is TRUE.
#' @param coordinate_flip logical value. Indicates whether the x and y axes will
#' be flipped. The default is FALSE.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @details This function takes in an object of class naRes and creates either a
#' bar or scatter plot of missing values. When plot_type = 'bar', a sample
#' name by missing values count bar chart is returned. When plot_type =
#' 'scatter' a mean intensity vs number of missing values (per molecule)
#' scatter plot is returned. Note: If the omicsData object has had
#' \code{\link{group_designation}} applied to it, the points in the plot will
#' be colored by group.
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mylipid <- group_designation(omicsData = lipid_neg_object, main_effects = "Virus")
#' result <- missingval_result(omicsData = mylipid)
#' plot(result, omicsData = mylipid, plot_type = "bar",
#' x_lab_angle = 50, order_by = "Virus", color_by = "Virus")
#' plot(result, omicsData = mylipid, plot_type = "scatter",
#' x_lab_angle = 50, color_by = "Virus")
#'
#' result <- missingval_result(omicsData = rnaseq_object)
#' plot(result, omicsData = rnaseq_object, plot_type = "bar")
#'
#' @rdname plot-naRes
#'
#' @export
#'
plot.naRes <- function (x, omicsData, plot_type = "bar",
nonmissing = FALSE, proportion = FALSE,
order_by = NULL, color_by = NULL,
interactive = FALSE, x_lab_bar = NULL,
x_lab_scatter = NULL, y_lab_bar = NULL,
y_lab_scatter = NULL, x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 60, title_lab_bar = NULL,
title_lab_scatter = NULL, title_lab_size = 14,
legend_lab_bar = NULL, legend_lab_scatter = NULL,
legend_position = "right", point_size = 2,
text_size = 3, bar_width = 0.8, bw_theme = TRUE,
palette = NULL, display_count = TRUE,
coordinate_flip = FALSE, use_VizSampNames = FALSE,
...) {
naRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# check for a naRes object #
if (!inherits(naRes_obj, "naRes")) stop("object must be of class 'naRes'")
# Check that omicsData is the correct class.
if (!inherits(omicsData, c(
"proData", "pepData", "lipidData",
"metabData", "nmrData", "seqData"
))) {
# Fezzik, tear his arms off.
stop("omicsData is not an appropriate class")
}
# Check that type is either bar or scatter.
if (!(plot_type %in% c("bar", "scatter"))) {
# My name is Evan Martin. You killed my plot. Prepare to die.
stop("plot_type must be either 'bar' or 'scatter'")
}
# Check to make sure proportion is only used with bar plot
if (proportion && plot_type != "bar") {
stop("plot_type must be 'bar' if proportion is TRUE")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Farm boy, make sure order_by exists in f_data. As you wish.
if (!is.null(order_by) && order_by != "Group") {
if (!order_by %in% names(omicsData$f_data)) {
# I'm a pmartR developer. You killed my plot. Prepare to receive an error.
stop ("order_by: column '", order_by, "' not found in f_data.")
}
}
# Farm boy, make sure color_by exists in f_data. As you wish.
if (!is.null(color_by) && color_by != "Group") {
if (!color_by %in% names(omicsData$f_data)) {
# Clearly you cannot choose a column name in f_data!
stop ("color_by: column '", color_by, "' not found in f_data.")
}
}
# Extract info from naRes_obj
if (inherits(omicsData, "seqData")) {
na.by.sample <- naRes_obj$zeros.by.sample
na.by.molecule <- naRes_obj$zeros.by.molecule
num_missing_vals <- na.by.molecule$num_zeros
num_nonmissing_vals <- na.by.molecule$num_nonzeros
missing_proportion <- na.by.molecule$zeros_proportion
names(na.by.sample)[which(names(na.by.sample) == "num_zeros")] <- "num_NA"
names(na.by.molecule)[which(names(na.by.molecule) == "num_zeros")] <- "num_NA"
names(na.by.sample)[which(names(na.by.sample) == "num_nonzeros")] <- "num_non_NA"
names(na.by.molecule)[which(names(na.by.molecule) == "num_nonzeros")] <- "num_non_NA"
} else {
na.by.sample <- naRes_obj$na.by.sample
na.by.molecule <- naRes_obj$na.by.molecule
num_missing_vals <- na.by.molecule$num_NA
num_nonmissing_vals <- na.by.molecule$num_non_NA
}
# Get the proportion of missing/nonmissing to total (missing + nonmissing)
target_NA_column <- ifelse(nonmissing, "num_non_NA", "num_NA")
na.by.molecule$NA_proportion <- na.by.molecule[[target_NA_column]] /
(na.by.molecule$num_NA + na.by.molecule$num_non_NA)
na.by.sample$NA_proportion <- na.by.sample[[target_NA_column]] /
(na.by.sample$num_NA + na.by.sample$num_non_NA)
edata_cname <- attr(naRes_obj, "cnames")$edata_cname
fdata_cname <- attr(naRes_obj, "cnames")$fdata_cname
# Extract info from omicsData
edata <- omicsData$e_data
edata_cname_id <- which(names(edata) == edata_cname)
group_df <- get_group_DF(omicsData)
# Bar plot order_by and group_by crap ---------------
# Check if order_by is NULL and update the plot_data object accordingly.
if (!is.null(order_by)) {
if (order_by == "Group") {
na.by.sample <- na.by.sample[order(na.by.sample$Group), ]
na.by.sample[[fdata_cname]] <- factor(
na.by.sample[[fdata_cname]],
levels = na.by.sample[[fdata_cname]],
ordered = TRUE
)
} else {
# Reorder the rows of na.by.sample so the bar plot will be displayed in the
# correct order.
na.by.sample <- na.by.sample[order(na.by.sample[, order_by]), ]
na.by.sample[[fdata_cname]] <- factor(
na.by.sample[[fdata_cname]],
levels = na.by.sample[[fdata_cname]],
ordered = TRUE
)
}
}
# Check if color_by is NULL and update na.by.sample accordingly.
if (!is.null(color_by)) {
# Create factors to color by according to the input of color_by.
color_levels <- if (color_by != "Group")
unique(factor(omicsData$f_data[[color_by]])) else
unique(factor(attr(omicsData, "group_DF")[["Group"]]))
na.by.sample[[color_by]] <- factor(na.by.sample[[color_by]],
levels = sort(color_levels))
}
# Fashion astonishing plots --------------------------------------------------
# Make me a bar plot. As you wish.
if (plot_type == "bar") {
p <- na_bar(na.by.sample = na.by.sample, x_lab_bar = x_lab_bar,
y_lab_bar = y_lab_bar, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab_bar = title_lab_bar, title_lab_size = title_lab_size,
legend_lab_bar = legend_lab_bar,
legend_position = legend_position, text_size = text_size,
bar_width = bar_width, bw_theme = bw_theme, palette = palette,
display_count = display_count,
coordinate_flip = coordinate_flip,
use_VizSampNames = use_VizSampNames, interactive = interactive,
fdata_cname = fdata_cname, color_by = color_by,
nonmissing = nonmissing, proportion = proportion)
}
# Make me a scatter plot. As you wish.
if (plot_type == "scatter") {
p <- na_scatter(edata = edata, group_df = group_df,
na.by.molecule = na.by.molecule,
edata_cname = edata_cname, edata_cname_id = edata_cname_id,
fdata_cname = fdata_cname, x_lab_scatter = x_lab_scatter,
y_lab_scatter = y_lab_scatter,
title_lab_scatter = title_lab_scatter,
legend_lab_scatter = legend_lab_scatter,
legend_position = legend_position,
title_lab_size = title_lab_size, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, text_size = text_size,
bw_theme = bw_theme, palette = palette,
x_lab_angle = x_lab_angle,
coordinate_flip = coordinate_flip,
interactive = interactive, point_size = point_size,
nonmissing = nonmissing)
}
return(p)
}
na_bar <- function (na.by.sample, x_lab_bar, y_lab_bar, x_lab_size, y_lab_size,
x_lab_angle, title_lab_bar, title_lab_size, legend_lab_bar,
legend_position, text_size, bar_width, bw_theme, palette,
display_count, coordinate_flip, use_VizSampNames,
interactive, fdata_cname, color_by, nonmissing,
proportion) {
# Select which column of na.by.sample will be used
if (proportion) {
y_axis = "NA_proportion"
} else if (nonmissing) {
y_axis = "num_non_NA"
} else {
y_axis = "num_NA"
}
# Farm boy, color the plots based on the input. As you wish.
if (!is.null(color_by)) {
# Forge the basic sample bar plot with group info. More details will be
# added according to the users input later.
samp <- ggplot2::ggplot(
data = na.by.sample,
ggplot2::aes(
x = .data[[fdata_cname]],
y = .data[[y_axis]],
fill = !!dplyr::sym(color_by)
)
) +
ggplot2::geom_bar(stat = "identity", width = bar_width)
} else {
# Check if palette is NULL or not. Hopefully it isn't so the plot will be
# created with colors other than the super hideous default ggplot2 colors.
if (!is.null(palette)) {
# Create a color from the color brewer package if a palette is provided.
colas <- RColorBrewer::brewer.pal(5, palette)
}
# Create an object for the first default ggplot2 color.
hideous <- grDevices::hcl(h = 15,
c = 100,
l = 65)
# Forge the basic sample bar plot without group info. More details will be
# added according to the users input later.
samp <- ggplot2::ggplot(data = na.by.sample,
ggplot2::aes(x = .data[[fdata_cname]],
y = .data[[y_axis]])) +
ggplot2::geom_bar(stat = "identity",
width = bar_width,
fill = if (is.null(palette))
hideous else
colas[[3]])
}
# Add the counts to the bar plot and histogram if the user so desires.
if (display_count) {
samp <- samp +
ggplot2::geom_text(ggplot2::aes(label = round(.data[[y_axis]], digits=4)),
vjust = 2,
color = "black",
size = text_size)
}
# Want the black and white theme? As you wish.
if (bw_theme) samp <- samp + ggplot2::theme_bw()
# Make labels for both the plot by sample and plot by molecule.
xLabelBar <- if (is.null(x_lab_bar))
"Sample Name" else
x_lab_bar
yLabelBar <- if (is.null(y_lab_bar))
sprintf(
"%s of %s values",
ifelse(proportion, "Proportion", "Number"),
ifelse(nonmissing, "non-missing", "missing")
) else
y_lab_bar
plotTitleBar <- if (is.null(title_lab_bar))
sprintf(
"%s values by sample",
ifelse(nonmissing, "Non-missing", "Missing")
) else
title_lab_bar
legendLabelBar <- if (is.null(legend_lab_bar))
color_by else
legend_lab_bar
# Add labels to the plots. Even more tedious work to do. Will it ever end!?!
samp <- samp +
ggplot2::xlab(xLabelBar) +
ggplot2::ylab(yLabelBar) +
ggplot2::ggtitle(plotTitleBar) +
ggplot2::labs(fill = legendLabelBar) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Want to use beautiful non-default colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
samp <- samp +
ggplot2::scale_fill_brewer(
palette = palette,
name = legendLabelBar
)
}
# Want to use short sample names? As you wish.
if (use_VizSampNames) {
samp <- samp +
ggplot2::scale_x_discrete(labels = na.by.sample$VizSampNames)
}
# Want to be bass ackwards? As you wish. (This is for the crazies.)
if (coordinate_flip) samp <- samp + ggplot2::coord_flip()
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) samp <- plotly::ggplotly(samp)
return(samp)
}
na_scatter <- function (edata, group_df, na.by.molecule, edata_cname,
edata_cname_id, fdata_cname, x_lab_scatter,
y_lab_scatter, title_lab_scatter, legend_lab_scatter,
legend_position, title_lab_size, x_lab_size, y_lab_size,
text_size, bw_theme, palette, x_lab_angle,
coordinate_flip, interactive, point_size,
nonmissing) {
# Select missing/nonmissing
if (nonmissing)
num_missing_vals <- na.by.molecule$num_non_NA
else
num_missing_vals <- na.by.molecule$num_NA
# More tedious label making.
xLabelScatter <- if (is.null(x_lab_scatter))
"Mean Intensity" else
x_lab_scatter
yLabelScatter <- if (is.null(y_lab_scatter))
"Number of Missing Values (per molecule)" else
y_lab_scatter
plotTitleScatter <- if (is.null(title_lab_scatter))
"Mean Intensity vs NA per Molecule" else
title_lab_scatter
legendLabelScatter <- if (is.null(legend_lab_scatter))
"Group" else
legend_lab_scatter
if (is.null(group_df)) {
# Calculate the mean intensity for each molecule when the group_DF attribute
# is NULL.
mean_intensity <- rowMeans(edata[, -edata_cname_id], na.rm = TRUE)
plot_data <- as.data.frame(cbind(mean_intensity, num_missing_vals))
# Start the scatter plot when the group_DF attribute is NULL.
p <- ggplot2::ggplot(
plot_data,
ggplot2::aes(
mean_intensity,
num_missing_vals
)
) +
ggplot2::geom_point(size = point_size)
} else {
# Extract group information to calculate the group-wise mean for each
# molecule.
levels <- unique(group_df$Group)
indices_list <- vector(
mode = "list",
length = length(levels)
)
for (i in 1:length(levels)) {
# Extract the column indices for the ith group. This will be used to
# subset e_data.
inds <- which(group_df$Group == levels[i])
indices_list[[i]] <- inds
}
# Calculate the mean intensity for each molecule by group. NaN can appear if
# an entire row has all NA values.
mean_by_group <- lapply(indices_list,
function(x, temp_edata) rowMeans(temp_edata[x],
na.rm = TRUE
),
temp_edata = edata[, -edata_cname_id]
)
names(mean_by_group) <- levels
mean_intensity <- do.call(cbind, mean_by_group)
plot_data <- cbind(num_missing_vals, mean_intensity)
plot_data <- as.data.frame(plot_data)
plot_data <- plot_data %>%
tidyr::pivot_longer(
-num_missing_vals,
cols_vary = "slowest",
names_to = "variable",
values_to = "value"
) %>% dplyr::mutate(
variable = factor(
variable,
levels = names(plot_data)[
-which(names(plot_data) == "num_missing_vals")
]
)
) %>% data.frame
# Start the scatter plot when the group_DF attribute is present.
p <- ggplot2::ggplot(
dplyr::filter(plot_data, !is.na(value)),
ggplot2::aes(
value,
num_missing_vals
)
) +
ggplot2::geom_point(ggplot2::aes(color = variable),
size = point_size
)
}
# Add the x, y, and title labels.
p <- p +
ggplot2::xlab(xLabelScatter) +
ggplot2::ylab(yLabelScatter) +
ggplot2::ggtitle(plotTitleScatter)
# Want the black and white theme? As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Want to be bass ackwards? As you wish.
if (coordinate_flip) p <- p + ggplot2::coord_flip()
# Add all of the theme crap now that the theme_bw crap is out of the way.
p <- p +
ggplot2::labs(color = legendLabelScatter) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Want to use beautiful non-default colors? As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_color_brewer(
palette = palette,
name = legendLabelScatter
)
}
# Want an interactive plot? As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot corRes Object
#'
#' For plotting an S3 object of type 'corRes'
#'
#' @param x An object of class "corRes" created via \code{cor_result}
#' @param omicsData an object of the class 'pepData', 'isobaricpepData',
#' 'proData', 'lipidData', 'metabData', 'nmrData' or 'seqData' created via
#' \code{\link{as.pepData}}, \code{\link{as.isobaricpepData}},
#' \code{\link{as.proData}}, \code{\link{as.lipidData}},
#' \code{\link{as.metabData}}, \code{\link{as.nmrData}}, or
#' \code{\link{as.seqData}}, respectively.
#' @param order_by A character string specifying a column in f_data by which to
#' order the samples.
#' @param x_text logical value. Indicates whether the x-axis will be labeled
#' with the sample names. The default is TRUE.
#' @param y_text logical value. Indicates whether the y-axis will be labeled
#' with the sample names. The default is TRUE.
#' @param colorbar_lim A pair of numeric values specifying the minimum and
#' maximum values to use in the heat map color bar. Defaults to 'c(NA, NA)',
#' in which case ggplot2 automatically sets the minimum and maximum values
#' based on the correlation values in the data.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 90.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param color_low character string specifying the color of the gradient for
#' low values
#' @param color_high character string specifying the color of the gradient for
#' high values
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @rdname plot-corRes
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mymetab <- edata_transform(omicsData = metab_object, data_scale = "log2")
#' mymetab <- group_designation(omicsData = mymetab, main_effects = "Phenotype")
#' my_correlation <- cor_result(omicsData = mymetab)
#' plot(my_correlation, omicsData = mymetab, order_by = "Phenotype")
#'
#' \donttest{
#' myseq_correlation <- cor_result(omicsData = rnaseq_object)
#' plot(myseq_correlation)
#' }
#'
#' @export
#'
plot.corRes <- function(x, omicsData = NULL, order_by = NULL,
colorbar_lim = c(NA, NA), x_text = TRUE,
y_text = TRUE, interactive = FALSE, x_lab = NULL,
y_lab = NULL, x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 90, title_lab = NULL,
title_lab_size = 14, legend_lab = NULL,
legend_position = "right", color_low = NULL,
color_high = NULL, bw_theme = TRUE,
use_VizSampNames = FALSE, ...) {
corRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# check for a corRes object #
if (!inherits(corRes_obj, "corRes")) {
# You will be given iocane powder due to your carelessness.
stop("corRes_obj must be of class 'corRes'")
}
if (!all(is.na(colorbar_lim))) {
if (!is.numeric(colorbar_lim) || length(colorbar_lim) != 2) {
# I can clearly not choose the arguments in front of you!
stop("colorbar_lim must be a numeric vector of length 2")
}
}
# check that omicsData is of appropriate class #
if (!is.null(omicsData)) {
if (!inherits(omicsData, c(
"pepData", "proData", "metabData",
"lipidData", "nmrData", "seqData"
))) {
stop("omicsData is not an appropriate class")
}
}
if (!is.null(order_by)) {
# Farm boy, make sure order_by exists in f_data. As you wish.
if (!order_by %in% names(omicsData$f_data)) {
# I do not think that input means what you think it means.
stop("order_by must be a column in f_data.")
}
}
# Create plot data matrix ----------------------------------------------------
# Workaround for certain "check" warnings
Var1 <- Var2 <- value <- NULL
# Nab groupDF when omicsData is available and order_by is specified. BOOM!
if (!is.null(order_by)) {
# Farm boy, extract the group_DF attribute. As you wish.
groupDF <- attr(omicsData, "group_DF")
# If order_by is not "Group" then run group designation with the specified
# variable as the main effect.
if (order_by != "Group") {
# Fish out the group_DF data frame from omicsData after creating the
# group_DF attribute with the order_by input. This will be combined with
# the plot_data object so the samples can be ordered by the main effect.
orderDF <- attr(
group_designation(omicsData = omicsData, main_effects = order_by),
"group_DF"
)
} else {
# Use the original group_DF attribute for ordering the samples. This
# occurs when order_by = "group_DF".
orderDF <- groupDF
}
# Reorder the orderDF according to the order_by input. We can subset using
# "Group" because it will always be the column we are after. If the input to
# order_by = "Group" we will use the Group column from the group_DF
# attribute from the original input. If order_by is a variable other than
# group, we will run the group_designation function and the name of this
# variable will be changed to Group.
orderDF <- orderDF[order(orderDF$Group), ]
# Save the original is_normalized attribute. This attribute is erased when
# the rows and columns are reordered based on the orderDF object. This
# attribute is needed later in the function to correctly label the plot.
normal_attr <- attr(corRes_obj, "is_normalized")
# Reorder the rows and columns of the corRes object to match the order of
# the groups in orderDF. We can hard-code the first column of orderDF
# because this will always be the column containing the sample names.
# 1. Reorder the columns of corRes_obj to match the order of orderDF.
corRes_obj <- corRes_obj[, match(orderDF[, 1], colnames(corRes_obj))]
# 2. Reorder the rows of corRes_obj to match the order of orderDF.
corRes_obj <- corRes_obj[match(orderDF[, 1], rownames(corRes_obj)), ]
# Add the lost attributes back to the corRes_obj because they are needed
# later on.
attr(corRes_obj, "is_normalized") <- normal_attr
}
# Create the data frame that will be used to produce the correlation heat map.
corRes_obj_df <- data.frame(corRes_obj, check.names = FALSE)
corRes_obj_df <- cbind(Var1 = rownames(corRes_obj_df), corRes_obj_df)
rownames(corRes_obj_df) <- 1:nrow(corRes_obj_df)
corRes_melt <- corRes_obj_df %>%
tidyr::pivot_longer(
-Var1,
names_to = "Var2",
cols_vary = "slowest"
) %>%
dplyr::mutate(
Var1 = factor(
abbreviate(Var1, minlength = 20),
levels = abbreviate(rownames(corRes_obj), minlength = 20)
),
Var2 = factor(
abbreviate(Var2, minlength = 20),
levels = abbreviate(rownames(corRes_obj), minlength = 20)
)
) %>%
data.frame(check.names = FALSE)
# Create all the plot labels. Life is pain!!!
xlabel <- if (is.null(x_lab)) "" else x_lab
ylabel <- if (is.null(y_lab)) "" else y_lab
legendLabel <- if (is.null(legend_lab)) "Correlation" else legend_lab
if (is.null(title_lab)) {
# include correlation method in title
plotTitle <- paste0(
"Correlations Among Samples (",
stringr::str_to_title(attr(corRes_obj, "cor_method")),
")"
)
# Runs when title_lab is not NULL (the user specified title).
} else {
plotTitle <- title_lab
}
# Design spectacular plots ---------------------------------------------------
# Start the skeleton of the heat map. Other aspects are forthcoming.
hm <- ggplot2::ggplot(
corRes_melt,
ggplot2::aes(
x = Var2,
y = Var1
)
) +
ggplot2::geom_tile(ggplot2::aes(fill = value))
# Farm boy, make me a plot with the black and white theme. As you wish.
if (bw_theme) hm <- hm + ggplot2::theme_bw()
# Add plot and axis labels and theme elements.
hm <- hm +
ggplot2::ggtitle(plotTitle) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position,
panel.border = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank(),
axis.line = ggplot2::element_blank(),
axis.ticks = ggplot2::element_blank()
)
# Farm boy, make me a plot with a custom correlation range. As you wish.
if (all(is.na(colorbar_lim))) {
# Use default range for the color gradient.
hm <- hm +
ggplot2::scale_fill_gradient(
legendLabel,
low = if (is.null(color_low)) "#132B43" else color_low,
high = if (is.null(color_high)) "#56B1F7" else color_high,
)
} else {
# Use the user specified range for the color gradient.
hm <- hm +
ggplot2::scale_fill_gradient(
legendLabel,
limits = colorbar_lim,
low = if (is.null(color_low)) "#132B43" else color_low,
high = if (is.null(color_high)) "#56B1F7" else color_high,
)
}
# If there are too many samples don't display the sample names on the plot.
if (nrow(corRes_obj) > 40) {
hm <- hm +
ggplot2::theme(
axis.text.x = ggplot2::element_blank(),
axis.text.y = ggplot2::element_blank()
)
}
# Farm boy, make me a plot without the x-axis sample labels. As you wish.
if (!x_text) hm <- hm + ggplot2::theme(axis.text.x = ggplot2::element_blank())
# Farm boy, make me a plot without the y-axis sample labels. As you wish.
if (!y_text) hm <- hm + ggplot2::theme(axis.text.y = ggplot2::element_blank())
# Farm boy, make me a plot with short sample names. As you wish.
if (use_VizSampNames) {
if (is.null(omicsData))
stop("If using custom sample names omicsData must not be NULL.")
hm <- hm +
ggplot2::scale_x_discrete(
labels = omicsData$f_data$VizSampNames,
breaks = levels(omicsData$f_data[, get_fdata_cname(omicsData)])
) +
ggplot2::scale_y_discrete(
labels = omicsData$f_data$VizSampNames,
breaks = levels(omicsData$f_data[, get_fdata_cname(omicsData)])
)
}
# Farm boy, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) hm <- plotly::ggplotly(hm)
return(hm)
}
#' Plot dimRes Object
#'
#' For plotting an S3 object of type 'dimRes'
#'
#' @param x object of class dimRes created by the \code{dim_reduction}
#' function
#' @param omicsData optional omicsData for use in specifying a column name in
#' fdata when using \code{color_by} or \code{shape_by}.
#' @param color_by character string specifying which column to use to control
#' the color for plotting. NULL indicates the default value of the main effect
#' levels (if present). "Group" uses the "Group" column of group_DF. NA
#' indicates no column will be used, and will use the default theme color. If
#' an omicsData object is passed, any other value will use the specified
#' column of f_data.
#' @param shape_by character string specifying which column to use to control
#' the shape for plotting. NULL indicates the default value of the second main
#' effect levels (if present). "Group" uses the "Group" column of group_DF. NA
#' indicates no column will be used, and will use the default theme shape. If
#' an omicsData object is passed, any other value will use the specified
#' column of f_data.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param point_size An integer specifying the size of the points. The default
#' is 4.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#'
#' mylipid <- edata_transform(omicsData = lipid_neg_object, data_scale = "log2")
#' mylipid <- group_designation(omicsData = mylipid, main_effects = "Virus")
#' pca_lipids <- dim_reduction(omicsData = mylipid)
#' plot(pca_lipids)
#'
#' \donttest{
#' myseq <- group_designation(omicsData = rnaseq_object, main_effects = "Virus")
#' pca_seq <- dim_reduction(omicsData = myseq)
#' plot(pca_seq)
#' }
#'
#' @rdname plot-dimRes
#'
#' @export
#'
plot.dimRes <- function (x, omicsData = NULL,
color_by = NULL, shape_by = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 0,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
point_size = 4, bw_theme = TRUE, palette = NULL, ...) {
dimRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Evan, make sure the input is the correct class. As you wish.
if (!inherits(dimRes_obj, "dimRes")) {
# Welcome to the pit of despair!
stop("dimRes_obj must be of class 'dimRes'")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
plotdata <- data.frame(SampleID = dimRes_obj$SampleID,
PC1 = dimRes_obj$PC1,
PC2 = dimRes_obj$PC2)
plotdata_name <- names(plotdata)[1]
# if there is a group designation #
if (!is.null(attr(dimRes_obj, "group_DF"))) {
group_DF <- attr(dimRes_obj, "group_DF")
fdata_cname <- names(group_DF)[1]
# if there's two main effects #
if (ncol(group_DF) == 4) {
main_eff_names <- names(group_DF[, 3:4])
# function for shortening long main effect names #
abbrev_fun <- function(string) {
if (nchar(string) > 25) string = paste0(substr(string, 1, 23), "...")
return(string)
}
# manage the length of legend titles #
display_names <- sapply(main_eff_names, abbrev_fun)
if (!identical(
as.character(plotdata[[plotdata_name]]),
as.character(group_DF[[fdata_cname]])
)) {
group_DF <- group_DF[match(
plotdata[[plotdata_name]],
group_DF[[fdata_cname]]
), ]
plotdata <- merge.data.frame(plotdata,
group_DF,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE
)
} else {
plotdata <- merge.data.frame(plotdata,
group_DF,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE
)
plotdata[[fdata_cname]] <- plotdata[[plotdata_name]]
}
color_var <- main_eff_names[1]
pch_var <- main_eff_names[2]
if (length(legend_lab) > length(main_eff_names)) {
warning(paste("legend_lab length is greater than the number of main",
"effects. Only the first two entries will be used.",
sep = " "
))
}
} else {
if (!identical(
as.character(plotdata[[plotdata_name]]),
as.character(group_DF[[fdata_cname]])
)) {
group_DF <- group_DF[match(
plotdata[[plotdata_name]],
group_DF[[fdata_cname]]
), ]
plotdata <- merge.data.frame(plotdata,
group_DF,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE
)
} else {
plotdata <- merge.data.frame(plotdata,
group_DF,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE
)
plotdata[[fdata_cname]] <- plotdata[[plotdata_name]]
}
color_var <- "Group"
pch_var <- NULL
display_names <- c("Group", NULL)
if (length(legend_lab) > 1) {
warning(paste("legend_lab length is greater than the number of main",
"effects. Only the first entry will be used.",
sep = " "
))
}
}
# Add any columns from f_data to the plotdata if present (for color_by
# and shape_by)
if (!is.null(omicsData)) {
if (is.null(omicsData$f_data)) {
stop("omicsData does not have f_data")
}
fdata_concat <- omicsData$f_data[
c(
which(colnames(omicsData$f_data) == fdata_cname),
which(!colnames(omicsData$f_data) %in% colnames(plotdata))
)
]
plotdata <- merge.data.frame(plotdata,
fdata_concat,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE)
plotdata[[fdata_cname]] <- plotdata[[plotdata_name]]
}
# Runs when there is no group information.
} else {
color_var <- NULL
pch_var <- NULL
display_names <- c(NULL, NULL)
if (!is.null(legend_lab)) {
warning("There is no group designation, so legend_lab will go unused.")
}
# Add any columns from f_data to the plotdata if present (for color_by
# and shape_by)
if (!is.null(omicsData)) {
if (is.null(omicsData$f_data)) {
stop("omicsData does not have f_data")
}
fdata_cname <- get_fdata_cname(omicsData)
fdata_concat <- omicsData$f_data[
c(
which(colnames(omicsData$f_data) == fdata_cname),
which(!colnames(omicsData$f_data) %in% colnames(plotdata))
)
]
plotdata <- merge.data.frame(plotdata,
fdata_concat,
by.x = plotdata_name,
by.y = fdata_cname,
sort = FALSE)
plotdata[[fdata_cname]] <- plotdata[[plotdata_name]]
}
}
if (!is.null(color_by)) {
if (is.na(color_by)) {
color_var <- NULL
} else if (color_by == "Group") {
color_var <- "Group"
display_names[1] <- "Group"
} else {
if(is.null(omicsData)) {
stop("color_by value is invalid. Did you mean to add an omicsData?")
}
if (!color_by %in% colnames(omicsData$f_data)) {
if (is.null(omicsData)) {
} else {
stop("color_by: column '", color_by, "' not found in f_data.")
}
}
color_var <- color_by
display_names[1] <- color_by
plotdata[[color_by]] <- as.factor(plotdata[[color_by]])
}
}
if (!is.null(shape_by)) {
if (is.na(shape_by)) {
pch_var <- NULL
} else if (shape_by == "Group") {
pch_var <- "Group"
display_names[2] <- "Group"
} else {
if(is.null(omicsData)) {
stop("shape_by value is invalid. Did you mean to add an omicsData?")
}
if (!shape_by %in% colnames(omicsData$f_data)) {
if (is.null(omicsData)) {
} else {
stop("shape_by: column '", shape_by, "' not found in f_data.")
}
}
pch_var <- shape_by
display_names[2] <- shape_by
plotdata[[shape_by]] <- as.factor(plotdata[[shape_by]])
}
}
# custom legend names #
if (!is.null(legend_lab)) {
# make the vector at least length 2 to avoid errors in the plot
display_names[1:length(legend_lab)] <- legend_lab[1:min(
2,
length(legend_lab)
)]
}
# title #
title_default <- ifelse(is.null(attr(dimRes_obj, "R2")),
"Principal Components (GLM-PCA)",
"Principal Components"
)
plot_title <- ifelse(is.null(title_lab), title_default, title_lab)
# Construct impressive plots -------------------------------------------------
# Create the bare bones plot.
p <- ggplot2::ggplot(
plotdata,
ggplot2::aes(
x = PC1,
y = PC2,
text = paste("Sample name: ", SampleID)
)
) +
ggplot2::geom_point(
ggplot2::aes(
col = if(!is.null(color_var)) .data[[color_var]] else NULL,
pch = if(!is.null(pch_var)) .data[[pch_var]] else NULL
),
size = point_size
) + ggplot2::labs(col = color_var, pch = pch_var)
# Evan, make me a plot with the black and white theme. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
if (is.null(attr(dimRes_obj, "R2"))) {
x_lab <- ifelse(is.null(x_lab), "PC1", x_lab)
y_lab <- ifelse(is.null(y_lab), "PC2", y_lab)
} else {
# Create objects for the percent variation for PC1 and PC2
pc1 <- round(attr(dimRes_obj, "R2")[1], 3)
pc2 <- round(attr(dimRes_obj, "R2")[2], 3)
# Tedious label making crap.
# These two lines don't currently work as intended. They display R^2 without
# the 2 as a superscript. However, the label cannot be created with substitute
# because it throws an error when converting to an interactive plot.
x_lab <- if (is.null(x_lab)) paste0(
"PC1 (",
expression(R^2),
" = ",
pc1,
")"
) else x_lab
y_lab <- if (is.null(y_lab)) paste0(
"PC2 (",
expression(R^2),
" = ",
pc2,
")"
) else y_lab
}
# Add labels and thematic elements.
p <- p +
ggplot2::ggtitle(plot_title) +
ggplot2::xlab(x_lab) +
ggplot2::ylab(y_lab) +
ggplot2::scale_shape_discrete(display_names[2])
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, make me a plot with dazzling colors. As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_color_brewer(
palette = palette,
name = display_names[1]
)
# Evan, make me a plot with hideous default ggplot2 colors. As you wish.
} else {
p <- p +
ggplot2::scale_color_discrete(display_names[1])
}
# Evan, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot moleculeFilt Object
#'
#' For plotting an S3 object of type 'moleculeFilt':
#'
#' @param x object of class moleculeFilt that contains the molecule
#' identifier and the number of samples for which the molecule was measured
#' (not NA)
#' @param min_num An integer specifying the minimum number of samples in which a
#' biomolecule must appear. If a value is specified, a horizontal line will be
#' drawn when \code{cumulative=TRUE}, and bars will be colored appropriately
#' if \code{cumulative=FALSE}. Defaults to NULL.
#' @param cumulative logical indicating whether the number of biomolecules
#' observed in \emph{at least} (TRUE) x number of samples or \emph{exactly}
#' (FALSE) x number of samples should be plotted. Defaults to TRUE.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param text_size integer specifying the size of the text (number of
#' biomolecules by sample) within the bar plot. The default is 3.
#' @param bar_width integer indicating the width of the bars in the bar plot.
#' The default is 0.8.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param display_count logical value. Indicates whether the missing value counts by
#' sample will be displayed on the bar plot. The default is TRUE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' data(pep_object)
#' molfilt <- molecule_filter(omicsData = pep_object)
#' plot(molfilt, min_num = 5)
#' plot(molfilt, min_num = 3, cumulative = FALSE)
#'
#' @rdname plot-moleculeFilt
#'
#' @export
#'
plot.moleculeFilt <- function(x, min_num = NULL, cumulative = TRUE,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 0, title_lab = NULL,
title_lab_size = 14, legend_lab = NULL,
legend_position = "right", text_size = 3,
bar_width = 0.8, bw_theme = TRUE,
palette = NULL, display_count = TRUE, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "moleculeFilt")) {
# Fezzik, tear his arms off.
stop("filter_object must be of class moleculeFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Forge sensational plots ----------------------------------------------------
# make counts, colors, and plot shape based on value of cumulative
# values that will be updated depending on input
fill <- 0
hline <- NULL
# create a TRUE/FALSE for if we are working with batch or not
use_batch <- attributes(filter_object)$use_batch
use_groups <- attributes(filter_object)$use_groups
if (cumulative) {
# cumulative counts (>=)
counts <- sapply(1:max(filter_object$Num_Observations), function(i) {
filter_object[filter_object$Num_Observations >= i, ]$Num_Observations %>% length()
})
# append 1 to extend last step (looks awkward without this)
counts <- c(counts, counts[length(counts)])
# 1 appended step
num_obs <- 1:(max(filter_object$Num_Observations) + 1)
# shape is a step function with fixed color
shape <- ggplot2::geom_step(
ggplot2::aes(
x = num_observations,
y = counts
),
color = "red"
)
# draw a horizontal line if min_num is specified
hline <- if (!is.null(min_num)) ggplot2::geom_hline(
yintercept = counts[min_num],
linetype = "dashed"
) else NULL
xlabel <- if (is.null(x_lab)) {
if (!use_batch & !use_groups) "Number of Samples"
else if (use_batch & !use_groups) "Number of Samples per Batch"
else if (!use_batch & use_groups) "Number of Samples per Group"
else "Number of Samples per Batch per Group"
}
ylabel <- ifelse(is.null(y_lab), "Count of Biomolecules", y_lab)
plot_title <- if (is.null(title_lab)) {
if (!use_batch & !use_groups) "Count of biomolecules observed in at least X number of samples"
else if (use_batch & !use_groups) "Minimum count of biomolecules observed in at least X number of samples per batch"
else if (!use_batch & use_groups) "Minimum count of biomolecules observed in at least X number of samples per group"
else "Minimum count of biomolecules observed in at least X number of samples per batch per group"
} else
title_lab
} else if (!cumulative) {
# counts for a specific number of nonmissing biomolecules (==)
counts <- sapply(1:max(filter_object$Num_Observations), function(i) {
filter_object[filter_object$Num_Observations == i, ]$Num_Observations %>%
length()
})
# color by which values are kept if min_num is specified
if (!is.null(min_num)) {
fill <- ifelse(1:max(filter_object$Num_Observations) >= min_num,
"retained",
"dropped"
)
shape <- ggplot2::geom_bar(
ggplot2::aes(
x = num_observations,
y = counts,
fill = fill
),
stat = "identity",
width = bar_width
)
} else {
# Check if palette is NULL or not. Hopefully it isn't so the plot will be
# created with colors other than the super hideous default ggplot2 colors.
if (!is.null(palette)) {
# Create a color from the color brewer package if a palette is provided.
colas <- RColorBrewer::brewer.pal(5, palette)
}
# Create an object for the first default ggplot2 color.
hideous <- grDevices::hcl(
h = 15,
c = 100,
l = 65
)
shape <- ggplot2::geom_bar(
ggplot2::aes(
x = num_observations,
y = counts
),
fill = if (is.null(palette))
hideous else
colas[[3]],
stat = "identity",
width = bar_width
)
}
num_obs <- 1:max(filter_object$Num_Observations)
xlabel <- if (is.null(x_lab)) "Number of samples" else x_lab
ylabel <- ifelse(is.null(y_lab), "Count of Biomolecules", y_lab)
plot_title <- ifelse(
is.null(title_lab),
"Count of biomolecules observed in exactly X number of samples",
title_lab
)
}
# create plotting dataframe
pep_observation_counts <- data.frame(
num_observations = num_obs,
frequency_counts = counts,
fill = fill
)
# plot #
p <- ggplot2::ggplot(pep_observation_counts) +
shape +
hline +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::ggtitle(plot_title) +
ggplot2::scale_x_continuous(breaks = max(filter_object$Num_Observations):1)
# Evan, make me a plot with the black and white theme. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Evan, display the biomolecule counts on the graph. As you wish.
if (display_count) p <- p + ggplot2::geom_text(
data = pep_observation_counts[1:max(filter_object$Num_Observations), ],
ggplot2::aes(
x = num_observations,
y = frequency_counts,
label = frequency_counts
),
vjust = -0.5,
nudge_x = ifelse(cumulative, 0.5, 0),
size = text_size
)
# Add the theme elements to the plot.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = ifelse(use_batch | use_groups, 11, title_lab_size)),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, make me a plot with beautiful colors. As you wish.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_fill_brewer(
palette = palette,
name = legend_lab
)
} else {
p <- p + ggplot2::scale_fill_manual(
name = legend_lab,
values = c(
"dropped" = "red",
"retained" = "green"
)
)
}
# Evan, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot totalCountFilt Object
#'
#' For plotting an S3 object of type 'totalCountFilt':
#'
#' @param x object of class totalCountFilt that contains the molecule
#' identifier and the number of total counts for which the molecule was measured
#' (not NA).
#' @param min_count integer specifying the minimum number of samples in which a
#' biomolecule must appear. Defaults to NULL.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param text_size integer specifying the size of the text (number of
#' biomolecules by sample) within the bar plot. The default is 3.
#' @param bar_width integer indicating the width of the bars in the bar plot.
#' The default is 0.8.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' \donttest{
#' library(pmartRdata)
#' seqfilt <- total_count_filter(omicsData = rnaseq_object)
#' plot(seqfilt, min_count = 15)
#' }
#'
#' @rdname plot-totalCountFilt
#'
#' @export
#'
plot.totalCountFilt <- function(x, min_count = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 0, title_lab = NULL,
title_lab_size = 14, legend_lab = "",
legend_position = "right", text_size = 3,
bar_width = 0.8, bw_theme = TRUE,
palette = NULL, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "totalCountFilt")) {
# Fezzik, tear his arms off.
stop("filter_object must be of class totalCountFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
## Checks for min_count as single numeric
if (!is.null(min_count) &&
(length(min_count) > 1 ||
!is.numeric(min_count))) stop("min_count must be numeric of length 1")
# Forge sensational plots ----------------------------------------------------
plot_data <- attr(filter_object, "e_data_lcpm")
title_default <- "Observation Density by LCPM"
if (!is.null(min_count)) {
biomols <- filter_object[[1]][filter_object$Total_Counts >= min_count]
if (length(biomols) == 0) stop(
"min_count exceeds maximum total count (",
max(filter_object$Total_Counts), ")"
)
plot_data <- plot_data[plot_data[[1]] %in% biomols, ]
subtitle <- paste0(min_count, "+ total counts per transcript")
} else subtitle <- NULL
xlabel <- if (is.null(x_lab)) "Log Counts per Million" else x_lab
ylabel <- ifelse(is.null(y_lab), "Observation Density", y_lab)
plot_title <- ifelse(
is.null(title_lab),
title_default,
title_lab
)
# Use the ColorBrewer color
values <- if (!is.null(palette)) {
c(
"Samples" = RColorBrewer::brewer.pal(5, palette)[[3]],
"Average Density" = RColorBrewer::brewer.pal(5, palette)[[5]]
)
} else {
c("Samples" = "grey", "Average Density" = "black")
}
# Plot
p <- ggplot2::ggplot(plot_data, ggplot2::aes(x = lcpm)) +
ggplot2::geom_density(ggplot2::aes(
group = !!dplyr::sym(colnames(plot_data)[2]),
color = !!dplyr::sym(colnames(plot_data)[2])
)) +
ggplot2::geom_density(ggplot2::aes(color = "Average Density")) +
ggplot2::scale_color_manual(
name = legend_lab,
values = values,
aesthetics = c("color")
) +
ggplot2::labs(
title = plot_title,
subtitle = subtitle,
x = xlabel, y = ylabel
)
# Evan, make me a plot with the black and white theme. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Add the theme elements to the plot.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot RNAFilt Object
#'
#' For plotting an S3 object of type 'RNAFilt'
#'
#' @param x object of class RNAFilt that contains the sample
#' identifier, library size, number of non-zero biomolecules, and proportion
#' of non-zero biomolecules
#' @param plot_type character string, specified as "library" or "biomolecule".
#' "library" displays library size for each sample, "biomolecule" displays the
#' number of unique biomolecules with non-zero counts per sample.
#' @param min_nonzero integer or float between 0 and 1. Cut-off for number of
#' unique biomolecules with non-zero counts or as a proportion of total
#' biomolecules. Defaults to NULL.
#' @param size_library integer cut-off for sample library size (i.e. number
#' of reads). Defaults to NULL.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param text_size An integer specifying the size of the text (number of
#' biomolecules by sample) within the bar plot. The default is 3.
#' @param bar_width An integer indicating the width of the bars in the bar plot.
#' The default is 0.8.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' seqfilt <- RNA_filter(omicsData = rnaseq_object)
#' plot(seqfilt)
#'
#' @rdname plot-RNAFilt
#'
#' @export
#'
plot.RNAFilt <- function(x, plot_type = "library",
size_library = NULL, min_nonzero = NULL,
interactive = FALSE,
x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 90, title_lab = NULL,
title_lab_size = 14, legend_lab = "",
legend_position = "right", text_size = 3,
bar_width = 0.8, bw_theme = TRUE,
palette = NULL, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "RNAFilt")) {
# Fezzik, tear his arms off.
stop("filter_object must be of class RNAFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
## Checks for plot_type as single string
if (is.null(plot_type) ||
length(plot_type) > 1 ||
!(plot_type %in% c('library', 'biomolecule'))) stop(
"plot_type must be either 'library' or 'biomolecule'"
)
## Checks for size_library as single integer
if (!is.null(size_library) &&
(length(size_library) > 1 ||
size_library %% 1 != 0 ||
size_library > max(filter_object$LibrarySize)
)
) stop(
paste0(
"size_library must be integer of length 1 less than max library size (",
max(filter_object$LibrarySize),
")"
)
)
## Checks for min_nonzero as single numeric
if (!is.null(min_nonzero)) {
## Length
if (length(min_nonzero) > 1) stop("min_nonzero must be length 1")
## proportion or int
if (!(min_nonzero %% 1 == 0 || (min_nonzero > 0 && min_nonzero < 1))) stop(
"min_nonzero must be integer or numeric between 0 and 1."
)
## Within appropriate bounds
if (min_nonzero %% 1 == 0 && min_nonzero > max(filter_object$NonZero)) stop(
paste0(
"min_nonzero exceeds maximum number of non-zero biomolecules (",
max(filter_object$NonZero),
")"
)
)
if (min_nonzero %% 1 != 0 &&
min_nonzero > max(filter_object$ProportionNonZero)) stop(
paste0(
"min_nonzero exceeds maximum proportion of non-zero biomolecules (",
signif(max(filter_object$ProportionNonZero)),
")"
)
)
}
# Forge sensational plots ----------------------------------------------------
## Set labels
xlabel <- if (is.null(x_lab)) "SampleID" else x_lab
plot_title <- ifelse(is.null(title_lab), "Library Size by Sample", title_lab)
if (plot_type == "library") {
ylabel <- ifelse(is.null(y_lab), "Library Size (Total Reads)", y_lab)
} else {
ylabel <- ifelse(is.null(y_lab), "N Non-zero Biomolecules", y_lab)
}
subtitle <- ""
if (!is.null(min_nonzero)) {
subtitle <- paste0(
subtitle,
ifelse(min_nonzero %% 1 == 0,
paste0("At least ", min_nonzero, " non-zero biomolecules"),
paste0("At least ", min_nonzero * 100, "% non-zero biomolecules")
)
)
}
if (!is.null(size_library)) {
subtitle <- paste0(
subtitle,
ifelse(subtitle == "",
"",
"\n"
),
paste0("At least ", size_library, " reads in sample library")
)
}
# Use the ColorBrewer color
values <- if (!is.null(palette)) {
RColorBrewer::brewer.pal(5, palette)[2, 4]
} else {
c(Keep = "deepskyblue3", Remove = "tomato")
}
temp_obj <- filter_object
temp_obj$keep_nz <- T
temp_obj$keep_sz <- T
if (!is.null(min_nonzero)) {
column_use <- ifelse(min_nonzero %% 1 == 0,
"NonZero", "ProportionNonZero"
)
temp_obj$keep_nz <- temp_obj[[column_use]] >= min_nonzero
}
if (!is.null(size_library)) {
temp_obj$keep_sz <- temp_obj[["LibrarySize"]] >= size_library
}
temp_obj$color <- as.character(Reduce("&", list(temp_obj$keep_nz, temp_obj$keep_sz)))
temp_obj$color <- gsub("FALSE", "Remove", gsub("TRUE", "Keep", temp_obj$color))
# Plot
if (plot_type == "library") {
p <- ggplot2::ggplot(
temp_obj, ggplot2::aes(x = !!dplyr::sym(colnames(temp_obj)[1]), y = LibrarySize, fill = color)
) +
ggplot2::geom_col(show.legend = F) +
ggplot2::scale_fill_manual(
name = legend_lab,
values = values,
aesthetics = c("fill")
) +
ggplot2::labs(
title = plot_title,
subtitle = subtitle,
x = xlabel, y = ylabel
)
if (!is.null(size_library)) {
p <- p + ggplot2::geom_segment(
y = size_library, yend = size_library,
xend = length(unique(temp_obj[[colnames(temp_obj)[1]]])) + .5,
x = 0, linetype = "dashed"
)
}
} else {
mt <- round(filter_object$NonZero[[1]] / filter_object$ProportionNonZero[[1]])
p <- ggplot2::ggplot(
temp_obj, ggplot2::aes(x = !!dplyr::sym(colnames(temp_obj)[1]), y = NonZero, fill = color)
) +
ggplot2::scale_y_continuous(
sec.axis = ggplot2::sec_axis(
trans = ~ . / mt,
name = "Proportion of all biomolecules"
)
) +
ggplot2::geom_col(show.legend = F) +
ggplot2::scale_fill_manual(
name = legend_lab,
values = values,
aesthetics = c("fill")
) +
ggplot2::labs(
title = plot_title,
subtitle = subtitle,
x = xlabel, y = ylabel
)
if (!is.null(min_nonzero)) {
p <- p + ggplot2::geom_segment(
y = min_nonzero, yend = min_nonzero,
xend = length(unique(temp_obj[[colnames(temp_obj)[1]]])) + .5,
x = 0, linetype = "dashed"
)
}
}
# Evan, make me a plot with the black and white theme. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Add the theme elements to the plot.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot imdanovaFilt Object
#'
#' For plotting an S3 object of type 'imdanovaFilt'
#'
#' @param x Object of class imdanovaFilt (also a data frame) containing
#' the molecule identifier and number of samples in each group with
#' non-missing values for that molecule
#' @param min_nonmiss_gtest An integer indicating the minimum number of
#' non-missing feature values allowed per group for \code{gtest_filter}.
#' Suggested value is 3.
#' @param min_nonmiss_anova An integer indicating the minimum number of
#' non-missing feature values allowed per group for \code{anova_filter}.
#' Suggested value is 2.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param point_size integer specifying the size of the points. The default
#' is 3.
#' @param line_size integer specifying the thickness of the line. The default
#' is 0.75.
#' @param text_size integer specifying the size of the text (number of
#' biomolecules per group). The default is 3.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param display_count logical value. Indicates whether the missing value counts by
#' sample will be displayed on the bar plot. The default is TRUE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' data(pep_object)
#' mypep <- group_designation(omicsData = pep_object, main_effects = "Phenotype")
#' to_filter <- imdanova_filter(omicsData = mypep)
#' plot(to_filter, min_nonmiss_anova = 2, min_nonmiss_gtest = 3)
#'
#' @rdname plot-imdanovaFilt
#'
#' @export
#'
plot.imdanovaFilt <- function(x, min_nonmiss_anova = NULL,
min_nonmiss_gtest = NULL, interactive = FALSE,
x_lab = NULL, y_lab = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = 0,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
point_size = 3, line_size = 0.75, text_size = 3,
bw_theme = TRUE, palette = NULL,
display_count = TRUE, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "imdanovaFilt")) {
# You used the wrong input for filter_object. Savvy?
stop("filter_object must be of class imdanovaFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Nab group size minimum that is not a singleton
group_sizes <- attr(filter_object, "group_sizes")$n_group
group_sizes_valid <- group_sizes[group_sizes > 1]
max_x <- min(group_sizes_valid)
obs <- as.data.frame(filter_object)[-1]
# Count number of groups in each row of the obs data frame that have > 0, > 1,
# ..., > max_x non-missing values. For ANOVA we need at least two groups that
# meet this criteria unless the data are paired and there are no main effects.
n_biomolecules_anova <- purrr::map_int(0:max_x, function(num) {
# Number of groups greater than num
n_greater_obs <- apply(obs, 1, function(row) sum(!(row < num)))
# If there are no main effects we need to count differently (in this case we
# do not need at least two groups to run ANOVA).
if ("paired_diff" %in% names(obs)) {
# biomolecules with 1+ group > num
n_greater_obs <- sum(apply(obs, 1, function(row) any(!(row < num))))
} else {
# Biomolecules with 2+ group > num.
sum(n_greater_obs > 1)
}
})
# Count number of groups in each row of the obs data frame that have > 0, > 1,
# ..., > max_x non-missing values. For G-Test we need at least one group that
# meets this criteria.
n_biomolecules_gtest <- purrr::map_int(0:max_x, function(num) {
# biomolecules with 1+ group > num
n_greater_obs <- sum(apply(obs, 1, function(row) any(!(row < num))))
})
# ANOVA table
plotter1 <- data.frame(
Min_obs = c(0:max_x),
Count_biomolecules = c(n_biomolecules_anova),
Statistic = c(rep("Within 2+ groups (ANOVA)", length(0:max_x)))
)
# G-test table
plotter2 <- data.frame(
Min_obs = c(0:max_x),
Count_biomolecules = c(n_biomolecules_gtest),
Statistic = c(rep("Within 1+ groups (G-Test)", length(0:max_x)))
)
# Evan, get me the colors of my choosing. As you wish.
if (!is.null(palette)) colas <- RColorBrewer::brewer.pal(5, palette)
# More monotonous label making code.
xlabel <- if (is.null(x_lab)) "Number of biomolecules" else x_lab
ylabel <- if (is.null(y_lab))
"Minimum number of observations per group" else
y_lab
titleLabel <- if (is.null(title_lab)) "IMD-ANOVA filter" else title_lab
# Fabricate glorious plots ---------------------------------------------------
# Construct the ggplot skeleton.
p <- ggplot2::ggplot() +
ggplot2::xlim(0, ceiling(max(n_biomolecules_gtest) * 1.25)) +
ggplot2::ylim(0, max_x)
# Evan, make the background black and white. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Evan, add title and axis labels. As you wish.
p <- p +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::ggtitle(titleLabel)
# Evan, add the gtest points to the plot. As you wish.
p <- p +
ggplot2::geom_point(
data = plotter2,
ggplot2::aes(
x = Count_biomolecules,
y = Min_obs,
color = Statistic
),
size = point_size
)
# Evan, display the counts on the plot. As you wish.
if (display_count) p <- p +
ggplot2::geom_text(
data = plotter2,
ggplot2::aes(
x = Count_biomolecules,
y = Min_obs,
label = Count_biomolecules
),
size = text_size,
hjust = -0.5
)
# Evan, add the anova points to the plot. As you wish.
p <- p +
ggplot2::geom_point(
data = plotter1,
ggplot2::aes(
x = Count_biomolecules,
y = Min_obs,
color = Statistic
),
size = point_size
)
# Evan, display the counts on the plot. As you wish.
if (display_count) p <- p +
ggplot2::geom_text(
data = plotter1,
ggplot2::aes(
x = Count_biomolecules,
y = Min_obs,
label = Count_biomolecules
),
size = text_size,
hjust = -0.5
)
# Evan, add gtest threshold to the plot. As you wish.
if (!is.null(min_nonmiss_gtest)) {
# Evan, add a vertical line for the gtest threshold. As you wish.
p <- p +
ggplot2::geom_hline(
ggplot2::aes(
yintercept = min_nonmiss_gtest,
color = "G-test applied filter"
),
linetype = "dashed",
linewidth = if (is.null(line_size)) 1 else line_size
)
}
# Evan, add anova threshold to the plot. As you wish.
if (!is.null(min_nonmiss_anova)) {
# Evan, add a vertical line for the anova threshold. As you wish.
p <- p +
ggplot2::geom_hline(
ggplot2::aes(
yintercept = min_nonmiss_anova,
color = "ANOVA applied filter"
),
linetype = "dotted",
size = if (is.null(line_size)) 1 else line_size
)
}
# Evan, add a custom legend according to anova and gtest inputs. As you wish.
# A minimum for gtest IS supplied and a minimum for anova IS NOT supplied.
if (!is.null(min_nonmiss_gtest) && is.null(min_nonmiss_anova)) {
# Add a customized legend when min_nonmiss_gtest is not NULL and
# min_nonmiss_anova is NULL.
p <- p +
ggplot2::scale_color_manual(
name = if (is.null(legend_lab)) "" else legend_lab,
values = c(
`Within 1+ groups (G-Test)` = if (is.null(palette))
"#FFC107" else
colas[[2]],
`G-test applied filter` = if (is.null(palette))
"#FFC107" else
colas[[2]],
`Within 2+ groups (ANOVA)` = if (is.null(palette))
"#004D40" else
colas[[3]]
),
breaks = c(
plotter2$Statistic[[1]], "G-test applied filter",
plotter1$Statistic[[1]], "ANOVA applied filter"
),
guide = ggplot2::guide_legend(
override.aes = list(
linetype = c(0, 2, 0),
shape = c(16, NA, 16),
color = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]]
)
)
)
)
} else if (is.null(min_nonmiss_gtest) && !is.null(min_nonmiss_anova)) {
# Add a customized legend when min_nonmiss_gtest is NULL and
# min_nonmiss_anova is not NULL.
p <- p +
ggplot2::scale_color_manual(
name = if (is.null(legend_lab)) "" else legend_lab,
values = c(
`Within 1+ groups (G-Test)` = if (is.null(palette))
"#FFC107" else
colas[[2]],
`Within 2+ groups (ANOVA)` = if (is.null(palette))
"#004D40" else
colas[[3]],
`ANOVA applied filter` = if (is.null(palette))
"#004D40" else
colas[[3]]
),
breaks = c(
plotter2$Statistic[[1]], "G-test applied filter",
plotter1$Statistic[[1]], "ANOVA applied filter"
),
guide = ggplot2::guide_legend(
override.aes = list(
linetype = c(0, 0, 3),
shape = c(16, 16, NA),
color = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]],
if (is.null(palette)) "#004D40" else colas[[3]]
)
)
)
)
# A minimum for gtest AND anova IS supplied.
} else if (!is.null(min_nonmiss_gtest) && !is.null(min_nonmiss_anova)) {
# Add a customized legend when both min_nonmiss_gtest and min_nonmiss_anova
# are not NULL.
p <- p +
ggplot2::scale_color_manual(
name = if (is.null(legend_lab)) "" else legend_lab,
values = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]],
if (is.null(palette)) "#004D40" else colas[[3]]
),
breaks = c(
plotter2$Statistic[[1]], "G-test applied filter",
plotter1$Statistic[[1]], "ANOVA applied filter"
),
guide = ggplot2::guide_legend(
override.aes = list(
linetype = c(0, 2, 0, 3),
shape = c(16, NA, 16, NA),
color = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]],
if (is.null(palette)) "#004D40" else colas[[3]]
)
)
)
)
# Neither a minimum for gtest nor anova is supplied.
} else {
# Add a customized legend when both min_nonmiss_gtest and min_nonmiss_anova
# are NULL.
p <- p +
ggplot2::scale_color_manual(
name = if (is.null(legend_lab)) "" else legend_lab,
values = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]]
),
guide = ggplot2::guide_legend(
override.aes = list(
shape = c(16, 16),
color = c(
if (is.null(palette)) "#FFC107" else colas[[2]],
if (is.null(palette)) "#004D40" else colas[[3]]
)
)
)
)
}
# Evan, add thematic elements to the plot. As you wish.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
}
#' Plot proteomicsFilt Object
#'
#' For plotting an S3 object of type 'proteomicsFilt':
#'
#' @param x object of class proteomicsFilt, which is a list with two
#' elements. The first element is a data frame of counts for each unique
#' peptide. The second element is a data frame with the counts for the number
#' of peptides that map to each unique protein.
#' @param plot_type character string specifying the type of plot to be
#' displayed. The available options are "num_peps" or "redundancy". If
#' "num_peps" the plot is displayed that shows the counts of proteins that
#' have a specific number of peptides mapping to them. If "redundancy" the
#' plot showing the counts of peptides that map to a specific number of
#' proteins is displayed.
#' @param min_num_peps an optional integer value between 1 and the maximum
#' number of peptides that map to a protein in the data. The value specifies
#' the minimum number of peptides that must map to a protein. Any protein with
#' less than \code{min_num_peps} mapping to it will be returned as a protein
#' that should be filtered. Default value is NULL.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab_pep character string used for the x-axis label for the
#' num_peps plot. The default is NULL in which case the default x-axis label
#' will be used.
#' @param x_lab_pro character string used for the x-axis label for the
#' redundancy plot. The default is NULL in which case the default x-axis label
#' will be used.
#' @param y_lab_pep character string used for the y-axis label for the
#' num_peps plot. The default is NULL in which case the default y-axis label
#' will be used.
#' @param y_lab_pro character string used for the y-axis label for the
#' redundancy plot. The default is NULL in which case the default y-axis label
#' will be used.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab_pep character string specifying the num_peps plot title.
#' The default is NULL in which case the default title will be used.
#' @param title_lab_pro character string specifying the redundancy plot title.
#' The default is NULL in which case the default title will be used.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param text_size An integer specifying the size of the text (number of
#' peptides or proteins depending on the plot) within the bar plot. The
#' default is 3.
#' @param bar_width An integer indicating the width of the bars in the bar plot.
#' The default is 0.8.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param display_count logical value. Indicates whether the peptide or protein counts
#' will be displayed on the bar plot. The default is TRUE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' data(pep_object)
#' my_filter <- proteomics_filter(omicsData = pep_object)
#' plot(my_filter, min_num_peps = 3)
#' plot(my_filter, plot_type = "redundancy")
#'
#' @rdname plot-proteomicsFilt
#'
#' @export
#'
plot.proteomicsFilt <- function(x,
plot_type = "num_peps",
min_num_peps = NULL,
interactive = FALSE, x_lab_pep = NULL,
x_lab_pro = NULL, y_lab_pep = NULL,
y_lab_pro = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = 0,
title_lab_pep = NULL, title_lab_pro = NULL,
title_lab_size = 14, legend_lab = NULL,
legend_position = "right", text_size = 3,
bar_width = 0.8, bw_theme = TRUE,
palette = NULL, display_count = TRUE,
...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "proteomicsFilt")) {
# The filter object is the wrong class. Savvy?
stop("filter_object must be of class proteomicsFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Error Checks
if (!is.null(min_num_peps)) {
# check that min_num_peps is numeric and >=1 #
if (!inherits(min_num_peps, "numeric") || min_num_peps < 1)
stop("min_num_peps must be an integer greater than or equal to 1")
# check that min_num_peps is an integer #
if (min_num_peps %% 1 != 0)
stop("min_num_peps must be an integer greater than or equal to 1")
# check that min_num_peps is of length 1 #
if (length(min_num_peps) != 1)
stop("min_num_peps must be of length 1")
# check that min_num_peps is less than the total number of peptides #
if (min_num_peps > max(filter_object$counts_by_pro$n))
stop(paste("min_num_peps cannot be greater than the maximum number of",
"peptides that map to a protein.",
sep = " "
))
}
if (!plot_type %in% c("num_peps", "redundancy")) {
stop("plot_type must be either 'num_peps' or 'redundancy'.")
}
# Seize unique values for peptide to protein and protein to peptide counts:
# These bins represent the number of PROTEINS each peptide maps to. Unless
# there are degenerate peptides this will be a vector with one value: 1.
pep_bins <- sort(unique(filter_object$counts_by_pep$n))
# These bins represent the number of PEPTIDES each protein maps to.
pro_bins <- sort(unique(filter_object$counts_by_pro$n))
# get counts of peptides that are mapped to by EXACTLY the number of
# proteins given in pep_bins
pep_counts <- sapply(pep_bins, function(x) {
filter_object$counts_by_pep[filter_object$counts_by_pep$n == x, ] %>% nrow()
})
# get counts of proteins that are mapped to by EXACTLY the number of
# peptides given in pro_bins
pro_counts <- sapply(pro_bins, function(x) {
filter_object$counts_by_pro[filter_object$counts_by_pro$n == x, ] %>% nrow()
})
# fill value and fill labels that will be given real values if certain
# arguments are supplied.
fill <- 0
fill_format <- NULL
# Mind numbing label making bit.
xlabel_pep <- if (is.null(x_lab_pep))
"Number of Proteins" else
x_lab_pep
ylabel_pep <- if (is.null(y_lab_pep)) "Count of Peptides" else y_lab_pep
titleLabelPep <- if (is.null(title_lab_pep))
"Y peptides map to exactly X proteins" else
title_lab_pep
xlabel_pro <- if (is.null(x_lab_pro))
"Number of Peptides" else
x_lab_pro
ylabel_pro <- if (is.null(y_lab_pro)) "Count of Proteins" else y_lab_pro
titleLabelPro <- if (is.null(title_lab_pro))
"Y proteins mapped to by exactly X peptides" else
title_lab_pro
# create plotting dataframe
pro_counts_df <- data.frame(
counts = pro_counts,
bins = pro_bins
)
pep_counts_df <- data.frame(
counts = pep_counts,
bins = pep_bins
)
# Manufacture phenomenal plots -----------------------------------------------
# !#!#!#! p represents the protein plot (num_peps) #!#!#!#!
# !#!#!#! q represents the pepe plot (redundancy) #!#!#!#!
# Create the bare bones protein and peptide plots.
p <- ggplot2::ggplot(pro_counts_df)
q <- ggplot2::ggplot(pep_counts_df)
# Create an object for the first default ggplot2 color.
hideous <- grDevices::hcl(
h = 15,
c = 100,
l = 65
)
# Check if palette is NULL or not. Hopefully it isn't so the plot will be
# created with colors other than the super hideous default ggplot2 colors.
if (!is.null(palette)) {
# Create a color from the color brewer package if a palette is provided.
# This color will be used if the plot only has one color. For example, when
# redundancy is selected or if num_peps is selected but
# min_num_peps is not specified.
colas <- RColorBrewer::brewer.pal(5, palette)
}
# If min_num_peps is specified, add a coloring variable that shows whether a
# peptide will be retained or dropped based on the input provided.
if (!is.null(min_num_peps)) {
fill <- ifelse(pro_bins >= min_num_peps, "retained", "dropped")
# Add the fill column in pro_counts_df to reflect the retained and
# dropped proteins.
pro_counts_df$fill <- fill
# We change bins to a factor so the x-axis tick labels are the value in bins
# but the width of the bars and x-axis does not change according to the
# numeric value of bins.
p <- p +
ggplot2::geom_bar(
ggplot2::aes(
x = as.factor(bins),
y = counts,
fill = fill
),
stat = "identity",
width = bar_width
)
# Creates bar charts when there is only one group (all bars will have the
# same color). These bar charts are created when min_num_peps is NOT
# specified. Color palettes must be defined here because there are no groups
# to fill by later in the script (when color palettes are defined for bar
# charts with groups).
} else {
# We change bins to a factor so the x-axis tick labels are the value in bins
# but the width of the bars and x-axis does not change according to the
# numeric value of bins.
p <- p +
ggplot2::geom_bar(
ggplot2::aes(
x = as.factor(bins),
y = counts
),
fill = if (is.null(palette))
hideous else
colas[[3]],
stat = "identity",
width = bar_width
)
}
# Evan, deal with all the issues when we ask you to make seemingly small
# changes to functions. AS YOU WISH.
# The q plot (redundant plot) has to be created outside the if else statement
# above because this plot does not change based on the input to min_num_peps.
# I tried to be smooth and leave the function mostly the same and add changes
# to the q plot together with the p plot when min_num_peps is specified.
# However, that turned out to be a nightmare. This attempt better work without
# any issues. Maybe I was too wishful: This attempt better not have the same
# completely ridiculous and unsolvable errors as the last attempt.
q <- q +
ggplot2::geom_bar(
ggplot2::aes(
x = as.factor(bins),
y = counts
),
fill = if (is.null(palette)) hideous else colas[[3]],
stat = "identity",
width = bar_width
)
# Evan, add plot labels for me. As you wish.
p <- p +
ggplot2::xlab(xlabel_pro) +
ggplot2::ylab(ylabel_pro) +
ggplot2::ggtitle(titleLabelPro)
q <- q +
ggplot2::xlab(xlabel_pep) +
ggplot2::ylab(ylabel_pep) +
ggplot2::ggtitle(titleLabelPep)
# Evan, make the plot theme black and white. As you wish.
if (bw_theme) {
p <- p + ggplot2::theme_bw()
q <- q + ggplot2::theme_bw()
}
# Evan, make me a plot with beautiful colors. As you wish.
# NOTE: This code only changes colors if not all bars will have the same color
# in the num_peps plot. If a plot has bars with all the same color, the
# coloring (according to whether palette was specified) was taken care of
# previously.
if (!is.null(palette)) {
# Use the ColorBrewer color and create the legend title
p <- p +
ggplot2::scale_fill_brewer(
palette = palette,
name = legend_lab
)
} else {
p <- p + ggplot2::scale_fill_manual(
name = legend_lab,
values = c(
"dropped" = "red",
"retained" = "green"
)
)
}
# Evan, add the protein counts to the plot. As you wish.
if (display_count) p <- p + ggplot2::geom_text(
data = pro_counts_df,
ggplot2::aes(
x = as.factor(bins),
y = counts,
label = counts
),
vjust = -0.5,
size = text_size
)
# Create generic theme settings.
axs <- ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
legend.position = legend_position
)
# Evan, add thematic elements to the plot. As you wish.
p <- p + axs
q <- q + axs
# Evan, just display the num_peps plot. As you wish.
if (plot_type == "num_peps") {
# Evan, make me an interactive num_peps plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
return(p)
# Evan, just display the redundancy plot. As you wish.
} else if (plot_type == "redundancy") {
# Evan, make me an interactive redundancy plot. As you wish.
if (interactive && requirePlotly()) q <- plotly::ggplotly(q)
return(q)
}
}
#' Plot rmdFilt Object
#'
#' For plotting an S3 object of type 'rmdFilt'
#'
#' @param x object of class rmdFilt created via \code{\link{rmd_filter}}
#' @param pvalue_threshold numeric threshold for the Robust Mahalanobis Distance (RMD)
#' p-value. If \code{sampleID} is NULL (see \code{sampleID} below), a
#' horizontal line is plotted at the RMD value that corresponds with the
#' threshold, and all samples above the line have a p-value below the
#' threshold. If \code{sampleID} is not NULL, \code{pvalue_threshold} will do
#' nothing. Default value is NULL.
#' @param sampleID character vector specifying the sample names to be plotted.
#' If specified, the plot function produces a boxplot instead of a
#' scatterplot. A point, colored by sample, will be placed on each boxplot for
#' that sample's value for the given metric. The default value is NULL.
#' @param order_by character string specifying a variable by which to order
#' the samples in the plot. This variable must be found in the column names of
#' fdata from the rmdFilt object. If \code{order_by} is "Group", the plot will
#' be ordered by the group variable from the group_designation function. If
#' NULL (default), the samples will be displayed in the order in which they
#' first appear.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 90.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param point_size An integer specifying the size of the points. The default
#' is 3.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mymetab <- edata_transform(omicsData = metab_object, data_scale = "log2")
#' mymetab <- group_designation(omicsData = mymetab, main_effects = "Phenotype")
#' rmd_results <- rmd_filter(omicsData = mymetab, metrics = c("MAD", "Skewness", "Correlation"))
#' plot(rmd_results, pvalue_threshold = 0.0001, order_by = "Phenotype")
#'
#' @rdname plot-rmdFilt
#'
#' @export
#'
plot.rmdFilt <- function(x, pvalue_threshold = NULL, sampleID = NULL,
order_by = NULL, interactive = FALSE, x_lab = NULL,
y_lab = NULL, x_lab_size = 11, y_lab_size = 11,
x_lab_angle = 90, title_lab = NULL,
title_lab_size = 14, legend_lab = NULL,
legend_position = "right", point_size = 3,
bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Have a looksie at the class of the filter object.
if (!inherits(filter_object, "rmdFilt")) {
# The filter object is the wrong class. Savvy?
stop("filter_object must be of class rmdFilt")
}
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# Check if order_by is present. If it is additional checks need to be
# performed to make sure it is a valid input.
if (!is.null(order_by)) {
# Make sure order_by is either "Group" or is in f_data.
if (order_by != "Group" &&
!(order_by %in% names(attr(filter_object, "fdata")))) {
# Your plot is only mostly dead! There is still a slim hope that you can
# save it.
stop(paste("order_by must either be 'Group' or the name of a column",
"from f_data.",
sep = " "
))
}
}
# Have a looksie at the sampleID argument.
if (!is.null(sampleID)) {
# Make sure the sample IDs provided actually exist.
if (!all(sampleID %in% attr(filter_object, "sample_names")))
stop("The sample IDs provided do not match the sample IDs in the data.")
}
samp_id <- names(attr(filter_object, "group_DF"))[1]
metrics <- attributes(filter_object)$metrics
# determine how to melt based on the number of main effects
group_df <- attributes(filter_object)$group_DF
# determine the main effects, then melt the df #
if (ncol(group_df) == 2) {
main_eff_names <- "Group"
dfmelt <- filter_object %>%
tidyr::pivot_longer(
-dplyr::all_of(c(!!samp_id, !!main_eff_names)),
names_to = "variable",
cols_vary = "slowest"
) %>% data.frame
} else if (ncol(group_df) > 2) {
## put main effect with more levels first, for plotting aesthetics ##
temp <- droplevels(group_df[, -(1:2)])
numlevels <- sapply(1:2, function(j) length(levels(as.factor(temp[, j]))))
main_eff_names <- names(temp)[order(numlevels, decreasing = TRUE)]
dfmelt <- tidyr::pivot_longer(
filter_object[, -2],
-dplyr::all_of(c(!!samp_id, !!main_eff_names)),
names_to = "variable",
cols_vary = "slowest"
) %>% data.frame
}
# Data frame that has information to create rmd box plots.
dfsub <- dfmelt[dfmelt$variable %in% metrics, ]
# legend labels #
## function for shortening long main effect names ##
abbrev_fun <- function(string) {
if (nchar(string) > 25) string = paste0(substr(string, 1, 23), "...")
return(string)
}
# Shorten the names of the main effects (if they are over 25 characters). This
# vector will have more than one element if there is more than one main
# effect.
display_names <- sapply(main_eff_names, abbrev_fun)
# Create the title for the legend that describes differences by color.
legend_title_color <- ifelse(is.null(legend_lab),
display_names[1],
legend_lab[1]
)
# Initialize the title for the legend that describes differences by point
# shape to NULL. It will only be used if there is more than one main effect.
legend_title_shape <- NULL
# Use the legend label (if it is provided in the input) for the legend
# describing the differences by point shape. The user must specify a legend
# label with more than one element. It is not created within the function.
if (length(display_names) > 1) {
if (length(legend_lab) > 1) {
legend_title_shape <- legend_lab[2]
} else {
legend_title_shape <- display_names[2]
}
}
# Assemble captivating plots -------------------------------------------------
# Order the samples according to the order_argument. If order_by is not
# provided order the samples according to the order they appear in the filter
# object.
if (!is.null(order_by)) {
if (order_by == "Group") {
# Order the samples by the Group column from group_DF.
filter_object[[samp_id]] <- factor(
filter_object[[samp_id]],
levels = filter_object[[samp_id]][order(attr(
filter_object,
"group_DF"
)$Group)],
ordered = TRUE
)
} else {
# Order the samples by the specified column from f_data.
filter_object[[samp_id]] <- factor(
filter_object[[samp_id]],
levels = filter_object[[samp_id]][order(attr(
filter_object,
"fdata"
)[[order_by]])],
ordered = TRUE
)
}
} else {
# Order the data in the order the samples appear in the samp_id column.
filter_object[[samp_id]] <- factor(
filter_object[[samp_id]],
levels = unique(filter_object[[samp_id]]),
)
}
# Beautiful box plots ---------------
# Check is sampleID is NULL. Generate box plots if it is not NULL.
if (!is.null(sampleID)) {
levels(dfsub$variable)[levels(dfsub$variable) == "Fraction_Missing"] <-
"Prop_missing"
plot_title <- ifelse(is.null(title_lab),
"Summary of RMD metrics used",
title_lab
)
xlabel <- ifelse(is.null(x_lab), " ", x_lab)
ylabel <- ifelse(is.null(y_lab), "Value", y_lab)
p <- ggplot2::ggplot(dfsub) +
ggplot2::geom_boxplot(ggplot2::aes(
x = rep(1, length(value)),
y = value
)) +
ggplot2::facet_wrap(~variable,
scales = "free",
ncol = length(metrics)
) +
ggplot2::geom_point(
data = dfsub[dfsub[, samp_id] %in% sampleID, ],
ggplot2::aes(
x = rep(1, length(value)),
y = value,
color = !!dplyr::sym(samp_id)
),
size = point_size
) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::ggtitle(plot_title)
# Stunning scatter plots: no threshold ---------------
} else if (is.null(pvalue_threshold)) {
# Start scatter plot skeleton when there is no p-value threshold.
p <- ggplot2::ggplot(filter_object)
# Start plot when there is only one main effect.
if (length(main_eff_names) == 1) {
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
color = !!dplyr::sym(main_eff_names[1])
),
size = point_size
)
# Start plot when there are two main effects.
} else {
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
color = !!dplyr::sym(main_eff_names[1]),
shape = !!dplyr::sym(main_eff_names[2])
),
size = point_size
)
}
plot_title <- ifelse(is.null(title_lab),
"Sample Outlier Results",
title_lab
)
xlabel <- ifelse(is.null(x_lab), "Samples", x_lab)
ylabel <- ifelse(is.null(y_lab), "log2(Robust Mahalanobis Distance)", y_lab)
p <- p +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::ggtitle(plot_title) +
ggplot2::labs(
color = legend_title_color,
shape = legend_title_shape
)
# Stunning scatter plots: with threshold ---------------
} else {
# Determine which samples fall below the p-value threshold. This is a
# logical vector that will be used to find pairs that are split (one sample
# is filtered and the other is not) and to change the transparency of the
# point in the plot.
goodies_alpha <- filter_object$pvalue < pvalue_threshold
# If data are paired make sure no sample is left behind!
if (!is.null(attr(attr(filter_object, "group_DF"), "pair_id"))) {
# Find the corresponding sample(s) if one sample from a pair is below the
# p-value threshold and the other sample is not.
if (sum(goodies_alpha) > 0) {
# Snatch the sample name and pair name as they will be used in multiple
# places. It will save some typing. ... However, all the typing I just
# saved has probably been undone by writing this comment.
sample_name <- attr(filter_object, "fdata_cname")
pair_name <- attr(attr(filter_object, "group_DF"), "pair_id")
# Grab the names of filtered samples.
filtad <- as.character(filter_object[goodies_alpha, sample_name])
# !#!#!#!#!#!#!#!#!#!
# The following code checks if the samples in a pair will be split. For
# example, one sample in a pair will be filtered and another sample in
# the pair will not be filtered. If a pair is split remove ALL samples
# associated with that pair.
# !#!#!#!#!#!#!#!#!#!
# Snag the associated pair IDs for the samples that will be filtered.
filtad_pairs <- attr(filter_object, "fdata") %>%
dplyr::filter(!!dplyr::sym(sample_name) %in% filtad) %>%
dplyr::pull(!!dplyr::sym(pair_name))
# Go back to f_data and nab all the sample names corresponding to the
# pair IDs associated with the original samples that were selected for
# removal. These sample names will be used to change the point shape.
# The points that will be different are the ones corresponding to the
# samples that belong to pair where only one sample falls below the
# threshold.
filtad_too <- attr(filter_object, "fdata") %>%
dplyr::filter(!!dplyr::sym(pair_name) %in% filtad_pairs) %>%
dplyr::pull(!!dplyr::sym(sample_name)) %>%
as.character()
# Update the goodies_alpha vector to reflect the additional samples that
# will be filtered.
goodies_alpha <- filter_object[, sample_name] %in% filtad_too
# Create a vector of samples who are guilty by association. (They do not
# fall below the threshold but their partners do.)
condemned <- setdiff(filtad_too, filtad)
# Create a logical vector that will determine the point shape.
goodies_pch <- filter_object[, sample_name] %in% condemned
} else goodies_pch <- rep(FALSE, nrow(filter_object))
} else {
# The data are not paired so all points should be a solid circle.
goodies_pch <- rep(FALSE, nrow(filter_object))
}
# get y-intercept for line
df <- attributes(filter_object)$df
yint <- log(qchisq(1 - pvalue_threshold, df = df), base = 2)
# make title
if (is.null(title_lab)) {
plot_title <- "Sample Outlier Results"
subtitle <- paste("p-value threshold = ", pvalue_threshold)
} else {
plot_title <- title_lab
subtitle <- ggplot2::waiver()
}
xlabel <- ifelse(is.null(x_lab), "Samples", x_lab)
ylabel <- ifelse(is.null(y_lab), "log2(Robust Mahalanobis Distance)", y_lab)
# Start scatter plot skeleton when a p-value threshold is specified.
p <- ggplot2::ggplot(filter_object)
# Start scatter plot skeleton when a p-value threshold has been provided.
if (length(main_eff_names) == 1) {
# we need separate plots for if we have pair id or not
if (!is.null(attr(attr(filter_object, "group_DF"), "pair_id"))) {
# if !null then we need to include pair fill information
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names),
# Add a fill layer that will not affect how the plot looks. This
# layer is used to create a legend when one sample from a pair is
# an outlier but the other sample belonging to the pair is not.
fill = "Removed because paired with outlier"
),
alpha = ifelse(goodies_alpha, 1, 0.5),
size = point_size,
shape = ifelse(goodies_pch, 15, 16)
)
} else {
# if null pair id then we do not need to account for fill
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names)
),
alpha = ifelse(goodies_alpha, 1, 0.5),
size = point_size,
shape = ifelse(goodies_pch, 15, 16)
)
}
} else {
if (!is.null(attr(attr(filter_object, "group_DF"), "pair_id"))) {
# if !null then we need to include pair fill information
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names[1]),
shape = !!dplyr::sym(main_eff_names[2]),
# Add a fill layer that will not affect how the plot looks. This
# layer is used to create a legend when one sample from a pair is
# an outlier but the other sample belonging to the pair is not.
fill = "Removed because paired with outlier"
),
alpha = ifelse(goodies_alpha, 1, 0.5),
# Make guilty-by-association points really small because we will
# plot a square point over them with the next lines of code. We
# don't want the edges of a circle or triangle peeking out from
# behind a square. That would make a hideous and confusing plot if
# that happened.
size = ifelse(goodies_pch, 0, point_size)
) +
# Add another layer of points with guilty-by-association samples
# plotted as a square.
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names[1])
),
size = ifelse(goodies_pch, point_size, 0),
shape = ifelse(goodies_pch, 15, 16)
)
} else {
# if null pair id then we do not need to account for fill
p <- p +
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names[1]),
shape = !!dplyr::sym(main_eff_names[2])
),
alpha = ifelse(goodies_alpha, 1, 0.5),
# Make guilty-by-association points really small because we will
# plot a square point over them with the next lines of code. We
# don't want the edges of a circle or triangle peeking out from
# behind a square. That would make a hideous and confusing plot if
# that happened.
size = ifelse(goodies_pch, 0, point_size)
) +
# Add another layer of points with guilty-by-association samples
# plotted as a square.
ggplot2::geom_point(
ggplot2::aes(
x = !!dplyr::sym(samp_id),
y = Log2.md,
col = !!dplyr::sym(main_eff_names[1])
),
size = ifelse(goodies_pch, point_size, 0),
shape = ifelse(goodies_pch, 15, 16)
)
}
}
# Add title, axis labels, and other crap.
p <- p +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::ggtitle(plot_title,
subtitle = subtitle
) +
ggplot2::geom_hline(yintercept = yint) +
ggplot2::guides(
color = ggplot2::guide_legend(ncol = 1),
shape = ggplot2::guide_legend(ncol = 1)
) +
ggplot2::labs(
color = legend_title_color,
shape = legend_title_shape
)
# Add a manual legend that describes the shape of the points that are
# removed because they belong to a pair with one sample being an outlier.
if (sum(goodies_pch > 0)) {
p <- p +
ggplot2::scale_fill_manual(
name = NULL,
values = 1,
breaks = "Removed because paired with outlier",
guide = ggplot2::guide_legend(
override.aes = list(
linetype = 0,
shape = 15,
color = "black"
)
)
)
}
}
# Farm boy, make me a plot with beautiful colors. As you wish.
if (!is.null(palette)) p <- p +
ggplot2::scale_color_brewer(
name = legend_title_color,
palette = palette
)
# Farm boy, create thematic elements for the plot. As you wish.
mytheme <- ggplot2::theme(
axis.ticks.x = ggplot2::element_blank(),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
plot.title = ggplot2::element_text(size = title_lab_size),
plot.subtitle = ggplot2::element_text(face = 'italic'),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
legend.position = legend_position
)
# Farm boy, remove useless box plot x-axis labels. As you wish.
if (!is.null(sampleID)) {
mytheme <- mytheme +
ggplot2::theme(axis.text.x = ggplot2::element_blank())
}
# Farm boy, add the black and white theme to the plot. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
# Farm boy, add the thematic elements you created to the plot. As you wish.
p <- p + mytheme
# Farm boy, use my custom sample names in the plot. As you wish.
if (use_VizSampNames) {
# Change the sample names of the scatter plot.
p <- p +
ggplot2::scale_x_discrete(labels = attr(filter_object, "VizSampNames"))
# We only want to change the legend if the box plots are created.
if (!is.null(sampleID)) {
# Nab the indices of the samples that will be highlighted in the box
# plots.
idx <- which(attr(filter_object, "sample_names") %in% sampleID)
# Change the names in the legend of the box plots.
p <- p +
ggplot2::scale_color_hue(
labels = attr(filter_object, "VizSampNames")[idx]
)
}
}
# Farm boy, remove the default legend(s) if the data are paired and there are
# no main effects. As you wish.
# If there are no main effects do not print a legend.
if ("paired_diff" %in% attr(filter_object, "group_DF")$Group) {
# Remove the color legend. This legend is automatically created because we
# specified a variable to color by in aes().
p <- p +
ggplot2::guides(color = "none")
}
# Farm boy, make the plot interactive. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
# Farm boy, return the plot so the entire world can enjoy it. As you wish.
return(p)
}
#' Plot cvFilt Object
#'
#' For plotting an S3 object of type 'cvFilt'
#'
#' @param x object of class cvFilt generated via
#' \code{\link{cv_filter}}
#' @param cv_threshold numeric value for cv threshold above which to remove the
#' corresponding biomolecules
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param log_scale logical value. Indicates whether to use a log2 transformed x-axis.
#' The default is TRUE.
#' @param n_bins integer value specifying the number of bins to draw in the
#' histogram. The default is 30.
#' @param n_breaks integer value specifying the number of breaks to use. You
#' may get less breaks if rounding causes certain values to become non-unique.
#' The default is 15.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' data(pep_object)
#' mypep <- group_designation(
#' omicsData = pep_object,
#' main_effects = "Phenotype"
#' )
#'
#' cvfilt <- cv_filter(omicsData = mypep)
#'
#' plot(cvfilt, cv_threshold = 20)
#' plot(cvfilt, cv_threshold = 10, log_scale = FALSE)
#'
#' @rdname plot-cvFilt
#'
#' @export
#'
plot.cvFilt <- function(x, cv_threshold = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 0,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
log_scale = TRUE, n_breaks = 15, n_bins = 30,
bw_theme = TRUE, palette = NULL, ...) {
filter_object <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# checks for cv_threshold if not null
if (!is.null(cv_threshold)) {
# check that cv_threshold is numeric
if (!is.numeric(cv_threshold))
stop("cv_threshold must be numeric of length 1")
# chack that cv_threshold is of length 1
if (length(cv_threshold) > 1)
stop("cv_threshold must be numeric of length 1")
# check that cv_threshold is more than 1 and less than max CV value
if (cv_threshold <= 1 || cv_threshold >= max(filter_object$CV, na.rm = TRUE))
stop("cv_threshold must be greater than 1 and less than the max CV value")
}
if (!is.logical(log_scale)) stop("log_scale must be logical: TRUE or FALSE")
if (!(n_breaks %% 1 == 0)) stop("n_breaks must be integer valued")
if (!(n_bins %% 1 == 0)) stop("n_bins must be integer valued")
# Make sure palette is one of the RColorBrewer options if it is not NULL.
if (!is.null(palette)) {
if (!(palette %in% c(
"YlOrRd", "YlOrBr", "YlGnBu", "YlGn", "Reds", "RdPu",
"Purples", "PuRd", "PuBuGn", "PuBu", "OrRd", "Oranges",
"Greys", "Greens", "GnBu", "BuPu", "BuGn", "Blues",
"Set3", "Set2", "Set1", "Pastel2", "Pastel1", "Paired",
"Dark2", "Accent", "Spectral", "RdYlGn", "RdYlBu",
"RdGy", "RdBu", "PuOr", "PRGn", "PiYG", "BrBG"
))) {
# INCONCEIVABLE!!!
stop("palette must be an RColorBrewer palette")
}
}
# plotting object
new_object <- filter_object[!is.na(filter_object$CV), ]
max_x_val <- attributes(filter_object)$max_x_val
# Check if any CV values are zero. If there are any zero values the log_scale
# input must be changed to FALSE.
if (any(new_object$CV == 0)) {
log_scale <- FALSE
message(paste("Because there are CV values = 0 the x-axis cannot be",
"converted to the log2 scale.",
"The original scale will be used.",
sep = " "
))
}
# labels
plot_title <- ifelse(is.null(title_lab),
"Coefficient of Variation (CV)",
title_lab
)
ylabel <- ifelse(is.null(y_lab), "Count", y_lab)
# Label x-axis according to whether group_designation() was run.
if (is.null(x_lab)) {
xlabel <- if (attributes(filter_object)$pooled) "Pooled CV" else "CV"
}
### Store ggplot2 layers
# scale transform and breaks depending on x-axis scale
if (log_scale) {
trans <- "log2"
i <- log2(min(new_object$CV, na.rm = TRUE))
breaks <- 0
# define a step value that is evenly spaced in the log2 scale
step = (max(log2(new_object$CV), na.rm = TRUE) -
min(log2(new_object$CV), na.rm = TRUE)) / n_breaks
# create the normal scale labels that will be log2 transformed when passed
# to ggplot
while (2^i < max(new_object$CV, na.rm = TRUE)) {
breaks <- c(breaks, 2^i)
i <- i + step
}
# rounding for plot purposes
breaks <- round(breaks, 2)
} else {
breaks <- scales::pretty_breaks(n = n_breaks)
trans <- "identity"
}
# change default title and draw a vertical line if cv_thresh specified
if (!is.null(cv_threshold)) {
if (is.null(title_lab)) {
plot_title <- bquote(paste(
"Coefficient of Variation (CV): ",
italic(paste(
"CV Threshold = ",
.(cv_threshold)
)),
""
))
}
cutoff <- ggplot2::geom_vline(xintercept = cv_threshold)
} else {
cutoff <- NULL
}
# Make magnificent plots -----------------------------------------------------
# Farm boy, start the plot for me. As you wish.
p <- ggplot2::ggplot(new_object)
# Check if palette is NULL or not. Hopefully it isn't so the plot will be
# created with colors other than the super hideous default ggplot2 colors.
if (!is.null(palette)) {
# Farm boy, make colors to replace the default color. As you wish.
colas <- RColorBrewer::brewer.pal(5, palette)
# Farm boy, add the beautiful color to the histogram. As you wish.
p <- p +
ggplot2::geom_histogram(ggplot2::aes(x = CV),
bins = n_bins,
fill = colas[[3]]
)
# Runs when palette is NULL.
} else {
# Farm boy, make the histogram with default colors. As you wish.
p <- p +
ggplot2::geom_histogram(ggplot2::aes(x = CV),
bins = n_bins
)
}
# Farm boy, add the cutoff and make the histogram pretty. As you wish.
p <- p +
cutoff +
ggplot2::scale_x_continuous(
breaks = breaks,
trans = trans
) +
ggplot2::scale_y_continuous(breaks = scales::pretty_breaks(n = 5))
# Farm boy, add labels to the plot. As you wish.
p <- p +
ggplot2::ggtitle(plot_title) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel)
# Farm boy, make the plot black and white. As you wish.
if (bw_theme) p <- p + ggplot2::theme_bw()
# Farm boy, add thematic elements to the plot. As you wish.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1)
)
# Farm boy, send my plot into the world. As you wish.
return(p)
}
#' Plot customFilt Object
#'
#' Currently plotting a customFilt object is not supported
#'
#' @param x An object of class customFilt.
#' @param ... further arguments passed to or from other methods.
#'
#' @return No return value, implemented to provide information to user.
#'
#' @rdname plot-customFilt
#'
#' @export
#'
plot.customFilt <- function(x, ...) {
message(paste("There is no plot method for objects of class 'customFilt'.",
"See summary.customFilt instead.",
sep = " "
))
}
#' Plot normRes Object
#'
#' For plotting an S3 object of type 'normRes'
#'
#' @param x normRes object created by the normalize_global function
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mymetab <- edata_transform(
#' omicsData = metab_object,
#' data_scale = "log2"
#' )
#' mymetab <- group_designation(
#' omicsData = mymetab,
#' main_effects = "Phenotype"
#' )
#' norm_object <- normalize_global(
#' omicsData = mymetab,
#' subset_fn = "all",
#' norm_fn = "median"
#' )
#' plot(norm_object, order_by = "Phenotype", color_by = "Phenotype")
#'
#' @rdname plot-normRes
#'
#' @export
#'
plot.normRes <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
normRes_obj <- x
# Preliminaries --------------------------------------------------------------
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Create the raw and normalized omicsData objects.
omicsRaw <- attr(normRes_obj, "omicsData")
# e_data will be updated after applying the normalization.
omicsNorm <- attr(normRes_obj, "omicsData")
# Extricate the ID column index.
id_col <- which(names(omicsRaw$e_data) == get_edata_cname(omicsRaw))
# Apply normalization depending on the location, scale, and backtransform
# values.
if (is.null(normRes_obj$parameters$normalization$scale)) {
# Normalize with just the location parameter (no backtransform). There isn't
# a section where backtransform is TRUE because the normalize_global
# function will not calculate backtransform parameters if the data are not
# normalized.
omicsNorm$e_data[, -id_col] <- (
omicsNorm$e_data[, -id_col] -
rep(normRes_obj$parameters$normalization$location,
each = nrow(omicsNorm$e_data)
)
)
# Backtransmute if there is a location backtransform parameter.
if (!is.null(normRes_obj$parameters$backtransform$location)) {
omicsNorm$e_data[, -id_col] <- (
omicsNorm$e_data[, -id_col] +
normRes_obj$parameters$backtransform$location
)
}
} else {
# Normalize with the location and scale parameters (no backtransform). There
# isn't a section where backtransform is TRUE because the normalize_global
# function will not calculate backtransform parameters if the data are not
# normalized.
omicsNorm$e_data[, -id_col] <- (
omicsNorm$e_data[, -id_col] -
rep(normRes_obj$parameters$normalization$location,
each = nrow(omicsNorm$e_data)
) /
rep(normRes_obj$parameters$normalization$scale,
each = nrow(omicsNorm$e_data)
)
)
# Backtransmute if there are location and scale backtransform parameters.
if (!is.null(normRes_obj$parameters$backtransform$location) &&
!is.null(normRes_obj$parameters$backtransform$scale)) {
omicsNorm$e_data[, -id_col] <- (
omicsNorm$e_data[, -id_col] *
normRes_obj$parameters$backtransform$scale +
normRes_obj$parameters$backtransform$location
)
}
}
# Update the norm_info element of the data_info attribute for the omicsNorm
# object.
attributes(omicsNorm)$data_info$norm_info$is_normalized <- TRUE
# Generate majestic plots ----------------------------------------------------
# Farm boy, make me a plot with a raw object. As you wish.
p_raw <- plot_omicsData(
omicsData = omicsRaw, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab,
title_lab_size = title_lab_size,
legend_lab = legend_lab,
legend_position = legend_position, ylimit = ylimit,
bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
# Farm boy, make me a plot with a normalized object. As you wish.
p_norm <- plot_omicsData(
omicsData = omicsNorm, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab,
x_lab_size = x_lab_size, y_lab_size = y_lab_size,
x_lab_angle = x_lab_angle, title_lab = title_lab,
title_lab_size = title_lab_size,
legend_lab = legend_lab,
legend_position = legend_position, ylimit = ylimit,
bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
# Farm boy, combine the plots and send them into the world. As you wish.
if (interactive && requirePlotly()) {
# Return the interactive plots side-by-side.
plotly::subplot(p_raw, p_norm, nrows = 1)
} else {
# Return the regular plots side-by-side.
p_raw + p_norm
}
}
#' Plot isobaricpepData Object
#'
#' For plotting isobaricpepData S3 objects
#'
#' @param x An isobaricpepData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true") & requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' myiso <- edata_transform(omicsData = isobaric_object, data_scale = "log2")
#' plot(myiso)
#'
#' @rdname plot-isobaricpepData
#'
#' @export
#'
plot.isobaricpepData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL,
y_lab = NULL, x_lab_size = 11,
y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE,
palette = NULL, use_VizSampNames = FALSE,
...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with an isobaricpepData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
#' Plot lipidData Object
#'
#' For plotting lipidData S3 objects
#'
#' @param x lipidData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mylipid <- edata_transform(omicsData = lipid_pos_object, data_scale = "log2")
#' plot(mylipid, order_by = "Virus", color_by = "Virus")
#'
#' @rdname plot-lipidData
#'
#' @export
#'
plot.lipidData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a lipidData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
#' Plot metabData Object
#'
#' For plotting metabData S3 objects
#'
#' @param x metabData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mymetab <- edata_transform(omicsData = metab_object, data_scale = "log2")
#' plot(mymetab, order_by = "Phenotype", color_by = "Phenotype")
#'
#' @rdname plot-metabData
#'
#' @export
#'
plot.metabData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a metabData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
#' Plot nmrData Object
#'
#' For plotting nmrData S3 objects
#'
#' @param x nmrData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols An optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit A numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' mynmr <- edata_transform(omicsData = nmr_identified_object, data_scale = "log2")
#' plot(mynmr)
#'
#' @rdname plot-nmrData
#'
#' @export
#'
plot.nmrData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a nmrData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
#' Plot seqData Object
#'
#' For plotting seqData S3 objects
#'
#' @param x seqData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param transformation character string. String of length 1 defining a
#' transformation for visualizing count data. Valid options are 'lcpm',
#' 'upper', and 'median'. 'lcpm' - For each column: scale column intensities by
#' (total column sum/1 million), then log2 transform. 'median' - For each
#' column: scale column intensities by median column intensities, then
#' back-transform to original scale. 'upper' - For each column: scale column
#' intensities by 75th quantile column intensities, then back-transform to
#' original scale. For 'median' and 'upper' options, all zeros are converted
#' to NAs.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true") & requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' plot(rnaseq_object, transformation = "lcpm")
#'
#' @rdname plot-seqData
#'
#' @export
#'
plot.seqData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, transformation = NULL,
...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a seqData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames,
transformation = transformation
)
}
#' Plot pepData Object
#'
#' For plotting pepData S3 objects
#'
#' @param x pepData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols An optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true") & requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' data(pep_object)
#' mypep <- edata_transform(omicsData = pep_object, data_scale = "log2")
#' plot(mypep, order_by = "Phenotype", color_by = "Phenotype")
#'
#' @rdname plot-pepData
#'
#' @export
#'
plot.pepData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a pepData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
#' Plot proData Object
#'
#' For plotting proData S3 objects
#'
#' @param x proData object
#' @param order_by character string specifying the column name of f_data by
#' which to order the boxplots. If \code{order_by} is "Group", the boxplots
#' will be ordered by the group variable from the group_designation function.
#' If NULL (default), the boxplots will be displayed in the order they appear
#' in the data.
#' @param color_by character string specifying the column name of f_data by
#' which to color the boxplots. If \code{color_by} is "Group", the boxplots
#' will be colored by the group variable from the group_designation function.
#' If NULL (default), the boxplots will have one default color.
#' @param facet_by character string specifying the column name of f_data with
#' which to create a facet plot. Default value is NULL.
#' @param facet_cols optional integer specifying the number of columns to
#' show in the facet plot.
#' @param interactive logical value. If TRUE produces an interactive plot.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label. The default is
#' NULL in which case the y-axis label will be the metric selected for the
#' \code{metric} argument.
#' @param x_lab_size integer value indicating the font size for the x-axis.
#' The default is 11.
#' @param y_lab_size integer value indicating the font size for the y-axis.
#' The default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' The default is 0.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param ylimit numeric vector of length 2 specifying y-axis lower and upper
#' limits.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white theme.
#' @param palette character string indicating the name of the RColorBrewer
#' palette to use. For a list of available options see the details section in
#' \code{\link[RColorBrewer]{RColorBrewer}}.
#' @param use_VizSampNames logical value. Indicates whether to use custom sample
#' names. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @examplesIf requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' plot(pro_object, order_by = "Phenotype", color_by = "Phenotype")
#'
#' @rdname plot-proData
#'
#' @export
#'
plot.proData <- function(x, order_by = NULL, color_by = NULL,
facet_by = NULL, facet_cols = NULL,
interactive = FALSE, x_lab = NULL, y_lab = NULL,
x_lab_size = 11, y_lab_size = 11, x_lab_angle = 90,
title_lab = NULL, title_lab_size = 14,
legend_lab = NULL, legend_position = "right",
ylimit = NULL, bw_theme = TRUE, palette = NULL,
use_VizSampNames = FALSE, ...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, make me a plot with a proData object. As you wish.
plot_omicsData(
omicsData = x, order_by = order_by,
color_by = color_by, facet_by = facet_by,
facet_cols = facet_cols, interactive = interactive,
x_lab = x_lab, y_lab = y_lab, x_lab_size = x_lab_size,
y_lab_size = y_lab_size, x_lab_angle = x_lab_angle,
title_lab = title_lab, title_lab_size = title_lab_size,
legend_lab = legend_lab, legend_position = legend_position,
ylimit = ylimit, bw_theme = bw_theme, palette = palette,
use_VizSampNames = use_VizSampNames
)
}
# The function that does all the heavy lifting for the isobaricpepData,
# lipidData, metabData, nmrData, pepData, proData, and normRes plot methods.
plot_omicsData <- function(omicsData, order_by, color_by, facet_by, facet_cols,
interactive, x_lab, y_lab, x_lab_size, y_lab_size,
x_lab_angle, title_lab, title_lab_size, legend_lab,
legend_position, ylimit, bw_theme, palette,
use_VizSampNames, transformation = NULL) {
# Preliminaries --------------------------------------------------------------
# Keeping the user honest ---------------
# Farm boy, make sure the data is the correct class. As you wish.
# check that omicsData is of appropriate class #
if (!inherits(omicsData, c(
"pepData", "proData", "metabData",
"lipidData", "nmrData", "seqData"
))) {
# INCONCEIVABLE!!!
stop(paste("omicsData must be of class 'isobaricpepData', 'lipidData'",
"'metabData', 'nmrData', 'pepData', 'proData', or 'seqData'.",
sep = " "
))
}
if (inherits(omicsData, "seqData")) {
if (!is.null(transformation)) {
if (!(transformation %in% c('lcpm', 'upper', 'median'))) {
# Tell the user that the input to data_scale is an abomination!
stop(paste(transformation, "is not a valid option for 'transformation'.",
"Refer to ?seqData.plot for specific seqData options.",
sep = " "
))
}
} else {
warning(paste0(
"Using transformation argument for plotting on counts",
" is recommended for seqData visualization. See ?seqData.plot for details."
))
}
}
if (!inherits(omicsData, "seqData") && !is.null(transformation)) {
warning("Transformation agrument is only applicable for seqData -- this argument is otherwise ignored.")
}
if (!is.null(order_by)) {
if (!is.character(order_by) || length(order_by) > 1)
stop("order_by must be a character vector of length 1")
}
if (!is.null(color_by)) {
if (!is.character(color_by) || length(color_by) > 1)
stop("color_by must be a character vector of length 1")
}
if (!is.null(facet_by)) {
if (!is.character(facet_by) || length(facet_by) > 1)
stop("facet_by must be a character vector of length 1")
}
if (!is.null(facet_cols)) {
if (is.null(facet_by))
stop("facet_by cannot be NULL when facet_cols is specified")
if (length(facet_cols) > 1)
stop("facet_cols must be of length 1")
if (!is.numeric(facet_cols))
stop("facet_cols must be an integer greater than zero")
if (facet_cols %% 1 != 0 || facet_cols <= 0)
stop("facet_cols must be an integer greater than zero")
}
if (!is.null(ylimit)) {
if (!is.numeric(ylimit) || length(ylimit) != 2)
stop("ylimit must be a numeric vector of length 2")
}
# Checking for NAs ---------------
# Check for samples with all NAs and return message to user that these will
# not be plotted.
sample_nas <- colSums(is.na(omicsData$e_data))
if (any(sample_nas == nrow(omicsData$e_data))) {
empties <- names(omicsData$e_data)[which(
sample_nas == nrow(omicsData$e_data)
)]
message(paste("The following sample(s) are comprised entirely of missing",
"data and will not be included in the plot: ",
empties,
sep = " "
))
}
# Label crap ---------------
datatype_text <- switch(class(omicsData)[1],
isobaricpepData = "Isobaric Peptide ",
pepData = "Peptide ",
proData = "Protein ",
lipidData = "Lipid ",
metabData = "Metabolite ",
nmrData = "NMR ",
seqData = "Transcript "
)
norm_info <- get_data_norm(omicsData)
norm_text <- ifelse(norm_info, "Normalized ", "Un-Normalized ")
ref_info <- if (inherits(omicsData, c("isobaricpepData", "nmrData"))) {
infos <- c("isobaric_info", "nmr_info")
res <- sapply(infos, function(info) {
norm <- attr(omicsData, info)$norm_info$is_normalized
!is.null(norm) && norm
})
any(res)
} else FALSE
ref_text <- if(ref_info) "Reference Standardized " else NULL
maintitle <- paste0(
"Boxplots of ", ref_text, norm_text, datatype_text, "Data"
)
######## Is this right? This should be separate from statistical normalization? #########
# Farm boy, make me a title depending on data type and norm_info. As you wish.
# if (inherits(omicsData, "isobaricpepData")) {
# maintitle <- if (attr(omicsData, "isobaric_info")$norm_info$is_normalized)
# "Boxplots of Normalized Isobaric Peptide Data" else
# "Boxplots of Un-Normalized Isobaric Peptide Data"
# } else if(inherits(omicsData, "pepData")){
# maintitle <- if (attr(omicsData, "data_info")$norm_info$is_normalized)
# "Boxplots of Normalized Peptide Data" else
# "Boxplots of Un-Normalized Peptide Data"
# } else if(inherits(omicsData, "proData")){
# maintitle <- if (attr(omicsData, "data_info")$norm_info$is_normalized)
# "Boxplots of Normalized Protein Data" else
# "Boxplots of Un-Normalized Protein Data"
# } else if(inherits(omicsData, "lipidData")){
# maintitle <- if (attr(omicsData, "data_info")$norm_info$is_normalized)
# "Boxplots of Normalized Lipid Data" else
# "Boxplots of Un-Normalized Lipid Data"
# } else if(inherits(omicsData, "metabData")){
# maintitle <- if (attr(omicsData, "data_info")$norm_info$is_normalized)
# "Boxplots of Normalized Metabolite Data" else
# "Boxplots of Un-Normalized Metabolite Data"
# } else if(inherits(omicsData, "nmrData")){
# maintitle <- if (attr(omicsData, "nmr_info")$norm_info$is_normalized)
# "Boxplots of Normalized NMR Data" else
# "Boxplots of Un-Normalized NMR Data"
# }
# Farm boy, create an plot subtitle object. As you wish.
subtitle <- NULL
# Farm boy, fashion plot, axis, and legend title objects. As you wish.
title <- if (is.null(title_lab)) maintitle else title_lab
xlabel <- if (is.null(x_lab)) "Sample" else x_lab
ylabel <- if (is.null(y_lab)) {
# Abundance based
if (get_data_scale(omicsData) == "abundance") {
out <- "Abundance"
} else if (get_data_scale(omicsData) %in% c("log", "log2", "log10")) {
out <- paste(get_data_scale(omicsData), "Abundance", sep = " ")
} else if (get_data_scale(omicsData) == "counts") {
if (is.null(transformation)) {
out <- "Counts"
} else {
out <- switch(transformation,
lcpm = "Log Counts per Million",
upper = "Upper-quantile transformed Counts",
median = "Median Counts"
)
}
}
out
} else y_lab
legend_title <- if (is.null(legend_lab)) color_by else legend_lab
# Data crap ---------------
# Farm boy, melt the data for me. As you wish.
e_data_cname <- get_edata_cname(omicsData)
temp_data <- omicsData$e_data
iCol <- which(names(omicsData$e_data) == get_edata_cname(omicsData))
if (!is.null(transformation)) {
transform_data <- temp_data[, -iCol]
if (transformation == 'lcpm') {
## log cpm, limma voom method and a similar method used for visualizations in edgeR
## EdgeR
# First scales the prior.count/pseudo-count and adds 2x the scaled prior count to the libsize
# prior.count.scaled <- lib.size/mean(lib.size)*prior.count
# lib.size <- lib.size+2*prior.count.scaled
# lib.size <- 1e-6*lib.size
# Calculates log2 log2(t( (t(x)+prior.count.scaled) / lib.size ))
# sum library size
samp_sum <- apply(transform_data,
2,
sum,
na.rm = TRUE
) + 1
# divide adjusted (ensure non-zero) counts by library size
div_sum <- sweep((transform_data + .5), 2, samp_sum, `/`)
# Apply per million multiplier and log2
temp_data[, -iCol] <- log2(div_sum * 10^6)
} else if (transformation == 'upper') {
warning("Zeros will be regarded as NA for 'upper' transformation")
transform_data[transform_data == 0] <- NA
# Grab non-zero upper quantile of data
samp_upper <- apply(transform_data,
2,
quantile,
na.rm = TRUE,
probs = .75
)
g.q <- quantile(unlist(transform_data), probs = .75, na.rm = TRUE)
# Divide each count by the upper quantile in respective columns
div_75 <- sweep(transform_data, 2, samp_upper, `/`)
# Set new data
temp_data[, -iCol] <- div_75 * g.q # back transform
} else if (transformation == 'median') {
warning("Zeros will be regarded as NA for 'median' transformation")
transform_data[transform_data == 0] <- NA
# Grab non-zero median of data
samp_med <- apply(transform_data,
2,
median,
na.rm = TRUE
)
# Divide each count by the upper quantile in respective columns
div_med <- sweep(transform_data, 2, samp_med, `/`)
g.q <- median(unlist(transform_data), na.rm = TRUE)
# Set new data
temp_data[, -iCol] <- div_med * g.q
}
}
plot_data <- temp_data %>%
tidyr::pivot_longer(
-!!e_data_cname,
names_to = "variable",
values_drop_na = TRUE,
cols_vary = "slowest"
) %>% dplyr::mutate(
variable = factor(
variable,
levels = names(temp_data)[
-which(names(temp_data) == e_data_cname)
]
)
) %>% data.frame
# Farm boy, extract the group_DF attribute. As you wish.
# groupDF <- attr(omicsData, "group_DF")
groupDF <- get_group_DF(omicsData)
# If facet_by is not null and isn't the same as either order_by or color_by.
if (!is.null(facet_by)) {
if (!(facet_by %in% c(order_by, color_by))) {
# Extract the group_DF attribute. This will be used to facet the plots
# later in the function.
# facetDF <- attr(
# group_designation(omicsData = omicsData, main_effects = facet_by),
# "group_DF"
# )
facetDF <- get_group_DF(
group_designation(omicsData = omicsData, main_effects = facet_by)
)
# Rename the columns so they can be merged with the plot_data object and
# referred to by name when plotting.
colnames(facetDF) <- c("variable", facet_by)
plot_data <- merge(plot_data, facetDF, by = "variable")
}
}
# Check if order_by is NULL and update the plot_data object accordingly.
if (!is.null(order_by)) {
# If order_by is not "group_DF" then run group designation with the
# specified variable as the main effect.
if (order_by != "Group") {
# Select the column in f_data containing the sample name as well as the
# column corresponding to the order_by input.
orderDF <- dplyr::select(
omicsData$f_data,
!!dplyr::sym(get_fdata_cname(omicsData)),
!!dplyr::sym(order_by)
)
} else {
# Use the original group_DF attribute for ordering the samples. This
# occurs when order_by = "Group".
orderDF <- groupDF
}
# Rename the columns so they can be merged with the plot_data object and
# referred to by name when plotting.
colnames(orderDF)[1:2] <- c("variable", order_by)
# Add the variables to plot_data that will be used to order the box plots.
plot_data <- merge(plot_data, orderDF, by = "variable")
# Reorder the rows of plot_data so the box plots will be displayed in the
# correct order.
plot_data <- plot_data[order(plot_data[, order_by]), ]
plot_data$variable <- factor(plot_data$variable,
levels = unique(plot_data$variable),
ordered = TRUE
)
# Farm boy, update the subtitle object. As you wish.
subtitle <- paste('Ordered by ', order_by)
}
# Check if color_by is NULL and update plot_data accordingly.
if (!is.null(color_by)) {
# If color_by is not "group_DF" then run group designation with the
# specified variable as the main effect.
if (color_by != "Group") {
# Extricate the group_DF data frame from omicsData after creating the
# group_DF attribute with the color_by input. This will be combined with
# the plot_data object so the samples can be colored by the main effect.
# colorDF <- attr(
# group_designation(omicsData = omicsData, main_effects = color_by),
# "group_DF"
# )
colorDF <- get_group_DF(
group_designation(omicsData = omicsData, main_effects = color_by)
)
} else {
# Use the original group_DF attribute for coloring the samples. This
# occurs when color_by = "group_DF".
colorDF <- groupDF
}
# Rename the columns so they can be merged with the plot_data object and
# referred to by name when plotting.
colnames(colorDF)[1:2] <- c("variable", color_by)
# Check the status of order_by. If order_by is not NULL AND it is different
# from color_by OR if order_by is NULL AND color_by is not NULL the colorDF
# object needs to be merged with plot_data.
if ((!is.null(order_by) && order_by != color_by) ||
(is.null(order_by) && !is.null(color_by))) {
# Merge the colorDF object with plot_data so the samples can be colored
# correctly.
plot_data <- merge(plot_data, colorDF, by = "variable")
}
# Create factors to color by according to the input of color_by.
color_levels <- if (color_by != "Group")
unique(factor(omicsData$f_data[[color_by]])) else
unique(factor(attr(omicsData, "group_DF")[["Group"]]))
plot_data[[color_by]] <- factor(plot_data[[color_by]],
levels = sort(color_levels))
}
# Form awe-inspiring plots ---------------------------------------------------
# Farm boy, make the graph skeleton. As you wish.
p <- ggplot2::ggplot(plot_data)
# Farm boy, color the plots based on the input. As you wish.
if (is.null(color_by)) {
p <- p +
ggplot2::geom_boxplot(ggplot2::aes(
x = variable,
y = value
))
} else {
p <- p +
ggplot2::geom_boxplot(ggplot2::aes(
x = variable,
y = value,
fill = !!dplyr::sym(color_by)
))
}
# Farm boy, use my custom sample names in the plot. As you wish.
if (use_VizSampNames) p <- p + ggplot2::scale_x_discrete(
labels = omicsData$f_data$VizSampNames,
breaks = unique(omicsData$f_data[, get_fdata_cname(omicsData)])
)
# Farm boy, add the black and white theme to my plot. As you wish.
if (bw_theme) {
p <- p + ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
}
# Farm boy, group my plots for me. As you wish.
if (!is.null(facet_by)) {
if (is.null(facet_cols)) {
p <- p + ggplot2::facet_wrap(formula(paste("~", facet_by)),
scales = "free_x"
)
} else {
p <- p + ggplot2::facet_wrap(formula(paste("~", facet_by)),
scales = "free_x",
ncol = facet_cols
)
}
}
# Farm boy, add thematic elements to my plot. As you wish.
p <- p +
ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle, hjust = 1),
plot.subtitle = ggplot2::element_text(face = 'italic')
)
# Farm boy, add labels to my plot. As you wish.
p <- p +
ggplot2::ggtitle(title, subtitle) +
ggplot2::xlab(xlabel) +
ggplot2::ylab(ylabel) +
ggplot2::scale_color_discrete(legend_title)
# Farm boy, add limits to my plot. As you wish.
if (!is.null(ylimit)) {
p <- p + ggplot2::scale_y_continuous(limits = ylimit)
}
# Farm boy, make me a plot with beautiful colors. As you wish.
if (!is.null(palette)) p <- p +
ggplot2::scale_fill_brewer(
name = legend_title,
palette = palette
)
# Farm boy, make me an interactive plot. As you wish.
if (interactive && requirePlotly()) p <- plotly::ggplotly(p)
# Farm boy, send my plot into the world to be adored by all. As you wish.
return(p)
}
#' Plot statRes Object
#'
#' Produces plots that summarize the results contained in a `statRes` object.
#'
#' @param x `statRes` object to be plotted, usually the result of `imd_anova`
#' @param plot_type defines which plots to be produced, options are "bar",
#' "volcano", "gheatmap", "fcheatmap"; defaults to "bar". See details for
#' plot descriptions.
#' @param fc_threshold optional threshold value for fold change estimates.
#' Modifies the volcano plot as follows: Vertical lines are added at
#' (+/-)\code{fc_threshold} and all observations that have absolute fold
#' change less than \code{abs(fc_threshold)} are colored as 'non-significant'
#' (as specified by \code{fc_colors}).
#' @param fc_colors vector of length three with character color values
#' interpretable by ggplot. i.e. c("orange", "black", "blue") with the values
#' being used to color negative, non-significant, and positive fold changes
#' respectively
#' @param stacked TRUE/FALSE for whether to stack positive and negative fold
#' change sections in the barplot, defaults to TRUE
#' @param show_sig This input is used when \code{plot_type = "gheatmap"}. A
#' logical value. If TRUE a visual indicator that a certain bin combination is
#' significant by the g-test is shown.
#' @param color_low This input is used when \code{plot_type = "gheatmap"}. A
#' character string specifying the color of the gradient for low count values.
#' @param color_high This input is used when \code{plot_type = "gheatmap"}. A
#' character string specifying the color of the gradient for high count
#' values.
#' @param plotly_layout This input is used when \code{plot_type = "gheatmap"}. A
#' list of arguments, not including the plot, to be passed to
#' \code{plotly::layout} if \code{interactive = TRUE}.
#' @param interactive TRUE/FALSE for whether to create an interactive plot using
#' plotly. Not valid for all plots.
#' @param x_lab character string specifying the x-axis label.
#' @param x_lab_size integer value indicating the font size for the x-axis. The
#' default is 11.
#' @param x_lab_angle integer value indicating the angle of x-axis labels.
#' @param y_lab character string specifying the y-axis label.
#' @param y_lab_size integer value indicating the font size for the y-axis. The
#' default is 11.
#' @param title_lab character string specifying the plot title.
#' @param title_lab_size integer value indicating the font size of the plot
#' title. The default is 14.
#' @param legend_lab character string specifying the legend title.
#' @param legend_position character string specifying the position of the
#' legend. Can be one of "right", "left", "top", "bottom", or "none". The
#' default is "none".
#' @param text_size integer specifying the size of the text (number of
#' non-missing values) within the plot. The default is 3.
#' @param bw_theme logical value. If TRUE uses the ggplot2 black and white
#' theme.
#' @param display_count logical value. Indicates whether the non-missing counts
#' will be displayed on the bar plot. The default is TRUE.
#' @param custom_theme a ggplot `theme` object to be applied to non-interactive
#' plots, or those converted by plotly::ggplotly().
#' @param cluster logical for heatmaps; TRUE will cluster biomolecules on X
#' axis. defaults to TRUE for seqData statistics and FALSE for all others.
#' @param free_y_axis Logical. If TRUE the y axis for each bar plot can have its
#' own range. The default is FALSE.
#' @param ... further arguments passed to or from other methods.
#'
#' @details Plot types:
#' \itemize{
#' \item{"bar"} \code{?pmartR::statres_barplot} Bar-chart with bar heights
#' indicating the number of significant biomolecules, grouped by test type and
#' fold change direction.
#' \item{"volcano"} \code{?pmartR::statres_volcano_plot} Scatter plot showing
#' negative-log-pvalues against fold change. Colored by statistical
#' significance and fold change.
#' \item{"gheatmap"} \code{?pmartR::gtest_heatmap} Heatmap with x and y axes
#' indicating the number of nonmissing values for two groups. Colored by
#' number of biomolecules that fall into that combination of nonmissing values.
#' \item{"fcheatmap"} Heatmap showing all biomolecules across comparisons,
#' colored by fold change.
#' }
#'
#' @return ggplot2 plot object if interactive is FALSE, or plotly plot object if
#' interactive is TRUE
#'
#' @export
#' @method plot statRes
#' @examplesIf identical(tolower(Sys.getenv("NOT_CRAN")), "true") & requireNamespace("pmartRdata", quietly = TRUE)
#' library(pmartRdata)
#' # Group the data by condition
#' mypro <- group_designation(
#' omicsData = pro_object,
#' main_effects = c("Phenotype")
#' )
#'
#' # Apply the IMD ANOVA filter
#' imdanova_Filt <- imdanova_filter(omicsData = mypro)
#' mypro <- applyFilt(
#' filter_object = imdanova_Filt,
#' omicsData = mypro,
#' min_nonmiss_anova = 2
#' )
#'
#' # Implement the IMD ANOVA method and compuate all pairwise comparisons
#' # (i.e. leave the `comparisons` argument NULL)
#' anova_res <- imd_anova(omicsData = mypro, test_method = 'anova')
#' plot(anova_res)
#' plot(anova_res, plot_type = "volcano")
#'
#' imd_res <- imd_anova(omicsData = mypro, test_method = 'gtest')
#' plot(imd_res)
#'
#' imd_anova_res <- imd_anova(
#' omicsData = mypro,
#' test_method = 'comb',
#' pval_adjust_a_multcomp = 'bon',
#' pval_adjust_g_multcomp = 'bon'
#' )
#' plot(imd_anova_res, bw_theme = TRUE)
#' plot(imd_anova_res, plot_type = "volcano", bw_theme = TRUE)
#'
plot.statRes <- function(x,
plot_type = "bar",
fc_threshold = NULL,
fc_colors = c("red", "black", "green"),
stacked = TRUE,
show_sig = TRUE,
color_low = NULL,
color_high = NULL,
plotly_layout = NULL,
interactive = FALSE,
x_lab = NULL,
x_lab_size = 11,
x_lab_angle = NULL,
y_lab = NULL,
y_lab_size = 11,
title_lab = NULL,
title_lab_size = 14,
legend_lab = NULL,
legend_position = "right",
text_size = 3,
bw_theme = TRUE,
display_count = TRUE,
custom_theme = NULL,
cluster = FALSE,
free_y_axis = FALSE,
...) {
# Make sure we only have valid arguments
if (length(list(...)) > 0) {
warning("unused argument(s): ",
toString(as.list(tail(match.call(), length(list(...))))))
}
# Farm boy, fix all the problems. As you wish.
# Most plots are based on "number_significant" data frame so pull it out
comp_df <- attr(x, "number_significant")
## --------##
# Go through the given plot_types and remove any that aren't currently avilable
plt_tyj <- try(
match.arg(
tolower(plot_type),
c(
"bar",
"volcano",
"gheatmap",
"fcheatmap",
"ma"
)
),
silent = TRUE
)
if (inherits(plt_tyj, 'try-error')) {
warning(paste0(
"Plot type '",
plot_type,
"' is not currently available, defaulting to bar plot."
))
plot_type <- "bar"
} else {
plot_type <- plt_tyj
}
# Don't make biomolecule heatmaps if there's only one comparison
if (plot_type %in% c("fcheatmap") & nrow(comp_df) == 1) {
stop(paste("Fold change heatmaps not supported when only one comparison",
"is being made.",
sep = " "
))
}
if (plot_type %in% c("ma") && attr(x, "data_class") != "seqData") {
stop("MA plots are only supported for transcriptomic data.",
sep = " "
)
}
# specified theme parameters
if (!is.null(custom_theme)) {
if (bw_theme)
warning(paste("Setting both bw_theme to TRUE and specifying a custom",
"theme may cause undesirable results",
sep = " "
))
if (!inherits(custom_theme, c("theme", "gg")))
stop("custom_theme must be a valid 'theme' object as used in ggplot")
mytheme = custom_theme
} else mytheme = ggplot2::theme(
plot.title = ggplot2::element_text(size = title_lab_size),
axis.title.x = ggplot2::element_text(size = x_lab_size),
axis.title.y = ggplot2::element_text(size = y_lab_size),
axis.text.x = ggplot2::element_text(angle = x_lab_angle),
legend.position = legend_position
)
# Both the volcano plot and heatmaps need a dataframe of fold changes by
# comparison/biomolecule
if (plot_type %in% c("volcano", "gheatmap", "fcheatmap")) {
volcano <- make_volcano_plot_df(x)
}
# Bar plot -------------------------------------------------------------------
if ("bar" %in% plot_type) {
p <- statres_barplot(
x = x,
stacked = stacked,
fc_colors = fc_colors,
text_size = text_size,
display_count = display_count,
x_lab = x_lab,
y_lab = y_lab,
title_lab = title_lab,
legend_lab = legend_lab,
free_y_axis = free_y_axis
)
if (bw_theme) p <- p +
ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
return(p + mytheme)
}
# Volcano plot
else if ("volcano" %in% plot_type) {
if (!attr(x, "statistical_test") %in% c(
"anova", "combined", "EdgeR_F", "Voom_T", "DESeq_Wald", "DESeq_LRT"
)
) {
stop(paste("imd_anova must have been run with test_method = 'anova' or",
"'combined' to make the volcano plot. For seqData,",
"DE_wrapper must have been run.",
sep = " "
))
}
# still returns a ggplot, even if interactive = T
p <-
statres_volcano_plot(
volcano = volcano,
data_scale = attr(x, "data_info")$data_scale,
pval_thresh = attr(x, "pval_thresh"),
fc_colors = fc_colors,
fc_threshold = fc_threshold,
interactive = interactive,
x_lab = x_lab,
y_lab = y_lab,
title_lab = title_lab,
legend_lab = legend_lab
)
if (bw_theme) p <- p +
ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
p <- p + mytheme
if (interactive && requirePlotly())
return(plotly::ggplotly(p, tooltip = c("text"))) else
return(p)
}
# g-test heat map ------------------------------------------------------------
else if ("gheatmap" %in% plot_type) {
if (!attr(x, "statistical_test") %in% c("gtest", "combined")) {
stop(paste("imd_anova must have been run with test_method = 'gtest' or",
"'combined' to make the g-test heatmap. Not valid for seqData.",
sep = " "
))
}
p <-
gtest_heatmap(
volcano = volcano,
pval_thresh = attr(x, "pval_thresh"),
show_sig = show_sig,
interactive = interactive,
color_low = color_low,
color_high = color_high,
plotly_layout = plotly_layout,
text_size = text_size,
display_count = display_count,
x_lab = x_lab,
y_lab = y_lab,
title_lab = title_lab,
legend_lab = legend_lab
)
if (!interactive) {
p <- p + mytheme
}
}
# biomolecule fold change heatmap
else if ("fcheatmap" %in% plot_type) {
# Farm boy, do all the tedious label crap. As you wish.
the_x_label <- if (is.null(x_lab))
"Biomolecule" else
x_lab
the_y_label <- if (is.null(y_lab))
"Comparison" else
y_lab
the_title_label <- if (is.null(title_lab))
"Log Fold Change" else
title_lab
the_legend_label <- if (is.null(legend_lab))
"Fold Change" else
legend_lab
# For now just consider biomolecules significant with respect to ANOVA
volcano <- dplyr::filter(volcano, Type %in% c(
"ANOVA", "EdgeR_F",
"Voom_T", "DESeq_Wald",
"DESeq_LRT"
))
volcano_sigs <- dplyr::filter(volcano, P_value < attr(x, "pval_thresh"))
if (!(nrow(volcano_sigs)) > 0)
warning("No molecules significant at the provided p-value threshold")
colnames(volcano_sigs)[1] <- "Biomolecule"
if (cluster) {
wide <- volcano_sigs %>%
tidyr::pivot_wider(
id_cols = Biomolecule,
names_from = Comparison,
values_from = Fold_change
) %>% data.frame
wide <- wide[!is.na(wide$Biomolecule), ]
row.names(wide) <- wide$Biomolecule
dist_mat <- dist(wide[-1])
res_hclust <- hclust(dist_mat)
order_biom <- rev(res_hclust$labels[res_hclust$order])
volcano_sigs$Biomolecule <- as.character(volcano_sigs$Biomolecule)
volcano_sigs$Biomolecule <- factor(
volcano_sigs$Biomolecule,
levels = unique(paste0(order_biom, volcano_sigs$Biomolecule))
)
} else {
volcano_sigs$Biomolecule <- as.factor(volcano_sigs$Biomolecule)
}
p <- ggplot2::ggplot(
volcano_sigs,
ggplot2::aes(Biomolecule,
Comparison,
text = paste(
"ID:",
Biomolecule,
"<br>",
"Pval:",
P_value
)
)
) +
ggplot2::geom_tile(ggplot2::aes(fill = Fold_change), color = "white") +
ggplot2::scale_fill_gradient(
low = fc_colors[1],
high = fc_colors[3],
name = the_legend_label
) +
ggplot2::xlab(the_x_label) +
ggplot2::ylab(the_y_label) +
ggplot2::ggtitle(the_title_label) +
mytheme
if (interactive && requirePlotly())
return(plotly::ggplotly(p, tooltip = c("text"))) else
return(p)
} else if ("ma" %in% plot_type) {
## Color by significance
comps <- strsplit(attr(x, "comparisons"), "_vs_")
plotter <- purrr::map_dfr(1:length(comps), function(n_comp) {
label <- attr(x, "comparisons")[n_comp]
comp <- comps[[n_comp]]
mean_df <- attr(x, "MA_means")
pval <- grep(paste0("^P_value_", label), colnames(x), value = T)
v1 <- mean_df[[comp[1]]]
v2 <- mean_df[[comp[2]]]
v3 <- x[[pval]]
if (length(v1) == 0) {
v1 <- NA
v2 <- NA
v3 <- NA
}
data.frame(var1 = v1, var2 = v2, pval = v3, comp = label)
})
p <- ggplot2::ggplot(
plotter,
ggplot2::aes(
x = log2((var1 + var2) / 2),
y = log2(var1 / var2), ## where mean is 0 or na in a group, goes to Inf
color = pval < attr(x, "pval_thresh")
)
) +
ggplot2::geom_point() +
ggplot2::facet_wrap(~comp) +
ggplot2::geom_segment(
y = 0, yend = 0, linetype = "dashed", color = "red",
x = min(log2((plotter$var1 + plotter$var2) / 2), na.rm = TRUE),
xend = max(log2((plotter$var1 + plotter$var2) / 2), na.rm = TRUE)
) +
ggplot2::labs(
x = "A (Log2 Average Expression)",
y = "M (Log2 Fold change)",
color = paste("Significance < ", attr(x, "pval_thresh"))
)
if (bw_theme) p <- p +
ggplot2::theme_bw() +
ggplot2::theme(strip.background = ggplot2::element_rect(fill = "white"))
p <- p + mytheme
if (interactive && requirePlotly())
return(plotly::ggplotly(p, tooltip = c("text"))) else
return(p)
}
return(p)
}
#' Extract flag columns from a statRes object
#'
#' Changes the flags columns from a statRes object into a format that the
#' statRes plot funcitons can handle. pmartR is an unruly beast that cannot be
#' tamed!!
#'
#' @param x A statRes object.
#' @param test character string indicating the type of test run.
#'
#' @return A data frame with the sample IDs and significance flags from a statistical test.
#'
prep_flags <- function(x, test) {
if (test == "anova") {
# Assemble a data frame with the sample IDs and anova flags.
da_flag <- data.frame(
x[, 1, drop = FALSE],
x[, grep("^Flag_A_", colnames(x))],
check.names = FALSE
)
# Remove "Flag_A_" from column names. The first column name is removed
# because it corresponds to the biomolecule ID column.
colnames(da_flag)[-1] <- gsub(
"^Flag_A_",
"",
colnames(x)[grep("^Flag_A_", colnames(x))]
)
} else if (test == "gtest") {
# Throw an error at the user like Fezzik throwing rocks at the Dread Pirate
# Roberts. It doesn't make sense to create a volcano plot with Gtest flags.
# Coding would take so much less time if we didn't have to think of all the
# ways a user can mess things up.
stop("A volcano plot cannot be created with Gtest flags.")
} else if (test %in% c("EdgeR_LRT", "EdgeR_F", "Voom_T", "DESeq_Wald", "DESeq_LRT")) {
# Assemble a data frame with the sample IDs and flags.
flag_cols <- grep("^Flag_", colnames(x))
da_flag <- x[c(1, flag_cols)]
# Remove "Flag_A_" from column names. The first column name is removed
# because it corresponds to the biomolecule ID column.
colnames(da_flag)[-1] <- gsub("^Flag_", "", colnames(da_flag)[-1])
# Runs when the "combined" option was used.
} else {
# NOTE: It does not make sense to have Gtest flags present when creating a
# volcano plot. For this reason we will only use the ANOVA flags when the
# test is "combined".
# Assemble a data frame with the sample IDs and anova flags.
da_flag <- data.frame(
x[, 1, drop = FALSE],
x[, grep("^Flag_A_", colnames(x))],
check.names = FALSE
)
# Remove "Flag_A_" from column names. The first column name is removed
# because it corresponds to the biomolecule ID column.
colnames(da_flag)[-1] <- gsub(
"^Flag_A_",
"",
colnames(x)[grep("^Flag_A_", colnames(x))]
)
}
return(da_flag)
}
#' Create a plotting dataframe for volcano plots and heatmaps
#'
#' A function internal to pmartR:::\link{plot.statRes} which creates the
#' dataframe necessary to construct volcano plots and heatmaps.
#'
#' @param x `statRes` object to be plotted, usually the result of `imd_anova`
#'
#' @returns `data.frame` object with plotting information about each biomolecule
#' such as missing counts per group, and p-values for t and g-tests.
#'
#' @keywords internal
#'
make_volcano_plot_df <- function(x) {
# fold change values for volcano plot
fc_data <- x[, c(1, grep("^Fold_change", colnames(x)))]
colnames(fc_data) <-
gsub(
pattern = "^Fold_change_",
replacement = "",
x = colnames(fc_data)
)
fc_data <- fc_data %>%
tidyr::pivot_longer(
-1,
names_to = "Comparison",
values_to = "Fold_change",
cols_vary = "slowest"
) %>% data.frame
# Run the cmbn_flags function here.
# fold change flags for coloring
fc_flags <- prep_flags(
x = x,
test = attr(x, "statistical_test")
)
fc_flags <- fc_flags %>%
tidyr::pivot_longer(
-1,
names_to = "Comparison",
values_to = "Fold_change_flag",
cols_vary = "slowest"
) %>%
dplyr::mutate(
Fold_change_flag = as.character(Fold_change_flag)
) %>%
data.frame
# p values for labeling and y axis in anova volcano plot
p_data <- x[, c(1, grep("^P_value", colnames(x)))]
pvals <- p_data %>%
tidyr::pivot_longer(
-1,
names_to = "Comparison",
values_to = "P_value",
cols_vary = "slowest"
) %>% data.frame
# grouping column based on test type
if (attr(x, "statistical_test") == "combined") {
pvals$Type <- "G-test"
pvals$Type[grep(pattern = "^P_value_A_", x = pvals$Comparison)] <-
"ANOVA"
pvals$Comparison <-
gsub(
pattern = "^P_value_(G|A)_",
replacement = "",
pvals$Comparison,
perl = T
)
} else if (attr(x, "statistical_test") == "gtest") {
pvals$Type <- "G-test"
pvals$Comparison <-
gsub(
pattern = "^P_value_G_",
replacement = "",
pvals$Comparison,
perl = T
)
} else if (attr(x, "statistical_test") == "anova") {
pvals$Type <- "ANOVA"
pvals$Comparison <-
gsub(
pattern = "^P_value_A_",
replacement = "",
pvals$Comparison,
perl = T
)
} else {
pvals$Type <- attr(x, "statistical_test")
pvals$Comparison <-
gsub(
pattern = "^P_value_",
replacement = "",
pvals$Comparison,
perl = T
)
}
volcano <-
merge(merge(fc_data, pvals, all = TRUE), fc_flags, all = TRUE)
# levels of comparison now of the form 'GROUPNAME_X vs GROUPNAME_Y'
volcano$Comparison <-
gsub(
pattern = "_vs_",
replacement = " vs ",
volcano$Comparison
)
# create counts for gtest plot (number present in each group)
if (attr(x, "statistical_test") %in% c("gtest", "combined")) {
counts <-
x[c(1, grep("^Count_", colnames(x)))]
# trim column names so they are just group names
colnames(counts) <-
gsub("^Count_", replacement = "", colnames(counts))
counts_df <- data.frame()
for (comp in as.character(unique(volcano$Comparison))) {
# create a vector of the two group names being compared
groups = strsplit(comp, " vs ")[[1]]
gsize_1 = nrow(attr(x, "group_DF") %>% dplyr::filter(Group == groups[1]))
gsize_2 = nrow(attr(x, "group_DF") %>% dplyr::filter(Group == groups[2]))
# will contain ID column and count column corresponding to the two groups
temp_df <-
counts[c(
1,
which(colnames(counts) == groups[1]),
which(colnames(counts) == groups[2])
)]
temp_df$Comparison <- comp
# rename the columns to something static so they can be rbind-ed
colnames(temp_df)[which(colnames(temp_df) == groups[1])] <- "Count_First_Group"
colnames(temp_df)[which(colnames(temp_df) == groups[2])] <- "Count_Second_Group"
# store proportion of nonmissing to color g-test values in volcano plot
temp_df$Prop_First_Group <- temp_df$Count_First_Group / gsize_1
temp_df$Prop_Second_Group <- temp_df$Count_Second_Group / gsize_2
counts_df <- rbind(counts_df, temp_df)
}
# should automatically left join by ID AND Comparison
suppressWarnings(volcano <-
volcano %>% dplyr::left_join(counts_df))
}
return(volcano)
}
#' Fold change barplots for statres objects
#'
#' Plots a bar-chart with bar heights indicating the number of significant
#' biomolecules, grouped by test type and fold change direction.
#'
#' @param x,stacked,fc_colors passed from
#' \code{\link[pmartR:plot.statRes]{pmartR::plot.statRes()}}
#' @param text_size An integer specifying the size of the text (number of
#' non-missing values) within the plot. The default is 3.
#' @param display_count logical value. Indicates whether the non-missing counts will
#' be displayed on the bar plot. The default is TRUE.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label.
#' @param title_lab character string specifying the plot title.
#' @param legend_lab character string specifying the legend title.
#'
#' @return `ggplot` object - barplot.
#'
#' @keywords internal
#'
statres_barplot <- function(x,
stacked,
fc_colors,
text_size,
display_count,
x_lab,
y_lab,
title_lab,
legend_lab,
free_y_axis) {
# If free_y_axis is true then each bar plot can have its own y axis range.
if (free_y_axis) {
da_scales <- "free"
} else {
da_scales <- NULL
}
# Farm boy, do all the tedious label crap. As you wish.
the_x_label <- if (is.null(x_lab))
"Statistical test, by group comparison" else
x_lab
the_y_label <- if (is.null(y_lab))
"Count of Biomolecules" else
y_lab
the_title_label <- if (is.null(title_lab))
"Number of DE Biomolecules Between Groups" else
title_lab
the_legend_label <- if (is.null(legend_lab))
"Fold Change Sign" else
legend_lab
comp_df <- attr(x, "number_significant")
comp_df_melt <- comp_df %>%
tidyr::pivot_longer(
-Comparison,
values_to = "Count",
names_to = "Direction",
cols_vary = "slowest"
) %>% data.frame
levels(comp_df_melt$Comparison) <- gsub(
pattern = "_",
replacement = " ",
levels(comp_df_melt$Comparison)
)
# Bar plots side-by-side, both going up
# ggplot(data=comp_df_melt,aes(Comparison,Count,fill=Direction))+
# geom_bar(stat='identity',position='dodge')
## Up direction is positive, down direction is negative
if (stacked)
comp_df_melt[grep("Down", comp_df_melt$Direction), ]$Count <- (
-comp_df_melt[grep("Down", comp_df_melt$Direction), ]$Count
)
# add whichtest, and posneg columns used for plot grouping and label
# adjustment
comp_df_melt <- comp_df_melt %>%
dplyr::mutate(
whichtest = ifelse(grepl("anova", Direction),
"anova",
ifelse(grepl("gtest", Direction),
"gtest",
"total"
)
),
posneg = ifelse(grepl("Up", Direction),
"Positive",
"Negative"
)
) %>%
dplyr::arrange(desc(posneg))
# get only anova or only g-test rows if user did not specify combined
if (attr(x, "statistical_test") %in% c("anova", "gtest")) {
comp_df_melt <- comp_df_melt %>%
dplyr::filter(whichtest == "total") %>%
dplyr::mutate(whichtest = attr(x, "statistical_test"))
}
p <- ggplot2::ggplot(data = comp_df_melt, ggplot2::aes(Comparison, Count)) +
ggplot2::geom_bar(
ggplot2::aes(
x = whichtest,
fill = posneg
),
stat = 'identity',
position = if (stacked) {
ggplot2::position_identity()
} else {
ggplot2::position_dodge(0.9)
}
) +
ggplot2::geom_hline(ggplot2::aes(yintercept = 0), colour = 'gray50') +
ggplot2::scale_fill_manual(
values = c(fc_colors[1], fc_colors[3]),
labels = c("Negative", "Positive"),
name = the_legend_label
) +
ggplot2::facet_wrap(~Comparison, scales = da_scales) +
ggplot2::xlab(the_x_label) +
ggplot2::ylab(the_y_label) +
ggplot2::ggtitle(the_title_label)
# Farm boy, display the counts on the plot. As you wish
if (display_count) {
p <- p +
ggplot2::geom_text(
ggplot2::aes(
x = whichtest,
group = posneg,
label = abs(Count)
),
size = text_size,
position = if (stacked) {
ggplot2::position_identity()
} else {
ggplot2::position_dodge(0.9)
}
)
}
return(p)
}
#' Plot a heatmap for the g-test results of imd-anova
#'
#' Plots a heatmap showing bins for combinations of # of biomolecules present
#' across groups. Bins are colored by the number of biomolecules falling into
#' each bin, and have indicators for significance by g-test.
#'
#' @param volcano `data.frame` produced by pmartR:::\link{make_volcano_plot_df}
#' @param pval_thresh numeric value indicating the p-value threshold for
#' significance.
#' @param show_sig Boolean whether to show the visual indicator that a certain
#' bin combination is significant by the g-test
#' @param interactive passed from
#' \code{\link[pmartR:plot.statRes]{pmartR::plot.statRes()}}. If T, will build
#' a plotly version of the plot. Defaults to FALSE.
#' @param color_low character string specifying the color of the gradient for
#' low count values.
#' @param color_high character string specifying the color of the gradient for
#' high count values.
#' @param plotly_layout A list of arguments, not including the plot, to be
#' passed to plotly::layout if interactive = T.
#' @param text_size An integer specifying the size of the text (number of
#' non-missing values) within the plot. The default is 3.
#' @param display_count logical value. Indicates whether the non-missing counts
#' will be displayed on the bar plot. The default is TRUE.
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label.
#' @param title_lab character string specifying the plot title.
#' @param legend_lab character string specifying the legend title.
#'
#' @return `ggplot or plotly` object, depending on if \code{interactive} is set
#' to TRUE or FALSE respectively. A g-test heatmap
#'
#' @keywords internal
#'
gtest_heatmap <-
function(volcano,
pval_thresh,
show_sig,
interactive,
color_low,
color_high,
plotly_layout,
text_size,
display_count,
x_lab,
y_lab,
title_lab,
legend_lab) {
# Farm boy, do all the tedious label crap. As you wish.
the_x_label <- if (is.null(x_lab))
"Nonmissing (first group)" else
x_lab
the_y_label <- if (is.null(y_lab))
"Nonmissing (second group)" else
y_lab
the_title_label <- if (is.null(title_lab))
"Count of non-missing values in each group" else
title_lab
the_legend_label <- if (is.null(legend_lab))
"Number of biomolecules \nin this bin" else
legend_lab
temp_data_gtest <- volcano %>%
dplyr::filter(Type == "G-test") %>%
dplyr::mutate(
Fold_change_flag = dplyr::case_when(
Prop_First_Group > Prop_Second_Group &
P_value <= pval_thresh ~ "2",
Prop_First_Group < Prop_Second_Group &
P_value <= pval_thresh ~ "-2",
is.na(Fold_change) ~ "0",
TRUE ~ Fold_change_flag
)
)
# summarized data frame of # of biomolecules per count combination.
gtest_counts <- temp_data_gtest %>%
dplyr::group_by(Count_First_Group, Count_Second_Group, Comparison) %>%
dplyr::summarise(n = dplyr::n(), sig = all(P_value < 0.05)) %>%
dplyr::mutate(
Count_First_Group = as.character(Count_First_Group),
Count_Second_Group = as.character(Count_Second_Group)
)
g1_counts <- unique(as.numeric(gtest_counts$Count_First_Group))
g2_counts <- unique(as.numeric(gtest_counts$Count_Second_Group))
all_counts <- expand.grid(
as.character(g1_counts),
as.character(g2_counts),
unique(gtest_counts$Comparison),
stringsAsFactors = F
) %>%
`colnames<-`(c("Count_First_Group", "Count_Second_Group", "Comparison"))
gtest_counts <- all_counts %>% dplyr::left_join(gtest_counts) %>%
dplyr::mutate(
Count_First_Group = factor(
Count_First_Group,
levels = sort(unique(as.numeric(Count_First_Group)))
),
Count_Second_Group = factor(
Count_Second_Group,
levels = sort(unique(as.numeric(Count_Second_Group)))
)
)
if (interactive && requirePlotly()) {
comps <- unique(gtest_counts$Comparison)
subplot_list <- list()
limits = range(gtest_counts$n)
# legend entry will not appear for a single plot, so putting info in title
subtext = if (length(comps) == 1)
"\n(star indicates statistical significance)" else
""
for (i in 1:length(comps)) {
data <- gtest_counts %>% dplyr::filter(Comparison == comps[i])
p <- plotly::plot_ly() %>%
plotly::add_trace(
data = data,
x = ~ as.numeric(Count_First_Group),
y = ~ as.numeric(Count_Second_Group),
z = ~n,
type = "heatmap",
hoverinfo = 'text',
text = ~ sprintf("%s biomolecules in this bin.", n),
colors = grDevices::colorRamp(
c(
if (is.null(color_low))
"#132B43" else
color_low,
if (is.null(color_high))
"#56B1F7" else
color_high
)
),
showscale = i == length(comps),
xgap = 0.6, ygap = 0.6
) %>%
plotly::add_trace(
data = data %>% dplyr::filter(sig),
x = ~ as.numeric(Count_First_Group),
y = ~ as.numeric(Count_Second_Group),
type = 'scatter',
mode = "markers",
showlegend = i == length(comps),
name = "Statistically significant",
marker = list(
symbol = "star",
color = "white",
line = list(color = "black", width = 0.5)
),
inherit = FALSE
) %>%
plotly::add_annotations(
text = comps[[i]],
x = 0.5,
y = 1,
xref = "paper",
yref = "paper",
showarrow = FALSE,
yanchor = "bottom",
font = list(size = 14)
)
if (i == length(comps)) {
p <- p %>% plotly::colorbar(
title = "Count biomolecules \nin this bin.", limits = limits
)
}
if (is.null(plotly_layout)) {
p <- p %>%
plotly::layout(
plot_bgcolor = 'grey',
title = list(
text = paste(the_title_label, subtext),
font = list(size = 14),
y = 0.95, yanchor = "top"
),
margin = list(t = 65),
xaxis = list(tickvals = g1_counts, zeroline = F),
yaxis = list(tickvals = g2_counts, zeroline = F)
)
} else {
p <- do.call(plotly::layout, c(list(p), plotly_layout))
}
subplot_list[[length(subplot_list) + 1]] <- p
}
p <- plotly::subplot(subplot_list, shareY = TRUE) %>%
plotly::layout(
xaxis = list(title = the_x_label),
yaxis = list(title = the_y_label)
)
} else {
p <- ggplot2::ggplot(gtest_counts) +
ggplot2::theme_minimal() +
ggplot2::geom_tile(
ggplot2::aes(Count_First_Group,
Count_Second_Group,
fill = n
),
color = "black"
)
if(show_sig) {
sig_data <- gtest_counts %>% dplyr::filter(sig)
if(nrow(sig_data) > 0) {
p <- p + ggplot2::geom_point(
data = sig_data,
ggplot2::aes(Count_First_Group, Count_Second_Group, shape = "1"),
fill = "white"
) +
ggplot2::scale_shape_manual(name = "Statistically significant",
labels = "",
values = 21)
}
}
if (display_count) {
p <- p + ggplot2::geom_text(
ggplot2::aes(Count_First_Group, Count_Second_Group, label = n),
nudge_x = -0.5, nudge_y = 0.5, hjust = -0.1, vjust = 1.5,
color = "white", size = text_size
)
}
p <- p +
ggplot2::facet_wrap(~Comparison) +
ggplot2::scale_fill_gradient(
name = the_legend_label,
low = if (is.null(color_low)) "#132B43" else color_low,
high = if (is.null(color_high)) "#56B1F7" else color_high
) +
ggplot2::xlab(the_x_label) +
ggplot2::ylab(the_y_label) +
ggplot2::ggtitle(the_title_label)
}
return(p)
}
#' Volcano plot for the anova results of imd-anova
#'
#' Plots a volcano plot showing negative log10 p-values on the y axis and fold
#' change on the x axis. Each point is colored by fold change direction and
#' whether or not it was significant by ANOVA.
#'
#' @param volcano data frame produced by pmartR:::\link{make_volcano_plot_df}
#' @param pval_thresh numeric value between 0 and 1 for the alpha level to
#' determine significance. Any values that are significant at this level will
#' be colored based on fc_colors.
#' @param data_scale One of c("log2","log","log10"), for labeling purposes.
#' @param fc_colors,fc_threshold,interactive passed from
#' \code{\link[pmartR:plot.statRes]{pmartR::plot.statRes()}}
#' @param x_lab character string specifying the x-axis label.
#' @param y_lab character string specifying the y-axis label.
#' @param title_lab character string specifying the plot title.
#' @param legend_lab character string specifying the legend title.
#'
#' @return `ggplot` object. A volcano plot.
#'
#' @keywords internal
#'
statres_volcano_plot <-
function(volcano,
data_scale,
pval_thresh,
fc_colors,
fc_threshold,
interactive,
x_lab,
y_lab,
title_lab,
legend_lab) {
# Farm boy, do all the tedious label crap. As you wish.
the_x_label <- if (is.null(x_lab))
paste("Fold-change (", data_scale, ")", sep = "") else
x_lab
the_y_label <- if (is.null(y_lab))
"-log[10](p-value)" else
y_lab
the_title_label <- if (is.null(title_lab))
"" else
title_lab
the_legend_label <- if (is.null(legend_lab))
"Fold Change" else
legend_lab
# color vector which assigns black to gtest flag values (-2, 2)
cols_anova <-
c(
"-2" = fc_colors[2],
"-1" = fc_colors[1],
"0" = fc_colors[2],
"1" = fc_colors[3],
"2" = fc_colors[2]
)
# temp data with rows only for ANOVA
temp_data_anova <- volcano %>%
dplyr::filter(Type %in% c(
"ANOVA", "EdgeR_F", "Voom_T", "DESeq_Wald", "DESeq_LRT"
)) %>%
dplyr::mutate(
Fold_change_flag = dplyr::case_when(
is.na(Fold_change) |
abs(Fold_change) < ifelse(length(fc_threshold) == 0,
0,
abs(fc_threshold)
) ~ "0",
Fold_change > 0 &
P_value <= pval_thresh ~ "1",
Fold_change < 0 &
P_value <= pval_thresh ~ "-1",
TRUE ~ Fold_change_flag
)
)
# interactive plots need manual text applied to prepare for ggplotly
# conversion
if (interactive && requirePlotly()) {
p <-
ggplot2::ggplot(temp_data_anova, ggplot2::aes(
Fold_change,
-log(P_value, base = 10),
text = paste(
"ID:",
!!dplyr::sym(colnames(volcano)[1]),
"<br>",
"Pval:",
round(P_value, 4)
)
))
} else {
p <-
ggplot2::ggplot(
data = temp_data_anova,
ggplot2::aes(
Fold_change,
-log(P_value, base = 10)
)
)
}
# draw vertical lines at +- fc threshold
if (length(fc_threshold) > 0) {
p <- p +
ggplot2::geom_vline(ggplot2::aes(xintercept = abs(fc_threshold)),
lty = 2
) +
ggplot2::geom_vline(ggplot2::aes(xintercept = abs(fc_threshold) * (-1)),
lty = 2
)
}
p <- p +
ggplot2::geom_point(ggplot2::aes(color = Fold_change_flag), shape = 1) +
ggplot2::facet_wrap(~Comparison) +
ggplot2::ylab(the_y_label) +
ggplot2::xlab(the_x_label) +
ggplot2::ggtitle(the_title_label) +
ggplot2::scale_color_manual(
values = cols_anova,
name = the_legend_label,
labels = c(
paste0("Neg(", unique(temp_data_anova$Type), ")"),
"0", paste0("Pos(", unique(temp_data_anova$Type), ")")
),
breaks = c("-1", "0", "1")
)
return(p)
}
#' Require Plotly
#'
#' Loads plotly if installed, else prints a message telling the user to install
#' plotly.
#'
#' @return whether plotly is installed
#'
#' @keywords internal
#'
#' @noRd
requirePlotly <- function() {
if (requireNamespace("plotly", quietly = TRUE)) {
return(TRUE)
}
warning("Package 'plotly' is not installed. Please install it to use interactive plots.")
return(FALSE)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.