R/plotting_functions.R

Defines functions qvalHist quickPCplot sHeatmap heatList heatSet

Documented in heatList heatSet quickPCplot qvalHist sHeatmap

#' Plot heatmap of genes in KEGG pathway
#'
#' Plots a Complex Heatmap of the genes in a particular KEGG pathway.
#'
#' @param set The name of the KEGG gene set to be plotted
#' @param expr Gene expression matrix, with gene names as ENSEMBL ids
#' @param axistitle The title to be displayed above heatmap legend
#' @param ha: Heatmap annotation to be displayed below heatmap (optional)
#'
#' @return Heatmap of genes in specified KEGG pathway
#'
#' @examples
#' heatSet("hsa04012 ErbB signaling pathway", expr, "log2 counts")
#'
#' @export
heatSet <- function(set, expr, axistitle, ha = NULL) {
  genes.ens <- mapIds(org.Hs.eg.db, kegg.sets.hs[[set]], keytype = "ENTREZID", column = "ENSEMBL")
  genes.ens <- genes.ens[!is.na(genes.ens)]
  names(genes.ens) <- NULL
  genes.ens <- base::intersect(genes.ens, rownames(expr))
  set.expr <- expr[genes.ens, ]
  rownames(set.expr) <- mapIds(org.Hs.eg.db, rownames(set.expr), keytype = "ENSEMBL", column = "SYMBOL")
  maintitle <- paste(set, sep = " ", collapse = " ")
  ht <- Heatmap(set.expr, show_row_names = FALSE, cluster_columns = FALSE, name = axistitle,
                bottom_annotation = ha, column_title = maintitle, show_row_dend = FALSE,
                col = colorRamp2(c(-1.5, 0, 1.5), c("blue", "white", "red")),
                heatmap_legend_param = list(color_bar = "continuous", legend_direction = "horizontal",
                                            title_position = "lefttop"))
  draw(ht, heatmap_legend_side = "top")
}

#' Plot heatmap of genes in provided vector of gene symbols.
#'
#' Plots a Complex Heatmap of the genes in a provided character vector of gene symbols.
#'
#' @param genes Character vector of gene symbols to be plotted.
#' @param expr Gene expression matrix, with gene names as ENSEMBL ids
#' @param axistitle The title to be displayed above heatmap legend
#' @param ha: Heatmap annotation to be displayed below heatmap (optional)
#' @param maintitle: The main title to be printed above the heatmap.
#' @param print: logical: print heatmaps? (default = TRUE)
#' @param crows: logical: cluster rows? (default = TRUE)
#'
#' @return Heatmap of genes in specified KEGG pathway
#'
#' @examples
#' heatList(myGenes, expr, "log2 counts", maintitle = "Genes of Interest")
#'
#' @export
heatList <- function(genes, expr, axistitle, ha = NULL, maintitle = NULL, print = TRUE, crows = TRUE) {
  genes.ens <- mapIds(org.Hs.eg.db, genes, keytype = "SYMBOL", column = "ENSEMBL")
  genes.ens <- genes.ens[!is.na(genes.ens)]
  names(genes.ens) <- NULL
  genes.ens <- base::intersect(genes.ens, rownames(expr))
  set.expr <- expr[genes.ens, ]
  rownames(set.expr) <- mapIds(org.Hs.eg.db, rownames(set.expr), keytype = "ENSEMBL", column = "SYMBOL")
  ht <- Heatmap(set.expr, show_row_names = TRUE, cluster_columns = FALSE, name = axistitle,
                bottom_annotation = ha, column_title = maintitle, cluster_rows = crows,
                col = colorRamp2(c(-1.5, 0, 1.5), c("blue", "white", "red")),
                heatmap_legend_param = list(color_bar = "continuous", legend_direction = "horizontal",
                                            title_position = "lefttop"))
  if (isTRUE(print)) {
    draw(ht, heatmap_legend_side = "top")
  } else {
    return(ht)
  }
}

#' Simple Heatmap
#'
#' This is a simple wrapper for Complex Heatmap to produce a heatmap with no rownames/row dendrograms.
#'
#' @param mat matrix
#'
#' @return Complex Heatmap of input matrix
#'
#' @examples
#' sHeatmap(expr)
#'
#' @export
sHeatmap <- function(mat) {
  Heatmap(mat, show_row_dend = FALSE, show_row_names = FALSE)
}

#' Quick principal componenent graph
#'
#' This function runs principal component analysis on a matrix, extracts the first
#' principal components, and plots the desired PCs.
#'
#' @param mat matrix
#' @param by By default, variables are rows, samples are columns; "switch" reverses
#' @param annotations optional vector of annotations to be used for colors in scatterplot.
#' @param PCs principal components to be plotted; default = c(1, 2)
#'
#' @return ggplot2 scatterplot of desired princiapl componenets
#'
#' @examples
#' quickPCplot(expr, annot)
#'
#' @export
quickPCplot <- function(mat, by = NULL, annotations = NULL, title = NULL, PCs = c(1, 2)) {
  if(is.null(by)){
    mat <- t(mat)
  }
  mat.pc <- prcomp(mat)
  pc.to.plot <- mat.pc$x[, PCs] %>% as.data.frame()

  if(!is.null(annotations)){
    pc.to.plot <- cbind(pc.to.plot, annotations)
    colnames(pc.to.plot)[3] <- "Group"
    q <- ggplot(pc.to.plot, aes(x = PC1, y = PC2)) + geom_point(aes(color = Group))
  } else {
    q <- ggplot(pc.to.plot, aes(x = PC1, y = PC2)) + geom_point()
  }

  if(!is.null(title)){
    q <- q + ggtitle(title)
  }

  return(q)
}

#' Plot Q-value Histogram
#'
#' Plots the distribution of q-values as a ggplot2 histogram
#'
#' @param qvals vector of q-values to be plotted
#' @param main.title main title for plot
#' @param bwd histogram bin width
#'
#' @return ggplot2 histogram
#'
#' @examples
#' qvalHist(MR.qvals, "Q-value distribution", bwd = 0.1)
#'
#' @export
qvalHist <- function(qvals, main.title, bwd = 0.1){
  qvals <- data.frame(qvals)
  len = 1/bwd
  ggplot(data = x) +
    geom_histogram(aes(qvals), binwidth = bwd, color = "black",
                   fill = c("tomato3", rep("bisque2", len))) +
    ggtitle(main.title) + xlab("FDR-corrected Q-value")
}
danielderrick/defunctions documentation built on Aug. 4, 2017, 6:23 p.m.