R/cyto_plot_label-methods.R

#' Add boxed text labels to cyto_plot
#'
#' @param x object of class \code{"flowFrame"}.
#' @param gates object of class
#'   \code{\link[flowCore:rectangleGate-class]{rectangleGate}},
#'   \code{\link[flowCore:polygonGate-class]{polygonGate}},
#'   \code{\link[flowCore:ellipsoidGate-class]{ellipsoidGate}}, \code{"list"} or
#'   \code{\link[flowCore:filters-class]{filters}}.
#' @param ... additional method-specific arguments.
#'
#' @return add a boxed text label to cyto_plot.
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @importFrom flowCore Subset parameters
#'
#' @seealso \code{\link{cyto_plot_label,flowFrame,rectangleGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,polygonGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,ellipsoidGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,list-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,filters-method}}
#'
#' @export
setGeneric(
  name = "cyto_plot_label",
  def = function(x, gates, ...) {
    standardGeneric("cyto_plot_label")
  }
)

#' Add boxed text labels to cyto_plot without gate
#'
#' \code{cyto_plot_label} takes on a \code{flowFrame} object, population name
#' \code{text}, \code{channels} and a gate object to construct a text label for
#' the plot with the population name and frequency. In the absence of a gate,
#' users can manually specify the label position using the \code{text_x} and
#' \code{text_y} arguments.
#'
#' @param x a \code{\link[flowCore:flowFrame-class]{flowFrame}} gated in the
#'   existing plot.
#' @param gates \code{NULL}.
#' @param 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.
#' @param channels a vector indicating the fluorescent channel(s) to be used for
#'   gating.
#' @param text character string to include in the label above the statistic
#'   (e.g. population name(s)).
#' @param stat indicates the type of statistic to include in the label, can be
#'   either code{"count"}, \code{"median"}, \code{"mean"}, \code{"mode"},
#'   \code{"geo mean"} or \code{"CV"}. \code{stat} is set to \code{"median"} by
#'   default. Statistics for fluorescent intensity are calculated for the entire
#'   distribution. Only count and percent statistics are supported for 2D plots.
#' @param text_x vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_y vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_font integer [1,2,3,4] passed to \code{text} to alter the font,
#'   set to \code{2} by default for a bold font.
#' @param text_size numeric character expansion used to control the size of the
#'   text in the labels, set to \code{0.8} by default. See \code{?text} for
#'   details.
#' @param text_col specify text colour in label for each gate, defaults to
#'   \code{"black"} for all gates.
#' @param box_alpha numeric [0,1] controls the transparency of the background,
#'   set to \code{0.6} by default.
#' @param density_smooth smoothing parameter passed to
#'   \code{\link[stats:density]{density}} to adjust kernel density for mode
#'   calculation.
#'
#' @return add a boxed text label to cyto_plot.
#'
#' @importFrom flowCore Subset parameters
#' @importFrom graphics par
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot_label,flowFrame,polygonGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,ellipsoidGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,list-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,filters-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(fs))
#' gs <- transform(gs, trans)
#'
#' # Gate using gate_draw
#' gating(Activation_gatingTemplate, gs)
#'
#' # Plot
#' cyto_plot(gs[[4]],
#'   parent = "T Cells",
#'   channels = c("Alexa Fluor 488-A", "Alexa Fluor 700-A")
#' )
#'
#' # Labels without gates - position using text_x and text_y
#' cyto_plot_label(getData(gs, "T Cells")[[4]],
#'   gates = NULL,
#'   channels = c("Alexa Fluor 488-A", "Alexa Fluor 700-A"),
#'   trans = trans,
#'   text = c("CD4 T Cells", "CD8 T Cells"),
#'   text_x = c(3.1, 1),
#'   text_y = c(-0.2, 3.2)
#' )
#' @export
setMethod(cyto_plot_label,
  signature = c("flowFrame", NULL),
  definition = function(x,
                          gates = NULL,
                          trans = NULL,
                          channels,
                          text = NA,
                          stat = NA,
                          text_x = NA,
                          text_y = NA,
                          text_font = 2,
                          text_size = 0.8,
                          text_col = "black",
                          box_alpha = 0.6,
                          density_smooth = 1.5) {

    # Assign x to fr
    fr <- x
    
    # Check statistic
    if(all(!is.na(stat))){
      stat <- .cyto_stat_check(stat)
    }
    
    # Channels needed to position label
    if (missing(channels)) {
      stop("Supply channel/marker(s) to contruct the plot.")
    }

    # Missing transList
    if (stat %in% c(
      "median",
      "mode",
      "mean",
      "geo mean",
      "CV"
    )) {
      if (is.null(cyto_trans_check(trans))) {
        stop(
          paste("Supply transformList/transformerList to calculate", stat, ".")
        )
      }
    }

    # Stats not supported in 2D
    if (length(channels) == 2 &
      stat %in% c(
        "mean",
        "median",
        "mode",
        "geo mean",
        "freq",
        "CV"
      )) {
      stop("Only count is supported for 2D plots without gates.")
    }

    # Missing text
    if (all(is.na(text)) & !all(is.na(stat))) {
      message(
        paste("No text supplied for labels - labels will show", stat, "only.")
      )
    }

    # Calculate statistics
    if (!all(is.na(stat))) {
      if (stat == "count") {
        st <- BiocGenerics::nrow(fr)
      } else if (stat == "median") {
        fr <- .getRawData(x = fr, trans)
        st <- median(flowCore::exprs(fr)[, channels])
        st <- round(st, 2)
      } else if (stat == "mean") {
        fr <- .getRawData(x = fr, trans)
        st <- mean(flowCore::exprs(fr)[, channels])
        st <- round(st, 2)
      } else if (stat == "mode") {
        fr <- .getRawData(x = fr, trans)
        d <- density(flowCore::exprs(fr)[, channels], adjust = density_smooth)
        st <- d$x[d$y == max(d$y)]
        st <- round(st, 2)
      } else if (stat == "geo mean") {
        st <- mean(flowCore::exprs(fr)[, channels])
        inv <- cyto_trans_check(trans, inverse = TRUE)
        st <- inv@transforms[[channels]]@f(st)
        st <- round(st, 2)
      } else if (stat == "CV"){
        fr <- .getRawData(x = fr, trans)
        fr.exprs <- exprs(fr)
        md <- median(fr.exprs[,channels])
        rSD <- median(abs(fr.exprs[,channels] - md))*1.4826
        st <- rSD/md
        st <- sprintf("%.2f %%", st*100)
      }
    }

    # Plot Limits
    xmin <- par("usr")[1]
    xmax <- par("usr")[2]
    ymin <- par("usr")[3]
    ymax <- par("usr")[4]

    # Label position - x - defaults to 3/4
    if (all(is.na(text_x))) {
      text_x <- xmin + (xmax - xmin) * 0.75
    }

    # Label position - y - defaults to 1/2
    if (all(is.na(text_y))) {
      text_y <- c(ymin + ymax) / 2
    }

    # Add labels
    if (!all(is.na(text)) & !all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = paste(text, st, sep = "\n"),
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    } else if (!all(is.na(text)) & all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = text,
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    } else if (all(is.na(text)) & !all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = st,
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    }
  }
)

