Browse code

almost works

Zuguang Gu authored on 11/09/2018 10:52:42
Showing7 changed files

... ...
@@ -98,7 +98,7 @@ AnnotationFunction = function(fun, fun_name = "", which = c("column", "row"),
98 98
 
99 99
 	which = match.arg(which)[1]
100 100
 
101
-	verbose = ht_global_opt$verbose
101
+	verbose = ht_opt$verbose
102 102
 	
103 103
 	anno = new("AnnotationFunction")
104 104
 
... ...
@@ -231,7 +231,7 @@ setMethod(f = "draw",
231 231
         pushViewport(viewport(width = 0.8, height = 0.8))
232 232
     }
233 233
 
234
-    verbose = ht_global_opt$verbose
234
+    verbose = ht_opt$verbose
235 235
     if(verbose) qqcat("draw annotation generated by @{object@fun_name}\n")
236 236
 
237 237
     if(missing(index)) index = seq_len(object@n)
... ...
@@ -308,7 +308,7 @@ Heatmap = function(matrix, col, name,
308 308
     raster_quality = 2,
309 309
     raster_device_param = list()) {
310 310
 
311
-    verbose = ht_global_opt("verbose")
311
+    verbose = ht_opt("verbose")
312 312
 
313 313
     if(!dev.interactive()) {
314 314
         pdf(file = NULL)
... ...
@@ -327,26 +327,26 @@ Heatmap = function(matrix, col, name,
327 327
     for(opt_name in c("row_names_gp", "column_names_gp", "row_title_gp", "column_title_gp")) {
328 328
         opt_name2 = paste0("heatmap_", opt_name)
329 329
         if(! opt_name %in% called_args) { # if this argument is not called
330
-            if(!is.null(ht_global_opt(opt_name2))) {
331
-                if(verbose) qqcat("re-assign @{opt_name} with `ht_global_opt('@{opt_name2}'')`\n")
332
-                assign(opt_name, ht_global_opt(opt_name2))
330
+            if(!is.null(ht_opt(opt_name2))) {
331
+                if(verbose) qqcat("re-assign @{opt_name} with `ht_opt('@{opt_name2}'')`\n")
332
+                assign(opt_name, ht_opt(opt_name2))
333 333
             }
334 334
         }
335 335
     }
336 336
 
337 337
     if("heatmap_legend_param" %in% called_args) {
338 338
         for(opt_name in setdiff(c("title_gp", "title_position", "labels_gp", "grid_width", "grid_height", "grid_border"), names(heatmap_legend_param))) {
339
-            opt_name2 = paste0("heatmap_legend_", opt_name)
340
-            if(!is.null(ht_global_opt(opt_name2)))
341
-                if(verbose) qqcat("re-assign heatmap_legend_param$@{opt_name} with `ht_global_opt('@{opt_name2}'')`\n")
342
-                heatmap_legend_param[[opt_name]] = ht_global_opt(opt_name2)
339
+            opt_name2 = paste0("legend_", opt_name)
340
+            if(!is.null(ht_opt(opt_name2)))
341
+                if(verbose) qqcat("re-assign heatmap_legend_param$@{opt_name} with `ht_opt('@{opt_name2}'')`\n")
342
+                heatmap_legend_param[[opt_name]] = ht_opt(opt_name2)
343 343
         }
344 344
     } else {
345 345
         for(opt_name in c("title_gp", "title_position", "labels_gp", "grid_width", "grid_height", "grid_border")) {
346
-            opt_name2 = paste0("heatmap_legend_", opt_name)
347
-            if(!is.null(ht_global_opt(opt_name2)))
348
-                if(verbose) qqcat("re-assign heatmap_legend_param$@{opt_name} with `ht_global_opt('@{opt_name2}'')`\n")
349
-                heatmap_legend_param[[opt_name]] = ht_global_opt(opt_name2)
346
+            opt_name2 = paste0("legend_", opt_name)
347
+            if(!is.null(ht_opt(opt_name2)))
348
+                if(verbose) qqcat("re-assign heatmap_legend_param$@{opt_name} with `ht_opt('@{opt_name2}'')`\n")
349
+                heatmap_legend_param[[opt_name]] = ht_opt(opt_name2)
350 350
         }
351 351
     }
352 352
 
... ...
@@ -616,7 +616,7 @@ Heatmap = function(matrix, col, name,
616 616
     .Object@row_dend_param$distance = clustering_distance_rows
617 617
     .Object@row_dend_param$method = clustering_method_rows
618 618
     .Object@row_dend_param$side = match.arg(row_dend_side)[1]
619
-    .Object@row_dend_param$width = row_dend_width + unit(1, "mm")  # append the gap
619
+    .Object@row_dend_param$width = row_dend_width + DENDROGRAM_PADDING  # append the gap
620 620
     .Object@row_dend_param$show = show_row_dend
621 621
     .Object@row_dend_param$gp = check_gp(row_dend_gp)
622 622
     .Object@row_dend_param$reorder = row_dend_reorder
... ...
@@ -653,7 +653,7 @@ Heatmap = function(matrix, col, name,
653 653
     .Object@column_dend_param$distance = clustering_distance_columns
654 654
     .Object@column_dend_param$method = clustering_method_columns
655 655
     .Object@column_dend_param$side = match.arg(column_dend_side)[1]
656
-    .Object@column_dend_param$height = column_dend_height + unit(1, "mm")  # append the gap
656
+    .Object@column_dend_param$height = column_dend_height + DENDROGRAM_PADDING  # append the gap
657 657
     .Object@column_dend_param$show = show_column_dend
658 658
     .Object@column_dend_param$gp = check_gp(column_dend_gp)
659 659
     .Object@column_dend_param$reorder = column_dend_reorder
... ...
@@ -671,7 +671,7 @@ Heatmap = function(matrix, col, name,
671 671
     if(is.null(top_annotation)) {
672 672
         .Object@top_annotation_param$height = unit(0, "mm")    
673 673
     } else {
674
-        .Object@top_annotation_param$height = height(top_annotation) + COLUMN_ANNO_PADDING*2  # append the gap
674
+        .Object@top_annotation_param$height = height(top_annotation) + COLUMN_ANNO_PADDING  # append the gap
675 675
     }
676 676
     if(!is.null(top_annotation)) {
677 677
         if(length(top_annotation) > 0) {
... ...
@@ -691,7 +691,7 @@ Heatmap = function(matrix, col, name,
691 691
     if(is.null(bottom_annotation)) {
692 692
         .Object@bottom_annotation_param$height = unit(0, "mm")
693 693
     } else {
694
-        .Object@bottom_annotation_param$height = height(bottom_annotation) + COLUMN_ANNO_PADDING*2  # append the gap
694
+        .Object@bottom_annotation_param$height = height(bottom_annotation) + COLUMN_ANNO_PADDING  # append the gap
695 695
     }
696 696
     if(!is.null(bottom_annotation)) {
697 697
         if(length(bottom_annotation) > 0) {
... ...
@@ -711,7 +711,7 @@ Heatmap = function(matrix, col, name,
711 711
     if(is.null(left_annotation)) {
712 712
         .Object@left_annotation_param$width = unit(0, "mm")
713 713
     } else {
714
-        .Object@left_annotation_param$width = width(left_annotation) + ROW_ANNO_PADDING*2  # append the gap
714
+        .Object@left_annotation_param$width = width(left_annotation) + ROW_ANNO_PADDING  # append the gap
715 715
     }
716 716
     if(!is.null(left_annotation)) {
717 717
         if(length(left_annotation) > 0) {
... ...
@@ -731,7 +731,7 @@ Heatmap = function(matrix, col, name,
731 731
     if(is.null(right_annotation)) {
732 732
         .Object@right_annotation_param$width = unit(0, "mm")
733 733
     } else {
734
-        .Object@right_annotation_param$width = width(right_annotation) + ROW_ANNO_PADDING*2  # append the gap
734
+        .Object@right_annotation_param$width = width(right_annotation) + ROW_ANNO_PADDING  # append the gap
735 735
     }
736 736
     if(!is.null(right_annotation)) {
737 737
         if(length(right_annotation) > 0) {
... ...
@@ -825,7 +825,7 @@ make_cluster = function(object, which = c("row", "column")) {
825 825
 
826 826
     verbose = object@heatmap_param$verbose
827 827
 
828
-    if(ht_global_opt("fast_hclust")) {
828
+    if(ht_opt("fast_hclust")) {
829 829
         hclust = fastcluster::hclust
830 830
         if(verbose) qqcat("apply hclust by fastcluster::hclust\n")
831 831
     } else {
... ...
@@ -1396,12 +1396,23 @@ setMethod(f = "make_layout",
1396 1396
         }
1397 1397
         row_dend_max_height = dend_heights(row_dend_slice) + max(dend_heights(object@row_dend_list))
1398 1398
         object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) {
1399
+            
1400
+            if(row_dend_side == "left") {
1401
+                pushViewport(viewport(x = unit(0, "npc"), width = unit(1, "npc") - DENDROGRAM_PADDING, just = "left"))
1402
+            } else {
1403
+                pushViewport(viewport(x = DENDROGRAM_PADDING, width = unit(1, "npc") - DENDROGRAM_PADDING, just = "left"))
1404
+            }
1399 1405
             for(i in seq_len(nr_slice)) {
1400
-                draw_dend(object, k = i, which = "row", y = slice_y[i], height = slice_height[i], just = "top")
1406
+                draw_dend(object, k = i, which = "row", y = slice_y[i], height = slice_height[i], just = "top",
1407
+                    max_height = row_dend_max_height)
1401 1408
             }
1402 1409
 
1403 1410
             if(nr_slice > 1) {
1404
-                pushViewport(viewport(xscale = c(0, row_dend_max_height), width = unit(1, "npc") - DENDROGRAM_PADDING*2))
1411
+                if(row_dend_side == "left") {
1412
+                    pushViewport(viewport(xscale = c(0, row_dend_max_height)))
1413
+                } else {
1414
+                    pushViewport(viewport(xscale = c(0, row_dend_max_height)))
1415
+                }
1405 1416
                 p = sapply(object@row_dend_list, function(x) {
1406 1417
                     attr(x, "x")/nobs(x)
1407 1418
                 })
... ...
@@ -1413,10 +1424,11 @@ setMethod(f = "make_layout",
1413 1424
                     slice_leaf_pos[i] = slice_leaf_pos[i] - slice_height[i]*p[i]
1414 1425
                 }
1415 1426
                 row_dend_slice = merge(row_dend_slice, object@row_dend_list, only_parent = TRUE)
1416
-                row_dend_slice = adjust_dend_by_x(row_dend_slice, x = slice_leaf_pos)
1427
+                row_dend_slice = adjust_dend_by_x(row_dend_slice, slice_leaf_pos)
1417 1428
                 grid.dendrogram(row_dend_slice, facing = ifelse(row_dend_side == "left", "right", "left"))
1418 1429
                 popViewport()
1419 1430
             }
1431
+            upViewport()
1420 1432
         })
1421 1433
     }
1422 1434
 
... ...
@@ -1436,12 +1448,22 @@ setMethod(f = "make_layout",
1436 1448
         }
1437 1449
         column_dend_max_height = dend_heights(column_dend_slice) + max(dend_heights(object@column_dend_list))
1438 1450
         object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) {
1451
+            if(column_dend_side == "top") {
1452
+                pushViewport(viewport(y = DENDROGRAM_PADDING, height = unit(1, "npc") - DENDROGRAM_PADDING, just = "bottom"))
1453
+            } else {
1454
+                pushViewport(viewport(y = unit(0, "npc"), height = unit(1, "npc") - DENDROGRAM_PADDING, just = "bottom"))
1455
+            }
1439 1456
             for(i in seq_len(nc_slice)) {
1440
-                draw_dend(object, k = i, which = "column", x = slice_x[i], width = slice_width[i], just = "left")
1457
+                draw_dend(object, k = i, which = "column", x = slice_x[i], width = slice_width[i], just = "left",
1458
+                    max_height = column_dend_max_height)
1441 1459
             }
1442 1460
 
1443 1461
             if(nc_slice > 1) {
1444
-                pushViewport(viewport(yscale = c(0, column_dend_max_height), height = unit(1, "npc") - DENDROGRAM_PADDING*2))
1462
+                if(column_dend_side == "top") {
1463
+                    pushViewport(viewport(yscale = c(0, column_dend_max_height)))
1464
+                } else {
1465
+                    pushViewport(viewport(yscale = c(0, column_dend_max_height)))
1466
+                }
1445 1467
                 p = sapply(object@column_dend_list, function(x) {
1446 1468
                     attr(x, "x")/nobs(x)
1447 1469
                 })
... ...
@@ -1453,10 +1475,11 @@ setMethod(f = "make_layout",
1453 1475
                     slice_leaf_pos[i] = slice_leaf_pos[i] + slice_width[i]*p[i]
1454 1476
                 }
1455 1477
                 column_dend_slice = merge(column_dend_slice, object@column_dend_list, only_parent = TRUE)
1456
-                column_dend_slice = adjust_dend_by_x(column_dend_slice, x = slice_leaf_pos)
1478
+                column_dend_slice = adjust_dend_by_x(column_dend_slice, slice_leaf_pos)
1457 1479
                 grid.dendrogram(column_dend_slice, facing = ifelse(column_dend_side == "top", "bottom", "top"))
1458 1480
                 popViewport()
1459 1481
             }
1482
+            upViewport()
1460 1483
         })
1461 1484
     }
1462 1485
 
... ...
@@ -1517,8 +1540,9 @@ setMethod(f = "make_layout",
1517 1540
             
1518 1541
             object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) {
1519 1542
                 for(i in seq_len(nc_slice)) {
1520
-                    draw_annotation(object, k = i, which = "top", x = slice_x[i], 
1521
-                        width = slice_width[i], height = unit(1, "npc"), just = "left")
1543
+                    draw_annotation(object, k = i, which = "top", x = slice_x[i], width = slice_width[i], 
1544
+                        y = COLUMN_ANNO_PADDING, height = unit(1, "npc") - COLUMN_ANNO_PADDING, 
1545
+                        just = c("left", "bottom"))
1522 1546
                 }
1523 1547
             }) 
1524 1548
         }
... ...
@@ -1534,8 +1558,9 @@ setMethod(f = "make_layout",
1534 1558
             object@layout$layout_index = rbind(object@layout$layout_index, column_anno_bottom = heatmap_layout_index("column_anno_bottom"))
1535 1559
             object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) {
1536 1560
                 for(i in seq_len(nc_slice)) {
1537
-                    draw_annotation(object, k = i, which = "bottom", x = slice_x[i], 
1538
-                        width = slice_width[i], height = unit(1, "npc"), just = "left")
1561
+                    draw_annotation(object, k = i, which = "bottom", x = slice_x[i], width = slice_width[i], 
1562
+                        y = unit(0, "npc"), height = unit(1, "npc") - COLUMN_ANNO_PADDING, 
1563
+                        just = c("left", "bottom"))
1539 1564
                 }
1540 1565
             })
1541 1566
         }
... ...
@@ -1551,8 +1576,9 @@ setMethod(f = "make_layout",
1551 1576
             object@layout$layout_index = rbind(object@layout$layout_index, row_anno_left = heatmap_layout_index("row_anno_left"))
1552 1577
             object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) {
1553 1578
                     for(i in seq_len(nr_slice)) {
1554
-                        draw_annotation(object, k = i, which = "left",  y = slice_y[i], 
1555
-                            height = slice_height[i], width = unit(1, "npc"), just = "top") 
1579
+                        draw_annotation(object, k = i, which = "left",  y = slice_y[i], height = slice_height[i], 
1580
+                            x = unit(0, "npc"), width = unit(1, "npc") - ROW_ANNO_PADDING, 
1581
+                            just = c("left", "top"))
1556 1582
                     }
1557 1583
                 }
1558 1584
             )
... ...
@@ -1569,8 +1595,9 @@ setMethod(f = "make_layout",
1569 1595
             object@layout$layout_index = rbind(object@layout$layout_index, row_anno_right = heatmap_layout_index("row_anno_right"))
1570 1596
             object@layout$graphic_fun_list = c(object@layout$graphic_fun_list, function(object) {
1571 1597
                 for(i in seq_len(nr_slice)) {
1572
-                    draw_annotation(object, k = i, which = "right", y = slice_y[i], 
1573
-                        height = slice_height[i], width = unit(1, "npc"), just = "top")
1598
+                    draw_annotation(object, k = i, which = "right", y = slice_y[i], height = slice_height[i], 
1599
+                        x = ROW_ANNO_PADDING, width = unit(1, "npc") - ROW_ANNO_PADDING, 
1600
+                        just = c("left", "top"))
1574 1601
                 }
1575 1602
             })
1576 1603
         }
... ...
@@ -1895,7 +1922,7 @@ R_binary = function() {
1895 1922
 setMethod(f = "draw_dend",
1896 1923
     signature = "Heatmap",
1897 1924
     definition = function(object,
1898
-    which = c("row", "column"), k = 1, ...) {
1925
+    which = c("row", "column"), k = 1, max_height = NULL, ...) {
1899 1926
 
1900 1927
     which = match.arg(which)[1]
1901 1928
     
... ...
@@ -1921,19 +1948,20 @@ setMethod(f = "draw_dend",
1921 1948
         return(invisible(NULL))
1922 1949
     }
1923 1950
 
1924
-    max_height = dend_heights(dend)
1951
+    if(is.null(max_height)) {
1952
+        max_height = dend_heights(dend)
1953
+    }
1925 1954
 
1926
-    dend_padding = unit(1, "mm")
1927 1955
     if(side %in% c("left", "right")) {
1928 1956
         xscale = c(0, max_height)
1929 1957
         yscale = c(0, nobs(dend))
1930
-        width = unit(1, "npc") - dend_padding*2
1958
+        width = unit(1, "npc")
1931 1959
         height = unit(1, "npc")
1932 1960
         name = paste(object@name, "dend_row", k, sep = "_")
1933 1961
     } else {
1934 1962
         xscale = c(0, nobs(dend))
1935 1963
         yscale = c(0, max_height)
1936
-        height = unit(1, "npc") - dend_padding*2
1964
+        height = unit(1, "npc")
1937 1965
         width = unit(1, "npc")
1938 1966
         name = paste(object@name, "dend_column", k, sep = "_")
1939 1967
     }
... ...
@@ -104,7 +104,7 @@ HeatmapAnnotation = function(...,
104 104
 
105 105
 	fun_args = names(as.list(environment()))
106 106
 
107
-	verbose = ht_global_opt$verbose
107
+	verbose = ht_opt$verbose
108 108
 	
109 109
 	.Object = new("HeatmapAnnotation")
110 110
 
... ...
@@ -266,8 +266,7 @@ setMethod(f = "make_layout",
266 266
     show_annotation_legend = TRUE, 
267 267
     annotation_legend_list = list(),
268 268
 
269
-    gap = unit(2, "mm"), 
270
-    ht_gap = gap, 
269
+    ht_gap = unit(2, "mm"), 
271 270
 
272 271
     main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1],
273 272
     padding = NULL,
... ...
@@ -286,10 +285,8 @@ setMethod(f = "make_layout",
286 285
     row_dend_reorder = NULL,
287 286
     row_dend_gp = NULL,
288 287
     row_order = NULL,
289
-    km = NULL,
290
-    split = NULL,
291
-    row_km = km,
292
-    row_split = split,
288
+    row_km = NULL,
289
+    row_split = NULL,
293 290
     heatmap_body_height = NULL,
294 291
 
295 292
     column_gap = NULL,
... ...
@@ -301,11 +298,11 @@ setMethod(f = "make_layout",
301 298
     column_dend_reorder = NULL,
302 299
     column_dend_gp = NULL,
303 300
     column_order = NULL,
304
-    column_km = km,
301
+    column_km = NULL,
305 302
     column_split = NULL,
306 303
     heatmap_body_width = NULL) {
307 304
 
308
-    verbose = ht_global_opt("verbose")
305
+    verbose = ht_opt("verbose")
309 306
 
310 307
     if(object@layout$initialized) {
311 308
         if(verbose) qqcat("heatmap list is already initialized\n")
... ...
@@ -1014,33 +1011,96 @@ setMethod(f = "make_layout",
1014 1011
 setMethod(f = "draw",
1015 1012
     signature = "HeatmapList",
1016 1013
     definition = function(object, 
1017
-        padding = NULL, 
1018
-        newpage = TRUE,
1019
-        row_title = character(0), 
1020
-        row_title_side = c("left", "right"), 
1021
-        row_title_gp = gpar(fontsize = 14),
1022
-        column_title = character(0), 
1023
-        column_title_side = c("top", "bottom"), 
1024
-        column_title_gp = gpar(fontsize = 14), 
1025
-        heatmap_legend_side = c("right", "left", "bottom", "top"), 
1026
-        heatmap_legend_offset = unit(0, "mm"),
1027
-        show_heatmap_legend = TRUE, 
1028
-        heatmap_legend_list = list(),
1029
-        annotation_legend_side = c("right", "left", "bottom", "top"), 
1030
-        annotation_legend_offset = unit(0, "mm"),
1031
-        show_annotation_legend = TRUE, 
1032
-        annotation_legend_list = list(),
1033
-        gap = unit(2, "mm"), 
1034
-        main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1],
1035
-        row_dend_side = c("original", "left", "right"),
1036
-        row_sub_title_side = c("original", "left", "right"), ...) {
1014
+    newpage = TRUE,
1015
+
1016
+    row_title = character(0), 
1017
+    row_title_side = c("left", "right"), 
1018
+    row_title_gp = gpar(fontsize = 14),
1019
+    column_title = character(0), 
1020
+    column_title_side = c("top", "bottom"), 
1021
+    column_title_gp = gpar(fontsize = 14), 
1022
+
1023
+    heatmap_legend_side = c("right", "left", "bottom", "top"), 
1024
+    heatmap_legend_offset = unit(0, "mm"),
1025
+    merge_legends = FALSE,
1026
+    show_heatmap_legend = TRUE, 
1027
+    heatmap_legend_list = list(),
1028
+    annotation_legend_side = c("right", "left", "bottom", "top"), 
1029
+    annotation_legend_offset = unit(0, "mm"),
1030
+    show_annotation_legend = TRUE, 
1031
+    annotation_legend_list = list(),
1032
+
1033
+    gap = unit(2, "mm"), 
1034
+    ht_gap = gap, 
1035
+
1036
+    main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1],
1037
+    padding = NULL,
1038
+
1039
+    row_dend_side = c("original", "left", "right"),
1040
+    row_sub_title_side = c("original", "left", "right"),
1041
+    column_dend_side = c("original", "top", "bottom"),
1042
+    column_sub_title_side = c("original", "top", "bottom"),
1043
+    
1044
+    row_gap = NULL,
1045
+    cluster_rows = NULL,
1046
+    clustering_distance_rows = NULL,
1047
+    clustering_method_rows = NULL,
1048
+    row_dend_width = NULL, 
1049
+    show_row_dend = NULL, 
1050
+    row_dend_reorder = NULL,
1051
+    row_dend_gp = NULL,
1052
+    row_order = NULL,
1053
+    km = NULL,
1054
+    split = NULL,
1055
+    row_km = km,
1056
+    row_split = split,
1057
+    heatmap_body_height = NULL,
1058
+
1059
+    column_gap = NULL,
1060
+    cluster_columns = NULL,
1061
+    clustering_distance_columns = NULL,
1062
+    clustering_method_columns = NULL,
1063
+    column_dend_width = NULL, 
1064
+    show_column_dend = NULL, 
1065
+    column_dend_reorder = NULL,
1066
+    column_dend_gp = NULL,
1067
+    column_order = NULL,
1068
+    column_km = NULL,
1069
+    column_split = NULL,
1070
+    heatmap_body_width = NULL,
1071
+
1072
+    ### global setting
1073
+    heatmap_row_names_gp = NULL,
1074
+    heatmap_column_names_gp = NULL,
1075
+    heatmap_row_title_gp = NULL,
1076
+    heatmap_column_title_gp = NULL,
1077
+    legend_title_gp = NULL,
1078
+    legend_title_position = NULL,
1079
+    legend_labels_gp = NULL,
1080
+    legend_grid_height = NULL,
1081
+    legend_grid_width = NULL,
1082
+    legend_grid_border = NULL,
1083
+    fastcluster = NULL,
1084
+    show_vp_border = NULL,
1085
+    anno_simple_row_size = NULL
1086
+    ) {
1087
+
1088
+    direction = object@direction
1037 1089
 
1038 1090
     l = sapply(object@ht_list, inherits, "Heatmap")
1039 1091
     if(! any(l)) {
1040
-        stop("There should be at least one Heatmap in the heatmap list. You can add a matrix with zero column to the list.")
1041
-    }
1042
-    if(nrow(object@ht_list[[ which(l)[1] ]]@matrix) == 0 && length(l) > 1) {
1043
-        stop("Since you have a zeor-row matrix, only one heatmap (no row annotation) is allowed.")
1092
+        ob = sapply(object@ht_list, nobs)
1093
+        ob = ob[!is.na(ob)]
1094
+        if(length(ob) == 0) {
1095
+            stop("There is no heatmap in the list and cannot infer the number of observations in the heatmap annotations, please add a zero row/column matrix by hand.")
1096
+        }
1097
+        if(direction == "horizontal") {
1098
+            nr = ob[1]
1099
+            object = object + Heatmap(matrix(nc = 0, nr = nr))
1100
+        } else {
1101
+            nc = ob[1]
1102
+            object = object %v% Heatmap(matrix(nr = 0, nc = nc))
1103
+        }
1044 1104
     }
1045 1105
 
1046 1106
     if(newpage) {
... ...
@@ -1059,26 +1119,85 @@ setMethod(f = "draw",
1059 1119
     object = make_layout(
1060 1120
         object, 
1061 1121
         row_title = row_title, 
1062
-        row_title_gp = row_title_gp, 
1063
-        row_title_side = row_title_side,
1122
+        row_title_side = row_title_side, 
1123
+        row_title_gp = row_title_gp,
1064 1124
         column_title = column_title, 
1065 1125
         column_title_side = column_title_side, 
1066
-        column_title_gp = column_title_gp,
1126
+        column_title_gp = column_title_gp, 
1127
+
1067 1128
         heatmap_legend_side = heatmap_legend_side, 
1129
+        merge_legends = merge_legends,
1068 1130
         show_heatmap_legend = show_heatmap_legend, 
1069 1131
         heatmap_legend_list = heatmap_legend_list,
1070 1132
         annotation_legend_side = annotation_legend_side, 
1071
-        show_annotation_legend = show_annotation_legend,
1072
-        annotation_legend_list = annotation_legend_list, 
1073
-        gap = gap, 
1074
-        main_heatmap = main_heatmap, 
1133
+        show_annotation_legend = show_annotation_legend, 
1134
+        annotation_legend_list = annotation_legend_list,
1135
+
1136
+        ht_gap = ht_gap, 
1137
+
1138
+        main_heatmap = main_heatmap,
1139
+        padding = padding,
1140
+
1075 1141
         row_dend_side = row_dend_side,
1076
-        row_sub_title_side = row_sub_title_side, 
1077
-        padding = padding, 
1078
-        ...
1142
+        row_sub_title_side = row_sub_title_side,
1143
+        column_dend_side = column_dend_side,
1144
+        column_sub_title_side = column_sub_title_side,
1145
+        
1146
+        row_gap = row_gap,
1147
+        cluster_rows = cluster_rows,
1148
+        clustering_distance_rows = clustering_distance_rows,
1149
+        clustering_method_rows = clustering_method_rows,
1150
+        row_dend_width = row_dend_width, 
1151
+        show_row_dend = show_row_dend, 
1152
+        row_dend_reorder = row_dend_reorder,
1153
+        row_dend_gp = row_dend_gp,
1154
+        row_order = row_order,
1155
+        row_km = row_km,
1156
+        row_split = row_split,
1157
+        heatmap_body_height = heatmap_body_height,
1158
+
1159
+        column_gap = column_gap,
1160
+        cluster_columns = cluster_columns,
1161
+        clustering_distance_columns = clustering_distance_columns,
1162
+        clustering_method_columns = clustering_method_columns,
1163
+        column_dend_width = column_dend_width, 
1164
+        show_column_dend = show_column_dend, 
1165
+        column_dend_reorder = column_dend_reorder,
1166
+        column_dend_gp = column_dend_gp,
1167
+        column_order = column_order,
1168
+        column_km = column_km,
1169
+        column_split = column_split,
1170
+        heatmap_body_width = heatmap_body_width
1079 1171
     )
1080 1172
 
1081
-    
1173
+    verbose = ht_opt$verbose
1174
+
1175
+    ovl = list()
1176
+    for(opt_nm in c("heatmap_row_names_gp",
1177
+                    "heatmap_column_names_gp",
1178
+                    "heatmap_row_title_gp",
1179
+                    "heatmap_column_title_gp",
1180
+                    "legend_title_gp",
1181
+                    "legend_title_position",
1182
+                    "legend_labels_gp",
1183
+                    "legend_grid_height",
1184
+                    "legend_grid_width",
1185
+                    "legend_grid_border",
1186
+                    "fastcluster",
1187
+                    "show_vp_border",
1188
+                    "anno_simple_row_size")) {
1189
+        v = get(opt_nm, inherits = FALSE)
1190
+        if(!is.null(v)) {
1191
+            ovl[[opt_nm]] = ht_opt[[opt_nm]]
1192
+            ht_opt[[opt_nm]] = v
1193
+
1194
+            if(verbose) qqcat("temporarily set the global parameter @{opt_nm}\n")
1195
+        }
1196
+    }
1197
+    if(length(ovl)) {
1198
+        on.exit(ht_opt(ovl))
1199
+    }
1200
+
1082 1201
     padding = object@ht_list_param$padding
1083 1202
     layout = grid.layout(nrow = length(HEATMAP_LIST_LAYOUT_COLUMN_COMPONENT), 
1084 1203
         ncol = length(HEATMAP_LAYOUT_ROW_COMPONENT), 
... ...
@@ -1178,7 +1297,7 @@ setMethod(f = "component_width",
1178 1297
                     if(inherits(ht, "Heatmap")) {
1179 1298
                         ht@heatmap_param$width
1180 1299
                     } else {
1181
-                        ht@size
1300
+                        size(ht)
1182 1301
                     }
1183 1302
                 })))
1184 1303
             if(is_abs_unit(width)) {
... ...
@@ -1223,7 +1342,7 @@ setMethod(f = "component_height",
1223 1342
                     if(inherits(ht, "Heatmap")) {
1224 1343
                         ht@heatmap_param$height
1225 1344
                     } else {
1226
-                        ht@size
1345
+                        size(ht)
1227 1346
                     }
1228 1347
                 })))
1229 1348
             if(is_abs_unit(height)) {
... ...
@@ -1243,7 +1362,7 @@ setMethod(f = "adjust_heatmap_list",
1243 1362
     signature = "HeatmapList",
1244 1363
     definition = function(object) {
1245 1364
     
1246
-    verbose = ht_global_opt("verbose")
1365
+    verbose = ht_opt("verbose")
1247 1366
 
1248 1367
     ## this function does mainly two things
1249 1368
     ## 1. calculate viewport/layout for individual heatmaps/annotations
... ...
@@ -1257,20 +1376,20 @@ setMethod(f = "adjust_heatmap_list",
1257 1376
     if(direction == "horizontal") {
1258 1377
 
1259 1378
         # adjust top anntatation, top annotation of all heatmaps should be aligned
1260
-        max_top_anno_height = max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_height(ht, "column_anno_top"))))
1379
+        max_top_anno_height = max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_height(ht, "column_anno_top")))) - COLUMN_ANNO_PADDING
1261 1380
         max_top_anno_height = convertHeight(max_top_anno_height, "mm")
1262
-        max_bottom_anno_height = max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_height(ht, "column_anno_bottom"))))
1381
+        max_bottom_anno_height = max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_height(ht, "column_anno_bottom")))) - COLUMN_ANNO_PADDING
1263 1382
         max_bottom_anno_height = convertHeight(max_bottom_anno_height, "mm")
1264 1383
         for(i in ht_index) {
1265 1384
             if(has_component(object@ht_list[[i]], "column_anno_top")) {
1266 1385
                 if(verbose) qqcat("adjust height of top annotation of heamtap @{object@ht_list[[i]]@name}\n")
1267 1386
                 object@ht_list[[i]]@top_annotation = resize(object@ht_list[[i]]@top_annotation, height = max_top_anno_height)
1268
-                object@ht_list[[i]] = set_component_height(object@ht_list[[i]], "column_anno_top", object@ht_list[[i]]@top_annotation@height)
1387
+                object@ht_list[[i]] = set_component_height(object@ht_list[[i]], "column_anno_top", object@ht_list[[i]]@top_annotation@height + COLUMN_ANNO_PADDING)
1269 1388
             }
1270 1389
             if(has_component(object@ht_list[[i]], "column_anno_bottom")) {   
1271 1390
                 if(verbose) qqcat("adjust height of bottom annotation of heamtap @{object@ht_list[[i]]@name}\n")
1272 1391
                 object@ht_list[[i]]@bottom_annotation = resize(object@ht_list[[i]]@bottom_annotation, height = max_bottom_anno_height)
1273
-                object@ht_list[[i]] = set_component_height(object@ht_list[[i]], "column_anno_bottom", object@ht_list[[i]]@bottom_annotation@height)
1392
+                object@ht_list[[i]] = set_component_height(object@ht_list[[i]], "column_anno_bottom", object@ht_list[[i]]@bottom_annotation@height + COLUMN_ANNO_PADDING)
1274 1393
             }
1275 1394
         }
1276 1395
 
... ...
@@ -1331,7 +1450,7 @@ setMethod(f = "adjust_heatmap_list",
1331 1450
                     total_null_units_lt = c(total_null_units_lt, list(ht@matrix_param$width))
1332 1451
                 }
1333 1452
             } else {
1334
-                total_fixed_width = total_fixed_width + ht@size
1453
+                total_fixed_width = total_fixed_width + size(ht)
1335 1454
             }
1336 1455
         }
1337 1456
         if(n > 1) {
... ...
@@ -1346,7 +1465,7 @@ setMethod(f = "adjust_heatmap_list",
1346 1465
                 if(inherits(ht, "Heatmap")) {
1347 1466
                     ht@heatmap_param$width
1348 1467
                 } else {
1349
-                    ht@size
1468
+                    size(ht)
1350 1469
                 }
1351 1470
             })
1352 1471
         } else {
... ...
@@ -1360,7 +1479,7 @@ setMethod(f = "adjust_heatmap_list",
1360 1479
                         sum(component_width(ht, setdiff(names(HEATMAP_LAYOUT_ROW_COMPONENT), "heatmap_body"))) + ht@matrix_param$width[[1]]*unit_per_null
1361 1480
                     }
1362 1481
                 } else {
1363
-                    ht@size
1482
+                    size(ht)
1364 1483
                 }
1365 1484
             })
1366 1485
         }
... ...
@@ -1394,20 +1513,20 @@ setMethod(f = "adjust_heatmap_list",
1394 1513
         }
1395 1514
     } else {
1396 1515
         # adjust left anntatation, right annotation of all heatmaps should be aligned
1397
-        max_left_anno_width = max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_width(ht, "row_anno_left"))))
1516
+        max_left_anno_width = max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_width(ht, "row_anno_left")))) - ROW_ANNO_PADDING
1398 1517
         max_left_anno_width = convertWidth(max_left_anno_width, "mm")
