@@ -176,6 +176,7 @@ export("row_anno_histogram")

 export("row_anno_link")

 export("row_anno_points")

 export("row_anno_text")

+export("smartAlign2")

 export("subset_gp")

 export("subset_matrix_by_row")

 export("subset_vector")

@@ -3134,16 +3134,23 @@ anno_block = function(gp = gpar(), labels = NULL, labels_gp = gpar(), labels_rot

 # https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#zoom-annotation

 #

 # == example

+# set.seed(123)

 # m = matrix(rnorm(100*10), nrow = 100)

-# hc = hclust(dist(m))

-# fa2 = cutree(hc, k = 4)

+# subgroup = sample(letters[1:3], 100, replace = TRUE, prob = c(1, 5, 10))

+# rg = range(m)

 # panel_fun = function(index, nm) {

+# 	pushViewport(viewport(xscale = rg, yscale = c(0, 2)))

 # 	grid.rect()

-# 	grid.text(nm)

+# 	grid.xaxis(gp = gpar(fontsize = 8))

+# 	grid.boxplot(m[index, ], pos = 1, direction = "horizontal")

+# 	grid.text(paste("distribution of group", nm), mean(rg), y = 1.9, 

+# 		just = "top", default.units = "native", gp = gpar(fontsize = 10))

+# 	popViewport()

 # }

-# anno = anno_zoom(align_to = fa2, which = "row", panel_fun = panel_fun, 

-# 	gap = unit(1, "cm"))

-# Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno))

+# anno = anno_zoom(align_to = subgroup, which = "row", panel_fun = panel_fun, 

+# 	size = unit(2, "cm"), gap = unit(1, "cm"), width = unit(4, "cm"))

+# Heatmap(m, right_annotation = rowAnnotation(foo = anno), row_split = subgroup)

+#

 anno_zoom = function(align_to, panel_fun = function(index, nm = NULL) { grid.rect() }, 

 	which = c("column", "row"), side = ifelse(which == "column", "top", "right"),

 	size = NULL, gap = unit(1, "mm"), 

@@ -3263,10 +3270,10 @@ anno_zoom = function(align_to, panel_fun = function(index, nm = NULL) { grid.rec

 			}

 			box_height2 = convertHeight(box_height2, "native", valueOnly = TRUE)

 			# the original positions of boxes

-			mean_pos = sapply(align_to, function(ind) mean(pos[ind]))

+			mean_pos = sapply(align_to_df, function(df) mean((pos[df[, 1]] + pos[df[, 2]])/2))

 			h1 = mean_pos - box_height2*0.5

 			h2 = mean_pos + box_height2*0.5

-			h = smartAlign(rev(h1), rev(h2), c(.scale[1] - extend[1], .scale[2] + extend[2]))

+			h = smartAlign2(rev(h1), rev(h2), c(.scale[1] - extend[1], .scale[2] + extend[2]))

 			colnames(h) = c("bottom", "top")

 			h = h[nrow(h):1, , drop = FALSE]

@@ -3412,10 +3419,10 @@ anno_zoom = function(align_to, panel_fun = function(index, nm = NULL) { grid.rec

 			}

 			box_width2 = convertWidth(box_width2, "native", valueOnly = TRUE)

 			# the original positions of boxes

-			mean_pos = sapply(align_to, function(ind) mean(pos[ind]))

+			mean_pos = sapply(align_to_df, function(df) mean((pos[df[, 1]] + pos[df[, 2]])/2))

 			h1 = mean_pos - box_width2*0.5

 			h2 = mean_pos + box_width2*0.5

-			h = smartAlign(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2]))

+			h = smartAlign2(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2]))

 			colnames(h) = c("left", "right")

 			# recalcualte h to remove gaps

@@ -826,3 +826,138 @@ resize_matrix = function(mat, nr, nc) {

     h_ratio = nr/nrow(mat)

     mat[ ceiling(1:nr / h_ratio), ceiling(1:nc / w_ratio), drop = FALSE]

 }

+

+

+# == title

+# Adjust positions of rectanglar shapes

+#

+# == param

+# -start position which corresponds to the start (bottom or left) of the rectangle-shapes.

+# -end position which corresponds to the end (top or right) of the rectanglar shapes.