#' Add boxed text labels to cyto_plot - rectangleGate Method
#'
#' \code{cyto_plot_label} takes on a \code{flowFrame} object, population name
#' \code{text}, \code{channels} and a gate object to construct a text label for
#' the plot with the population name and frequency.
#'
#' @param x a \code{\link[flowCore:flowFrame-class]{flowFrame}} gated in the
#'   existing plot.
#' @param gates an object of class
#'   \code{\link[flowCore:rectangleGate-class]{rectangleGate}}.
#' @param 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.
#' @param channels a vector indicating the fluorescent channel(s) to be used for
#'   gating.
#' @param text character string to include in the label above the statistic
#'   (e.g. population name(s)).
#' @param stat indicates the type of statistic to include in the label, can be
#'   either \code{"freq"}, \code{"count"}, \code{"median"}, \code{"mean"},
#'   \code{"mode"}, \code{"geo mean"} or \code{"CV"}. \code{stat} is set to
#'   \code{"freq"} by default. Statistics for fluorescent intensity are
#'   calculated for the entire distribution. Only count and percent statistics
#'   are supported for 2D plots.
#' @param text_x vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_y vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_font integer [1,2,3,4] passed to \code{text} to alter the font,
#'   set to \code{2} by default for a bold font.
#' @param text_size numeric character expansion used to control the size of the
#'   text in the labels, set to \code{0.8} by default. See \code{?text} for
#'   details.
#' @param text_col specify text colour in label for each gate, defaults to
#'   \code{"black"} for all gates.
#' @param box_alpha numeric [0,1] controls the transparency of the background,
#'   set to \code{0.6} by default.
#' @param density_smooth smoothing parameter passed to
#'   \code{\link[stats:density]{density}} to adjust kernel density for mode
#'   calculation.
#'
#' @return add a boxed text label to cyto_plot.
#'
#' @importFrom flowCore Subset parameters
#' @importFrom graphics par
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot_label,flowFrame,polygonGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,ellipsoidGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,list-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,filters-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(fs))
#' gs <- transform(gs, trans)
#'
#' # Gate using gate_draw
#' gating(Activation_gatingTemplate, gs)
#'
#' # Plot
#' cyto_plot(gs[[4]],
#'   parent = "CD4 T Cells",
#'   channels = "7-AAD-A"
#' )
#'
#' # CD69+ CD4 T Cells gate
#' gt <- getGate(gs, "CD69+ CD4 T Cells")[[1]]
#' cyto_plot_gate(gt,
#'   channels = "7-AAD-A"
#' )
#'
#' # Labels
#' cyto_plot_label(getData(gs, "CD4 T Cells")[[4]],
#'   gates = gt,
#'   trans = trans,
#'   channels = "7-AAD-A",
#'   text = c("CD69+"),
#'   stat = "freq",
#'   text_col = "blue"
#' )
#' @export
setMethod(cyto_plot_label,
  signature = c("flowFrame", "rectangleGate"),
  definition = function(x,
                          gates = NULL,
                          trans = NULL,
                          channels,
                          text = NA,
                          stat = NA,
                          text_x = NA,
                          text_y = NA,
                          text_font = 2,
                          text_size = 0.8,
                          text_col = "black",
                          box_alpha = 0.6,
                          density_smooth = 1.5) {

    # Assign x to fr
    fr <- x

    # Check statistic
    if(all(!is.na(stat))){
      stat <- .cyto_stat_check(stat)
    }
    
    # Channels needed to position label
    if (missing(channels)) {
      stop("Supply channel/marker(s) to contruct the plot.")
    }

    # Only count and percent supported in 2D
    if (length(channels) == 2 & !stat %in% c("count", "freq")) {
      stop("Only count and percent statistics are supported in 2D plots.")
    }

    # Missing transList
    if (stat %in% c("median", "mode", "mean", "geo mean")) {
      if (is.null(cyto_trans_check(trans))) {
        stop(
          paste("Supply transformList/transformerList to calculate", stat, ".")
        )
      }
    }

    # 2D gate in 1D plot
    if (length(channels) == 1 & length(parameters(gates)) == 2) {
      gates <- gates[channels]
    }

    # Missing text
    if (all(is.na(text)) & !all(is.na(stat))) {
      message(
        paste("No text supplied for labels - labels will show", stat, "only.")
      )
    }

    # Calculate statistics
    if (!all(is.na(stat))) {
      if (stat == "count") {
        st <- BiocGenerics::nrow(flowCore::Subset(fr, gates))
      } else if (stat == "freq") {

        # Total events
        events <- BiocGenerics::nrow(fr)

        # Population events - percentages
        cnt <- BiocGenerics::nrow(flowCore::Subset(fr, gates))
        prcnt <- round(cnt / events, 4)
        st <- sprintf("%.2f %%", 100 * prcnt)
      } else if (stat == "mean") {
        fr <- .getRawData(x = fr, trans)
        st <- mean(flowCore::exprs(fr)[, channels])
        st <- round(st, 2)
      } else if (stat == "median") {
        fr <- .getRawData(x = fr, trans)
        st <- median(flowCore::exprs(fr)[, channels])
        st <- round(st, 2)
      } else if (stat == "mode") {
        fr <- .getRawData(x = fr, trans)
        d <- density(flowCore::exprs(fr)[, channels], adjust = density_smooth)
        st <- d$x[d$y == max(d$y)]
        st <- round(st, 2)
      } else if (stat == "geo mean") {
        st <- mean(flowCore::exprs(fr)[, channels])
        inv <- cyto_trans_check(trans, inverse = TRUE)
        st <- inv@transforms[[channels]]@f(st)
        st <- round(st, 2)
      } else if (stat == "CV"){
        fr <- .getRawData(x = fr, trans)
        fr.exprs <- exprs(fr)
        md <- median(fr.exprs[,channels])
        rSD <- median(abs(fr.exprs[,channels] - md))*1.4826
        st <- rSD/md
        st <- sprintf("%.2f %%", st*100)
      }
    }

    # 1D gate plotted in 2D
    if (length(channels) == 2 & length(parameters(gates)) == 1) {
      rg <- matrix(c(as.numeric(gates@min), as.numeric(gates@max), -Inf, Inf),
        ncol = 2, nrow = 2
      )
      colnames(rg) <- c(
        as.vector(parameters(gates)),
        channels[!channels == as.vector(parameters(gates))]
      )
      rownames(rg) <- c("min", "max")
      gates <- rectangleGate(.gate = rg)
    }

    # Gate channels
    chans <- as.vector(parameters(gates))

    # Plot limits
    xmin <- par("usr")[1]
    xmax <- par("usr")[2]
    ymin <- par("usr")[3]
    ymax <- par("usr")[4]

    # 1D gate supplied
    if (length(chans) == 1) {
      if (length(channels) == 1) {
        if (!channels == chans) {
          stop("Supplied channel does not match that of the supplied gate.")
        } else if (channels == chans) {
          if (all(is.na(text_x))) {
            xmin <- gates@min
            xmax <- gates@max

            if (is.infinite(xmin)) {
              xmin <- par("usr")[1]
            }
            if (is.infinite(xmax)) {
              xmax <- par("usr")[2]
            }
          }
        }
      } else if (length(channels) == 2) {
        if (!chans %in% channels) {
          stop("Supplied channels do not match that of the supplied gate.")
        } else if (chans %in% channels) {
          if (all(is.na(text_x))) {
            xmin <- gates@min[channels[1]]
            xmax <- gates@max[channels[1]]

            if (is.infinite(xmin)) {
              xmin <- par("usr")[1]
            }

            if (is.infinite(xmax)) {
              xmax <- par("usr")[2]
            }
          }

          if (all(is.na(text_y))) {
            ymin <- gates@min[channels[2]]
            ymax <- gates@max[channels[2]]

            if (is.infinite(ymin)) {
              ymin <- par("usr")[3]
            }

            if (is.infinite(ymax)) {
              ymax <- par("usr")[4]
            }
          }
        }
      }

      # 2D gate supplied
    } else if (length(chans) == 2) {
      if (!all(chans %in% channels)) {
        stop("Supplied channels do not match that of the supplied gate.")
      } else if (all(chans %in% channels)) {
        if (all(is.na(text_x))) {
          xmin <- gates@min[channels[1]]
          xmax <- gates@max[channels[1]]

          if (is.infinite(xmin)) {
            xmin <- par("usr")[1]
          }

          if (is.infinite(xmax)) {
            xmax <- par("usr")[2]
          }
        }

        if (all(is.na(text_y))) {
          ymin <- gates@min[channels[2]]
          ymax <- gates@max[channels[2]]

          if (is.infinite(ymin)) {
            ymin <- par("usr")[3]
          }

          if (is.infinite(ymax)) {
            ymax <- par("usr")[4]
          }
        }
      }
    }

    # Label position - x - defaults to 3/4
    if (all(is.na(text_x))) {
      text_x <- c(xmin + xmax) / 2
    }

    # Label position - y - defaults to 1/2
    if (all(is.na(text_y))) {
      text_y <- c(ymin + ymax) / 2
    }

    # Add labels
    if (!all(is.na(text)) & !all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = paste(text, st, sep = "\n"),
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    } else if (!all(is.na(text)) & all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = text,
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    } else if (all(is.na(text)) & !all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = st,
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    }
  }
)