1399
-        max_right_anno_width = max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_width(ht, "row_anno_right"))))
1518
+        max_right_anno_width = max(do.call("unit.c", lapply(object@ht_list[ht_index], function(ht) component_width(ht, "row_anno_right")))) - ROW_ANNO_PADDING
1400 1519
         max_right_anno_width = convertWidth(max_right_anno_width, "mm")
1401 1520
         for(i in ht_index) {
1402 1521
             if(has_component(object@ht_list[[i]], "row_anno_left")) {
1403 1522
                 if(verbose) qqcat("adjust width of left annotation of heamtap @{object@ht_list[[i]]@name}\n")
1404 1523
                 object@ht_list[[i]]@left_annotation = resize(object@ht_list[[i]]@left_annotation, width = max_left_anno_width)
1405
-                object@ht_list[[i]] = set_component_width(object@ht_list[[i]], "row_anno_left", object@ht_list[[i]]@left_annotation@width)
1524
+                object@ht_list[[i]] = set_component_width(object@ht_list[[i]], "row_anno_left", object@ht_list[[i]]@left_annotation@width + ROW_ANNO_PADDING)
1406 1525
             }
1407 1526
             if(has_component(object@ht_list[[i]], "row_anno_right")) {   
1408 1527
                 if(verbose) qqcat("adjust width of right annotation of heamtap @{object@ht_list[[i]]@name}\n")
1409 1528
                 object@ht_list[[i]]@right_annotation = resize(object@ht_list[[i]]@right_annotation, width = max_right_anno_width)
1410
-                object@ht_list[[i]] = set_component_width(object@ht_list[[i]], "row_anno_right", object@ht_list[[i]]@right_annotation@width)
1529
+                object@ht_list[[i]] = set_component_width(object@ht_list[[i]], "row_anno_right", object@ht_list[[i]]@right_annotation@width + ROW_ANNO_PADDING)
1411 1530
             }
1412 1531
         }
