Browse code

add smartAlign2()

Zuguang Gu authored on 13/12/2018 11:37:32
Showing7 changed files

... ...
@@ -176,6 +176,7 @@ export("row_anno_histogram")
176 176
 export("row_anno_link")
177 177
 export("row_anno_points")
178 178
 export("row_anno_text")
179
+export("smartAlign2")
179 180
 export("subset_gp")
180 181
 export("subset_matrix_by_row")
181 182
 export("subset_vector")
... ...
@@ -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)