add labels_rot argument to anno_mark()

DESCRIPTION

@@ -2,7 +2,7 @@ Package: ComplexHeatmap
 Type: Package
 Title: Make Complex Heatmaps
 Version: 2.1.0
-Date: 2019-05-03
+Date: 2019-07-02
 Author: Zuguang Gu
 Maintainer: Zuguang Gu <[email protected]>
 Depends: R (>= 3.1.2), methods, grid, graphics, stats, grDevices

NEWS

@@ -2,6 +2,7 @@ CHANGES in VERSION 2.1.0
 
 * check the length of the clustering objects and the matrix rows/columns
 * `anno_oncoprint_barplot()`: add `ylim` argumnet
+* `anno_mark()`: add `labels_rot` argument
 
 ========================
 

R/AnnotationFunction-function.R

@@ -2704,6 +2704,7 @@ row_anno_text = function(...) {
 # -lines_gp Please use ``link_gp`` instead.
 # -link_gp Graphic settings for the segments.
 # -labels_gp Graphic settings for the labels.
+# -labels_rot Rotations of labels, scalar.
 # -padding Padding between neighbouring labels in the plot.
 # -link_width Width of the segments.
 # -link_height Similar as ``link_width``, used for column annotation.
@@ -2732,7 +2733,8 @@ row_anno_text = function(...) {
 # Heatmap(m) + rowAnnotation(mark = anno)
 anno_mark = function(at, labels, which = c("column", "row"), 
 	side = ifelse(which == "column", "top", "right"),
-	lines_gp = gpar(), labels_gp = gpar(), padding = 0.5, 
+	lines_gp = gpar(), labels_gp = gpar(), 
+	labels_rot = ifelse(which == "column", 90, 0), padding = 0.5, 
 	link_width = unit(5, "mm"), link_height = link_width,
 	link_gp = lines_gp, 
 	extend = unit(0, "mm")) {
@@ -2759,9 +2761,9 @@ anno_mark = function(at, labels, which = c("column", "row"),
 
 	if(which == "row") {
 		height = unit(1, "npc")
-		width = link_width + max_text_width(labels, gp = labels_gp)
+		width = link_width + max_text_width(labels, gp = labels_gp, rot = labels_rot)
 	} else {
-		height = link_width + max_text_width(labels, gp = labels_gp)
+		height = link_width + max_text_height(labels, gp = labels_gp, rot = labels_rot)
 		width = unit(1, "npc")
 	}
 
@@ -2801,13 +2803,13 @@ anno_mark = function(at, labels, which = c("column", "row"),
 
 		n2 = length(labels)
 		if(side == "right") {
-			grid.text(labels, rep(link_width, n2), h, default.units = "native", gp = labels_gp, just = "left")
+			grid.text(labels, rep(link_width, n2), h, default.units = "native", gp = labels_gp, rot = labels_rot, just = "left")
 			link_width = link_width - unit(1, "mm")
 			grid.segments(unit(rep(0, n2), "npc"), pos, rep(link_width*(1/3), n2), pos, default.units = "native", gp = link_gp)
 			grid.segments(rep(link_width*(1/3), n2), pos, rep(link_width*(2/3), n2), h, default.units = "native", gp = link_gp)
 			grid.segments(rep(link_width*(2/3), n2), h, rep(link_width, n2), h, default.units = "native", gp = link_gp)
 		} else {
-			grid.text(labels, unit(1, "npc")-rep(link_width, n2), h, default.units = "native", gp = labels_gp, just = "right")
+			grid.text(labels, unit(1, "npc")-rep(link_width, n2), h, default.units = "native", gp = labels_gp, rot = labels_rot, just = "right")
 			link_width = link_width - unit(1, "mm")
 			grid.segments(unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_width*(1/3), n2), pos, default.units = "native", gp = link_gp)
 			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"),
 
 		n2 = length(labels)
 		if(side == "top") {
-			grid.text(labels, h, rep(link_height, n2), default.units = "native", gp = labels_gp, rot = 90, just = "left")
+			grid.text(labels, h, rep(link_height, n2), default.units = "native", gp = labels_gp, rot = labels_rot, just = "left")
 			link_height = link_height - unit(1, "mm")
 			grid.segments(pos, unit(rep(0, n2), "npc"), pos, rep(link_height*(1/3), n2), default.units = "native", gp = link_gp)
 			grid.segments(pos, rep(link_height*(1/3), n2), h, rep(link_height*(2/3), n2), default.units = "native", gp = link_gp)
 			grid.segments(h, rep(link_height*(2/3), n2), h, rep(link_height, n), default.units = "native", gp = link_gp)
 		} else {
-			grid.text(labels, h, rep(max_text_width(labels, gp = labels_gp), n2), default.units = "native", gp = labels_gp, rot = 90, just = "right")
+			grid.text(labels, h, rep(max_text_width(labels, gp = labels_gp), n2), default.units = "native", gp = labels_gp, rot = labels_rot, just = "right")
 			link_height = link_height - unit(1, "mm")
 			grid.segments(pos, unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_height*(1/3), n2), default.units = "native", gp = link_gp)
 			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"),
 		width = width,
 		height = height,
 		n = -1,
-		var_import = list(at, labels2index, at2labels, link_gp, labels_gp, padding, .pos, .scale,
+		var_import = list(at, labels2index, at2labels, link_gp, labels_gp, labels_rot, padding, .pos, .scale,
 			side, link_width, link_height, extend),
 		show_name = FALSE
 	)

R/utils.R

@@ -341,6 +341,7 @@ list_components = function() {
 # == param
 # -text A vector of text.
 # -gp Graphic parameters for text.
+# -rot Rotation of the text, scalar.
 #
 # == details
 # It simply calculates maximum width of a list of `grid::textGrob` objects.
@@ -360,14 +361,14 @@ list_components = function() {
 # x = c("a", "bb", "ccc")
 # max_text_width(x, gp = gpar(fontsize = 10))
 #
-max_text_width = function(text, gp = gpar()) {
+max_text_width = function(text, gp = gpar(), rot = 0) {
     if(is.null(text)) {
         return(unit(0, "mm"))
     }
     n = length(text)
     gp = recycle_gp(gp, n)
 
-    u = max(do.call("unit.c", lapply(seq_len(n), function(i) grobWidth(textGrob(text[i], gp = subset_gp(gp, i))))))
+    u = max(do.call("unit.c", lapply(seq_len(n), function(i) grobWidth(textGrob(text[i], gp = subset_gp(gp, i), rot = rot)))))
     convertWidth(u, "mm")
 }
 
@@ -377,6 +378,7 @@ max_text_width = function(text, gp = gpar()) {
 # == param
 # -text A vector of text.
 # -gp Graphic parameters for text.
+# -rot Rotation of the text, scalar.
 #
 # == details
 # It simply calculates maximum height of a list of `grid::textGrob` objects.
@@ -396,14 +398,14 @@ max_text_width = function(text, gp = gpar()) {
 # x = c("a", "b\nb", "c\nc\nc")
 # max_text_height(x, gp = gpar(fontsize = 10))
 #
-max_text_height = function(text, gp = gpar()) {
+max_text_height = function(text, gp = gpar(), rot = 0) {
     if(is.null(text)) {
         return(unit(0, "mm"))
     }
     n = length(text)
     gp = recycle_gp(gp, n)
 
-    u = max(do.call("unit.c", lapply(seq_len(n), function(i) grobHeight(textGrob(text[i], gp = subset_gp(gp, i))))))
+    u = max(do.call("unit.c", lapply(seq_len(n), function(i) grobHeight(textGrob(text[i], gp = subset_gp(gp, i), rot = rot)))))
     convertHeight(u, "mm")
 }
 

logo.R

@@ -0,0 +1,91 @@
+
+
+logo = readLines(textConnection("
+oooooo                  oooooo  oo          oo  oo
+oooooo                  oooooo  oo          oo  oo
+oo      oooooo  oo  oo  oo  oo  oo  oooooo  oooooo
+oo      oooooo  oooooo  oo  oo  oo  oooooo  oooooo
+oo      oo  oo  oooooo  oooo    oo  oo  oo    oo
+oo      oo  oo  oooooo  oooo    oo  oo  oo    oo
+oooooo  oooooo  oo  oo  oo      oo  oooo    oo  oo
+oooooo  oooooo  oo  oo  oo      oo  oooo    oo  oo
+
+oo  oo                    oo                    oooooo
+oo  oo                    oo                    oooooo
+oo  oo  oooooo    oooo  oooooo  oo  oo  oooooo  oo  oo
+oo  oo  oooooo    oooo  oooooo  oooooo  oooooo  oo  oo
+oooooo  oo  oo  oo  oo    oo    oooooo  oo  oo  oooo
+oooooo  oo  oo  oo  oo    oo    oooooo  oo  oo  oooo
+oo  oo  oooo    oooooo    oo    oo  oo  oooo    oo
+oo  oo  oooo    oooooo    oo    oo  oo  oooo    oo
+"))
+
+logo = strsplit(logo, "")
+
+mat1 = matrix(0, nrow = 8, ncol = max(sapply(logo[2:9], length)))
+for(i in 2:9) {
+	mat1[i - 1, which(!grepl("^\\s*$", logo[[i]]))] = 1
+}
+mat1 = cbind(matrix(0, nrow = nrow(mat1), ncol = 2), mat1)
+
+mat2 = matrix(0, nrow = 8, ncol = max(sapply(logo[11:18], length)))
+for(i in 11:18) {
+	mat2[i - 10, which(!grepl("^\\s*$", logo[[i]]))] = 1
+}
+
+mat = cbind(mat1, matrix(0, nrow = nrow(mat1), ncol = 4), mat2)
+
+if(ncol(mat1) > ncol(mat2)) {
+	mat2 = cbind(mat2, matrix(0, nrow = nrow(mat2), ncol = ncol(mat1) - ncol(mat2)))
+} else {
+	mat1 = cbind(mat1, matrix(0, nrow = nrow(mat1), ncol = ncol(mat2) - ncol(mat1)))
+}
+
+mat = rbind(mat1, matrix(0, nrow = 2, ncol = ncol(mat1)), mat2)
+
+mat = rbind(matrix(0, nrow = 30, ncol = ncol(mat1)),
+	        mat,
+	        matrix(0, nrow = 30, ncol = ncol(mat1)))
+
+mat = cbind(matrix(0, nrow = nrow(mat), ncol = 10),
+	        mat,
+	        matrix(0, nrow = nrow(mat), ncol = 10))
+
+mat[nrow(mat) - 27, 9:(ncol(mat) - 8)] = 1
+mat[nrow(mat) - 26, 9:(ncol(mat) - 8)] = 1
+mat[28, 9:(ncol(mat) - 8)] = 1
+mat[27, 9:(ncol(mat) - 8)] = 1
+
+
+
+library(ComplexHeatmap)
+library(circlize)
+col_fun = function(x) {
+	n = length(x)
+	col = ifelse(x == 1, add_transparency("#4DAF4A", runif(n, min = 0, max = 0.3)),
+		                 rand_color(n, luminosity = "light", transparency = 0.8))
+}
+attr(col_fun, "breaks") = c(0, 1)
+ht = Heatmap(mat, name = "foo", rect_gp = gpar(col = "white", lwd = 0.5), cluster_rows = FALSE, cluster_columns = FALSE,
+	col = col_fun, show_heatmap_legend = FALSE)
+g = grid.grabExpr(draw(ht, padding = unit(c(0, 0, 0, 0), "mm")))
+
+grid.newpage()
+pushViewport(viewport(xscale = c(0, 2), yscale = c(0, 2), width = unit(0.9, "snpc"), height = unit(0.9, "snpc")))
+grid.polygon(cos(0:5 * pi/3 + pi/6)*1 + 1,
+     sin(0:5 * pi/3 + pi/6)*1 + 1, default.units = "native",
+     gp = gpar(col = "#4DAF4A", lwd = 6))
+height = 1
+pushViewport(viewport(x = 0.5, y = 0.5, height = height, width = height*ncol(mat)/nrow(mat)))
+grid.draw(g)
+popViewport()
+grid.polygon(cos(0:5 * pi/3 + pi/6)*1 + 1,
+     sin(0:5 * pi/3 + pi/6)*1 + 1, default.units = "native",
+     gp = gpar(col = "#4DAF4A", lwd = 8))
+popViewport()
+
+library(gridgeometry)
+A = g
+B = polygonGrid(cos(0:5 * pi/3 + pi/6)*1 + 1,
+     sin(0:5 * pi/3 + pi/6)*1 + 1, default.units = "native",
+     gp = gpar(col = "#4DAF4A", lwd = 8))

man/anno_mark.rd

@@ -9,7 +9,8 @@ Link annotation with labels
 \usage{
 anno_mark(at, labels, which = c("column", "row"),
     side = ifelse(which == "column", "top", "right"),
-    lines_gp = gpar(), labels_gp = gpar(), padding = 0.5,
+    lines_gp = gpar(), labels_gp = gpar(),
+    labels_rot = ifelse(which == "column", 90, 0), padding = 0.5,
     link_width = unit(5, "mm"), link_height = link_width,
     link_gp = lines_gp,
     extend = unit(0, "mm"))
@@ -23,6 +24,7 @@ anno_mark(at, labels, which = c("column", "row"),
   \item{lines_gp}{Please use \code{link_gp} instead.}
   \item{link_gp}{Graphic settings for the segments.}
   \item{labels_gp}{Graphic settings for the labels.}
+  \item{labels_rot}{Rotations of labels, scalar.}
   \item{padding}{Padding between neighbouring labels in the plot.}
   \item{link_width}{Width of the segments.}
   \item{link_height}{Similar as \code{link_width}, used for column annotation.}

man/max_text_height.rd

@@ -7,12 +7,13 @@ Maximum Height of Text
 Maximum Height of Text
 }
 \usage{
-max_text_height(text, gp = gpar())
+max_text_height(text, gp = gpar(), rot = 0)
 }
 \arguments{
 
   \item{text}{A vector of text.}
   \item{gp}{Graphic parameters for text.}
+  \item{rot}{Rotation of the text, scalar.}
 
 }
 \details{

man/max_text_width.rd

@@ -7,12 +7,13 @@ Maximum Width of Text
 Maximum Width of Text
 }
 \usage{
-max_text_width(text, gp = gpar())
+max_text_width(text, gp = gpar(), rot = 0)
 }
 \arguments{
 
   \item{text}{A vector of text.}
   \item{gp}{Graphic parameters for text.}
+  \item{rot}{Rotation of the text, scalar.}
 
 }
 \details{

tests_not_run/test-AnnotationFunction.R

@@ -293,8 +293,11 @@ draw(anno, test = "heatmap, colors")
 anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], which = "row")
 draw(anno, index = 1:100, test = "anno_mark")
 
+anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], labels_rot = 30, which = "row")
+draw(anno, index = 1:100, test = "anno_mark")
+
 m = matrix(1:1000, byrow = TRUE, nr = 100)
-anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], which = "row")
+anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], which = "row", labels_rot = 30)
 Heatmap(m, cluster_rows = F, cluster_columns = F) + rowAnnotation(mark = anno)
 Heatmap(m) + rowAnnotation(mark = anno)