1413 1532
 
... ...
@@ -1467,7 +1586,7 @@ setMethod(f = "adjust_heatmap_list",
1467 1586
                     total_null_units_lt = c(total_null_units_lt, list(ht@matrix_param$height))
1468 1587
                 }
1469 1588
             } else {
1470
-                total_fixed_height = total_fixed_height + ht@size
1589
+                total_fixed_height = total_fixed_height + size(ht)
1471 1590
             }
1472 1591
         }
1473 1592
         if(n > 1) {
... ...
@@ -1482,7 +1601,7 @@ setMethod(f = "adjust_heatmap_list",
1482 1601
                 if(inherits(ht, "Heatmap")) {
1483 1602
                     ht@heatmap_param$height
1484 1603
                 } else {
1485
-                    ht@size
1604
+                    size(ht)
1486 1605
                 }
1487 1606
             })
1488 1607
         } else {
... ...
@@ -1496,7 +1615,7 @@ setMethod(f = "adjust_heatmap_list",
1496 1615
                         sum(component_height(ht, setdiff(names(HEATMAP_LAYOUT_COLUMN_COMPONENT), "heatmap_body"))) + ht@matrix_param$height[[1]]*unit_per_null
1497 1616
                     }
1498 1617
                 } else {
1499
-                    ht@size
1618
+                    size(ht)
1500 1619
                 }