+# -range data ranges (the minimal and maximal values)

+# -range_fixed Whether the range is fixed for ``range`` when adjust the positions?

+#

+# == details

+# This is an improved version of the `circlize::smartAlign`.

+#

+# It adjusts the positions of the rectangular shapes to make them do not overlap

+#

+# == example

+# require(circlize)

+# make_plot = function(pos1, pos2, range) {

+#     oxpd = par("xpd")

+#     par(xpd = NA)

+#     plot(NULL, xlim = c(0, 4), ylim = range, ann = FALSE)

+#     col = rand_color(nrow(pos1), transparency = 0.5)

+#     rect(0.5, pos1[, 1], 1.5, pos1[, 2], col = col)

+#     rect(2.5, pos2[, 1], 3.5, pos2[, 2], col = col)

+#     segments(1.5, rowMeans(pos1), 2.5, rowMeans(pos2))

+#     par(xpd = oxpd)

+# }

+#

+# range = c(0, 10)

+# pos1 = rbind(c(1, 2), c(5, 7))

+# make_plot(pos1, smartAlign2(pos1, range = range), range)

+#

+# range = c(0, 10)

+# pos1 = rbind(c(-0.5, 2), c(5, 7))

+# make_plot(pos1, smartAlign2(pos1, range = range), range)

+#

+# pos1 = rbind(c(-1, 2), c(3, 4), c(5, 6), c(7, 11))

+# pos1 = pos1 + runif(length(pos1), max = 0.3, min = -0.3)

+# omfrow = par("mfrow")

+# par(mfrow = c(3, 3))

+# for(i in 1:9) {

+#     ind = sample(4, 4)

+#     make_plot(pos1[ind, ], smartAlign2(pos1[ind, ], range = range), range)

+# }

+# par(mfrow = omfrow)

+#

+# pos1 = rbind(c(3, 6), c(4, 7))

+# make_plot(pos1, smartAlign2(pos1, range = range), range)

+#

+# pos1 = rbind(c(1, 8), c(3, 10))

+# make_plot(pos1, smartAlign2(pos1, range = range), range)

+# make_plot(pos1, smartAlign2(pos1, range = range, range_fixed = FALSE), range)

+#

+smartAlign2 = function(start, end, range, range_fixed = TRUE) {

+

+    if(missing(end)) {

+        x1 = start[, 1]

+        x2 = start[, 2]

+    } else {

+        x1 = start

+        x2 = end

+    }

+

+    if(missing(range)) {

+        range = range(c(x1, x2))

+    }

+

+    od = order(x1)

+    rk = rank(x1, ties.method = "random")

+    x1 = x1[od]

+    x2 = x2[od]

+    h = x2 - x1

+

+    ncluster.before = -1

+    ncluster = length(x1)

+    i_try = 0

+    while(ncluster.before != ncluster) {

+        ncluster.before = ncluster

+        cluster = rep(0, length(x1))

+        i_cluster = 1

+        cluster[1] = i_cluster

+        for(i in seq_along(x1)[-1]) {

+            # overlap with previous one

+            if(x1[i] <= x2[i-1]) {  # this means x1 should be sorted increasingly

+                cluster[i] = i_cluster

+            } else {

+                i_cluster = i_cluster + 1

+                cluster[i] = i_cluster

+            }

+        }

+        ncluster = length(unique(cluster))

+        

+        if(ncluster.before == ncluster && i_try > 0) break

+        

+        # tile intervals in each cluster and re-assign x1 and x2

+        new_x1 = numeric(length(x1))

+        new_x2 = numeric(length(x2))

+        for(i_cluster in unique(cluster)) {

+            index = which(cluster == i_cluster)

+            total_len = sum(x2[index] - x1[index])  # sum of the height in the cluster

+            mid = (min(x1[index]) + max(x2[index]))/2

+            if(total_len > range[2] - range[1]) {

+                # tp = seq(range[1], range[2], length = length(index) + 1)

+                if(range_fixed) {

+                    tp = cumsum(c(0, h[index]/sum(h[index])))*(range[2] - range[1]) + range[1]

+                } else {

+                    tp = c(0, cumsum(h[index])) + mid - sum(h[index])/2

+                }

+            } else if(mid - total_len/2 < range[1]) { # if it exceed the bottom

+                # tp = seq(range[1], range[1] + total_len, length = length(index) + 1)

+                tp = c(0, cumsum(h[index])) + range[1]

+            } else if(mid + total_len/2 > range[2]) {

+                # tp = seq(range[2] - total_len, range[2], length = length(index) + 1)

+                tp = range[2] - rev(c(0, cumsum(h[index])))

+            } else {

+                # tp = seq(mid - total_len/2, mid + total_len/2, length = length(index)+1)

+                tp = c(0, cumsum(h[index])) + mid - sum(h[index])/2

+            }

+            new_x1[index] = tp[-length(tp)]

+            new_x2[index] = tp[-1]

+        }

+        mid = (new_x1 + new_x2)/2

+        h = (x2 - x1)

+        

+        x1 = mid - h/2

+        x2 = mid + h/2

+

+        i_try = i_try + 1

+    }

+    

+    df = data.frame(start = x1, end = x2)

+    df[rk, , drop = FALSE]

+}