#' Add boxed text labels to cyto_plot - polygonGate Method
#'
#' \code{cyto_plot_label} takes on a \code{flowFrame} object, population name
#' \code{text}, \code{channels} and a gate object to construct a text label for
#' the plot with the population name and frequency.
#'
#' @param x a \code{\link[flowCore:flowFrame-class]{flowFrame}} gated in the
#'   existing plot.
#' @param gates an object of class
#'   \code{\link[flowCore:polygonGate-class]{polygonGate}}.
#' @param channels a vector indicating the fluorescent channel(s) to be used for
#'   gating.
#' @param 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.
#' @param text the name of the gated population, set to NA by default to only
#'   include percent in labels.
#' @param stat indicates the type of statistic to include in the label, can be
#'   either \code{"freq"} or \code{"count"}. \code{stat} is set to
#'   \code{"freq"} by default.
#' @param text_x vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_y vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_font integer [1,2,3,4] passed to \code{text} to alter the font,
#'   set to \code{2} by default for a bold font.
#' @param text_size numeric character expansion used to control the size of the
#'   text in the labels, set to \code{0.8} by default. See \code{?text} for
#'   details.
#' @param text_col specify text colour in label for each gate, defaults to
#'   \code{"black"} for all gates.
#' @param box_alpha numeric [0,1] controls the transparency of the background,
#'   set to \code{0.6} by default.
#'
#' @return add a boxed text label to cyto_plot.
#'
#' @importFrom flowCore Subset parameters
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot_label,flowFrame,rectangleGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,ellipsoidGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,list-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,filters-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(fs))
#' gs <- transform(gs, trans)
#' 
#' # Gate using gate_draw
#' gating(Activation_gatingTemplate, gs)
#' 
#' # Plot
#' cyto_plot(gs[[4]],
#'   parent = "root",
#'   channels = c("FSC-A", "SSC-A")
#' )
#' 
#' # Cells gate
#' gt <- getGate(gs, "Cells")[[1]]
#' cyto_plot_gate(gt,
#'   channels = c("FSC-A", "SSC-A")
#' )
#' 
#' # Labels
#' cyto_plot_label(getData(gs, "root")[[4]],
#'   gates = gt,
#'   trans = trans,
#'   channels = c("FSC-A", "SSC-A"),
#'   text = "Cells",
#'   stat = "freq",
#'   text_col = "magenta",
#'   text_size = 1.2
#' )
#' @export
setMethod(cyto_plot_label,
  signature = c("flowFrame", "polygonGate"),
  definition = function(x,
                          gates,
                          channels,
                          trans = NULL,
                          text = NA,
                          stat = NA,
                          text_x = NA,
                          text_y = NA,
                          text_font = 2,
                          text_size = 0.8,
                          text_col = "black",
                          box_alpha = 0.6) {

    # Assign x to fr
    fr <- x

    # Check statistic
    if(all(!is.na(stat))){
      stat <- .cyto_stat_check(stat)
    }
    
    # Channels needed to position label
    if (missing(channels)) {
      stop("Supply channel/marker(s) to contruct the plot.")
    }

    # Only count and percent supported
    if (!stat %in% c("count", "freq")) {
      stop("Only 'count' and 'percent' are supported for gated 2D plots.")
    }

    # Missing text
    if (all(is.na(text)) & !all(is.na(stat))) {
      message(
        paste("No text supplied for labels - labels will show", stat, "only.")
      )
    }

    # Calculate statistic
    if (!all(is.na(stat))) {
      if (stat == "count") {
        st <- BiocGenerics::nrow(flowCore::Subset(fr, gates))
      } else if (stat == "freq") {
        # Total events
        events <- nrow(fr)

        # Population events - percentages
        cnt <- BiocGenerics::nrow(flowCore::Subset(fr, gates))
        prcnt <- round(cnt / events, 4)
        st <- sprintf("%.2f %%", 100 * prcnt)
      }
    }

    # Check supplied channels & gate channels
    chans <- parameters(gates)

    # Check gate parameters against channels
    if (!all(chans %in% channels)) {
      stop("Supplied channels do not match that of the supplied gate.")
    }

    # Label position - x
    if (all(is.na(text_x))) {
      text_x <- sum(gates@boundaries[, channels[1]]) / nrow(gates@boundaries)
    }

    # Label position - y
    if (all(is.na(text_y))) {
      text_y <- sum(gates@boundaries[, channels[2]]) / nrow(gates@boundaries)
    }

    # Add labels
    if (!all(is.na(text)) & !all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = paste(text, st, sep = "\n"),
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    } else if (!all(is.na(text)) & all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = text,
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    } else if (all(is.na(text)) & !all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = st,
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    }
  }
)

