... | ... |
@@ -3134,16 +3134,23 @@ anno_block = function(gp = gpar(), labels = NULL, labels_gp = gpar(), labels_rot |
3134 | 3134 |
# https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#zoom-annotation |
3135 | 3135 |
# |
3136 | 3136 |
# == example |
3137 |
+# set.seed(123) |
|
3137 | 3138 |
# m = matrix(rnorm(100*10), nrow = 100) |
3138 |
-# hc = hclust(dist(m)) |
|
3139 |
-# fa2 = cutree(hc, k = 4) |
|
3139 |
+# subgroup = sample(letters[1:3], 100, replace = TRUE, prob = c(1, 5, 10)) |
|
3140 |
+# rg = range(m) |
|
3140 | 3141 |
# panel_fun = function(index, nm) { |
3142 |
+# pushViewport(viewport(xscale = rg, yscale = c(0, 2))) |
|
3141 | 3143 |
# grid.rect() |
3142 |
-# grid.text(nm) |
|
3144 |
+# grid.xaxis(gp = gpar(fontsize = 8)) |
|
3145 |
+# grid.boxplot(m[index, ], pos = 1, direction = "horizontal") |
|
3146 |
+# grid.text(paste("distribution of group", nm), mean(rg), y = 1.9, |
|
3147 |
+# just = "top", default.units = "native", gp = gpar(fontsize = 10)) |
|
3148 |
+# popViewport() |
|
3143 | 3149 |
# } |
3144 |
-# anno = anno_zoom(align_to = fa2, which = "row", panel_fun = panel_fun, |
|
3145 |
-# gap = unit(1, "cm")) |
|
3146 |
-# Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno)) |
|
3150 |
+# anno = anno_zoom(align_to = subgroup, which = "row", panel_fun = panel_fun, |
|
3151 |
+# size = unit(2, "cm"), gap = unit(1, "cm"), width = unit(4, "cm")) |
|
3152 |
+# Heatmap(m, right_annotation = rowAnnotation(foo = anno), row_split = subgroup) |
|
3153 |
+# |
|
3147 | 3154 |
anno_zoom = function(align_to, panel_fun = function(index, nm = NULL) { grid.rect() }, |
3148 | 3155 |
which = c("column", "row"), side = ifelse(which == "column", "top", "right"), |
3149 | 3156 |
size = NULL, gap = unit(1, "mm"), |
... | ... |
@@ -3263,10 +3270,10 @@ anno_zoom = function(align_to, panel_fun = function(index, nm = NULL) { grid.rec |
3263 | 3270 |
} |
3264 | 3271 |
box_height2 = convertHeight(box_height2, "native", valueOnly = TRUE) |
3265 | 3272 |
# the original positions of boxes |
3266 |
- mean_pos = sapply(align_to, function(ind) mean(pos[ind])) |
|
3273 |
+ mean_pos = sapply(align_to_df, function(df) mean((pos[df[, 1]] + pos[df[, 2]])/2)) |
|
3267 | 3274 |
h1 = mean_pos - box_height2*0.5 |
3268 | 3275 |
h2 = mean_pos + box_height2*0.5 |
3269 |
- h = smartAlign(rev(h1), rev(h2), c(.scale[1] - extend[1], .scale[2] + extend[2])) |
|
3276 |
+ h = smartAlign2(rev(h1), rev(h2), c(.scale[1] - extend[1], .scale[2] + extend[2])) |
|
3270 | 3277 |
colnames(h) = c("bottom", "top") |
3271 | 3278 |
h = h[nrow(h):1, , drop = FALSE] |
3272 | 3279 |
|
... | ... |
@@ -3412,10 +3419,10 @@ anno_zoom = function(align_to, panel_fun = function(index, nm = NULL) { grid.rec |
3412 | 3419 |
} |
3413 | 3420 |
box_width2 = convertWidth(box_width2, "native", valueOnly = TRUE) |
3414 | 3421 |
# the original positions of boxes |
3415 |
- mean_pos = sapply(align_to, function(ind) mean(pos[ind])) |
|
3422 |
+ mean_pos = sapply(align_to_df, function(df) mean((pos[df[, 1]] + pos[df[, 2]])/2)) |
|
3416 | 3423 |
h1 = mean_pos - box_width2*0.5 |
3417 | 3424 |
h2 = mean_pos + box_width2*0.5 |
3418 |
- h = smartAlign(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2])) |
|
3425 |
+ h = smartAlign2(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2])) |
|
3419 | 3426 |
colnames(h) = c("left", "right") |
3420 | 3427 |
|
3421 | 3428 |
# recalcualte h to remove gaps |
... | ... |
@@ -826,3 +826,138 @@ resize_matrix = function(mat, nr, nc) { |
826 | 826 |
h_ratio = nr/nrow(mat) |
827 | 827 |
mat[ ceiling(1:nr / h_ratio), ceiling(1:nc / w_ratio), drop = FALSE] |
828 | 828 |
} |
829 |
+ |
|
830 |
+ |
|
831 |
+# == title |
|
832 |
+# Adjust positions of rectanglar shapes |
|
833 |
+# |
|
834 |
+# == param |
|
835 |
+# -start position which corresponds to the start (bottom or left) of the rectangle-shapes. |
|
836 |
+# -end position which corresponds to the end (top or right) of the rectanglar shapes. |
|
837 |
+# -range data ranges (the minimal and maximal values) |
|
838 |
+# -range_fixed Whether the range is fixed for ``range`` when adjust the positions? |
|
839 |
+# |
|
840 |
+# == details |
|
841 |
+# This is an improved version of the `circlize::smartAlign`. |
|
842 |
+# |
|
843 |
+# It adjusts the positions of the rectangular shapes to make them do not overlap |
|
844 |
+# |
|
845 |
+# == example |
|
846 |
+# require(circlize) |
|
847 |
+# make_plot = function(pos1, pos2, range) { |
|
848 |
+# oxpd = par("xpd") |
|
849 |
+# par(xpd = NA) |
|
850 |
+# plot(NULL, xlim = c(0, 4), ylim = range, ann = FALSE) |
|
851 |
+# col = rand_color(nrow(pos1), transparency = 0.5) |
|
852 |
+# rect(0.5, pos1[, 1], 1.5, pos1[, 2], col = col) |
|
853 |
+# rect(2.5, pos2[, 1], 3.5, pos2[, 2], col = col) |
|
854 |
+# segments(1.5, rowMeans(pos1), 2.5, rowMeans(pos2)) |
|
855 |
+# par(xpd = oxpd) |
|
856 |
+# } |
|
857 |
+# |
|
858 |
+# range = c(0, 10) |
|
859 |
+# pos1 = rbind(c(1, 2), c(5, 7)) |
|
860 |
+# make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
861 |
+# |
|
862 |
+# range = c(0, 10) |
|
863 |
+# pos1 = rbind(c(-0.5, 2), c(5, 7)) |
|
864 |
+# make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
865 |
+# |
|
866 |
+# pos1 = rbind(c(-1, 2), c(3, 4), c(5, 6), c(7, 11)) |
|
867 |
+# pos1 = pos1 + runif(length(pos1), max = 0.3, min = -0.3) |
|
868 |
+# omfrow = par("mfrow") |
|
869 |
+# par(mfrow = c(3, 3)) |
|
870 |
+# for(i in 1:9) { |
|
871 |
+# ind = sample(4, 4) |
|
872 |
+# make_plot(pos1[ind, ], smartAlign2(pos1[ind, ], range = range), range) |
|
873 |
+# } |
|
874 |
+# par(mfrow = omfrow) |
|
875 |
+# |
|
876 |
+# pos1 = rbind(c(3, 6), c(4, 7)) |
|
877 |
+# make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
878 |
+# |
|
879 |
+# pos1 = rbind(c(1, 8), c(3, 10)) |
|
880 |
+# make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
881 |
+# make_plot(pos1, smartAlign2(pos1, range = range, range_fixed = FALSE), range) |
|
882 |
+# |
|
883 |
+smartAlign2 = function(start, end, range, range_fixed = TRUE) { |
|
884 |
+ |
|
885 |
+ if(missing(end)) { |
|
886 |
+ x1 = start[, 1] |
|
887 |
+ x2 = start[, 2] |
|
888 |
+ } else { |
|
889 |
+ x1 = start |
|
890 |
+ x2 = end |
|
891 |
+ } |
|
892 |
+ |
|
893 |
+ if(missing(range)) { |
|
894 |
+ range = range(c(x1, x2)) |
|
895 |
+ } |
|
896 |
+ |
|
897 |
+ od = order(x1) |
|
898 |
+ rk = rank(x1, ties.method = "random") |
|
899 |
+ x1 = x1[od] |
|
900 |
+ x2 = x2[od] |
|
901 |
+ h = x2 - x1 |
|
902 |
+ |
|
903 |
+ ncluster.before = -1 |
|
904 |
+ ncluster = length(x1) |
|
905 |
+ i_try = 0 |
|
906 |
+ while(ncluster.before != ncluster) { |
|
907 |
+ ncluster.before = ncluster |
|
908 |
+ cluster = rep(0, length(x1)) |
|
909 |
+ i_cluster = 1 |
|
910 |
+ cluster[1] = i_cluster |
|
911 |
+ for(i in seq_along(x1)[-1]) { |
|
912 |
+ # overlap with previous one |
|
913 |
+ if(x1[i] <= x2[i-1]) { # this means x1 should be sorted increasingly |
|
914 |
+ cluster[i] = i_cluster |
|
915 |
+ } else { |
|
916 |
+ i_cluster = i_cluster + 1 |
|
917 |
+ cluster[i] = i_cluster |
|
918 |
+ } |
|
919 |
+ } |
|
920 |
+ ncluster = length(unique(cluster)) |
|
921 |
+ |
|
922 |
+ if(ncluster.before == ncluster && i_try > 0) break |
|
923 |
+ |
|
924 |
+ # tile intervals in each cluster and re-assign x1 and x2 |
|
925 |
+ new_x1 = numeric(length(x1)) |
|
926 |
+ new_x2 = numeric(length(x2)) |
|
927 |
+ for(i_cluster in unique(cluster)) { |
|
928 |
+ index = which(cluster == i_cluster) |
|
929 |
+ total_len = sum(x2[index] - x1[index]) # sum of the height in the cluster |
|
930 |
+ mid = (min(x1[index]) + max(x2[index]))/2 |
|
931 |
+ if(total_len > range[2] - range[1]) { |
|
932 |
+ # tp = seq(range[1], range[2], length = length(index) + 1) |
|
933 |
+ if(range_fixed) { |
|
934 |
+ tp = cumsum(c(0, h[index]/sum(h[index])))*(range[2] - range[1]) + range[1] |
|
935 |
+ } else { |
|
936 |
+ tp = c(0, cumsum(h[index])) + mid - sum(h[index])/2 |
|
937 |
+ } |
|
938 |
+ } else if(mid - total_len/2 < range[1]) { # if it exceed the bottom |
|
939 |
+ # tp = seq(range[1], range[1] + total_len, length = length(index) + 1) |
|
940 |
+ tp = c(0, cumsum(h[index])) + range[1] |
|
941 |
+ } else if(mid + total_len/2 > range[2]) { |
|
942 |
+ # tp = seq(range[2] - total_len, range[2], length = length(index) + 1) |
|
943 |
+ tp = range[2] - rev(c(0, cumsum(h[index]))) |
|
944 |
+ } else { |
|
945 |
+ # tp = seq(mid - total_len/2, mid + total_len/2, length = length(index)+1) |
|
946 |
+ tp = c(0, cumsum(h[index])) + mid - sum(h[index])/2 |
|
947 |
+ } |
|
948 |
+ new_x1[index] = tp[-length(tp)] |
|
949 |
+ new_x2[index] = tp[-1] |
|
950 |
+ } |
|
951 |
+ mid = (new_x1 + new_x2)/2 |
|
952 |
+ h = (x2 - x1) |
|
953 |
+ |
|
954 |
+ x1 = mid - h/2 |
|
955 |
+ x2 = mid + h/2 |
|
956 |
+ |
|
957 |
+ i_try = i_try + 1 |
|
958 |
+ } |
|
959 |
+ |
|
960 |
+ df = data.frame(start = x1, end = x2) |
|
961 |
+ df[rk, , drop = FALSE] |
|
962 |
+} |
|
963 |
+ |
... | ... |
@@ -40,14 +40,20 @@ An annotation function which can be used in \code{\link{HeatmapAnnotation}}. |
40 | 40 |
\url{https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#zoom-annotation} |
41 | 41 |
} |
42 | 42 |
\examples{ |
43 |
+set.seed(123) |
|
43 | 44 |
m = matrix(rnorm(100*10), nrow = 100) |
44 |
-hc = hclust(dist(m)) |
|
45 |
-fa2 = cutree(hc, k = 4) |
|
45 |
+subgroup = sample(letters[1:3], 100, replace = TRUE, prob = c(1, 5, 10)) |
|
46 |
+rg = range(m) |
|
46 | 47 |
panel_fun = function(index, nm) { |
48 |
+ pushViewport(viewport(xscale = rg, yscale = c(0, 2))) |
|
47 | 49 |
grid.rect() |
48 |
- grid.text(nm) |
|
49 |
-} |
|
50 |
-anno = anno_zoom(align_to = fa2, which = "row", panel_fun = panel_fun, |
|
51 |
- gap = unit(1, "cm")) |
|
52 |
-Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno)) |
|
50 |
+ grid.xaxis(gp = gpar(fontsize = 8)) |
|
51 |
+ grid.boxplot(m[index, ], pos = 1, direction = "horizontal") |
|
52 |
+ grid.text(paste("distribution of group", nm), mean(rg), y = 1.9, |
|
53 |
+ just = "top", default.units = "native", gp = gpar(fontsize = 10)) |
|
54 |
+ popViewport() |
|
55 |
+} |
|
56 |
+anno = anno_zoom(align_to = subgroup, which = "row", panel_fun = panel_fun, |
|
57 |
+ size = unit(2, "cm"), gap = unit(1, "cm"), width = unit(4, "cm")) |
|
58 |
+Heatmap(m, right_annotation = rowAnnotation(foo = anno), row_split = subgroup) |
|
53 | 59 |
} |
54 | 60 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,62 @@ |
1 |
+\name{smartAlign2} |
|
2 |
+\alias{smartAlign2} |
|
3 |
+\title{ |
|
4 |
+Adjust positions of rectanglar shapes |
|
5 |
+} |
|
6 |
+\description{ |
|
7 |
+Adjust positions of rectanglar shapes |
|
8 |
+} |
|
9 |
+\usage{ |
|
10 |
+smartAlign2(start, end, range, range_fixed = TRUE) |
|
11 |
+} |
|
12 |
+\arguments{ |
|
13 |
+ |
|
14 |
+ \item{start}{position which corresponds to the start (bottom or left) of the rectangle-shapes.} |
|
15 |
+ \item{end}{position which corresponds to the end (top or right) of the rectanglar shapes.} |
|
16 |
+ \item{range}{data ranges (the minimal and maximal values)} |
|
17 |
+ \item{range_fixed}{Whether the range is fixed for \code{range} when adjust the positions?} |
|
18 |
+ |
|
19 |
+} |
|
20 |
+\details{ |
|
21 |
+This is an improved version of the \code{\link[circlize]{smartAlign}}. |
|
22 |
+ |
|
23 |
+It adjusts the positions of the rectangular shapes to make them do not overlap |
|
24 |
+} |
|
25 |
+\examples{ |
|
26 |
+require(circlize) |
|
27 |
+make_plot = function(pos1, pos2, range) { |
|
28 |
+ oxpd = par("xpd") |
|
29 |
+ par(xpd = NA) |
|
30 |
+ plot(NULL, xlim = c(0, 4), ylim = range, ann = FALSE) |
|
31 |
+ col = rand_color(nrow(pos1), transparency = 0.5) |
|
32 |
+ rect(0.5, pos1[, 1], 1.5, pos1[, 2], col = col) |
|
33 |
+ rect(2.5, pos2[, 1], 3.5, pos2[, 2], col = col) |
|
34 |
+ segments(1.5, rowMeans(pos1), 2.5, rowMeans(pos2)) |
|
35 |
+ par(xpd = oxpd) |
|
36 |
+} |
|
37 |
+ |
|
38 |
+range = c(0, 10) |
|
39 |
+pos1 = rbind(c(1, 2), c(5, 7)) |
|
40 |
+make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
41 |
+ |
|
42 |
+range = c(0, 10) |
|
43 |
+pos1 = rbind(c(-0.5, 2), c(5, 7)) |
|
44 |
+make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
45 |
+ |
|
46 |
+pos1 = rbind(c(-1, 2), c(3, 4), c(5, 6), c(7, 11)) |
|
47 |
+pos1 = pos1 + runif(length(pos1), max = 0.3, min = -0.3) |
|
48 |
+omfrow = par("mfrow") |
|
49 |
+par(mfrow = c(3, 3)) |
|
50 |
+for(i in 1:9) { |
|
51 |
+ ind = sample(4, 4) |
|
52 |
+ make_plot(pos1[ind, ], smartAlign2(pos1[ind, ], range = range), range) |
|
53 |
+} |
|
54 |
+par(mfrow = omfrow) |
|
55 |
+ |
|
56 |
+pos1 = rbind(c(3, 6), c(4, 7)) |
|
57 |
+make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
58 |
+ |
|
59 |
+pos1 = rbind(c(1, 8), c(3, 10)) |
|
60 |
+make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
61 |
+make_plot(pos1, smartAlign2(pos1, range = range, range_fixed = FALSE), range) |
|
62 |
+} |
... | ... |
@@ -437,5 +437,20 @@ Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno), row_ |
437 | 437 |
anno = anno_zoom(align_to = fa2, which = "row", panel_fun = panel_fun, size = unit(1:4, "cm")) |
438 | 438 |
Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno)) |
439 | 439 |
|
440 |
- |
|
440 |
+set.seed(123) |
|
441 |
+m = matrix(rnorm(100*10), nrow = 100) |
|
442 |
+subgroup = sample(letters[1:3], 100, replace = TRUE, prob = c(1, 5, 10)) |
|
443 |
+rg = range(m) |
|
444 |
+panel_fun = function(index, nm) { |
|
445 |
+ pushViewport(viewport(xscale = rg, yscale = c(0, 2))) |
|
446 |
+ grid.rect() |
|
447 |
+ grid.xaxis(gp = gpar(fontsize = 8)) |
|
448 |
+ grid.boxplot(m[index, ], pos = 1, direction = "horizontal") |
|
449 |
+ grid.text(paste("distribution of group", nm), mean(rg), y = 1.9, |
|
450 |
+ just = "top", default.units = "native", gp = gpar(fontsize = 10)) |
|
451 |
+ popViewport() |
|
452 |
+} |
|
453 |
+anno = anno_zoom(align_to = subgroup, which = "row", panel_fun = panel_fun, |
|
454 |
+ size = unit(2, "cm"), gap = unit(1, "cm"), width = unit(4, "cm")) |
|
455 |
+Heatmap(m, right_annotation = rowAnnotation(foo = anno), row_split = subgroup) |
|
441 | 456 |
|
... | ... |
@@ -17,3 +17,44 @@ test_that("test default colors", { |
17 | 17 |
col = default_col(1:10) |
18 | 18 |
expect_that(is.function(col), is_identical_to(TRUE)) |
19 | 19 |
}) |
20 |
+ |
|
21 |
+ |
|
22 |
+ |
|
23 |
+# things needed to be tested |
|
24 |
+# 1. the order |
|
25 |
+# 2. if the sum of sizes are larger than xlim |
|
26 |
+ |
|
27 |
+make_plot = function(pos1, pos2, range) { |
|
28 |
+ oxpd = par("xpd") |
|
29 |
+ par(xpd = NA) |
|
30 |
+ plot(NULL, xlim = c(0, 4), ylim = range, ann = FALSE) |
|
31 |
+ col = rand_color(nrow(pos1), transparency = 0.5) |
|
32 |
+ rect(0.5, pos1[, 1], 1.5, pos1[, 2], col = col) |
|
33 |
+ rect(2.5, pos2[, 1], 3.5, pos2[, 2], col = col) |
|
34 |
+ segments(1.5, rowMeans(pos1), 2.5, rowMeans(pos2)) |
|
35 |
+ par(xpd = oxpd) |
|
36 |
+} |
|
37 |
+ |
|
38 |
+range = c(0, 10) |
|
39 |
+pos1 = rbind(c(1, 2), c(5, 7)) |
|
40 |
+make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
41 |
+ |
|
42 |
+range = c(0, 10) |
|
43 |
+pos1 = rbind(c(-0.5, 2), c(5, 7)) |
|
44 |
+make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
45 |
+ |
|
46 |
+pos1 = rbind(c(-1, 2), c(3, 4), c(5, 6), c(7, 11)) |
|
47 |
+pos1 = pos1 + runif(length(pos1), max = 0.3, min = -0.3) |
|
48 |
+par(mfrow = c(3, 3)) |
|
49 |
+for(i in 1:9) { |
|
50 |
+ ind = sample(4, 4) |
|
51 |
+ make_plot(pos1[ind, ], smartAlign2(pos1[ind, ], range = range), range) |
|
52 |
+} |
|
53 |
+par(mfrow = c(1, 1)) |
|
54 |
+ |
|
55 |
+pos1 = rbind(c(3, 6), c(4, 7)) |
|
56 |
+make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
57 |
+ |
|
58 |
+pos1 = rbind(c(1, 8), c(3, 10)) |
|
59 |
+make_plot(pos1, smartAlign2(pos1, range = range), range) |
|
60 |
+make_plot(pos1, smartAlign2(pos1, range = range, range_fixed = FALSE), range) |