... | ... |
@@ -1,8 +1,8 @@ |
1 | 1 |
Package: ComplexHeatmap |
2 | 2 |
Type: Package |
3 | 3 |
Title: Make Complex Heatmaps |
4 |
-Version: 1.99.3 |
|
5 |
-Date: 2018-11-28 |
|
4 |
+Version: 1.99.4 |
|
5 |
+Date: 2018-12-7 |
|
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 |
... | ... |
@@ -2676,6 +2676,9 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2676 | 2676 |
width = unit(1, "npc") |
2677 | 2677 |
} |
2678 | 2678 |
|
2679 |
+ .pos = NULL |
|
2680 |
+ .scale = NULL |
|
2681 |
+ |
|
2679 | 2682 |
# a map between row index and positions |
2680 | 2683 |
# pos_map = |
2681 | 2684 |
row_fun = function(index) { |
... | ... |
@@ -2690,27 +2693,35 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2690 | 2693 |
labels_gp = subset_gp(labels_gp, labels2index[labels]) |
2691 | 2694 |
link_gp = subset_gp(link_gp, labels2index[labels]) |
2692 | 2695 |
|
2693 |
- pushViewport(viewport(xscale = c(0, 1), yscale = c(0.5, n+0.5))) |
|
2696 |
+ if(is.null(.scale)) { |
|
2697 |
+ .scale = c(0.5, n+0.5) |
|
2698 |
+ } |
|
2699 |
+ pushViewport(viewport(xscale = c(0, 1), yscale = .scale)) |
|
2694 | 2700 |
if(inherits(extend, "unit")) extend = convertHeight(extend, "native", valueOnly = TRUE) |
2695 | 2701 |
text_height = convertHeight(grobHeight(textGrob(labels, gp = labels_gp))*(1+padding), "native", valueOnly = TRUE) |
2696 |
- i2 = rev(which(index %in% at)) |
|
2697 |
- h1 = n-i2+1 - text_height*0.5 |
|
2698 |
- h2 = n-i2+1 + text_height*0.5 |
|
2699 |
- pos = rev(smartAlign(h1, h2, c(0.5 - extend[1], n+0.5 + extend[2]))) |
|
2700 |
- h = (pos[, 1] + pos[, 2])/2 |
|
2702 |
+ if(is.null(.pos)) { |
|
2703 |
+ i2 = rev(which(index %in% at)) |
|
2704 |
+ pos = n-i2+1 # position of rows |
|
2705 |
+ } else { |
|
2706 |
+ pos = .pos[rev(which(index %in% at))] |
|
2707 |
+ } |
|
2708 |
+ h1 = pos - text_height*0.5 |
|
2709 |
+ h2 = pos + text_height*0.5 |
|
2710 |
+ pos_adjusted = rev(smartAlign(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2]))) |
|
2711 |
+ h = (pos_adjusted[, 1] + pos_adjusted[, 2])/2 |
|
2701 | 2712 |
|
2702 | 2713 |
n2 = length(labels) |
2703 | 2714 |
if(side == "right") { |
2704 | 2715 |
grid.text(labels, rep(link_width, n2), h, default.units = "native", gp = labels_gp, just = "left") |
2705 | 2716 |
link_width = link_width - unit(1, "mm") |
2706 |
- grid.segments(unit(rep(0, n2), "npc"), n-i2+1, rep(link_width*(1/3), n2), n-i2+1, default.units = "native", gp = link_gp) |
|
2707 |
- grid.segments(rep(link_width*(1/3), n2), n-i2+1, rep(link_width*(2/3), n2), h, default.units = "native", gp = link_gp) |
|
2717 |
+ grid.segments(unit(rep(0, n2), "npc"), pos, rep(link_width*(1/3), n2), pos, default.units = "native", gp = link_gp) |
|
2718 |
+ grid.segments(rep(link_width*(1/3), n2), pos, rep(link_width*(2/3), n2), h, default.units = "native", gp = link_gp) |
|
2708 | 2719 |
grid.segments(rep(link_width*(2/3), n2), h, rep(link_width, n2), h, default.units = "native", gp = link_gp) |
2709 | 2720 |
} else { |
2710 | 2721 |
grid.text(labels, unit(1, "npc")-rep(link_width, n2), h, default.units = "native", gp = labels_gp, just = "right") |
2711 | 2722 |
link_width = link_width - unit(1, "mm") |
2712 |
- grid.segments(unit(rep(1, n2), "npc"), n-i2+1, unit(1, "npc")-rep(link_width*(1/3), n2), n-i2+1, default.units = "native", gp = link_gp) |
|
2713 |
- grid.segments(unit(1, "npc")-rep(link_width*(1/3), n2), n-i2+1, unit(1, "npc")-rep(link_width*(2/3), n2), h, default.units = "native", gp = link_gp) |
|
2723 |
+ grid.segments(unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_width*(1/3), n2), pos, default.units = "native", gp = link_gp) |
|
2724 |
+ 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) |
|
2714 | 2725 |
grid.segments(unit(1, "npc")-rep(link_width*(2/3), n2), h, unit(1, "npc")-rep(link_width, n2), h, default.units = "native", gp = link_gp) |
2715 | 2726 |
} |
2716 | 2727 |
upViewport() |
... | ... |
@@ -2720,38 +2731,43 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2720 | 2731 |
|
2721 | 2732 |
# adjust at and labels |
2722 | 2733 |
at = intersect(index, at) |
2734 |
+ if(length(at) == 0) { |
|
2735 |
+ return(NULL) |
|
2736 |
+ } |
|
2723 | 2737 |
labels = at2labels[as.character(at)] |
2724 | 2738 |
|
2725 | 2739 |
labels_gp = subset_gp(labels_gp, labels2index[labels]) |
2726 |
- lines_gp = subset_gp(lines_gp, labels2index[labels]) |
|
2740 |
+ link_gp = subset_gp(link_gp, labels2index[labels]) |
|
2727 | 2741 |
|
2728 |
- pushViewport(viewport(yscale = c(0, 1), xscale = c(0.5, n+0.5))) |
|
2742 |
+ if(is.null(.scale)) { |
|
2743 |
+ .scale = c(0.5, n+0.5) |
|
2744 |
+ } |
|
2745 |
+ pushViewport(viewport(yscale = c(0, 1), xscale = .scale)) |
|
2729 | 2746 |
if(inherits(extend, "unit")) extend = convertWidth(extend, "native", valueOnly = TRUE) |
2730 | 2747 |
text_height = convertWidth(grobHeight(textGrob(labels, gp = labels_gp))*(1+padding), "native", valueOnly = TRUE) |
2731 |
- i2 = which(index %in% at) |
|
2732 |
- h1 = i2 - text_height*0.5 |
|
2733 |
- h2 = i2 + text_height*0.5 |
|
2734 |
- pos = smartAlign(h1, h2, c(0.5 - extend[1], n+0.5 + extend[2])) |
|
2735 |
- h = (pos[, 1] + pos[, 2])/2 |
|
2736 |
- if(is.null(link_width)) { |
|
2737 |
- if(convertHeight(unit(1, "npc") - max_text_width(labels, gp = labels_gp), "mm", valueOnly = TRUE) < 0) { |
|
2738 |
- link_width = unit(0.5, "npc") |
|
2739 |
- } else { |
|
2740 |
- link_width = unit(1, "npc") - max_text_width(labels, gp = labels_gp) |
|
2741 |
- } |
|
2748 |
+ if(is.null(.pos)) { |
|
2749 |
+ i2 = which(index %in% at) |
|
2750 |
+ pos = i2 # position of rows |
|
2751 |
+ } else { |
|
2752 |
+ pos = .pos[which(index %in% at)] |
|
2742 | 2753 |
} |
2754 |
+ h1 = pos - text_height*0.5 |
|
2755 |
+ h2 = pos + text_height*0.5 |
|
2756 |
+ pos_adjusted = smartAlign(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2])) |
|
2757 |
+ h = (pos_adjusted[, 1] + pos_adjusted[, 2])/2 |
|
2758 |
+ |
|
2743 | 2759 |
n2 = length(labels) |
2744 | 2760 |
if(side == "top") { |
2745 | 2761 |
grid.text(labels, h, rep(link_width, n2), default.units = "native", gp = labels_gp, rot = 90, just = "left") |
2746 | 2762 |
link_width = link_width - unit(1, "mm") |
2747 |
- grid.segments(i2, unit(rep(0, n2), "npc"), i2, rep(link_width*(1/3), n2), default.units = "native", gp = link_gp) |
|
2748 |
- grid.segments(i2, rep(link_width*(1/3), n2), h, rep(link_width*(2/3), n2), default.units = "native", gp = link_gp) |
|
2763 |
+ grid.segments(pos, unit(rep(0, n2), "npc"), pos, rep(link_width*(1/3), n2), default.units = "native", gp = link_gp) |
|
2764 |
+ grid.segments(pos, rep(link_width*(1/3), n2), h, rep(link_width*(2/3), n2), default.units = "native", gp = link_gp) |
|
2749 | 2765 |
grid.segments(h, rep(link_width*(2/3), n2), h, rep(link_width, n), default.units = "native", gp = link_gp) |
2750 | 2766 |
} else { |
2751 | 2767 |
grid.text(labels, h, rep(max_text_width(labels, gp = labels_gp), n2), default.units = "native", gp = labels_gp, rot = 90, just = "right") |
2752 | 2768 |
link_width = link_width - unit(1, "mm") |
2753 |
- grid.segments(i2, unit(rep(1, n2), "npc"), i2, unit(1, "npc")-rep(link_width*(1/3), n2), default.units = "native", gp = link_gp) |
|
2754 |
- grid.segments(i2, unit(1, "npc")-rep(link_width*(1/3), n2), h, unit(1, "npc")-rep(link_width*(2/3), n2), default.units = "native", gp = link_gp) |
|
2769 |
+ grid.segments(pos, unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_width*(1/3), n2), default.units = "native", gp = link_gp) |
|
2770 |
+ grid.segments(pos, unit(1, "npc")-rep(link_width*(1/3), n2), h, unit(1, "npc")-rep(link_width*(2/3), n2), default.units = "native", gp = link_gp) |
|
2755 | 2771 |
grid.segments(h, unit(1, "npc")-rep(link_width*(2/3), n2), h, unit(1, "npc")-rep(link_width, n2), default.units = "native", gp = link_gp) |
2756 | 2772 |
} |
2757 | 2773 |
upViewport() |
... | ... |
@@ -2770,7 +2786,7 @@ anno_mark = function(at, labels, which = c("column", "row"), |
2770 | 2786 |
width = width, |
2771 | 2787 |
height = height, |
2772 | 2788 |
n = -1, |
2773 |
- var_import = list(at, labels2index, at2labels, link_gp, labels_gp, padding, |
|
2789 |
+ var_import = list(at, labels2index, at2labels, link_gp, labels_gp, padding, .pos, .scale, |
|
2774 | 2790 |
side, link_width, extend), |
2775 | 2791 |
show_name = FALSE |
2776 | 2792 |
) |
... | ... |
@@ -602,6 +602,12 @@ Heatmap = function(matrix, col, name, |
602 | 602 |
if(is.character(row_order)) { |
603 | 603 |
row_order = structure(seq_len(nrow(matrix)), names = rownames(matrix))[row_order] |
604 | 604 |
} |
605 |
+ if(any(is.na(row_order))) { |
|
606 |
+ stop_wrap("`row_order` should not contain NA values.") |
|
607 |
+ } |
|
608 |
+ if(length(row_order) != nrow(matrix)) { |
|
609 |
+ stop_wrap("length of `row_order` should be same as the number of marix rows.") |
|
610 |
+ } |
|
605 | 611 |
.Object@row_order = row_order |
606 | 612 |
} |
607 | 613 |
.Object@row_dend_param$cluster_slices = cluster_row_slices |
... | ... |
@@ -647,6 +653,12 @@ Heatmap = function(matrix, col, name, |
647 | 653 |
if(is.character(column_order)) { |
648 | 654 |
column_order = structure(seq_len(ncol(matrix)), names = colnames(matrix))[column_order] |
649 | 655 |
} |
656 |
+ if(any(is.na(column_order))) { |
|
657 |
+ stop_wrap("`column_order` should not contain NA values.") |
|
658 |
+ } |
|
659 |
+ if(length(column_order) != ncol(matrix)) { |
|
660 |
+ stop_wrap("length of `column_order` should be same as the number of marix columns") |
|
661 |
+ } |
|
650 | 662 |
.Object@column_order = column_order |
651 | 663 |
} |
652 | 664 |
.Object@column_dend_param$cluster_slices = cluster_column_slices |
... | ... |
@@ -500,7 +500,73 @@ setMethod(f = "draw_annotation", |
500 | 500 |
n = length(object@row_order_list) |
501 | 501 |
} |
502 | 502 |
|
503 |
+ ## deal with the special anno_mark |
|
504 |
+ anno_mark_param = list() |
|
505 |
+ if(which %in% c("left", "right")) { |
|
506 |
+ slice_y = object@layout$slice$y |
|
507 |
+ n_slice = length(slice_y) |
|
508 |
+ slice_height = object@layout$slice$height |
|
509 |
+ |
|
510 |
+ if(n_slice > 1) { |
|
511 |
+ all_anno_type = anno_type(annotation) |
|
512 |
+ if("anno_mark" %in% all_anno_type) { |
|
513 |
+ ## only make the anno_mark annotation |
|
514 |
+ ro_lt = object@row_order_list |
|
515 |
+ # calcualte the position of each row with taking "gaps" into account |
|
516 |
+ .scale = c(0, 1) |
|
517 |
+ |
|
518 |
+ .pos = NULL |
|
519 |
+ for(i in seq_along(ro_lt)) { |
|
520 |
+ # assume slices are align to top `slice_just` contains "top" |
|
521 |
+ .pos1 = slice_y[i] - (seq_along(ro_lt[[i]]) - 0.5)/length(ro_lt[[i]]) * slice_height[i] |
|
522 |
+ .pos1 = convertY(.pos1, "native", valueOnly = TRUE) |
|
523 |
+ .pos = c(.pos, .pos1) |
|
524 |
+ } |
|
525 |
+ |
|
526 |
+ anno_mark_param$.scale = .scale |
|
527 |
+ anno_mark_param$.pos = .pos |
|
528 |
+ anno_mark_param$index = unlist(ro_lt) |
|
529 |
+ |
|
530 |
+ anno_mark_param$vp_height = convertHeight(unit(1, "npc"), "cm") |
|
531 |
+ anno_mark_param$vp_width = unit(1, "npc") |
|
532 |
+ anno_mark_param$vp_just = "top" |
|
533 |
+ anno_mark_param$vp_x = unit(0.5, "npc") |
|
534 |
+ anno_mark_param$vp_y = unit(1, "npc") |
|
535 |
+ } |
|
536 |
+ } |
|
537 |
+ } else { |
|
538 |
+ slice_x = object@layout$slice$x |
|
539 |
+ n_slice = length(slice_x) |
|
540 |
+ slice_width = object@layout$slice$width |
|
541 |
+ |
|
542 |
+ if(n_slice > 1) { |
|
543 |
+ all_anno_type = anno_type(annotation) |
|
544 |
+ if("anno_mark" %in% all_anno_type) { |
|
545 |
+ ## only make the anno_mark annotation |
|
546 |
+ co_lt = object@column_order_list |
|
547 |
+ .scale = c(0, 1) |
|
548 |
+ |
|
549 |
+ .pos = NULL |
|
550 |
+ for(i in seq_along(co_lt)) { |
|
551 |
+ .pos1 = slice_x[i] + (seq_along(co_lt[[i]]) - 0.5)/length(co_lt[[i]]) * slice_width[i] |
|
552 |
+ .pos1 = convertX(.pos1, "native", valueOnly = TRUE) |
|
553 |
+ .pos = c(.pos, .pos1) |
|
554 |
+ } |
|
555 |
+ |
|
556 |
+ anno_mark_param$.scale = .scale |
|
557 |
+ anno_mark_param$.pos = .pos |
|
558 |
+ anno_mark_param$index = unlist(co_lt) |
|
559 |
+ |
|
560 |
+ anno_mark_param$vp_height = unit(1, "npc") |
|
561 |
+ anno_mark_param$vp_width = convertWidth(unit(1, "npc"), "cm") |
|
562 |
+ anno_mark_param$vp_just = "left" |
|
563 |
+ anno_mark_param$vp_x = unit(0, "npc") |
|
564 |
+ anno_mark_param$vp_y = unit(0.5, "npc") |
|
565 |
+ } |
|
566 |
+ } |
|
567 |
+ } |
|
568 |
+ |
|
503 | 569 |
pushViewport(viewport(...)) |
504 |
- draw(annotation, index = index, k = k, n = n) |
|
570 |
+ draw(annotation, index = index, k = k, n = n, anno_mark_param = anno_mark_param) |
|
505 | 571 |
upViewport() |
506 | 572 |
}) |
... | ... |
@@ -553,6 +553,8 @@ setMethod(f = "get_legend_param_list", |
553 | 553 |
# -n Total number of slices. |
554 | 554 |
# -... Pass to `grid::viewport` which contains all the annotations. |
555 | 555 |
# -test Is it in test mode? The value can be logical or a text which is plotted as the title of plot. |
556 |
+# -anno_mark_param It contains specific parameters for drawing `anno_mark` and pass to the |
|
557 |
+# `draw,SingleAnnotation-method`. |
|
556 | 558 |
# |
557 | 559 |
# == value |
558 | 560 |
# No value is returned. |
... | ... |
@@ -563,7 +565,7 @@ setMethod(f = "get_legend_param_list", |
563 | 565 |
setMethod(f = "draw", |
564 | 566 |
signature = "HeatmapAnnotation", |
565 | 567 |
definition = function(object, index, k = 1, n = 1, ..., |
566 |
- test = FALSE) { |
|
568 |
+ test = FALSE, anno_mark_param = list()) { |
|
567 | 569 |
|
568 | 570 |
which = object@which |
569 | 571 |
n_anno = length(object@anno_list) |
... | ... |
@@ -609,21 +611,23 @@ setMethod(f = "draw", |
609 | 611 |
for(i in seq_len(n_anno)) { |
610 | 612 |
pushViewport(viewport(y = sum(anno_size[seq(i, n_anno)]) + sum(gap[seq(i, n_anno)]) - gap[n_anno], |
611 | 613 |
height = anno_size[i], just = c("center", "top"))) |
612 |
- oe = try(draw(object@anno_list[[i]], index, k, n)) |
|
613 |
- if(inherits(oe, "try-error")) { |
|
614 |
- cat("Error when drawing annotation '", object@anno_list[[i]]@name, "'\n", sep = "") |
|
615 |
- stop_wrap(oe) |
|
616 |
- } |
|
614 |
+ draw(object@anno_list[[i]], index, k, n, anno_mark_param = anno_mark_param) |
|
615 |
+ # oe = try(draw(object@anno_list[[i]], index, k, n)) |
|
616 |
+ # if(inherits(oe, "try-error")) { |
|
617 |
+ # cat("Error when drawing annotation '", object@anno_list[[i]]@name, "'\n", sep = "") |
|
618 |
+ # stop_wrap(oe) |
|
619 |
+ # } |
|
617 | 620 |
upViewport() |
618 | 621 |
} |
619 | 622 |
} else if(which == "row") { |
620 | 623 |
for(i in seq_len(n_anno)) { |
621 | 624 |
pushViewport(viewport(x = sum(anno_size[seq_len(i)]) + sum(gap[seq_len(i)]) - gap[i], width = anno_size[i], just = c("right", "center"))) |
622 |
- oe = try(draw(object@anno_list[[i]], index, k, n)) |
|
623 |
- if(inherits(oe, "try-error")) { |
|
624 |
- cat("Error when drawing annotation '", object@anno_list[[i]]@name, "'\n", sep = "") |
|
625 |
- stop_wrap(oe) |
|
626 |
- } |
|
625 |
+ draw(object@anno_list[[i]], index, k, n, anno_mark_param = anno_mark_param) |
|
626 |
+ # oe = try(draw(object@anno_list[[i]], index, k, n)) |
|
627 |
+ # if(inherits(oe, "try-error")) { |
|
628 |
+ # cat("Error when drawing annotation '", object@anno_list[[i]]@name, "'\n", sep = "") |
|
629 |
+ # stop_wrap(oe) |
|
630 |
+ # } |
|
627 | 631 |
upViewport() |
628 | 632 |
} |
629 | 633 |
} |
... | ... |
@@ -913,6 +917,10 @@ names.HeatmapAnnotation = function(x) { |
913 | 917 |
return(x) |
914 | 918 |
} |
915 | 919 |
|
920 |
+anno_type = function(ha) { |
|
921 |
+ sapply(ha@anno_list, function(x) x@fun@fun_name) |
|
922 |
+} |
|
923 |
+ |
|
916 | 924 |
|
917 | 925 |
# == title |
918 | 926 |
# Subset the HeatmapAnnotation object |
... | ... |
@@ -596,16 +596,47 @@ setMethod(f = "draw_heatmap_list", |
596 | 596 |
if(inherits(ht, "Heatmap")) { |
597 | 597 |
draw(ht, internal = TRUE) |
598 | 598 |
} else if(inherits(ht, "HeatmapAnnotation")) { |
599 |
+ # if the HeatmapAnnotation contains anno_mark() and it is split into more than one slices |
|
600 |
+ anno_mark_param = list() |
|
601 |
+ if(n_slice > 1) { |
|
602 |
+ all_anno_type = anno_type(ht) |
|
603 |
+ if("anno_mark" %in% all_anno_type) { |
|
604 |
+ ## only make the anno_mark annotation |
|
605 |
+ pushViewport(viewport(y = max_bottom_component_height, height = unit(1, "npc") - max_top_component_height - max_bottom_component_height, just = c("bottom"))) |
|
606 |
+ ro_lt = ht_main@row_order_list |
|
607 |
+ # calcualte the position of each row with taking "gaps" into account |
|
608 |
+ .scale = c(0, 1) |
|
609 |
+ |
|
610 |
+ .pos = NULL |
|
611 |
+ for(i in seq_along(ro_lt)) { |
|
612 |
+ # assume slices are align to top `slice_just` contains "top" |
|
613 |
+ .pos1 = slice_y[i] - (seq_along(ro_lt[[i]]) - 0.5)/length(ro_lt[[i]]) * slice_height[i] |
|
614 |
+ .pos1 = convertY(.pos1, "native", valueOnly = TRUE) |
|
615 |
+ .pos = c(.pos, .pos1) |
|
616 |
+ } |
|
617 |
+ |
|
618 |
+ anno_mark_param$.scale = .scale |
|
619 |
+ anno_mark_param$.pos = .pos |
|
620 |
+ anno_mark_param$index = unlist(ro_lt) |
|
621 |
+ |
|
622 |
+ anno_mark_param$vp_height = convertHeight(unit(1, "npc"), "cm") |
|
623 |
+ anno_mark_param$vp_width = unit(1, "npc") |
|
624 |
+ anno_mark_param$vp_just = "top" |
|
625 |
+ anno_mark_param$vp_x = unit(0.5, "npc") |
|
626 |
+ anno_mark_param$vp_y = unit(1, "npc") |
|
627 |
+ popViewport() |
|
628 |
+ } |
|
629 |
+ } |
|
630 |
+ |
|
599 | 631 |
# calcualte the position of the heatmap body |
600 | 632 |
pushViewport(viewport(y = max_bottom_component_height, height = unit(1, "npc") - max_top_component_height - max_bottom_component_height, just = c("bottom"))) |
601 | 633 |
for(j in seq_len(n_slice)) { |
602 |
- draw(ht, index = ht_main@row_order_list[[j]], y = slice_y[j], height = slice_height[j], just = slice_just[2], k = j, n = n_slice) |
|
634 |
+ draw(ht, index = ht_main@row_order_list[[j]], y = slice_y[j], height = slice_height[j], just = slice_just[2], k = j, n = n_slice, anno_mark_param = anno_mark_param) |
|
603 | 635 |
} |
604 | 636 |
upViewport() |
605 | 637 |
} |
606 | 638 |
upViewport() |
607 | 639 |
} |
608 |
- |
|
609 | 640 |
upViewport() |
610 | 641 |
} else { |
611 | 642 |
heatmap_height = object@layout$heatmap_height |
... | ... |
@@ -653,10 +684,41 @@ setMethod(f = "draw_heatmap_list", |
653 | 684 |
if(inherits(ht, "Heatmap")) { |
654 | 685 |
draw(ht, internal = TRUE) |
655 | 686 |
} else if(inherits(ht, "HeatmapAnnotation")) { |
687 |
+ # if the HeatmapAnnotation contains anno_mark() and it is split into more than one slices |
|
688 |
+ anno_mark_param = list() |
|
689 |
+ if(n_slice > 1) { |
|
690 |
+ all_anno_type = anno_type(ht) |
|
691 |
+ if("anno_mark" %in% all_anno_type) { |
|
692 |
+ ## only make the anno_mark annotation |
|
693 |
+ pushViewport(viewport(x = max_left_component_width, width = unit(1, "npc") - max_left_component_width - max_right_component_width, just = c("left"))) |
|
694 |
+ co_lt = ht_main@column_order_list |
|
695 |
+ .scale = c(0, 1) |
|
696 |
+ |
|
697 |
+ .pos = NULL |
|
698 |
+ for(i in seq_along(co_lt)) { |
|
699 |
+ # assume slices are align to left, `slice_just` contains "left" |
|
700 |
+ .pos1 = slice_x[i] + (seq_along(co_lt[[i]]) - 0.5)/length(co_lt[[i]]) * slice_width[i] |
|
701 |
+ .pos1 = convertX(.pos1, "native", valueOnly = TRUE) |
|
702 |
+ .pos = c(.pos, .pos1) |
|
703 |
+ } |
|
704 |
+ |
|
705 |
+ anno_mark_param$.scale = .scale |
|
706 |
+ anno_mark_param$.pos = .pos |
|
707 |
+ anno_mark_param$index = unlist(co_lt) |
|
708 |
+ |
|
709 |
+ anno_mark_param$vp_height = unit(1, "npc") |
|
710 |
+ anno_mark_param$vp_width = convertWidth(unit(1, "npc"), "cm") |
|
711 |
+ anno_mark_param$vp_just = "left" |
|
712 |
+ anno_mark_param$vp_x = unit(0, "npc") |
|
713 |
+ anno_mark_param$vp_y = unit(0.5, "npc") |
|
714 |
+ popViewport() |
|
715 |
+ } |
|
716 |
+ } |
|
717 |
+ |
|
656 | 718 |
# calcualte the position of the heatmap body |
657 | 719 |
pushViewport(viewport(x = max_left_component_width, width = unit(1, "npc") - max_left_component_width - max_right_component_width, just = c("left"))) |
658 | 720 |
for(j in seq_len(n_slice)) { |
659 |
- draw(ht, index = ht_main@column_order_list[[j]], x = slice_x[j], width = slice_width[j], just = slice_just[1], k = j, n = n_slice) |
|
721 |
+ draw(ht, index = ht_main@column_order_list[[j]], x = slice_x[j], width = slice_width[j], just = slice_just[1], k = j, n = n_slice, anno_mark_param = anno_mark_param) |
|
660 | 722 |
} |
661 | 723 |
upViewport() |
662 | 724 |
} |
... | ... |
@@ -226,6 +226,9 @@ setMethod(f = "make_layout", |
226 | 226 |
if(length(row_split) > 1 && length(row_split) != ht_nr) { |
227 | 227 |
stop_wrap("`row_split` should have same length as nrow of the main matrix.") |
228 | 228 |
} |
229 |
+ if(length(row_split) == 1 && !object@ht_list[[i_main]]@row_dend_param$cluster) { |
|
230 |
+ stop_wrap("Since there is no row clustering for the main heatmap, `row_split` is not allowed to set as a single number.") |
|
231 |
+ } |
|
229 | 232 |
} |
230 | 233 |
} |
231 | 234 |
if(!is.null(row_km)) { |
... | ... |
@@ -296,6 +299,12 @@ setMethod(f = "make_layout", |
296 | 299 |
if(verbose) qqcat("set row_dend_reorder to main heatmap\n") |
297 | 300 |
} |
298 | 301 |
if(!is.null(row_order)) { |
302 |
+ if(any(is.na(row_order))) { |
|
303 |
+ stop_wrap("`row_order` should not contain NA values.") |
|
304 |
+ } |
|
305 |
+ if(length(row_order) != nrow(object@ht_list[[i_main]]@matrix)) { |
|
306 |
+ stop_wrap("length of `row_order` should be same as the number of main marix rows.") |
|
307 |
+ } |
|
299 | 308 |
if(is.character(row_order)) { |
300 | 309 |
row_order = structure(seq_len(nrow(object@ht_list[[i_main]]@matrix)), names = rownames(object@ht_list[[i_main]]@matrix))[row_order] |
301 | 310 |
} |
... | ... |
@@ -345,6 +354,9 @@ setMethod(f = "make_layout", |
345 | 354 |
if(length(column_split) > 1 && length(column_split) != ht_nr) { |
346 | 355 |
stop_wrap("`column_split` should have same length as ncol of the main matrix.") |
347 | 356 |
} |
357 |
+ if(length(column_split) == 1 && !object@ht_list[[i_main]]@column_dend_param$cluster) { |
|
358 |
+ stop_wrap("Since there is no column clustering for the main heatmap, `column_split` is not allowed to set as a single number.") |
|
359 |
+ } |
|
348 | 360 |
} |
349 | 361 |
} |
350 | 362 |
if(!is.null(column_km)) { |
... | ... |
@@ -415,6 +427,12 @@ setMethod(f = "make_layout", |
415 | 427 |
if(verbose) qqcat("set column_dend_reorder to main heatmap\n") |
416 | 428 |
} |
417 | 429 |
if(!is.null(column_order)) { |
430 |
+ if(any(is.na(column_order))) { |
|
431 |
+ stop_wrap("`column_order` should not contain NA values.") |
|
432 |
+ } |
|
433 |
+ if(length(column_order) != ncol(object@ht_list[[i_main]]@matrix)) { |
|
434 |
+ stop_wrap("length of `column_order` should be same as the number of main marix columns.") |
|
435 |
+ } |
|
418 | 436 |
if(is.character(column_order)) { |
419 | 437 |
column_order = structure(seq_len(ncol(object@ht_list[[i_main]]@matrix)), names = colnames(object@ht_list[[i_main]]@matrix))[column_order] |
420 | 438 |
} |
... | ... |
@@ -529,6 +529,7 @@ SingleAnnotation = function(name, value, col, fun, |
529 | 529 |
# -n Total number of slices. ``k`` and ``n`` are used to adjust annotation names. E.g. |
530 | 530 |
# if ``k`` is 2 and ``n`` is 3, the annotation names are not drawn. |
531 | 531 |
# -test Is it in test mode? The value can be logical or a text which is plotted as the title of plot. |
532 |
+# -anno_mark_param It contains specific parameters for drawing `anno_mark`. |
|
532 | 533 |
# |
533 | 534 |
# == value |
534 | 535 |
# No value is returned. |
... | ... |
@@ -538,7 +539,23 @@ SingleAnnotation = function(name, value, col, fun, |
538 | 539 |
# |
539 | 540 |
setMethod(f = "draw", |
540 | 541 |
signature = "SingleAnnotation", |
541 |
- definition = function(object, index, k = 1, n = 1, test = FALSE) { |
|
542 |
+ definition = function(object, index, k = 1, n = 1, test = FALSE, |
|
543 |
+ anno_mark_param = list()) { |
|
544 |
+ |
|
545 |
+ ## make the special anno_mark when the anotation is split |
|
546 |
+ if(object@fun@fun_name == "anno_mark" && length(anno_mark_param) > 0) { |
|
547 |
+ if(k > 1) { |
|
548 |
+ return(invisible(NULL)) |
|
549 |
+ } else { |
|
550 |
+ ## change values for .pos and .scale for anno_mark |
|
551 |
+ object@fun@var_env$.pos = anno_mark_param$.pos |
|
552 |
+ object@fun@var_env$.scale = anno_mark_param$.scale |
|
553 |
+ pushViewport(viewport(x = anno_mark_param$vp_x, y = anno_mark_param$vp_y, width = anno_mark_param$vp_width, height = anno_mark_param$vp_height, just = anno_mark_param$vp_just)) |
|
554 |
+ draw(object@fun, index = anno_mark_param$index) |
|
555 |
+ upViewport() |
|
556 |
+ return(invisible(NULL)) |
|
557 |
+ } |
|
558 |
+ } |
|
542 | 559 |
|
543 | 560 |
if(is.character(test)) { |
544 | 561 |
test2 = TRUE |
... | ... |
@@ -8,7 +8,7 @@ Draw the Heatmap Annotations |
8 | 8 |
} |
9 | 9 |
\usage{ |
10 | 10 |
\S4method{draw}{HeatmapAnnotation}(object, index, k = 1, n = 1, ..., |
11 |
- test = FALSE) |
|
11 |
+ test = FALSE, anno_mark_param = list()) |
|
12 | 12 |
} |
13 | 13 |
\arguments{ |
14 | 14 |
|
... | ... |
@@ -18,6 +18,7 @@ Draw the Heatmap Annotations |
18 | 18 |
\item{n}{Total number of slices.} |
19 | 19 |
\item{...}{Pass to \code{\link[grid]{viewport}} which contains all the annotations.} |
20 | 20 |
\item{test}{Is it in test mode? The value can be logical or a text which is plotted as the title of plot.} |
21 |
+ \item{anno_mark_param}{It contains specific parameters for drawing \code{\link{anno_mark}} and pass to the \code{\link{draw,SingleAnnotation-method}}.} |
|
21 | 22 |
|
22 | 23 |
} |
23 | 24 |
\value{ |
... | ... |
@@ -7,7 +7,8 @@ Draw the Single Annotation |
7 | 7 |
Draw the Single Annotation |
8 | 8 |
} |
9 | 9 |
\usage{ |
10 |
-\S4method{draw}{SingleAnnotation}(object, index, k = 1, n = 1, test = FALSE) |
|
10 |
+\S4method{draw}{SingleAnnotation}(object, index, k = 1, n = 1, test = FALSE, |
|
11 |
+ anno_mark_param = list()) |
|
11 | 12 |
} |
12 | 13 |
\arguments{ |
13 | 14 |
|
... | ... |
@@ -16,6 +17,7 @@ Draw the Single Annotation |
16 | 17 |
\item{k}{The index of the slice.} |
17 | 18 |
\item{n}{Total number of slices. \code{k} and \code{n} are used to adjust annotation names. E.g. if \code{k} is 2 and \code{n} is 3, the annotation names are not drawn.} |
18 | 19 |
\item{test}{Is it in test mode? The value can be logical or a text which is plotted as the title of plot.} |
20 |
+ \item{anno_mark_param}{It contains specific parameters for drawing \code{\link{anno_mark}}.} |
|
19 | 21 |
|
20 | 22 |
} |
21 | 23 |
\value{ |
... | ... |
@@ -101,3 +101,43 @@ draw(ha, 1:10, test = TRUE) |
101 | 101 |
ha = rowAnnotation(fun = fun, width = unit(4, "cm")) |
102 | 102 |
draw(ha, 1:10, test = TRUE) |
103 | 103 |
|
104 |
+ |
|
105 |
+## test anno_mark |
|
106 |
+m = matrix(rnorm(1000), nrow = 100) |
|
107 |
+ha1 = rowAnnotation(foo = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10])) |
|
108 |
+Heatmap(m, name = "mat", cluster_rows = FALSE, right_annotation = ha1) |
|
109 |
+Heatmap(m, name = "mat", cluster_rows = FALSE) + ha1 |
|
110 |
+ |
|
111 |
+split = rep("a", 100); split[c(1:4, 20, 60, 98:100)] = "b" |
|
112 |
+Heatmap(m, name = "mat", cluster_rows = FALSE, right_annotation = ha1, row_split = split, gap = unit(1, "cm")) |
|
113 |
+Heatmap(m, name = "mat", cluster_rows = FALSE, row_split = split, gap = unit(1, "cm")) + ha1 |
|
114 |
+ |
|
115 |
+# ha has two annotations |
|
116 |
+ha2 = rowAnnotation(foo = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10]), bar = 1:100) |
|
117 |
+Heatmap(m, name = "mat", cluster_rows = FALSE, right_annotation = ha2) |
|
118 |
+Heatmap(m, name = "mat", cluster_rows = FALSE) + ha2 |
|
119 |
+ |
|
120 |
+Heatmap(m, name = "mat", cluster_rows = FALSE, right_annotation = ha2, row_split = split, gap = unit(1, "cm")) |
|
121 |
+Heatmap(m, name = "mat", cluster_rows = FALSE, row_split = split, gap = unit(1, "cm")) + ha2 |
|
122 |
+ |
|
123 |
+ |
|
124 |
+## test anno_mark as column annotation |
|
125 |
+m = matrix(rnorm(1000), ncol = 100) |
|
126 |
+ha1 = columnAnnotation(foo = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10])) |
|
127 |
+Heatmap(m, name = "mat", cluster_columns = FALSE, top_annotation = ha1) |
|
128 |
+ha1 %v% Heatmap(m, name = "mat", cluster_columns = FALSE) |
|
129 |
+ |
|
130 |
+split = rep("a", 100); split[c(1:4, 20, 60, 98:100)] = "b" |
|
131 |
+Heatmap(m, name = "mat", cluster_columns = FALSE, top_annotation = ha1, column_split = split, column_gap = unit(1, "cm")) |
|
132 |
+ha1 %v% Heatmap(m, name = "mat", cluster_columns = FALSE, column_split = split, gap = unit(1, "cm")) |
|
133 |
+ |
|
134 |
+# ha has two annotations |
|
135 |
+ha2 = HeatmapAnnotation(foo = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10]), bar = 1:100) |
|
136 |
+Heatmap(m, name = "mat", cluster_columns = FALSE, top_annotation = ha2) |
|
137 |
+ha2 %v% Heatmap(m, name = "mat", cluster_columns = FALSE) |
|
138 |
+ |
|
139 |
+Heatmap(m, name = "mat", cluster_columns = FALSE, top_annotation = ha2, column_split = split, column_gap = unit(1, "cm")) |
|
140 |
+ha2 %v% Heatmap(m, name = "mat", cluster_columns = FALSE, column_split = split, column_gap = unit(1, "cm")) |
|
141 |
+ |
|
142 |
+ |
|
143 |
+ |