R/cyto_plot_compensation.R

In DillonHammill/CytoExploreR: Interactive Analysis of Cytometry Data

## 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)
}