R/plot_comp.R

In cellGeometry: Geometric Single Cell Deconvolution

#' Plot compensation analysis
#' 
#' Plots the effect of varying compensation from 0 to 1 for each cell subclass,
#' examining the minimum subclass output result following a call to
#' [deconvolute()]. For this function to work, the argument `check_comp` must be
#' set to `TRUE` during the call to [deconvolute()].
#' 
#' @param x An object of class 'deconv' generated by [deconvolute()].
#' @param overlay Logical whether to overlay compensation curves onto a single
#'   plot. If FALSE, multiple plots (one per subclass) are generated on one or
#'   more pages.
#' @param mfrow Optional vector of length 2 for organising plot layout. See
#'   `par()`. Only used when `overlay = FALSE`.
#' @param subclass Either an index number or character value specifying which cell
#'   subclass to plot.
#' @param sample Either an index number or character value specifying which
#'   sample to plot. Both `subclass` and `sample` cannot be specified together.
#' @param type Either "counts" or "percent", to specify whether deconvoluted
#'   cell counts or cell percentages are shown.
#' @param add_points Logical whether to add points showing the final cell count
#'   values. Not available if `type = "percent"`.
#' @param labs Either logical, whether to show labels for each line. Or a vector
#'   of label names for each line.
#' @param ... Optional graphical arguments passed to [plot()].
#' @return No return value. `plot_comp()` plots the effect of varying
#'   compensation on the minimum subclass output for every cell subclass.
#'   `plot_path()` plots the coefficient paths for either each bulk sample for the
#'   subclass specified by `subclass`, or all subclasses for a single sample
#'   specified by `sample`.
#' @importFrom graphics text points
#' @export

plot_comp <- function(x, overlay = TRUE, type = c("counts", "percent"),
                      mfrow = NULL, ...) {
  if (!inherits(x, "deconv")) stop("not a 'deconv' class object")
  if (is.null(x$comp_check)) stop("missing comp_check analysis")
  type <- match.arg(type)
  
  ylab <- "min output"
  mat <- x$comp_check$mat  # sample, comp, subclass
  if (type == "percent") {
    mat <- compmat_percent(mat)
    ylab <- "min output (%)"
  }
  n <- dim(mat)[3]
  comp <- x$comp_check$comp
  minx <- lapply(1:n, function(i) colMins(mat[, , i]))
  names(minx) <- dimnames(mat)[[3]] 
  new.args <- list(...)
  
  if (overlay) {
    yr <- range(minx)
    scheme <- hue_pal(h = c(0, 270), c = 120)(n)
    args <- list(x = NA, las = 1, xlim = c(0, 1), ylim = yr,
                 xlab = "Compensation", ylab = ylab)
    if (length(new.args)) args[names(new.args)] <- new.args
    do.call(plot, args)
    abline(h = 0)
    for (i in seq_len(n)) {
      lines(comp, minx[[i]], col = scheme[i])
    }
  } else {
    nr1 <- ceiling(sqrt(n))
    nr2 <- ceiling(n / nr1)
    if (is.null(mfrow)) mfrow <- c(nr1, nr2)
    op <- par(bty = "l", mgp = c(2.2, 0.6, 0), tcl = -0.3,
              mar = c(3.7, 4.5, 1.5, 1.1), mfrow = mfrow)
    on.exit(par(op))
    for (i in seq_len(n)) {
      ylim <- range(minx[[i]])
      if (ylim[1] > 0) ylim[1] <- 0
      if (ylim[2] < 0) ylim[2] <- 0
      plot(comp, minx[[i]], type = "l", ylim = ylim, las = 1,
           xlab = paste(names(minx)[i], "comp"), ylab = "")
      abline(h = 0, col = "darkgrey")
      comp_i <- x$subclass$comp_amount[i]
      abline(v = comp_i, col = "red", lty = 2)
      text(comp_i, ylim[2], format(comp_i, digits = 2, nsmall = 1),
           col = "red", adj = c(0.5, -0.5), xpd = NA)
    }
  }
}

