... | ... |
@@ -2739,7 +2739,7 @@ row_anno_text = function(...) { |
2739 | 2739 |
anno_mark = function(at, labels, which = c("column", "row"), |
2740 | 2740 |
side = ifelse(which == "column", "top", "right"), |
2741 | 2741 |
lines_gp = gpar(), labels_gp = gpar(), |
2742 |
- labels_rot = ifelse(which == "column", 90, 0), padding = 0.5, |
|
2742 |
+ labels_rot = ifelse(which == "column", 90, 0), padding = unit(1, "mm"), |
|
2743 | 2743 |
link_width = unit(5, "mm"), link_height = link_width, |
2744 | 2744 |
link_gp = lines_gp, |
2745 | 2745 |
extend = unit(0, "mm")) { |
... | ... |
@@ -2775,6 +2775,8 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2775 | 2775 |
.pos = NULL |
2776 | 2776 |
.scale = NULL |
2777 | 2777 |
|
2778 |
+ labels_rot = labels_rot %% 360 |
|
2779 |
+ |
|
2778 | 2780 |
# a map between row index and positions |
2779 | 2781 |
# pos_map = |
2780 | 2782 |
row_fun = function(index) { |
... | ... |
@@ -2794,7 +2796,11 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2794 | 2796 |
} |
2795 | 2797 |
pushViewport(viewport(xscale = c(0, 1), yscale = .scale)) |
2796 | 2798 |
if(inherits(extend, "unit")) extend = convertHeight(extend, "native", valueOnly = TRUE) |
2797 |
- text_height = convertHeight(grobHeight(textGrob(labels, gp = labels_gp))*(1+padding), "native", valueOnly = TRUE) |
|
2799 |
+ if(labels_rot %in% c(90, 270)) { |
|
2800 |
+ text_height = convertHeight(text_width(labels, gp = labels_gp) + padding, "native", valueOnly = TRUE) |
|
2801 |
+ } else { |
|
2802 |
+ text_height = convertHeight(text_height(labels, gp = labels_gp) + padding, "native", valueOnly = TRUE) |
|
2803 |
+ } |
|
2798 | 2804 |
if(is.null(.pos)) { |
2799 | 2805 |
i2 = rev(which(index %in% at)) |
2800 | 2806 |
pos = n-i2+1 # position of rows |
... | ... |
@@ -2808,13 +2814,34 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2808 | 2814 |
|
2809 | 2815 |
n2 = length(labels) |
2810 | 2816 |
if(side == "right") { |
2811 |
- grid.text(labels, rep(link_width, n2), h, default.units = "native", gp = labels_gp, rot = labels_rot, just = "left") |
|
2817 |
+ if(labels_rot == 90) { |
|
2818 |
+ just = c("center", "top") |
|
2819 |
+ } else if(labels_rot == 270) { |
|
2820 |
+ just = c("center", "bottom") |
|
2821 |
+ } else if(labels_rot > 90 & labels_rot < 270 ) { |
|
2822 |
+ just = c("right", "center") |
|
2823 |
+ } else { |
|
2824 |
+ just = c("left", "center") |
|
2825 |
+ } |
|
2826 |
+ } else { |
|
2827 |
+ if(labels_rot == 90) { |
|
2828 |
+ just = c("center", "bottom") |
|
2829 |
+ } else if(labels_rot == 270) { |
|
2830 |
+ just = c("center", "top") |
|
2831 |
+ } else if(labels_rot > 90 & labels_rot < 270 ) { |
|
2832 |
+ just = c("left", "center") |
|
2833 |
+ } else { |
|
2834 |
+ just = c("right", "center") |
|
2835 |
+ } |
|
2836 |
+ } |
|
2837 |
+ if(side == "right") { |
|
2838 |
+ grid.text(labels, rep(link_width, n2), h, default.units = "native", gp = labels_gp, rot = labels_rot, just = just) |
|
2812 | 2839 |
link_width = link_width - unit(1, "mm") |
2813 | 2840 |
grid.segments(unit(rep(0, n2), "npc"), pos, rep(link_width*(1/3), n2), pos, default.units = "native", gp = link_gp) |
2814 | 2841 |
grid.segments(rep(link_width*(1/3), n2), pos, rep(link_width*(2/3), n2), h, default.units = "native", gp = link_gp) |
2815 | 2842 |
grid.segments(rep(link_width*(2/3), n2), h, rep(link_width, n2), h, default.units = "native", gp = link_gp) |
2816 | 2843 |
} else { |
2817 |
- grid.text(labels, unit(1, "npc")-rep(link_width, n2), h, default.units = "native", gp = labels_gp, rot = labels_rot, just = "right") |
|
2844 |
+ grid.text(labels, unit(1, "npc")-rep(link_width, n2), h, default.units = "native", gp = labels_gp, rot = labels_rot, just = just) |
|
2818 | 2845 |
link_width = link_width - unit(1, "mm") |
2819 | 2846 |
grid.segments(unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_width*(1/3), n2), pos, default.units = "native", gp = link_gp) |
2820 | 2847 |
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) |
... | ... |
@@ -2824,7 +2851,6 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2824 | 2851 |
} |
2825 | 2852 |
column_fun = function(index) { |
2826 | 2853 |
n = length(index) |
2827 |
- |
|
2828 | 2854 |
# adjust at and labels |
2829 | 2855 |
at = intersect(index, at) |
2830 | 2856 |
if(length(at) == 0) { |
... | ... |
@@ -2840,7 +2866,11 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2840 | 2866 |
} |
2841 | 2867 |
pushViewport(viewport(yscale = c(0, 1), xscale = .scale)) |
2842 | 2868 |
if(inherits(extend, "unit")) extend = convertWidth(extend, "native", valueOnly = TRUE) |
2843 |
- text_height = convertWidth(grobHeight(textGrob(labels, gp = labels_gp))*(1+padding), "native", valueOnly = TRUE) |
|
2869 |
+ if(labels_rot %in% c(0, 180)) { |
|
2870 |
+ text_height = convertWidth(text_width(labels, gp = labels_gp) + padding, "native", valueOnly = TRUE) |
|
2871 |
+ } else { |
|
2872 |
+ text_height = convertWidth(text_height(labels, gp = labels_gp) + padding, "native", valueOnly = TRUE) |
|
2873 |
+ } |
|
2844 | 2874 |
if(is.null(.pos)) { |
2845 | 2875 |
i2 = which(index %in% at) |
2846 | 2876 |
pos = i2 # position of rows |
... | ... |
@@ -2854,13 +2884,34 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2854 | 2884 |
|
2855 | 2885 |
n2 = length(labels) |
2856 | 2886 |
if(side == "top") { |
2857 |
- grid.text(labels, h, rep(link_height, n2), default.units = "native", gp = labels_gp, rot = labels_rot, just = "left") |
|
2887 |
+ if(labels_rot == 0) { |
|
2888 |
+ just = c("center", "bottom") |
|
2889 |
+ } else if(labels_rot == 180) { |
|
2890 |
+ just = c("center", "top") |
|
2891 |
+ } else if(labels_rot > 0 & labels_rot < 180 ) { |
|
2892 |
+ just = c("left", "center") |
|
2893 |
+ } else { |
|
2894 |
+ just = c("right", "center") |
|
2895 |
+ } |
|
2896 |
+ } else { |
|
2897 |
+ if(labels_rot == 0) { |
|
2898 |
+ just = c("center", "top") |
|
2899 |
+ } else if(labels_rot == 180) { |
|
2900 |
+ just = c("center", "bottom") |
|
2901 |
+ } else if(labels_rot > 0 & labels_rot < 180 ) { |
|
2902 |
+ just = c("right", "center") |
|
2903 |
+ } else { |
|
2904 |
+ just = c("left", "center") |
|
2905 |
+ } |
|
2906 |
+ } |
|
2907 |
+ if(side == "top") { |
|
2908 |
+ grid.text(labels, h, rep(link_height, n2), default.units = "native", gp = labels_gp, rot = labels_rot, just = just) |
|
2858 | 2909 |
link_height = link_height - unit(1, "mm") |
2859 | 2910 |
grid.segments(pos, unit(rep(0, n2), "npc"), pos, rep(link_height*(1/3), n2), default.units = "native", gp = link_gp) |
2860 | 2911 |
grid.segments(pos, rep(link_height*(1/3), n2), h, rep(link_height*(2/3), n2), default.units = "native", gp = link_gp) |
2861 | 2912 |
grid.segments(h, rep(link_height*(2/3), n2), h, rep(link_height, n), default.units = "native", gp = link_gp) |
2862 | 2913 |
} else { |
2863 |
- grid.text(labels, h, unit(1, "npc")-rep(link_height, n2), default.units = "native", gp = labels_gp, rot = labels_rot, just = "right") |
|
2914 |
+ grid.text(labels, h, unit(1, "npc")-rep(link_height, n2), default.units = "native", gp = labels_gp, rot = labels_rot, just = just) |
|
2864 | 2915 |
link_height = link_height - unit(1, "mm") |
2865 | 2916 |
grid.segments(pos, unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_height*(1/3), n2), default.units = "native", gp = link_gp) |
2866 | 2917 |
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) |
... | ... |
@@ -409,6 +409,42 @@ max_text_height = function(text, gp = gpar(), rot = 0) { |
409 | 409 |
convertHeight(u, "mm") |
410 | 410 |
} |
411 | 411 |
|
412 |
+text_width = function(text, gp = gpar()) { |
|
413 |
+ if(is.null(text)) { |
|
414 |
+ return(unit(0, "mm")) |
|
415 |
+ } |
|
416 |
+ n = length(text) |
|
417 |
+ gp = recycle_gp(gp, n) |
|
418 |
+ |
|
419 |
+ u = do.call("unit.c", lapply(seq_len(n), function(i) grobWidth(textGrob(text[i], gp = subset_gp(gp, i))))) |
|
420 |
+ convertWidth(u, "mm") |
|
421 |
+} |
|
422 |
+ |
|
423 |
+grid.text = function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"), |
|
424 |
+ just = "centre", hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, |
|
425 |
+ default.units = "npc", name = NULL, gp = gpar(), draw = TRUE, |
|
426 |
+ vp = NULL) { |
|
427 |
+ tg <- textGrob(label = label, x = x, y = y, just = just, |
|
428 |
+ hjust = hjust, vjust = vjust, rot = rot, check.overlap = check.overlap, |
|
429 |
+ default.units = default.units, name = name, gp = gp, |
|
430 |
+ vp = vp) |
|
431 |
+ tw = text_width(label) |
|
432 |
+ th = text_height(label) |
|
433 |
+ grid.draw(tg) |
|
434 |
+ if(identical(just, "")) |
|
435 |
+} |
|
436 |
+ |
|
437 |
+text_height = function(text, gp = gpar()) { |
|
438 |
+ if(is.null(text)) { |
|
439 |
+ return(unit(0, "mm")) |
|
440 |
+ } |
|
441 |
+ n = length(text) |
|
442 |
+ gp = recycle_gp(gp, n) |
|
443 |
+ |
|
444 |
+ u = do.call("unit.c", lapply(seq_len(n), function(i) grobHeight(textGrob(text[i], gp = subset_gp(gp, i))))) |
|
445 |
+ convertHeight(u, "mm") |
|
446 |
+} |
|
447 |
+ |
|
412 | 448 |
dev.null = function(...) { |
413 | 449 |
pdf(file = NULL, ...) |
414 | 450 |
} |
... | ... |
@@ -304,18 +304,28 @@ Heatmap(m) + rowAnnotation(mark = anno) |
304 | 304 |
ht_list = Heatmap(m, cluster_rows = F, cluster_columns = F) + rowAnnotation(mark = anno) |
305 | 305 |
draw(ht_list, row_split = c(rep("a", 95), rep("b", 5))) |
306 | 306 |
|
307 |
-pl = list() |
|
307 |
+ |
|
308 |
+grid.newpage() |
|
309 |
+pushViewport(viewport(layout = grid.layout(nrow = 12, ncol = 1))) |
|
308 | 310 |
for(rot in seq(0, 360, by = 30)[-13]) { |
309 |
- anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = letters[1:10], labels_rot = rot, which = "column") |
|
310 |
- pl[[as.character(rot)]] = grid.grabExpr(draw(anno, index = 1:100, test = qq("labels_rot = @{rot}"))) |
|
311 |
+ anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = strrep(letters[1:10], 4), labels_rot = rot, which = "column", side = "bottom") |
|
312 |
+ pushViewport(viewport(layout.pos.col = 1, layout.pos.row = rot/30 + 1)) |
|
313 |
+ grid.rect() |
|
314 |
+ draw(anno, index = 1:100) |
|
315 |
+ popViewport() |
|
311 | 316 |
} |
312 |
-pushViewport(viewport(layout = grid.layout(nrow = 12, ncol = 1))) |
|
313 |
-for(i in seq_along(pl)) { |
|
314 |
- pushViewport(viewport(layout.pos.row = i, layout.pos.col = 1)) |
|
315 |
- grid.draw(pl[[i]]) |
|
317 |
+ |
|
318 |
+ |
|
319 |
+grid.newpage() |
|
320 |
+pushViewport(viewport(layout = grid.layout(nrow = 1, ncol = 12))) |
|
321 |
+for(rot in seq(0, 360, by = 30)[-13]) { |
|
322 |
+ anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = strrep(letters[1:10], 4), labels_rot = rot, which = "row", side = "right") |
|
323 |
+ pushViewport(viewport(layout.pos.row = 1, layout.pos.col = rot/30 + 1)) |
|
324 |
+ grid.rect() |
|
325 |
+ draw(anno, index = 1:100) |
|
316 | 326 |
popViewport() |
317 | 327 |
} |
318 |
-popViewport() |
|
328 |
+ |
|
319 | 329 |
|
320 | 330 |
|
321 | 331 |
### graphic parameters after reordering |