Update plotOverlapMetric() and plotOneOverlapMetric() methods

KrasnitzLab · Feb 10, 2021 · dd8d8d7 · dd8d8d7
1 parent 2ce9f18
commit dd8d8d7
Show file tree

Hide file tree

Showing 11 changed files with 251 additions and 43 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -21,7 +21,6 @@ Imports: rtracklayer,
     stats,
     utils,
     pheatmap,
-    RColorBrewer,
     gridExtra,
     grDevices
 Suggests: BiocStyle, 

diff --git a/NAMESPACE b/NAMESPACE
@@ -20,14 +20,15 @@ importFrom(GenomicRanges,width)
 importFrom(IRanges,IRanges)
 importFrom(IRanges,ranges)
 importFrom(IRanges,width)
-importFrom(RColorBrewer,brewer.pal)
 importFrom(S4Vectors,"values<-")
 importFrom(S4Vectors,queryHits)
 importFrom(S4Vectors,subjectHits)
+importFrom(grDevices,col2rgb)
 importFrom(grDevices,colorRampPalette)
 importFrom(gridExtra,arrangeGrob)
 importFrom(gridExtra,grid.arrange)
 importFrom(magrittr,"%>%")
+importFrom(methods,hasArg)
 importFrom(methods,is)
 importFrom(pheatmap,pheatmap)
 importFrom(rtracklayer,import)

diff --git a/R/CNVMetricsOverlapInternalMethods.R b/R/CNVMetricsOverlapInternalMethods.R
@@ -86,6 +86,7 @@
 #'     type="DELETION")
 #' 
 #' @author Astrid Deschênes
