Browse code

add labels_rot argument to anno_mark()

Zuguang Gu authored on 02/07/2019 20:34:44
Showing9 changed files

... ...
@@ -2,7 +2,7 @@ Package: ComplexHeatmap
2 2
 Type: Package
3 3
 Title: Make Complex Heatmaps
4 4
 Version: 2.1.0
5
-Date: 2019-05-03
5
+Date: 2019-07-02
6 6
 Author: Zuguang Gu
7 7
 Maintainer: Zuguang Gu <z.gu@dkfz.de>
8 8
 Depends: R (>= 3.1.2), methods, grid, graphics, stats, grDevices
... ...
@@ -2,6 +2,7 @@ CHANGES in VERSION 2.1.0
2 2
 
3 3
 * check the length of the clustering objects and the matrix rows/columns
4 4
 * `anno_oncoprint_barplot()`: add `ylim` argumnet
5
+* `anno_mark()`: add `labels_rot` argument
5 6
 
6 7
 ========================
7 8
 
... ...
@@ -2704,6 +2704,7 @@ row_anno_text = function(...) {
2704 2704
 # -lines_gp Please use ``link_gp`` instead.
2705 2705
 # -link_gp Graphic settings for the segments.
2706 2706
 # -labels_gp Graphic settings for the labels.
2707
+# -labels_rot Rotations of labels, scalar.
2707 2708
 # -padding Padding between neighbouring labels in the plot.
2708 2709
 # -link_width Width of the segments.
2709 2710
 # -link_height Similar as ``link_width``, used for column annotation.
... ...
@@ -2732,7 +2733,8 @@ row_anno_text = function(...) {
2732 2733
 # Heatmap(m) + rowAnnotation(mark = anno)
2733 2734
 anno_mark = function(at, labels, which = c("column", "row"), 
2734 2735
 	side = ifelse(which == "column", "top", "right"),
2735
-	lines_gp = gpar(), labels_gp = gpar(), padding = 0.5, 
2736
+	lines_gp = gpar(), labels_gp = gpar(), 
2737
+	labels_rot = ifelse(which == "column", 90, 0), padding = 0.5, 
2736 2738
 	link_width = unit(5, "mm"), link_height = link_width,
2737 2739
 	link_gp = lines_gp, 
2738 2740
 	extend = unit(0, "mm")) {
... ...
@@ -2759,9 +2761,9 @@ anno_mark = function(at, labels, which = c("column", "row"),
2759 2761
 
2760 2762
 	if(which == "row") {
2761 2763
 		height = unit(1, "npc")
2762
-		width = link_width + max_text_width(labels, gp = labels_gp)
2764
+		width = link_width + max_text_width(labels, gp = labels_gp, rot = labels_rot)
2763 2765
 	} else {
2764
-		height = link_width + max_text_width(labels, gp = labels_gp)
2766
+		height = link_width + max_text_height(labels, gp = labels_gp, rot = labels_rot)
2765 2767
 		width = unit(1, "npc")
2766 2768
 	}
2767 2769
 
... ...
@@ -2801,13 +2803,13 @@ anno_mark = function(at, labels, which = c("column", "row"),
2801 2803
 
2802 2804
 		n2 = length(labels)
2803 2805
 		if(side == "right") {
2804
-			grid.text(labels, rep(link_width, n2), h, default.units = "native", gp = labels_gp, just = "left")
2806
+			grid.text(labels, rep(link_width, n2), h, default.units = "native", gp = labels_gp, rot = labels_rot, just = "left")
2805 2807
 			link_width = link_width - unit(1, "mm")
2806 2808
 			grid.segments(unit(rep(0, n2), "npc"), pos, rep(link_width*(1/3), n2), pos, default.units = "native", gp = link_gp)
2807 2809
 			grid.segments(rep(link_width*(1/3), n2), pos, rep(link_width*(2/3), n2), h, default.units = "native", gp = link_gp)
2808 2810
 			grid.segments(rep(link_width*(2/3), n2), h, rep(link_width, n2), h, default.units = "native", gp = link_gp)
2809 2811
 		} else {
2810
-			grid.text(labels, unit(1, "npc")-rep(link_width, n2), h, default.units = "native", gp = labels_gp, just = "right")
2812
+			grid.text(labels, unit(1, "npc")-rep(link_width, n2), h, default.units = "native", gp = labels_gp, rot = labels_rot, just = "right")
2811 2813
 			link_width = link_width - unit(1, "mm")
2812 2814
 			grid.segments(unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_width*(1/3), n2), pos, default.units = "native", gp = link_gp)
2813 2815
 			grid.segments(unit(1, "npc")-rep(link_width*(1/3), n2), pos, unit(1, "npc")-rep(link_width*(2/3), n2), h, default.units = "native", gp = link_gp)
... ...
@@ -2847,13 +2849,13 @@ anno_mark = function(at, labels, which = c("column", "row"),
2847 2849
 
2848 2850
 		n2 = length(labels)
2849 2851
 		if(side == "top") {
2850
-			grid.text(labels, h, rep(link_height, n2), default.units = "native", gp = labels_gp, rot = 90, just = "left")
2852
+			grid.text(labels, h, rep(link_height, n2), default.units = "native", gp = labels_gp, rot = labels_rot, just = "left")
2851 2853
 			link_height = link_height - unit(1, "mm")
2852 2854
 			grid.segments(pos, unit(rep(0, n2), "npc"), pos, rep(link_height*(1/3), n2), default.units = "native", gp = link_gp)
2853 2855
 			grid.segments(pos, rep(link_height*(1/3), n2), h, rep(link_height*(2/3), n2), default.units = "native", gp = link_gp)
2854 2856
 			grid.segments(h, rep(link_height*(2/3), n2), h, rep(link_height, n), default.units = "native", gp = link_gp)
2855 2857
 		} else {
2856
-			grid.text(labels, h, rep(max_text_width(labels, gp = labels_gp), n2), default.units = "native", gp = labels_gp, rot = 90, just = "right")
2858
+			grid.text(labels, h, rep(max_text_width(labels, gp = labels_gp), n2), default.units = "native", gp = labels_gp, rot = labels_rot, just = "right")
2857 2859
 			link_height = link_height - unit(1, "mm")
2858 2860
 			grid.segments(pos, unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_height*(1/3), n2), default.units = "native", gp = link_gp)
2859 2861
 			grid.segments(pos, unit(1, "npc")-rep(link_height*(1/3), n2), h, unit(1, "npc")-rep(link_height*(2/3), n2), default.units = "native", gp = link_gp)
... ...
@@ -2875,7 +2877,7 @@ anno_mark = function(at, labels, which = c("column", "row"),
2875 2877
 		width = width,
2876 2878
 		height = height,
2877 2879
 		n = -1,
2878
-		var_import = list(at, labels2index, at2labels, link_gp, labels_gp, padding, .pos, .scale,
2880
+		var_import = list(at, labels2index, at2labels, link_gp, labels_gp, labels_rot, padding, .pos, .scale,
2879 2881
 			side, link_width, link_height, extend),
2880 2882
 		show_name = FALSE
2881 2883
 	)
... ...
@@ -341,6 +341,7 @@ list_components = function() {
341 341
 # == param
342 342
 # -text A vector of text.
343 343
 # -gp Graphic parameters for text.
344
+# -rot Rotation of the text, scalar.
344 345
 #
345 346
 # == details
346 347
 # It simply calculates maximum width of a list of `grid::textGrob` objects.
... ...
@@ -360,14 +361,14 @@ list_components = function() {
360 361
 # x = c("a", "bb", "ccc")
361 362
 # max_text_width(x, gp = gpar(fontsize = 10))
362 363
 #
363
-max_text_width = function(text, gp = gpar()) {
364
+max_text_width = function(text, gp = gpar(), rot = 0) {
364 365
     if(is.null(text)) {
365 366
         return(unit(0, "mm"))
366 367
     }
367 368
     n = length(text)
368 369
     gp = recycle_gp(gp, n)
369 370
 
370
-    u = max(do.call("unit.c", lapply(seq_len(n), function(i) grobWidth(textGrob(text[i], gp = subset_gp(gp, i))))))
371
+    u = max(do.call("unit.c", lapply(seq_len(n), function(i) grobWidth(textGrob(text[i], gp = subset_gp(gp, i), rot = rot)))))
371 372
     convertWidth(u, "mm")
372 373
 }
373 374
 
... ...
@@ -377,6 +378,7 @@ max_text_width = function(text, gp = gpar()) {
377 378
 # == param
378 379
 # -text A vector of text.
379 380
 # -gp Graphic parameters for text.
381
+# -rot Rotation of the text, scalar.
380 382
 #
381 383
 # == details
382 384
 # It simply calculates maximum height of a list of `grid::textGrob` objects.
... ...
@@ -396,14 +398,14 @@ max_text_width = function(text, gp = gpar()) {
396 398
 # x = c("a", "b\nb", "c\nc\nc")
397 399
 # max_text_height(x, gp = gpar(fontsize = 10))
398 400
 #
399
-max_text_height = function(text, gp = gpar()) {
401
+max_text_height = function(text, gp = gpar(), rot = 0) {
400 402
     if(is.null(text)) {
401 403
         return(unit(0, "mm"))
402 404
     }
403 405
     n = length(text)
404 406
     gp = recycle_gp(gp, n)
405 407
 
406
-    u = max(do.call("unit.c", lapply(seq_len(n), function(i) grobHeight(textGrob(text[i], gp = subset_gp(gp, i))))))
408
+    u = max(do.call("unit.c", lapply(seq_len(n), function(i) grobHeight(textGrob(text[i], gp = subset_gp(gp, i), rot = rot)))))
407 409
     convertHeight(u, "mm")
408 410
 }
409 411
 
410 412
new file mode 100644
... ...
@@ -0,0 +1,91 @@
1
+
2
+
3
+logo = readLines(textConnection("
4
+oooooo                  oooooo  oo          oo  oo
5
+oooooo                  oooooo  oo          oo  oo
6
+oo      oooooo  oo  oo  oo  oo  oo  oooooo  oooooo
7
+oo      oooooo  oooooo  oo  oo  oo  oooooo  oooooo
8
+oo      oo  oo  oooooo  oooo    oo  oo  oo    oo
9
+oo      oo  oo  oooooo  oooo    oo  oo  oo    oo
10
+oooooo  oooooo  oo  oo  oo      oo  oooo    oo  oo
11
+oooooo  oooooo  oo  oo  oo      oo  oooo    oo  oo
12
+
13
+oo  oo                    oo                    oooooo
14
+oo  oo                    oo                    oooooo
15
+oo  oo  oooooo    oooo  oooooo  oo  oo  oooooo  oo  oo
16
+oo  oo  oooooo    oooo  oooooo  oooooo  oooooo  oo  oo
17
+oooooo  oo  oo  oo  oo    oo    oooooo  oo  oo  oooo
18
+oooooo  oo  oo  oo  oo    oo    oooooo  oo  oo  oooo
19
+oo  oo  oooo    oooooo    oo    oo  oo  oooo    oo
20
+oo  oo  oooo    oooooo    oo    oo  oo  oooo    oo
21
+"))
22
+
23
+logo = strsplit(logo, "")
24
+
25
+mat1 = matrix(0, nrow = 8, ncol = max(sapply(logo[2:9], length)))
26
+for(i in 2:9) {
27
+	mat1[i - 1, which(!grepl("^\\s*$", logo[[i]]))] = 1
28
+}
29
+mat1 = cbind(matrix(0, nrow = nrow(mat1), ncol = 2), mat1)
30
+
31
+mat2 = matrix(0, nrow = 8, ncol = max(sapply(logo[11:18], length)))
32
+for(i in 11:18) {
33
+	mat2[i - 10, which(!grepl("^\\s*$", logo[[i]]))] = 1
34
+}
35
+
36
+mat = cbind(mat1, matrix(0, nrow = nrow(mat1), ncol = 4), mat2)
37
+
38
+if(ncol(mat1) > ncol(mat2)) {
39
+	mat2 = cbind(mat2, matrix(0, nrow = nrow(mat2), ncol = ncol(mat1) - ncol(mat2)))
40
+} else {
41
+	mat1 = cbind(mat1, matrix(0, nrow = nrow(mat1), ncol = ncol(mat2) - ncol(mat1)))
42
+}
43
+
44
+mat = rbind(mat1, matrix(0, nrow = 2, ncol = ncol(mat1)), mat2)
45
+
46
+mat = rbind(matrix(0, nrow = 30, ncol = ncol(mat1)),
47
+	        mat,
48
+	        matrix(0, nrow = 30, ncol = ncol(mat1)))
49
+
50
+mat = cbind(matrix(0, nrow = nrow(mat), ncol = 10),
51
+	        mat,
52
+	        matrix(0, nrow = nrow(mat), ncol = 10))
53
+
54
+mat[nrow(mat) - 27, 9:(ncol(mat) - 8)] = 1
55
+mat[nrow(mat) - 26, 9:(ncol(mat) - 8)] = 1
56
+mat[28, 9:(ncol(mat) - 8)] = 1
57
+mat[27, 9:(ncol(mat) - 8)] = 1
58
+
59
+
60
+
61
+library(ComplexHeatmap)
62
+library(circlize)
63
+col_fun = function(x) {
64
+	n = length(x)
65
+	col = ifelse(x == 1, add_transparency("#4DAF4A", runif(n, min = 0, max = 0.3)),
66
+		                 rand_color(n, luminosity = "light", transparency = 0.8))
67
+}
68
+attr(col_fun, "breaks") = c(0, 1)
69
+ht = Heatmap(mat, name = "foo", rect_gp = gpar(col = "white", lwd = 0.5), cluster_rows = FALSE, cluster_columns = FALSE,
70
+	col = col_fun, show_heatmap_legend = FALSE)
71
+g = grid.grabExpr(draw(ht, padding = unit(c(0, 0, 0, 0), "mm")))
72
+
73
+grid.newpage()
74
+pushViewport(viewport(xscale = c(0, 2), yscale = c(0, 2), width = unit(0.9, "snpc"), height = unit(0.9, "snpc")))
75
+grid.polygon(cos(0:5 * pi/3 + pi/6)*1 + 1,
76
+     sin(0:5 * pi/3 + pi/6)*1 + 1, default.units = "native",
77
+     gp = gpar(col = "#4DAF4A", lwd = 6))
78
+height = 1
79
+pushViewport(viewport(x = 0.5, y = 0.5, height = height, width = height*ncol(mat)/nrow(mat)))
80
+grid.draw(g)
81
+popViewport()
82
+grid.polygon(cos(0:5 * pi/3 + pi/6)*1 + 1,
83
+     sin(0:5 * pi/3 + pi/6)*1 + 1, default.units = "native",
84
+     gp = gpar(col = "#4DAF4A", lwd = 8))
85
+popViewport()
86
+
87
+library(gridgeometry)
88
+A = g
89
+B = polygonGrid(cos(0:5 * pi/3 + pi/6)*1 + 1,
90
+     sin(0:5 * pi/3 + pi/6)*1 + 1, default.units = "native",
91
+     gp = gpar(col = "#4DAF4A", lwd = 8))
... ...
@@ -9,7 +9,8 @@ Link annotation with labels
9 9
 \usage{
10 10
 anno_mark(at, labels, which = c("column", "row"),
11 11
     side = ifelse(which == "column", "top", "right"),
12
-    lines_gp = gpar(), labels_gp = gpar(), padding = 0.5,
12
+    lines_gp = gpar(), labels_gp = gpar(),
13
+    labels_rot = ifelse(which == "column", 90, 0), padding = 0.5,
13 14
     link_width = unit(5, "mm"), link_height = link_width,
14 15
     link_gp = lines_gp,
15 16
     extend = unit(0, "mm"))
... ...
@@ -23,6 +24,7 @@ anno_mark(at, labels, which = c("column", "row"),
23 24
   \item{lines_gp}{Please use \code{link_gp} instead.}
24 25
   \item{link_gp}{Graphic settings for the segments.}
25 26
   \item{labels_gp}{Graphic settings for the labels.}
27
+  \item{labels_rot}{Rotations of labels, scalar.}
26 28
   \item{padding}{Padding between neighbouring labels in the plot.}
27 29
   \item{link_width}{Width of the segments.}
28 30
   \item{link_height}{Similar as \code{link_width}, used for column annotation.}
... ...
@@ -7,12 +7,13 @@ Maximum Height of Text
7 7
 Maximum Height of Text
8 8
 }
9 9
 \usage{
10
-max_text_height(text, gp = gpar())
10
+max_text_height(text, gp = gpar(), rot = 0)
11 11
 }
12 12
 \arguments{
13 13
 
14 14
   \item{text}{A vector of text.}
15 15
   \item{gp}{Graphic parameters for text.}
16
+  \item{rot}{Rotation of the text, scalar.}
16 17
 
17 18
 }
18 19
 \details{
... ...
@@ -7,12 +7,13 @@ Maximum Width of Text
7 7
 Maximum Width of Text
8 8
 }
9 9
 \usage{
10
-max_text_width(text, gp = gpar())
10
+max_text_width(text, gp = gpar(), rot = 0)
11 11
 }
12 12
 \arguments{
13 13
 
14 14
   \item{text}{A vector of text.}
15 15
   \item{gp}{Graphic parameters for text.}
16
+  \item{rot}{Rotation of the text, scalar.}
16 17
 
17 18
 }
18 19
 \details{
... ...
@@ -293,8 +293,11 @@ draw(anno, test = "heatmap, colors")
293 293
 anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], which = "row")
294 294
 draw(anno, index = 1:100, test = "anno_mark")
295 295
 
296
+anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], labels_rot = 30, which = "row")
297
+draw(anno, index = 1:100, test = "anno_mark")
298
+
296 299
 m = matrix(1:1000, byrow = TRUE, nr = 100)
297
-anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], which = "row")
300
+anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], which = "row", labels_rot = 30)
298 301
 Heatmap(m, cluster_rows = F, cluster_columns = F) + rowAnnotation(mark = anno)
299 302
 Heatmap(m) + rowAnnotation(mark = anno)
300 303