add 'cell_width' option in circos.heatmap()

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: circlize
 Type: Package
 Title: Circular Visualization
-Version: 0.4.12.1006
-Date: 2020-12-15
+Version: 0.4.12.1007
+Date: 2021-1-7
 Author: Zuguang Gu
 Maintainer: Zuguang Gu <[email protected]>
 Depends: R (>= 3.0.0), graphics

NAMESPACE

@@ -133,9 +133,9 @@ importFrom("grid", grid.pretty)
 importFrom("methods", as)
 importFrom("shape", Arrowhead)
 importFrom("stats", "as.dendrogram", "dist", "hclust", "order.dendrogram")
+importFrom("stats", "as.hclust", "cutree")
 importFrom("stats", "reorder")
 importFrom("stats", rnorm)
 importFrom("stats", runif)
 importFrom("utils", download.file)
 importFrom("utils", read.table, packageDescription)
-

NEWS

@@ -13,6 +13,7 @@ Changes in version 0.4.12
 * add `arrange_links_evenly()` function.
 * add `circos.connect()` function.
 * `circos.heatmap()`: argument `cluster` can be a clustering object.
+* `circos.heatmap()`: add `cell_width` to control the relative width of heatmap cells.
 
 Changes in version 0.4.11
 -----------------------------------------------------------------------

R/circos.heatmap.R

