R/plotGS.R

In mengchen18/mogsa: Multiple omics data integrative clustering and gene set analysis

#' Plot the gene set space
#' 
#' Plot the gene set space of objects of "moa" and "mgsa"
#' 
#' This is a convenience function to explore the gene set space so not very
#' flexible. For customized plot, please use the object of
#' \code{data@coord.comb} and \code{data@coord.sep}.
#' 
#' @param x An object of class \code{\link{mgsa-class}} or
#' \code{\link{moa.sup-class}}
#' @param axes An integer vector in the length 2 to indicate the axes to be
#' drawn.
#' @param center.only A logical to indicate whether the separate gene set
#' spaces from each of the data set should be plotted. Default is FALSE.
#' @param topN An integer specify N gene set from the most positive and
#' negative end of axes to be labeled
#' @param data.pch The shape for plotting each data set. This argument is
#' passed to points function, so only used when separate gene set spaces are
#' plotted (i.e. center.only = FALSE).
#' @param data.col The col for plotting each data set. This argument is passed
#' to points function, so only used when separate gene set spaces are plotted
#' (i.e. center.only = FALSE).
#' @param highlight.col The color used to highlight the selected gene sets
#' @param label Either a character vector or NULL (default). The character
#' vector should be the name of some gene sets want ot be labeled.
#' @param label.cex Passed to \code{\link{text}} function to adjust the the
#' labels
#' @param layout A matrix passed to the \code{layout} function.
#' @param \dots Other arguments passed to \code{\link{points}}
#' @return If assign to variable, A \code{list} of selected/highlighted gene
#' set at the (positve and negative) end of each axis will be returned.
#' @author Chen Meng
#' @export
#' @examples
#' 
#'   
#'   # library(mogsa)
#'   # loading gene expression data and supplementary data
#'   data(NCI60_4array_supdata)
#'   data(NCI60_4arrays)
#'   mgsa <- mogsa(x = NCI60_4arrays, sup=NCI60_4array_supdata, nf=9,
#'                 proc.row = "center_ssq1", w.data = "inertia", statis = TRUE)
#' 
#'   plotGS(mgsa, center.only = TRUE, topN=5)
#'   res <- plotGS(mgsa, center.only = FALSE, data.pch=1:4, data.col=1:4)
#'   res
#' 
plotGS <- function(x, axes=1:2, center.only=FALSE, topN=1, data.pch=20, data.col=1, highlight.col = 2,
                          label=NULL, label.cex=1, layout=NULL, ...) {
  
  if (inherits(x, "mgsa")) {
    data <- x@sup
  } else if (inherits(x, "moa.sup")) {
    data <- x
  } else 
    stop("x should be either mgsa or mog.sup class.")

  if (center.only) {
      r <- .plotGS.comb(data, axes=axes, label=label, label.cex=label.cex, 
        topN=topN, data.col=data.col, data.pch=data.pch, highlight.col = highlight.col, ...)
    } else {
      r <- .plotGS.sep(data, axes=axes, label=label, label.cex=label.cex, 
        topN=topN, layout=layout, data.col=data.col, data.pch=data.pch, highlight.col = highlight.col, ...) 
    }
  return(invisible(r))
}

# data is moa.sup object
.plotGS.sep <- function(data, axes, label, label.cex, topN, layout, data.col, data.pch, highlight.col, ...) {

      Nd <- length(data@coord.sep)
      if (length(data.pch)==1) data.pch <- rep(data.pch, Nd)
      if (length(data.col)==1) data.col <- rep(data.col, Nd)
      if (is.null(layout)) lo <- matrix(1:Nd, 1, Nd) else 
        lo <- layout
      layout(lo)

      sg <- lapply(data@coord.sep, .selectTopN, axes, n=topN)
      label <- unique(c(label, unlist(sg)))

      for (i in 1:Nd) {
        x <- data@coord.sep[[i]]
        plot(x[, axes], pch=NA)
        abline(v=0, h=0)
        col <- rep(data.col[i], nrow(x))
        col[rownames(x) %in% label] <- highlight.col
        points(x[, axes], pch=data.pch, col=col, ...)
        text(x=x[label, axes], labels=row.names(x[label, ]), cex=label.cex)
      }
      return(sg)
}

.plotGS.comb <- function(data, axes, label, label.cex, topN, data.col, data.pch, highlight.col, ...) {
  mat <- data@coord.comb
  sg <- .selectTopN(mat, axes, topN)
  label <- unique(c(label, unique(unlist(sg))))
  plot(mat[, axes], pch=NA)
  abline(v=0, h=0)
  col <- rep(data.col[1], nrow(mat))
  col[ rownames(mat) %in% label ] <- highlight.col
  points(mat[, axes], pch=data.pch, col=col, ...)
  text(x=mat[label, axes], labels=row.names(mat[label, ]), cex=label.cex)
  return(sg)
}

.selectTopN <- function(mat, col, n) {
  # give a matrix, select top positve and negative N elements for specific columns.
  if (n != 0) {
      r <- lapply(col, function(i) {
      v <- mat[, i]
      names(v) <- rownames(mat)
      sv <- sort(v)
      lv <- length(v)
      slow <- names(sv[1:n])
      shigh <- names(sv[(lv-n+1):lv])
      list(negN = slow, posN = shigh)
    })
    r <- unlist(r, recursive = FALSE)
    names(r) <- paste(paste("ax", rep(col, each=2), sep=""), names(r), sep=".")
  }
  else r <- NULL
  r
}