Browse code

fixed device issue under rstudio

jokergoo authored on 25/10/2018 12:13:17
Showing6 changed files

... ...
@@ -13,7 +13,7 @@ Suggests: testthat (>= 0.3), knitr, markdown, cluster, MASS, pvclust,
13 13
     dendextend (>= 1.0.1), grImport, grImport2, rsvg, glue
14 14
 VignetteBuilder: knitr
15 15
 Description: Complex heatmaps are efficient to visualize associations 
16
-    between different sources of data sets and reveal potential structures. 
16
+    between different sources of data sets and reveal potential patterns. 
17 17
     Here the ComplexHeatmap package provides a highly flexible way to arrange 
18 18
     multiple heatmaps and supports various annotation graphics.
19 19
 biocViews: Software, Visualization, Sequencing
... ...
@@ -213,7 +213,7 @@ Heatmap = function(matrix, col, name,
213 213
     row_dend_side = c("left", "right"),
214 214
     row_dend_width = unit(10, "mm"), 
215 215
     show_row_dend = TRUE, 
216
-    row_dend_reorder = is.logical(cluster_rows),
216
+    row_dend_reorder = is.logical(cluster_rows) || is.function(cluster_rows),
217 217
     row_dend_gp = gpar(), 
218 218
     cluster_columns = TRUE, 
219 219
     clustering_distance_columns = "euclidean", 
... ...
@@ -222,7 +222,7 @@ Heatmap = function(matrix, col, name,
222 222
     column_dend_height = unit(10, "mm"), 
223 223
     show_column_dend = TRUE, 
224 224
     column_dend_gp = gpar(), 
225
-    column_dend_reorder = is.logical(cluster_columns),
225
+    column_dend_reorder = is.logical(cluster_columns) || is.function(cluster_columns),
226 226
 
227 227
     row_order = NULL, 
228 228
     column_order = NULL,
... ...
@@ -254,6 +254,7 @@ Heatmap = function(matrix, col, name,
254 254
     gap = unit(1, "mm"),
255 255
     row_gap = unit(1, "mm"),
256 256
     column_gap = unit(1, "mm"),
257
+    show_parent_dend_line = ht_opt$show_parent_dend_line,
257 258
 
258 259
     heatmap_width = unit(1, "npc"),
259 260
     width = NULL,
... ...
@@ -759,6 +760,7 @@ Heatmap = function(matrix, col, name,
759 760
     .Object@heatmap_param$verbose = verbose
760 761
     .Object@heatmap_param$post_fun = post_fun
761 762
     .Object@heatmap_param$calling_env = parent.frame()
763
+    .Object@heatmap_param$show_parent_dend_line = show_parent_dend_line
762 764
 
763 765
     if(nrow(matrix) == 0) {
764 766
         .Object@matrix_param$height = unit(0, "mm")
... ...
@@ -954,7 +956,7 @@ make_cluster = function(object, which = c("row", "column")) {
954 956
                 for(i in seq_along(dend_list)) {
955 957
                     if(length(order_list[[i]]) > 1) {
956 958
                         sub_ind = sort(order_list[[i]])
957
-                        dend_list[[i]] = reorder(dend_list[[i]], reorder[sub_ind])
959
+                        dend_list[[i]] = reorder(dend_list[[i]], reorder[sub_ind], mean)
958 960
                         # the order of object@row_dend_list[[i]] is the order corresponding to the big dendrogram
959 961
                         order_list[[i]] = order.dendrogram(dend_list[[i]])
960 962
                     }
... ...
@@ -1068,7 +1070,7 @@ make_cluster = function(object, which = c("row", "column")) {
1068 1070
         meanmat = as.matrix(as.data.frame(meanmat))
1069 1071
         hc = hclust(dist(t(meanmat)))
1070 1072
         weight = colMeans(meanmat)
1071
-        hc = as.hclust(reorder(as.dendrogram(hc), -weight))
1073
+        hc = as.hclust(reorder(as.dendrogram(hc), -weight, mean))
1072 1074
         cl2 = numeric(length(cl))
1073 1075
         for(i in seq_along(hc$order)) {
1074 1076
             cl2[cl == hc$order[i]] = i
... ...
@@ -1209,7 +1211,7 @@ make_cluster = function(object, which = c("row", "column")) {
1209 1211
             for(i in seq_along(dend_list)) {
1210 1212
                 if(length(order_list[[i]]) > 1) {
1211 1213
                     sub_ind = sort(order_list[[i]])
1212
-                    dend_list[[i]] = reorder(dend_list[[i]], reorder[sub_ind])
1214
+                    dend_list[[i]] = reorder(dend_list[[i]], reorder[sub_ind], mean)
1213 1215
                     order_list[[i]] = sub_ind[ order.dendrogram(dend_list[[i]]) ]
1214 1216
                 }
1215 1217
             }
... ...
@@ -201,19 +201,19 @@ setMethod(f = "make_layout",
201 201
                 }
202 202
                 row_dend_slice = adjust_dend_by_x(row_dend_slice, slice_leaf_pos)
203 203
                 grid.dendrogram(row_dend_slice, facing = ifelse(row_dend_side == "left", "right", "left"), gp = object@row_dend_param$gp)
204
-                if(!object@row_dend_param$split_by_cutree) {
204
+                if(!object@row_dend_param$split_by_cutree && object@heatmap_param$show_parent_dend_line) {
205 205
                     dh = dend_heights(object@row_dend_list)
206 206
                     if(row_dend_side == "left") {
207 207
                         grid.segments(unit(row_dend_max_height - max(dh), "native") - unit(0.5, "mm"), 
208
-                            slice_leaf_pos[1] + unit(5, "mm"), 
208
+                            min(unit.c(slice_leaf_pos[1] + unit(5, "mm"), unit(1, "npc"))), 
209 209
                             unit(row_dend_max_height - max(dh), "native") - unit(0.5, "mm"), 
210
-                            slice_leaf_pos[length(slice_leaf_pos)] - unit(5, "mm"),
210
+                            max(unit.c(slice_leaf_pos[length(slice_leaf_pos)] - unit(5, "mm"), unit(0, "npc"))),
211 211
                             gp = gpar(lty = 3, col = "#666666"))
212 212
                     } else {
213 213
                         grid.segments(unit(max(dh), "native") + unit(0.5, "mm"), 
214
-                            slice_leaf_pos[1] + unit(5, "mm"), 
214
+                            min(unit.c(slice_leaf_pos[1] + unit(5, "mm"), unit(1, "npc"))), 
215 215
                             unit(max(dh), "native") + unit(0.5, "mm"), 
216
-                            slice_leaf_pos[length(slice_leaf_pos)] - unit(5, "mm"),
216
+                            max(unit.c(slice_leaf_pos[length(slice_leaf_pos)] - unit(5, "mm"), unit(0, "npc"))),
217 217
                             gp = gpar(lty = 3, col = "#666666"))
218 218
                     }
219 219
                 }
... ...
@@ -274,18 +274,18 @@ setMethod(f = "make_layout",
274 274
                 }
275 275
                 column_dend_slice = adjust_dend_by_x(column_dend_slice, slice_leaf_pos)
276 276
                 grid.dendrogram(column_dend_slice, facing = ifelse(column_dend_side == "top", "bottom", "top"), gp = object@column_dend_param$gp)
277
-                if(!object@column_dend_param$split_by_cutree) {
277
+                if(!object@column_dend_param$split_by_cutree && object@heatmap_param$show_parent_dend_line) {
278 278
                     dh = dend_heights(object@column_dend_list)
279 279
                     if(row_dend_side == "bottom") {
280
-                        grid.segments(slice_leaf_pos[1] - unit(5, "mm"), 
280
+                        grid.segments(max(unit.c(slice_leaf_pos[1] - unit(5, "mm"), unit(0, "npc"))), 
281 281
                             unit(column_dend_max_height - max(dh), "native") - unit(0.5, "mm"), 
282
-                            slice_leaf_pos[length(slice_leaf_pos)] + unit(5, "mm"),
282
+                            min(unit.c(slice_leaf_pos[length(slice_leaf_pos)] + unit(5, "mm"), unit(1, "npc"))),
283 283
                             unit(column_dend_max_height - max(dh), "native") - unit(0.5, "mm"), 
284 284
                             gp = gpar(lty = 3, col = "#666666"))
285 285
                     } else {
286
-                        grid.segments(slice_leaf_pos[1] - unit(5, "mm"), 
286
+                        grid.segments(max(unit.c(slice_leaf_pos[1] - unit(5, "mm"), unit(0, "npc"))), 
287 287
                             unit(max(dh), "native") + unit(0.5, "mm"), 
288
-                            slice_leaf_pos[length(slice_leaf_pos)] + unit(5, "mm"),
288
+                            min(unit.c(slice_leaf_pos[length(slice_leaf_pos)] + unit(5, "mm"), unit(1, "npc"))),
289 289
                             unit(max(dh), "native") + unit(0.5, "mm"), 
290 290
                             gp = gpar(lty = 3, col = "#666666"))
291 291
                     }
... ...
@@ -238,6 +238,7 @@ setMethod(f = "add_heatmap",
238 238
 # -annotation_border  this set the value in `ht_opt` and reset back after the plot is done
239 239
 # -fastcluster this set the value in `ht_opt` and reset back after the plot is done
240 240
 # -anno_simple_size  this set the value in `ht_opt` and reset back after the plot is done
241
+# -show_parent_dend_line this set the value in `ht_opt` and reset back after the plot is done
241 242
 #
242 243
 # == detail
243 244
 # The function first calls `make_layout,HeatmapList-method` to calculate
... ...
@@ -333,7 +334,8 @@ setMethod(f = "draw",
333 334
     heatmap_border = NULL,
334 335
     annotation_border = NULL,
335 336
     fastcluster = NULL,
336
-    anno_simple_size = NULL
337
+    anno_simple_size = NULL,
338
+    show_parent_dend_line = NULL
337 339
     ) {
338 340
 
339 341
     verbose = ht_opt$verbose
... ...
@@ -352,7 +354,8 @@ setMethod(f = "draw",
352 354
                     "heatmap_border",
353 355
                     "annotation_border",
354 356
                     "fastcluster",
355
-                    "anno_simple_size")) {
357
+                    "anno_simple_size",
358
+                    "show_parent_dend_line")) {
356 359
         v = get(opt_nm, inherits = FALSE)
357 360
         if(!is.null(v)) {
358 361
             ovl[[opt_nm]] = ht_opt[[opt_nm]]
... ...
@@ -486,15 +489,15 @@ setMethod(f = "draw",
486 489
     ht_list_height = sum(component_height(object)) + padding[1] + padding[3]
487 490
 
488 491
     if(is_abs_unit(ht_list_width)) {
489
-        ht_list_width = unit(ceiling(convertWidth(ht_list_width, "mm", valueOnly = TRUE)), "mm")
490
-        qqcat("Since all heatmaps/annotations have absolute units, the total width of the plot is @{ht_list_width}\n")
492
+        ht_list_width = unit(convertWidth(ht_list_width, "mm", valueOnly = TRUE), "mm")
493
+        # qqcat("Since all heatmaps/annotations have absolute units, the total width of the plot is @{ht_list_width}\n")
491 494
         w = ht_list_width
492 495
     } else {
493 496
         w = unit(1, "npc")
494 497
     }
495 498
     if(is_abs_unit(ht_list_height)) {
496
-        ht_list_height = unit(ceiling(convertHeight(ht_list_height, "mm", valueOnly = TRUE)), "mm")
497
-        qqcat("Since all heatmaps/annotations have absolute units, the total height of the plot is @{ht_list_height}\n")
499
+        ht_list_height = unit(convertHeight(ht_list_height, "mm", valueOnly = TRUE), "mm")
500
+        # qqcat("Since all heatmaps/annotations have absolute units, the total height of the plot is @{ht_list_height}\n")
498 501
         h = ht_list_height
499 502
     } else {
500 503
         h = unit(1, "npc")
... ...
@@ -504,14 +507,13 @@ setMethod(f = "draw",
504 507
         ncol = length(HEATMAP_LAYOUT_ROW_COMPONENT), 
505 508
         widths = component_width(object), 
506 509
         heights = component_height(object))
507
-    
508 510
 
509 511
     pushViewport(viewport(name = "global", width = w, height = h))
510 512
     pushViewport(viewport(layout = layout, name = "global_layout", x = padding[2], y = padding[1], width = unit(1, "npc") - padding[2] - padding[4],
511 513
         height = unit(1, "npc") - padding[1] - padding[3], just = c("left", "bottom")))
512 514
     ht_layout_index = object@layout$layout_index
513 515
     ht_graphic_fun_list = object@layout$graphic_fun_list
514
-    
516
+
515 517
     for(j in seq_len(nrow(ht_layout_index))) {
516 518
         pushViewport(viewport(layout.pos.row = ht_layout_index[j, 1], layout.pos.col = ht_layout_index[j, 2]))
517 519
         ht_graphic_fun_list[[j]](object)
... ...
@@ -48,6 +48,7 @@
48 48
 # Other parameters:
49 49
 #
50 50
 # -fast_hclust whether use `fastcluster::hclust` to speed up clustering?
51
+# -show_parent_dend_line when heatmap is split, whether to add a dashed line to mark parent dendrogram and children dendrograms?
51 52
 #
52 53
 # You can get or set option values by the traditional way (like `base::options`) or by ``$`` operator:
53 54
 #
... ...
@@ -109,6 +110,8 @@ ht_opt = setGlobalOptions(
109 110
 		.class = "logical",
110 111
 		.length = 1
111 112
 	),
113
+	show_parent_dend_line = TRUE,
114
+
112 115
 	verbose = list(
113 116
 		.value = FALSE,
114 117
 		.class = "logical",
... ...
@@ -462,8 +462,17 @@ popViewport = function(...) {
462 462
 dev.off2 = function () {
463 463
     i1 = dev.prev()
464 464
     i2 = dev.cur()
465
-    if (i1 > 1)
465
+
466
+    if (i1 == 2) {
466 467
         dev.set(i1)
468
+    } else if(i1 > 2) {
469
+        i11 = dev.prev(i1)
470
+        if(names(i11) == "RStudioGD") {
471
+            dev.set(i11)
472
+        } else {
473
+            dev.set(i1)
474
+        }
475
+    }
467 476
     dev.off(i2)
468 477
 }
469 478