R/cyto_plot_compensation-methods.R

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

#' Plot Compensation in All Fluorescent Channels
#'
#' Plot each compensation control in all fluorescent channels to identify any
#' potential compensation issues. The unstained control is overlaid in black as
#' a reference.
#'
#' @param x object of class \code{\link[flowCore:flowFrame-class]{flowFrame}} or
#'   \code{\link[flowCore:flowSet-class]{flowSet}} or
#'   \code{\link[flowWorkspace:GatingSet-class]{GatingSet}} containing gated
#'   compensation controls and an unstained control.
#' @param ... additional method-specific arguments.
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot_compensation,flowFrame-method}}
#' @seealso \code{\link{cyto_plot_compensation,flowSet-method}}
#' @seealso \code{\link{cyto_plot_compensation,GatingSet-method}}
#'
#' @export
setGeneric(
  name = "cyto_plot_compensation",
  def = function(x, ...) {
    standardGeneric("cyto_plot_compensation")
  }
)

#' Plot Compensation in All Fluorescent Channels - flowFrame Method
#'
#' Plot each compensation control in all fluorescent channels to identify any
#' potential compensation issues. The unstained control is overlaid in black as
#' a reference.
#'
#' @param x object of class \code{\link[flowCore:flowFrame-class]{flowFrame}}
#'   containing gated compensation controls and an unstained control.
#' @param channel_match name of the fluorescent channel associated with the
#'   \code{\link[flowCore:flowFrame-class]{flowFrame}}. 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_file 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 \code{flowFrame} and applied to the sample when
#'   \code{compensate} is TRUE.
#' @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)} 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.
#' @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 ... additional arguments passed to
#'   \code{\link{cyto_plot,flowFrame-method}}.
#'
#' @importFrom flowWorkspace sampleNames pData
#' @importFrom flowCore parameters compensate
#' @importFrom utils read.csv
#' @importFrom grDevices n2mfrow
#' @importFrom graphics par mtext
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot,flowFrame-method}}
#'
#' @examples
#' library(CytoRSuiteData)
#' 
#' # Don't run - bypass directory check for external files
#' options("CytoRSuite_wd_check" = FALSE)
#' 
#' # Load in compensation controls
#' gs <- GatingSet(Compensation)
#' 
#' # Gate single cells using gate_draw
#' gt <- Compensation_gatingTemplate
#' gating(gt, gs)
#' 
#' # Compensation plots
#' cyto_plot_compensation(getData(gs, "Single Cells")[[1]],
#'   channel_match = "7-AAD-A",
#'   overlay = getData(gs, "Single Cells")[[4]]
#' )
#' 
#' # Don't run - return "CytoRSuite_wd_check" to default
#' options("CytoRSuite_wd_check" = TRUE)
#' @export
setMethod(cyto_plot_compensation,
  signature = "flowFrame",
  definition = function(x,
                          channel_match = NULL,
                          compensate = FALSE,
                          spillover = NULL,
                          axes_trans = NULL,
                          layout,
                          popup = FALSE,
                          title = NA,
                          header = NA,
                          header_text_font = 2,
                          header_text_size = 1,
                          header_text_col = "black", ...) {

    # Assign x to fr
    fr <- x

    # Sample names
    nm <- fr@description$GUID

    # Extract channels
    channels <- cyto_fluor_channels(fr)

    # Compensation
    if (compensate == TRUE) {
      if (is.null(spillover)) {
        spill <- fr@description$SPILL
        fr <- suppressMessages(compensate(fr, spill))
      } else if (!is.null(spillover)) {
        if (inherits(spillover, "matrix") |
          inherits(spillover, "data.frame") |
          inherits(spillover, "tibble")) {
          spill <- spillover
        } else {
          if (getOption("CytoRSuite_wd_check") == TRUE) {
            if (.file_wd_check(spillover)) {
              spill <- read.csv(spillover, header = TRUE, row.names = 1)
              colnames(spill) <- rownames(spill)
            } else {
              message(paste(spillover, "is not in this working directory."))
              spill <- fr@description$SPILL
            }
          } else {
            spill <- read.csv(spillover, header = TRUE, row.names = 1)
            colnames(spill) <- rownames(spill)
          }
        }
        fr <- suppressMessages(compensate(fr, spill))
      }
    }

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

    # Transfomed Data
    fr <- .getTransformedData(fr, axes_trans)

    # Select channel associated with flowFrame
    if (is.null(channel_match)) {
      chan <- cyto_channel_select(fr)
    } else {
      chan <- channel_match
    }

    # Pop-up
    if (popup == TRUE) {
      .cyto_plot_window()
    }

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

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

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

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

    # Plots
    lapply(seq_len(length(channels)), function(y) {
      cyto_plot(fr,
        channels = c(chan, channels[y]),
        axes_trans = axes_trans,
        legend = FALSE,
        title = title, ...
      )

      if (channels[y] == channels[length(channels)]) {
        if (!is.null(header)) {
          mtext(header,
            outer = TRUE,
            cex = header_text_size,
            font = header_text_font,
            col = header_text_col
          )
        }
      }
    })

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

#' Plot Compensation in All Fluorescent Channels - flowSet Method
#'
#' Plot each compensation control in all fluorescent channels to identify any
#' potential compensation issues. The unstained control is overlaid in black as
#' a reference.
#'
#' @param x object of class \code{\link[flowCore:flowSet-class]{flowSet}}
#'   containing gated compensation controls and an unstained control.
#' @param channel_match name of a csv file with two columns, the first
#'   called "name" lists the names of each compensation control and the second
#'   "channel" lists the fluorescent channel associated with each of the
#'   compensation controls. Use "Unstained" in the channel column for the
#'   universal unstained control. No need to construct this file manually as
#'   users will be guided through this process if the \code{channel_match}
#'   is missing.
#' @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_file argument the spillover matrix will
#'   extracted from the samples.
#' @param spillover name of spillover matrix csv file including .csv file
#'   extension to apply to samples when \code{compensate} is TRUE. If no
#'   \code{spillover} is supplied the spillover matrix will be extracted
#'   directly from the \code{flowSet} and applied to the samples when
#'   \code{compensate} is TRUE.
#' @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 overlay logical indicating whether the unstained control should be
#'   overlaid onto the plot if supplied in the flowSet, 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 vector of titles to use for the plots, set to the name of the
#'   sample by default.
#' @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 ... additional arguments passed to
#'   \code{\link{cyto_plot,flowFrame-method}}.
#'
#' @importFrom flowWorkspace sampleNames pData
#' @importFrom flowCore parameters compensate fsApply
#' @importFrom ncdfFlow ncfsApply
#' @importFrom utils read.csv write.csv
#' @importFrom methods as
#' @importFrom grDevices n2mfrow
#' @importFrom graphics par mtext plot.new
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @examples
#' library(CytoRSuiteData)
#' 
#' # Don't run - bypass directory check for external files
#' options("CytoRSuite_wd_check" = FALSE)
#' 
#' # Load in compensation controls
#' gs <- GatingSet(Compensation)
#' 
#' # Gate single cells using gate_draw
#' gt <- Compensation_gatingTemplate
#' gating(gt, gs)
#' 
#' # Channel match file
#' cmfile <- system.file("extdata",
#'   "Compensation-Channels.csv",
#'   package = "CytoRSuiteData"
#' )
#' 
#' # Compensation plots
#' cyto_plot_compensation(getData(gs, "Single Cells"),
#'   channel_match = cmfile
#' )
#' 
#' # Don't run - return "CytoRSuite_wd_check" to default
#' options("CytoRSuite_wd_check" = TRUE)
#' @seealso \code{\link{cyto_plot,flowFrame-method}}
#'
#' @export
setMethod(cyto_plot_compensation,
  signature = "flowSet",
  definition = function(x,
                          channel_match = NULL,
                          compensate = FALSE,
                          spillover = NULL,
                          axes_trans = NULL,
                          overlay = TRUE,
                          layout,
                          popup = FALSE,
                          title = NA,
                          header = NA,
                          header_text_font = 2,
                          header_text_size = 1,
                          header_text_col = "black", ...) {

    # Assign x to fs
    fs <- x

    # Number of samples
    smp <- length(fs)

    # Extract channels
    channels <- cyto_fluor_channels(fs)

    # Compensation
    if (compensate == TRUE) {
      if (is.null(spillover)) {
        spill <- fs[[1]]@description$SPILL
      } else if (!is.null(spillover)) {
        if (inherits(spillover, "matrix") |
          inherits(spillover, "data.frame") |
          inherits(spillover, "tibble")) {
          spill <- spillover
        } else {
          if (getOption("CytoRSuite_wd_check") == TRUE) {
            if (.file_wd_check(spillover)) {
              spill <- read.csv(spillover, header = TRUE, row.names = 1)
              colnames(spill) <- rownames(spill)
            } else {
              message(paste(spillover, "is not in this working directory."))
              spill <- fs[[1]]@description$SPILL
            }
          } else {
            spill <- read.csv(spillover, header = TRUE, row.names = 1)
            colnames(spill) <- rownames(spill)
          }
        }

        if (inherits(fs, "ncdfFlowSet") == TRUE) {
          fs <- suppressMessages(ncfsApply(fs, function(fr) {
            compensate(fr, spill)
          }))
        } else if (inherits(fs, "flowSet")) {
          fs <- suppressMessages(fsApply(fs, function(fr) {
            compensate(fr, spill)
          }))
        }
      }
    }

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

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

    # Extract pData information
    pd <- pData(fs)

    # Channel match file
    if (is.null(channel_match)) {

      # No channel_match file supplied
      message("Select a channel for each sample from the dropdown menu.")
      pd$channel <- paste(cyto_channel_select(fs))

      # Save new channel_match csv file
      message("Saving channel selections to 'Compensation-Channels.csv'.")
      write.csv(pd, "Compensation-Channels.csv", row.names = FALSE)
    } else if (!is.null(channel_match)) {
      if (getOption("CytoRSuite_wd_check") == TRUE) {
        if (.file_wd_check(channel_match) == FALSE) {
          message(paste(channel_match, "is not in this working directory."))
          pd$channel <- paste(cyto_channel_select(fs))
        } else {
          cm <- read.csv(channel_match, header = TRUE, row.names = 1)
          chans <- cm$channel[match(sampleNames(fs), row.names(cm))]
          pd$channel <- paste(chans)
        }
      } else {
        cm <- read.csv(channel_match, header = TRUE, row.names = 1)
        chans <- cm$channel[match(sampleNames(fs), row.names(cm))]
        pd$channel <- paste(chans)
      }
    }

    # Pull out unstained control if supplied
    if ("Unstained" %in% pd$channel) {
      unst <- TRUE
      NIL <- fs[[match("Unstained", pd$channel)]]
      fs <- fs[-match("Unstained", pd$channel)]
      smp <- smp - 1
    } else {
      unst <- FALSE
    }

    # Sample names
    nms <- sampleNames(fs)

    # Restrict pd to fs
    pd <- pd[!pd$channel == "Unstained", ]

    # Convert fs into list of flowFrames
    fs.lst <- lapply(seq(1, smp, 1), function(x) fs[[x]])

    # Pop-up
    if (popup == TRUE) {
      .cyto_plot_window()
    }

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

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

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

    # Title
    if (!is.null(header) & is.na(header)) {
      header <- nms
    }

    # Loop through fs.lst
    lapply(1:smp, function(x) {
      lapply(seq_len(length(channels)), function(y) {
        if (unst == TRUE & overlay == TRUE) {
          cyto_plot(fs.lst[[x]],
            channels = c(pd$channel[x], channels[y]),
            overlay = NIL,
            axes_trans = axes_trans,
            legend = FALSE,
            title = title, ...
          )
        } else {
          cyto_plot(fs.lst[[x]],
            channels = c(pd$channel[x], channels[y]),
            axes_trans = axes_trans,
            legend = FALSE,
            title = title, ...
          )
        }

        # Call new plot
        if (x != smp & channels[y] == channels[length(channels)]) {
          if (!is.null(header)) {
            mtext(header[x],
              outer = TRUE,
              cex = header_text_size,
              font = header_text_font,
              col = header_text_col
            )
          }

          if (popup == TRUE) {
            .cyto_plot_window()
            par(mfrow = layout)
            par(oma = c(0, 0, 3, 0))
          } else {
            plot.new()
            par(mfrow = layout)
            par(oma = c(0, 0, 3, 0))
          }
        } else if (x == smp & channels[y] == channels[length(channels)]) {
          if (!is.null(header)) {
            mtext(header[x],
              outer = TRUE,
              cex = header_text_size,
              font = header_text_font,
              col = header_text_col
            )
          }
        }
      })
    })

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

#' Plot Compensation in All Fluorescent Channels - GatingSet Method
#'
#' Plot each compensation control in all fluorescent channels to identify any
#' potential compensation issues. The unstained control is overlaid in black as
#' a reference.
#'
#' @param x object of class
#'   \code{\link[flowWorkspace:GatingSet-class]{GatingSet}} containing gated
#'   compensation controls and an unstained control.
#' @param parent name of the population to plot.
#' @param channel_match name of a csv file with two columns, the first called
#'   "name" lists the names of each compensation control and the second
#'   "channel" lists the fluorescent channel associated with each of the
#'   compensation controls. Use "Unstained" in the channel column for the
#'   universal unstained control. No need to construct this file manually as
#'   users will be guided through this process if the \code{channel_match} is
#'   missing.
#' @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_file argument the spillover matrix will
#'   extracted from the samples.
#' @param spillover name of spillover matrix csv file including .csv file
#'   extension to apply to samples when \code{compensate} is TRUE. If no
#'   \code{spillover} is supplied the spillover matrix will be extracted
#'   directly from the \code{GatingSet} and applied to the samples when
#'   \code{compensate} is TRUE.
#' @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)} for each
#'   plot.
#' @param overlay logical indicating whether the unstained control should be
#'   overlaid onto the plot if supplied in the flowSet, set to \code{TRUE} by
#'   default.
#' @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 vector of titles to use for the plots, set to the name of the
#'   sample by default.
#' @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 ... additional arguments passed to
#'   \code{\link{cyto_plot,flowFrame-method}}.
#'
#' @importFrom flowWorkspace sampleNames pData getNodes GatingSet
#' @importFrom flowCore parameters compensate flowSet fsApply
#' @importFrom ncdfFlow ncfsApply
#' @importFrom utils read.csv
#' @importFrom methods as
#' @importFrom graphics par
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @examples
#' library(CytoRSuiteData)
#' 
#' # Don't run - bypass directory check for external files
#' options("CytoRSuite_wd_check" = FALSE)
#' 
#' # Load in compensation controls
#' gs <- GatingSet(Compensation)
#' 
#' # Gate single cells using gate_draw
#' gt <- Compensation_gatingTemplate
#' gating(gt, gs)
#' 
#' # Channel match file
#' cmfile <- system.file("extdata",
#'   "Compensation-Channels.csv",
#'   package = "CytoRSuiteData"
#' )
#' 
#' # Compensation plots
#' cyto_plot_compensation(gs,
#'   parent = "Single Cells",
#'   channel_match = cmfile
#' )
#' 
#' # Don't run - return "CytoRSuite_wd_check" to default
#' options("CytoRSuite_wd_check" = TRUE)
#' @seealso \code{\link{cyto_plot,flowFrame-method}}
#'
#' @export
setMethod(cyto_plot_compensation,
  signature = "GatingSet",
  definition = function(x,
                          parent = NULL,
                          channel_match = NULL,
                          compensate = FALSE,
                          spillover = NULL,
                          axes_trans = NULL,
                          overlay = TRUE,
                          layout,
                          popup = FALSE,
                          title = NA,
                          header = NA,
                          header_text_font = 2,
                          header_text_size = 1,
                          header_text_col = "black", ...) {

    # Assign x to gs
    gs <- x

    # Parent
    if (is.null(parent)) {
      parent <- basename(getNodes(gs))[length(getNodes(gs))]
      message(paste(
        "No parent supplied -",
        parent,
        "population will be used for plots."
      ))
    }

    # Extract channels
    channels <- cyto_fluor_channels(gs)

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

    # Compensation
    if (compensate == TRUE) {
      if (is.null(spillover)) {
        spill <- fs[[1]]@description$SPILL
      } else if (!is.null(spillover)) {
        if (inherits(spillover, "matrix") |
          inherits(spillover, "data.frame") |
          inherits(spillover, "tibble")) {
          spill <- spillover
        } else {
          if (getOption("CytoRSuite_wd_check") == TRUE) {
            if (.file_wd_check(spillover)) {
              spill <- read.csv(spillover, header = TRUE, row.names = 1)
              colnames(spill) <- rownames(spill)
            } else {
              message(paste(spillover, "is not in this working directory."))
              spill <- fs[[1]]@description$SPILL
            }
          } else {
            spill <- read.csv(spillover, header = TRUE, row.names = 1)
            colnames(spill) <- rownames(spill)
          }
        }

        if (inherits(fs, "ncdfFlowSet") == TRUE) {
          fs <- suppressMessages(ncfsApply(fs, function(fr) {
            compensate(fr, spill)
          }))
        } else if (inherits(fs, "flowSet")) {
          fs <- suppressMessages(fsApply(fs, function(fr) {
            compensate(fr, spill)
          }))
        }
      }
    }

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

    # Make to cyto_plot_compensation
    cyto_plot_compensation(
      x = fs,
      axes_trans = axes_trans,
      channel_match = channel_match,
      overlay = overlay,
      popup = popup,
      title = title,
      header = header,
      header_text_font = header_text_font,
      header_text_size = header_text_size,
      header_text_col = header_text_col, ...
    )

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