## CYTO_PLOT_EMPTY -------------------------------------------------------------
#' Create an empty cyto_plot
#'
#' \code{cyto_plot_empty} generates to base for cyto_plot by creating an empty
#' plot with border, axes, axes_text and titles. Data is subsequently added to
#' this base layer with \code{cyto_plot_point} or \code{cyto_plot_density}.
#'
#' @param x object of class \code{\link[flowCore:flowFrame-class]{flowFrame}}.
#' @param channels name of the channel(s) or marker(s) to be used to construct
#' the plot. The length of channels determines the type of plot to be
#' constructed, either a 1-D density distribution for a single channel or a
#' 2-D scatterplot with blue-red colour scale for two channels.
#' @param axes_trans object of class
#' \code{\link[flowCore:transformList-class]{transformList}} or
#' \code{\link[flowWorkspace]{transformerList}} generated by
#' \code{\link[flowCore:logicleTransform]{estimateLogicle}} which was used to
#' transform the fluorescent channels of the supplied flowFrame. This
#' transformation object will be used internally to ensure that the axes
#' labels of the plot are appropriately transformed. The transformation object
#' will NOT be applied to the flowFrame internally and should be applied to
#' the flowFrame prior to plotting.
#' @param overlay a list of flowFrames to overlay onto the plot.
#' @param gate list of gate objects to be plotted, used internlaly to ensure
#' gate co-ordinates are taken into account when computing axes limits.
#' @param xlim lower and upper limits of x axis (e.g. c(0,5)).
#' @param ylim lower and upper limits of y axis (e.g. c(0,5)).
#' @param axes_limits options include \code{"auto"}, \code{"data"} or
#' \code{"machine"} to use optimised, data or machine limits respectively. Set
#' to \code{"auto"} by default to use optimised axes ranges. Fine control over
#' axes limits can be obtained by altering the \code{xlim} and \code{ylim}
#' arguments.
#' @param axes_limits_buffer decimal indicating the percentage of buffering to
#' add to either end of the axes limits, set to 0.03 by default.
#' @param title title to use for the plot, set to the name of the sample by
#' default. Title can be removed by setting this argument to \code{NA}.
#' @param xlab x axis label.
#' @param ylab y axis label.
#' @param margins a vector of length 4 to control the margins around the bottom,
#' left, top and right of the plot, set to NULL by default to let `cyto_plot`
#' compute optimal margins.
#' @param density_modal logical indicating whether density should be normalised
#' to mode and presented as a percentage. Set to \code{TRUE} by default.
#' @param density_smooth smoothing parameter passed to
#' \code{\link[stats:density]{density}} to adjust kernel density.
#' @param density_stack numeric [0,1] indicating the degree of offset for
#' overlaid populations, set to 0.5 by default. #' @param density_cols vector
#' colours to draw from when selecting density fill colours if none are
#' supplied to density_fill.
#' @param density_cols vector colours to draw from when selecting density fill
#' colours if none are supplied to density_fill.
#' @param density_fill colour(s) used to fill polygons.
#' @param density_fill_alpha numeric [0,1] used to control fill transparency,
#' set to 1 by default to remove transparency.
#' @param density_line_type line type(s) to use for border(s), set to solid
#' lines by default.
#' @param density_line_width line width for border.
#' @param density_line_col colour(s) for border line, set to "black" by default.
#' @param point_shape shape(s) to use for points in 2-D scatterplots, set to
#' \code{"."} by default to maximise plotting speed. See
#' \code{\link[graphics:par]{pch}} for alternatives.
#' @param point_size numeric to control the size of points in 2-D scatter plots
#' set to 2 by default.
#' @param point_col_scale vector of colours to use for density gradient.
#' @param point_cols vector colours to draw from when selecting colours for
#' points if none are supplied to point_col.
#' @param point_col colour(s) to use for points in 2-D scatter plots, set to NA
#' by default to use a blue-red density colour scale.
#' @param point_col_alpha numeric [0,1] to control point colour transparency in
#' 2-D scatter plots, set to 1 by default to use solid colours.
#' @param axes_text logical vector of length 2 indicating whether axis text
#' should be included for the x and y axes respectively, set to
#' \code{c(TRUE,TRUE)} by default to display axes text on both axes.
#' @param axes_text_font numeric indicating the font to use for axes, set to 1
#' for plain font by default. See \code{\link[graphics:par]{?par}} font for
#' details.
#' @param axes_text_size character expansion for axis text.
#' @param axes_text_col colour of axis text.
#' @param axes_label_text_font numeric indicating the font to use for title, set
#' to 1 for plain font by default. See \code{\link[graphics:par]{?par}} font
#' for details.
#' @param axes_label_text_size character expansion for axis labels.
#' @param axes_label_text_col colour of axis labels.
#' @param title_text_font numeric indicating the font to use for title, set to 2
#' for bold font by default. See \code{\link[graphics:par]{?par}} font for
#' details.
#' @param title_text_size character expansion for plot title.
#' @param title_text_col colour for plot title.
#' @param border_line_type line type to use for plot border, set to 1 by default
#' for a sold border.
#' @param border_line_width line width for plot border, set to 1 by default.
#' @param border_line_col line colour for plot border, set to "black" by
#' default.
#' @param border_fill colour to use for the plot background, set to "white" by
#' default.
#' @param border_fill_alpha transparency to use for border_fill colour, set to 1
#' by default to add no transparency.
#' @param legend can be either \code{"line"} or \code{"fill"} to indicate
#' whether a legend should be constructed based on the density \code{"line"}
#' or \code{"fill"}, set to FALSE by default to remove the legend.
#' @param legend_text vector of labels to use in the legend.
#' @param legend_text_font numeric to control the font of legend text, set to 1
#' for plain font by default. See \code{\link[graphics:par]{font}} for
#' alternatives.
#' @param legend_text_size numeric to control the size of text in the legend,
#' set to 1 by default.
#' @param legend_text_col colour(s) to use for text in legend, set to
#' \code{"black"} by default.
#' @param legend_line_type numeric to control the line type for line legends,
#' set to 1 by default. Refer to \code{lty} in \code{\link[graphics:par]{par}}
#' for alternatives.
#' @param legend_line_width numeric to control the line width in line legend,
#' set to 1 by default. Refer to \code{lwd} in \code{\link[graphics:par]{par}}
#' for alternatives.
#' @param legend_line_col colour(s) to use for the lines in 1-D plot legends
#' when legend is set to \code{"line"}.
#' @param legend_box_fill fill colour(s) to use for the boxes in 1-D plot
#' legends when legend is set to \code{"fill"}.
#' @param legend_point_col colour(s) to use for points in 2-D scatter plot
#' legend.
#' @param ... not in use.
#'
#' @importFrom grDevices adjustcolor
#' @importFrom graphics plot box axis title par
#' @importFrom methods formalArgs is
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @examples
#' library(CytoExploreRData)
#'
#' # Construct an empty 2D plot with black background
#' cyto_plot_empty(Activation[[32]],
#' channels = c("FSC-A", "SSC-A"),
#' border_fill = "black"
#' )
#'
#' # Construct an empty 1D plot
#' cyto_plot_empty(Activation[[32]],
#' channels = c("FSC-A"),
#' overlay = Activation[1:2]
#' )
#' @rdname cyto_plot_empty
#' @export
cyto_plot_empty <- function(x, ...) {
UseMethod("cyto_plot_empty")
}
#' @rdname cyto_plot_empty
#' @export
cyto_plot_empty.flowFrame <- function(x,
channels,
axes_trans = NA,
overlay = NA,
gate = NA,
xlim = NA,
ylim = NA,
axes_limits = "auto",
axes_limits_buffer = 0.03,
title,
xlab,
ylab,
margins = NULL,
density_modal = TRUE,
density_smooth = 1.5,
density_stack = 0.5,
density_cols = NA,
density_fill = NA,
density_fill_alpha = 1,
density_line_type = 1,
density_line_width = 1,
density_line_col = "black",
point_shape = ".",
point_size = 2,
point_col_scale = NA,
point_cols = NA,
point_col = NA,
point_col_alpha = 1,
axes_text = c(TRUE, TRUE),
axes_text_font = 1,
axes_text_size = 1,
axes_text_col = "black",
axes_label_text_font = 1,
axes_label_text_size = 1.1,
axes_label_text_col = "black",
title_text_font = 2,
title_text_size = 1.1,
title_text_col = "black",
border_line_type = 1,
border_line_width = 1,
border_line_col = "black",
border_fill = "white",
border_fill_alpha = 1,
legend = FALSE,
legend_text,
legend_text_font = 1,
legend_text_size = 1,
legend_text_col = "black",
legend_line_type = NA,
legend_line_width = NA,
legend_line_col = NA,
legend_box_fill = NA,
legend_point_col = NA,
...) {
# GRAPHICAL PARAMETERS -------------------------------------------------------
# Prevent scientific notation on axes - reset on exit
scipen <- getOption("scipen")
options(scipen = 100000000)
on.exit(options(scipen = scipen))
# Extract current graphics parameters
pars <- par("mar")
# Reset graphics parameters on exit
on.exit(par(pars))
# ARGUMENTS ------------------------------------------------------------------
# Pull down arguments to named list
args <- .args_list()
# Inherit arguments from cyto_plot_theme
args <- .cyto_plot_theme_inherit(args)
# Update arguments
.args_update(args)
# CHANNELS -------------------------------------------------------------------
# Check channels
channels <- cyto_channels_extract(
x,
channels
)
# LIST OF FLOWFRAMES ---------------------------------------------------------
# Convert overlay to list of flowFrames
if (!.all_na(overlay) &
any(is(overlay, "flowFrame") |
is(overlay, "flowSet"))) {
overlay <- cyto_convert(overlay, "list of flowFrames")
}
# Combine x and overlay into list
if (!.all_na(overlay)) {
fr_list <- c(list(x), overlay)
} else {
fr_list <- list(x)
}
# SAMPLES
smp <- length(fr_list)
# AXES LIMITS ----------------------------------------------------------------
# XLIM
if (.all_na(xlim)) {
# XLIM
xlim <- .cyto_range(fr_list,
channels = channels[1],
axes_limits = axes_limits,
buffer = axes_limits_buffer,
plot = TRUE
)[, 1]
}
# YLIM
if (.all_na(ylim)) {
# 1D PLOT
if (length(channels) == 1) {
# DENSITY
fr_dens <- .cyto_density(fr_list,
channel = channels,
smooth = density_smooth,
stack = density_stack,
modal = density_modal
)
# YLIM
ymin <- as.numeric(unlist(strsplit(names(fr_dens)[1], "-"))[1])
ymax <- as.numeric(unlist(strsplit(names(fr_dens)[smp], "-"))[2])
ylim <- c(ymin, ymax)
# 2D PLOT
} else if (length(channels) == 2) {
# YLIM
ylim <- .cyto_range(fr_list,
channels = channels[2],
axes_limits = axes_limits,
buffer = axes_limits_buffer,
plot = TRUE
)[, 1]
}
}
# GATE COORDS MUST BE WITHIN AXES LIMITS
if(!.all_na(gate)){
# GATE COORDS
gate_coords <- .cyto_gate_coords(gate, channels)
}
# XLIM GATE COORD ADJUSTMENT
if(!.all_na(gate)){
# MIN & MAX GATE COORDS
gate_xcoords <- gate_coords[, channels[1]]
gate_xcoords <- c(min(gate_xcoords), max(gate_xcoords))
# GATE COORDS BELOW XMIN
if(is.finite(gate_xcoords[1]) & gate_xcoords[1] < xlim[1]){
xlim[1] <- gate_xcoords[1]
}
# GATE COORDS ABOVE XMAX
if(is.finite(gate_xcoords[2]) & gate_xcoords[2] > xlim[2]){
xlim[2] <- gate_xcoords[2]
}
}
# YLIM GATE COORD ADJUSTMENT
if(length(channels) == 2){
# GATE COORDS
if(!.all_na(gate)){
# MIN & MAX GATE COORDS
gate_ycoords <- gate_coords[, channels[2]]
gate_ycoords <- c(min(gate_ycoords), max(gate_ycoords))
# GATE COORDS BELOW YMIN
if(is.finite(gate_ycoords[1]) & gate_ycoords[1] < ylim[1]){
ylim[1] <- gate_ycoords[1]
}
# GATE COORDS ABOVE YMAX
if(is.finite(gate_ycoords[2]) & gate_ycoords[2] > ylim[2]){
ylim[2] <- gate_ycoords[2]
}
}
}
# AXES TEXT ------------------------------------------------------------------
# Convert axes_text to list - allows inheritance from cyto_plot
if (!is(axes_text, "list")) {
axes_text <- list(axes_text[1], axes_text[2])
}
# X axis breaks and labels - can be inherited from cyto_plot
if (!is(axes_text[[1]], "list")) {
if (.all_na(axes_text[[1]])) {
# NA == TRUE returns NA not T/F
} else if (axes_text[[1]] == TRUE) {
lims <- list(xlim)
names(lims) <- channels[1]
axes_text[[1]] <- .cyto_plot_axes_text(fr_list,
channels = channels[1],
axes_trans = axes_trans,
axes_range = lims,
axes_limits = axes_limits
)[[1]]
}
}
# Y axis breaks and labels - can be inherited from cyto_plot
if (!is(axes_text[[2]], "list")) {
if (.all_na(axes_text[[2]])) {
# NA == TRUE returns NA not T/F
} else if (axes_text[[2]] == TRUE) {
if (length(channels) == 2) {
lims <- list(ylim)
names(lims) <- channels[2]
axes_text[[2]] <- .cyto_plot_axes_text(fr_list,
channels = channels[2],
axes_trans = axes_trans,
axes_range = lims,
axes_limits = axes_limits
)[[1]]
} else {
axes_text[[2]] <- NA
}
}
}
# Turn off y axis labels for stacked overlays
if (!.all_na(overlay) &
density_stack != 0 &
length(channels) == 1) {
axes_text <- list(axes_text[[1]], FALSE)
}
# AXES LABELS ----------------------------------------------------------------
# AXES LABELS - missing replaced - NA removed
axes_labels <- .cyto_plot_axes_label(x,
channels = channels,
xlab = xlab,
ylab = ylab,
density_modal = density_modal
)
xlab <- axes_labels[[1]]
ylab <- axes_labels[[2]]
# TITLE ----------------------------------------------------------------------
# TITLE - missing replaced - NA removed
title <- .cyto_plot_title(x,
channels = channels,
overlay = overlay,
title = title
)
# MARGINS --------------------------------------------------------------------
# Set plot margins - set par("mar")
.cyto_plot_margins(c(list(x), overlay),
legend = legend,
legend_text = legend_text,
legend_text_size = legend_text_size,
title = title,
axes_text = axes_text,
margins = margins
)
# PLOT CONSTRUCTION ----------------------------------------------------------
# Plot
graphics::plot(1,
type = "n",
axes = FALSE,
xlim = xlim,
ylim = ylim,
xlab = "",
ylab = "",
bty = "n"
)
# X AXIS - TRANSFORMED
if (is(axes_text[[1]], "list")) {
# MINOR TICKS
mnr_ind <- which(as.character(axes_text[[1]]$label) == "")
axis(1,
at = axes_text[[1]]$at[mnr_ind],
labels = axes_text[[1]]$label[mnr_ind],
tck = -0.015
)
# MAJOR TICKS - MUST BE >2% XRANGE FROM ZERO
mjr_ind <- which(as.character(axes_text[[1]]$label) != "")
mjr <- list(
"at" = axes_text[[1]]$at[mjr_ind],
"label" = axes_text[[1]]$label[mjr_ind]
)
# Zero included on plot
if (any(as.character(mjr$label) == "0")) {
zero <- which(as.character(mjr$label) == "0")
zero_break <- mjr$at[zero]
zero_buffer <- c(
zero_break - 0.02 * (xlim[2] - xlim[1]),
zero_break + 0.02 * (xlim[2] - xlim[1])
)
mjr_ind <- c(
zero,
which(mjr$at < zero_buffer[1] |
mjr$at > zero_buffer[2])
)
} else {
mjr_ind <- seq_len(length(mjr$label))
}
axis(1,
at = mjr$at[mjr_ind],
labels = mjr$label[mjr_ind],
font.axis = axes_text_font,
col.axis = axes_text_col,
cex.axis = axes_text_size,
tck = -0.03
)
# X AXIS - UNTRANSFORMED
} else if (.all_na(axes_text[[1]])) {
axis(1,
font.axis = axes_text_font,
col.axis = axes_text_col,
cex.axis = axes_text_size,
tck = -0.03
)
}
# Y AXIS - TRANSFORMED
if (is(axes_text[[2]], "list")) {
# MINOR TICKS
mnr_ind <- which(as.character(axes_text[[2]]$label) == "")
axis(2,
at = axes_text[[2]]$at[mnr_ind],
labels = axes_text[[2]]$label[mnr_ind],
tck = -0.015
)
# MAJOR TICKS - MUST BE >2% yrange FROM ZERO
mjr_ind <- which(as.character(axes_text[[2]]$label) != "")
mjr <- list(
"at" = axes_text[[2]]$at[mjr_ind],
"label" = axes_text[[2]]$label[mjr_ind]
)
# Zero included on plot
if (any(as.character(mjr$label) == "0")) {
zero <- which(as.character(mjr$label) == "0")
zero_break <- mjr$at[zero]
zero_buffer <- c(
zero_break - 0.02 * (ylim[2] - ylim[1]),
zero_break + 0.02 * (ylim[2] - ylim[1])
)
mjr_ind <- c(
zero,
which(mjr$at < zero_buffer[1] |
mjr$at > zero_buffer[2])
)
} else {
mjr_ind <- seq_len(length(mjr$label))
}
axis(2,
at = mjr$at[mjr_ind],
labels = mjr$label[mjr_ind],
font.axis = axes_text_font,
col.axis = axes_text_col,
cex.axis = axes_text_size,
tck = -0.03
)
# Y AXIS - LINEAR
} else if (.all_na(axes_text[[2]])) {
axis(2,
font.axis = axes_text_font,
col.axis = axes_text_col,
cex.axis = axes_text_size,
tck = -0.03
)
}
# BORDER
box(
which = "plot",
lty = border_line_type,
lwd = border_line_width,
col = border_line_col
)
# BORDER_FILL
if (border_fill != "white") {
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4],
col = adjustcolor(border_fill, border_fill_alpha),
border = NA
)
}
# TITLE
if (!.all_na(title)) {
title(
main = title,
cex.main = title_text_size,
col.main = title_text_col,
font.main = title_text_font
)
}
# XLAB - position labels closer if axes text is missing
if (!.all_na(xlab)) {
if (is(axes_text[[1]], "list")) {
title(
xlab = xlab,
font.lab = axes_label_text_font,
col.lab = axes_label_text_col,
cex.lab = axes_label_text_size
)
} else if (.all_na(axes_text[[1]])) {
title(
xlab = xlab,
font.lab = axes_label_text_font,
col.lab = axes_label_text_col,
cex.lab = axes_label_text_size
)
} else if (axes_text[[1]] == FALSE) {
title(
xlab = xlab,
font.lab = axes_label_text_font,
col.lab = axes_label_text_col,
cex.lab = axes_label_text_size,
mgp = c(2, 0, 0)
)
}
}
# YLAB - position labels closer if axes text is missing
if (!.all_na(ylab)) {
if (is(axes_text[[2]], "list")) {
title(
ylab = ylab,
font.lab = axes_label_text_font,
col.lab = axes_label_text_col,
cex.lab = axes_label_text_size
)
} else if (.all_na(axes_text[[2]])) {
title(
ylab = ylab,
font.lab = axes_label_text_font,
col.lab = axes_label_text_col,
cex.lab = axes_label_text_size
)
} else if (axes_text[[2]] == FALSE) {
title(
ylab = ylab,
font.lab = axes_label_text_font,
col.lab = axes_label_text_col,
cex.lab = axes_label_text_size,
mgp = c(2, 0, 0)
)
}
}
# LEGEND ---------------------------------------------------------------------
# LEGEND - FALSE/"fill"/"line"
if (legend != FALSE) {
.cyto_plot_legend(fr_list,
channels = channels,
legend = legend,
legend_text = legend_text,
legend_text_font = legend_text_font,
legend_text_size = legend_text_size,
legend_text_col = legend_text_col,
legend_line_type = legend_line_type,
legend_line_width = legend_line_width,
legend_line_col = legend_line_col,
legend_box_fill = legend_box_fill,
legend_point_col = legend_point_col,
density_cols = density_cols,
density_fill = density_fill,
density_fill_alpha = density_fill_alpha,
density_line_type = density_line_type,
density_line_width = density_line_width,
density_line_col = density_line_col,
point_shape = point_shape,
point_size = point_size,
point_col_scale = point_col_scale,
point_cols = point_cols,
point_col = point_col,
point_col_alpha = point_col_alpha
)
}
}
#' @noRd
#' @export
cyto_plot_empty.list <- function(x,
channels,
axes_trans = NA,
gate = NA,
xlim = NA,
ylim = NA,
axes_limits = "auto",
title,
xlab,
ylab,
margins = NULL,
density_modal = TRUE,
density_smooth = 1.5,
density_stack = 0.5,
density_cols = NA,
density_fill = NA,
density_fill_alpha = 1,
density_line_type = 1,
density_line_width = 1,
density_line_col = "black",
point_shape = ".",
point_size = 2,
point_col_scale = NA,
point_cols = NA,
point_col = NA,
point_col_alpha = 1,
axes_limits_buffer = 0.03,
axes_text = c(TRUE, TRUE),
axes_text_font = 1,
axes_text_size = 1,
axes_text_col = "black",
axes_label_text_font = 1,
axes_label_text_size = 1.1,
axes_label_text_col = "black",
title_text_font = 2,
title_text_size = 1.1,
title_text_col = "black",
border_line_type = 1,
border_line_width = 1,
border_line_col = "black",
border_fill = "white",
border_fill_alpha = 1,
legend = FALSE,
legend_text,
legend_text_font = 1,
legend_text_size = 1,
legend_text_col = "black",
legend_line_type = NA,
legend_line_width = NA,
legend_line_col = NA,
legend_box_fill = NA,
legend_point_col = NA,
...) {
# CHECKS ---------------------------------------------------------------------
# LIST OF FLOWFRAMES
if (!all(LAPPLY(x, is, "flowFrame"))) {
stop("'x' must be a list of flowFrame objects.")
}
# OVERLAY
if (length(x) > 1) {
overlay <- x[seq(2, length(x), 1)]
} else {
overlay <- NA
}
# X
x <- x[[1]]
# ARGUMENTS ------------------------------------------------------------------
# ARGUMENT LIST
args <- .args_list()
# CALL FLOWFRAME METHOD ------------------------------------------------------
# CYTO_PLOT_EMPTY ARGUMENTS
ARGS <- formalArgs("cyto_plot_empty.flowFrame")
# CALL FLOWFRAME METHOD
do.call("cyto_plot_empty.flowFrame", args[names(args) %in% ARGS])
}
## CYTO_PLOT_NEW ---------------------------------------------------------------
#' Open new graphics device for cyto_plot
#'
#' \code{cyto_plot_new} is used internally by cyto_plot to open an
#' OS-specific interactive garphics device to facilitate gate drawing. Mac users
#' will need to install \href{https://www.xquartz.org/}{XQuartz} for this
#' functionality.
#'
#' @param popup logical indicating whether a popup graphics device should be
#' opened, set to TRUE by default.
#' @param ... additional arguments passed to
#' \code{\link[grDevices:dev]{dev.new}}:
#'
#' @importFrom grDevices dev.cur dev.new
#'
#' @examples
#' \dontrun{
#' # Open platform-specific graphics device
#' cyto_plot_new()
#' }
#'
#' @author Dillon Hammill, \email{Dillon.Hammill@anu.edu.au}
#'
#' @export
cyto_plot_new <- function(popup = TRUE, ...){
# Null graphics device -> RStudioGD
if(dev.cur() == 1) {
dev.new()
}
# Open popup window - either windows/X11/xquartz
if(popup == TRUE & interactive() & getOption("CytoExploreR_interactive")){
if(.Platform$OS.type == "windows"){
suppressWarnings(dev.new(...))
}else if (.Platform$OS.type == "unix") {
if (Sys.info()["sysname"] == "Linux") {
# Cairo needed for semi-transparency
suppressWarnings(dev.new(type = "cairo", ...))
}else if(Sys.info()["sysname"] == "Darwin"){
suppressWarnings(dev.new(...))
}
}
}
}
## CYTO_PLOT_RESET -------------------------------------------------------------
#' Reset all cyto_plot related settings
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @importFrom grDevices dev.off dev.cur
#' @export
cyto_plot_reset <- function() {
# Signals args called to cyto_plot - check if call is made twice
options("cyto_plot_call" = NULL)
# Signals if plots match in flowSet method
options("cyto_plot_match" = NULL)
# Create custom theme for cyto_plot
options("cyto_plot_theme" = NULL)
# Signal cyto_plot_save method has been called
options("cyto_plot_save" = FALSE)
# Signal which cyto_plot method has been called
options("cyto_plot_method" = NULL)
# Signal if a custom plot is being contructed - require cyto_plot_complete
options("cyto_plot_custom" = FALSE)
# Signal when cyto_plot_grid method is being called
options("cyto_plot_grid" = FALSE)
# Signal previous call to cyto_plot (same plot?)
options("cyto_plot_call" = NULL)
# Save label co-ordinates as list
options("cyto_plot_label_coords" = NULL)
# Turn off graphics device
if(dev.cur() != 1){
dev.off()
}
invisible(NULL)
}
## CYTO_PLOT_RECORD ------------------------------------------------------------
#' Record an existing cyto_plot
#'
#' \code{cyto_plot_record} will record an existing plot such that it can be
#' saved to an R object for future reference.
#'
#' @importFrom grDevices recordPlot
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @examples
#' \dontrun{
#'
#' # Load CytoExploreRData to acces data
#' library(CytoExploreRData)
#'
#' # Activation flowSet
#' fs <- Activation
#'
#' # Construct cyto_plot
#' cyto_plot(fs[[1]],
#' channels = c("FSC-A", "SSC-A"))
#'
#' # Record plot and save to object called p
#' p <- cyto_plot_record()
#'
#' # Calling p will bring back the recorded plot
#' p
#'
#' }
#'
#' @export
cyto_plot_record <- function(){
recordPlot()
}
## CYTO_PLOT_SAVE --------------------------------------------------------------
#' Save High Resolution cyto_plot Images
#'
#' @param save_as name of the file to which the plot should be saved (including
#' the file extension). Supported file formats include png, tiff, jpeg, svg
#' and pdf.
#' @param width numeric indicating the width of exported plot in \code{units},
#' set to 7 by default for image with width of 7 inches.
#' @param height numeric indicating the height of the exported plot in
#' \code{units}, set to 7 by default for image with height of 7 inches.
#' @param units units to be used to set plot size, can be either pixels
#' (\code{px}), inches (\code{inches}), centimetres (\code{cm}) or millimetres
#' (\code{mm}). Set to \code{"in"} by default. Units cannot be altered for
#' \code{svg} and \code{pdf} graphics devices.
#' @param res resolution in ppi, set to 300 by default.
#' @param multiple logical indicating whether multiple pages should be saved to
#' separate numbered files, set to \code{TRUE} by default.
#' @param layout a vector or matrix defining the custom layout of the plot to be
#' created using `cyto_plot_layout`, set to NULL by default to use standard
#' `cyto_plot` layout. Custom layouts are required when making multiple
#' `cyto_plot` calls in the same image.
#' @param ... additional arguments for the appropriate \code{png()},
#' \code{tiff()}, \code{jpeg()}, \code{svg()} or \code{pdf} graphics devices.
#'
#' @importFrom tools file_ext file_path_sans_ext
#' @importFrom grDevices png tiff jpeg pdf svg
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @examples
#' \dontrun{
#' library(CytoExploreRData)
#'
#' # Load samples into GatingSet
#' fs <- Activation
#' gs <- GatingSet(fs)
#'
#' # Apply compensation
#' gs <- cyto_compensate(gs)
#'
#' # Transform fluorescent channels
#' gs <- cyto_transform(gs)
#'
#' # Apply gatingTemplate
#' cyto_gatingTemplate_apply(gs, Activation_gatingTemplate)
#'
#' # Save png image of gating scheme after plotting
#' cyto_plot_save("Gating-Scheme.png",
#' width = 20,
#' height = 16
#' )
#' cyto_plot_gating_scheme(gs[[1]])
#'
#' # Save multiple pages to the same pdf file
#' cyto_plot_save("CD4-T-Cells.pdf",
#' height = 8,
#' width = 16,
#' multiple = TRUE
#' )
#' cyto_plot(gs,
#' parent = "CD4 T Cells",
#' alias = "",
#' channels = c("Alexa Fluor 647-A", "7-AAD-A"),
#' layout = c(1, 2)
#' )
#' }
#' @seealso \code{\link[grDevices:cairo]{cairo}}
#' @seealso \code{\link[grDevices:png]{png}}
#'
#' @export
cyto_plot_save <- function(save_as,
width = 7,
height = 7,
units = "in",
res = 300,
multiple = FALSE,
layout = NULL,
...) {
# File missing extension
if (file_ext(save_as) == "") {
# Modify file name to export png by default
save_as <- paste0(save_as, ".png")
}
# Save separate pages to separate number files
if (multiple == TRUE & file_ext(save_as) != "pdf") {
save_as <- paste0(
file_path_sans_ext(save_as),
"%03d", ".",
file_ext(save_as)
)
}
# PNG DEVICE
if (file_ext(save_as) == "png") {
png(
filename = save_as,
width = width,
height = height,
units = units,
res = res,
...
)
# TIFF DEVICE
} else if (file_ext(save_as) == "tiff") {
tiff(
filename = save_as,
width = width,
height = height,
units = units,
res = res,
...
)
# JPEG DEVICE
} else if (file_ext(save_as) == "jpeg") {
jpeg(
filename = save_as,
width = width,
height = height,
units = units,
res = res,
...
)
# PDF DEVICE
} else if (file_ext(save_as) == "pdf") {
pdf(
file = save_as,
width = width,
height = height,
onefile = multiple,
...
)
} else if(file_ext(save_as) == "svg") {
svg(
filename = save_as,
width = width,
height = height,
...
)
} else {
stop(paste("Can't save file to", file_ext(save_as), "format."))
}
# Set global option to notify cyto_plot when dev.off() is required for saving
options("cyto_plot_save" = TRUE)
# CYTO_PLOT_CUSTOM
if(!is.null(layout)){
cyto_plot_custom(layout = layout)
}
}
## CYTO_PLOT_SAVE_RESET --------------------------------------------------------
#' Revert unwanted cyto_plot_save call
#'
#' @importFrom grDevices dev.off
#'
#' @examples
#'
#' # Unwanted cyto_plot_save call
#' cyto_plot_save("Mistake.png")
#'
#' # Revert unwanted cyto_plot_save call
#' cyto_plot_save_reset()
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @export
cyto_plot_save_reset <- function() {
# TURN OFF GLOBAL OPTION
options("cyto_plot_save" = FALSE)
# TURN OFF GRAPHICS DEVICE
dev.off()
}
## CYTO_PLOT_LAYOUT ------------------------------------------------------------
#' Set Panel Layout for cyto_plot
#'
#' \code{cyto_plot_layout()} sets the panel layout dimensions for combining
#' different types of cyto_plot plots. Make a call to \code{cyto_plot_layout()}
#' prior to making multiple calls to \code{cyto_plot()}.
#'
#' @param layout either a vector of the form c(nrow, ncol) defining the
#' dimensions of the plot or a matrix defining a more sophisticated layout
#' (see \code{\link[graphics]{layout}}). Vectors can optionally contain a
#' third element to indicate whether plots should be placed in row (1) or
#' column (2) order, set to row order by default.
#'
#' @importFrom graphics par layout
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @examples
#' library(CytoExploreRData)
#'
#' # Load samples into GatingSet
#' fs <- Activation
#' gs <- GatingSet(fs)
#'
#' # Apply compensation
#' gs <- compensate(gs, fs[[1]]@description$SPILL)
#'
#' # Transform fluorescent channels
#' trans <- estimateLogicle(gs[[4]], cyto_fluor_channels(gs))
#' gs <- transform(gs, trans)
#'
#' # Apply gatingTemplate
#' gt <- Activation_gatingTemplate
#' gt_gating(gt, gs)
#'
#' # Set out plot layout
#' cyto_plot_layout(c(1,2))
#'
#' # Add 2D plot
#' cyto_plot(gs[[4]],
#' parent = "CD4 T Cells",
#' alias = "",
#' channels = c("Alexa Fluor 647-A", "7-AAD-A"),
#' layout = FALSE
#' )
#'
#' # Add 1D plot
#' cyto_plot(gs,
#' parent = "CD4 T Cells",
#' alias = "",
#' channels = "7-AAD-A",
#' density_stack = 0.6,
#' layout = FALSE
#' )
#' @export
cyto_plot_layout <- function(layout = NULL) {
# MESSAGE
if(is.null(layout)){
stop("Supply either a vector or matrix to construct a custom layout.")
}
# MATRIX
if(is.matrix(layout)){
layout(layout)
# VECTOR
}else{
# ROW ORDER
if(length(layout) == 2){
layout <- c(layout, 1)
}
# ROWS
if (layout[3] == 1) {
par(mfrow = c(layout[1], layout[2]))
# COLUMNS
} else if (layout[3] == 2) {
par(mfcol = c(layout[1], layout[2]))
}
}
}
## CYTO_PLOT_CUSTOM ------------------------------------------------------------
#' Create custom cyto_plot
#'
#' Signal to \code{cyto_plot} that a custom plot is being created to ensure that
#' plots are appropraitely saved with \code{cyto_plot_save}.
#' \code{cyto_plot_custom} calls must be made before \code{cyto_plo_save} calls
#' and \code{cyto_plot} calls should be followed by a call to
#' \code{cyto_plot_complete} to indicate when the plot is complete and should be
#' saved.
#'
#' @param layout either a vector of the form c(nrow, ncol) defining the
#' dimensions of the plot or a matrix defining a more sophisticated layout
#' (see \code{\link[graphics]{layout}}). Vectors can optionally contain a
#' third element to indicate whether plots should be placed in row (1) or
#' column (2) order, set to row order by default.
#'
#' @importFrom graphics par
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @examples
#' \dontrun{
#' library(CytoExploreRData)
#'
#' # Activation flowSet
#' fs <- Activation
#'
#' # Save plot
#' cyto_plot_save("Test.png",
#' height = 7,
#' width = 14)
#'
#' # Create custom plot - 1D & 2D plot panels
#' cyto_plot_custom(layout = c(1,2))
#' cyto_plot(fs[[32]],
#' channels = "FSC-A")
#' cyto_plot(fs[[32]],
#' channels = c("FSC-A","SSC-A"))
#'
#' # Signal plot is complete and save
#' cyto_plot_complete()
#' }
#' @export
cyto_plot_custom <- function(layout = NULL){
# Tell CytoExploreR - cyto_plot_save and layout resets
options("cyto_plot_custom" = TRUE)
# Set plot method
options("cyto_plot_method" = "custom")
# Set layout
cyto_plot_layout(layout)
}
## CYTO_PLOT_COMPLETE ----------------------------------------------------------
#' Indicate Completion of Custom cyto_plot Layout for Saving
#'
#' @param layout either a vector of the form c(nrow, ncol) defining the
#' dimensions of the plot or a matrix defining a more sophisticated layout
#' (see \code{\link[graphics]{layout}}). Vectors can optionally contain a
#' third element to indicate whether plots should be placed in row (1) or
#' column (2) order, set to row order by default.
#'
#' @importFrom graphics par
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @examples
#' library(CytoExploreRData)
#'
#' # Load samples into GatingSet
#' fs <- Activation
#' gs <- GatingSet(fs)
#'
#' # Apply compensation
#' gs <- compensate(gs, fs[[1]]@description$SPILL)
#'
#' # Transform fluorescent channels
#' trans <- estimateLogicle(gs[[4]], cyto_fluor_channels(gs))
#' gs <- transform(gs, trans)
#'
#' # Apply gatingTemplate
#' gt <- Activation_gatingTemplate
#' gt_gating(gt, gs)
#'
#' # Save custom plot
#' cyto_plot_save("Custom.png",
#' height = 8,
#' width = 16
#' )
#'
#' # Set out plot layout
#' cyto_plot_layout(c(1,2))
#'
#' # Add 2D plot
#' cyto_plot(gs[[4]],
#' parent = "CD4 T Cells",
#' alias = "",
#' channels = c("Alexa Fluor 647-A", "7-AAD-A"),
#' layout = FALSE
#' )
#'
#' # Add 1D plot
#' cyto_plot(gs,
#' parent = "CD4 T Cells",
#' alias = "",
#' channels = "7-AAD-A",
#' density_stack = 0.6,
#' layout = FALSE
#' )
#'
#' # Signal that the plot is complete
#' cyto_plot_complete()
#' @export
cyto_plot_complete <- function(layout = NULL) {
# Close graphics device (not RStudioGD or X11)
if(!names(dev.cur()) %in% c("RStudioGD",
"windows",
"X11",
"x11",
"quartz")){
dev.off()
}
# Reset cyto_plot_custom
options("cyto_plot_custom" = FALSE)
# Reset plot method
options("cyto_plot_method" = NULL)
# Turn off saving
options("cyto_plot_save" = FALSE)
# Reset layout - 1 x 1
if(is.null(layout)){
par("mfrow" = c(1,1))
par("mfcol" = c(1,1))
# Reset layout as supplied
}else{
# MATRIX
if(is.matrix(layout)){
layout(layout)
# VECTOR
}else{
if(length(layout) == 2){
layout <- c(layout, 1)
}
}
# ROWS
if (layout[3] == 1) {
par(mfrow = c(layout[1], layout[2]))
# COLUMNS
} else if (layout[3] == 2) {
par(mfcol = c(layout[1], layout[2]))
}
}
}
## CYTO_PLOT_THEME -------------------------------------------------------------
#' Create custom themes for cyto_plot
#'
#' \code{cyto_plot_theme} provides an easy way to alter the theme used by
#' \code{cyto_plot}. By calling \code{cyto_plot_theme} prior to plotting,
#' subsequent plots will inherit these arguments so there is no need to supply
#' them manually each time. For a complete list of supported arguments see
#' \code{cyto_plot_theme_args}.
#'
#' @param ... arguments supported by cyto_plot_theme.
#'
#' @examples
#' # Make all plots have a black background
#' cyto_plot_theme(border_fill = "black")
#'
#' # Black ground with custom colour scale for points and purple gates
#' cyto_plot_theme(
#' border_fill = "black",
#' point_col_scale = c(
#' "cyan",
#' "green",
#' "yellow",
#' "orange",
#' "red",
#' "darkred"
#' ),
#' gate_line_col = "magenta"
#' )
#'
#' # Reset to default setting
#' cyto_plot_theme_reset()
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @export
cyto_plot_theme <- function(...) {
# cyto_plot will pull down these arguments
# Arguments as named list
args <- list(...)
# Empty list set theme to NULL
if (length(args) == 0) {
args <- NULL
} else {
# Check supplied arguments are supported.
if (!all(names(args) %in% cyto_plot_theme_args())) {
lapply(names(args), function(x) {
if (!x %in% cyto_plot_theme_args()) {
message(paste(x, "is not a supported argument for cyto_plot_theme."))
}
})
}
# Restrict list to supported arguments only
args <- args[names(args) %in% cyto_plot_theme_args()]
}
# Assign arguments to cyto_plot_theme option
options("cyto_plot_theme" = args)
}
## CYTO_PLOT_THEME_RESET -------------------------------------------------------
#' Reset cyto_plot_theme to default settings
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @export
cyto_plot_theme_reset <- function() {
# Set cyto_plot_theme option to NULL
options("cyto_plot_theme" = NULL)
}
## .CYTO_PLOT_THEME_ARGS -------------------------------------------------------
#' Get supported cyto_plot_theme arguments
#'
#' @return vector of argument names supported by cyto_plot_theme.
#'
#' @examples
#' cyto_plot_theme_args()
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @export
cyto_plot_theme_args <- function() {
c(
"axes_limits",
"axes_limits_buffer",
"margins",
"popup",
"density_modal",
"density_smooth",
"density_stack",
"density_cols",
"density_fill_alpha",
"density_line_type",
"density_line_width",
"density_line_col",
"axes_text",
"axes_text_font",
"axes_text_size",
"axes_text_col",
"axes_label_text_font",
"axes_label_text_size",
"axes_label_text_col",
"title_text_font",
"title_text_size",
"title_text_col",
"legend",
"legend_text_font",
"legend_text_size",
"legend_text_col",
"legend_line_col",
"legend_box_fill",
"gate_line_type",
"gate_line_width",
"gate_line_col",
"gate_fill",
"gate_fill_alpha",
"label",
"label_position",
"label_text_font",
"label_text_size",
"label_text_col",
"label_fill",
"label_fill_alpha",
"border_fill",
"border_fill_alpha",
"border_line_type",
"border_line_width",
"border_line_col",
"point_shape",
"point_size",
"point_col_scale",
"point_cols",
"point_col_alpha",
"contour_lines",
"contour_line_type",
"contour_line_width",
"contour_line_col",
"contour_line_alpha"
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.