use unitType(, recurse=T) to test absolute units

DESCRIPTION

@@ -2,7 +2,7 @@ Package: ComplexHeatmap
 Type: Package
 Title: Make Complex Heatmaps
 Version: 2.3.2
-Date: 2020-02-05
+Date: 2020-03-05
 Author: Zuguang Gu
 Maintainer: Zuguang Gu <z.gu@dkfz.de>
 Depends: R (>= 3.1.2), methods, grid, graphics, stats, grDevices

LICENSE

@@ -1,3 +1,3 @@
-YEAR: 2019
+YEAR: 2020
 COPYRIGHT HOLDER: Zuguang Gu
 

NEWS

@@ -1,6 +1,8 @@
 CHANGES in VERSION 2.3.2
 
 * `anno_simple()`: fixed a bug when pch are all NA in a slice
+* adjust code according to grid 4.0.
+* move scripts in test_not_run/ to tests/ folder
 
 ========================
 

R/grid.dendrogram.R

@@ -229,12 +229,14 @@ dendrogramGrob = function(dend, facing = c("bottom", "top", "left", "right"),
         lt$y1 = unit(1, "npc") - unit(lt$y1, "native")
     }
     if(facing %in% c("bottom", "top")) {
-        segmentsGrob(lt$x0, lt$y0, lt$x1, lt$y1, gp = gpar(lwd = lt$lwd, lty = lt$lty, col = lt$col),
+        gb = segmentsGrob(lt$x0, lt$y0, lt$x1, lt$y1, gp = gpar(lwd = lt$lwd, lty = lt$lty, col = lt$col),
             default.units = "native")
     } else if(facing %in% c("left", "right")) {
-        segmentsGrob(lt$y0, lt$x0, lt$y1, lt$x1, gp = gpar(lwd = lt$lwd, lty = lt$lty, col = lt$col),
+        gb = segmentsGrob(lt$y0, lt$x0, lt$y1, lt$x1, gp = gpar(lwd = lt$lwd, lty = lt$lty, col = lt$col),
             default.units = "native")
     }
+    gb$facing = facing
+    return(gb)
 }
 
 # == title
@@ -272,20 +274,15 @@ dendrogramGrob = function(dend, facing = c("bottom", "top", "left", "right"),
 grid.dendrogram = function(dend, ..., test = FALSE) {
     gb = dendrogramGrob(dend, ...)
     if(test) {
-        ylim = range(gb[c("y0", "y1")])
-        ylim[1] = - 0.05*(ylim[2] - ylim[1])
-        ylim[2] = ylim[2] + 0.05*ylim[2]
+        h = dend_heights(dend)
+        n = nobs(dend)
         grid.newpage()
-        if(is_abs_unit(gb$x0[1]) && !identical("native", attr(gb$x0[1], "unit"))) {
-            width = max(unit.c(gb$x0, gb$x1))
-            pushViewport(viewport(yscale = ylim, 
-                width = width*1.1, 
+        if(gb$facing %in% c("top", "bottom")) {
+           pushViewport(viewport(xscale = c(-0.5, n + 0.5), yscale = c(-h*0.05, h*1.05), 
+                width = unit(1, "npc") - unit(4, "cm"), 
                 height = unit(1, "npc") - unit(4, "cm")))
         } else {
-            xlim = range(gb[c("x0", "x1")])
-            xlim[1] = xlim[1] - 0.05*(xlim[2] - xlim[1])
-            xlim[2] = xlim[2] + 0.05*(xlim[2] - xlim[1])
-            pushViewport(viewport(xscale = xlim, yscale = ylim, 
+            pushViewport(viewport(yscale = c(-0.5, n + 0.5), xscale = c(-h*0.05, h*1.05), 
                 width = unit(1, "npc") - unit(4, "cm"), 
                 height = unit(1, "npc") - unit(4, "cm")))
         }

R/is_abs_unit.R

@@ -1,18 +1,20 @@
 
 # is_abs_unit = function(x) UseMethod("is_abs_unit")
 
+abs_units = c("cm", "inches", "mm", "points", "picas", "bigpts", "dida", "cicero",
+		               "scaledpts", "lines", "char", "strwidth", "strheight", "grobwidth",
+		               "grobheight", "strascent", "strdescent", "mylines", "mychar", 
+		               "mystrwidth", "mystrheight", "centimetre", "centimetres", "centimeter",
+		               "centimeters", "in", "inch", "line", "millimetre", "millimetres",
+		               "millimeter", "millimeters", "point", "pt")
+
 # grid::absolute.size() treats grobwidth and grobheight as non-absolute units,
 # thus, I write another function to test
 .is_abs_unit.unit = function(x) {
 
 	unit = unitType(x)
 
-	if(all(unit %in% c("cm", "inches", "mm", "points", "picas", "bigpts", "dida", "cicero",
-		               "scaledpts", "lines", "char", "strwidth", "strheight", "grobwidth",
-		               "grobheight", "strascent", "strdescent", "mylines", "mychar", 
-		               "mystrwidth", "mystrheight", "centimetre", "centimetres", "centimeter",
-		               "centimeters", "in", "inch", "line", "millimetre", "millimetres",
-		               "millimeter", "millimeters", "point", "pt"))) {
+	if(all(unit %in% abs_units)) {
 		return(TRUE)
 	} else {
 		return(FALSE)
@@ -78,15 +80,9 @@ is_abs_unit_v3 = function(u) {
 }
 
 is_abs_unit_v4 = function(u) {
-	if(inherits(u, "simpleUnit")) {
-		.is_abs_unit.unit(u)
-	} else {
-		if(unitType(u) %in% c("sum", "min", "max")) {
-			all(sapply(unclass(u)[[1]][[2]], is_abs_unit_v4))
-		} else {
-			.is_abs_unit.unit(u)
-		}
-	}
+	u = unitType(u, recurse = TRUE)
+	u = unlist(u)
+	all(u %in% abs_units)
 }
 
 if(getRversion() >= "4.0.0") {

tests/test-plot-all.R

@@ -0,0 +1,10 @@
+suppressWarnings(suppressPackageStartupMessages(library(ComplexHeatmap)))
+library(circlize)
+library(GetoptLong)
+
+## test the scripts in test-plot folder
+for(f in list.files("test-plot", full.names = TRUE)) {
+	pdf(NULL)
+	source(f)
+	dev.off()
+}

tests/test-plot/test-AnnotationFunction.R

@@ -1,3 +1,16 @@
+library(circlize)
+
+if(!exists("normalize_graphic_param_to_mat")) {
+	normalize_graphic_param_to_mat = ComplexHeatmap:::normalize_graphic_param_to_mat
+}
+
+if(!exists("height")) {
+	height = ComplexHeatmap:::height
+}
+
+if(!exists("width")) {
+	width = ComplexHeatmap:::width
+}
 
 normalize_graphic_param_to_mat(1, nc = 2, nr = 4, "foo")
 normalize_graphic_param_to_mat(1:2, nc = 2, nr = 4, "foo")
@@ -18,11 +31,11 @@ fun = function(index) {
 	grid.points(index, x[index])
 	popViewport()
 }
-anno = AnnotationFunction(fun = fun, var_imported = "x")
-anno = AnnotationFunction(fun = fun, var_imported = list(x))
+anno = AnnotationFunction(fun = fun, var_import = "x")
+anno = AnnotationFunction(fun = fun, var_import = list(x))
 
 
-devAskNewPage(ask = TRUE)
+# devAskNewPage(ask = dev.interactive())
 
 ########### testing anno_simple ############
 anno = anno_simple(1:10)
@@ -74,6 +87,7 @@ draw(anno, test = "anno_empty")
 anno = anno_empty(border = FALSE)
 draw(anno, test = "anno_empty without border")
 
+if(0) {
 ###### test anno_image #####
 image1 = sample(dir("~/Downloads/IcoMoon-Free-master/PNG/64px", full.names = TRUE), 10)
 anno = anno_image(image1)
@@ -104,6 +118,7 @@ draw(anno, test = "space")
 image1[1] = ""
 anno = anno_image(image1)
 draw(anno, test = "png")
+}
 
 ######## test anno_points #####
 anno = anno_points(runif(10))
@@ -130,12 +145,14 @@ anno = anno_points(runif(10), axis_param = list(direction = "reverse"), ylim = c
 draw(anno, test = "anno_points")
 
 # pch as image
+if(0) {
 image1 = sample(dir("/desktop-home/guz/Downloads/IcoMoon-Free-master/PNG/64px", full.names = TRUE), 10)
 x = runif(10)
 anno1 = anno_points(x, pch = image1, pch_as_image = TRUE, size = unit(5, "mm"), height = unit(4, "cm"))
 anno2 = anno_points(x, height = unit(4, "cm"))
 draw(anno1, test = "anno_points")
 draw(anno2, test = "anno_points")
+}
 
 ##### test anno_lines ###
 anno = anno_lines(runif(10))
@@ -177,7 +194,7 @@ draw(anno, test = "with rotations")
 anno = anno_text(month.name, location = 1, rot = 45, just = "right", gp = gpar(fontsize = 1:12+4))
 draw(anno, test = "with rotations")
 
-devAskNewPage(ask = TRUE)
+
 for(rot in seq(0, 360, by = 45)) {
 	anno = anno_text(month.name, which = "row", location = 0, rot = rot, 
 		just = "left")
@@ -297,6 +314,7 @@ draw(anno, test = "heatmap, colors")
 
 
 ###### anno_mark ###
+if(0) {
 library(gridtext)
 grid.text = function(text, x = 0.5, y = 0.5, gp = gpar(), rot = 0, default.units = "npc", just = "center") {
 	if(length(just) == 1) {
@@ -321,7 +339,7 @@ grid.text = function(text, x = 0.5, y = 0.5, gp = gpar(), rot = 0, default.units
 		default.units = default.units, hjust = just2[1], vjust = just2[2], rot = rot)
 	grid.draw(gb)
 }
-
+}
 anno = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10], which = "row")
 draw(anno, index = 1:100, test = "anno_mark")
 
@@ -451,7 +469,7 @@ draw(anno, index = 1:10, k = 2, n = 4, test = "anno_block")
 anno = anno_block(gp = gpar(fill = 1:4), labels = letters[1:4], labels_gp = gpar(col = "white"))
 draw(anno, index = 1:10, k = 2, n = 4, test = "anno_block")
 draw(anno, index = 1:10, k = 4, n = 4, test = "anno_block")
-draw(anno, index = 1:10, k = 2, n = 2, test = "anno_block")
+# draw(anno, index = 1:10, k = 2, n = 2, test = "anno_block")
 
 anno = anno_block(gp = gpar(fill = 1:4), labels = letters[1:4], labels_gp = gpar(col = "white"), which = "row")
 draw(anno, index = 1:10, k = 2, n = 4, test = "anno_block")
@@ -529,12 +547,12 @@ draw(anno, index = hc$order, test = "anno_zoom, column annotation")
 
 
 anno = anno_zoom(align_to = fa2, which = "row", panel_fun = panel_fun)
-Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno))
-Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno), row_split = 2)
+draw(Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno)))
+draw(Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno), row_split = 2))
 
 
 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))
+draw(Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno)))
 
 set.seed(123)
 m = matrix(rnorm(100*10), nrow = 100)
@@ -551,7 +569,7 @@ panel_fun = function(index, nm) {
 }
 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)
+draw(Heatmap(m, right_annotation = rowAnnotation(foo = anno), row_split = subgroup))
 
 panel_fun2 = function(index, nm) {
 	pushViewport(viewport())
@@ -565,13 +583,13 @@ anno2 = anno_zoom(align_to = subgroup, which = "row", panel_fun = panel_fun2,
 	gap = unit(1, "cm"), width = unit(3, "cm"), side = "left")
 
 # in infinite loop
-Heatmap(m, right_annotation = rowAnnotation(subgroup = subgroup, foo = anno,
+draw(Heatmap(m, right_annotation = rowAnnotation(subgroup = subgroup, foo = anno,
 	show_annotation_name = FALSE), 
 	left_annotation = rowAnnotation(bar = anno2, subgroup = subgroup, show_annotation_name = FALSE),
 	show_row_dend = FALSE,
-	row_split = subgroup)
+	row_split = subgroup))
 
-Heatmap(m, right_annotation = rowAnnotation(foo = anno), 
+draw(Heatmap(m, right_annotation = rowAnnotation(foo = anno), 
 	left_annotation = rowAnnotation(bar = anno2),
 	show_row_dend = FALSE,
-	row_split = subgroup)
+	row_split = subgroup))

tests/test-plot/test-ColorMapping-class.R

@@ -1,40 +1,5 @@
 
 
-cm = ColorMapping(name = "test",
-	colors = c("blue", "white", "red"),
-	levels = c("a", "b", "c"))
-
-test_that("color mapping is discrete", {
-	expect_that(show(cm), prints_text("Discrete color mapping"))
-	expect_that(map_to_colors(cm, "a"), is_identical_to("#0000FFFF"))
-	expect_that(map_to_colors(cm, "d"), throws_error("cannot map colors to some of the levels"))
-	expect_that(map_to_colors(cm, c("a", "a", "b", "c")), is_identical_to(c("#0000FFFF", "#0000FFFF", "#FFFFFFFF", "#FF0000FF")))
-})
-
-cm = ColorMapping(name = "test",
-	col_fun = colorRamp2(c(0, 0.5, 1), c("blue", "white", "red")))
-
-test_that("color mapping is continuous", {
-	expect_that(show(cm), prints_text("Continuous color mapping"))
-	expect_that(map_to_colors(cm, 0), is_identical_to("#0000FFFF"))
-	expect_that(map_to_colors(cm, 2), is_identical_to("#FF0000FF"))
-	expect_that(map_to_colors(cm, seq(-1, 2, length = 4)), is_identical_to(c("#0000FFFF", "#0000FFFF", "#FF0000FF", "#FF0000FF")))
-})
-
-cm = ColorMapping(name = "test",
-	colors = c("blue", "white", "red"),
-	levels = c(1, 2, 3))
-
-test_that("color mapping is discrete but with numeric levels", {
-	expect_that(show(cm), prints_text("Discrete color mapping"))
-	expect_that(map_to_colors(cm, 1), is_identical_to("#0000FFFF"))
-	expect_that(map_to_colors(cm, "1"), is_identical_to("#0000FFFF"))
-	expect_that(map_to_colors(cm, 5), throws_error("cannot map colors to some of the levels"))
-	expect_that(map_to_colors(cm, c(1, 1, 2, 2)), is_identical_to(c("#0000FFFF", "#0000FFFF", "#FFFFFFFF", "#FFFFFFFF")))
-})
-
-
-pdf(NULL)
 cm = ColorMapping(name = "test",
 	colors = c("blue", "white", "red"),
 	levels = c("a", "b", "c"))
@@ -48,5 +13,3 @@ cm = ColorMapping(name = "test",
 	colors = c("blue", "white", "red"),
 	levels = c(1, 2, 3))
 color_mapping_legend(cm)
-
-dev.off()

tests/test-plot/test-Heatmap-class.R

@@ -1,5 +1,7 @@
-ht_global_opt$verbose = FALSE
-ht_global_opt$show_vp_border = FALSE
+
+if(!exists("random_str")) {
+	random_str = ComplexHeatmap:::random_str
+}
 
 set.seed(123)
 nr1 = 10; nr2 = 8; nr3 = 6
@@ -45,8 +47,8 @@ draw(ht, test = TRUE)
 ht = Heatmap(mat, row_title = "blablabla", row_title_gp = gpar(fontsize = 20, font = 2))
 draw(ht, test = TRUE)
 
-ht = Heatmap(mat, row_title = "blablabla", row_title_rot = 45)
-draw(ht, test = TRUE)
+# ht = Heatmap(mat, row_title = "blablabla", row_title_rot = 45)
+# draw(ht, test = TRUE)
 
 ht = Heatmap(mat, row_title = "blablabla", row_title_rot = 0)
 draw(ht, test = TRUE)
@@ -63,8 +65,8 @@ draw(ht, test = TRUE)
 ht = Heatmap(mat, column_title = "blablabla", column_title_gp = gpar(fontsize = 20, font = 2))
 draw(ht, test = TRUE)
 
-ht = Heatmap(mat, column_title = "blablabla", column_title_rot = 45)
-draw(ht, test = TRUE)
+# ht = Heatmap(mat, column_title = "blablabla", column_title_rot = 45)
+# draw(ht, test = TRUE)
 
 ht = Heatmap(mat, column_title = "blablabla", column_title_rot = 90)
 draw(ht, test = TRUE)
@@ -100,6 +102,7 @@ dend = as.dendrogram(hclust(dist(mat)))
 ht = Heatmap(mat, cluster_rows = dend)
 draw(ht, test = TRUE)
 
+library(dendextend)
 dend = color_branches(dend, k = 3)
 ht = Heatmap(mat, cluster_rows = dend)
 draw(ht, test = TRUE)
@@ -392,13 +395,13 @@ ht@heatmap_param[c("width", "height")]
 ht@matrix_param[c("width", "height")]
 draw(ht, test = TRUE)
 
-ht = Heatmap(mat, heatmap_body_width = unit(10, "cm"), heatmap_body_height = unit(10, "cm"))
+ht = Heatmap(mat, heatmap_width = unit(10, "cm"), heatmap_height = unit(10, "cm"))
 ht = prepare(ht)
 ht@heatmap_param[c("width", "height")]
 ht@matrix_param[c("width", "height")]
 draw(ht, test = TRUE)
 
-ht = Heatmap(mat, heatmap_body_width = unit(10, "cm"))
+ht = Heatmap(mat, heatmap_width = unit(10, "cm"))
 ht = prepare(ht)
 ht@heatmap_param[c("width", "height")]
 ht@matrix_param[c("width", "height")]
@@ -415,10 +418,13 @@ draw(ht, test = TRUE)
 
 #### test global padding
 ra = rowAnnotation(foo = 1:24)
-Heatmap(mat, show_column_names = FALSE) + ra
-	left_annotation = ra)
-
+ht = Heatmap(mat, show_column_names = FALSE) + ra
+draw(ht)
 
-Heatmap(matrix(rnorm(100), 10), row_km = 2, row_title = "")
+ht = Heatmap(matrix(rnorm(100), 10), row_km = 2, row_title = "")
+draw(ht)
 
-Heatmap(matrix(rnorm(100), 10), heatmap_width = unit(5, "mm"))
+if(0) {
+ht = Heatmap(matrix(rnorm(100), 10), heatmap_width = unit(5, "mm"))
+draw(ht)
+}