@@ -66,13 +66,15 @@ is.circos.heatmap.cached = function() {
 # -clustering.method Clustering method, pass to `stats::hclust`.
 # -distance.method Distance method, pass to `stats::dist`.
 # -dend.callback A callback function that is applied to the dendrogram in every sector.
+# -cell_width Relative widths of heatmap cells.
 # 
 # == seealso
 # https://jokergoo.github.io/2020/05/21/make-circular-heatmaps/
 #
 circos.heatmap.initialize = function(mat, split = NULL, cluster = TRUE, 
 	clustering.method = "complete", distance.method = "euclidean",
-	dend.callback = function(dend, m, si) reorder(dend, rowMeans(m))) {
+	dend.callback = function(dend, m, si) reorder(dend, rowMeans(m)),
+	cell_width = rep(1, nrow(mat))) {
 
 	if(!is.matrix(mat)) {
 		if(is.vector(mat) && is.atomic(mat)) {
@@ -90,6 +92,14 @@ circos.heatmap.initialize = function(mat, split = NULL, cluster = TRUE,
 		}
 	}
 
+	if(length(cell_width) == 1) {
+		cell_width = rep(cell_width, nrow(mat))
+	} else if(length(cell_width) < nrow(mat)) {
+		cell_width = rep(cell_width, times = nrow(mat))[1:nrow(mat)]
+	}
+
+	cell_width = cell_width/sum(cell_width)*nrow(mat)
+
 	if(identical(cluster, NA) || identical(cluster, NULL)) cluster = FALSE
 	if(!(identical(cluster, TRUE) || identical(cluster, FALSE))) {
 		cluster = as.dendrogram(cluster)
@@ -138,6 +148,8 @@ circos.heatmap.initialize = function(mat, split = NULL, cluster = TRUE,
 	}
 
 	mat_list = circos.heatmap.format.input(mat, split2)
+	cell_width_list = split(cell_width, split2)
+	cell_width_list = cell_width_list[names(mat_list)]
 	n = length(mat_list)
 	subset_list = attr(mat_list, "subset_list")
 	if(exists("dend_list")) {
@@ -163,19 +175,27 @@ circos.heatmap.initialize = function(mat, split = NULL, cluster = TRUE,
 
 	circos.par(cell.padding = cell.padding, track.margin = track.margin, gap.degree = gap.degree)
 
-	circos.initialize(names(mat_list), xlim = cbind(rep(0, n), sapply(mat_list, nrow)))
+	circos.initialize(names(mat_list), xlim = cbind(rep(0, n), sapply(cell_width_list, sum)))
 
 	env = circos.par("__tempenv__")
 
 	if(cluster_is_dendrogram) {
 		for(se in get.all.sector.index()) {
-			add.sector.meta.data("row_dend", dend_list[[se]], sector.index = se)
-			add.sector.meta.data("dend", dend_list[[se]], sector.index = se)
-			add.sector.meta.data("row_order", order.dendrogram(dend_list[[se]]), sector.index = se)
-			add.sector.meta.data("order", order.dendrogram(dend_list[[se]]), sector.index = se)
+			cw = cell_width_list[[se]][order.dendrogram(dend)]
+			add.sector.meta.data("cell_width", cw, sector.index = se)
+			add.sector.meta.data("cell_middle", cumsum(cw) - cw/2, sector.index = se)
+
+			dend = dend_list[[se]]
+			dend = ComplexHeatmap::adjust_dend_by_x(dend, cumsum(cw) - cw/2)
+			add.sector.meta.data("row_dend", dend, sector.index = se)
+			add.sector.meta.data("dend", dend, sector.index = se)
+			add.sector.meta.data("row_order", order.dendrogram(dend), sector.index = se)
+			add.sector.meta.data("order", order.dendrogram(dend), sector.index = se)
 			if(!is.null(subset_list)) {
 				add.sector.meta.data("subset", subset_list[[se]], sector.index = se)
 			}
+
+
 		}
 		env$circos.heatmap.cluster = TRUE
 	} else {
@@ -190,13 +210,20 @@ circos.heatmap.initialize = function(mat, split = NULL, cluster = TRUE,
 			}
 
 			for(se in get.all.sector.index()) {
-				add.sector.meta.data("row_dend", dend_list[[se]], sector.index = se)
-				add.sector.meta.data("dend", dend_list[[se]], sector.index = se)
+				cw = cell_width_list[[se]][order.dendrogram(dend_list[[se]])]
+				add.sector.meta.data("cell_width", cw, sector.index = se)
+				add.sector.meta.data("cell_middle", cumsum(cw) - cw/2, sector.index = se)
+
+				dend = dend_list[[se]]
+				dend = ComplexHeatmap::adjust_dend_by_x(dend, cumsum(cw) - cw/2)
+				add.sector.meta.data("row_dend", dend, sector.index = se)
+				add.sector.meta.data("dend", dend, sector.index = se)
 				add.sector.meta.data("row_order", order.dendrogram(dend_list[[se]]), sector.index = se)
 				add.sector.meta.data("order", order.dendrogram(dend_list[[se]]), sector.index = se)
 				if(!is.null(subset_list)) {
 					add.sector.meta.data("subset", subset_list[[se]], sector.index = se)
 				}
+
 			}
 			env$circos.heatmap.cluster = TRUE
 		} else {
@@ -207,6 +234,9 @@ circos.heatmap.initialize = function(mat, split = NULL, cluster = TRUE,
 				if(!is.null(subset_list)) {
 					add.sector.meta.data("subset", subset_list[[se]], sector.index = se)
 				}
+				cw = cell_width_list[[se]]
+				add.sector.meta.data("cell_width", cw, sector.index = se)
+				add.sector.meta.data("cell_middle", cumsum(cw) - cw/2, sector.index = se)
 			}
 			env$circos.heatmap.cluster = FALSE
 		}
@@ -264,6 +294,7 @@ circos.heatmap.validate = function(mat_list) {
 # -rownames.font Font of row names.
 # -rownames.col Color of row names.
 # -show.sector.labels Whether to show sector labels.
+# -cell_width Relative widths of heatmap cells.
 # -... Pass to `circos.track` which draws the heatmap track.
 # 
 # == seealso
@@ -293,7 +324,7 @@ circos.heatmap = function(mat, split = NULL, col, na.col = "grey",
 	dend.side = c("none", "outside", "inside"), dend.track.height = 0.1,
 	rownames.side = c("none", "outside", "inside"), rownames.cex = 0.5,
 	rownames.font = par("font"), rownames.col = "black", 
-	show.sector.labels = FALSE, ...) {
+	show.sector.labels = FALSE, cell_width = rep(1, nrow(mat)), ...) {
 
 	if(!is.matrix(mat)) {
 		if(is.vector(mat) && is.atomic(mat)) {
@@ -324,7 +355,7 @@ circos.heatmap = function(mat, split = NULL, col, na.col = "grey",
 
 		circos.heatmap.initialize(mat, split = split, cluster = cluster, 
 			clustering.method = clustering.method, distance.method = distance.method,
-			dend.callback = dend.callback)
+			dend.callback = dend.callback, cell_width = cell_width)
 	}
 
 	env = circos.par("__tempenv__")
@@ -354,7 +385,7 @@ circos.heatmap = function(mat, split = NULL, col, na.col = "grey",
 		    panel.fun = function(x, y) {
 		        sector.numeric.index = get.cell.meta.data("sector.numeric.index")
 		        dend = dend_list[[sector.numeric.index]]
-		        circos.dendrogram(dend, max_height = max_height, facing = "inside")
+		        circos.dendrogram(dend, max_height = max_height, facing = "inside", use_x_attr = TRUE)
 		})
 	}
 
@@ -381,7 +412,7 @@ circos.heatmap = function(mat, split = NULL, col, na.col = "grey",
 				    nr = nrow(m)
 
 				    if(!is.null(rownames(m))) {
-				    	circos.text(1:nr - 0.5, rep(0, nr), rownames(m)[od], cex = rownames.cex[CELL_META$subset][od], 
+				    	circos.text(CELL_META$cell_middle, rep(0, nr), rownames(m)[od], cex = rownames.cex[CELL_META$subset][od], 
 				    		font = rownames.font[CELL_META$subset][od], col = rownames.col[CELL_META$subset][od],
 				    		facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.5))
 				    }
@@ -438,16 +469,19 @@ circos.heatmap = function(mat, split = NULL, col, na.col = "grey",
 	    		} else {
 	    			# qqcat("@{sum(l)} white rectangles are not drawn.\n")
 	    			circos.rect(
-	    				(1:nr - 1)[!l], 
+	    				(CELL_META$cell_middle - CELL_META$cell_width/2)[!l], 
 	    				(rep(nc - i, nr))[!l], 
-			            (1:nr)[!l], 
+			            (CELL_META$cell_middle + CELL_META$cell_width/2)[!l], 
 			            (rep(nc - i + 1, nr))[!l], 
 			            border = col_mat[, i][!l], 
 			            col = col_mat[, i][!l])
 	    		}
 	    	} else {
-		        circos.rect(1:nr - 1, rep(nc - i, nr), 
-		            1:nr, rep(nc - i + 1, nr), 
+		        circos.rect(
+		        	CELL_META$cell_middle - CELL_META$cell_width/2, 
+		        	rep(nc - i, nr), 
+		            CELL_META$cell_middle + CELL_META$cell_width/2, 
+		            rep(nc - i + 1, nr), 
 		            border = col_mat[, i], col = col_mat[, i])
 		       }
 	    }
@@ -470,7 +504,7 @@ circos.heatmap = function(mat, split = NULL, col, na.col = "grey",
 		    panel.fun = function(x, y) {
 		        sector.numeric.index = get.cell.meta.data("sector.numeric.index")
 		        dend = dend_list[[sector.numeric.index]]
-		        circos.dendrogram(dend, max_height = max_height, facing = "outside")
+		        circos.dendrogram(dend, max_height = max_height, facing = "outside", use_x_attr = TRUE)
 		})
 	}
 
@@ -484,7 +518,7 @@ circos.heatmap = function(mat, split = NULL, col, na.col = "grey",
 				    nr = nrow(m)
 
 				    if(!is.null(rownames(m))) {
-				    	circos.text(1:nr - 0.5, rep(1, nr), rownames(m)[od], cex = rownames.cex[CELL_META$subset][od], 
+				    	circos.text(CELL_META$cell_middle, rep(1, nr), rownames(m)[od], cex = rownames.cex[CELL_META$subset][od], 
 				    		font = rownames.font[CELL_META$subset][od], col = rownames.col[CELL_META$subset][od],
 				    		facing = "clockwise", niceFacing = TRUE, adj = c(1, 0.5))
 				    }

R/global.R

@@ -218,7 +218,8 @@ circos.par = setGlobalOptions(
 		.value = new.env(parent = emptyenv()),
 		.private = TRUE,
 		.visible = FALSE),
-	message = TRUE
+	message = TRUE,
+	help = list(.synonymous = "message")
 )
 
 # before initialization, .SECTOR.DATA is NULL

R/low_level.R

@@ -2082,7 +2082,8 @@ circos.barplot = function(value, pos, bar_width = 0.6,
         if(length(border) == 1) border = rep(border, n)
         if(length(lwd) == 1) lwd = rep(lwd, n)
         if(length(lty) == 1) lty = rep(lty, n)
-
+        if(length(bar_width) == 1) bar_width = rep(bar_width, n)
+
         for(i in 1:n) {
             if(i == 1) {
                 circos.rect(pos - bar_width/2, 0, pos + bar_width/2, rowSums(value[, seq_len(i), drop = FALSE]), 
@@ -2110,7 +2111,7 @@ circos.barplot = function(value, pos, bar_width = 0.6,
 # -value A numeric vector, a matrix or a list. If it is a matrix, boxplots are made by columns (each column is a box).
 # -pos Positions of the boxes.
 # -outline Whether to draw outliers.
-# -box_width Width of boxes. It assumes the bars locating at ``x = 1, 2, ...``.
+# -box_width Width of boxes.
 # -col Filled color of boxes.
 # -border Color for the border as well as the quantile lines.
 # -lwd Line width.
@@ -2186,6 +2187,8 @@ circos.boxplot = function(value, pos, outline = TRUE, box_width = 0.6,
             stop_wrap("Length of `pos` should be same as number of boxes.")
         }
 
+        if(length(box_width) == 1) box_width = rep(box_width, n)
+
         if(length(col) == 1) col = rep(col, n)
         if(length(border) == 1) border = rep(border, n)
         if(length(lwd) == 1) lwd = rep(lwd, n)
@@ -2195,7 +2198,7 @@ circos.boxplot = function(value, pos, outline = TRUE, box_width = 0.6,
         if(length(pt.col) == 1) pt.col = rep(pt.col, n)
 
         for(i in 1:n) {
-            single_boxplot(value[[i]], pos = pos[i], outline = outline, box_width = box_width,
+            single_boxplot(value[[i]], pos = pos[i], outline = outline, box_width = box_width[i],
                 col = col[i], border = border[i], lwd = lwd[i], lty = lty[i], cex = cex[i], 
                 pch = pch[i], pt.col = pt.col[i])
         }
@@ -2288,6 +2291,7 @@ circos.violin = function(value, pos, violin_width = 0.8,
         if(length(cex) == 1) cex = rep(cex, n)
         if(length(pch) == 1) pch = rep(pch, n)
         if(length(pt.col) == 1) pt.col = rep(pt.col, n)
+        if(length(violin_width) == 1) violin_width = rep(violin_width, n)
 
         density_list = lapply(value, density, na.rm = TRUE)
 

man/Subset.CELL_META.Rd

@@ -1,6 +1,6 @@
 \name{$.CELL_META}
-\alias{$.CELL_META}
 \alias{Subset.CELL_META}
+\alias{$.CELL_META}
 \title{
 Easy to way to get meta data in the current cell
 }

man/circos.heatmap.Rd

@@ -14,7 +14,7 @@ circos.heatmap(mat, split = NULL, col, na.col = "grey",
     dend.side = c("none", "outside", "inside"), dend.track.height = 0.1,
     rownames.side = c("none", "outside", "inside"), rownames.cex = 0.5,
     rownames.font = par("font"), rownames.col = "black",
-    show.sector.labels = FALSE, ...)
+    show.sector.labels = FALSE, cell_width = rep(1, nrow(mat)), ...)
 }
 \arguments{
 
@@ -37,6 +37,7 @@ circos.heatmap(mat, split = NULL, col, na.col = "grey",
   \item{rownames.font}{Font of row names.}
   \item{rownames.col}{Color of row names.}
   \item{show.sector.labels}{Whether to show sector labels.}
+  \item{cell_width}{Relative widths of heatmap cells.}
   \item{...}{Pass to \code{\link{circos.track}} which draws the heatmap track.}
 
 }

man/circos.heatmap.initialize.Rd

@@ -9,7 +9,8 @@ Initialize circular heatmaps
 \usage{
 circos.heatmap.initialize(mat, split = NULL, cluster = TRUE,
     clustering.method = "complete", distance.method = "euclidean",
-    dend.callback = function(dend, m, si) reorder(dend, rowMeans(m)))
+    dend.callback = function(dend, m, si) reorder(dend, rowMeans(m)),
+    cell_width = rep(1, nrow(mat)))
 }
 \arguments{
 
@@ -19,6 +20,7 @@ circos.heatmap.initialize(mat, split = NULL, cluster = TRUE,
   \item{clustering.method}{Clustering method, pass to \code{\link[stats]{hclust}}.}
   \item{distance.method}{Distance method, pass to \code{\link[stats]{dist}}.}
   \item{dend.callback}{A callback function that is applied to the dendrogram in every sector.}
+  \item{cell_width}{Relative widths of heatmap cells.}
 
 }
 \seealso{