#' Add boxed text labels to cyto_plot - ellipsoidGate Method
#'
#' \code{cyto_plot_label} takes on a \code{flowFrame} object, population name
#' \code{text}, \code{channels} and a gate object to construct a text label for
#' the plot with the population name and frequency.
#'
#' @param x a \code{\link[flowCore:flowFrame-class]{flowFrame}} gated in the
#'   existing plot.
#' @param gates an object of class
#'   \code{\link[flowCore:ellipsoidGate-class]{ellipsoidGate}}.
#' @param channels a vector indicating the fluorescent channel(s) to be used for
#'   gating.
#' @param 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.
#' @param text the name of the gated population, set to NA by default to only
#'   include percent in labels.
#' @param stat indicates the type of statistic to include in the label, can be
#'   either \code{"freq"} or \code{"count"}. \code{stat} is set to
#'   \code{"freq"} by default.
#' @param text_x vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_y vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_font integer [1,2,3,4] passed to \code{text} to alter the font,
#'   set to \code{2} by default for a bold font.
#' @param text_size numeric character expansion used to control the size of the
#'   text in the labels, set to \code{0.8} by default. See \code{?text} for
#'   details.
#' @param text_col specify text colour in label for each gate, defaults to
#'   \code{"black"} for all gates.
#' @param box_alpha numeric [0,1] controls the transparency of the background,
#'   set to \code{0.6} by default.
#'
#' @return add a boxed text label to cyto_plot.
#'
#' @importFrom flowCore Subset parameters
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot_label,flowFrame,rectangleGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,polygonGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,list-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,filters-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(fs))
#' gs <- transform(gs, trans)
#' 
#' # Gate using gate_draw
#' gating(Activation_gatingTemplate, gs)
#' 
#' # Plot
#' cyto_plot(gs[[4]],
#'   parent = "Live Cells",
#'   channels = c("APC-Cy7-A", "PE-A")
#' )
#' 
#' # T Cells gate
#' gt <- getGate(gs, "T Cells")[[1]]
#' cyto_plot_gate(gt,
#'   channels = c("APC-Cy7-A", "PE-A")
#' )
#' 
#' # Labels
#' cyto_plot_label(getData(gs, "Live Cells")[[4]],
#'   gates = gt,
#'   trans = trans,
#'   channels = c("APC-Cy7-A", "PE-A"),
#'   text = "T Cells",
#'   stat = "count",
#'   text_col = "magenta",
#'   text_size = 1.2,
#'   box_alpha = 1
#' )
#' @export
setMethod(cyto_plot_label,
  signature = c("flowFrame", "ellipsoidGate"),
  definition = function(x,
                          gates,
                          channels,
                          trans = NULL,
                          text = NA,
                          stat = NA,
                          text_x = NA,
                          text_y = NA,
                          text_font = 2,
                          text_size = 0.8,
                          text_col = "black",
                          box_alpha = 0.6) {

    # Assign x to fr
    fr <- x

    # Check statistic
    if(all(!is.na(stat))){
      stat <- .cyto_stat_check(stat)
    }
    
    # Channels needed to position label
    if (missing(channels)) {
      stop("Supply channel/marker(s) to contruct the plot.")
    }

    # Only count and percent supported
    if (!stat %in% c("count", "freq")) {
      stop("Only 'count' and 'percent' are supported for gated 2D plots.")
    }

    # Missing text
    if (all(is.na(text)) & !all(is.na(stat))) {
      message(
        paste("No text supplied for labels - labels will show", stat, "only.")
      )
    }

    # Calculate statistic
    if (!all(is.na(stat))) {
      if (stat == "count") {
        st <- BiocGenerics::nrow(flowCore::Subset(fr, gates))
      } else if (stat == "freq") {
        # Total events
        events <- nrow(fr)

        # Population events - percentages
        cnt <- BiocGenerics::nrow(flowCore::Subset(fr, gates))
        prcnt <- round(cnt / events, 4)
        st <- sprintf("%.2f %%", 100 * prcnt)
      }
    }

    # Check supplied channels & gate channels
    chans <- parameters(gates)

    # Check gate parameters against channels
    if (!all(chans %in% channels)) {
      stop("Supplied channels do not match that of the supplied gate.")
    }

    # Label position - x
    if (all(is.na(text_x))) {
      text_x <- gates@mean[channels[1]]
    }

    # Label position - y
    if (all(is.na(text_y))) {
      text_y <- gates@mean[channels[2]]
    }

    # Add labels
    if (!all(is.na(text)) & !all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = paste(text, st, sep = "\n"),
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    } else if (!all(is.na(text)) & all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = text,
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    } else if (all(is.na(text)) & !all(is.na(stat))) {
      .boxed.labels(
        x = text_x,
        y = text_y,
        labels = st,
        border = FALSE,
        font = text_font,
        col = text_col,
        alpha.bg = box_alpha,
        cex = text_size
      )
    }
  }
)