+

@@ -40,14 +40,20 @@ An annotation function which can be used in \code{\link{HeatmapAnnotation}}.

 \url{https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html#zoom-annotation}

 }

 \examples{

+set.seed(123)

 m = matrix(rnorm(100*10), nrow = 100)

-hc = hclust(dist(m))

-fa2 = cutree(hc, k = 4)

+subgroup = sample(letters[1:3], 100, replace = TRUE, prob = c(1, 5, 10))

+rg = range(m)

 panel_fun = function(index, nm) {

+	pushViewport(viewport(xscale = rg, yscale = c(0, 2)))

 	grid.rect()

-	grid.text(nm)

-}

-anno = anno_zoom(align_to = fa2, which = "row", panel_fun = panel_fun, 

-	gap = unit(1, "cm"))

-Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno))

+	grid.xaxis(gp = gpar(fontsize = 8))

+	grid.boxplot(m[index, ], pos = 1, direction = "horizontal")

+	grid.text(paste("distribution of group", nm), mean(rg), y = 1.9, 

+		just = "top", default.units = "native", gp = gpar(fontsize = 10))

+	popViewport()

+}

+anno = anno_zoom(align_to = subgroup, which = "row", panel_fun = panel_fun, 

+	size = unit(2, "cm"), gap = unit(1, "cm"), width = unit(4, "cm"))

+Heatmap(m, right_annotation = rowAnnotation(foo = anno), row_split = subgroup)

 }

new file mode 100644

@@ -0,0 +1,62 @@

+\name{smartAlign2}

+\alias{smartAlign2}

+\title{

+Adjust positions of rectanglar shapes

+}

+\description{

+Adjust positions of rectanglar shapes

+}

+\usage{

+smartAlign2(start, end, range, range_fixed = TRUE)

+}

+\arguments{

+

+  \item{start}{position which corresponds to the start (bottom or left) of the rectangle-shapes.}

+  \item{end}{position which corresponds to the end (top or right) of the rectanglar shapes.}

+  \item{range}{data ranges (the minimal and maximal values)}

+  \item{range_fixed}{Whether the range is fixed for \code{range} when adjust the positions?}

+

+}

+\details{

+This is an improved version of the \code{\link[circlize]{smartAlign}}.

+

+It adjusts the positions of the rectangular shapes to make them do not overlap

+}

