@@ -2,14 +2,15 @@ Package: ComplexHeatmap

 Type: Package

 Title: Making Complex Heatmaps

 Version: 1.15.1

-Date: 2017-2-15

+Date: 2017-7-19

 Author: Zuguang Gu

 Maintainer: Zuguang Gu <z.gu@dkfz.de>

 Depends: R (>= 3.1.2), methods, grid, graphics, stats, grDevices

 Imports: circlize (>= 0.4.1), GetoptLong, colorspace,

-    RColorBrewer, dendextend (>= 1.0.1), GlobalOptions (>= 0.0.10)

+    RColorBrewer, GlobalOptions (>= 0.0.10)

 Suggests: testthat (>= 0.3), knitr, markdown, cluster, MASS, pvclust, 

-    dendsort, HilbertCurve, Cairo, png, jpeg, tiff, fastcluster

+    dendsort, HilbertCurve, Cairo, png, jpeg, tiff, fastcluster,

+    dendextend (>= 1.0.1)

 VignetteBuilder: knitr

 Description: Complex heatmaps are efficient to visualize associations 

     between different sources of data sets and reveal potential structures. 

@@ -18,6 +19,6 @@ Description: Complex heatmaps are efficient to visualize associations

 biocViews: Software, Visualization, Sequencing

 URL: https://github.com/jokergoo/ComplexHeatmap

 License: GPL (>= 2)

-Packaged: 2017-2-15 00:00:00 UTC; Administrator

+Packaged: 2017-7-19 00:00:00 UTC; Administrator

 Repository: Bioconductor

-Date/Publication: 2017-2-15 00:00:00

+Date/Publication: 2017-7-19 00:00:00

@@ -1,5 +1,6 @@

 export('+.AdditiveUnit')

 export('grid.dendrogram')

+export('grid.dendrogram2')

 export(AdditiveUnit)

 export(ColorMapping)

 export(Heatmap)

@@ -7,6 +8,7 @@ export(HeatmapAnnotation)

 export(HeatmapList)

 export(Legend)

 export(SingleAnnotation)

+export(adjust_dend_by_leaf_width)

 export(anno_barplot)

 export(anno_boxplot)

 export(anno_density)

@@ -109,8 +111,5 @@ importFrom("circlize", rand_color)

 importFrom("circlize", smartAlign)

 importFrom("colorspace", diverge_hcl)

 importFrom("colorspace", rainbow_hcl)

-importFrom("dendextend", "labels<-")

-importFrom("dendextend", get_branches_heights)

-importFrom("dendextend", nnodes)

 importFrom("utils", "getFromNamespace")

@@ -5,10 +5,16 @@ CHANGES in VERSION 1.15.1

 * annotations with duplicated names have no legends any more

 * re-implement `grid.xaxis()` to draw axis labels rotated 90 degrees

 * grids in discrete legend are arranged by rows if ncol > 1

-* raster image is generated in a independent R session

+* raster image is generated in an independent R session

 * empty string in annotation or heatmap is mapped to NA

 * annotation and heatmap legends can be merged into one column. 

 * change the default value of `row_names_max_width` and `column_names_max_height`

+* default legend style for continuous values is changed to "continuous"

+* add `grid.dendrogram2()` which draws dendrograms with uneven position for leaves

+* move **dendextend** to Suggests field because it depends/imports rlang indirectly

+  which has a `print.frame()` function and it will affect to print a `frame` object

+  returned by `frameGrob()`.

+* `decorate_*()` functions return to the viewport where they are called.

 =======================

