Browse code

add unit_to_numeric() function

... ...
@@ -312,13 +312,13 @@ setMethod(f = "draw",
312 312
 		if(!identical(unit(0, "mm"), object@extended[1])) {
313 313
 			grid.rect(y = 1, height = unit(1, "npc") + object@extended[1], just = "top",
314 314
 				gp = gpar(fill = "transparent", col = "red", lty = 2))
315
-		} else if(!identical(unit(0, "mm"), object@extended[[2]])) {
315
+		} else if(!identical(unit(0, "mm"), object@extended[2])) {
316 316
 			grid.rect(x = 1, width = unit(1, "npc") + object@extended[2], just = "right",
317 317
 				gp = gpar(fill = "transparent", col = "red", lty = 2))
318
-		} else if(!identical(unit(0, "mm"), object@extended[[3]])) {
318
+		} else if(!identical(unit(0, "mm"), object@extended[3])) {
319 319
 			grid.rect(y = 0, height = unit(1, "npc") + object@extended[3], just = "bottom",
320 320
 				gp = gpar(fill = "transparent", col = "red", lty = 2))
321
-		} else if(!identical(unit(0, "mm"), object@extended[[4]])) {
321
+		} else if(!identical(unit(0, "mm"), object@extended[4])) {
322 322
 			grid.rect(x = 0, width = unit(1, "npc") + object@extended[4], just = "left",
323 323
 				gp = gpar(fill = "transparent", col = "red", lty = 2))
324 324
 		}
... ...
@@ -846,13 +846,13 @@ update_anno_extend = function(anno, axis_grob, axis_param) {
846 846
 
847 847
 	if(axis_param$facing == "outside") {
848 848
 		if(axis_param$side == "left") {
849
-			extended[[2]] = convertWidth(grobWidth(axis_grob), "mm", valueOnly = TRUE)
849
+			extended[2] = convertWidth(grobWidth(axis_grob), "mm")
850 850
 		} else if(axis_param$side == "right") {
851
-			extended[[4]] = convertWidth(grobWidth(axis_grob), "mm", valueOnly = TRUE)
851
+			extended[4] = convertWidth(grobWidth(axis_grob), "mm")
852 852
 		} else if(axis_param$side == "top") {
853
-			extended[[3]] = convertHeight(grobHeight(axis_grob), "mm", valueOnly = TRUE)
853
+			extended[3] = convertHeight(grobHeight(axis_grob), "mm")
854 854
 		} else if(axis_param$side == "bottom") {
855
-			extended[[1]] = convertHeight(grobHeight(axis_grob), "mm", valueOnly = TRUE)
855
+			extended[1] = convertHeight(grobHeight(axis_grob), "mm")
856 856
 		}
857 857
 	}
858 858
 	return(extended)
... ...
@@ -430,7 +430,7 @@ setMethod(f = "make_layout",
430 430
                 layout_size$row_anno_right_width,
431 431
                 layout_size$row_names_right_width,
432 432
                 layout_size$row_title_right_width), "mm")
433
-        if(object@matrix_param$width[[1]] <= 0) {
433
+        if(unit_to_numeric(object@matrix_param$width[1]) <= 0) {
434 434
             stop_wrap("width of the heatmap body is negative, maybe `heatmap_width` you set is too small. Note `heatmap_width` is the width of the complete heatmap.")
435 435
         }
436 436
     } else if(is_abs_unit(object@matrix_param$width)) {  # e.g. unit(1, "npc")
... ...
@@ -461,7 +461,7 @@ setMethod(f = "make_layout",
461 461
                 layout_size$column_dend_bottom_height,
462 462
                 layout_size$column_anno_bottom_height,
463 463
                 layout_size$column_names_bottom_height), "mm")
464
-        if(object@matrix_param$height[[1]] <= 0) {
464
+        if(unit_to_numeric(object@matrix_param$height[1]) <= 0) {
465 465
             stop_wrap("height of the heatmap body is negative, maybe `heatmap_height` you set is too small. Note `heatmap_height` is the height of the complete heatmap.")
466 466
         }
467 467
     } else if(is_abs_unit(object@matrix_param$height)) {
... ...
@@ -440,9 +440,9 @@ HeatmapAnnotation = function(...,
440 440
     .Object@subsetable = all(sapply(anno_list, function(x) x@subsetable))
441 441
     extended = unit(c(0, 0, 0, 0), "mm")
442 442
     for(i in 1:4) {
443
-    	extended[[i]] = max(sapply(anno_list, function(anno) {
444
-    		anno@extended[[i]]
445
-    	}))
443
+    	extended[i] = unit(max(sapply(anno_list, function(anno) {
444
+    		unit_to_numeric(anno@extended[i])
445
+    	})), "mm")
446 446
     }
447 447
     .Object@extended = extended
448 448
     .Object@param = list(
... ...
@@ -893,9 +893,9 @@ c.HeatmapAnnotation = function(..., gap = unit(0, "mm")) {
893 893
 
894 894
 	extended = unit(c(0, 0, 0, 0), "mm")
895 895
     for(i in 1:4) {
896
-    	extended[[i]] = max(sapply(x@anno_list, function(anno) {
897
-    		anno@extended[[i]]
898
-    	}))
896
+    	extended[i] = unit(max(sapply(x@anno_list, function(anno) {
897
+    		unit_to_numeric(anno@extended[i])
898
+    	})), "mm")
899 899
     }
900 900
     x@extended = extended
901 901
 
... ...
@@ -1009,9 +1009,9 @@ anno_type = function(ha) {
1009 1009
     
1010 1010
     extended = unit(c(0, 0, 0, 0), "mm")
1011 1011
     for(i in 1:4) {
1012
-    	extended[[i]] = max(sapply(x2@anno_list, function(anno) {
1013
-    		anno@extended[[i]]
1014
-    	}))
1012
+    	extended[[i]] = unit(max(sapply(x2@anno_list, function(anno) {
1013
+    		unit_to_numeric(anno@extended[i])
1014
+    	})), "mm")
1015 1015
     }
1016 1016
     x2@extended = extended
1017 1017
 
... ...
@@ -1202,7 +1202,11 @@ setMethod(f = "re_size",
1202 1202
 	anno_size = object@anno_size
1203 1203
 	size = slot(object, size_name)
1204 1204
 	gap = object@gap
1205
-	gap = gap[-length(gap)]
1205
+	if(length(gap) == 1) {
1206
+		gap = unit(0, "mm")
1207
+	} else {
1208
+		gap = gap[-length(gap)]
1209
+	}
1206 1210
 	n = length(object@anno_list)
1207 1211
 
1208 1212
 	# the basic rule is
... ...
@@ -1240,7 +1244,7 @@ setMethod(f = "re_size",
1240 1244
 						} else {
1241 1245
 							stop_wrap("relative unit should be defined as `unit(..., 'null')")
1242 1246
 						}
1243
-						annotation_size_adjusted[i][[1]]
1247
+						unit_to_numeric(annotation_size_adjusted[i][[1]])
1244 1248
 					})
1245 1249
 					rel_num = rel_num/sum(rel_num)
1246 1250
 					if(any(!l_rel_unit)) {
... ...
@@ -402,7 +402,7 @@ setMethod(f = "draw",
402 402
                 }
403 403
             })))
404 404
             max_height = convertHeight(max_height, "mm")
405
-            if(max_height[[1]] == 0) {
405
+            if(unit_to_numeric(max_height[1]) == 0) {
406 406
                 object = object + Heatmap(matrix(ncol = 0, nrow = nr), row_title = NULL, show_heatmap_legend = FALSE)
407 407
             } else {
408 408
                 object = object + Heatmap(matrix(ncol = 0, nrow = nr), height = max_height, row_title = NULL, show_heatmap_legend = FALSE)
... ...
@@ -419,7 +419,7 @@ setMethod(f = "draw",
419 419
                 }
420 420
             })))