1501 1620
             })
1502 1621
         }
... ...
@@ -1624,9 +1743,9 @@ setMethod(f = "draw_heatmap_list",
1624 1743
                 draw(ht, internal = TRUE)
1625 1744
             } else if(inherits(ht, "HeatmapAnnotation")) {
1626 1745
                 # calcualte the position of the heatmap body
1627
-                pushViewport(viewport(x = max_bottom_component_width, width = unit(1, "npc") - max_left_component_width - max_right_component_width, just = c("left")))
1746
+                pushViewport(viewport(x = max_left_component_width, width = unit(1, "npc") - max_left_component_width - max_right_component_width, just = c("left")))
1628 1747
                 for(j in seq_len(n_slice)) {
1629
-                    draw(ht, index = ht_main@row_order_list[[j]], x = slice_x[j], width = slice_width[j], just = slice_just[2], k = j, n = n_slice)
1748
+                    draw(ht, index = ht_main@column_order_list[[j]], x = slice_x[j], width = slice_width[j], just = slice_just[1], k = j, n = n_slice)
1630 1749
                 }
1631 1750
                 upViewport()
1632 1751
             }
... ...
@@ -1757,18 +1876,18 @@ setMethod(f = "draw_heatmap_legend",
1757 1876
 
1758 1877
     if(side != annotation_legend_side) {
1759 1878
         y = unit(0.5, "npc")
1760
-        pushViewport(viewport(x = unit(0.5, "npc"), y = y + offset, width = size[1], height = size[2], just = c("center", "center")))
1879
+        pushViewport(viewport(name = "heatmap_legend", x = unit(0.5, "npc"), y = y + offset, width = size[1], height = size[2], just = c("center", "center")))
1761 1880
     } else {
1762 1881
         if(side %in% c("left", "right")) {
1763 1882
             y1 = unit(0.5, "npc") + size[2]*0.5  # top of heatmap legend
1764 1883
             y2 = unit(0.5, "npc") + annotation_legend_size[2]*0.5
1765 1884
             y = max(y1, y2)
1766
-            pushViewport(viewport(x = unit(0.5, "npc"), y = y + offset, width = size[1], height = size[2], just = c("center", "top")))           
1885
+            pushViewport(viewport(name = "heatmap_legend", x = unit(0.5, "npc"), y = y + offset, width = size[1], height = size[2], just = c("center", "top")))           
1767 1886
         } else {
1768 1887
             x1 = unit(0.5, "npc") - size[1]*0.5  # top of heatmap legend
1769 1888
             x2 = unit(0.5, "npc") - annotation_legend_size[1]*0.5
1770 1889
             x = min(x1, x2)
1771
-            pushViewport(viewport(x = x, y = unit(0.5, "npc") + offset, width = size[1], height = size[2], just = c("left", "center")))           
1890
+            pushViewport(viewport(name = "heatmap_legend", x = x, y = unit(0.5, "npc") + offset, width = size[1], height = size[2], just = c("left", "center")))           
1772 1891
         }
1773 1892
     }
1774 1893
     draw_legend(ColorMappingList, ColorMappingParamList, side = side, legend_list = legend_list, padding = padding, ...)
... ...
@@ -151,21 +151,21 @@ SingleAnnotation = function(name, value, col, fun,
151 151
     .ENV$current_annotation_which = which
152 152
     on.exit(.ENV$current_SingleAnnotation_which <- NULL)
153 153
 
154
-    verbose = ht_global_opt$verbose
154
+    verbose = ht_opt$verbose
155 155
 
156 156
     # re-define some of the argument values according to global settings
157 157
     called_args = names(as.list(match.call())[-1])
158 158
     if("legend_param" %in% called_args) {
159 159
         for(opt_name in setdiff(c("title_gp", "title_position", "labels_gp", "grid_width", "grid_height", "grid_border"), names(legend_param))) {
160
-            opt_name2 = paste0("annotation_legend_", opt_name)
161
-            if(!is.null(ht_global_opt(opt_name2)))
162
-                legend_param[[opt_name]] = ht_global_opt(opt_name2)
160
+            opt_name2 = paste0("legend_", opt_name)
161
+            if(!is.null(ht_opt(opt_name2)))
162
+                legend_param[[opt_name]] = ht_opt(opt_name2)
163 163
         }
164 164
     } else {
165 165
         for(opt_name in c("title_gp", "title_position", "labels_gp", "grid_width", "grid_height", "grid_border")) {
166
-            opt_name2 = paste0("annotation_legend_", opt_name)
167
-            if(!is.null(ht_global_opt(opt_name2)))
168
-                legend_param[[opt_name]] = ht_global_opt(opt_name2)
166
+            opt_name2 = paste0("legend_", opt_name)
167
+            if(!is.null(ht_opt(opt_name2)))
168
+                legend_param[[opt_name]] = ht_opt(opt_name2)
169 169
         }
170 170
     }
171 171
 
... ...
@@ -525,7 +525,7 @@ setMethod(f = "draw",
525 525
         test2 = test
526 526
     }
527 527
 
528
-    verbose = ht_global_opt$verbose
528
+    verbose = ht_opt$verbose
529 529
 
530 530
     ## it draws annotation names, create viewports with names
531 531
     if(test2) {
... ...
@@ -560,6 +560,7 @@ setMethod(f = "draw",
560 560
         fun = object@fun
561 561
         if(verbose) qqcat("adjust annotation axis\n")
562 562
         if(!is.null(fun@var_env$axis)) {
563
+            axis_ov = fun@var_env$axis
563 564
             if(fun@var_env$axis && n > 1) {
564 565
                 if(object@which == "row") {
565 566
                     if(k == n && fun@var_env$axis_param$side == "bottom") {
... ...
@@ -581,6 +582,9 @@ setMethod(f = "draw",
581 582
             }
582 583
         }
583 584
         draw(fun, index = index)
585
+        if(!is.null(fun@var_env$axis)) {
586
+            fun@var_env$axis = axis_ov
587
+        }
584 588
     } else {
585 589
         if(verbose) qqcat("execute user-defined annotation function\n")
586 590
         object@fun(index, k, n)
... ...
@@ -71,41 +71,27 @@ ht_global_opt = setGlobalOptions(
71 71
 	heatmap_column_title_gp = list(
72 72
 		.value = NULL,
73 73
 		.class = "gpar"),
74
-	heatmap_legend_title_gp = list(
74
+	legend_title_gp = list(
75 75
 		.value = NULL,
76 76
 		.class = "gpar"),
77
-	heatmap_legend_title_position = list(
77
+	legend_title_position = list(
78 78
 		.value = NULL,
79 79
 		.class = "character"),
80
-	heatmap_legend_labels_gp = list(
80
+	legend_labels_gp = list(
81 81
 		.value = NULL,
82 82
 		.class = "gpar"),
83
-	heatmap_legend_grid_height = list(
83
+	legend_grid_height = list(
84 84
 		.value = NULL,
85 85
 		.class = "unit"),
86
-	heatmap_legend_grid_width = list(
86
+	legend_grid_width = list(
87 87
 		.value = NULL,
88 88
 		.class = "unit"),
89
-	heatmap_legend_grid_border = list(
89
+	legend_grid_border = list(
90 90
 		.value = NULL),
91 91
 
92
-	annotation_legend_title_gp = list(
93
-		.value = NULL,
94
-		.class = "gpar"),
95
-	annotation_legend_title_position = list(
96
-		.value = NULL,
97
-		.class = "character"),
98
-	annotation_legend_labels_gp = list(
99
-		.value = NULL,
100
-		.class = "gpar"),
101
-	annotation_legend_grid_height = list(
102
-		.value = NULL,
103
-		.class = "unit"),
104
-	annotation_legend_grid_width = list(
105
-		.value = NULL,
106
-		.class = "unit"),
107
-	annotation_legend_grid_border = list(
92
+	border = list(
108 93
 		.value = NULL),
94
+
109 95
 	fast_hclust = list(
110 96
 		.value = FALSE,
111 97
 		.class = "logical",
... ...
@@ -136,11 +122,11 @@ ht_opt = ht_global_opt
136 122
 .ENV$row_pos = NULL
137 123
 
138 124
 
139
-DENDROGRAM_PADDING = unit(1, "mm")
125
+DENDROGRAM_PADDING = unit(0.5, "mm")
140 126
 DIMNAME_PADDING = unit(1, "mm")
141 127
 TITLE_PADDING = unit(2.5, "mm")
142
-COLUMN_ANNO_PADDING = unit(1, "mm")
143
-ROW_ANNO_PADDING = unit(1, "mm")
128
+COLUMN_ANNO_PADDING = unit(0.5, "mm")
129
+ROW_ANNO_PADDING = unit(0.5, "mm")
144 130
 
145 131
 
146 132
 
... ...
@@ -386,7 +386,9 @@ upViewport = function(...) {
386 386
     if(ht_global_opt$show_vp_border) {
387 387
         grid.rect(gp = gpar(fill = "transparent", col = "black", lty = 3))
388 388
         vpname = current.viewport()$name
389
-        add_vp_name(vpname)
389
+        if(!grepl("^GRID.VP", vpname)) {
390
+            add_vp_name(vpname)
391
+        }
390 392
     }
391 393
     grid::upViewport(...)
392 394
 }
... ...
@@ -395,7 +397,9 @@ popViewport = function(...) {
395 397
     if(ht_global_opt$show_vp_border) {
396 398
         grid.rect(gp = gpar(fill = "transparent", col = "black", lty = 3))
397 399
         vpname = current.viewport()$name
398
-        add_vp_name(vpname)
400
+        if(!grepl("^GRID.VP", vpname)) {
401
+            add_vp_name(vpname)
402
+        }
399 403
     }
400 404
     grid::popViewport(...)
401 405
 }