feat: custom colors for heatmap annotations

R/heatmap.R

@@ -4,14 +4,14 @@
 #'
 #' Clustering high CV Genes and making a heatmap
 #'
 #' 1. Exploring the normalized data by calculating the coefficient of variation 
 #'    (CV) for each gene (g) using the formula CVg=SDg/meang.
 #' 2. We then identify genes with high CVs that should have large differences 
 #'    across the various profiled segments.
 #' 3. This unbiased approach can reveal highly variable genes across the study.
 #' 4. We plot the results using unsupervised hierarchical clustering, displayed 
 #'    as a heatmap.
 #'    
 #' @title Clustering high CV Genes and making a heatmap
 #'
 #' @description heatmap returns a heatmap plot and a list of genes in the plot
@@ -20,25 +20,25 @@
 
 #' @param object object Normalized NanoStringGeoMxSet object to use for heatmap.
 #'               It is a S4 object.
 #' @param norm.method normalization method quant: Upper quartile (Q3) 
 #'        normalization and neg: background normalization (Default: quant)
 #' @param annotation.col the annotations shown on right side of the heatmap
 #'                      (Default: c("class", "segment", "region"))
 #' @param ngenes Number of high CV genes to cluster and plot (Default: 200)
 #' @param scale.by.row.or.col Scale.by perform z-scaling. Choices are "row", 
 #'                            "column" and "none" (Default: "row")
 #' @param show.rownames Boolean specifying if row names are be shown.
 #'                      (Default: FALSE)
 #' @param show.colnames Boolean specifying if column names are be shown.
 #'                      (Default: FALSE)
 #' @param clustering.method Clustering method used. Accepts the same values as 
 #'.       hclust. e.g "ward.D", "ward.D2", "single", "complete", "average"
 #'.       (Default: "average")
 #' @param cluster.rows Boolean values determining if rows should be clustered 
 #'        or hclust object (Default: TRUE)
 #' @param cluster.cols Boolean values determining if cols should be clustered 
 #'        or hclust object (Default: TRUE)
 #' @param clustering.distance.rows Distance for clustering by rows 
 #'        (correlation, or euclidean) (Default: "correlation")
 #' @param clustering.distance.cols Distance for clustering by cols 
 #'        (correlation, or euclidean) (Default: "correlation")
@@ -49,6 +49,8 @@
 #' @param heatmap.color Colors of heatmap to match breaks above 
 #'                      (Default: colorRampPalette(
 #'                       c("blue", "white", "red"))(120))
+#' @param anno.colors A list of named vectors that assigns the levels of each 
+#'                    annotation to a specific color
 #'
 #' @importFrom NanoStringNCTools assayDataApply
 #' @importFrom Biobase assayDataElement
@@ -74,7 +76,8 @@
   clustering.distance.cols = "correlation",
   annotation.row = NA,
   breaks.by.values = seq(-3, 3, 0.05),
-  heatmap.color = colorRampPalette(c("blue", "white", "red"))(120)) {
+  heatmap.color = colorRampPalette(c("blue", "white", "red"))(120), 
+  annotation.colors = NULL) {
 
   # norm.method must be either quant or neg
   if((norm.method != "quant") && (norm.method != "neg")){
@@ -119,6 +122,9 @@
   anno.col <- 
     pData(object)[, annotation.col]
 
+  # annotation colors
+  anno.colors <- annotation.colors
+
   # make plot
   p <- pheatmap(
     plot.genes[1:ngenes, ],
@@ -134,9 +140,30 @@
     clustering_distance_cols = clustering.distance.cols,
     breaks = breaks.by.values,
     color = col.palette,
-    annotation_col = anno.col
+    annotation_col = anno.col, 
+    annotation_colors = anno.colors
   )
 
+  p <- pheatmap(
+    plot.genes[1:ngenes, ],
+    main = "Clustering high CV genes",
+    scale = scale.by.row.or.col,
+    show_rownames = show.rownames,
+    show_colnames = show.colnames,
+    border_color = NA,
+    clustering_method = clustering.method,
+    cluster_rows = cluster.rows,
+    cluster_cols = cluster.cols,
+    clustering_distance_rows = clustering.distance.rows,
+    clustering_distance_cols = clustering.distance.cols,
+    breaks = breaks.by.values,
+    color = col.palette,
+    annotation_col = anno.col, 
+    annotation_colors = anno.colors
+  )
+
+
+
   ## gene.df converts to data frame
   gene.df <- as.data.frame(plot.genes)
 

R/qc_preprocessing.R

@@ -107,6 +107,8 @@ qcProc <-  function(object,
   ## settings ####
   ## shift counts (useDALogic=TRUE adds 1 only to 0s)
   object <- shiftCountsOne(object, useDALogic = shift.counts.zero)
+
+
   ## list of user-defined segment QC params for annotations and variables
   ## expected to be always present in the input object
   qc.params <-

vignettes/Integration_Test_Kidney.Rmd

@@ -195,6 +195,12 @@ qc.output <-  qcProc(object = sdesign.list$object,
 
 ```{r Clustering high CV Genes, echo=TRUE}
 
+    anno.colors = list(
+       class = c(DKD = "yellow", normal = "orange"), 
+       region = c(glomerulus = "purple", tubule = "red"), 
+       segment = c(GeometricSegment = "blue", neg = "coral", PanCK = "green")
+    )
+
     heatmap.output <- heatMap(object = unsupervised.output$object, 
                         ngenes = 200, 
                         scale.by.row.or.col = "row", 
@@ -209,7 +215,8 @@ qc.output <-  qcProc(object = sdesign.list$object,
                         annotation.col = c("class", "segment", "region"), 
                         breaks.by.values = seq(-3, 3, 0.05), 
                         heatmap.color = colorRampPalette(c("blue", "white", "red"))(120), 
-                        norm.method = "quant")
+                        norm.method = "quant", 
+                        annotation.colors = anno.colors)
 
 
     print(heatmap.output$plot)