421 421
             max_width = convertWidth(max_width, "mm")
422
-            if(max_width[[1]] == 0) {
422
+            if(unit_to_numeric(max_width[1]) == 0) {
423 423
                 object = object %v% Heatmap(matrix(nrow = 0, ncol = nc), column_title = NULL, show_heatmap_legend = FALSE)
424 424
             } else {
425 425
                 object = object %v% Heatmap(matrix(nrow = 0, ncol = nc), width = max_width, column_title = NULL, show_heatmap_legend = FALSE)
... ...
@@ -133,7 +133,7 @@ setMethod(f = "adjust_heatmap_list",
133 133
                     if(is_abs_unit(ht@matrix_param$width)) {
134 134
                         ht@heatmap_param$width
135 135
                     } else {
136
-                        sum(component_width(ht, setdiff(names(HEATMAP_LAYOUT_ROW_COMPONENT), "heatmap_body"))) + ht@matrix_param$width[[1]]*unit_per_null
136
+                        sum(component_width(ht, setdiff(names(HEATMAP_LAYOUT_ROW_COMPONENT), "heatmap_body"))) + unit_to_numeric(ht@matrix_param$width[1])*unit_per_null
137 137
                     }
138 138
                 } else {
139 139
                     size(ht)
... ...
@@ -336,7 +336,7 @@ setMethod(f = "adjust_heatmap_list",
336 336
                     if(is_abs_unit(ht@matrix_param$height)) {
337 337
                         ht@heatmap_param$height
338 338
                     } else {
339
-                        sum(component_height(ht, setdiff(names(HEATMAP_LAYOUT_COLUMN_COMPONENT), "heatmap_body"))) + ht@matrix_param$height[[1]]*unit_per_null
339
+                        sum(component_height(ht, setdiff(names(HEATMAP_LAYOUT_COLUMN_COMPONENT), "heatmap_body"))) + unit_to_numeric(ht@matrix_param$height[1])*unit_per_null
340 340
                     }
341 341
                 } else {
342 342
                     size(ht)
... ...
@@ -508,17 +508,17 @@ setMethod(f = "adjust_heatmap_list",
508 508
     if(is.null(adjust_annotation_extension)) adjust_annotation_extension = TRUE
509 509
     if(adjust_annotation_extension) {
510 510
         # note e.g. max_*_component_height does not include the height of titles
511
-        if(object@layout$row_anno_max_bottom_extended[[1]] > object@layout$max_bottom_component_height[[1]]+ object@layout$max_title_component_height[[2]]) {
511
+        if(unit_to_numeric(object@layout$row_anno_max_bottom_extended[1]) > unit_to_numeric(object@layout$max_bottom_component_height[1]) + unit_to_numeric(object@layout$max_title_component_height[2])) {
512 512
             padding[1] = object@layout$row_anno_max_bottom_extended - object@layout$max_bottom_component_height - object@layout$max_title_component_height[2]
513 513
         }
514
-        if(object@layout$column_anno_max_left_extended[[1]] > object@layout$max_left_component_width[[1]] + object@layout$max_title_component_width[[1]]) {
514
+        if(unit_to_numeric(object@layout$column_anno_max_left_extended[1]) > unit_to_numeric(object@layout$max_left_component_width[1]) + unit_to_numeric(object@layout$max_title_component_width[1])) {
515 515
             padding[2] = object@layout$column_anno_max_left_extended - object@layout$max_left_component_width - object@layout$max_title_component_width[1]
516 516
         }
517 517
             
518
-        if(object@layout$row_anno_max_top_extended[[1]] > object@layout$max_top_component_height[[1]] + object@layout$max_title_component_height[[1]]) {
518
+        if(unit_to_numeric(object@layout$row_anno_max_top_extended[1]) > unit_to_numeric(object@layout$max_top_component_height[1]) + unit_to_numeric(object@layout$max_title_component_height[1])) {
519 519
             padding[3] = object@layout$row_anno_max_top_extended - object@layout$max_top_component_height - object@layout$max_title_component_height[1]
520 520
         }
521
-        if(object@layout$column_anno_max_right_extended[[1]] > object@layout$max_right_component_width[[1]] + object@layout$max_title_component_width[[2]]) {
521
+        if(unit_to_numeric(object@layout$column_anno_max_right_extended[1]) > unit_to_numeric(object@layout$max_right_component_width[1]) + unit_to_numeric(object@layout$max_title_component_width[2])) {
522 522
             padding[4] = object@layout$column_anno_max_right_extended - object@layout$max_right_component_width - object@layout$max_title_component_width[2]
523 523
         }
524 524
     }
... ...
@@ -263,7 +263,7 @@ SingleAnnotation = function(name, value, col, fun,
263 263
     	}
264 264
         if(verbose) qqcat("@{name}: adjust positions of annotation names\n")
265 265
     	if(name_side == "left") {
266
-            if(anno_fun_extend[[2]] > 0) {
266
+            if(unit_to_numeric(anno_fun_extend[2]) > 0) {
267 267
                 if(!is_name_offset_called) {
268 268
                     name_offset = name_offset + anno_fun_extend[2]
269 269
                 }
... ...
@@ -291,7 +291,7 @@ SingleAnnotation = function(name, value, col, fun,
291 291
                 name_just = "top"
292 292
             }
293 293
     	} else {
294
-            if(anno_fun_extend[[4]] > 0) {
294
+            if(unit_to_numeric(anno_fun_extend[4]) > 0) {
295 295
                 if(!is_name_offset_called) {
296 296
                     name_offset = name_offset + anno_fun_extend[4]
297 297
                 }
... ...
@@ -326,7 +326,7 @@ SingleAnnotation = function(name, value, col, fun,
326 326
     	}
327 327
         if(verbose) qqcat("@{name}: adjust positions of annotation names\n")
328 328
     	if(name_side == "top") {
329
-            if(anno_fun_extend[[3]] > 0) {
329
+            if(unit_to_numeric(anno_fun_extend[3]) > 0) {
330 330
                 if(!is_name_offset_called) {
331 331
                     name_offset = name_offset + anno_fun_extend[3]
332 332
                 }
... ...
@@ -354,7 +354,7 @@ SingleAnnotation = function(name, value, col, fun,
354 354
                 name_just = "right"
355 355
             }
356 356
     	} else {
357
-            if(anno_fun_extend[[1]] > 0) {
357
+            if(unit_to_numeric(anno_fun_extend[1]) > 0) {
358 358
                 if(!is_name_offset_called) {
359 359
                     name_offset = name_offset + anno_fun_extend[1]
360 360
                 }
... ...
@@ -399,30 +399,30 @@ SingleAnnotation = function(name, value, col, fun,
399 399
     if(name_param$show) {
400 400
         if(which == "column") {
401 401
             if(name_param$rot == 0) {
402
-                text_width = convertWidth(grobWidth(textGrob(name_param$label, gp = name_gp)) + name_param$offset, "mm", valueOnly = TRUE)
402
+                text_width = convertWidth(grobWidth(textGrob(name_param$label, gp = name_gp)) + name_param$offset, "mm")
403 403
             } else {
404
-                text_width = convertHeight(grobHeight(textGrob(name_param$label, gp = name_gp)) + name_param$offset, "mm", valueOnly = TRUE)
404
+                text_width = convertHeight(grobHeight(textGrob(name_param$label, gp = name_gp)) + name_param$offset, "mm")
405 405
             }
406 406
             if(name_param$side == "left") {
407
-                extended[[2]] = text_width
407
+                extended[2] = text_width
408 408
             } else if(name_param$side == "right") {
409
-                extended[[4]] = text_width
409
+                extended[4] = text_width
410 410
             }
411 411
         } else if(which == "row") {
412 412
             if(name_param$rot == 0) {
413
-                text_width = convertHeight(grobHeight(textGrob(name_param$label, gp = name_gp, rot = name_param$rot)) + name_param$offset, "mm", valueOnly = TRUE)
413
+                text_width = convertHeight(grobHeight(textGrob(name_param$label, gp = name_gp, rot = name_param$rot)) + name_param$offset, "mm")
414 414
             } else {
415
-                text_width = convertHeight(grobHeight(textGrob(name_param$label, gp = name_gp, rot = name_param$rot)) + name_param$offset, "mm", valueOnly = TRUE)
415
+                text_width = convertHeight(grobHeight(textGrob(name_param$label, gp = name_gp, rot = name_param$rot)) + name_param$offset, "mm")
416 416
             }
417 417
             if(name_param$side == "bottom") {
418
-                extended[[1]] = text_width
418
+                extended[1] = text_width
419 419
             } else if(name_param$side == "top") {
420
-                extended[[3]] = text_width
420
+                extended[3] = text_width
421 421
             }
422 422
         }
423 423
     }
424 424
     for(i in 1:4) {
425
-        extended[[i]] = max(anno_fun_extend[[i]], extended[[i]])
425
+        extended[[i]] = unit(max(unit_to_numeric(anno_fun_extend[i]), unit_to_numeric(extended[i])), "mm")
426 426
     }
427 427
     .Object@extended = extended
428 428
 
... ...
@@ -156,7 +156,7 @@ Legend = function(at, labels = at, col_fun, nrow = NULL, ncol = 1, by_row = FALS
156 156
 			if(title_position == "lefttop") {
157 157
 				title_width = convertWidth(grobWidth(textGrob(title, gp = title_gp)), "mm")
158 158
 				title_height = convertHeight(grobHeight(textGrob(title, gp = title_gp)), "mm")
159
-				if(title_height[[1]] <= grid_height[[1]]) {
159
+				if(unit_to_numeric(title_height[1]) <= unit_to_numeric(grid_height[1])) {
160 160
 					legend_extension = title_width + title_padding
161 161
 				}
162 162
 			}
... ...
@@ -67,8 +67,30 @@
67 67
 # is_abs_unit(unit(1, "mm") + unit(1, "npc"))
68 68
 #
69 69
 is_abs_unit = function(u) {
70
+	NULL
71
+}
72
+
73
+is_abs_unit_v3 = function(u) {
70 74
 	if(inherits(u, "unit.arithmetic")) .is_abs_unit.unit.arithmetic(u)
71 75
 	else if(inherits(u, "unit.list")) .is_abs_unit.unit.list(u)
72 76
 	else if(inherits(u, "unit")) .is_abs_unit.unit(u)
73 77
 	else FALSE
74 78
 }
79
+
80
+is_abs_unit_v4 = function(u) {
81
+	if(inherits(u, "simpleUnit")) {
82
+		.is_abs_unit.unit(u)
83
+	} else {
84
+		if(unitType(u) %in% c("sum", "min", "max")) {
85
+			all(sapply(unclass(u)[[1]][[2]], is_abs_unit_v4))
86
+		} else {
87
+			.is_abs_unit.unit(u)
88
+		}
89
+	}
90
+}
91
+
92
+if(getRversion() >= "4.0.0") {
93
+	is_abs_unit = is_abs_unit_v4
94
+} else {
95
+	is_abs_unit = is_abs_unit_v3
96
+}
... ...
@@ -545,6 +545,10 @@ unit_in_mm = function(x) {
545 545
     identical(unitType(x), "mm")
546 546
 }
547 547
 
548
+unit_to_numeric = function(x) {
549
+    as.numeric(x)
550
+}
551
+
548 552
 normalize_graphic_param_to_mat = function(x, nc, nr, name) {
549 553
     if(is.matrix(x)) {
550 554
         if(nrow(x) == nr && ncol(x) == nc) {
... ...
@@ -25,15 +25,3 @@ if(getRversion() >= "4.0.0") {
25 25
 	unitType = function(x) attr(x, "unit")
26 26
 }
27 27
 
28
-
29
-"[[.unit" = function(x, index) {
30
-    as.numeric(x[index])
31
-}
32
-
33
-# value is a pure number
34
-"[[<-.unit" = function(x, index, value) {
35
-	ut = unitType(x[index])
36
-    x[index] = unit(value, ut)
37
-    x
38
-}
39
-
40 28
new file mode 100644
... ...
@@ -0,0 +1,4 @@
1
+[Dolphin]
2
+Timestamp=2020,3,5,15,27,50
3
+Version=3
4
+ViewMode=2
0 5
similarity index 100%
1 6
rename from tests_not_run/test-AnnotationFunction.R
2 7
rename to tests/test-plot/test-AnnotationFunction.R
3 8
similarity index 100%
4 9
rename from tests_not_run/test-ColorMapping-class.R
5 10
rename to tests/test-plot/test-ColorMapping-class.R
6 11
similarity index 100%
7 12
rename from tests_not_run/test-Heatmap-class.R
8 13
rename to tests/test-plot/test-Heatmap-class.R
9 14
similarity index 100%
10 15
rename from tests_not_run/test-Heatmap-cluster.R
11 16
rename to tests/test-plot/test-Heatmap-cluster.R
12 17
similarity index 100%
13 18
rename from tests_not_run/test-HeatmapAnnotation.R
14 19
rename to tests/test-plot/test-HeatmapAnnotation.R
15 20
similarity index 100%
16 21
rename from tests_not_run/test-HeatmapList-class.R
17 22
rename to tests/test-plot/test-HeatmapList-class.R
18 23
similarity index 100%
19 24
rename from tests_not_run/test-Legend.R
20 25
rename to tests/test-plot/test-Legend.R
21 26
similarity index 100%
22 27
rename from tests_not_run/test-SingleAnnotation.R
23 28
rename to tests/test-plot/test-SingleAnnotation.R
24 29
similarity index 100%
25 30
rename from tests_not_run/test-annotation_axis.R
26 31
rename to tests/test-plot/test-annotation_axis.R
27 32
similarity index 100%
28 33
rename from tests_not_run/test-dendrogram.R
29 34
rename to tests/test-plot/test-dendrogram.R
30 35
similarity index 100%
31 36
rename from tests_not_run/test-gridtext.R
32 37
rename to tests/test-plot/test-gridtext.R
33 38
similarity index 100%
34 39
rename from tests_not_run/test-multiple-page.R
35 40
rename to tests/test-plot/test-multiple-page.R
36 41
similarity index 100%
37 42
rename from tests_not_run/test-oncoPrint.R
38 43
rename to tests/test-plot/test-oncoPrint.R
39 44
similarity index 100%
40 45
rename from tests_not_run/test-upset.R
41 46
rename to tests/test-plot/test-upset.R
42 47
similarity index 68%
43 48
rename from tests_not_run/test-utils.R
44 49
rename to tests/test-plot/test-utils.R
... ...
@@ -1,24 +1,3 @@
1
-mat = matrix(rnorm(40), nr = 4, ncol = 10)
2
-rownames(mat) = letters[1:4]
3
-colnames(mat) = letters[1:10]
4
-
5
-d1 = dist(mat)
6
-d2 = dist2(mat)
7
-
8
-test_that("test dist and dist2", {
9
-	expect_that(all(abs(d1 - d2) < 1e-10), is_identical_to(TRUE))
10
-})
11
-
12
-test_that("test default colors", {
13
-	col = default_col(c("a", "b", "c"))
14
-	expect_that(is.atomic(col), is_identical_to(TRUE))
15
-	col = default_col(factor(c("a", "b", "c")))
16
-	expect_that(is.atomic(col), is_identical_to(TRUE))
17
-	col = default_col(1:10)
18
-	expect_that(is.function(col), is_identical_to(TRUE))
19
-})
20
-
21
-
22 1
 
23 2
 # things needed to be tested
24 3
 # 1. the order
25 4
similarity index 53%
26 5
rename from tests/test-all.R
27 6
rename to tests/testthat-all.R
... ...
@@ -1,4 +1,14 @@
1
-library(testthat)
1
+
2
+
2 3
 suppressWarnings(suppressPackageStartupMessages(library(ComplexHeatmap)))
3 4
 
5
+## test the scripts in test-plot folder
6
+for(f in dir("test-plot")) {
7
+	pdf(NULL)
8
+	source(f)
9
+	dev.off()
10
+}
11
+
12
+library(testthat)
13
+
4 14
 test_check("ComplexHeatmap")
5 15
similarity index 100%
6 16
rename from tests/testthat/test-utiles.R
7 17
rename to tests/testthat/testhat-utiles.R
8 18
similarity index 100%
9 19
rename from tests/testthat/test-HeatmapAnnotation-size.R
10 20
rename to tests/testthat/testthat-HeatmapAnnotation-size.R
11 21
similarity index 100%
12 22
rename from tests/testthat/test-UpSet.R
13 23
rename to tests/testthat/testthat-UpSet.R