+#' @encoding UTF-8
 #' @keywords internal
 calculateOverlapMetric <- function(sample01, sample02, method, type) {
 
@@ -155,6 +156,7 @@ calculateOverlapMetric <- function(sample01, sample02, method, type) {
 #'     
 #' @author Astrid Deschênes
 #' @importFrom GenomicRanges intersect width
+#' @encoding UTF-8
 #' @keywords internal
 calculateSorensen <- function(sample01, sample02) {
 
@@ -220,6 +222,7 @@ calculateSorensen <- function(sample01, sample02) {
 #'     
 #' @author Astrid Deschênes
 #' @importFrom GenomicRanges intersect width
+#' @encoding UTF-8
 #' @keywords internal
 calculateSzymkiewicz <- function(sample01, sample02) {
 
@@ -236,3 +239,106 @@ calculateSzymkiewicz <- function(sample01, sample02) {
     return(result)
 }
 
+#' @title Plot one graph related to metrics based on overlapping 
+#' amplified/deleted regions
+#' 
+#' @description Plot one heatmap of the metrics based on overlapping 
+#' amplified/deleted regions. 
+#' 
+#' @param metric a \code{CNVMetric} object containing the metrics calculated
+#' by \code{calculateOverlapRegionsMetric}.
+#' 
+#' @param type a \code{character} string indicating which graph to generate. 
+#' This should be (an unambiguous abbreviation of) one of  
+#' "\code{AMPLIFICATION}" or "\code{DELETION}".
+#' 
+#' @param show_colnames a \code{boolean} specifying if column names are 
+#' be shown.
+#' 
+#' @param \ldots further arguments passed to 
+#' \code{\link[pheatmap:pheatmap]{pheatmap::pheatmap()}} method.
+#' 
+#' @return a \code{gtable} object containing the heatmap for the specified 
+#' metric.
+#' 
+#' @seealso 
+#' 
+#' The default method  \code{\link[pheatmap:pheatmap]{pheatmap::pheatmap()}}.
+#' 
+#' @examples
+#' 
+#' #' ## Load required package to generate the samples
+#' require(GenomicRanges)
+#' 
+#' ## Create a GRangesList object with 3 samples
+#' ## The stand of the regions doesn't affect the calculation of the metric
+#' demo <- GRangesList()
+#' demo[["sample01"]] <- GRanges(seqnames = "chr1", 
+#'     ranges =  IRanges(start = c(1905048, 4554832, 31686841), 
+#'     end = c(2004603, 4577608, 31695808)), strand =  "*",
+#'     state = c("AMPLIFICATION", "AMPLIFICATION", "DELETION"))
+#' 
+#' demo[["sample02"]] <- GRanges(seqnames = "chr1", 
+#'     ranges =  IRanges(start = c(1995066, 31611222, 31690000), 
+#'     end = c(2204505, 31689898, 31895666)), strand =  c("-", "+", "+"),
+#'     state = c("AMPLIFICATION", "AMPLIFICATION", "DELETION"))
+#' 
+#' ## The amplified region in sample03 is a subset of the amplified regions 
+#' ## in sample01
+#' demo[["sample03"]] <- GRanges(seqnames = "chr1", 
+#'     ranges =  IRanges(start = c(1906069, 4558838), 
+#'     end = c(1909505, 4570601)), strand =  "*",
+#'     state = c("AMPLIFICATION", "DELETION"))
+#' 
+#' ## Calculating Sorensen metric
+#' metric <- calculateOverlapRegionsMetric(demo, method="sorensen")
+#' 
+#' ## Plot both amplification metrics using darkorange color
+#' CNVMetrics:::plotOneOverlapMetric(metric, type="AMPLIFICATION", 
+#'     colorRange=c("white", "darkorange"), show_colnames=FALSE)
+#'
+#' @author Astrid Deschênes
+#' @importFrom pheatmap pheatmap
+#' @importFrom grDevices colorRampPalette
+#' @importFrom methods hasArg
+#' @import GenomicRanges
+#' @encoding UTF-8
+#' @keywords internal
+plotOneOverlapMetric <- function(metric, type, colorRange, show_colnames, ...) 
+{
+    ## Prepare matrix by filling upper triangle
+    metricMat <- metric[[type]]
+    diag(metricMat) <- 1.0
+    metricMat[upper.tri(metricMat)] <- t(metricMat)[upper.tri(metricMat)]
+
+
+    ## Prepare main title (might not be used if main argument given by user)
+    metricInfo <- switch(attributes(metric)$metric, 
+                         "szymkiewicz"="Szymkiewicz-Simpson", 
+                         "sorensen"="Sorensen")
+    metricInfo <- paste0(type, " - ", metricInfo, " metric")
+
+    ## Create heatmap
+    ## If color information given, that information is used to create graph
+    ## If main title given, that information is used to create graph
+    if (!hasArg("breaks") && !hasArg("color")) {
+        ## Create color palette using colorRange parameter
+        colors <- colorRampPalette(colorRange)(255)
+        breaks <-  seq(0, 1, length.out=255)
+
+        if (!hasArg("main")) {
+            pheatmap(metricMat, main=metricInfo, show_colnames=show_colnames, 
+                     color=colors, breaks=breaks, ...)[[4]] 
+        } else {
+            pheatmap(metricMat, show_colnames=show_colnames, 
+                     color=colors, breaks=breaks, ...)[[4]]  
+        }
+    } else {
+        if (!hasArg("main")) {
+            pheatmap(metricMat, main=metricInfo, show_colnames=show_colnames, 
+                        ...)[[4]] 
+        } else {
+            pheatmap(metricMat, show_colnames=show_colnames, ...)[[4]]  
+        }
+    }
+}
diff --git a/R/CNVMetricsOverlapMethods.R b/R/CNVMetricsOverlapMethods.R
@@ -109,6 +109,7 @@
 #' 
 #' @author Astrid Deschênes, Pascal Belleau
 #' @import GenomicRanges 
+#' @encoding UTF-8
 #' @export
 calculateOverlapRegionsMetric <- function(segmentData, 
                                     method=c("sorensen", "szymkiewicz")) {
@@ -163,8 +164,9 @@ calculateOverlapRegionsMetric <- function(segmentData,
 
 #' @title Plot metrics based on overlapping amplified/deleted regions
 #' 
-#' @description Plot a heatmap of the metrics based on overlapping 
-#' amplified/deleted regions.
+#' @description Plot one heatmap (or two heatmaps) of the metrics based on 
+#' overlapping amplified/deleted regions. The user can select to print the
+#' heatmap related to amplified, deleted regions or both.
 #' 
 #' @param metric a \code{CNVMetric} object containing the metrics calculated
 #' by \code{calculateOverlapRegionsMetric}.
@@ -173,9 +175,19 @@ calculateOverlapRegionsMetric <- function(segmentData,
 #' This should be (an unambiguous abbreviation of) one of "\code{BOTH}", 
 #' "\code{AMPLIFICATION}" or "\code{DELETION}". Default: "\code{BOTH}".
 #' 
+#' @param colorRange a \code{vector} of 2 \code{character} string 
+#' representing the 2 colors that will be
+#' assigned to the lowest (0) and highest value (1) in the heatmap. 
+#' Default: \code{c("white", "darkblue")}.
 #' 
-#' @return a \code{gtable} object containing the heatmap of the specified 
-#' metric. TODO
+#' @param show_colnames a \code{boolean} specifying if column names are 
+#' be shown. Default: \code{FALSE}.
+#' 
+#' @param \ldots further arguments passed to 
+#' \code{\link[pheatmap:pheatmap]{pheatmap::pheatmap()}} method.
+#' 
+#' @return a \code{gtable} object containing the heatmap(s) of the specified 
+#' metric(s).
 #' 
 #' @examples
 #' 
@@ -212,15 +224,17 @@ calculateOverlapRegionsMetric <- function(segmentData,
 #' 
 #' The default method  \code{\link[pheatmap:pheatmap]{pheatmap::pheatmap()}}.
 #' 
-#' @author Astrid Deschênes, Pascal Belleau
-#' @importFrom grDevices colorRampPalette
-#' @importFrom RColorBrewer brewer.pal
+#' @author Astrid Deschênes
+#' @importFrom grDevices colorRampPalette col2rgb 
 #' @importFrom pheatmap pheatmap
 #' @importFrom gridExtra grid.arrange arrangeGrob
 #' @import GenomicRanges
+#' @encoding UTF-8
 #' @export
 plotOverlapMetric <- function(metric, 
-                              type=c("BOTH", "AMPLIFICATION", "DELETION")) {
+                                type=c("BOTH", "AMPLIFICATION", "DELETION"),
+                                colorRange=c(c("white", "darkblue")), 
+                                show_colnames=FALSE, ...) {
 
     ## Validate that the metric parameter is a CNVMetric object
     if (!is.CNVMetric(metric)) {
@@ -230,45 +244,38 @@ plotOverlapMetric <- function(metric,
     ## Assign type parameter
     type <- match.arg(type)
 
+    ## Validate that the color name has only one value
+    if (!is.character(colorRange) || length(colorRange) < 2) {
+        stop("\'colorRange\' must be a vector of 2 character strings.")
+    }
+
+    ## Validate that the color name is valid
+    tryCatch(col2rgb(colorRange), error = function(e) {
+        stop("\'colorRange\' must be be a vector of 2 valid color names.")
+    })
+
     ## Extract the type of metric
     metricInfo <- attributes(metric)$metric
 
     plot_list <- list()
 
-    colors <- colorRampPalette(brewer.pal(9, "Blues"))(255)
-    breaks <-  seq(0, 1, length.out = 255)
-
     ## Amplification
     if (type %in% c("AMPLIFICATION", "BOTH")) {
-        ampMatrix <- metric$AMPLIFICATION
-        diag(ampMatrix) <- 1.0
-        ampMatrix[upper.tri(ampMatrix)] <- t(ampMatrix)[upper.tri(ampMatrix)]
-
-        rownames(ampMatrix) <-  rownames(metric$AMPLIFICATION)
-        colnames(ampMatrix) <- NULL
-        plot_list[["AMPLIFICATION"]] <- pheatmap(ampMatrix, cluster_rows=TRUE, 
-                                                 cluster_cols=TRUE,
-                                                 main="Amplification",
-                                                 color=colors, 
-                                                 breaks=breaks)[[4]]    
+        plot_list[["AMPLIFICATION"]] <- plotOneOverlapMetric(metric=metric,
+                                            type="AMPLIFICATION", 
+                                            colorRange=colorRange, 
+                                            show_colnames=show_colnames, ...)  
     }
 
     ## Deletion
     if (type %in% c("DELETION", "BOTH")) {
-        delMatrix <- metric$DELETION
-        diag(delMatrix) <- 1.0
-        delMatrix[upper.tri(delMatrix)] <- t(delMatrix)[upper.tri(delMatrix)]
-
-        rownames(delMatrix) <-  rownames(metric$DELETION)
-        colnames(delMatrix) <- NULL
-
-        plot_list[["DELETION"]] <- pheatmap(delMatrix, cluster_rows=TRUE, 
-                                            cluster_cols=TRUE,
-                                            main="Deletion",
-                                            color=colors, breaks=breaks)[[4]]   
+        plot_list[["DELETION"]] <- plotOneOverlapMetric(metric=metric,
+                                            type="DELETION", 
+                                            colorRange=colorRange, 
+                                            show_colnames=show_colnames, ...)  
     }
 
     n_col <- ifelse(type == "BOTH", 2, 1)
 
-    grid.arrange(arrangeGrob(grobs= plot_list, ncol=n_col))
+    grid.arrange(arrangeGrob(grobs=plot_list, ncol=n_col))
 }
diff --git a/man/calculateOverlapMetric.Rd b/man/calculateOverlapMetric.Rd
diff --git a/man/calculateOverlapRegionsMetric.Rd b/man/calculateOverlapRegionsMetric.Rd
diff --git a/man/calculateSorensen.Rd b/man/calculateSorensen.Rd
diff --git a/man/calculateSzymkiewicz.Rd b/man/calculateSzymkiewicz.Rd
diff --git a/man/plotOneOverlapMetric.Rd b/man/plotOneOverlapMetric.Rd