#' Add boxed text labels to cyto_plot - list Method
#'
#' \code{cyto_plot_label} takes on a \code{flowFrame} object, population name
#' \code{text}, \code{channels} and a gate object to construct a text label for
#' the plot with the population name and frequency.
#'
#' @param x a \code{\link[flowCore:flowFrame-class]{flowFrame}} gated in the
#'   existing plot.
#' @param gates an object of class \code{"list"} containing objects of class
#'   \code{\link[flowCore:rectangleGate-class]{rectangleGate}},
#'   \code{\link[flowCore:polygonGate-class]{polygonGate}} or
#'   \code{\link[flowCore:ellipsoidGate-class]{ellipsoidGate}}.
#' @param 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.
#' @param channels a vector indicating the fluorescent channel(s) to be used for
#'   gating.
#' @param text the name of the gated population, set to NA by default to only
#'   include percent in labels.
#' @param stat indicates the type of statistic to include in the label, can be
#'   either \code{"freq"}, \code{"count"}, \code{"median"}, \code{"mean"},
#'   \code{"mode"}, \code{"geo mean"} or \code{"CV"}. \code{stat} is set to
#'   \code{"freq"} by default. Statistics for fluorescent intensity are
#'   calculated for the entire distribution. Only count and percent statistics
#'   are supported for 2D plots.
#' @param text_x vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_y vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_font integer [1,2,3,4] passed to \code{text} to alter the font,
#'   set to \code{2} by default for a bold font.
#' @param text_size numeric character expansion used to control the size of the
#'   text in the labels, set to \code{0.8} by default. See \code{?text} for
#'   details.
#' @param text_col specify text colour in label for each gate, defaults to
#'   \code{"black"} for all gates.
#' @param box_alpha numeric [0,1] controls the transparency of the background,
#'   set to \code{0.6} by default.
#'
#' @return add a boxed text label to cyto_plot.
#'
#' @importFrom flowCore Subset parameters
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot_label,flowFrame,rectangleGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,polygonGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,ellipsoidGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,filters-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(fs))
#' gs <- transform(gs, trans)
#'
#' # Gate using gate_draw
#' gating(Activation_gatingTemplate, gs)
#'
#' # Plot
#' cyto_plot(gs[[4]],
#'   parent = "Live Cells",
#'   channels = c("APC-Cy7-A", "PE-A")
#' )
#'
#' # T Cells & Dendritic Cells gates
#' gts <- list(getGate(gs, "T Cells")[[1]], getGate(gs, "Dendritic Cells")[[1]])
#' cyto_plot_gate(gts,
#'   channels = c("APC-Cy7-A", "PE-A")
#' )
#'
#' # Labels
#' cyto_plot_label(getData(gs, "Live Cells")[[4]],
#'   gates = gts,
#'   trans = trans,
#'   channels = c("APC-Cy7-A", "PE-A"),
#'   text = c("T Cells", "Dendritic Cells"),
#'   stat = "count",
#'   text_col = c("magenta", "purple"),
#'   text_size = 1.2,
#'   box_alpha = 1
#' )
#' @export
setMethod(cyto_plot_label,
  signature = c("flowFrame", "list"),
  definition = function(x,
                          gates,
                          trans = NULL,
                          channels,
                          text = NA,
                          stat = NA,
                          text_x = NA,
                          text_y = NA,
                          text_font = 2,
                          text_size = 0.8,
                          text_col = "black",
                          box_alpha = 0.6) {


    # Make calls to cyto_plot_label
    invisible(
      mapply(
        function(gate,
                         text,
                         stat,
                         text_font,
                         text_col,
                         text_size,
                         box_alpha) {
          cyto_plot_label(
            x = x,
            trans = trans,
            gates = gate,
            channels = channels,
            text = text,
            stat = stat,
            text_font = text_font,
            text_col = text_col,
            text_size = text_size,
            box_alpha = box_alpha
          )
        }, gates,
        text, stat,
        text_font,
        text_col,
        text_size,
        box_alpha
      )
    )
  }
)