#' @rdname plot_comp
plot_path <- function(x, subclass = 1L, sample = NULL,
                      type = c("counts", "percent"),
                      add_points = FALSE, labs = TRUE, ...) {
  if (!inherits(x, "deconv")) stop("not a 'deconv' class object")
  if (is.null(x$comp_check)) stop("missing comp_check analysis")
  type <- match.arg(type)
  
  mat <- x$comp_check$mat  # sample, comp, subclass
  dims <- dim(mat)
  comp <- x$comp_check$comp
  new.args <- list(...)
  add_labs <- !isFALSE(labs) & !is.null(labs)
  ylab <- "coef"
  
  if (type == "percent") {
    mat <- compmat_percent(mat)
    ylab <- "cells (%)"
  }
  
  if (is.null(sample)) {
    # per subclass
    n <- dim(mat)[1]
    scheme <- hue_pal(h = c(0, 270), c = 120)(n)
    yr <- range(mat[, , subclass])
    main <- if (is.numeric(subclass)) dimnames(mat)[[3]][subclass] else subclass
    args <- list(x = NA, las = 1, xlim = c(0, 1), ylim = yr, bty = "l",
                 xlab = "Compensation", ylab = ylab,
                 main = main, font.main = 1)
    if (length(new.args)) args[names(new.args)] <- new.args
    do.call(plot, args)
    abline(h = 0)
    abline(v = x$subclass$comp_amount[subclass], lty = 2)
    for (i in seq_len(n)) {
      lines(comp, mat[i, , subclass], col = scheme[i])
    }
    if (add_labs) {
      if (isTRUE(labs)) {labs <- rownames(mat)
      } else if (length(labs) != n) stop("incompatible `labs` length")
      text(1.01, mat[, length(comp), subclass], labs,
           cex = 0.7, col = scheme, adj = c(0, 0.5), xpd = NA)
    }
    if (add_points & type != "percent") {
      points(rep(x$subclass$comp_amount[subclass], n),
             x$subclass$output[, subclass], pch = 20, col = scheme)
    }
  } else {
    # per sample
    if (!is.numeric(subclass) || subclass != 1L)
      stop("cannot specify both subclass & sample")
    n <- dim(mat)[3]
    scheme <- hue_pal(h = c(0, 270), c = 120)(n)
    yr <- range(mat[sample, , ])
    main <- if (is.numeric(sample)) rownames(mat)[sample] else sample 
    args <- list(x = NA, las = 1, xlim = c(0, 1), ylim = yr, bty = "l",
                 xlab = "Compensation", ylab = ylab,
                 main = main, font.main = 1)
    if (length(new.args)) args[names(new.args)] <- new.args
    do.call(plot, args)
    abline(h = 0)
    for (i in seq_len(n)) {
      lines(comp, mat[sample, , i], col = scheme[i])
    }
    if (add_labs) {
      if (isTRUE(labs)) labs <- dimnames(mat)[[3]]
      text(1.01, mat[sample, length(comp), ], labs,
           cex = 0.7, col = scheme, adj = c(0, 0.5), xpd = NA)
    }
    if (add_points & type != "percent") {
      points(x$subclass$comp_amount, x$subclass$output[sample, ],
             pch = 21, col = scheme, bg = "white")
    }
  }
}


compmat_percent <- function(mat) {
  dims <- dim(mat)
  pc <- lapply(seq_len(dims[2]), function(i) {
    mat2 <- mat[, i, ]  # sample, subclass
    mat2 / rowSums(mat2) * 100
  })
  pc <- array(unlist(pc), dim = dims[c(1, 3, 2)],
              dimnames = dimnames(mat)[c(1, 3, 2)])  # sample, subclass, comp
  aperm(pc, c(1, 3, 2))
}