add ezvolcano tests

Author: jdreyf

.gitignore

@@ -2,4 +2,5 @@
 .Rhistory
 .RData
 inst/doc
-Thumbs.db
+Thumbs.db
+Rplots.pdf

R/ezvolcano.R

@@ -12,24 +12,23 @@
 #' @param comparison Name of contrast to plot. If given, it's assumed that \code{lfc.col=paste0(comparison, '.logFC')}
 #' and \code{sig.col=paste0(comparison, '.p') or paste0(comparison, '.FDR')}, and these are over-ridden.
 #' @param name Name of PNG file to write to. Set to \code{NA} to suppress writing to file.
-#' @param add.rnames Additional rownames of features to annotate. These must be in \code{rownames(tab)}.
+#' @param ann.rnames Additional rownames of \code{tab} to annotate; must be in \code{rownames(tab)}.
 #' @param up.color Color for points that are upregulated (\code{logFC>0}).
 #' @param down.color Color for points that are downregulated (\code{logFC<0}).
 #' @param x.bound x-axis limits are set to \code{c(-x.bound, x.bound)}. If \code{NULL, x.bound=max(abs(tab[,lfc.col]))}.
 #' @param y.bound y-axis limits are set to \code{c(0, y.bound)}. If \code{NULL, y.bound=max(tab[,'nlg10sig'])}.
 #' @param type.sig Type of significance y-axis should use, either "p" or "FDR".
 #' @param cut.color Color of points that meet both \code{cut.lfc} and \code{cut.sig}. If \code{NULL}, cutoffs are ignored.
 #' @param cut.lfc Points need to have \code{|logFC| >= cut.lfc} to have \code{cut.color}.
-#' @param cut.sig Points need to have significance \code{<= cut.sig} to have \code{cut.color}. Significance type is of
-#' \code{type.sig}.
+#' @param cut.sig Points need to have significance \code{tab[,sig.col] <= cut.sig} to have \code{cut.color}.
 #' @param sep Separator string between contrast names and suffix such as \code{logFC}.
 #' @param na.lab Character vector of labels in \code{lab.col} to treat as missing, in addition to \code{NA}.
 #' @details If \code{ntop.sig>0} or \code{ntop.lfc>0}, then \code{lab.col} must be in \code{colnames(tab)}.
 #' @return A ggplot object, invisibly.
 #' @export
 