@@ -212,7 +212,7 @@ setMethod(f = "map_to_colors",

 # -title title of the legend, by default it is the name of the legend

 # -title_gp graphical parameters for legend title

 # -title_position position of the title

-# -color_bar if the mapping is continuous, whether show the legend as discrete color bar or continuous color bar

+# -color_bar a string of "continous" or "discrete". If the mapping is continuous, whether show the legend as discrete color bar or continuous color bar

 # -grid_height height of each legend grid.

 # -grid_width width of each legend grid.

 # -border color for legend grid borders.

@@ -245,7 +245,7 @@ setMethod(f = "color_mapping_legend",

 	title = object@name,

 	title_gp = gpar(fontsize = 10, fontface = "bold"),

 	title_position = c("topleft", "topcenter", "leftcenter", "lefttop"),

-	color_bar = c("discrete", "continuous"),

+	color_bar = object@type,

 	grid_height = unit(4, "mm"),

 	grid_width = unit(4, "mm"),

 	border = NULL,

@@ -268,10 +268,10 @@ setMethod(f = "color_mapping_legend",

 	title_gp = check_gp(title_gp)

 	labels_gp = check_gp(labels_gp)

-	color_bar = match.arg(color_bar)

+	# color_bar = match.arg(color_bar)

 	if(object@type == "discrete" && color_bar == "continuous") {

-		stop("'color_bar' can only be set to 'continuous' only if the color mapping is continuous")

+		stop("'color_bar' can only be set to 'discrete' only if the color mapping is discrete")

 	}

 	# get labels

@@ -191,7 +191,7 @@ Heatmap = setClass("Heatmap",

 # -bottom_annotation_height total height of the column annotations on the bottom.

 # -km do k-means clustering on rows. If the value is larger than 1, the heatmap will be split by rows according to the k-means clustering.

 #     For each row-clusters, hierarchical clustering is still applied with parameters above.

-# -km_title row title for each cluster when ``km`` is set. It must a text with format of "*\%i*" where "\%i" is replaced by the index of the cluster.

+# -km_title row title for each cluster when ``km`` is set. It must a text with format of ".*\%i.*" where "\%i" is replaced by the index of the cluster.

 # -split a vector or a data frame by which the rows are split. But if ``cluster_rows`` is a clustering object, ``split`` can be a single number

 #        indicating rows are to be split according to the split on the tree.

 # -gap gap between row-slices if the heatmap is split by rows, should be `grid::unit` object. If it is a vector, the order corresponds

@@ -287,7 +287,7 @@ Heatmap = function(matrix, col, name,

     combined_name_fun = function(x) paste(x, collapse = "/"),

     width = NULL, 

     show_heatmap_legend = TRUE,

-    heatmap_legend_param = list(title = name, color_bar = "discrete"),

+    heatmap_legend_param = list(title = name),

     use_raster = FALSE, 

     raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF"),

     raster_quality = 1,

@@ -1445,7 +1445,7 @@ setMethod(f = "draw_dend",

     dend = as.dendrogram(hc)

     n = length(labels(dend))

-    if(nnodes(dend) <= 1) {

+    if(nobs(dend) <= 1) {

         return(invisible(NULL))

     }

@@ -135,7 +135,6 @@ Legend = function(at, labels = at, nrow = NULL, ncol = 1, col_fun,

 	# for(i in seq_len(length(odevlist) - length(dev.list()))) {

 	# 	dev.off()

 	# }

-

 	return(gf)

 }

@@ -44,6 +44,8 @@

 #

 decorate_heatmap_body = function(heatmap, code, slice = 1, envir = new.env(parent = parent.frame())) {

+	current_vp = current.viewport()$name

+	

 	if(is.null(slice)) {

 		vp_name = paste0(heatmap, "_heatmap_body_", 1)

 		seekViewport(vp_name)

@@ -55,7 +57,7 @@ decorate_heatmap_body = function(heatmap, code, slice = 1, envir = new.env(paren

 	eval(substitute(code), envir = envir)

-	seekViewport("global")

+	seekViewport(current_vp)

 }

 # == title

@@ -98,6 +100,8 @@ decorate_heatmap_body = function(heatmap, code, slice = 1, envir = new.env(paren

 decorate_dend = function(heatmap, code, slice = 1, which = c("column", "row"), 

 	envir = new.env(parent = parent.frame())) {

+	current_vp = current.viewport()$name

+	

 	which = match.arg(which)[1]

 	if(which == "column") {

 		vp_name = paste0(heatmap, "_dend_", which)

@@ -116,7 +120,7 @@ decorate_dend = function(heatmap, code, slice = 1, which = c("column", "row"),

 	e = new.env(parent = parent.frame())

 	eval(substitute(code), envir = e)

-	seekViewport("global")

+	seekViewport(current_vp)

 }

 # == title

@@ -212,6 +216,8 @@ decorate_row_dend = function(..., envir = new.env(parent = parent.frame())) {

 decorate_dimnames = function(heatmap, code, slice = 1, which = c("column", "row"), 

 	envir = new.env(parent = parent.frame())) {

+	current_vp = current.viewport()$name

+	

 	which = match.arg(which)[1]

 	if(which == "column") {

 		vp_name = paste0(heatmap, "_", which, "_names")

@@ -228,7 +234,7 @@ decorate_dimnames = function(heatmap, code, slice = 1, which = c("column", "row"

 	seekViewport(vp_name)

 	eval(substitute(code), envir = envir)

-	seekViewport("global")

+	seekViewport(current_vp)

 }

 # == title

@@ -312,6 +318,8 @@ decorate_column_names = function(..., envir = new.env(parent = parent.frame()))

 decorate_title = function(heatmap, code, slice = 1, which = c("column", "row"), 

 	envir = new.env(parent = parent.frame())) {

+	current_vp = current.viewport()$name

+	

 	which = match.arg(which)[1]

 	if(which == "column") {

 		vp_name = paste0(heatmap, "_", which, "_title")

@@ -328,7 +336,7 @@ decorate_title = function(heatmap, code, slice = 1, which = c("column", "row"),

 	seekViewport(vp_name)

 	eval(substitute(code), envir = envir)

-	seekViewport("global")

+	seekViewport(current_vp)

 }

 # == title

@@ -416,6 +424,8 @@ decorate_column_title = function(..., envir = new.env(parent = parent.frame()))

 #

 decorate_annotation = function(annotation, code, slice, envir = new.env(parent = parent.frame())) {

+	current_vp = current.viewport()$name

+	

 	if(missing(slice)) {

 		vp_name = paste0("annotation_", annotation)

 		o = try(seekViewport(vp_name), silent = TRUE)

@@ -440,6 +450,6 @@ decorate_annotation = function(annotation, code, slice, envir = new.env(parent =

 	}

 	eval(substitute(code), envir = envir)

-	seekViewport("global")

+	seekViewport(current_vp)

 }

@@ -16,7 +16,6 @@

 #                            Set it to ``NULL`` if you don't want to set the order

 # -column_order order of samples. By default the order is calculated by the 'memo sort' method which can visualize

 #                                 the mutual exclusivity across genes. Set it to ``NULL`` if you don't want to set the order

-# -show_column_names whether show column names

 # -show_pct whether show percent values on the left of the oncoprint

 # -pct_gp graphic paramters for percent row annotation

 # -pct_digits digits for percent values

@@ -26,8 +25,31 @@

 # -remove_empty_columns if there is no alteration in that sample, whether remove it on the heatmap

 # -heatmap_legend_param pass to `Heatmap`

 # -top_annotation by default the top annotation contains barplots representing frequency of mutations in every sample.

+# -top_annotation_height total height of the column annotations on the top.

+# -bottom_annotation a `HeatmapAnnotation` object.

+# -bottom_annotation_height total height of the column annotations on the bottom.

 # -barplot_ignore specific alterations that you don't want to put on the barplots. If you want to really suppress the top barplot

 #        set ``top_annotation`` to ``NULL``.

+# -row_title title on row.

+# -row_title_side will the title be put on the left or right of the heatmap?

+# -row_title_gp graphic parameters for drawing text.

+# -row_title_rot rotation of row titles. Only 0, 90, 270 are allowed to set.

+# -column_title title on column.

+# -column_title_side will the title be put on the top or bottom of the heatmap?

+# -column_title_gp graphic parameters for drawing text.

+# -column_title_rot rotation of column titles. Only 0, 90, 270 are allowed to set.

+# -show_row_names whether show row names.

+# -row_names_gp graphic parameters for drawing text.

+# -show_column_names whether show column names.

+# -column_names_gp graphic parameters for drawing text.

+# -split a vector or a data frame by which the rows are split. But if ``cluster_rows`` is a clustering object, ``split`` can be a single number

+#        indicating rows are to be split according to the split on the tree.

+# -gap gap between row-slices if the heatmap is split by rows, should be `grid::unit` object. If it is a vector, the order corresponds

+#   to top to bottom in the heatmap

+# -combined_name_fun if the heatmap is split by rows, how to make a combined row title for each slice?

+#                 The input parameter for this function is a vector which contains level names under each column in ``split``.

+# -width the width of the single heatmap, should be a fixed `grid::unit` object. It is used for the layout when the heatmap

+#        is appended to a list of heatmaps.

 # -... pass to `Heatmap`, so can set ``bottom_annotation`` here.

 #

 # == details

@@ -51,8 +73,7 @@ oncoPrint = function(mat, get_type = function(x) x,

 	alter_fun = alter_fun_list, alter_fun_list = NULL, col, 

 	row_order = oncoprint_row_order(),

 	column_order = oncoprint_column_order(),

-	show_column_names = FALSE,

-	show_pct = TRUE, pct_gp = gpar(), pct_digits = 0,

+	show_pct = TRUE, pct_gp = row_names_gp, pct_digits = 0,

 	axis_gp = gpar(fontsize = 8), 

 	show_row_barplot = TRUE, 

 	row_barplot_width = unit(2, "cm"),

@@ -60,7 +81,26 @@ oncoPrint = function(mat, get_type = function(x) x,

 	heatmap_legend_param = list(title = "Alterations"),

 	top_annotation = HeatmapAnnotation(column_bar = anno_oncoprint_barplot(), 

 		annotation_height = unit(2, "cm")),

-	barplot_ignore = NULL,

+	top_annotation_height = top_annotation@size,

+	bottom_annotation = new("HeatmapAnnotation"),

+    bottom_annotation_height = bottom_annotation@size,

+    barplot_ignore = NULL,

+	row_title = character(0),

+    row_title_side = c("left", "right"),

+    row_title_gp = gpar(fontsize = 14),

+    row_title_rot = switch(row_title_side[1], "left" = 90, "right" = 270),

+    column_title = character(0),

+    column_title_side = c("top", "bottom"),

+    column_title_gp = gpar(fontsize = 14),

+    column_title_rot = 0,

+    show_row_names = TRUE,

+    row_names_gp = gpar(fontsize = 12),

+    show_column_names = FALSE,

+    column_names_gp = gpar(fontsize = 12),

+    split = NULL,

+    gap = unit(1, "mm"),

+    combined_name_fun = function(x) paste(x, collapse = "/"),

+    width = NULL,

 	...) {

 	if(length(names(list(...))) > 0) {

@@ -282,9 +322,29 @@ oncoPrint = function(mat, get_type = function(x) x,

 			z = arr[i, j, ]

 			names(z) = dimnames(arr)[[3]]

 			af(x, y, width, height, z)

-		}, show_column_names = show_column_names,

+		},

 		top_annotation = top_annotation,

-		heatmap_legend_param = heatmap_legend_param, ...)

+		top_annotation_height = top_annotation_height,

+		bottom_annotation = bottom_annotation,

+		bottom_annotation_height = bottom_annotation_height,

+		row_title = row_title,

+		row_title_side = row_title_side,

+		row_title_gp = row_names_gp,

+		row_title_rot = row_title_rot,

+		column_title = column_title,

+		column_title_side = column_title_side,

+		column_title_gp = column_title_gp,

+		column_title_rot = column_title_rot,

+		show_row_names = show_row_names,

+		row_names_gp = row_names_gp,

+		show_column_names = show_column_names,

+		column_names_gp = column_names_gp,

+		heatmap_legend_param = heatmap_legend_param, 

+		split = split,

+		gap = gap,

+		combined_name_fun = combined_name_fun,

+		width = width,

+		...)

 	ht@matrix_param$oncoprint = list()

 	ht@matrix_param$oncoprint$arr = arr

@@ -2,11 +2,20 @@

 # environment that contains global variables

 INDEX_ENV = new.env()

+INDEX_ENV$I_FIGURE = 0

 INDEX_ENV$I_HEATMAP = 0

 INDEX_ENV$I_ANNOTATION = 0

 INDEX_ENV$I_ROW_ANNOTATION = 0

 INDEX_ENV$I_COLOR_MAPPING = 0

+get_figure_index = function() {

+    INDEX_ENV$I_FIGURE

+}

+

+increase_figure_index = function() {

+    INDEX_ENV$I_FIGURE = INDEX_ENV$I_FIGURE + 1

+}

+

 get_heatmap_index = function() {

 	INDEX_ENV$I_HEATMAP

 }

@@ -124,8 +133,6 @@ grid.dendrogram = function(dend, facing = c("bottom", "top", "left", "right"),

             leaf

         }

     }

-

-    labels(dend) = paste0("leaf_", seq_len(nnodes(dend)))

     draw.d = function(dend, max_height, facing = "bottom", order = "normal", max_width = 0, env = NULL) {

         leaf = attr(dend, "leaf")

@@ -275,6 +282,287 @@ grid.dendrogram = function(dend, facing = c("bottom", "top", "left", "right"),

     }

 }

+# == title

+# Adjust dendrogram based on width of leaves

+#

+# == param

+# -dend a `stats::dendrogram` object.

+# -width a vector of width. The order of width SHOULD be same as the order of original elements before clustering.

+# -offset offset to x = 0

+#

+# == details

+# In the standard `stats::dendrogram` object, leaves locate at x = 0.5, 1.5, ..., n - 0.5,

+# which means, the width of leaves are always 1 and the distance to neighbouring leaves is always 1 as well.

+# Here `adjust_dend_by_leaf_width` adjusts the dendrogram by setting different width for leaves so that leaves

+# have unequal distance to other leaves.

+#

+# The adjusted dendrogram can be sent to `grid.dendrogram2` to make the dendrogram.

+#

+# For each branch as well each leaf, a new attribute of ``x`` is added which is the position of the middle point or the leaf.

+# For each leaf, a new attribute of ``width`` is added which is the width of current leaf.

+#

+# == value

+# A `stats::dendrogram` object. The adjustment will not affect other standard dendrogram functions.

+#

+# == author

+# Zuguang Gu <z.gu@dkfz.de>

+#

+# == example

+# m = matrix(rnorm(100), 10)

+# dend = as.dendrogram(hclust(dist(m)))

+# dend = adjust_dend_by_leaf_width(dend, width = 1:10)

+# require(dendextend)

+# get_leaves_attr(dend, "label")

+# get_leaves_attr(dend, "width")

+# get_leaves_attr(dend, "x")

+adjust_dend_by_leaf_width = function(dend, width = 1, offset = 0) {

+    n = nobs(dend)

+

+    if(length(width) == 1) {

+        width = rep(width, n)

+    }

+

+    if(identical(width, rep(1, n))) {

+        return(dend)

+    }

+

+    if(length(width) != n) {

+        stop("length of `width` should be same as `dend`.")

+    }

+

+    dend_order = order.dendrogram(dend)

+    leaves_pos = cumsum(width[dend_order]) - width[dend_order]/2 + offset

+    label2index = structure(dend_order, names = labels(dend))

+

+    env = new.env()

+    env$dend = dend

+

+    adj_dend = function(ind = NULL) {

+        if(is.null(ind)) {

+            d = env$dend

+        } else {

+            d = env$dend[[ind]]

+        }

+        

+        if(is.leaf(d)) {

+            i = which(labels(dend) == attr(d, "label"))

+            x = leaves_pos[i]

+            attr(env$dend[[ind]], "width") = width[dend_order[i]]

+        } else {

+            x = ( adj_dend(c(ind, 1)) + adj_dend(c(ind, 2)) )/2

+        }

+

+        if(is.null(ind)) {

+            attr(env$dend, "x") = x

+        } else {

+            attr(env$dend[[ind]], "x") = x

+        }

+        return(x)

+    }

+

+    adj_dend()

+    attr(env$dend, "width_adjusted") = TRUE

+    attr(env$dend, "offset") = offset

+

+    return(env$dend)

+}

+

+

+# == title

+# Draw dendrogram under grid system

+#

+# == param

+# -dend a `stats::dendrogram` object which has been adjusted by `adjust_dend_by_leaf_width`, or else

+#      it will be sent back to `grid.dendrogram`.

+# -facing same as in `grid.dendrogram`.

+# -max_height same as in `grid.dendrogram`.

+# -order same as in `grid.dendrogram`.

+# -... same as in `grid.dendrogram`.

+#

+# == author

+# Zuguang gu <z.gu@dkfz.de>

+#

+# == example

+# m = matrix(rnorm(100), 10)

+# dend = as.dendrogram(hclust(dist(m)))

+# dend = adjust_dend_by_leaf_width(dend, width = 1:10)

+# grid.dendrogram2(dend)

+grid.dendrogram2 = function(dend, facing = c("bottom", "top", "left", "right"), 

+    max_height = NULL, order = c("normal", "reverse"), ...) {

+

+    if(is.null(attr(dend, "width_adjusted"))) {

+        grid.dendrogram(dend, facing = facing, max_height = max_height, order = order, ...)

+        return(invisible(NULL))

+    }

+    

+    facing = match.arg(facing)[1]

+

+    if(is.null(max_height)) {

+        max_height = attr(dend, "height")

+    }

+    

+    if(max_height == 0) {

+        return(invisible(NULL))

+    }

+

+    is.leaf = function(object) {

+        leaf = attr(object, "leaf")

+        if(is.null(leaf)) {

+            FALSE

+        } else {

+            leaf

+        }

+    }

+    

+    draw.d = function(dend, max_height, facing = "bottom", order = "normal", max_width = 0, env = NULL) {

+

+        d1 = dend[[1]]  # child tree 1

+        d2 = dend[[2]]  # child tree 2

+        height = attr(dend, "height")

+        

+        x1 = attr(d1, "x")

+        y1 = attr(d1, "height")

+        

+        x2 = attr(d2, "x")

+        y2 = attr(d2, "height")

+        midpoint = (x1 + x2)/2

+

+        # graphic parameters for current branch

+        edge_gp1 = as.list(attr(d1, "edgePar"))

+        edge_gp2 = as.list(attr(d2, "edgePar"))

+

+        if(is.null(env)) {

+            begin = TRUE

+            env = new.env()

+            n = nobs(dend)

+            env$x0 = NULL

+            env$y0 = NULL

+            env$x1 = NULL

+            env$y1 = NULL

+            env$col = NULL

+            env$lty = NULL

+            env$lwd = NULL

+        } else {

+            begin = FALSE

+        }

+

+        for(gp_name in c("col", "lwd", "lty")) {

+            if(is.null(edge_gp1[[gp_name]])) {

+                env[[gp_name]] = c(env[[gp_name]], rep(get.gpar(gp_name)[[gp_name]], 2))

+            } else {

+                env[[gp_name]] = c(env[[gp_name]], rep(edge_gp1[[gp_name]], 2))

+            }

+            if(is.null(edge_gp2[[gp_name]])) {

+                env[[gp_name]] = c(env[[gp_name]], rep(get.gpar(gp_name)[[gp_name]], 2))

+            } else {

+                env[[gp_name]] = c(env[[gp_name]], rep(edge_gp2[[gp_name]], 2))

+            }

+        }

+

+        # plot the connection line

+        if(order == "normal") {

+            if(facing == "bottom") {

+                # grid.lines(c(x1, x1, (x1+x2)/2), c(y1, height, height), default.units = "native", gp = edge_gp1)

+                # grid.lines(c(x2, x2, (x1+x2)/2), c(y2, height, height), default.units = "native", gp = edge_gp2)

+                env$x0 = c(env$x0, c(x1, x1, x2, x2))

+                env$y0 = c(env$y0, c(y1, height, y2, height))

+                env$x1 = c(env$x1, c(x1, (x1+x2)/2, x2, (x1+x2)/2))

+                env$y1 = c(env$y1, c(height, height, height, height))

+            } else if(facing == "top") {

+                # grid.lines(c(x1, x1, (x1+x2)/2), max_height - c(y1, height, height), default.units = "native", gp = edge_gp1)

+                # grid.lines(c(x2, x2, (x1+x2)/2), max_height - c(y2, height, height), default.units = "native", gp = edge_gp2)

+                env$x0 = c(env$x0, c(x1, x1, x2, x2))

+                env$y0 = c(env$y0, max_height - c(y1, height, y2, height))

+                env$x1 = c(env$x1, c(x1, (x1+x2)/2, x2, (x1+x2)/2))

+                env$y1 = c(env$y1, max_height - c(height, height, height, height))

+            } else if(facing == "right") {

+                # grid.lines(max_height - c(y1, height, height), c(x1, x1, (x1+x2)/2), default.units = "native", gp = edge_gp1)

+                # grid.lines(max_height - c(y2, height, height), c(x2, x2, (x1+x2)/2), default.units = "native", gp = edge_gp2)

+                env$x0 = c(env$x0, max_height - c(y1, height, y2, height))

+                env$y0 = c(env$y0, c(x1, x1, x2, x2))

+                env$x1 = c(env$x1, max_height - c(height, height, height, height))

+                env$y1 = c(env$y1, c(x1, (x1+x2)/2, x2, (x1+x2)/2))

+            } else if(facing == "left") {

+                # grid.lines(c(y1, height, height), c(x1, x1, (x1+x2)/2), default.units = "native", gp = edge_gp1)

+                # grid.lines(c(y2, height, height), c(x2, x2, (x1+x2)/2), default.units = "native", gp = edge_gp2)

+                env$x0 = c(env$x0, c(y1, height, y2, height))

+                env$y0 = c(env$y0, c(x1, x1, x2, x2))

+                env$x1 = c(env$x1, c(height, height, height, height))

+                env$y1 = c(env$y1, c(x1, (x1+x2)/2, x2, (x1+x2)/2))

+            }

+        } else {

+            if(facing == "bottom") {

+                # grid.lines(max_width - c(x1, x1, (x1+x2)/2), c(y1, height, height), default.units = "native", gp = edge_gp1)

+                # grid.lines(max_width - c(x2, x2, (x1+x2)/2), c(y2, height, height), default.units = "native", gp = edge_gp2)

+                env$x0 = c(env$x0, max_width - c(x1, x1, x2, x2))

+                env$y0 = c(env$y0, c(y1, height, y2, height))

+                env$x1 = c(env$x1, max_width - c(x1, (x1+x2)/2, x2, (x1+x2)/2))

+                env$y1 = c(env$y1, c(height, height, height, height))

+            } else if(facing == "top") {

+                # grid.lines(max_width - c(x1, x1, (x1+x2)/2), max_height - c(y1, height, height), default.units = "native", gp = edge_gp1)

+                # grid.lines(max_width - c(x2, x2, (x1+x2)/2), max_height - c(y2, height, height), default.units = "native", gp = edge_gp2)

+                env$x0 = c(env$x0, max_width - c(x1, x1, x2, x2))

+                env$y0 = c(env$y0, max_height - c(y1, height, y2, height))

+                env$x1 = c(env$x1, max_width - c(x1, (x1+x2)/2, x2, (x1+x2)/2))

+                env$y1 = c(env$y1, max_height - c(height, height, height, height))

+            } else if(facing == "right") {

+                # grid.lines(max_height - c(y1, height, height), max_width - c(x1, x1, (x1+x2)/2), default.units = "native", gp = edge_gp1)

+                # grid.lines(max_height - c(y2, height, height), max_width - c(x2, x2, (x1+x2)/2), default.units = "native", gp = edge_gp2)

+                env$x0 = c(env$x0, max_height - c(y1, height, y2, height))

+                env$y0 = c(env$y0, max_width - c(x1, x1, x2, x2))

+                env$x1 = c(env$x1, max_height - c(height, height, height, height))

+                env$y1 = c(env$y1, max_width - c(x1, (x1+x2)/2, x2, (x1+x2)/2))

+            } else if(facing == "left") {

+                # grid.lines(c(y1, height, height), max_width - c(x1, x1, (x1+x2)/2), default.units = "native", gp = edge_gp1)

+                # grid.lines(c(y2, height, height), max_width - c(x2, x2, (x1+x2)/2), default.units = "native", gp = edge_gp2)

+                env$x0 = c(env$x0, c(y1, height, y2, height))

+                env$y0 = c(env$y0, max_width - c(x1, x1, x2, x2))

+                env$x1 = c(env$x1, c(height, height, height, height))

+                env$y1 = c(env$y1, max_width - c(x1, (x1+x2)/2, x2, (x1+x2)/2))

+            }

+        }

+        # do it recursively

+        if(!is.leaf(d1)) {

+            draw.d(d1, max_height, facing, order, max_width, env = env)

+        } else {

+            grid.rect(x1, width = attr(d1, "width"), default.units = "native", gp = gpar(fill = rand_color(1, transparency = 0.5)))

+        }

+        if(!is.leaf(d2)) {

+            draw.d(d2, max_height, facing, order, max_width, env = env)

+        } else {

+            grid.rect(x2, width = attr(d2, "width"), default.units = "native", gp = gpar(fill = rand_color(1, transparency = 0.5)))

+        }

+

+        if(begin) {

+            grid.segments(env$x0, env$y0, env$x1, env$y1, default.units = "native", gp = gpar(col = env$col, lty = env$lty, lwd = env$lwd))

+        }

+    }

+

+    sum_width = sum(.get_leaves_width(dend))

+    order = match.arg(order)[1]

+    offset = attr(dend, "offset")

+    

+    if(facing %in% c("top", "bottom")) {

+        pushViewport(viewport(xscale = c(0, sum_width) + offset, yscale = c(0, max_height), ...))

+        draw.d(dend, max_height, facing, order, max_width = sum_width)

+        upViewport()

+    } else if(facing %in% c("right", "left")) {

+        pushViewport(viewport(yscale = c(0, sum_width) + offset, xscale = c(0, max_height), ...))

+        draw.d(dend, max_height, facing, order, max_width = sum_width)

+        upViewport()

+    }

+}

+

+.get_leaves_width = function(d, v = NULL) {

+    if(is.leaf(d)) {

+        v = c(v, attr(d, "width"))

+    } else {

+        v = .get_leaves_width(d[[1]], v)

+        v = .get_leaves_width(d[[2]], v)

+    }

+    return(v)

+}

+

 # == title

 # Calculate pairwise distance from a matrix

 #

@@ -366,12 +654,21 @@ get_dend_order = function(x) {

 # can only cut dendrogram for which branches at every node are two

 cut_dendrogram = function(dend, k) {

-    h = sort(get_branches_heights(dend), decreasing = TRUE)

+    h = sort(dend_branches_heights(dend), decreasing = TRUE)

     height = (h[k-1] + h[k])/2

     trees = cut(dend, h = height)

     trees$lower

 }

+dend_branches_heights = function(d, v = NULL) {

+    if(!is.leaf(d)) {

+        v = c(v, attr(d, "height"))

+        v = dend_branches_heights(d[[1]], v)

+        v = dend_branches_heights(d[[2]], v)

+    }

+    return(v)

+}

+

 recycle_gp = function(gp, n = 1) {

     for(i in seq_along(gp)) {

         x = gp[[i]]

@@ -67,7 +67,7 @@ Heatmap(matrix, col, name,

     combined_name_fun = function(x) paste(x, collapse = "/"),

     width = NULL,

     show_heatmap_legend = TRUE,

-    heatmap_legend_param = list(title = name, color_bar = "discrete"),

+    heatmap_legend_param = list(title = name),

     use_raster = FALSE,

     raster_device = c("png", "jpeg", "tiff", "CairoPNG", "CairoJPEG", "CairoTIFF"),

     raster_quality = 1,

@@ -131,7 +131,7 @@ Heatmap(matrix, col, name,

   \item{bottom_annotation}{a \code{\link{HeatmapAnnotation}} object.}

   \item{bottom_annotation_height}{total height of the column annotations on the bottom.}

   \item{km}{do k-means clustering on rows. If the value is larger than 1, the heatmap will be split by rows according to the k-means clustering. For each row-clusters, hierarchical clustering is still applied with parameters above.}

-  \item{km_title}{row title for each cluster when \code{km} is set. It must a text with format of "*\%i*" where "\%i" is replaced by the index of the cluster.}

+  \item{km_title}{row title for each cluster when \code{km} is set. It must a text with format of ".*\%i.*" where "\%i" is replaced by the index of the cluster.}

   \item{split}{a vector or a data frame by which the rows are split. But if \code{cluster_rows} is a clustering object, \code{split} can be a single number indicating rows are to be split according to the split on the tree.}

   \item{gap}{gap between row-slices if the heatmap is split by rows, should be \code{\link[grid]{unit}} object. If it is a vector, the order corresponds to top to bottom in the heatmap}

   \item{combined_name_fun}{if the heatmap is split by rows, how to make a combined row title for each slice? The input parameter for this function is a vector which contains level names under each column in \code{split}.}

new file mode 100644

@@ -0,0 +1,44 @@

+\name{adjust_dend_by_leaf_width}

+\alias{adjust_dend_by_leaf_width}

+\title{

+Adjust dendrogram based on width of leaves

+}

+\description{

+Adjust dendrogram based on width of leaves

+}

+\usage{

+adjust_dend_by_leaf_width(dend, width = 1, offset = 0)

+}

+\arguments{

+

+  \item{dend}{a \code{\link[stats]{dendrogram}} object.}

+  \item{width}{a vector of width. The order of width SHOULD be same as the order of original elements before clustering.}

+  \item{offset}{offset to x = 0}

+

+}

+\details{

+In the standard \code{\link[stats]{dendrogram}} object, leaves locate at x = 0.5, 1.5, ..., n - 0.5,

+which means, the width of leaves are always 1 and the distance to neighbouring leaves is always 1 as well.

+Here \code{\link{adjust_dend_by_leaf_width}} adjusts the dendrogram by setting different width for leaves so that leaves

+have unequal distance to other leaves.

+

+The adjusted dendrogram can be sent to \code{\link{grid.dendrogram2}} to make the dendrogram.

+

+For each branch as well each leaf, a new attribute of \code{x} is added which is the position of the middle point or the leaf.

+For each leaf, a new attribute of \code{width} is added which is the width of current leaf.

+}

+\value{

+A \code{\link[stats]{dendrogram}} object. The adjustment will not affect other standard dendrogram functions.

+}

+\author{

+Zuguang Gu <z.gu@dkfz.de>

+}

+\examples{

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

+dend = as.dendrogram(hclust(dist(m)))

+dend = adjust_dend_by_leaf_width(dend, width = 1:10)

+require(dendextend)

+get_leaves_attr(dend, "label")

+get_leaves_attr(dend, "width")

+get_leaves_attr(dend, "x")

+}

@@ -13,7 +13,7 @@ Draw legend based on color mapping

     title = object@name,

     title_gp = gpar(fontsize = 10, fontface = "bold"),

     title_position = c("topleft", "topcenter", "leftcenter", "lefttop"),

-    color_bar = c("discrete", "continuous"),

+    color_bar = object@type,

     grid_height = unit(4, "mm"),

     grid_width = unit(4, "mm"),

     border = NULL,

@@ -33,7 +33,7 @@ Draw legend based on color mapping

   \item{title}{title of the legend, by default it is the name of the legend}

   \item{title_gp}{graphical parameters for legend title}

   \item{title_position}{position of the title}

-  \item{color_bar}{if the mapping is continuous, whether show the legend as discrete color bar or continuous color bar}

+  \item{color_bar}{a string of "continous" or "discrete". If the mapping is continuous, whether show the legend as discrete color bar or continuous color bar}

   \item{grid_height}{height of each legend grid.}

   \item{grid_width}{width of each legend grid.}

   \item{border}{color for legend grid borders.}

new file mode 100644

@@ -0,0 +1,30 @@

+\name{grid.dendrogram2}

+\alias{grid.dendrogram2}

+\title{

+Draw dendrogram under grid system

+}

+\description{

+Draw dendrogram under grid system

+}

+\usage{

+grid.dendrogram2(dend, facing = c("bottom", "top", "left", "right"),

+    max_height = NULL, order = c("normal", "reverse"), ...)

+}

+\arguments{

+

+  \item{dend}{a \code{\link[stats]{dendrogram}} object which has been adjusted by \code{\link{adjust_dend_by_leaf_width}}, or else it will be sent back to \code{\link{grid.dendrogram}}.}

+  \item{facing}{same as in \code{\link{grid.dendrogram}}.}

+  \item{max_height}{same as in \code{\link{grid.dendrogram}}.}

+  \item{order}{same as in \code{\link{grid.dendrogram}}.}

+  \item{...}{same as in \code{\link{grid.dendrogram}}.}

+

+}

+\author{

+Zuguang gu <z.gu@dkfz.de>

+}

+\examples{

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

+dend = as.dendrogram(hclust(dist(m)))

+dend = adjust_dend_by_leaf_width(dend, width = 1:10)

+grid.dendrogram2(dend)

+}

@@ -11,8 +11,7 @@ oncoPrint(mat, get_type = function(x) x,

     alter_fun = alter_fun_list, alter_fun_list = NULL, col,

     row_order = oncoprint_row_order(),

     column_order = oncoprint_column_order(),

-    show_column_names = FALSE,

-    show_pct = TRUE, pct_gp = gpar(), pct_digits = 0,

+    show_pct = TRUE, pct_gp = row_names_gp, pct_digits = 0,

     axis_gp = gpar(fontsize = 8),

     show_row_barplot = TRUE,

     row_barplot_width = unit(2, "cm"),

@@ -20,7 +19,26 @@ oncoPrint(mat, get_type = function(x) x,

     heatmap_legend_param = list(title = "Alterations"),

     top_annotation = HeatmapAnnotation(column_bar = anno_oncoprint_barplot(),

     annotation_height = unit(2, "cm")),

+    top_annotation_height = top_annotation@size,

+    bottom_annotation = new("HeatmapAnnotation"),

+    bottom_annotation_height = bottom_annotation@size,

     barplot_ignore = NULL,

+    row_title = character(0),

+    row_title_side = c("left", "right"),

+    row_title_gp = gpar(fontsize = 14),

+    row_title_rot = switch(row_title_side[1], "left" = 90, "right" = 270),

+    column_title = character(0),

+    column_title_side = c("top", "bottom"),

+    column_title_gp = gpar(fontsize = 14),

+    column_title_rot = 0,

+    show_row_names = TRUE,

+    row_names_gp = gpar(fontsize = 12),

+    show_column_names = FALSE,

+    column_names_gp = gpar(fontsize = 12),

+    split = NULL,

+    gap = unit(1, "mm"),

+    combined_name_fun = function(x) paste(x, collapse = "/"),

+    width = NULL,

     ...)

 }

 \arguments{

@@ -32,7 +50,6 @@ oncoPrint(mat, get_type = function(x) x,

   \item{col}{a vector of color for which names correspond to alteration types.}

   \item{row_order}{order of genes. By default it is sorted by frequency of alterations decreasingly. Set it to \code{NULL} if you don't want to set the order}

   \item{column_order}{order of samples. By default the order is calculated by the 'memo sort' method which can visualize the mutual exclusivity across genes. Set it to \code{NULL} if you don't want to set the order}

-  \item{show_column_names}{whether show column names}

   \item{show_pct}{whether show percent values on the left of the oncoprint}

   \item{pct_gp}{graphic paramters for percent row annotation}

   \item{pct_digits}{digits for percent values}

@@ -42,7 +59,26 @@ oncoPrint(mat, get_type = function(x) x,

   \item{remove_empty_columns}{if there is no alteration in that sample, whether remove it on the heatmap}

   \item{heatmap_legend_param}{pass to \code{\link{Heatmap}}}

   \item{top_annotation}{by default the top annotation contains barplots representing frequency of mutations in every sample.}

+  \item{top_annotation_height}{total height of the column annotations on the top.}

+  \item{bottom_annotation}{a \code{\link{HeatmapAnnotation}} object.}

+  \item{bottom_annotation_height}{total height of the column annotations on the bottom.}

   \item{barplot_ignore}{specific alterations that you don't want to put on the barplots. If you want to really suppress the top barplot set \code{top_annotation} to \code{NULL}.}

+  \item{row_title}{title on row.}

+  \item{row_title_side}{will the title be put on the left or right of the heatmap?}

+  \item{row_title_gp}{graphic parameters for drawing text.}

+  \item{row_title_rot}{rotation of row titles. Only 0, 90, 270 are allowed to set.}

+  \item{column_title}{title on column.}

+  \item{column_title_side}{will the title be put on the top or bottom of the heatmap?}

+  \item{column_title_gp}{graphic parameters for drawing text.}

+  \item{column_title_rot}{rotation of column titles. Only 0, 90, 270 are allowed to set.}

+  \item{show_row_names}{whether show row names.}

+  \item{row_names_gp}{graphic parameters for drawing text.}

+  \item{show_column_names}{whether show column names.}

+  \item{column_names_gp}{graphic parameters for drawing text.}

+  \item{split}{a vector or a data frame by which the rows are split. But if \code{cluster_rows} is a clustering object, \code{split} can be a single number indicating rows are to be split according to the split on the tree.}

+  \item{gap}{gap between row-slices if the heatmap is split by rows, should be \code{\link[grid]{unit}} object. If it is a vector, the order corresponds to top to bottom in the heatmap}

+  \item{combined_name_fun}{if the heatmap is split by rows, how to make a combined row title for each slice? The input parameter for this function is a vector which contains level names under each column in \code{split}.}

+  \item{width}{the width of the single heatmap, should be a fixed \code{\link[grid]{unit}} object. It is used for the layout when the heatmap is appended to a list of heatmaps.}

   \item{...}{pass to \code{\link{Heatmap}}, so can set \code{bottom_annotation} here.}

 }

@@ -157,32 +157,36 @@ ht1 = Heatmap(mat, name = "ht1", show_heatmap_legend = FALSE)

 draw(ht1 + ha_chr, heatmap_legend_side = "bottom")

 ```

-If you don't like the default discrete color bar for continuous values, you can specify `color_bar` to `continuous`.

-For the simple annotation which contains continuous values, `color_bar` can also be set to `continuous`.

+Discrete color bar for can be used for continuous values, if you specify `color_bar` to `discrete`.

+For the simple annotation which contains continuous values, `color_bar` can also be set to `discrete`.

 ```{r}

 ha = HeatmapAnnotation(df = data.frame(value = runif(10)), 

     col = list(value = colorRamp2(c(0, 1), c("white", "blue"))), 

-    annotation_legend_param = list(color_bar = "continuous", at = c(0, 0.5, 1), 

-        labels = c("low", "median", "high"), legend_height = unit(4, "cm")))

-Heatmap(mat, name = "ht1", top_annotation = ha, heatmap_legend_param = list(color_bar = "continuous"))