#' Add boxed text labels to cyto_plot - filters Method
#'
#' \code{cyto_plot_label} takes on a \code{flowFrame} object, population name
#' \code{text}, \code{channels} and a gate object to construct a text label for
#' the plot with the population name and frequency.
#'
#' @param x a \code{\link[flowCore:flowFrame-class]{flowFrame}} gated in the
#'   existing plot.
#' @param gates an object of class \code{\link[flowCore:filters-class]{filters}}
#'   containing objects of class
#'   \code{\link[flowCore:rectangleGate-class]{rectangleGate}},
#'   \code{\link[flowCore:polygonGate-class]{polygonGate}} or
#'   \code{\link[flowCore:ellipsoidGate-class]{ellipsoidGate}}.
#' @param 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.
#' @param channels a vector indicating the fluorescent channel(s) to be used for
#'   gating.
#' @param text the name of the gated population, set to NA by default to only
#'   include percent in labels.
#' @param stat indicates the type of statistic to include in the label, can be
#'   either \code{"freq"}, \code{"count"}, \code{"median"}, \code{"mean"},
#'   \code{"mode"}, \code{"geo mean"} or\code{"CV"}. \code{stat} is set to
#'   \code{"freq"} by default. Statistics for fluorescent intensity are
#'   calculated for the entire distribution. Only count and percent statistics
#'   are supported for 2D plots.
#' @param text_x vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_y vector containing the x co-ordinates for the plot labels. Set
#'   to \code{NULL} by default to place labels in the center of the gates.
#' @param text_font integer [1,2,3,4] passed to \code{text} to alter the font,
#'   set to \code{2} by default for a bold font.
#' @param text_size numeric character expansion used to control the size of the
#'   text in the labels, set to \code{0.8} by default. See \code{?text} for
#'   details.
#' @param text_col specify text colour in label for each gate, defaults to
#'   \code{"black"} for all gates.
#' @param box_alpha numeric [0,1] controls the transparency of the background,
#'   set to \code{0.6} by default.
#'
#' @return add a boxed text label to cyto_plot.
#'
#' @importFrom flowCore Subset parameters
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @seealso \code{\link{cyto_plot_label,flowFrame,rectangleGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,polygonGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,ellipsoidGate-method}}
#' @seealso \code{\link{cyto_plot_label,flowFrame,list-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(fs))
#' gs <- transform(gs, trans)
#'
#' # Gate using gate_draw
#' gating(Activation_gatingTemplate, gs)
#'
#' # Plot
#' cyto_plot(gs[[4]],
#'   parent = "Live Cells",
#'   channels = c("APC-Cy7-A", "PE-A")
#' )
#'
#' # T Cells & Dendritic Cells gates
#' gts <- filters(list(getGate(gs, "T Cells")[[1]], 
#' getGate(gs, "Dendritic Cells")[[1]]))
#' cyto_plot_gate(gts,
#'   channels = c("APC-Cy7-A", "PE-A"),
#'   gate_line_col = c("red", "black")
#' )
#'
#' # Labels
#' cyto_plot_label(getData(gs, "Live Cells")[[4]],
#'   gates = gts,
#'   trans = trans,
#'   channels = c("APC-Cy7-A", "PE-A"),
#'   text = c("T Cells", "Dendritic Cells"),
#'   stat = "freq",
#'   text_col = c("green4", "purple"),
#'   text_size = 1.2,
#'   box_alpha = 1
#' )
#' @export
setMethod(cyto_plot_label,
  signature = c("flowFrame", "filters"),
  definition = function(x,
                          gates,
                          trans = NULL,
                          channels,
                          text = NA,
                          stat = NA,
                          text_x = NA,
                          text_y = NA,
                          text_font = 2,
                          text_size = 0.8,
                          text_col = "black",
                          box_alpha = 0.6) {

    # Make calls to cyto_plot_label
    invisible(
      mapply(
        function(gate,
                         text,
                         stat,
                         text_font,
                         text_col,
                         text_size,
                         box_alpha) {
          cyto_plot_label(
            x = x,
            trans = trans,
            gates = gate,
            channels = channels,
            text = text,
            stat = stat,
            text_font = text_font,
            text_col = text_col,
            text_size = text_size,
            box_alpha = box_alpha
          )
        }, gates,
        text, stat,
        text_font,
        text_col,
        text_size,
        box_alpha
      )
    )
  }
)
DillonHammill/cytoSuite documentation built on March 7, 2019, 10:09 a.m.