R/cyto_plot_profile-methods.R

In DillonHammill/cytoSuite: Compensation, Gating & Visualisation Toolkit for Analysis of Flow Cytometry Data

#' Plot Expression Profile in All Fluorescent Channels
#'
#' @param x object of class \code{\link[flowCore:flowFrame-class]{flowFrame}},
#'   \code{\link[flowCore:flowSet-class]{flowSet}},
#'   \code{\link[flowWorkspace:GatingHierarchy-class]{GatingHierarchy}} or
#'   \code{\link[flowWorkspace:GatingSet-class]{GatingSet}}.
#' @param ... additional method-specific arguments.
#'
#' @importFrom flowCore exprs
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot_profile,flowFrame-method}}
#' @seealso \code{\link{cyto_plot_profile,flowSet-method}}
#' @seealso \code{\link{cyto_plot_profile,GatingSet-method}}
#'
#' @export
setGeneric(
  name = "cyto_plot_profile",
  def = function(x, ...) {
    standardGeneric("cyto_plot_profile")
  }
)

#' Plot Expression Profile in All Fluorescent Channels - flowFrame Method
#'
#' @param x object of class \code{\link[flowCore:flowFrame-class]{flowFrame}}.
#' @param channels a vector channels to use to construct the plots, set to all
#'   channels by default.
#' @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
#'   transform object will be used internally to ensure axes labels of the plot
#'   are appropriately transformed. The transform object will NOT be applied to
#'   the flowFrame internally and should be applied to the flowFrame prior to
#'   plotting.
#' @param layout vector of grid dimensions \code{c(#rows,#columns)}.
#' @param title a title for the plots, set to the file name of x by default.
#' @param ... additional arguments passed to
#'   \code{\link{cyto_plot,flowFrame-method}}.
#'
#' @importFrom flowCore exprs
#' @importFrom grDevices n2mfrow
#' @importFrom graphics par mtext
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot,flowFrame-method}}
#' @seealso \code{\link{cyto_plot_profile,flowSet-method}}
#' @seealso \code{\link{cyto_plot_profile,GatingSet-method}}
#'
#' @examples
#' library(CytoRSuiteData)
#' 
#' # Load in samples
#' 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)
#' 
#' # Gate using gate_draw
#' gt <- Activation_gatingTemplate
#' gating(gt, gs)
#' 
#' # Plot expression profile in all channels
#' cyto_plot_profile(getData(gs, "T Cells")[[4]],
#'   axes_trans = trans
#' )
#' @export
setMethod(cyto_plot_profile,
  signature = "flowFrame",
  definition = function(x,
                          channels = NULL,
                          axes_trans = NULL,
                          layout = NULL,
                          title = NA, ...) {

    # Assign x to fr
    fr <- x

    # Extract data for axes limits
    fr.exprs <- exprs(fr)

    # Missing channels
    if (is.null(channels)) {
      channels <- BiocGenerics::colnames(fr)
      channels <- channels[channels != "Time"]
    }

    # Check channels
    channels <- cyto_channel_check(
      x = fr,
      channels = channels,
      plot = FALSE
    )

    # Transformations
    axes_trans <- .getCompleteTransList(fr, axes_trans)
    axes_trans <- cyto_trans_check(axes_trans, inverse = FALSE)

    # Grid layout
    if (is.null(layout)) {
      layout <- c(n2mfrow(length(channels))[2], n2mfrow(length(channels))[1])
      par(mfrow = layout)
    } else if (!is.null(layout)) {
      if (layout[1] == FALSE) {

        # Do nothing
      } else {
        par(mfrow = layout)
      }
    }

    # Title space
    if (!is.null(title)) {
      par(oma = c(0, 0, 3, 0))
    }

    # Plots
    lapply(channels, function(channel) {
      cyto_plot(fr,
        channels = channel,
        axes_trans = axes_trans,
        title = NA, ...
      )
    })

    # Plot title
    if (!is.null(title) & is.na(title)) {
      title <- fr@description$GUID
    }

    # Add title
    if (!is.null(title)) {
      mtext(title, outer = TRUE, cex = 1, font = 2)
    }

    # Return defaults
    par(mfrow = c(1, 1))
    par(oma = c(0, 0, 0, 0))
  }
)

