R/PSIHeatmap.R

In tangchao7498/ICAS:

#' heatmap of PSI
#'
#' @title PSIHeatmap
#' @name PSIHeatmap
#'
#' @importFrom pheatmap pheatmap
#'
#' @param object an ICASDataSet
#' @param SJ a charactor or vector of SJ
#' @param cells which cells are output, NULL for all cells
#'
#' @seealso \code{\link{pheatmap}}
#'
#' @export


PSIHeatmap <- function(object,
                       SJs,
                       cells = NULL,
                       RowAnno = NULL,
                       ColAnno = NULL,
                       cluster_rows = F,
                       cluster_cols = F,
                       show_rownames = F,
                       show_colnames = F,
                       na_col = "white",
                       ...) {
  if(!is(object, "ICASDataSet"))
    stop("The object must be a ICASDataSet data")

  if(any(!is.character(SJs)))
    stop("SJs must be a character formated chr:start-end:strand")

  if(any(!SJs %in% row.names(counts(object))))
    warning("some SJs are not in row.names(counts(object))")

  if(any(!SJs %in% row.names(psi(object))))
    warning("some SJs are constitutive SJ")

  SJs <- SJs[SJs %in% row.names(counts(object))]

  if(length(SJs) == 0) {
    stop("all SJs are not in row.names(counts(object))")
  }

  if(!is.null(cells)) {
    cells <- cells[cells %in% colnames(counts(object))]
    if(length(cells) == 0) {
      stop("all cells are not in colnames(counts(object))")
    }
  } else {
    cells <- row.names(colData(object))[order(colData(object)[[object@design]])]
  }

  if(is.null(ColAnno)) {
    ColAnno <- subset(colData(object), select = colnames(colData(object)) == object@design)
  } else {
    if(!all(cells %in% row.names(RowAnno))) {
      stop("row.names(RowAnno) must cover all cells")
    }
  }

  Mat <- PSIofSJ(object = object, SJ = SJs, cells = cells)

  pheatmap::pheatmap(Mat,
                     cluster_rows = cluster_rows,
                     cluster_cols = cluster_cols,
                     show_rownames = show_rownames,
                     show_colnames = show_colnames,
                     na_col = na_col,
                     annotation_col = as.data.frame(ColAnno),
                     annotation_row = RowAnno, ...)
}