-ezvolcano <- function(tab, lfc.col=NULL, sig.col=NULL, lab.col='Gene.Symbol', ntop.sig=0, ntop.lfc=0, comparison=NULL,
-                      name='volcano', add.rnames=NULL, up.color='black', down.color='black', x.bound=NULL, y.bound=NULL,
+ezvolcano <- function(tab, lfc.col=NULL, sig.col=NULL, lab.col=NULL, ntop.sig=0, ntop.lfc=0, comparison=NULL,
+                      name='volcano', ann.rnames=NULL, up.color='black', down.color='black', x.bound=NULL, y.bound=NULL,
                       type.sig=c('p', 'FDR'), cut.color=NULL, cut.lfc=1, cut.sig=0.05, sep='.', na.lab=c('---', '')){
   if (!requireNamespace("ggplot2", quietly = TRUE)){
     stop("Package 'ggplot2' needed for this function to work. Please install it.", call. = FALSE)
@@ -44,9 +43,9 @@ ezvolcano <- function(tab, lfc.col=NULL, sig.col=NULL, lab.col='Gene.Symbol', nt
       ntop.sig <- 0
       warning("ntop.sig > 0 but lab.col is null.")
     }
-    if (!is.null(add.rnames)){
-      add.rnames <- NULL
-      warning("add.rnames is not null, but lab.col is null.")
+    if (!is.null(ann.rnames)){
+      ann.rnames <- NULL
+      warning("ann.rnames is not null, but lab.col is null.")
     }
   }
 
@@ -69,8 +68,9 @@ ezvolcano <- function(tab, lfc.col=NULL, sig.col=NULL, lab.col='Gene.Symbol', nt
   }
 
   stopifnot((ntop.sig==0 & ntop.lfc==0) | lab.col %in% colnames(tab), ntop.sig==as.integer(ntop.sig),
-            ntop.lfc==as.integer(ntop.lfc), is.null(add.rnames)|add.rnames %in% rownames(tab),
-            lfc.col %in% colnames(tab), sig.col %in% colnames(tab), any(tab[,lfc.col]<0), any(tab[,lfc.col]>=0))
+            ntop.lfc==as.integer(ntop.lfc), is.null(ann.rnames)|ann.rnames %in% rownames(tab),
+            lfc.col %in% colnames(tab), sig.col %in% colnames(tab), any(tab[,lfc.col]<0), any(tab[,lfc.col]>=0),
+            length(x.bound)<=1, length(y.bound)<=1)
 
   tab <- data.frame(tab, nlg10sig=-log10(tab[,sig.col]))
   #want symmetric x-axis
@@ -99,13 +99,14 @@ ezvolcano <- function(tab, lfc.col=NULL, sig.col=NULL, lab.col='Gene.Symbol', nt
     if (ntop.sig > 0) top.sig.ind <- order(tab[,sig.col])[1:ntop.sig] else top.sig.ind <- NULL
     ind.annot <- setdiff(union(top.sig.ind, top.lfc.ind), na.lab.ind)
   }
-  #add.rnames to plot with symbol
-  if (!is.null(add.rnames)){
-    ind.add.rnames <- which(rownames(tab) %in% add.rnames)
-    ind.annot <- union(ind.add.rnames, ind.annot)
+  #ann.rnames to plot with symbol
+  if (!is.null(ann.rnames)){
+    ind.ann.rnames <- which(rownames(tab) %in% ann.rnames)
+    ind.annot <- union(ind.ann.rnames, ind.annot)
   }
   if (!is.null(ind.annot)){
-    vol <- vol + ggplot2::geom_text(data=tab[ind.annot,], mapping=ggplot2::aes_string(x=lfc.col, y='nlg10sig', label=lab.col), size=3, vjust=2)
+    vol <- vol + ggplot2::geom_text(data=tab[ind.annot,], mapping=ggplot2::aes_string(x=lfc.col, y='nlg10sig', label=lab.col),
+                                    size=3, vjust=2)
   }
 
   if (!is.na(name)) ggplot2::ggsave(filename=paste0(name, ".png"), plot=vol) else graphics::plot(vol)

R/multi_volcano.R

@@ -7,7 +7,7 @@
 #' @param ntop.sig Number of top significant features to annotate.
 #' @param ntop.lfc Number of top logFC features to annotate.
 #' @param name Name of PDF file to write to. Set to \code{NA} to suppress writing to file.
-#' @param add.rnames Additional rownames of features to annotate. These must be in \code{rownames(tab)}.
+#' @param ann.rnames Additional rownames of features to annotate. These must be in \code{rownames(tab)}.
 #' @param up.color Color for points that are upregulated (\code{logFC>0}).
 #' @param down.color Color for points that are downregulated (\code{logFC<0}).
 #' @param same.scale Logical indicating if different volcano plots should have the same x-limits and y-limits.
@@ -22,7 +22,7 @@
 #' @return List of ggplot objects from \code{\link{ezvolcano}}, invisibly.
 #' @export
 
-multi_volcano <- function(tab, lab.col=NULL, ntop.sig=0, ntop.lfc=0, name='volcanoes', add.rnames=NULL,
+multi_volcano <- function(tab, lab.col=NULL, ntop.sig=0, ntop.lfc=0, name='volcanoes', ann.rnames=NULL,
                           up.color='black', down.color='black', same.scale=FALSE, type.sig=c('p', 'FDR'), cut.color=NULL,
                           cut.lfc=1, cut.sig=0.05, sep='.', na.lab=c('---', '')){
 
@@ -49,7 +49,7 @@ multi_volcano <- function(tab, lab.col=NULL, ntop.sig=0, ntop.lfc=0, name='volca
   ret.lst <- list()
   for (contr in contr.names){
     ret.lst[[contr]] <- ezvolcano(tab=tab, lab.col=lab.col, ntop.sig=ntop.sig, ntop.lfc=ntop.lfc, comparison=contr,
-                                  name=NA, add.rnames=add.rnames, up.color=up.color, down.color=down.color, x.bound=x.bound,
+                                  name=NA, ann.rnames=ann.rnames, up.color=up.color, down.color=down.color, x.bound=x.bound,
                                   y.bound=y.bound, type.sig=type.sig, cut.color=cut.color, cut.lfc=cut.lfc, cut.sig=cut.sig,
                                   sep=sep, na.lab=na.lab)
   }

R/prune_mat.R

@@ -22,21 +22,21 @@ prune_mat <- function(object, symbols=NULL, only.symbols=FALSE, unique.rows=FALS
     }
 
     if (only.symbols){
-      if (verbose) message('Removing', length(na.sym.ind), 'rows without gene symbols.')
+      if (verbose) message('Removing ', length(na.sym.ind), ' rows without gene symbols.')
       object <- object[-na.sym.ind,]
     }
     if (unique.rows){
-      if (verbose) message('Removing', sum(duplicated(rownames(object))), 'rows with duplicated names.')
+      if (verbose) message('Removing ', sum(duplicated(rownames(object))), ' rows with duplicated names.')
       object <- object[!duplicated(rownames(object)),]
     }
   }#end if !is.null(sym)
 
   if (!is.null(ntop)){
-    if (verbose) cat('Selecting top', ntop, 'rows\n')
+    if (verbose) message('Selecting top ', ntop, ' rows.')
     if (ntop <= nrow(object)){
       object <- object[1:ntop,]
     } else {
-      if (verbose) message("After processing, object has only", nrow(object), "rows, so cannot subset to", ntop, "rows.")
+      if (verbose) message("After processing, object has only ", nrow(object), " rows, so cannot subset to ", ntop, " rows.")
     }
   }
   return(object)