Browse code

gp in anno_text() supports fill and border

Zuguang Gu authored on 24/03/2019 22:20:59
Showing8 changed files

... ...
@@ -185,6 +185,7 @@ export("oncoPrint")
185 185
 export("order.comb_mat")
186 186
 export("packLegend")
187 187
 export("pindex")
188
+export("restore_matrix")
188 189
 export("rowAnnotation")
189 190
 export("row_anno_barplot")
190 191
 export("row_anno_boxplot")
... ...
@@ -3,6 +3,9 @@ CHANGES in VERSION 1.99.6
3 3
 * adjust the size of heatmap annotations and add testing scripts
4 4
 * run multiple times k-means to get a consensus partition
5 5
 * `show_heatmap_legend` is set to FALSE if `rect_gp = gpar(type = "none")`
6
+* add `restore_matrix()`
7
+* add `row_names_centered`/`column_names_centered` arguments to `Heatmap()`
8
+* `gp` in `anno_text()` supports `fill` and `border`
6 9
 
7 10
 ========================
8 11
 
... ...
@@ -2000,11 +2000,31 @@ anno_text = function(x, which = c("column", "row"), gp = gpar(),
2000 2000
 
2001 2001
 	row_fun = function(index) {
2002 2002
 		n = length(index)
2003
-		grid.text(value[index], location, (n - seq_along(index) + 0.5)/n, gp = subset_gp(gp, index), just = just, rot = rot)
2003
+		gp = subset_gp(gp, index)
2004
+		gp2 = gp
2005
+        if("border" %in% names(gp2)) gp2$col = gp2$border
2006
+        if("fill" %in% names(gp2)) {
2007
+        	if(!"border" %in% names(gp2)) gp2$col = gp2$fill
2008
+        }
2009
+        if(any(c("border", "fill") %in% names(gp2))) {
2010
+        	grid.rect(y = (n - seq_along(index) + 0.5)/n, height = 1/n, gp = gp2)
2011
+        }
2012
+        
2013
+		grid.text(value[index], location, (n - seq_along(index) + 0.5)/n, gp = gp, just = just, rot = rot)
2004 2014
 	}
2005 2015
 	column_fun = function(index, k = NULL, N = NULL, vp_name = NULL) {
2006 2016
 		n = length(index)
2007
-		grid.text(value[index], (seq_along(index) - 0.5)/n, location, gp = subset_gp(gp, index), just = just, rot = rot)
2017
+		gp = subset_gp(gp, index)
2018
+		gp2 = gp
2019
+        if("border" %in% names(gp2)) gp2$col = gp2$border
2020
+        if("fill" %in% names(gp2)) {
2021
+        	if(!"border" %in% names(gp2)) gp2$col = gp2$fill
2022
+        }
2023
+        if(any(c("border", "fill") %in% names(gp2))) {
2024
+        	grid.rect(x = (seq_along(index) - 0.5)/n, width = 1/n, gp = gp2)
2025
+        }
2026
+        
2027
+		grid.text(value[index], (seq_along(index) - 0.5)/n, location, gp = gp, just = just, rot = rot)
2008 2028
 	}
2009 2029
 
2010 2030
 	if(which == "row") {
... ...
@@ -137,12 +137,14 @@ Heatmap = setClass("Heatmap",
137 137
 # -row_names_max_width Maximum width of row names viewport.
138 138
 # -row_names_gp Graphic parameters for row names.
139 139
 # -row_names_rot Rotation of row names.
140
+# -row_names_centered Should row names put centered?
140 141
 # -column_labels Optional column labels which are put as column names in the heatmap.
141 142
 # -column_names_side Should the column names be put on the top or bottom of the heatmap?
142 143
 # -column_names_max_height Maximum height of column names viewport.
143 144
 # -show_column_names Whether show column names.
144 145
 # -column_names_gp Graphic parameters for drawing text.
145 146
 # -column_names_rot Rotation of column names.
147
+# -column_names_centered Should column names put centered?
146 148
 # -top_annotation A `HeatmapAnnotation` object.
147 149
 # -bottom_annotation A `HeatmapAnnotation` object.
148 150
 # -left_annotation It should be specified by `rowAnnotation`.
... ...
@@ -242,12 +244,14 @@ Heatmap = function(matrix, col, name,
242 244
     row_names_max_width = unit(6, "cm"), 
243 245
     row_names_gp = gpar(fontsize = 12), 
244 246
     row_names_rot = 0,
247
+    row_names_centered = FALSE,
245 248
     column_labels = colnames(matrix),
246 249
     column_names_side = c("bottom", "top"), 
247 250
     show_column_names = TRUE, 
248 251
     column_names_max_height = unit(6, "cm"), 
249 252
     column_names_gp = gpar(fontsize = 12),
250 253
     column_names_rot = 90,
254
+    column_names_centered = FALSE,
251 255
 
252 256
     top_annotation = NULL,
253 257
     bottom_annotation = NULL,
... ...
@@ -257,10 +261,10 @@ Heatmap = function(matrix, col, name,
257 261
     km = 1, 
258 262
     split = NULL, 
259 263
     row_km = km,
260
-    row_km_repeats = 10,
264
+    row_km_repeats = 1,
261 265
     row_split = split,
262 266
     column_km = 1,
263
-    column_km_repeats = 10,
267
+    column_km_repeats = 1,
264 268
     column_split = NULL,
265 269
     gap = unit(1, "mm"),
266 270
     row_gap = unit(1, "mm"),
... ...
@@ -540,15 +544,22 @@ Heatmap = function(matrix, col, name,
540 544
     .Object@row_names_param$show = show_row_names
541 545
     .Object@row_names_param$gp = check_gp(row_names_gp)
542 546
     .Object@row_names_param$rot = row_names_rot
547
+    .Object@row_names_param$centered = row_names_centered
543 548
     .Object@row_names_param$max_width = row_names_max_width + unit(2, "mm")
544 549
     # we use anno_text to draw row/column names because it already takes care of text rotation
545 550
     if(show_row_names) {
546 551
         if(length(row_labels) != nrow(matrix)) {
547 552
             stop_wrap("Length of `row_labels` should be the same as the nrow of matrix.")
548 553
         }
549
-        row_names_anno = anno_text(row_labels, which = "row", gp = row_names_gp, rot = row_names_rot,
550
-            location = ifelse(.Object@row_names_param$side == "left", 1, 0), 
551
-            just = ifelse(.Object@row_names_param$side == "left", "right", "left"))
554
+        if(row_names_centered) {
555
+            row_names_anno = anno_text(row_labels, which = "row", gp = row_names_gp, rot = row_names_rot,
556
+                location = 0.5, 
557
+                just = "center")
558
+        } else {
559
+            row_names_anno = anno_text(row_labels, which = "row", gp = row_names_gp, rot = row_names_rot,
560
+                location = ifelse(.Object@row_names_param$side == "left", 1, 0), 
561
+                just = ifelse(.Object@row_names_param$side == "left", "right", "left"))
562
+        }
552 563
         .Object@row_names_param$anno = row_names_anno
553 564
     }
554 565
 
... ...
@@ -560,17 +571,24 @@ Heatmap = function(matrix, col, name,
560 571
     .Object@column_names_param$show = show_column_names
561 572
     .Object@column_names_param$gp = check_gp(column_names_gp)
562 573
     .Object@column_names_param$rot = column_names_rot
574
+    .Object@column_names_param$centered = column_names_centered
563 575
     .Object@column_names_param$max_height = column_names_max_height + unit(2, "mm")
564 576
     if(show_column_names) {
565 577
         if(length(column_labels) != ncol(matrix)) {
566 578
             stop_wrap("Length of `column_labels` should be the same as the ncol of matrix.")
567 579
         }
568
-        column_names_anno = anno_text(column_labels, which = "column", gp = column_names_gp, rot = column_names_rot,
569
-            location = ifelse(.Object@column_names_param$side == "top", 0, 1), 
570
-            just = ifelse(.Object@column_names_param$side == "top", 
571
-                     ifelse(.Object@column_names_param$rot >= 0, "left", "right"),
572
-                     ifelse(.Object@column_names_param$rot >= 0, "right", "left")
573
-                    ))
580
+        if(column_names_centered) {
581
+            column_names_anno = anno_text(column_labels, which = "column", gp = column_names_gp, rot = column_names_rot,
582
+            location = 0.5, 
583
+            just = "center")
584
+        } else {
585
+            column_names_anno = anno_text(column_labels, which = "column", gp = column_names_gp, rot = column_names_rot,
586
+                location = ifelse(.Object@column_names_param$side == "top", 0, 1), 
587
+                just = ifelse(.Object@column_names_param$side == "top", 
588
+                         ifelse(.Object@column_names_param$rot >= 0, "left", "right"),
589
+                         ifelse(.Object@column_names_param$rot >= 0, "right", "left")
590
+                        ))
591
+        }
574 592
         .Object@column_names_param$anno = column_names_anno
575 593
     }
576 594
 
... ...
@@ -1146,7 +1164,6 @@ make_cluster = function(object, which = c("row", "column")) {
1146 1164
         }
1147 1165
 
1148 1166
         meanmat = do.call("cbind", meanmat)
1149
-        hc = hclust(dist(t(meanmat)))
1150 1167
         # if `reorder` is a vector, the slice dendrogram is reordered by the mean of reorder in each slice
1151 1168
         # or else, weighted by the mean of `meanmat`.
1152 1169
         if(length(reorder) > 1) {
... ...
@@ -1154,7 +1171,12 @@ make_cluster = function(object, which = c("row", "column")) {
1154 1171
         } else {
1155 1172
             weight = colMeans(meanmat)
1156 1173
         }
1157
-        hc = as.hclust(reorder(as.dendrogram(hc), weight, mean))
1174
+        if(cluster_slices) {
1175
+            hc = hclust(dist(t(meanmat)))
1176
+            hc = as.hclust(reorder(as.dendrogram(hc), weight, mean))
1177
+        } else {
1178
+            hc = list(order = order(weight))
1179
+        }
1158 1180
 
1159 1181
         cl2 = numeric(length(cl))
1160 1182
         for(i in seq_along(hc$order)) {
... ...
@@ -430,9 +430,9 @@ setMethod(f = "draw_title",
430 430
     if(which == "row") {
431 431
         
432 432
         pushViewport(viewport(name = paste(object@name, "row_title", k, sep = "_"), clip = FALSE, ...))
433
-        if("fill" %in% names(gp)) {
434
-            grid.rect(gp = gpar(fill = gp$fill))
435
-        }
433
+        gp2 = gp
434
+        if("border" %in% names(gp2)) gp2$col = gp2$border
435
+        if(any(c("border", "fill") %in% names(gp2))) grid.rect(gp = gp2)
436 436
         if(side == "left") {
437 437
             grid.text(title, x = unit(1, "npc") - ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
438 438
         } else {
... ...
@@ -441,9 +441,9 @@ setMethod(f = "draw_title",
441 441
         upViewport()
442 442
     } else {
443 443
         pushViewport(viewport(name = paste(object@name, "column_title", k, sep = "_"), clip = FALSE, ...))
444
-        if("fill" %in% names(gp)) {
445
-            grid.rect(gp = gpar(fill = gp$fill))
446
-        }
444
+        gp2 = gp
445
+        if("border" %in% names(gp2)) gp2$col = gp2$border
446
+        if(any(c("border", "fill") %in% names(gp2))) grid.rect(gp = gp2)
447 447
         if(side == "top") {
448 448
             grid.text(title, y = ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
449 449
         } else {
... ...
@@ -73,7 +73,7 @@ default_col = function(x, main_matrix = FALSE) {
73 73
     } else if(is.numeric(x)) {
74 74
         if(main_matrix) {
75 75
             p = sum(x > 0)/sum(x != 0)
76
-            if(p > 0.3 & p < 0.7) {
76
+            if(p > 0.25 & p < 0.75) {
77 77
                 if(ht_opt$verbose) {
78 78
                     cat("This matrix has both negative and positive values, use a color mapping symmetric to zero\n")
79 79
                 }
... ...
@@ -721,6 +721,90 @@ pindex = function(m, i, j) {
721 721
     }
722 722
 }
723 723
 
724
+# == title
725
+# Restore the index vector to index matrix in layer_fun
726
+#
727
+# == param
728
+# -j Column indices directly from ``layer_fun``.
729
+# -i Row indices directly from ``layer_fun``.
730
+# -x Position on x-direction directly from ``layer_fun``.
731
+# -y Position on y-direction directly from ``layer_fun``.
732
+#
733
+# == details
734
+# The values that are sent to ``layer_fun`` are all vectors (for the vectorization
735
+# of the grid graphic functions), however, the heatmap slice where
736
+# ``layer_fun`` is applied to, is still represented by a matrix, thus, it would be
737
+# very convinient if all the arguments in ``layer_fun`` can be converted to the
738
+# sub-matrix for the current slice. Here, as shown in above example,
739
+# `restore_matrix` does the job. `restore_matrix` directly accepts the first
740
+# four argument in ``layer_fun`` and returns an index matrix, where rows and
741
+# columns correspond to the rows and columns in the current slice, from top to
742
+# bottom and from left to right. The values in the matrix are the natural order
743
+# of e.g. vector ``j`` in current slice.
744
+#
745
+# For following code:
746
+#
747
+#     Heatmap(small_mat, name = "mat", col = col_fun,
748
+#         row_km = 2, column_km = 2,
749
+#         layer_fun = function(j, i, x, y, w, h, fill) {
750
+#             ind_mat = restore_matrix(j, i, x, y)
751
+#             print(ind_mat)
752
+#         }
753
+#     )
754
+#
755
+# The first output which is for the top-left slice:
756
+# 
757
+#          [,1] [,2] [,3] [,4] [,5]
758
+#     [1,]    1    4    7   10   13
759
+#     [2,]    2    5    8   11   14
760
+#     [3,]    3    6    9   12   15
761
+#
762
+# As you see, this is a three-row and five-column index matrix where the first
763
+# row corresponds to the top row in the slice. The values in the matrix
764
+# correspond to the natural index (i.e. 1, 2, ...) in ``j``, ``i``, ``x``, ``y``,
765
+# ... in ``layer_fun``. Now, if we want to add values on the second column in the
766
+# top-left slice, the code which is put inside ``layer_fun`` would look like:
767
+#
768
+#     for(ind in ind_mat[, 2]) {
769
+#         grid.text(small_mat[i[ind], j[ind]], x[ind], y[ind], ...)
770
+#     }
771
+#
772
+# == example
773
+# set.seed(123)
774
+# mat = matrix(rnorm(81), nr = 9)
775
+# Heatmap(mat, row_km = 2, column_km = 2,
776
+#     layer_fun = function(j, i, x, y, width, height, fill) {
777
+#        ind_mat = restore_matrix(j, i, x, y)
778
+#        print(ind_mat)
779
+# })
780
+#
781
+# set.seed(123)
782
+# mat = matrix(round(rnorm(81), 2), nr = 9)
783
+# Heatmap(mat, row_km = 2, column_km = 2,
784
+#     layer_fun = function(j, i, x, y, width, height, fill) {
785
+#        ind_mat = restore_matrix(j, i, x, y)
786
+#        ind = unique(c(ind_mat[2, ], ind_mat[, 3]))
787
+#        grid.text(pindex(mat, i[ind], j[ind]), x[ind], y[ind])
788
+# })
789
+restore_matrix = function(j, i, x, y) {
790
+    x = as.numeric(x)
791
+    y = as.numeric(y)
792
+    od = order(x, rev(y))
793
+    ind = seq_along(i)
794
+    j = j[od]
795
+    i = i[od]
796
+    x = x[od]
797
+    y = y[od]
798
+    ind = ind[od]
799
+    
800
+    nr = length(unique(i))
801
+    nc = length(unique(j))
802
+    # I = matrix(i, nrow = nr, ncol = nc)
803
+    # J = matrix(j, nrow = nr, ncol = nc)
804
+    IND = matrix(ind, nrow = nr, ncol = nc)
805
+    return(IND)
806
+}
807
+
724 808
 
725 809
 unit_with_vp = function(..., vp = current.viewport()$name) {
726 810
     u = unit(...)
... ...
@@ -52,12 +52,14 @@ Heatmap(matrix, col, name,
52 52
     row_names_max_width = unit(6, "cm"),
53 53
     row_names_gp = gpar(fontsize = 12),
54 54
     row_names_rot = 0,
55
+    row_names_centered = FALSE,
55 56
     column_labels = colnames(matrix),
56 57
     column_names_side = c("bottom", "top"),
57 58
     show_column_names = TRUE,
58 59
     column_names_max_height = unit(6, "cm"),
59 60
     column_names_gp = gpar(fontsize = 12),
60 61
     column_names_rot = 90,
62
+    column_names_centered = FALSE,
61 63
     
62 64
     top_annotation = NULL,
63 65
     bottom_annotation = NULL,
... ...
@@ -67,10 +69,10 @@ Heatmap(matrix, col, name,
67 69
     km = 1,
68 70
     split = NULL,
69 71
     row_km = km,
70
-    row_km_repeats = 10,
72
+    row_km_repeats = 1,
71 73
     row_split = split,
72 74
     column_km = 1,
73
-    column_km_repeats = 10,
75
+    column_km_repeats = 1,
74 76
     column_split = NULL,
75 77
     gap = unit(1, "mm"),
76 78
     row_gap = unit(1, "mm"),
... ...
@@ -138,12 +140,14 @@ Heatmap(matrix, col, name,
138 140
   \item{row_names_max_width}{Maximum width of row names viewport.}
139 141
   \item{row_names_gp}{Graphic parameters for row names.}
140 142
   \item{row_names_rot}{Rotation of row names.}
143
+  \item{row_names_centered}{Should row names put centered?}
141 144
   \item{column_labels}{Optional column labels which are put as column names in the heatmap.}
142 145
   \item{column_names_side}{Should the column names be put on the top or bottom of the heatmap?}
143 146
   \item{column_names_max_height}{Maximum height of column names viewport.}
144 147
   \item{show_column_names}{Whether show column names.}
145 148
   \item{column_names_gp}{Graphic parameters for drawing text.}
146 149
   \item{column_names_rot}{Rotation of column names.}
150
+  \item{column_names_centered}{Should column names put centered?}
147 151
   \item{top_annotation}{A \code{\link{HeatmapAnnotation}} object.}
148 152
   \item{bottom_annotation}{A \code{\link{HeatmapAnnotation}} object.}
149 153
   \item{left_annotation}{It should be specified by \code{\link{rowAnnotation}}.}
150 154
new file mode 100644
... ...
@@ -0,0 +1,79 @@
1
+\name{restore_matrix}
2
+\alias{restore_matrix}
3
+\title{
4
+Restore the index vector to index matrix in layer_fun
5
+}
6
+\description{
7
+Restore the index vector to index matrix in layer_fun
8
+}
9
+\usage{
10
+restore_matrix(j, i, x, y)
11
+}
12
+\arguments{
13
+
14
+  \item{j}{Column indices directly from \code{layer_fun}.}
15
+  \item{i}{Row indices directly from \code{layer_fun}.}
16
+  \item{x}{Position on x-direction directly from \code{layer_fun}.}
17
+  \item{y}{Position on y-direction directly from \code{layer_fun}.}
18
+
19
+}
20
+\details{
21
+The values that are sent to \code{layer_fun} are all vectors (for the vectorization
22
+of the grid graphic functions), however, the heatmap slice where
23
+\code{layer_fun} is applied to, is still represented by a matrix, thus, it would be
24
+very convinient if all the arguments in \code{layer_fun} can be converted to the
25
+sub-matrix for the current slice. Here, as shown in above example,
26
+\code{\link{restore_matrix}} does the job. \code{\link{restore_matrix}} directly accepts the first
27
+four argument in \code{layer_fun} and returns an index matrix, where rows and
28
+columns correspond to the rows and columns in the current slice, from top to
29
+bottom and from left to right. The values in the matrix are the natural order
30
+of e.g. vector \code{j} in current slice.
31
+
32
+For following code:
33
+
34
+  \preformatted{
35
+    Heatmap(small_mat, name = "mat", col = col_fun,
36
+        row_km = 2, column_km = 2,
37
+        layer_fun = function(j, i, x, y, w, h, fill) \{
38
+            ind_mat = restore_matrix(j, i, x, y)
39
+            print(ind_mat)
40
+        \}
41
+    )  }
42
+
43
+The first output which is for the top-left slice:
44
+
45
+  \preformatted{
46
+         [,1] [,2] [,3] [,4] [,5]
47
+    [1,]    1    4    7   10   13
48
+    [2,]    2    5    8   11   14
49
+    [3,]    3    6    9   12   15  }
50
+
51
+As you see, this is a three-row and five-column index matrix where the first
52
+row corresponds to the top row in the slice. The values in the matrix
53
+correspond to the natural index (i.e. 1, 2, ...) in \code{j}, \code{i}, \code{x}, \code{y},
54
+... in \code{layer_fun}. Now, if we want to add values on the second column in the
55
+top-left slice, the code which is put inside \code{layer_fun} would look like:
56
+
57
+  \preformatted{
58
+    for(ind in ind_mat[, 2]) \{
59
+        grid.text(small_mat[i[ind], j[ind]], x[ind], y[ind], ...)
60
+    \}  }
61
+}
62
+\examples{
63
+set.seed(123)
64
+mat = matrix(rnorm(81), nr = 9)
65
+Heatmap(mat, row_km = 2, column_km = 2,
66
+    layer_fun = function(j, i, x, y, width, height, fill) {
67
+       ind_mat = restore_matrix(j, i, x, y)
68
+       print(ind_mat)
69
+})
70
+
71
+set.seed(123)
72
+mat = matrix(round(rnorm(81), 2), nr = 9)
73
+Heatmap(mat, row_km = 2, column_km = 2,
74
+    layer_fun = function(j, i, x, y, width, height, fill) {
75
+       ind_mat = restore_matrix(j, i, x, y)
76
+       ind = unique(c(ind_mat[2, ], ind_mat[, 3]))
77
+       grid.text(pindex(mat, i[ind], j[ind]), x[ind], y[ind])
78
+})
79
+}