R/src_BoxplotsFromCounts.R

In ATpoint/misterplotR: Functions for plotting and clustering of count data

#' Produce notched boxplots from count data
#' 
#' This minimal function accepts a count matrix (columns=samples, rows=regions/genes) 
#' and then uses ggplot2 to produce notched boxplots. 
#' 
#' @param InputData a matrix or dataframe with the count data
#' @param ScaleByQuantile a numeric vector with two elements that define the lower and upper quantile
#' which will be used to winsorize the data in order to limit infuence of outliers on the plot. 
#' @param Box.title the title of the boxplots
#' @param Box.color the color to fill the boxes with
#' @param Box.ylab the y-axis description
#' @param Box.axislabsize the fontsize of the axis labels
#' @param Box.titlesize the fontsize of the title
#' @param add.NumberElements logical, whether to add the number of rows of the count matrix to the end of the plot title 
#' like <PlotTitle (1000 elements)>
#' @param Return.Plot logical, whether to return the ggplot2 object to be saved as a variable
#' 
#' @details Not much to say here. The function accepts the counts "as-is" so any normalization or averaging of samples has to be done
#' externally.
#' 
#' @author Alexander Toenges
#' 
#' @examples 
#' 
#' cts <- sapply(seq(1,10), function(x) rnorm(1000,100))
#' colnames(cts) <- paste0("sample", seq(1,10))
#' PlotSaved <- BoxplotsFromCounts(InputData = cts, ScaleByQuantile = c(.01, .99), Box.title = "The main title", Return.Plot = TRUE)
#' 
#' @export
BoxplotsFromCounts <- function(InputData,
                               ScaleByQuantile    = NULL,
                               Box.title          = NULL,
                               Box.color          = "darkgoldenrod2",
                               Box.ylab           = "",
                               Box.axislabsize    = 25,
                               Box.titlesize      = 25,
                               add.NumberElements = TRUE,
                               Return.Plot        = FALSE
                               )
                          
{
  
  options(scipen=999)  
  require(ggplot2)  
  require(SummarizedExperiment)
  require(reshape2)
  
  ###########################################################################################################
  
  ## some up-front checks
  if(class(InputData) != "matrix" & class(InputData) != "data.frame"){
    stop("Format of InputData must be data.frame or matrix")
  }
  
  if(!is.null(ScaleByQuantile)){
    if(length(ScaleByQuantile) > 2 | length(ScaleByQuantile) < 2 | sum(is.numeric(ScaleByQuantile))) {
      stop("ScaleByQuantile must be a numeric vector of two elements", call. = FALSE)
    }
  }
  
  areColors <- function(x) {
    sapply(x, function(X) {
      tryCatch(is.matrix(col2rgb(X)), 
               error = function(e) FALSE)
    })
  }; if(sum(areColors(Box.color)) != 1) stop("Box.color is not a valid color", call. = FALSE)
    
  ###########################################################################################################
  
  ## melt df 
  if(is.null(colnames(InputData))){
    
    colnames(InputData) <- paste0("X", seq(1, ncol(InputData)))
    
  }
  
  if(class(InputData) == "matrix") InputData <- data.frame(InputData)
  
  ToPlot.melt <- suppressMessages( reshape2::melt(InputData) )
    
  ## optionally winsorize outliers to quantiles
  if (!is.null(ScaleByQuantile)){
    
    qt.upper <- as.numeric(quantile(ToPlot.melt$value, ScaleByQuantile[2], na.rm = TRUE))
    qt.lower <- as.numeric(quantile(ToPlot.melt$value, ScaleByQuantile[1], na.rm = TRUE))
      
    ToPlot.melt$value[which(ToPlot.melt$value > qt.upper)] <- qt.upper
    ToPlot.melt$value[which(ToPlot.melt$value < qt.lower)] <- qt.lower
      
  }
  
  if(add.NumberElements){
    
    numberElements <- dim(InputData)[1]
    
    nElements <- paste(numberElements, "elements")
    if(is.null(Box.title)) {
      Box.title <- nElements
    } else {
      Box.title <- paste(Box.title, paste0("(", nElements, ")"))
    }
  } 
  if(is.null(Box.title)) Box.title <- ""
   
    ## ggplot2-based notched boxplot
    LosPlottos <- ggplot(ToPlot.melt, aes(variable, value, color = Box.color))                           +
            
            geom_boxplot(notch = TRUE, outlier.shape=16, fill = Box.color, color = "black")              +
            
            theme_minimal() +
            
            theme(axis.title.y = element_text(size = Box.axislabsize),
                  axis.text.x = element_text(size = Box.axislabsize, angle = 90, margin=margin(5,0,0,0), hjust=1),
                  axis.text.y = element_text(size = Box.axislabsize, margin=margin(0,2,0,0)),
                  axis.line = element_line(colour = "black", 
                                           size = 1, linetype = "solid"))                               +
            
            theme(axis.ticks.length=unit(.5, "cm"))                                                     +
            
            labs(x = "", y = Box.ylab)                                                                  +
            
            ggtitle(Box.title)                                                                          +
            
            theme(plot.title = element_text(size = Box.titlesize, margin=margin(0,0,30,0)))
    
    print(LosPlottos)
    
    if(Return.Plot) return(LosPlottos)
    
}

## BoxplotFromSE(InputData = do.call(cbind, lapply(seq(1,10), function(x) rnorm(1000,100))))