+\examples{

+require(circlize)

+make_plot = function(pos1, pos2, range) {

+    oxpd = par("xpd")

+    par(xpd = NA)

+    plot(NULL, xlim = c(0, 4), ylim = range, ann = FALSE)

+    col = rand_color(nrow(pos1), transparency = 0.5)

+    rect(0.5, pos1[, 1], 1.5, pos1[, 2], col = col)

+    rect(2.5, pos2[, 1], 3.5, pos2[, 2], col = col)

+    segments(1.5, rowMeans(pos1), 2.5, rowMeans(pos2))

+    par(xpd = oxpd)

+}

+

+range = c(0, 10)

+pos1 = rbind(c(1, 2), c(5, 7))

+make_plot(pos1, smartAlign2(pos1, range = range), range)

+

+range = c(0, 10)

+pos1 = rbind(c(-0.5, 2), c(5, 7))

+make_plot(pos1, smartAlign2(pos1, range = range), range)

+

+pos1 = rbind(c(-1, 2), c(3, 4), c(5, 6), c(7, 11))

+pos1 = pos1 + runif(length(pos1), max = 0.3, min = -0.3)

+omfrow = par("mfrow")

+par(mfrow = c(3, 3))

+for(i in 1:9) {

+    ind = sample(4, 4)

+    make_plot(pos1[ind, ], smartAlign2(pos1[ind, ], range = range), range)

+}

+par(mfrow = omfrow)

+

+pos1 = rbind(c(3, 6), c(4, 7))

+make_plot(pos1, smartAlign2(pos1, range = range), range)

+

+pos1 = rbind(c(1, 8), c(3, 10))

+make_plot(pos1, smartAlign2(pos1, range = range), range)

+make_plot(pos1, smartAlign2(pos1, range = range, range_fixed = FALSE), range)

+}

@@ -437,5 +437,20 @@ Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno), row_

 anno = anno_zoom(align_to = fa2, which = "row", panel_fun = panel_fun, size = unit(1:4, "cm"))

 Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno))

-

+set.seed(123)

+m = matrix(rnorm(100*10), nrow = 100)

+subgroup = sample(letters[1:3], 100, replace = TRUE, prob = c(1, 5, 10))

+rg = range(m)

+panel_fun = function(index, nm) {

+	pushViewport(viewport(xscale = rg, yscale = c(0, 2)))

+	grid.rect()

+	grid.xaxis(gp = gpar(fontsize = 8))

+	grid.boxplot(m[index, ], pos = 1, direction = "horizontal")

+	grid.text(paste("distribution of group", nm), mean(rg), y = 1.9, 

+		just = "top", default.units = "native", gp = gpar(fontsize = 10))

+	popViewport()

+}

+anno = anno_zoom(align_to = subgroup, which = "row", panel_fun = panel_fun, 

+	size = unit(2, "cm"), gap = unit(1, "cm"), width = unit(4, "cm"))

+Heatmap(m, right_annotation = rowAnnotation(foo = anno), row_split = subgroup)

@@ -17,3 +17,44 @@ test_that("test default colors", {

 	col = default_col(1:10)

 	expect_that(is.function(col), is_identical_to(TRUE))

 })

+

+

+

+# things needed to be tested

+# 1. the order

+# 2. if the sum of sizes are larger than xlim

+

+make_plot = function(pos1, pos2, range) {

+	oxpd = par("xpd")

+	par(xpd = NA)

+	plot(NULL, xlim = c(0, 4), ylim = range, ann = FALSE)

+	col = rand_color(nrow(pos1), transparency = 0.5)

+	rect(0.5, pos1[, 1], 1.5, pos1[, 2], col = col)

+	rect(2.5, pos2[, 1], 3.5, pos2[, 2], col = col)

+	segments(1.5, rowMeans(pos1), 2.5, rowMeans(pos2))

+	par(xpd = oxpd)

+}

+

+range = c(0, 10)

+pos1 = rbind(c(1, 2), c(5, 7))

+make_plot(pos1, smartAlign2(pos1, range = range), range)

+

+range = c(0, 10)

+pos1 = rbind(c(-0.5, 2), c(5, 7))

+make_plot(pos1, smartAlign2(pos1, range = range), range)

+

+pos1 = rbind(c(-1, 2), c(3, 4), c(5, 6), c(7, 11))

+pos1 = pos1 + runif(length(pos1), max = 0.3, min = -0.3)

+par(mfrow = c(3, 3))

+for(i in 1:9) {

+	ind = sample(4, 4)

+	make_plot(pos1[ind, ], smartAlign2(pos1[ind, ], range = range), range)

+}

+par(mfrow = c(1, 1))

+

+pos1 = rbind(c(3, 6), c(4, 7))

+make_plot(pos1, smartAlign2(pos1, range = range), range)

+

+pos1 = rbind(c(1, 8), c(3, 10))

+make_plot(pos1, smartAlign2(pos1, range = range), range)

+make_plot(pos1, smartAlign2(pos1, range = range, range_fixed = FALSE), range)