... | ... |
@@ -2653,7 +2653,9 @@ row_anno_link = function(...) { |
2653 | 2653 |
anno_link(..., which = "row") |
2654 | 2654 |
} |
2655 | 2655 |
|
2656 |
-anno_summarize = function(which = c("column", "row"), |
|
2656 |
+# only allow for one-column/one-row heamtap |
|
2657 |
+# discrete: barplot; continuous: boxplot (maybe also barplot, e.g. pct overlap) |
|
2658 |
+anno_summary = function(which = c("column", "row"), bar_width = 0.8, |
|
2657 | 2659 |
width = NULL, height = NULL, border = FALSE, ...) { |
2658 | 2660 |
|
2659 | 2661 |
if(is.null(.ENV$current_annotation_which)) { |
... | ... |
@@ -2662,15 +2664,53 @@ anno_summarize = function(which = c("column", "row"), |
2662 | 2664 |
which = .ENV$current_annotation_which |
2663 | 2665 |
} |
2664 | 2666 |
|
2665 |
- if(which == "column") { |
|
2666 |
- stop_wrap("`anno_summarize()` is only allowed as a column annotation.") |
|
2667 |
- } |
|
2668 |
- |
|
2669 | 2667 |
anno_size = anno_width_and_height(which, width, height, unit(2, "cm")) |
2670 | 2668 |
|
2671 | 2669 |
# get variables fron oncoPrint() function |
2672 | 2670 |
pf = parent.frame() |
2673 | 2671 |
# find where the heatmap object is. |
2672 |
+ row_fun = function(index) { |
|
2673 |
+ |
|
2674 |
+ } |
|
2675 |
+ column_fun = function(index) { |
|
2676 |
+ ht = get("object", envir = parent.frame(7)) |
|
2677 |
+ mat = ht@matrix |
|
2678 |
+ cm = ht@matrix_color_mapping |
|
2679 |
+ order_list = ht@row_order_list |
|
2680 |
+ ng = length(order_list) |
|
2681 |
+ |
|
2682 |
+ if(cm@type == "discrete") { |
|
2683 |
+ tl = lapply(order_list, function(od) table(mat[od, 1])) |
|
2684 |
+ tl = lapply(tl, function(x) x/sum(x)) |
|
2685 |
+ pushViewport(viewport(xscale = c(0.5, ng+0.5), yscale = c(0, 1))) |
|
2686 |
+ for(i in 1:ng) { |
|
2687 |
+ x = i |
|
2688 |
+ y = cumsum(tl[[i]]) |
|
2689 |
+ grid.rect(x, y, w = bar_width, just = "top", gp = gpar(fill = map_to_colors(cm, names(y)))) |
|
2690 |
+ } |
|
2691 |
+ # axis |
|
2692 |
+ popViewport() |
|
2693 |
+ } |
|
2694 |
+ |
|
2695 |
+ } |
|
2696 |
+ |
|
2697 |
+ if(which == "row") { |
|
2698 |
+ fun = row_fun |
|
2699 |
+ } else if(which == "column") { |
|
2700 |
+ fun = column_fun |
|
2701 |
+ } |
|
2674 | 2702 |
|
2703 |
+ anno = AnnotationFunction( |
|
2704 |
+ fun = fun, |
|
2705 |
+ fun_name = "anno_summary", |
|
2706 |
+ which = which, |
|
2707 |
+ width = width, |
|
2708 |
+ height = height, |
|
2709 |
+ n = 1, |
|
2710 |
+ show_name = FALSE |
|
2711 |
+ ) |
|
2712 |
+ |
|
2713 |
+ anno@subsetable = FALSE |
|
2714 |
+ return(anno) |
|
2675 | 2715 |
} |
2676 | 2716 |
|
... | ... |
@@ -1244,6 +1244,9 @@ make_cluster = function(object, which = c("row", "column")) { |
1244 | 1244 |
} else { |
1245 | 1245 |
slice_mean = sapply(order_list, function(ind) rowMeans(mat[, ind, drop = FALSE])) |
1246 | 1246 |
} |
1247 |
+ if(!is.matrix(slice_mean)) { |
|
1248 |
+ slice_mean = matrix(slice_mean, nrow = 1) |
|
1249 |
+ } |
|
1247 | 1250 |
dend_slice = as.dendrogram(hclust(dist(t(slice_mean)))) |
1248 | 1251 |
if(verbose) qqcat("perform clustering on mean of @{which} slices\n") |
1249 | 1252 |
} |
... | ... |
@@ -370,9 +370,9 @@ setMethod(f = "draw_title", |
370 | 370 |
grid.rect(gp = gpar(fill = gp$fill)) |
371 | 371 |
} |
372 | 372 |
if(side == "left") { |
373 |
- grid.text(title, x = unit(1, "npc") - TITLE_PADDING, rot = rot, just = just, gp = gp) |
|
373 |
+ grid.text(title, x = unit(1, "npc") - ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp) |
|
374 | 374 |
} else { |
375 |
- grid.text(title, x = TITLE_PADDING, rot = rot, just = just, gp = gp) |
|
375 |
+ grid.text(title, x = ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp) |
|
376 | 376 |
} |
377 | 377 |
upViewport() |
378 | 378 |
} else { |
... | ... |
@@ -381,9 +381,9 @@ setMethod(f = "draw_title", |
381 | 381 |
grid.rect(gp = gpar(fill = gp$fill)) |
382 | 382 |
} |
383 | 383 |
if(side == "top") { |
384 |
- grid.text(title, y = TITLE_PADDING, rot = rot, just = just, gp = gp) |
|
384 |
+ grid.text(title, y = ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp) |
|
385 | 385 |
} else { |
386 |
- grid.text(title, y = unit(1, "npc") - TITLE_PADDING, rot = rot, just = just, gp = gp) |
|
386 |
+ grid.text(title, y = unit(1, "npc") - ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp) |
|
387 | 387 |
} |
388 | 388 |
upViewport() |
389 | 389 |
} |
... | ... |
@@ -308,7 +308,7 @@ setMethod(f = "draw", |
308 | 308 |
ht_gap = gap, |
309 | 309 |
|
310 | 310 |
main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1], |
311 |
- padding = NULL, |
|
311 |
+ padding = GLOBAL_PADDING, |
|
312 | 312 |
adjust_annotation_extension = TRUE, |
313 | 313 |
|
314 | 314 |
auto_adjust = TRUE, |
... | ... |
@@ -479,12 +479,6 @@ setMethod(f = "draw", |
479 | 479 |
heatmap_body_width = heatmap_body_width |
480 | 480 |
) |
481 | 481 |
|
482 |
- # calculate proper padding |
|
483 |
- if(is.null(padding)) { |
|
484 |
- padding = GLOBAL_PADDING |
|
485 |
- object@ht_list_param$padding = padding |
|
486 |
- } |
|
487 |
- |
|
488 | 482 |
layout = grid.layout(nrow = length(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT), |
489 | 483 |
ncol = length(HEATMAP_LAYOUT_ROW_COMPONENT), |
490 | 484 |
widths = component_width(object), |
... | ... |
@@ -84,7 +84,7 @@ setMethod(f = "make_layout", |
84 | 84 |
ht_gap = unit(2, "mm"), |
85 | 85 |
|
86 | 86 |
main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1], |
87 |
- padding = NULL, |
|
87 |
+ padding = GLOBAL_PADDING, |
|
88 | 88 |
|
89 | 89 |
auto_adjust = TRUE, |
90 | 90 |
row_dend_side = c("original", "left", "right"), |
... | ... |
@@ -125,6 +125,20 @@ setMethod(f = "make_layout", |
125 | 125 |
return(object) |
126 | 126 |
} |
127 | 127 |
|
128 |
+ # the size of the plotting page |
|
129 |
+ # if current viewport is top viewport |
|
130 |
+ current_vp = current.viewport()$name |
|
131 |
+ if(current_vp == "ROOT") { |
|
132 |
+ object@layout$page_size = unit(dev.size("cm"), "cm") |
|
133 |
+ } else { |
|
134 |
+ grid::upViewport() |
|
135 |
+ object@layout$page_size = unit.c(convertWidth(unit(1, "npc"), "mm"), |
|
136 |
+ convertHeight(unit(1, "npc"), "mm")) |
|
137 |
+ grid::downViewport() |
|
138 |
+ |
|
139 |
+ } |
|
140 |
+ object@ht_list_param$padding = padding |
|
141 |
+ |
|
128 | 142 |
n_ht = length(object@ht_list) |
129 | 143 |
i_main = main_heatmap[1] |
130 | 144 |
direction = object@direction |
... | ... |
@@ -634,10 +648,10 @@ setMethod(f = "make_layout", |
634 | 648 |
object@column_title_param$side = column_title_side |
635 | 649 |
if(length(column_title) > 0) { |
636 | 650 |
if(column_title_side == "top") { |
637 |
- object@layout$layout_column_title_top_height = grobHeight(textGrob(column_title, gp = column_title_gp)) + TITLE_PADDING*2 |
|
651 |
+ object@layout$layout_column_title_top_height = grobHeight(textGrob(column_title, gp = column_title_gp)) + ht_opt$TITLE_PADDING*2 |
|
638 | 652 |
object@layout$layout_index = rbind(object@layout$layout_index, column_title_top = heatmap_list_layout_index("column_title_top")) |
639 | 653 |
} else { |
640 |
- object@layout$layout_column_title_bottom_height = grobHeight(textGrob(column_title, gp = column_title_gp)) + TITLE_PADDING*2 |
|
654 |
+ object@layout$layout_column_title_bottom_height = grobHeight(textGrob(column_title, gp = column_title_gp)) + ht_opt$TITLE_PADDING*2 |
|
641 | 655 |
object@layout$layout_index = rbind(object@layout$layout_index, column_title_bottom = heatmap_list_layout_index("column_title_bottom")) |
642 | 656 |
} |
643 | 657 |
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_title(object, which = "column")) |
... | ... |
@@ -660,10 +674,10 @@ setMethod(f = "make_layout", |
660 | 674 |
object@row_title_param$side = row_title_side |
661 | 675 |
if(length(row_title) > 0) { |
662 | 676 |
if(row_title_side == "left") { |
663 |
- object@layout$layout_row_title_left_width = grobHeight(textGrob(row_title, gp = row_title_gp)) + TITLE_PADDING*2 |
|
677 |
+ object@layout$layout_row_title_left_width = grobHeight(textGrob(row_title, gp = row_title_gp)) + ht_opt$TITLE_PADDING*2 |
|
664 | 678 |
object@layout$layout_index = rbind(object@layout$layout_index, row_title_left = heatmap_list_layout_index("row_title_left")) |
665 | 679 |
} else { |
666 |
- object@layout$layout_row_title_right_width = grobHeight(textGrob(row_title, gp = row_title_gp)) + TITLE_PADDING*2 |
|
680 |
+ object@layout$layout_row_title_right_width = grobHeight(textGrob(row_title, gp = row_title_gp)) + ht_opt$TITLE_PADDING*2 |
|
667 | 681 |
object@layout$layout_index = rbind(object@layout$layout_index, row_title_right = heatmap_list_layout_index("row_title_right")) |
668 | 682 |
} |
669 | 683 |
object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_title(object, which = "row")) |
... | ... |
@@ -717,7 +731,10 @@ setMethod(f = "make_layout", |
717 | 731 |
} |
718 | 732 |
} |
719 | 733 |
} |
720 |
- if(length(ColorMappingList) == 0 && length(heatmap_legend_list) == 0) { |
|
734 |
+ if(merge_legends) { |
|
735 |
+ heatmap_legend_list = c(heatmap_legend_list, annotation_legend_list) |
|
736 |
+ } |
|
737 |
+ if(length(ColorMappingList) == 0 && length(heatmap_legend_list) == 0) { |
|
721 | 738 |
show_heatmap_legend = FALSE |
722 | 739 |
} |
723 | 740 |
|
... | ... |
@@ -738,30 +755,34 @@ setMethod(f = "make_layout", |
738 | 755 |
if(show_heatmap_legend) { |
739 | 756 |
if(heatmap_legend_side == "top") { |
740 | 757 |
object@heatmap_legend_param$padding = unit(c(2, 0, 0, 0), "mm") |
741 |
- size = heatmap_legend_size(object, legend_list = heatmap_legend_list) |
|
758 |
+ size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object)) |
|
742 | 759 |
object@heatmap_legend_param$size = size |
743 | 760 |
object@layout$layout_heatmap_legend_top_height = size[2] |
744 | 761 |
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_top = heatmap_list_layout_index("heatmap_legend_top")) |
745 | 762 |
} else if(heatmap_legend_side == "bottom") { |
746 | 763 |
object@heatmap_legend_param$padding = unit(c(0, 0, 2, 0), "mm") |
747 |
- size = heatmap_legend_size(object, legend_list = heatmap_legend_list) |
|
764 |
+ size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object)) |
|
748 | 765 |
object@heatmap_legend_param$size = size |
749 | 766 |
object@layout$layout_heatmap_legend_bottom_height = size[2] |
750 | 767 |
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_bottom = heatmap_list_layout_index("heatmap_legend_bottom")) |
751 | 768 |
} else if(heatmap_legend_side == "left") { |
752 | 769 |
object@heatmap_legend_param$padding = unit(c(0, 0, 0, 2), "mm") |
753 |
- size = heatmap_legend_size(object, legend_list = heatmap_legend_list) |
|
770 |
+ size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object)) |
|
754 | 771 |
object@heatmap_legend_param$size = size |
755 | 772 |
object@layout$layout_heatmap_legend_left_width = size[1] |
756 | 773 |
object@layout$layout_index = rbind(object@layout$layout_index, heatmap_legend_left = heatmap_list_layout_index("heatmap_legend_left")) |
757 | 774 |
} else if(heatmap_legend_side == "right") { |
758 | 775 |
object@heatmap_legend_param$padding = unit(c(0, 2, 0, 0), "mm") |
759 |
- size = heatmap_legend_size(object, legend_list = heatmap_legend_list) |
|
776 |
+ size = heatmap_legend_size(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object)) |
|
760 | 777 |
object@heatmap_legend_param$size = size |
761 | 778 |
object@layout$layout_heatmap_legend_right_width = size[1] |
762 | 779 |
object@layout$layout_index = rbind(object@layout$layout_index, heamap_legend_right = heatmap_list_layout_index("heatmap_legend_right")) |
763 | 780 |
} |
764 |
- object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_heatmap_legend(object, legend_list = heatmap_legend_list)) |
|
781 |
+ if(heatmap_legend_side %in% c("top", "bottom")) { |
|
782 |
+ object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_heatmap_legend(object, legend_list = heatmap_legend_list, max_width = calc_legends_max_width(object))) |
|
783 |
+ } else { |
|
784 |
+ object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_heatmap_legend(object, legend_list = heatmap_legend_list, max_height = calc_legends_max_height(object))) |
|
785 |
+ } |
|
765 | 786 |
} else { |
766 | 787 |
object@heatmap_legend_param$size = unit(c(0, 0), "mm") |
767 | 788 |
} |
... | ... |
@@ -805,30 +826,34 @@ setMethod(f = "make_layout", |
805 | 826 |
if(show_annotation_legend) { |
806 | 827 |
if(annotation_legend_side == "top") { |
807 | 828 |
object@annotation_legend_param$padding = unit(c(2, 0, 0, 0), "mm") |
808 |
- size = annotation_legend_size(object, legend_list = annotation_legend_list) |
|
829 |
+ size = annotation_legend_size(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object)) |
|
809 | 830 |
object@annotation_legend_param$size = size |
810 | 831 |
object@layout$layout_annotation_legend_top_height = size[2] |
811 | 832 |
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_top = heatmap_list_layout_index("annotation_legend_top")) |
812 | 833 |
} else if(annotation_legend_side == "bottom") { |
813 | 834 |
object@annotation_legend_param$padding = unit(c(0, 0, 2, 0), "mm") |
814 |
- size = annotation_legend_size(object, legend_list = annotation_legend_list) |
|
835 |
+ size = annotation_legend_size(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object)) |
|
815 | 836 |
object@annotation_legend_param$size = size |
816 | 837 |
object@layout$layout_annotation_legend_bottom_height = size[2] |
817 | 838 |
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_bottom = heatmap_list_layout_index("annotation_legend_bottom")) |
818 | 839 |
} else if(annotation_legend_side == "left") { |
819 | 840 |
object@annotation_legend_param$padding = unit(c(0, 0, 0, 2), "mm") |
820 |
- size = annotation_legend_size(object, legend_list = annotation_legend_list) |
|
841 |
+ size = annotation_legend_size(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object)) |
|
821 | 842 |
object@annotation_legend_param$size = size |
822 | 843 |
object@layout$layout_annotation_legend_left_width = size[1] |
823 | 844 |
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_left = heatmap_list_layout_index("annotation_legend_left")) |
824 | 845 |
} else if(annotation_legend_side == "right") { |
825 | 846 |
object@annotation_legend_param$padding = unit(c(0, 2, 0, 0), "mm") |
826 |
- size = annotation_legend_size(object, legend_list = annotation_legend_list) |
|
847 |
+ size = annotation_legend_size(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object)) |
|
827 | 848 |
object@annotation_legend_param$size = size |
828 | 849 |
object@layout$layout_annotation_legend_right_width = size[1] |
829 | 850 |
object@layout$layout_index = rbind(object@layout$layout_index, annotation_legend_right = heatmap_list_layout_index("annotation_legend_right")) |
830 | 851 |
} |
831 |
- object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_annotation_legend(object, legend_list = annotation_legend_list)) |
|
852 |
+ if(annotation_legend_side %in% c("top", "bottom")) { |
|
853 |
+ object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_annotation_legend(object, legend_list = annotation_legend_list, max_width = calc_legends_max_width(object))) |
|
854 |
+ } else { |
|
855 |
+ object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) draw_annotation_legend(object, legend_list = annotation_legend_list, max_height = calc_legends_max_height(object))) |
|
856 |
+ } |
|
832 | 857 |
} else { |
833 | 858 |
object@annotation_legend_param$size = unit(c(0, 0), "null") |
834 | 859 |
} |
... | ... |
@@ -876,8 +901,19 @@ setMethod(f = "make_layout", |
876 | 901 |
return(object) |
877 | 902 |
}) |
878 | 903 |
|
904 |
+calc_legends_max_height = function(object) { |
|
905 |
+ gh = object@layout$page_size[2] |
|
906 |
+ h = gh - object@layout$layout_column_title_top_height - object@layout$layout_column_title_bottom_height - |
|
907 |
+ object@ht_list_param$padding[1] - object@ht_list_param$padding[3] |
|
908 |
+ convertHeight(h, "mm") |
|
909 |
+} |
|
879 | 910 |
|
880 |
- |
|
911 |
+calc_legends_max_width = function(object) { |
|
912 |
+ gh = object@layout$page_size[1] |
|
913 |
+ h = gh - object@layout$layout_row_title_right_width - object@layout$layout_row_title_left_width - |
|
914 |
+ object@ht_list_param$padding[2] - object@ht_list_param$padding[4] |
|
915 |
+ convertWidth(h, "mm") |
|
916 |
+} |
|
881 | 917 |
|
882 | 918 |
HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT = 1:7 |
883 | 919 |
names(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT) = c("annotation_legend_top", "heatmap_legend_top", "column_title_top", |
... | ... |
@@ -401,7 +401,7 @@ draw_legend = function(ColorMappingList, ColorMappingParamList, side = c("right" |
401 | 401 |
} else if(side == "top") { |
402 | 402 |
draw(pk, y = unit(1, "npc"), just = "top") |
403 | 403 |
} else if(side == "bottom") { |
404 |
- draw(pk, y = unit(1, "npc"), just = "top") |
|
404 |
+ draw(pk, y = unit(0, "npc"), just = "bottom") |
|
405 | 405 |
} |
406 | 406 |
} |
407 | 407 |
|
... | ... |
@@ -977,6 +977,8 @@ valid_just = function(just) { |
977 | 977 |
"left" = c("left", "center"), |
978 | 978 |
"right" = c("right", "center"), |
979 | 979 |
"top" = c("center", "top"), |
980 |
+ "bottom" = c("center", "bottom"), |
|
981 |
+ "top" = c("center", "top"), |
|
980 | 982 |
c("center", "center")) |
981 | 983 |
} |
982 | 984 |
if(length(just) != 2) { |