#' Plot Expression Profile in All Fluorescent Channels - flowSet Method
#'
#' @param x object of class \code{\link[flowCore:flowSet-class]{flowSet}}.
#' @param channels a vector channels to use to construct the plots, set to all
#'   channels by default.
#' @param group_by a vector of pData variables to sort and merge samples into
#'   groups, set to FALSE by default to prevent merging. To merge all samples
#'   set this argument to "all".
#' @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
#'   transform object will be used internally to ensure axes labels of the plot
#'   are appropriately transformed. The transform object will NOT be applied to
#'   the flowFrame internally and should be applied to the flowFrame prior to
#'   plotting.
#' @param title a title for the plots, set to the file name of x by default.
#' @param density_stack numeric [0,1] indicating the degree of offset for
#'   overlaid populations, set to 0.5 by default.
#' @param ... additional arguments passed to
#'   \code{\link{cyto_plot,flowFrame-method}}.
#'
#' @importFrom flowCore exprs
#' @importFrom methods as
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot,flowFrame-method}}
#' @seealso \code{\link{cyto_plot_profile,flowFrame-method}}
#' @seealso \code{\link{cyto_plot_profile,GatingSet-method}}
#'
#' @examples
#' library(CytoRSuiteData)
#' 
#' # Load in samples
#' 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)
#' 
#' # Gate using gate_draw
#' gt <- Activation_gatingTemplate
#' gating(gt, gs)
#' 
#' # Plot expression profile in all channels
#' cyto_plot_profile(getData(gs, "T Cells"),
#'   axes_trans = trans
#' )
#' @export
setMethod(cyto_plot_profile,
  signature = "flowSet",
  definition = function(x,
                          channels = NULL,
                          group_by = FALSE,
                          axes_trans = NULL,
                          title = NA,
                          density_stack = 0.5, ...) {

    # Assign x to fs
    fs <- x

    # Title
    if (is.na(title)) {
      title <- "Expression Profile"
    }

    # Merge - list of flowFrames
    if (group_by == FALSE) {
      fr.lst <- lapply(seq_along(fs), function(x) {
        fs[[x]]
      })
    } else {
      if (group_by == TRUE) {
        group_by <- "all"
      }
      fr.lst <- .cyto_merge(fs, group_by = group_by)
    }

    # cyto_plot_profile
    if (length(fr.lst) == 1) {
      cyto_plot_profile(
        x = fr.lst[[1]],
        channels = channels,
        axes_trans = axes_trans,
        title = title,
        legend_text = NA, ...
      )
    } else {
      cyto_plot_profile(
        x = fr.lst[[1]],
        overlay = fr.lst[2:length(fr.lst)],
        channels = channels,
        axes_trans = axes_trans,
        title = title,
        density_stack = density_stack, ...
      )
    }
  }
)

#' Plot Expression Profile in All Fluorescent Channels - GatingSet Method
#'
#' @param x object of class
#'   \code{\link[flowWorkspace:GatingSet-class]{GatingSet}}.
#' @param channels a vector channels to use to construct the plots, set to all
#'   channels by default.
#' @param parent name of the population used to construct the plot.
#' @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
#'   transform object will be used internally to ensure axes labels of the plot
#'   are appropriately transformed. The transform object will NOT be applied to
#'   the flowFrame internally and should be applied to the flowFrame prior to
#'   plotting.
#' @param ... additional arguments passed to
#'   \code{\link{cyto_plot,flowFrame-method}}.
#'
#' @importFrom flowCore exprs transformList
#' @importFrom flowWorkspace getData transformerList getTransformations
#' @importFrom grDevices n2mfrow
#' @importFrom graphics par mtext plot.new
#' @importFrom utils read.csv
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot,flowFrame-method}}
#' @seealso \code{\link{cyto_plot_profile,flowFrame-method}}
#' @seealso \code{\link{cyto_plot_profile,flowSet-method}}
#'
#' @examples
#' library(CytoRSuiteData)
#' 
#' # Load in samples
#' 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)
#' 
#' # Gate using gate_draw
#' gt <- Activation_gatingTemplate
#' gating(gt, gs)
#' 
#' # Plot expression profile in all channels
#' cyto_plot_profile(gs,
#'   parent = "T Cells"
#' )
#' @export
setMethod(cyto_plot_profile,
  signature = "GatingSet",
  definition = function(x,
                          parent = NULL,
                          channels = NULL,
                          axes_trans = NULL, ...) {

    # Parent missing
    if (is.null(parent)) {
      stop("Please supply the name of the parent population to plot.")
    }

    # Assign x to gs
    gs <- x

    # Extract population
    fs <- getData(gs, parent)

    # Missing channels
    if (is.null(channels)) {
      channels <- BiocGenerics::colnames(fs[[1]])
      channels <- channels[channels != "Time"]
    }

    # Check channels
    channels <- cyto_channel_check(
      x = fs,
      channels = channels,
      plot = FALSE
    )

    # Transformations
    axes_trans <- .getCompleteTransList(gs, axes_trans)
    axes_trans <- cyto_trans_check(axes_trans, inverse = FALSE)

    # Transformed data
    fs <- .getTransformedData(fs, axes_trans)

    # Plots
    cyto_plot_profile(
      x = fs,
      channels = channels,
      axes_trans = axes_trans, ...
    )
  }
)