## CYTO_PLOT_COMPENSATION ------------------------------------------------------
#' Visualise Compensation of Fluorescent Spillover in All Fluorescent Channels
#'
#' \code{cyto_plot_compensation} plots each compensation control in all
#' fluorescent channels to make it easy to identify any potential compensation
#' issues. The unstained control is automatically overlaid onto the plot as a
#' refernce if supplied.
#'
#' @param x object of class \code{\link[flowCore:flowFrame-class]{flowFrame}} or
#' \code{\link[flowCore:flowSet-class]{flowSet}},
#' \code{\link[flowWorkspace:GatingHierarchy-class]{GatingHierarchy}} or
#' \code{\link[flowWorkspace:GatingSet-class]{GatingSet}} containing gated
#' compensation controls.
#' @param parent indicates the name of the parent population to extract fro
#' plotting to plot for GatingSet objects. Users can specify a parent for each
#' compensation control either as a vector or by adding a parent column to
#' \code{cyto_details(x)}.
#' @param channel_match name of the fluorescent channel associated with the
#' \code{\link[flowCore:flowFrame-class]{flowFrame}}. A \code{channel_match}
#' csv file may also be supplied. If not supplied users will need to select
#' the channel from a dropdown menu.
#' @param compensate logical indicating whether the samples should be
#' compensated prior to plotting, set to FALSE by default. If no spillover
#' matrix is supplied to the spillover argument the spillover matrix will
#' extracted from the samples.
#' @param spillover name of spillover matrix csv file including .csv file
#' extension to apply to sample when \code{compensate} is TRUE. If no
#' \code{spillover} is supplied the spillover matrix will be extracted
#' directly from the data and applied to the sample when \code{compensate} is
#' TRUE.
#' @param axes_trans object of class
#' \code{\link[flowWorkspace:transformerList]{transformerList}} generated by a
#' \code{cyto_transform} which contains the transformer definitions that were
#' used to transform the channels of the supplied flowFrame, flowSet,
#' GatingHierarchy or GatingSet.
#' @param axes_limits options include \code{"auto"}, \code{"data"} or
#' \code{"machine"} to use optimised, data or machine limits respectively. Set
#' to \code{"machine"} by default to use entire axes ranges.
#' @param overlay logical indicating whether the unstained control should be
#' overlaid onto the plot if supplied in the flowSet or GatingSet, set to
#' \code{TRUE} by default.
#' @param layout vector of grid dimensions \code{c(#rows,#columns)} for each
#' plot.
#' @param popup logical indicating whether plots should be constructed in a
#' pop-up window.
#' @param title text to include above each plot, set to NA by default to remove
#' titles.
#' @param header title to use for the plots, set to the name of the sample by
#' default. Turn off the header by setting this argument to NA.
#' @param header_text_font font to use for header text, set to 2 by default.
#' @param header_text_size text size for header, set to 1 by default.
#' @param header_text_col colour for header text, set to "black" by default.
#' @param density_stack numeric passsed to cyto_plot to control the degree of
#' stacking for density distributions, set to 0 by default.
#' @param density_fill vector of colours passed to cyto_plot to control the fill
#' colours of density distributions, set to c("grey","blue") by default.
#' @param density_fill_alpha numeric passed to cyto_plot to control the fill
#' transparency of density distributions, set to 0.5 by default.
#' @param ... additional arguments passed to \code{\link{cyto_plot}}.
#'
#' @importFrom grDevices n2mfrow
#' @importFrom graphics par mtext
#' @importFrom tools file_ext
#' @importFrom methods is
#' @importFrom flowWorkspace gs_cyto_data<-
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @examples
#' library(CytoExploreRData)
#'
#' # Bypass directory check for external files
#' options("CytoExploreR_wd_check" = FALSE)
#'
#' # Load in compensation controls
#' gs <- GatingSet(Compensation)
#'
#' # Gate single cells using cyto_gate_draw
#' gt <- Compensation_gatingTemplate
#' gt_gating(gt, gs)
#'
#' # Extract flowSet for plotting
#' fs <- cyto_extract(gs, "Single Cells")
#'
#' # Channel match file
#' cmfile <- system.file("extdata",
#' "Compensation-Channels.csv",
#' package = "CytoExploreRData"
#' )
#'
#' # Compensation plots - flowFrame
#' cyto_plot_compensation(fs[[1]],
#' channel_match = cmfile,
#' display = 1000
#' )
#'
#' # Compensation plots - flowSet
#' cyto_plot_compensation(fs,
#' channel_match = cmfile,
#' compensate = TRUE,
#' display = 1000
#' )
#'
#' # Compensation plots - GatingHierarchy
#' cyto_plot_compensation(gs[[1]],
#' parent = "Single Cells",
#' channel_match = cmfile,
#' display = 1000,
#' contour_lines = 10
#' )
#'
#' # Compensation plots - GatingSet
#' cyto_plot_compensation(gs,
#' parent = "Single Cells",
#' channel_match = cmfile,
#' display = 1000
#' )
#'
#' # Return "CytoExploreR_wd_check" to default
#' options("CytoExploreR_wd_check" = TRUE)
#'
#' @seealso \code{\link{cyto_spillover_compute}}
#' @seealso \code{\link{cyto_spillover_edit}}
#' @seealso \code{\link{cyto_spillover_spread_compute}}
#' @seealso \code{\link{cyto_plot}}
#'
#' @name cyto_plot_compensation
NULL
#' @noRd
#' @export
cyto_plot_compensation <- function(x, ...) {
UseMethod("cyto_plot_compensation")
}
#' @rdname cyto_plot_compensation
#' @export
cyto_plot_compensation.GatingSet <- function(x,
parent = NULL,
channel_match = NULL,
compensate = FALSE,
spillover = NULL,
axes_trans = NA,
axes_limits = "machine",
overlay = TRUE,
layout = NULL,
popup = FALSE,
title = NA,
header = NULL,
header_text_font = 2,
header_text_size = 1,
header_text_col = "black",
density_stack = 0,
density_fill = c(
"grey",
"blue"
),
density_fill_alpha = 0.5, ...) {
# PREPARE ARGUMENTS ----------------------------------------------------------
# PLOT METHOD
if (is.null(getOption("cyto_plot_method"))) {
options("cyto_plot_method" = "Comp/GatingSet")
}
# GRAPHICAL PARAMETERS
pars <- par(c("mfrow", "oma"))
on.exit(par(pars))
# COPY
x <- cyto_copy(x)
# EXPERIMENT DETAILS
pd <- cyto_details(x)
# TRANSFORMATIONS
axes_trans <- cyto_transformer_extract(x)
# CHANNELS
channels <- cyto_fluor_channels(x)
# APPLY COMPENSATION & TRANSFORMATIONS ---------------------------------------
# COMPENSATION
if(compensate){
# INVERSE TRANSFORMATIONS
if(!.all_na(axes_trans)){
fs <- cyto_extract(x, "root")
fs <- cyto_transform(fs,
trans = axes_trans,
inverse = TRUE,
plot = FALSE)
gs_cyto_data(x) <- fs
}
# COMPENSATE
x <- cyto_compensate(x, spillover = spillover)
# TRANSFORM
if(!.all_na(axes_trans)){
x <- cyto_transform(x,
trans = axes_trans,
plot = FALSE)
}else{
axes_trans <- cyto_transformer_biex(x, plot = FALSE)
x <- cyto_transform(x,
trans = axes_trans,
plot = FALSE)
}
}else{
# TRANSFORM
if(.all_na(axes_trans)){
axes_trans <- cyto_transformer_biex(x, plot = FALSE)
x <- cyto_transform(x,
trans = axes_trans,
plot = FALSE)
}
}
# PREPARE CHANNEL_MATCH ------------------------------------------------------
# CHANNEL MATCH MISSING
if (!"channel" %in% colnames(pd)) {
# TRY CHANNEL_MATCH
if (is.null(channel_match)) {
pd$channel <- paste(cyto_channel_select(x))
} else {
if (is(channel_match, "data.frame") |
is(channel_match, "matrix") |
is(channel_match, "tibble")) {
if (!all(c("name", "channel") %in% colnames(channel_match))) {
stop("channel_match must contain columns 'name' and 'channel'.")
}
cm <- channel_match
chans <- cm$channel[match_ind(cyto_names(x), rownames(cm))]
pd$channel <- paste(chans)
} else {
if (getOption("CytoExploreR_wd_check") == TRUE) {
if (file_wd_check(channel_match)) {
cm <- read.csv(channel_match,
header = TRUE,
row.names = 1,
stringsAsFactors = FALSE
)
chans <- cm$channel[match_ind(cyto_names(x), row.names(cm))]
pd$channel <- paste(chans)
} else {
stop(paste(channel_match, "is not in this working directory."))
}
} else {
cm <- read.csv(channel_match,
header = TRUE,
row.names = 1,
stringsAsFactors = FALSE
)
chans <- cm$channel[match_ind(cyto_names(x), row.names(cm))]
pd$channel <- paste(chans)
}
}
}
}
# PREPARE PARENTS ------------------------------------------------------------
# PARENT MISSING
if (is.null(parent)) {
if (!"parent" %in% colnames(pd)) {
if (!is.null(channel_match)) {
if ("parent" %in% colnames(cm)) {
parent <- cm[, "parent"]
pd[, "parent"] <- parent
} else {
nodes <- cyto_nodes(x, path = "auto")
parent <- rep(nodes[length(nodes)], length(x))
pd[, "parent"] <- parent
}
} else {
nodes <- cyto_nodes(x, path = "auto")
parent <- rep(nodes[length(nodes)], length(x))
pd[, "parent"] <- parent
}
}
} else {
parent <- rep(parent, length.out = length(x))
pd[, "parent"] <- parent
}
# CYTO_DETAILS
cyto_details(x) <- pd
# PREPARE POPULATIONS --------------------------------------------------------
# ISOLATE UNSTAINED CONTROL
if (any(grepl("unstained", pd[, "channel"], ignore.case = TRUE))) {
NIL <- x[[which(grepl("unstained", pd[, "channel"],
ignore.case = TRUE))[1]]]
x <- x[-which(grepl("unstained", pd[, "channel"],
ignore.case = TRUE))]
}
# EXTRACT POPULATIONS
fr_list <- lapply(seq_along(x), function(z){
cyto_extract(x[[z]],
pd[, "parent"][match_ind(cyto_names(x[[z]]), pd[, "name"])])
})
names(fr_list) <- cyto_names(x)
# EXTRACT UNSTAINED POPULATIONS
if(any(grepl("unstained", pd[, "channel"], ignore.case = TRUE))){
neg_pops <- lapply(seq_along(x), function(z) {
cyto_extract(NIL,
pd[, "parent"][match_ind(cyto_names(x[[z]]), pd[, "name"])])
})
names(neg_pops) <- cyto_names(x)
}
# PREPARE ARGUMENTS ----------------------------------------------------------
# ARGUMENTS
args <- .args_list(...)
# REMOVE UNNECESSARY ARGUMENTS
args <- args[-match_ind(c("pars",
"pd",
"channels",
"fs",
"cm",
"chans",
"parent",
"nodes",
"NIL",
"fr_list",
"neg_pops"),
names(args))]
# CONSTRUCT PLOTS ------------------------------------------------------------
# LOOP THROUGH CONTROLS
plots <- lapply(seq_along(fr_list), function(z){
# DATA
args[["x"]] <- fr_list[[z]]
# OVERLAY
if(args[["overlay"]]){
if(any(grepl("unstained", pd$channel, ignore.case = TRUE))){
args[["overlay"]] <- neg_pops[[z]]
}else{
args[["overlay"]] <- NA
}
}
# CHANNEL_MATCH
args[["channel_match"]] <- pd[pd[, "name"] == cyto_names(args[["x"]]),
"channel"]
# COMPENSATE
args[["compensate"]] <- FALSE
# CYTO_PLOT_COMPENSATION
do.call("cyto_plot_compensation", args)
})
# RECORD/SAVE PLOTS ----------------------------------------------------------
# Turn off graphics device for saving
if (getOption("cyto_plot_save")) {
if (is(x, basename(getOption("cyto_plot_method")))) {
# CLOSE GRAPHICS DEVICE
dev.off()
# RESET CYTO_PLOT_SAVE
options("cyto_plot_save" = FALSE)
# RESET CYTO_PLOT_METHOD
options("cyto_plot_method" = NULL)
}
}
# RETURN RECORDED PLOTS
invisible(plots)
}
#' @rdname cyto_plot_compensation
#' @export
cyto_plot_compensation.GatingHierarchy <- function(x,
parent = NULL,
channel_match = NULL,
compensate = FALSE,
spillover = NULL,
axes_trans = NA,
axes_limits = "machine",
layout = NULL,
popup = FALSE,
title = NA,
header,
header_text_font = 2,
header_text_size = 1,
header_text_col = "black",
density_stack = 0,
density_fill = c(
"grey",
"blue"
),
density_fill_alpha = 0.5,
...) {
# PREPARE ARGUMENTS ----------------------------------------------------------
# PLOT METHOD
if (is.null(getOption("cyto_plot_method"))) {
options("cyto_plot_method" = "Comp/GatingHierarchy")
}
# GRAPHICAL PARAMETERS
pars <- par(c("mfrow", "oma"))
on.exit(par(pars))
# PARENT
if (is.null(parent)) {
parent <- cyto_nodes(x, path = "auto")[length(cyto_nodes(x))]
message(paste(
"No parent supplied -",
parent,
"population will be used for plots."
))
}
# TRANSFORMATIONS
axes_trans <- cyto_transformer_extract(x)
# EXTRACT POPULATION
x <- cyto_extract(x, parent, copy = TRUE)
# ARGUMENTS
args <- .args_list(...)
# REMOVE UNNECESSARY ARGUMENTS
args <- args[-match_ind(c("pars", "parent"), names(args))]
# CONSTRUCT PLOTS ------------------------------------------------------------
# CYTO_PLOT_COMPENSATION
plots <- do.call("cyto_plot_compensation", args)
# RECORD/SAVE ----------------------------------------------------------------
# Turn off graphics device for saving
if (getOption("cyto_plot_save")) {
if (is(x, basename(getOption("cyto_plot_method")))) {
# Close graphics device
dev.off()
# Reset cyto_plot_save
options("cyto_plot_save" = FALSE)
# Reset cyto_plot_method
options("cyto_plot_method" = NULL)
}
}
# RETURN RECORDED PLOTS
invisible(plots)
}
#' @rdname cyto_plot_compensation
#' @export
cyto_plot_compensation.flowSet <- function(x,
channel_match = NULL,
compensate = FALSE,
spillover = NULL,
axes_trans = NA,
axes_limits = "machine",
overlay = TRUE,
layout = NULL,
popup = FALSE,
title = NA,
header = NULL,
header_text_font = 2,
header_text_size = 1,
header_text_col = "black",
density_stack = 0,
density_fill = c(
"grey",
"blue"
),
density_fill_alpha = 0.5, ...) {
# PREPARE ARGUMENTS ----------------------------------------------------------
# SET PLOT METHOD
if (is.null(getOption("cyto_plot_method"))) {
options("cyto_plot_method" = "Comp/flowSet")
}
# GRAPHICAL PARAMETERS
pars <- par(c("mfrow", "oma"))
on.exit(par(pars))
# COPY
fs <- cyto_copy(x)
# SAMPLES
smp <- length(fs)
# EXPERIMENT DETAILS
pd <- cyto_details(fs)
# CHANNELS
channels <- cyto_fluor_channels(fs)
# APPLY COMPENSATION & TRANSFORMATIONS ---------------------------------------
# COMPENSATION
if (compensate == TRUE) {
# INVERSE TRANSFORMATIONS
if (!.all_na(axes_trans)) {
fs <- cyto_transform(fs,
trans = axes_trans,
inverse = TRUE,
plot = FALSE
)
}
# COMPENSATE
fs <- cyto_compensate(fs,
spillover = spillover
)
# TRANSFORM
if(!.all_na(axes_trans)){
fs <- cyto_transform(fs,
trans = axes_trans,
plot = FALSE
)
}else{
axes_trans <- cyto_transformer_biex(fs,
plot = FALSE)
fs <- cyto_transform(fs,
trans = axes_trans,
plot = FALSE
)
}
}else{
# TRANSFORM
if(.all_na(axes_trans)){
axes_trans <- cyto_transformer_biex(fs,
plot = FALSE)
fs <- cyto_transform(fs,
trans = axes_trans,
plot = FALSE)
}
}
# CHANNEL MATCHING -----------------------------------------------------------
# CHANNEL MATCH MISSING
if (is.null(channel_match)) {
pd$channel <- cyto_channel_select(fs)
# CHANNEL MATCH SUPPLIED
} else {
# CHANNEL/MARKER
if (is.character(channel_match) &
channel_match %in% c(channels, cyto_markers_extract(fs, channels))) {
pd$channel <- cyto_channels_extract(fs, channel_match)
# CHANNEL MATCH OBJECT/STRING
} else {
# CHANNEL MATCH OBJECT
if (is(channel_match, "data.frame") |
is(channel_match, "matrix") |
is(channel_match, "tibble")) {
if (!all(c("name", "channel") %in% colnames(channel_match))) {
stop("channel_match must contain columns 'name' and 'channel'.")
}
ind <- match_ind(cyto_names(fs), rownames(channel_match))
pd$channel <- channel_match$channel[ind]
} else {
if (getOption("CytoExploreR_wd_check") == TRUE) {
if (file_wd_check(channel_match)) {
channel_match <- read.csv(channel_match,
header = TRUE,
row.names = 1,
stringsAsFactors = FALSE
)
ind <- match_ind(cyto_names(fs), row.names(channel_match))
pd$channel <- channel_match$channel[ind]
} else {
stop(paste(channel_match, "is not in this working directory."))
}
} else {
channel_match <- read.csv(channel_match,
header = TRUE,
row.names = 1,
stringsAsFactors = FALSE
)
ind <- match_ind(cyto_names(fs), row.names(channel_match))
pd$channel <- channel_match$channel[ind]
}
}
}
}
# PREPARE DATA AND ARGUMENTS -------------------------------------------------
# FLOWFRAME LIST
fr_list <- cyto_convert(fs, "list of flowFrames")
names(fr_list) <- cyto_names(fs)
# ISOLATE UNSTAINED CONTROL
if (any(grepl("unstained", pd$channel, ignore.case = TRUE))) {
NIL <- fr_list[which(grepl("unstained", pd$channel, ignore.case = TRUE))[1]]
fr_list <- fr_list[-which(grepl("unstained", pd$channel, ignore.case = TRUE))]
NIL <- rep(NIL, length.out = length(fr_list))
}
# PULL DOWN ARGUMENTS
args <- .args_list(...)
# REMOVE UNNECESSARY ARGUMENTS
args <- args[-match_ind(c("pars",
"fs",
"pd",
"smp",
"channels",
"ind",
"fr_list",
"NIL"),
names(args))]
# CONSTRUCT PLOTS ------------------------------------------------------------
plots <- lapply(seq_along(fr_list), function(z){
# DATA
args[["x"]] <<- fr_list[[z]]
# OVERLAY
if(args[["overlay"]]){
if("Unstained" %in% pd$channel){
args[["overlay"]] <- NIL[[z]]
}else{
args[["overlay"]] <- NA
}
}
# CHANNEL_MATCH
args[["channel_match"]] <- pd[pd[, "name"] == cyto_names(args[["x"]]),
"channel"]
# COMPENSATE
args[["compensate"]] <- FALSE
# CYTO_PLOT_COMPENSATION
do.call("cyto_plot_compensation", args)
})
names(plots) <- cyto_names(fr_list)
# RECORD/SAVE ----------------------------------------------------------------
# TURN OFF GRAPHICS DEVICE FOR SAVING
if (getOption("cyto_plot_save")) {
if (is(x, basename(getOption("cyto_plot_method")))) {
# CLOSE GRAPHICS DEVICE
dev.off()
# RESET CYTO_PLOT_SAVE
options("cyto_plot_save" = FALSE)
# RESET CYTO_PLOT_METHOD
options("cyto_plot_method" = NULL)
}
}
# RETURN RECORDED PLOTS
invisible(plots)
}
#' @rdname cyto_plot_compensation
#' @export
cyto_plot_compensation.flowFrame <- function(x,
channel_match = NULL,
compensate = FALSE,
spillover = NULL,
axes_trans = NA,
axes_limits = "machine",
layout = NULL,
popup = FALSE,
title = NA,
header = NULL,
header_text_font = 2,
header_text_size = 1,
header_text_col = "black",
density_stack = 0,
density_fill = c(
"grey",
"blue"
),
density_fill_alpha = 0.5, ...) {
# PREPARE ARGUMENTS ----------------------------------------------------------
# SET PLOT METHOD
if (is.null(getOption("cyto_plot_method"))) {
options("cyto_plot_method" = "Comp/flowFrame")
}
# GRAPHICS PARAMETERS
pars <- par(c("mfrow", "oma"))
on.exit(par(pars))
# COPY
fr <- cyto_copy(x)
# SAMPLES
nm <- cyto_names(fr)
# CHANNELS
channels <- cyto_fluor_channels(fr)
# APPLY COMPENSATION & TRANSFORMATIONS ---------------------------------------
# COMPENSATION
if (compensate == TRUE) {
# INVERSE TRANSFORMATIONS
if (!.all_na(axes_trans)) {
fr <- cyto_transform(fr,
trans = axes_trans,
inverse = TRUE,
plot = FALSE
)
}
# COMPENSATE
fr <- cyto_compensate(fr,
spillover = spillover
)
# TRANSFORM
fr <- cyto_transform(fr,
trans = axes_trans,
plot = FALSE
)
}else{
# TRANSFORM
if(.all_na(axes_trans)){
axes_trans <- cyto_transformer_biex(fr,
plot = FALSE)
fr <- cyto_transform(fr,
trans = axes_trans,
plot = FALSE
)
}
}
# CHANNEL MATCHING -----------------------------------------------------------
# CHANNEL MATCH MISSING
if (is.null(channel_match)) {
chan <- cyto_channel_select(fr)
# CHANNEL MATCH SUPPLIED
} else {
# CHANNEL/MARKER
if (is.character(channel_match) &
channel_match %in% c(channels, cyto_markers_extract(fr, channels))) {
chan <- cyto_channels_extract(fr, channel_match)
# CHANNEL MATCH OBJECT/STRING
} else {
# CHANNEL MATCH OBJECT
if (is(channel_match, "data.frame") |
is(channel_match, "matrix") |
is(channel_match, "tibble")) {
if (!all(c("name", "channel") %in% colnames(channel_match))) {
stop("channel_match must contain columns 'name' and 'channel'.")
}
ind <- match_ind(cyto_names(fr), rownames(channel_match))
chan <- channel_match$channel[ind]
} else {
if (getOption("CytoExploreR_wd_check") == TRUE) {
if (file_wd_check(channel_match)) {
channel_match <- read.csv(channel_match,
header = TRUE,
row.names = 1,
stringsAsFactors = FALSE
)
ind <- match_ind(cyto_names(fr), row.names(channel_match))
chan <- channel_match$channel[ind]
} else {
stop(paste(channel_match, "is not in this working directory."))
}
} else {
channel_match <- read.csv(channel_match,
header = TRUE,
row.names = 1,
stringsAsFactors = FALSE
)
ind <- match_ind(cyto_names(fr), row.names(channel_match))
chan <- channel_match$channel[ind]
}
}
}
}
# PREPARE PLOT LAYOUT --------------------------------------------------------
# POPUP
if (popup == TRUE) {
cyto_plot_new(popup)
}
# LAYOUT - FLOWSET METHOD EMPTY
if (is.null(layout)) {
layout <- c(
n2mfrow(length(channels))[2],
n2mfrow(length(channels))[1]
)
par(mfrow = layout)
} else {
if (layout[1] == FALSE) {
# Do nothing
} else {
par(mfrow = layout)
}
}
# TITLE
if (is.null(header)) {
header <- cyto_names(fr)
}
# TITLE SPACE
if (!.all_na(header)) {
par(oma = c(0, 0, 3, 0))
}
# SHEETS
sheets <- ceiling(length(channels)/prod(layout))
full_sheets <- seq_len(sheets)*prod(layout)
# CONSTRUCT PLOTS ------------------------------------------------------------
# PLOTS
plots <- lapply(seq_len(length(channels)), function(y) {
# DENSITY - MATCHING CHANNELS
if (chan == channels[y]) {
cyto_plot(fr,
channels = chan,
axes_trans = axes_trans,
axes_limits = axes_limits,
legend = FALSE,
title = title,
density_stack = density_stack,
density_fill = rev(density_fill),
density_fill_alpha = density_fill_alpha, ...
)
# SCATTER - NON-MATCHING CHANNELS
} else {
cyto_plot(fr,
channels = c(chan, channels[y]),
axes_trans = axes_trans,
axes_limits = axes_limits,
legend = FALSE,
title = title, ...
)
}
# HEADER
if (y %in% c(full_sheets,
length(channels))) {
if (!.all_na(header)) {
mtext(header,
outer = TRUE,
cex = header_text_size,
font = header_text_font,
col = header_text_col
)
}
}
# POPUP
if (popup){
if(y %in% full_sheets){
if(y != length(channels)){
# SHEET
cyto_plot_new(popup)
# LAYOUT
par(mfrow = layout)
# HEADER
if (!.all_na(header)) {
par(oma = c(0, 0, 3, 0))
}
}
}
}
# RECORD PLOT
if (y %in% c(full_sheets,
length(channels))) {
cyto_plot_record()
} else {
return(NA)
}
})
plots <- plots[!LAPPLY(plots, ".all_na")]
names(plots) <- rep(chan, length(plots))
# RECORD/SAVE ----------------------------------------------------------------
# TURN OFF GRAPHICS DEVICE FOR SAVING
if (getOption("cyto_plot_save")) {
if (is(fr, basename(getOption("cyto_plot_method")))) {
# CLOSE GRAPHICS DEVICE
dev.off()
# RESET CYTO_PLOT_SAVE
options("cyto_plot_save" = FALSE)
# RESET CYTO_PLOT_METHOD
options("cyto_plot_method" = NULL)
}
}
# RETURN RECORDED PLOTS
invisible(plots)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.