Browse code

update

Zuguang Gu authored on 28/07/2022 07:52:06
Showing1 changed files
... ...
@@ -228,7 +228,7 @@ setMethod(f = "draw_heatmap_body",
228 228
             }
229 229
             attr(image, "width") = heatmap_width_pt
230 230
             attr(image, "height") = heatmap_height_pt
231
-            assign(".image", image, envir = .GlobalEnv)
231
+            # assign(".image", image, envir = .GlobalEnv)
232 232
         }
233 233
         ########################
234 234
 
Browse code

global variables in cell_fun are automatically saved

Zuguang Gu authored on 02/04/2022 15:52:11
Showing1 changed files
... ...
@@ -60,6 +60,9 @@ setMethod(f = "draw_heatmap_body",
60 60
     if(!is.null(cell_fun)) {
61 61
         use_raster = FALSE
62 62
     }
63
+    if(identical(object@matrix_param$gp$type, "none")) {
64
+        use_raster = FALSE
65
+    }
63 66
    
64 67
     if(use_raster) {
65 68
 
Browse code

restrict the size of the temp raster image

Zuguang Gu authored on 28/09/2021 09:20:28
Showing1 changed files
... ...
@@ -139,8 +139,22 @@ setMethod(f = "draw_heatmap_body",
139 139
             temp_image_width = ceiling(max(heatmap_width_pt, 1))
140 140
             temp_image_height = ceiling(max(heatmap_height_pt, 1))
141 141
         }
142
-        do.call(device_fun, c(list(filename = temp_image, 
143
-            width = temp_image_width, height = temp_image_height), raster_device_param))
142
+        temp_image_width = as.integer(temp_image_width)
143
+        temp_image_height = as.integer(temp_image_height)
144
+
145
+        if(!is.na(ht_opt$raster_temp_image_max_width)) {
146
+            temp_image_width = min(temp_image_width, ht_opt$raster_temp_image_max_width)
147
+        }
148
+        if(!is.na(ht_opt$raster_temp_image_max_height)) {
149
+            temp_image_height = min(temp_image_height, ht_opt$raster_temp_image_max_height)
150
+        }
151
+
152
+        oe = try(do.call(device_fun, c(list(filename = temp_image, 
153
+            width = temp_image_width, height = temp_image_height), raster_device_param)))
154
+        if(inherits(oe, "try-error")) {
155
+            stop_wrap(qq("The size of the temporary image for rasterization is too huge (@{temp_image_width} x @{temp_image_height} px) that it is cannot be handled by the device function `@{device_info[1]}:@{raster_device}()`. Please reduce the maximal size of temporary image by setting proper values for `ht_opt$raster_temp_image_max_width` and `ht_opt$raster_temp_image_max_height`."))
156
+        }
157
+
144 158
         if(object@heatmap_param$verbose) {
145 159
             qqcat("saving into a temp image (.@{device_info[2]}) with size @{temp_image_width}x@{temp_image_height}px.\n")
146 160
         }
Browse code

set max scale to 1 when dendrogram height is zero

Zuguang Gu authored on 08/09/2021 08:28:57
Showing1 changed files
... ...
@@ -363,6 +363,7 @@ setMethod(f = "draw_dend",
363 363
     if(is.null(max_height)) {
364 364
         max_height = dend_heights(dend)
365 365
     }
366
+    if(max_height == 0) max_height = 1
366 367
 
367 368
     if(side %in% c("left", "right")) {
368 369
         xscale = c(0, max_height)
Browse code

update

Zuguang authored on 28/03/2021 08:14:55
Showing1 changed files
... ...
@@ -92,6 +92,10 @@ setMethod(f = "draw_heatmap_body",
92 92
         heatmap_width_pt = max(1, ceiling(convertWidth(unit(1, "npc"), "bigpts", valueOnly = TRUE)))
93 93
         heatmap_height_pt = max(1, ceiling(convertHeight(unit(1, "npc"), "bigpts", valueOnly = TRUE)))
94 94
 
95
+        if(raster_quality < 1) raster_quality = 1
96
+        heatmap_width_pt = ceiling(heatmap_width_pt * raster_quality)
97
+        heatmap_height_pt = ceiling(heatmap_height_pt * raster_quality)
98
+
95 99
         matrix_is_resized = FALSE
96 100
         # resize on the matrix
97 101
         raster_resize_mat = object@heatmap_param$raster_resize_mat
... ...
@@ -132,14 +136,8 @@ setMethod(f = "draw_heatmap_body",
132 136
             temp_image_width = ceiling(max(heatmap_width_pt, 1))
133 137
             temp_image_height = ceiling(max(heatmap_height_pt, 1))
134 138
         } else {
135
-            if(is.character(raster_quality)) {
136
-                temp_image_width = ceiling(max(heatmap_width_pt, nc, 1))
137
-                temp_image_height = ceiling(max(heatmap_height_pt, nr, 1))
138
-            } else {
139
-                if(raster_quality < 1) raster_quality = 1
140
-                temp_image_width = ceiling(max(heatmap_width_pt*raster_quality, 1))
141
-                temp_image_height = ceiling(max(heatmap_height_pt*raster_quality, 1))
142
-            }
139
+            temp_image_width = ceiling(max(heatmap_width_pt, 1))
140
+            temp_image_height = ceiling(max(heatmap_height_pt, 1))
143 141
         }
144 142
         do.call(device_fun, c(list(filename = temp_image, 
145 143
             width = temp_image_width, height = temp_image_height), raster_device_param))
Browse code

won't generate color matrix when type=='none'

Zuguang Gu authored on 15/12/2020 12:01:39
Showing1 changed files
... ...
@@ -44,7 +44,10 @@ setMethod(f = "draw_heatmap_body",
44 44
     pushViewport(viewport(name = paste(object@name, "heatmap_body", kr, kc, sep = "_"), ...))
45 45
 
46 46
     mat = object@matrix[row_order, column_order, drop = FALSE]
47
-    col_matrix = map_to_colors(object@matrix_color_mapping, mat)
47
+    oe = try(col_matrix <- map_to_colors(object@matrix_color_mapping, mat), silent = TRUE)
48
+    if(inherits(oe, "try-error")) {
49
+        col_matrix = matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
50
+    }
48 51
 
49 52
     nc = ncol(mat)
50 53
     nr = nrow(mat)
Browse code

temporary solution for retina display with Rstudio

Zuguang Gu authored on 10/11/2020 10:56:48
Showing1 changed files
... ...
@@ -613,7 +613,11 @@ setMethod(f = "draw_annotation",
613 613
                 anno_mark_param$.pos = .pos
614 614
                 anno_mark_param$index = unlist(ro_lt)
615 615
                 
616
-                anno_mark_param$vp_height = convertHeight(unit(1, "npc"), "cm")
616
+                if(abs(par("din")[2] - grDevices::dev.size("in")[2]) < 1e-6) {
617
+                    anno_mark_param$vp_height = convertHeight(unit(1, "npc"), "cm")  
618
+                } else {
619
+                    anno_mark_param$vp_height = convertHeight(unit(1, "npc"), "cm")*(par("din")[2]/grDevices::dev.size("in")[2])*0.9742
620
+                }
617 621
                 anno_mark_param$vp_width = unit(1, "npc")
618 622
                 anno_mark_param$vp_just = "top"
619 623
                 anno_mark_param$vp_x = unit(0.5, "npc")
... ...
@@ -644,7 +648,11 @@ setMethod(f = "draw_annotation",
644 648
                 anno_mark_param$index = unlist(co_lt)
645 649
                 
646 650
                 anno_mark_param$vp_height = unit(1, "npc")
647
-                anno_mark_param$vp_width = convertWidth(unit(1, "npc"), "cm")
651
+                if(abs(par("din")[1] - grDevices::dev.size("in")[1]) < 1e-6) {
652
+                    anno_mark_param$vp_width = convertWidth(unit(1, "npc"), "cm")
653
+                } else {
654
+                    anno_mark_param$vp_width = convertWidth(unit(1, "npc"), "cm")*(par("din")[1]/grDevices::dev.size("in")[1])*0.945
655
+                }
648 656
                 anno_mark_param$vp_just = "left"
649 657
                 anno_mark_param$vp_x = unit(0, "npc")
650 658
                 anno_mark_param$vp_y = unit(0.5, "npc")
Browse code

finally adjust the space of column title according to ggplot2

Zuguang Gu authored on 30/10/2020 15:10:21
Showing1 changed files
... ...
@@ -505,6 +505,14 @@ setMethod(f = "draw_title",
505 505
         "row" = object@row_title_param$just,
506 506
         "column" = object@column_title_param$just)
507 507
 
508
+    if(!is.null(ht_opt$TITLE_PADDING)) {
509
+        title_padding = ht_opt$TITLE_PADDING
510
+    } else {
511
+        title_padding = unit(c(0, 0), "points")
512
+        title_padding[1] = title_padding[1] + unit(5.5, "points") + 
513
+            convertHeight(grobDescent(textGrob(label = "jA", gp = gp)), "inches")
514
+    }
515
+
508 516
     if(which == "row") {
509 517
         
510 518
         pushViewport(viewport(name = paste(object@name, "row_title", k, sep = "_"), clip = FALSE, ...))
... ...
@@ -512,9 +520,9 @@ setMethod(f = "draw_title",
512 520
         if("border" %in% names(gp2)) gp2$col = gp2$border
513 521
         if(any(c("border", "fill") %in% names(gp2))) grid.rect(gp = gp2)
514 522
         if(side == "left") {
515
-            grid.text(title, x = unit(1, "npc") - ht_opt$TITLE_PADDING[1], rot = rot, just = just, gp = gp)
523
+            grid.text(title, x = unit(1, "npc") - title_padding[1], rot = rot, just = just, gp = gp)
516 524
         } else {
517
-            grid.text(title, x = ht_opt$TITLE_PADDING[1], rot = rot, just = just, gp = gp)
525
+            grid.text(title, x = title_padding[1], rot = rot, just = just, gp = gp)
518 526
         }
519 527
         upViewport()
520 528
     } else {
... ...
@@ -523,9 +531,9 @@ setMethod(f = "draw_title",
523 531
         if("border" %in% names(gp2)) gp2$col = gp2$border
524 532
         if(any(c("border", "fill") %in% names(gp2))) grid.rect(gp = gp2)
525 533
         if(side == "top") {
526
-            grid.text(title, y = ht_opt$TITLE_PADDING[1], rot = rot, just = just, gp = gp)
534
+            grid.text(title, y = title_padding[1], rot = rot, just = just, gp = gp)
527 535
         } else {
528
-            grid.text(title, y = unit(1, "npc") - ht_opt$TITLE_PADDING[1], rot = rot, just = just, gp = gp)
536
+            grid.text(title, y = unit(1, "npc") - title_padding[1], rot = rot, just = just, gp = gp)
529 537
         }
530 538
         upViewport()
531 539
     }
Browse code

set default type for raster_device to cairo

Zuguang Gu authored on 26/10/2020 10:43:49
Showing1 changed files
... ...
@@ -77,6 +77,14 @@ setMethod(f = "draw_heatmap_body",
77 77
             stop_wrap(paste0("Need ", device_info[2], " package to read image."))
78 78
         }
79 79
 
80
+        if(raster_device %in% c("png", "jpeg", "tiff")) {
81
+            if(! "type" %in% names(raster_device_param)) {
82
+                if(capabilities("cairo")) {
83
+                    raster_device_param$type = "cairo"
84
+                }
85
+            }
86
+        }
87
+
80 88
         # can we get the size of the heatmap body?
81 89
         heatmap_width_pt = max(1, ceiling(convertWidth(unit(1, "npc"), "bigpts", valueOnly = TRUE)))
82 90
         heatmap_height_pt = max(1, ceiling(convertHeight(unit(1, "npc"), "bigpts", valueOnly = TRUE)))
... ...
@@ -188,7 +196,7 @@ setMethod(f = "draw_heatmap_body",
188 196
 
189 197
         grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"), interpolate = FALSE)
190 198
 
191
-        ### only for testing ###
199
+        ### only for testing the temp image size ###
192 200
         if(ht_opt("__export_image_size__")) {
193 201
             if(inherits(image, "magick-image")) {
194 202
                 image = as.raster(image)
Browse code

Legend(): add row_gap and column_gap arguments

Zuguang Gu authored on 22/10/2020 10:44:27
Showing1 changed files
... ...
@@ -504,7 +504,7 @@ setMethod(f = "draw_title",
504 504
         if("border" %in% names(gp2)) gp2$col = gp2$border
505 505
         if(any(c("border", "fill") %in% names(gp2))) grid.rect(gp = gp2)
506 506
         if(side == "left") {
507
-            grid.text(title, x = unit(1, "npc") - ht_opt$TITLE_PADDING[2], rot = rot, just = just, gp = gp)
507
+            grid.text(title, x = unit(1, "npc") - ht_opt$TITLE_PADDING[1], rot = rot, just = just, gp = gp)
508 508
         } else {
509 509
             grid.text(title, x = ht_opt$TITLE_PADDING[1], rot = rot, just = just, gp = gp)
510 510
         }
... ...
@@ -517,7 +517,7 @@ setMethod(f = "draw_title",
517 517
         if(side == "top") {
518 518
             grid.text(title, y = ht_opt$TITLE_PADDING[1], rot = rot, just = just, gp = gp)
519 519
         } else {
520
-            grid.text(title, y = unit(1, "npc") - ht_opt$TITLE_PADDING[2], rot = rot, just = just, gp = gp)
520
+            grid.text(title, y = unit(1, "npc") - ht_opt$TITLE_PADDING[1], rot = rot, just = just, gp = gp)
521 521
         }
522 522
         upViewport()
523 523
     }
Browse code

col argument can be a super set of the elements in the character matrix

Zuguang Gu authored on 20/10/2020 19:30:27
Showing1 changed files
... ...
@@ -152,12 +152,12 @@ setMethod(f = "draw_heatmap_body",
152 152
         if(is.function(layer_fun)) {
153 153
             if(length(as.list(formals(layer_fun))) == 7) {
154 154
                 layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
155
-                    x[expand_index[[2]]], y[expand_index[[1]]],
155
+                    unit(x[expand_index[[2]]], "npc"), unit(y[expand_index[[1]]], "npc"),
156 156
                     unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
157 157
                     as.vector(col_matrix))
158 158
             } else {
159 159
                 layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
160
-                    x[expand_index[[2]]], y[expand_index[[1]]],
160
+                    unit(x[expand_index[[2]]], "npc"), unit(y[expand_index[[1]]], "npc"),
161 161
                     unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
162 162
                     as.vector(col_matrix), kr, kc)
163 163
             }
... ...
@@ -231,14 +231,14 @@ setMethod(f = "draw_heatmap_body",
231 231
         if(is.function(layer_fun)) {
232 232
             if(length(as.list(formals(layer_fun))) == 7) {
233 233
                 layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
234
-                    x[expand_index[[2]]], y[expand_index[[1]]],
234
+                    unit(x[expand_index[[2]]], "npc"), unit(y[expand_index[[1]]], "npc"),
235 235
                     unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
236 236
                     as.vector(col_matrix))
237 237
             } else {
238 238
                 layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
239
-                x[expand_index[[2]]], y[expand_index[[1]]],
240
-                unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
241
-                as.vector(col_matrix), kr, kc)
239
+                    unit(x[expand_index[[2]]], "npc"), unit(y[expand_index[[1]]], "npc"),
240
+                    unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
241
+                    as.vector(col_matrix), kr, kc)
242 242
             }
243 243
         }
244 244
     }
Browse code

heatmap name is converted to a hash when constructing temp file name

Zuguang Gu authored on 20/10/2020 14:11:30
Showing1 changed files
... ...
@@ -111,7 +111,7 @@ setMethod(f = "draw_heatmap_body",
111 111
         }
112 112
 
113 113
         temp_dir = tempdir()
114
-        temp_image = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", kr, "_", kc), tmpdir = temp_dir, fileext = paste0(".", device_info[2]))
114
+        temp_image = tempfile(pattern = paste0(".heatmap_body_", digest::digest(object@name), "_", kr, "_", kc), tmpdir = temp_dir, fileext = paste0(".", device_info[2]))
115 115
         device_fun = getFromNamespace(raster_device, ns = device_info[1])
116 116
 
117 117
         if(raster_by_magick) {
Browse code

change default raster device to CairoPNG

Zuguang Gu authored on 20/10/2020 13:15:35
Showing1 changed files
... ...
@@ -176,6 +176,7 @@ setMethod(f = "draw_heatmap_body",
176 176
             }
177 177
             image = magick::image_read(temp_image)
178 178
             image = magick::image_resize(image, paste0(heatmap_width_pt, "x", heatmap_height_pt, "!"), filter = raster_magick_filter)
179
+            image = as.raster(image)
179 180
         } else {
180 181
             if(object@heatmap_param$verbose) {
181 182
                 qqcat("image is read by @{device_info[2]}::@{device_info[3]}\n")
... ...
@@ -183,7 +184,7 @@ setMethod(f = "draw_heatmap_body",
183 184
             image = getFromNamespace(device_info[3], ns = device_info[2])(temp_image)
184 185
         }
185 186
         # validate image, there might be white horizontal lines and vertical lines 
186
-        image = validate_raster_matrix(image, mat, object@matrix_color_mapping)
187
+        # image = validate_raster_matrix(image, mat, object@matrix_color_mapping)
187 188
 
188 189
         grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"), interpolate = FALSE)
189 190
 
... ...
@@ -262,11 +263,29 @@ setMethod(f = "draw_heatmap_body",
262 263
 # careful: row orders of rgb and mat are reversed
263 264
 # rgb: values change from 0 to 1
264 265
 validate_raster_matrix = function(rgb, mat, col_mapping) {
265
-    # if(any(rgb[, 1, 1] == 1 & rgb[, 1, 2] == 1 & rgb[, 1, 3] == 1)) {
266
-    #     if(nrow(rgb) < nrow(mat)) {
266
+    if(is.character(rgb)) {
267
+        dim = dim(rgb)
268
+        x = col2rgb(rgb)/255
269
+        rgb = array(dim = c(dim, 3))
270
+        rgb[, , 1] = matrix(x[1, ], nrow = dim[1], ncol = dim[2], byrow = TRUE)
271
+        rgb[, , 2] = matrix(x[2, ], nrow = dim[1], ncol = dim[2], byrow = TRUE)
272
+        rgb[, , 3] = matrix(x[3, ], nrow = dim[1], ncol = dim[2], byrow = TRUE)
273
+    }
274
+    # check rows
275
+    white_row = NULL
276
+    white_column = NULL
277
+    if(any( abs(rgb[, 1, 1] - 1) < 1e-10 & abs(rgb[, 1, 2] - 1) < 1e-10 & abs(rgb[, 1, 3] - 1)< 1e-10 )) {
278
+        white_row = which( abs(rowMeans(rgb[, , 1]) - 1) < 1e-10 & 
279
+                           abs(rowMeans(rgb[, , 2]) - 1) < 1e-10 & 
280
+                           abs(rowMeans(rgb[, , 3]) - 1) < 1e-10 )
281
+    }
282
+    if(any( abs(rgb[1, , 1] - 1) < 1e-10 & abs(rgb[1, , 2] - 1) < 1e-10 & abs(rgb[1, , 3] - 1)< 1e-10 )) {
283
+        white_column = which( abs(colMeans(rgb[, , 1]) - 1) < 0.1 & 
284
+                              abs(colMeans(rgb[, , 2]) - 1) < 0.1 & 
285
+                              abs(colMeans(rgb[, , 3]) - 1) < 0.1 )
286
+    }
267 287
 
268
-    #     }
269
-    # }
288
+    # estimate while rows and columns
270 289
     rgb
271 290
 }
272 291
 
Browse code

comment unimplemented code

Zuguang Gu authored on 20/10/2020 07:40:56
Showing1 changed files
... ...
@@ -262,11 +262,11 @@ setMethod(f = "draw_heatmap_body",
262 262
 # careful: row orders of rgb and mat are reversed
263 263
 # rgb: values change from 0 to 1
264 264
 validate_raster_matrix = function(rgb, mat, col_mapping) {
265
-    if(any(rgb[, 1, 1] == 1 & rgb[, 1, 2] == 1 & rgb[, 1, 3] == 1)) {
266
-        if(nrow(rgb) < nrow(mat)) {
265
+    # if(any(rgb[, 1, 1] == 1 & rgb[, 1, 2] == 1 & rgb[, 1, 3] == 1)) {
266
+    #     if(nrow(rgb) < nrow(mat)) {
267 267
 
268
-        }
269
-    }
268
+    #     }
269
+    # }
270 270
     rgb
271 271
 }
272 272
 
Browse code

add validate_raster_matrix()

simplifyEnrichment authored on 15/10/2020 08:39:24
Showing1 changed files
... ...
@@ -176,14 +176,16 @@ setMethod(f = "draw_heatmap_body",
176 176
             }
177 177
             image = magick::image_read(temp_image)
178 178
             image = magick::image_resize(image, paste0(heatmap_width_pt, "x", heatmap_height_pt, "!"), filter = raster_magick_filter)
179
-            grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"), interpolate = FALSE)
180 179
         } else {
181 180
             if(object@heatmap_param$verbose) {
182 181
                 qqcat("image is read by @{device_info[2]}::@{device_info[3]}\n")
183 182
             }
184 183
             image = getFromNamespace(device_info[3], ns = device_info[2])(temp_image)
185
-            grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"), interpolate = FALSE)
186 184
         }
185
+        # validate image, there might be white horizontal lines and vertical lines 
186
+        image = validate_raster_matrix(image, mat, object@matrix_color_mapping)
187
+
188
+        grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"), interpolate = FALSE)
187 189
 
188 190
         ### only for testing ###
189 191
         if(ht_opt("__export_image_size__")) {
... ...
@@ -256,6 +258,18 @@ setMethod(f = "draw_heatmap_body",
256 258
 
257 259
 })
258 260
 
261
+# check white lines in the RGB matrix, and re-fill the color from mat with color_mapping
262
+# careful: row orders of rgb and mat are reversed
263
+# rgb: values change from 0 to 1
264
+validate_raster_matrix = function(rgb, mat, col_mapping) {
265
+    if(any(rgb[, 1, 1] == 1 & rgb[, 1, 2] == 1 & rgb[, 1, 3] == 1)) {
266
+        if(nrow(rgb) < nrow(mat)) {
267
+
268
+        }
269
+    }
270
+    rgb
271
+}
272
+
259 273
 is_windows = function() {
260 274
     tolower(.Platform$OS.type) == "windows"
261 275
 }
Browse code

support agg_png for writing temporary png files

Zuguang Gu authored on 09/10/2020 13:12:56
Showing1 changed files
... ...
@@ -67,7 +67,8 @@ setMethod(f = "draw_heatmap_body",
67 67
             tiff = c("grDevices", "tiff", "readTIFF"),
68 68
             CairoPNG = c("Cairo", "png", "readPNG"),
69 69
             CairoJPEG = c("Cairo", "jpeg", "readJPEG"),
70
-            CairoTIFF = c("Cairo", "tiff", "readTIFF")
70
+            CairoTIFF = c("Cairo", "tiff", "readTIFF"),
71
+            agg_png = c("ragg", "png", "readPNG")
71 72
         )
72 73
         if(!requireNamespace(device_info[1])) {
73 74
             stop_wrap(paste0("Need ", device_info[1], " package to write image."))
Browse code

remove unused colors in annotations

Zuguang Gu authored on 08/10/2020 08:44:52
Showing1 changed files
... ...
@@ -470,9 +470,9 @@ setMethod(f = "draw_title",
470 470
         if("border" %in% names(gp2)) gp2$col = gp2$border
471 471
         if(any(c("border", "fill") %in% names(gp2))) grid.rect(gp = gp2)
472 472
         if(side == "left") {
473
-            grid.text(title, x = unit(1, "npc") - ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
473
+            grid.text(title, x = unit(1, "npc") - ht_opt$TITLE_PADDING[2], rot = rot, just = just, gp = gp)
474 474
         } else {
475
-            grid.text(title, x = ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
475
+            grid.text(title, x = ht_opt$TITLE_PADDING[1], rot = rot, just = just, gp = gp)
476 476
         }
477 477
         upViewport()
478 478
     } else {
... ...
@@ -481,9 +481,9 @@ setMethod(f = "draw_title",
481 481
         if("border" %in% names(gp2)) gp2$col = gp2$border
482 482
         if(any(c("border", "fill") %in% names(gp2))) grid.rect(gp = gp2)
483 483
         if(side == "top") {
484
-            grid.text(title, y = ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
484
+            grid.text(title, y = ht_opt$TITLE_PADDING[1], rot = rot, just = just, gp = gp)
485 485
         } else {
486
-            grid.text(title, y = unit(1, "npc") - ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
486
+            grid.text(title, y = unit(1, "npc") - ht_opt$TITLE_PADDING[2], rot = rot, just = just, gp = gp)
487 487
         }
488 488
         upViewport()
489 489
     }
Browse code

check NA in pheatmap()

Zuguang Gu authored on 09/09/2020 06:54:18
Showing1 changed files
... ...
@@ -77,11 +77,8 @@ setMethod(f = "draw_heatmap_body",
77 77
         }
78 78
 
79 79
         # can we get the size of the heatmap body?
80
-        heatmap_width_pt = ceiling(convertWidth(unit(1, "npc"), "bigpts", valueOnly = TRUE))
81
-        heatmap_height_pt = ceiling(convertHeight(unit(1, "npc"), "bigpts", valueOnly = TRUE))
82
-        if(heatmap_width_pt <= 0 || heatmap_height_pt <= 0) {
83
-            stop_wrap("The width or height of the raster image is zero, maybe you forget to turn off the previous graphic device or it was corrupted. Run `dev.off()` to close it.")
84
-        }
80
+        heatmap_width_pt = max(1, ceiling(convertWidth(unit(1, "npc"), "bigpts", valueOnly = TRUE)))
81
+        heatmap_height_pt = max(1, ceiling(convertHeight(unit(1, "npc"), "bigpts", valueOnly = TRUE)))
85 82
 
86 83
         matrix_is_resized = FALSE
87 84
         # resize on the matrix
Browse code

update

Zuguang Gu authored on 13/07/2020 18:14:56
Showing1 changed files
... ...
@@ -127,6 +127,7 @@ setMethod(f = "draw_heatmap_body",
127 127
                 temp_image_width = ceiling(max(heatmap_width_pt, nc, 1))
128 128
                 temp_image_height = ceiling(max(heatmap_height_pt, nr, 1))
129 129
             } else {
130
+                if(raster_quality < 1) raster_quality = 1
130 131
                 temp_image_width = ceiling(max(heatmap_width_pt*raster_quality, 1))
131 132
                 temp_image_height = ceiling(max(heatmap_height_pt*raster_quality, 1))
132 133
             }
... ...
@@ -173,7 +174,7 @@ setMethod(f = "draw_heatmap_body",
173 174
                 qqcat("image is read by magick.\n")
174 175
             }
175 176
             if(!requireNamespace("magick")) {
176
-                stop_wrap("magick package should be installed.")
177
+                stop_wrap("'magick' package should be installed.")
177 178
             }
178 179
             image = magick::image_read(temp_image)
179 180
             image = magick::image_resize(image, paste0(heatmap_width_pt, "x", heatmap_height_pt, "!"), filter = raster_magick_filter)
Browse code

bug fixed

Zuguang Gu authored on 10/07/2020 09:02:24
Showing1 changed files
... ...
@@ -108,12 +108,29 @@ setMethod(f = "draw_heatmap_body",
108 108
             }
109 109
         }
110 110
 
111
+        if(matrix_is_resized) {
112
+            raster_by_magick = FALSE
113
+        }
114
+
111 115
         temp_dir = tempdir()
112 116
         temp_image = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", kr, "_", kc), tmpdir = temp_dir, fileext = paste0(".", device_info[2]))
113 117
         device_fun = getFromNamespace(raster_device, ns = device_info[1])
114 118
 
115
-        temp_image_width = ceiling(max(heatmap_width_pt, nc, 1))
116
-        temp_image_height = ceiling(max(heatmap_height_pt, nr, 1))
119
+        if(raster_by_magick) {
120
+            temp_image_width = ceiling(max(heatmap_width_pt, nc, 1))
121
+            temp_image_height = ceiling(max(heatmap_height_pt, nr, 1))
122
+        } else if(matrix_is_resized) {
123
+            temp_image_width = ceiling(max(heatmap_width_pt, 1))
124
+            temp_image_height = ceiling(max(heatmap_height_pt, 1))
125
+        } else {
126
+            if(is.character(raster_quality)) {
127
+                temp_image_width = ceiling(max(heatmap_width_pt, nc, 1))
128
+                temp_image_height = ceiling(max(heatmap_height_pt, nr, 1))
129
+            } else {
130
+                temp_image_width = ceiling(max(heatmap_width_pt*raster_quality, 1))
131
+                temp_image_height = ceiling(max(heatmap_height_pt*raster_quality, 1))
132
+            }
133
+        }
117 134
         do.call(device_fun, c(list(filename = temp_image, 
118 135
             width = temp_image_width, height = temp_image_height), raster_device_param))
119 136
         if(object@heatmap_param$verbose) {
... ...
@@ -160,13 +177,13 @@ setMethod(f = "draw_heatmap_body",
160 177
             }
161 178
             image = magick::image_read(temp_image)
162 179
             image = magick::image_resize(image, paste0(heatmap_width_pt, "x", heatmap_height_pt, "!"), filter = raster_magick_filter)
163
-            grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
180
+            grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"), interpolate = FALSE)
164 181
         } else {
165 182
             if(object@heatmap_param$verbose) {
166 183
                 qqcat("image is read by @{device_info[2]}::@{device_info[3]}\n")
167 184
             }
168 185
             image = getFromNamespace(device_info[3], ns = device_info[2])(temp_image)
169
-            grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
186
+            grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"), interpolate = FALSE)
170 187
         }
171 188
 
172 189
         ### only for testing ###
Browse code

fixed the bug of heatmap border

Zuguang Gu authored on 08/07/2020 09:40:06
Showing1 changed files
... ...
@@ -224,8 +224,14 @@ setMethod(f = "draw_heatmap_body",
224 224
         }
225 225
     }
226 226
 
227
-    if(!identical(border, FALSE) && !identical(border, NA)) {
227
+    if(!(identical(border, FALSE) || identical(border, NA))) {
228 228
         border_gp = object@matrix_param$border_gp
229
+        if(!identical(border, TRUE)) {
230
+            border_gp$col = border
231
+        }
232
+        if("fill" %in% names(border_gp)) {
233
+            message_wrap("`fill` is ignored in `border_gp`. The value for `fill` is always 'transparent'.")
234
+        }
229 235
         border_gp$fill = "transparent"
230 236
         grid.rect(gp = border_gp)
231 237
     }
Browse code

change option from private to invisible

Zuguang Gu authored on 04/07/2020 16:38:44
Showing1 changed files
... ...
@@ -170,19 +170,21 @@ setMethod(f = "draw_heatmap_body",
170 170
         }
171 171
 
172 172
         ### only for testing ###
173
-        if(inherits(image, "magick-image")) {
174
-            image = as.raster(image)
175
-        } else {
176
-            tf = tempfile()
177
-            png(tf, width = heatmap_width_pt, height = heatmap_height_pt)
178
-            grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
179
-            dev.off()
180
-            image = as.raster(png::readPNG(tf))
181
-            file.remove(tf)   
173
+        if(ht_opt("__export_image_size__")) {
174
+            if(inherits(image, "magick-image")) {
175
+                image = as.raster(image)
176
+            } else {
177
+                tf = tempfile()
178
+                png(tf, width = heatmap_width_pt, height = heatmap_height_pt)
179
+                grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
180
+                dev.off()
181
+                image = as.raster(png::readPNG(tf))
182
+                file.remove(tf)   
183
+            }
184
+            attr(image, "width") = heatmap_width_pt
185
+            attr(image, "height") = heatmap_height_pt
186
+            assign(".image", image, envir = .GlobalEnv)
182 187
         }
183
-        attr(image, "width") = heatmap_width_pt
184
-        attr(image, "height") = heatmap_height_pt
185
-        .GlobalEnv$image = image
186 188
         ########################
187 189
 
188 190
         file.remove(temp_image)
Browse code

improve rasterization

Zuguang Gu authored on 02/07/2020 10:40:04
Showing1 changed files
... ...
@@ -75,6 +75,7 @@ setMethod(f = "draw_heatmap_body",
75 75
         if(!requireNamespace(device_info[2])) {
76 76
             stop_wrap(paste0("Need ", device_info[2], " package to read image."))
77 77
         }
78
+
78 79
         # can we get the size of the heatmap body?
79 80
         heatmap_width_pt = ceiling(convertWidth(unit(1, "npc"), "bigpts", valueOnly = TRUE))
80 81
         heatmap_height_pt = ceiling(convertHeight(unit(1, "npc"), "bigpts", valueOnly = TRUE))
... ...
@@ -167,6 +168,23 @@ setMethod(f = "draw_heatmap_body",
167 168
             image = getFromNamespace(device_info[3], ns = device_info[2])(temp_image)
168 169
             grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
169 170
         }
171
+
172
+        ### only for testing ###
173
+        if(inherits(image, "magick-image")) {
174
+            image = as.raster(image)
175
+        } else {
176
+            tf = tempfile()
177
+            png(tf, width = heatmap_width_pt, height = heatmap_height_pt)
178
+            grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
179
+            dev.off()
180
+            image = as.raster(png::readPNG(tf))
181
+            file.remove(tf)   
182
+        }
183
+        attr(image, "width") = heatmap_width_pt
184
+        attr(image, "height") = heatmap_height_pt
185
+        .GlobalEnv$image = image
186
+        ########################
187
+
170 188
         file.remove(temp_image)
171 189
 
172 190
     } else {
Browse code

fixed a bug of the legend size due to R 4.0.0

Zuguang Gu authored on 01/07/2020 21:06:46
Showing1 changed files
... ...
@@ -37,6 +37,8 @@ setMethod(f = "draw_heatmap_body",
37 37
     raster_device = object@heatmap_param$raster_device
38 38
     raster_quality = object@heatmap_param$raster_quality
39 39
     raster_device_param = object@heatmap_param$raster_device_param
40
+    raster_by_magick = object@heatmap_param$raster_by_magick
41
+    raster_magick_filter = object@heatmap_param$raster_magick_filter
40 42
     if(length(raster_device_param) == 0) raster_device_param = list()
41 43
 
42 44
     pushViewport(viewport(name = paste(object@name, "heatmap_body", kr, kc, sep = "_"), ...))
... ...
@@ -74,36 +76,51 @@ setMethod(f = "draw_heatmap_body",
74 76
             stop_wrap(paste0("Need ", device_info[2], " package to read image."))
75 77
         }
76 78
         # can we get the size of the heatmap body?
77
-        heatmap_width = convertWidth(unit(1, "npc"), "bigpts", valueOnly = TRUE)
78
-        heatmap_height = convertHeight(unit(1, "npc"), "bigpts", valueOnly = TRUE)
79
-        if(heatmap_width <= 0 || heatmap_height <= 0) {
79
+        heatmap_width_pt = ceiling(convertWidth(unit(1, "npc"), "bigpts", valueOnly = TRUE))
80
+        heatmap_height_pt = ceiling(convertHeight(unit(1, "npc"), "bigpts", valueOnly = TRUE))
81
+        if(heatmap_width_pt <= 0 || heatmap_height_pt <= 0) {
80 82
             stop_wrap("The width or height of the raster image is zero, maybe you forget to turn off the previous graphic device or it was corrupted. Run `dev.off()` to close it.")
81 83
         }
82 84
 
83 85
         matrix_is_resized = FALSE
84
-        if(object@heatmap_param$raster_resize) {
85
-            if(heatmap_width < nc && heatmap_height < nr) {
86
-                mat2 = resize_matrix(mat, nr = heatmap_height, nc = heatmap_width)
86
+        # resize on the matrix
87
+        raster_resize_mat = object@heatmap_param$raster_resize_mat
88
+        if(!identical(raster_resize_mat, FALSE)) {
89
+            if(is.logical(raster_resize_mat)) {
90
+                raster_resize_mat_fun = function(x) mean(x, na.rm = TRUE)
91
+            } else {
92
+                if(!inherits(raster_resize_mat, "function")) {
93
+                    stop_wrap("`raster_resize_mat` should be set as logical scalar or a function.")
94
+                }
95
+                raster_resize_mat_fun = raster_resize_mat
96
+            }
97
+
98
+            if(heatmap_width_pt < nc && heatmap_height_pt < nr) {
99
+                mat2 = resize_matrix(mat, nr = heatmap_height_pt, nc = heatmap_width_pt, fun = raster_resize_mat_fun)
87 100
                 matrix_is_resized = TRUE
88
-            } else if(heatmap_width < nc) {
89
-                mat2 = resize_matrix(mat, nr = nr, nc = heatmap_width)
101
+            } else if(heatmap_width_pt < nc) {
102
+                mat2 = resize_matrix(mat, nr = nr, nc = heatmap_width_pt, fun = raster_resize_mat_fun)
90 103
                 matrix_is_resized = TRUE
91
-            } else if(heatmap_height < nr) {
92
-                mat2 = resize_matrix(mat, nr = heatmap_height, nc = nc)
104
+            } else if(heatmap_height_pt < nr) {
105
+                mat2 = resize_matrix(mat, nr = heatmap_height_pt, nc = nc, fun = raster_resize_mat_fun)
93 106
                 matrix_is_resized = TRUE
94 107
             }
95 108
         }
96 109
 
97 110
         temp_dir = tempdir()
98
-                # dir.create(tmp_dir, showWarnings = FALSE)
99 111
         temp_image = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", kr, "_", kc), tmpdir = temp_dir, fileext = paste0(".", device_info[2]))
100
-        #getFromNamespace(raster_device, ns = device_info[1])(temp_image, width = heatmap_width*raster_quality, height = heatmap_height*raster_quality)
101 112
         device_fun = getFromNamespace(raster_device, ns = device_info[1])
102 113
 
103
-        do.call(device_fun, c(list(filename = temp_image, width = max(c(heatmap_width*raster_quality, 1)), height = max(c(heatmap_height*raster_quality, 1))), raster_device_param))
114
+        temp_image_width = ceiling(max(heatmap_width_pt, nc, 1))
115
+        temp_image_height = ceiling(max(heatmap_height_pt, nr, 1))
116
+        do.call(device_fun, c(list(filename = temp_image, 
117
+            width = temp_image_width, height = temp_image_height), raster_device_param))
118
+        if(object@heatmap_param$verbose) {
119
+            qqcat("saving into a temp image (.@{device_info[2]}) with size @{temp_image_width}x@{temp_image_height}px.\n")
120
+        }
104 121
         if(matrix_is_resized) {
105 122
             if(object@heatmap_param$verbose) {
106
-                qqcat("resize the matrix from (@{nrow(mat)} x @{ncol(mat)}) to (@{nrow(mat2)} x @{ncol(mat2)}).\n")
123
+                qqcat("resize the matrix from (@{nrow(mat)}x@{ncol(mat)}) to (@{nrow(mat2)}x@{ncol(mat2)}).\n")
107 124
             }
108 125
             col_matrix2 = map_to_colors(object@matrix_color_mapping, mat2)
109 126
             nc2 = ncol(mat2)
... ...
@@ -129,51 +146,27 @@ setMethod(f = "draw_heatmap_body",
129 146
             }
130 147
         }
131 148
         dev.off2()
132
-        
133
-        # ############################################
134
-        # ## make the heatmap body in a another process
135
-        # temp_R_data = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", kr, "_", kc), tmpdir = temp_dir, fileext = paste0(".RData"))
136
-        # temp_R_file = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", kr, "_", kc), tmpdir = temp_dir, fileext = paste0(".R"))
137
-        # if(Sys.info()["sysname"] == "Windows") {
138
-        #     temp_image = gsub("\\\\", "/", temp_image)
139
-        #     temp_R_data = gsub("\\\\", "/", temp_R_data)
140
-        #     temp_R_file = gsub("\\\\", "/", temp_R_file)
141
-        # }
142
-        # save(device_fun, device_info, temp_image, heatmap_width, raster_quality, heatmap_height, raster_device_param,
143
-        #     gp, x, expand_index, nc, nr, col_matrix, row_order, column_order, y,
144
-        #     file = temp_R_data)
145
-        # R_cmd = qq("
146
-        # library(@{device_info[1]})
147
-        # library(grid)
148
-        # load('@{temp_R_data}')
149
-        # do.call('device_fun', c(list(filename = temp_image, width = max(c(heatmap_width*raster_quality, 1)), height = max(c(heatmap_height*raster_quality, 1))), raster_device_param))
150
-        # grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = unit(1/nc, 'npc'), height = unit(1/nr, 'npc'), gp = do.call('gpar', c(list(fill = col_matrix), gp)))
151
-        # dev.off()
152
-        # q(save = 'no')
153
-        # ", code.pattern = "@\\{CODE\\}")
154
-        # writeLines(R_cmd, con = temp_R_file)
155
-        # if(grepl(" ", temp_R_file)) {
156
-        #     if(is_windows()) {
157
-        #         oe = try(system(qq("\"@{normalizePath(R_binary(), winslash='/')}\" --vanilla < \'@{temp_R_file}\'", code.pattern = "@\\{CODE\\}"), ignore.stdout = TRUE, ignore.stderr = TRUE, show.output.on.console = FALSE), silent = TRUE)
158
-        #     } else {
159
-        #         oe = try(system(qq("\"@{normalizePath(R_binary(), winslash='/')}\" --vanilla < \'@{temp_R_file}\'", code.pattern = "@\\{CODE\\}"), ignore.stdout = TRUE, ignore.stderr = TRUE), silent = TRUE)
160
-        #     }
161
-        # } else {
162
-        #     if(is_windows()) {
163
-        #         oe = try(system(qq("\"@{normalizePath(R_binary(), winslash='/')}\" --vanilla < @{temp_R_file}", code.pattern = "@\\{CODE\\}"), ignore.stdout = TRUE, ignore.stderr = TRUE, show.output.on.console = FALSE), silent = TRUE)
164
-        #     } else {
165
-        #         oe = try(system(qq("\"@{normalizePath(R_binary(), winslash='/')}\" --vanilla < @{temp_R_file}", code.pattern = "@\\{CODE\\}"), ignore.stdout = TRUE, ignore.stderr = TRUE), silent = TRUE)
166
-        #     }
167
-        # }
168
-        # ############################################
169
-        # file.remove(temp_R_data)
170
-        # file.remove(temp_R_file)
171
-        # if(inherits(oe, "try-error")) {
172
-        #     stop(oe)
173
-        # }
174
-        image = getFromNamespace(device_info[3], ns = device_info[2])(temp_image)
175
-        image = as.raster(image)
176
-        grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
149
+
150
+        if(object@heatmap_param$verbose) {
151
+            qqcat("resize the temp image to a size @{heatmap_width_pt}x@{heatmap_height_pt}px.\n")
152
+        }
153
+        if(raster_by_magick) {
154
+            if(object@heatmap_param$verbose) {
155
+                qqcat("image is read by magick.\n")
156
+            }
157
+            if(!requireNamespace("magick")) {
158
+                stop_wrap("magick package should be installed.")
159
+            }
160
+            image = magick::image_read(temp_image)
161
+            image = magick::image_resize(image, paste0(heatmap_width_pt, "x", heatmap_height_pt, "!"), filter = raster_magick_filter)
162
+            grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
163
+        } else {
164
+            if(object@heatmap_param$verbose) {
165
+                qqcat("image is read by @{device_info[2]}::@{device_info[3]}\n")
166
+            }
167
+            image = getFromNamespace(device_info[3], ns = device_info[2])(temp_image)
168
+            grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
169
+        }
177 170
         file.remove(temp_image)
178 171
 
179 172
     } else {
Browse code

bug fixed

Zuguang Gu authored on 28/06/2020 13:14:25
Showing1 changed files
... ...
@@ -211,8 +211,9 @@ setMethod(f = "draw_heatmap_body",
211 211
         }
212 212
     }
213 213
 
214
-    if(!identical(border, FALSE)) {
214
+    if(!identical(border, FALSE) && !identical(border, NA)) {
215 215
         border_gp = object@matrix_param$border_gp
216
+        border_gp$fill = "transparent"
216 217
         grid.rect(gp = border_gp)
217 218
     }
218 219
 
Browse code

fix a bug where slice dendrograms were wrongly reordered

Zuguang Gu authored on 26/06/2020 11:48:32
Showing1 changed files
... ...
@@ -212,7 +212,8 @@ setMethod(f = "draw_heatmap_body",
212 212
     }
213 213
 
214 214
     if(!identical(border, FALSE)) {
215
-        grid.rect(gp = gpar(fill = "transparent", col = border))
215
+        border_gp = object@matrix_param$border_gp
216
+        grid.rect(gp = border_gp)
216 217
     }
217 218
 
218 219
     upViewport()
Browse code

gp in anno_text() supports fill and border

Zuguang Gu authored on 24/03/2019 22:20:59
Showing1 changed files
... ...
@@ -430,9 +430,9 @@ setMethod(f = "draw_title",
430 430
     if(which == "row") {
431 431
         
432 432
         pushViewport(viewport(name = paste(object@name, "row_title", k, sep = "_"), clip = FALSE, ...))
433
-        if("fill" %in% names(gp)) {
434
-            grid.rect(gp = gpar(fill = gp$fill))
435
-        }
433
+        gp2 = gp
434
+        if("border" %in% names(gp2)) gp2$col = gp2$border
435
+        if(any(c("border", "fill") %in% names(gp2))) grid.rect(gp = gp2)
436 436
         if(side == "left") {
437 437
             grid.text(title, x = unit(1, "npc") - ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
438 438
         } else {
... ...
@@ -441,9 +441,9 @@ setMethod(f = "draw_title",
441 441
         upViewport()
442 442
     } else {
443 443
         pushViewport(viewport(name = paste(object@name, "column_title", k, sep = "_"), clip = FALSE, ...))
444
-        if("fill" %in% names(gp)) {
445
-            grid.rect(gp = gpar(fill = gp$fill))
446
-        }
444
+        gp2 = gp
445
+        if("border" %in% names(gp2)) gp2$col = gp2$border
446
+        if(any(c("border", "fill") %in% names(gp2))) grid.rect(gp = gp2)
447 447
         if(side == "top") {
448 448
             grid.text(title, y = ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
449 449
         } else {
Browse code

add anno_zoom()

Zuguang Gu authored on 12/12/2018 21:54:43
Showing1 changed files
... ...
@@ -509,7 +509,7 @@ setMethod(f = "draw_annotation",
509 509
 
510 510
         if(n_slice > 1) {
511 511
             all_anno_type = anno_type(annotation)
512
-            if("anno_mark" %in% all_anno_type) {
512
+            if(any(c("anno_zoom", "anno_mark") %in% all_anno_type)) {
513 513
                 ## only make the anno_mark annotation
514 514
                 ro_lt = object@row_order_list
515 515
                 # calcualte the position of each row with taking "gaps" into account
... ...
@@ -541,7 +541,7 @@ setMethod(f = "draw_annotation",
541 541
 
542 542
         if(n_slice > 1) {
543 543
             all_anno_type = anno_type(annotation)
544
-            if("anno_mark" %in% all_anno_type) {
544
+            if(any(c("anno_zoom", "anno_mark") %in% all_anno_type)) {
545 545
                 ## only make the anno_mark annotation
546 546
                 co_lt = object@column_order_list
547 547
                 .scale = c(0, 1)
Browse code

anno_mark() is calculated from mutiple slices

Zuguang Gu authored on 07/12/2018 14:41:15
Showing1 changed files
... ...
@@ -500,7 +500,73 @@ setMethod(f = "draw_annotation",
500 500
         n = length(object@row_order_list)
501 501
     }
502 502
 
503
+    ## deal with the special anno_mark
504
+    anno_mark_param = list()
505
+    if(which %in% c("left", "right")) {
506
+        slice_y = object@layout$slice$y
507
+        n_slice = length(slice_y)
508
+        slice_height = object@layout$slice$height
509
+
510
+        if(n_slice > 1) {
511
+            all_anno_type = anno_type(annotation)
512
+            if("anno_mark" %in% all_anno_type) {
513
+                ## only make the anno_mark annotation
514
+                ro_lt = object@row_order_list
515
+                # calcualte the position of each row with taking "gaps" into account
516
+                .scale = c(0, 1)
517
+
518
+                .pos = NULL
519
+                for(i in seq_along(ro_lt)) {
520
+                    # assume slices are align to top `slice_just` contains "top"
521
+                    .pos1 = slice_y[i] - (seq_along(ro_lt[[i]]) - 0.5)/length(ro_lt[[i]]) * slice_height[i]
522
+                    .pos1 = convertY(.pos1, "native", valueOnly = TRUE)
523
+                    .pos = c(.pos, .pos1)
524
+                }
525
+
526
+                anno_mark_param$.scale = .scale
527
+                anno_mark_param$.pos = .pos
528
+                anno_mark_param$index = unlist(ro_lt)
529
+                
530
+                anno_mark_param$vp_height = convertHeight(unit(1, "npc"), "cm")
531
+                anno_mark_param$vp_width = unit(1, "npc")
532
+                anno_mark_param$vp_just = "top"
533
+                anno_mark_param$vp_x = unit(0.5, "npc")
534
+                anno_mark_param$vp_y = unit(1, "npc")
535
+            }
536
+        }
537
+    } else {
538
+        slice_x = object@layout$slice$x
539
+        n_slice = length(slice_x)
540
+        slice_width = object@layout$slice$width
541
+
542
+        if(n_slice > 1) {
543
+            all_anno_type = anno_type(annotation)
544
+            if("anno_mark" %in% all_anno_type) {
545
+                ## only make the anno_mark annotation
546
+                co_lt = object@column_order_list
547
+                .scale = c(0, 1)
548
+
549
+                .pos = NULL
550
+                for(i in seq_along(co_lt)) {
551
+                    .pos1 = slice_x[i] + (seq_along(co_lt[[i]]) - 0.5)/length(co_lt[[i]]) * slice_width[i]
552
+                    .pos1 = convertX(.pos1, "native", valueOnly = TRUE)
553
+                    .pos = c(.pos, .pos1)
554
+                }
555
+
556
+                anno_mark_param$.scale = .scale
557
+                anno_mark_param$.pos = .pos
558
+                anno_mark_param$index = unlist(co_lt)
559
+                
560
+                anno_mark_param$vp_height = unit(1, "npc")
561
+                anno_mark_param$vp_width = convertWidth(unit(1, "npc"), "cm")
562
+                anno_mark_param$vp_just = "left"
563
+                anno_mark_param$vp_x = unit(0, "npc")
564
+                anno_mark_param$vp_y = unit(0.5, "npc")
565
+            }
566
+        }
567
+    }
568
+
503 569
     pushViewport(viewport(...))
504
-    draw(annotation, index = index, k = k, n = n)
570
+    draw(annotation, index = index, k = k, n = n, anno_mark_param = anno_mark_param)
505 571
     upViewport()
506 572
 })
Browse code

change variable names

Zuguang Gu authored on 23/11/2018 17:59:37
Showing1 changed files
... ...
@@ -116,7 +116,7 @@ setMethod(f = "draw_heatmap_body",
116 116
             grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = unit(1/nc, 'npc'), height = unit(1/nr, 'npc'), gp = do.call('gpar', c(list(fill = col_matrix), gp)))
117 117
         }
118 118
         if(is.function(layer_fun)) {
119
-            if(length(as.list(formals(fun))) == 7) {
119
+            if(length(as.list(formals(layer_fun))) == 7) {
120 120
                 layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
121 121
                     x[expand_index[[2]]], y[expand_index[[1]]],
122 122
                     unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
... ...
@@ -197,7 +197,7 @@ setMethod(f = "draw_heatmap_body",
197 197
             }
198 198
         }
199 199
         if(is.function(layer_fun)) {
200
-            if(length(as.list(formals(fun))) == 7) {
200
+            if(length(as.list(formals(layer_fun))) == 7) {
201 201
                 layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
202 202
                     x[expand_index[[2]]], y[expand_index[[1]]],
203 203
                     unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
Browse code

add raster_resize argument

Zuguang Gu authored on 17/11/2018 21:11:19
Showing1 changed files
... ...
@@ -81,15 +81,17 @@ setMethod(f = "draw_heatmap_body",
81 81
         }
82 82
 
83 83
         matrix_is_resized = FALSE
84
-        if(heatmap_width < nc && heatmap_height < nr) {
85
-            mat2 = resize_matrix(mat, nr = heatmap_height, nc = heatmap_width)
86
-            matrix_is_resized = TRUE
87
-        } else if(heatmap_width < nc) {
88
-            mat2 = resize_matrix(mat, nr = nr, nc = heatmap_width)
89
-            matrix_is_resized = TRUE
90
-        } else if(heatmap_height < nr) {
91
-            mat2 = resize_matrix(mat, nr = heatmap_height, nc = nc)
92
-            matrix_is_resized = TRUE
84
+        if(object@heatmap_param$raster_resize) {
85
+            if(heatmap_width < nc && heatmap_height < nr) {
86
+                mat2 = resize_matrix(mat, nr = heatmap_height, nc = heatmap_width)
87
+                matrix_is_resized = TRUE
88
+            } else if(heatmap_width < nc) {
89
+                mat2 = resize_matrix(mat, nr = nr, nc = heatmap_width)
90
+                matrix_is_resized = TRUE
91
+            } else if(heatmap_height < nr) {
92
+                mat2 = resize_matrix(mat, nr = heatmap_height, nc = nc)
93
+                matrix_is_resized = TRUE
94
+            }
93 95
         }
94 96
 
95 97
         temp_dir = tempdir()
Browse code

also resize the image when using raster image

Zuguang Gu authored on 17/11/2018 16:02:08
Showing1 changed files
... ...
@@ -55,8 +55,9 @@ setMethod(f = "draw_heatmap_body",
55 55
     if(!is.null(cell_fun)) {
56 56
         use_raster = FALSE
57 57
     }
58
-        
58
+   
59 59
     if(use_raster) {
60
+
60 61
         # write the image into a temporary file and read it back
61 62
         device_info = switch(raster_device,
62 63
             png = c("grDevices", "png", "readPNG"),
... ...
@@ -78,7 +79,19 @@ setMethod(f = "draw_heatmap_body",
78 79
         if(heatmap_width <= 0 || heatmap_height <= 0) {
79 80
             stop_wrap("The width or height of the raster image is zero, maybe you forget to turn off the previous graphic device or it was corrupted. Run `dev.off()` to close it.")
80 81
         }
81
-        
82
+
83
+        matrix_is_resized = FALSE
84
+        if(heatmap_width < nc && heatmap_height < nr) {
85
+            mat2 = resize_matrix(mat, nr = heatmap_height, nc = heatmap_width)
86
+            matrix_is_resized = TRUE
87
+        } else if(heatmap_width < nc) {
88
+            mat2 = resize_matrix(mat, nr = nr, nc = heatmap_width)
89
+            matrix_is_resized = TRUE
90
+        } else if(heatmap_height < nr) {
91
+            mat2 = resize_matrix(mat, nr = heatmap_height, nc = nc)
92
+            matrix_is_resized = TRUE
93
+        }
94
+
82 95
         temp_dir = tempdir()
83 96
                 # dir.create(tmp_dir, showWarnings = FALSE)
84 97
         temp_image = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", kr, "_", kc), tmpdir = temp_dir, fileext = paste0(".", device_info[2]))
... ...
@@ -86,12 +99,32 @@ setMethod(f = "draw_heatmap_body",
86 99
         device_fun = getFromNamespace(raster_device, ns = device_info[1])
87 100
 
88 101
         do.call(device_fun, c(list(filename = temp_image, width = max(c(heatmap_width*raster_quality, 1)), height = max(c(heatmap_height*raster_quality, 1))), raster_device_param))
89
-        grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = unit(1/nc, 'npc'), height = unit(1/nr, 'npc'), gp = do.call('gpar', c(list(fill = col_matrix), gp)))
102
+        if(matrix_is_resized) {
103
+            if(object@heatmap_param$verbose) {
104
+                qqcat("resize the matrix from (@{nrow(mat)} x @{ncol(mat)}) to (@{nrow(mat2)} x @{ncol(mat2)}).\n")
105
+            }
106
+            col_matrix2 = map_to_colors(object@matrix_color_mapping, mat2)
107
+            nc2 = ncol(mat2)
108
+            nr2 = nrow(mat2)
109
+            x2 = (seq_len(nc2) - 0.5) / nc2
110
+            y2 = (rev(seq_len(nr2)) - 0.5) / nr2
111
+            expand_index2 = expand.grid(seq_len(nr2), seq_len(nc2))
112
+            grid.rect(x2[expand_index2[[2]]], y2[expand_index2[[1]]], width = unit(1/nc2, 'npc'), height = unit(1/nr2, 'npc'), gp = do.call('gpar', c(list(fill = col_matrix2), gp)))
113
+        } else {
114
+            grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = unit(1/nc, 'npc'), height = unit(1/nr, 'npc'), gp = do.call('gpar', c(list(fill = col_matrix), gp)))
115
+        }
90 116
         if(is.function(layer_fun)) {
91
-            layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
92
-                x[expand_index[[2]]], y[expand_index[[1]]],
93
-                unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
94
-                as.vector(col_matrix))
117
+            if(length(as.list(formals(fun))) == 7) {
118
+                layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
119
+                    x[expand_index[[2]]], y[expand_index[[1]]],
120
+                    unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
121
+                    as.vector(col_matrix))
122
+            } else {
123
+                layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
124
+                    x[expand_index[[2]]], y[expand_index[[1]]],
125
+                    unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
126
+                    as.vector(col_matrix), kr, kc)
127
+            }
95 128
         }
96 129
         dev.off2()
97 130
         
... ...
@@ -142,6 +175,7 @@ setMethod(f = "draw_heatmap_body",
142 175
         file.remove(temp_image)
143 176
 
144 177
     } else {
178
+
145 179
         if(any(names(gp) %in% c("type"))) {
146 180
             if(gp$type == "none") {
147 181
             } else {
... ...
@@ -161,10 +195,17 @@ setMethod(f = "draw_heatmap_body",
161 195
             }
162 196
         }
163 197
         if(is.function(layer_fun)) {
164
-            layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
198
+            if(length(as.list(formals(fun))) == 7) {
199
+                layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
200
+                    x[expand_index[[2]]], y[expand_index[[1]]],
201
+                    unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
202
+                    as.vector(col_matrix))
203
+            } else {
204
+                layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
165 205
                 x[expand_index[[2]]], y[expand_index[[1]]],
166 206
                 unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
167
-                as.vector(col_matrix))
207
+                as.vector(col_matrix), kr, kc)
208
+            }
168 209
         }
169 210
     }
170 211
 
Browse code

vignettes added

Zuguang Gu authored on 30/10/2018 22:32:01
Showing1 changed files
... ...
@@ -310,7 +310,28 @@ setMethod(f = "draw_dimnames",
310 310
         "column" = object@column_order_list[[k]])
311 311
     
312 312
     pushViewport(viewport(name = paste(object@name, which, "names", k, sep = "_"), ...))
313
-    draw(anno, index = ind)
313
+    if(which == "row") {
314
+        if(object@row_names_param$side == "right" ) {
315
+            x = unit(0, "npc")
316
+            y = unit(0.5, "npc")
317
+            just = "left"
318
+        } else {
319
+            x = unit(1, "npc")
320
+            y = unit(0.5, "npc")
321
+            just = "right"
322
+        }
323
+    } else {
324
+        if(object@column_names_param$side == "top") {
325
+            x = unit(0.5, "npc")
326
+            y = unit(0, "npc")
327
+            just = "bottom"
328
+        } else {
329
+            x = unit(0.5, "npc")
330
+            y = unit(1, "npc")
331
+            just = "top"
332
+        }
333
+    }
334
+    draw(anno, index = ind, x = x, y = y, just = just)
314 335
     upViewport()
315 336
 })
316 337
 
Browse code

add a line at dendrogram

Zuguang Gu authored on 24/10/2018 13:37:30
Showing1 changed files
... ...
@@ -67,16 +67,16 @@ setMethod(f = "draw_heatmap_body",
67 67
             CairoTIFF = c("Cairo", "tiff", "readTIFF")
68 68
         )
69 69
         if(!requireNamespace(device_info[1])) {
70
-            stop(paste0("Need ", device_info[1], " package to write image."))
70
+            stop_wrap(paste0("Need ", device_info[1], " package to write image."))
71 71
         }
72 72
         if(!requireNamespace(device_info[2])) {
73
-            stop(paste0("Need ", device_info[2], " package to read image."))
73
+            stop_wrap(paste0("Need ", device_info[2], " package to read image."))
74 74
         }
75 75
         # can we get the size of the heatmap body?
76 76
         heatmap_width = convertWidth(unit(1, "npc"), "bigpts", valueOnly = TRUE)
77 77
         heatmap_height = convertHeight(unit(1, "npc"), "bigpts", valueOnly = TRUE)
78 78
         if(heatmap_width <= 0 || heatmap_height <= 0) {
79
-            stop("The width or height of the raster image is zero, maybe you forget to turn off the previous graphic device or it was corrupted. Run `dev.off()` to close it.")
79
+            stop_wrap("The width or height of the raster image is zero, maybe you forget to turn off the previous graphic device or it was corrupted. Run `dev.off()` to close it.")
80 80
         }
81 81
         
82 82
         temp_dir = tempdir()
Browse code

update

Zuguang Gu authored on 22/10/2018 05:57:29
Showing1 changed files
... ...
@@ -1,6 +1,6 @@
1 1
 
2 2
 # == title
3
-# Draw the Heatmap Body
3
+# Draw Heatmap Body
4 4
 #
5 5
 # == param
6 6
 # -object A `Heatmap-class` object.
... ...
@@ -321,7 +321,7 @@ setMethod(f = "draw_dimnames",
321 321
 # -object A `Heatmap-class` object.
322 322
 # -which Is title put on the row or on the column of the heatmap?
323 323
 # -k Slice index.
324
-# -... Pass to `grid::viewport` which includes the complete heatmap title
324
+# -... Pass to `grid::viewport` which includes the complete heatmap title.
325 325
 #
326 326
 # == details
327 327
 # A viewport is created which contains heatmap title.
Browse code

update

jokergoo authored on 12/10/2018 15:28:37
Showing1 changed files
... ...
@@ -1,12 +1,12 @@
1 1
 
2 2
 # == title
3
-# Draw the heatmap body
3
+# Draw the Heatmap Body
4 4
 #
5 5
 # == param
6 6
 # -object A `Heatmap-class` object.
7 7
 # -kr Row slice index.
8 8
 # -kc Column slice index.
9
-# -... Pass to `grid::viewport` which includes the subset of heatmap body.
9
+# -... Pass to `grid::viewport` which includes the slice of heatmap body.
10 10
 #
11 11
 # == details
12 12
 # A viewport is created which contains subset rows and columns of the heatmap.
Browse code

update

Zuguang Gu authored on 09/10/2018 20:28:04
Showing1 changed files
... ...
@@ -370,9 +370,9 @@ setMethod(f = "draw_title",
370 370
             grid.rect(gp = gpar(fill = gp$fill))
371 371
         }
372 372
         if(side == "left") {
373
-            grid.text(title, x = unit(1, "npc") - TITLE_PADDING, rot = rot, just = just, gp = gp)
373
+            grid.text(title, x = unit(1, "npc") - ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
374 374
         } else {
375
-            grid.text(title, x = TITLE_PADDING, rot = rot, just = just, gp = gp)
375
+            grid.text(title, x = ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
376 376
         }
377 377
         upViewport()
378 378
     } else {
... ...
@@ -381,9 +381,9 @@ setMethod(f = "draw_title",
381 381
             grid.rect(gp = gpar(fill = gp$fill))
382 382
         }
383 383
         if(side == "top") {
384
-            grid.text(title, y = TITLE_PADDING, rot = rot, just = just, gp = gp)
384
+            grid.text(title, y = ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
385 385
         } else {
386
-            grid.text(title, y = unit(1, "npc") - TITLE_PADDING, rot = rot, just = just, gp = gp)
386
+            grid.text(title, y = unit(1, "npc") - ht_opt$TITLE_PADDING, rot = rot, just = just, gp = gp)
387 387
         }
388 388
         upViewport()
389 389
     }
Browse code

oncoPrint is vectorized

Zuguang Gu authored on 25/09/2018 07:59:43
Showing1 changed files
... ...
@@ -88,7 +88,10 @@ setMethod(f = "draw_heatmap_body",
88 88
         do.call(device_fun, c(list(filename = temp_image, width = max(c(heatmap_width*raster_quality, 1)), height = max(c(heatmap_height*raster_quality, 1))), raster_device_param))
89 89
         grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = unit(1/nc, 'npc'), height = unit(1/nr, 'npc'), gp = do.call('gpar', c(list(fill = col_matrix), gp)))
90 90
         if(is.function(layer_fun)) {
91
-            layer_fun(row_order, column_order)
91
+            layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
92
+                x[expand_index[[2]]], y[expand_index[[1]]],
93
+                unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
94
+                as.vector(col_matrix))
92 95
         }
93 96
         dev.off2()
94 97
         
... ...
@@ -149,12 +152,20 @@ setMethod(f = "draw_heatmap_body",
149 152
         }
150 153
 
151 154
         if(is.function(cell_fun)) {
152
-            for(i in row_order) {
153
-                for(j in column_order) {
154
-                    cell_fun(j, i, unit(x[which(column_order == j)], "npc"), unit(y[which(row_order == i)], "npc"), unit(1/nc, "npc"), unit(1/nr, "npc"), col_matrix[which(row_order == i), which(column_order == j)])
155
+            for(i in seq_len(nr)) {
156
+                for(j in seq_len(nc)) {
157
+                    cell_fun(column_order[j], row_order[i], unit(x[j], "npc"), unit(y[i], "npc"), 
158
+                        unit(1/nc, "npc"), unit(1/nr, "npc"), 
159
+                        col_matrix[i, j])
155 160
                 }
156 161
             }
157 162
         }
163
+        if(is.function(layer_fun)) {
164
+            layer_fun(column_order[ expand_index[[2]] ], row_order[ expand_index[[1]] ], 
165
+                x[expand_index[[2]]], y[expand_index[[1]]],
166
+                unit(rep(1/nc, nrow(expand_index)), "npc"), unit(rep(1/nr, nrow(expand_index)), "npc"),
167
+                as.vector(col_matrix))
168
+        }
158 169
     }
159 170
 
160 171
     if(!identical(border, FALSE)) {
Browse code

R CMD check passed

Zuguang Gu authored on 20/09/2018 12:48:08
Showing1 changed files
... ...
@@ -181,6 +181,7 @@ R_binary = function() {
181 181
 # -object A `Heatmap-class` object.
182 182
 # -which Are the dendrograms put on the row or on the column of the heatmap?
183 183
 # -k Slice index.
184
+# -max_height maximal height of dendrogram.
184 185
 # -... Pass to `grid::viewport` which includes the complete heatmap dendrograms.
185 186
 #
186 187
 # == details
Browse code

a backup push

Zuguang Gu authored on 18/09/2018 10:40:29
Showing1 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,430 @@
1
+
2
+# == title
3
+# Draw the heatmap body
4
+#
5
+# == param
6
+# -object A `Heatmap-class` object.
7
+# -kr Row slice index.
8
+# -kc Column slice index.
9
+# -... Pass to `grid::viewport` which includes the subset of heatmap body.
10
+#
11
+# == details
12
+# A viewport is created which contains subset rows and columns of the heatmap.
13
+#
14
+# This function is only for internal use.
15
+#
16
+# == value
17
+# This function returns no value.
18
+#
19
+# == author
20
+# Zuguang Gu <z.gu@dkfz.de>
21
+#
22
+setMethod(f = "draw_heatmap_body",
23
+    signature = "Heatmap",
24
+    definition = function(object, kr = 1, kc = 1, ...) {
25
+
26
+    if(ncol(object@matrix) == 0 || nrow(object@matrix) == 0) {
27
+        return(invisible(NULL))
28
+    }
29
+
30
+    row_order = object@row_order_list[[kr]]
31
+    column_order = object@column_order_list[[kc]]
32
+
33
+    gp = object@matrix_param$gp
34
+    border = object@matrix_param$border
35
+
36
+    use_raster = object@heatmap_param$use_raster
37
+    raster_device = object@heatmap_param$raster_device
38
+    raster_quality = object@heatmap_param$raster_quality
39
+    raster_device_param = object@heatmap_param$raster_device_param
40
+    if(length(raster_device_param) == 0) raster_device_param = list()
41
+
42
+    pushViewport(viewport(name = paste(object@name, "heatmap_body", kr, kc, sep = "_"), ...))
43
+
44
+    mat = object@matrix[row_order, column_order, drop = FALSE]
45
+    col_matrix = map_to_colors(object@matrix_color_mapping, mat)
46
+
47
+    nc = ncol(mat)
48
+    nr = nrow(mat)
49
+    x = (seq_len(nc) - 0.5) / nc
50
+    y = (rev(seq_len(nr)) - 0.5) / nr
51
+    expand_index = expand.grid(seq_len(nr), seq_len(nc))
52
+    
53
+    cell_fun = object@matrix_param$cell_fun
54
+    layer_fun = object@matrix_param$layer_fun
55
+    if(!is.null(cell_fun)) {
56
+        use_raster = FALSE
57
+    }
58
+        
59
+    if(use_raster) {
60
+        # write the image into a temporary file and read it back
61
+        device_info = switch(raster_device,
62
+            png = c("grDevices", "png", "readPNG"),
63
+            jpeg = c("grDevices", "jpeg", "readJPEG"),
64
+            tiff = c("grDevices", "tiff", "readTIFF"),
65
+            CairoPNG = c("Cairo", "png", "readPNG"),
66
+            CairoJPEG = c("Cairo", "jpeg", "readJPEG"),
67
+            CairoTIFF = c("Cairo", "tiff", "readTIFF")
68
+        )
69
+        if(!requireNamespace(device_info[1])) {
70
+            stop(paste0("Need ", device_info[1], " package to write image."))
71
+        }
72
+        if(!requireNamespace(device_info[2])) {
73
+            stop(paste0("Need ", device_info[2], " package to read image."))
74
+        }
75
+        # can we get the size of the heatmap body?
76
+        heatmap_width = convertWidth(unit(1, "npc"), "bigpts", valueOnly = TRUE)
77
+        heatmap_height = convertHeight(unit(1, "npc"), "bigpts", valueOnly = TRUE)
78
+        if(heatmap_width <= 0 || heatmap_height <= 0) {
79
+            stop("The width or height of the raster image is zero, maybe you forget to turn off the previous graphic device or it was corrupted. Run `dev.off()` to close it.")
80
+        }
81
+        
82
+        temp_dir = tempdir()
83
+                # dir.create(tmp_dir, showWarnings = FALSE)
84
+        temp_image = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", kr, "_", kc), tmpdir = temp_dir, fileext = paste0(".", device_info[2]))
85
+        #getFromNamespace(raster_device, ns = device_info[1])(temp_image, width = heatmap_width*raster_quality, height = heatmap_height*raster_quality)
86
+        device_fun = getFromNamespace(raster_device, ns = device_info[1])
87
+
88
+        do.call(device_fun, c(list(filename = temp_image, width = max(c(heatmap_width*raster_quality, 1)), height = max(c(heatmap_height*raster_quality, 1))), raster_device_param))
89
+        grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = unit(1/nc, 'npc'), height = unit(1/nr, 'npc'), gp = do.call('gpar', c(list(fill = col_matrix), gp)))
90
+        if(is.function(layer_fun)) {
91
+            layer_fun(row_order, column_order)
92
+        }
93
+        dev.off2()
94
+        
95
+        # ############################################
96
+        # ## make the heatmap body in a another process
97
+        # temp_R_data = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", kr, "_", kc), tmpdir = temp_dir, fileext = paste0(".RData"))
98
+        # temp_R_file = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", kr, "_", kc), tmpdir = temp_dir, fileext = paste0(".R"))
99
+        # if(Sys.info()["sysname"] == "Windows") {
100
+        #     temp_image = gsub("\\\\", "/", temp_image)
101
+        #     temp_R_data = gsub("\\\\", "/", temp_R_data)
102
+        #     temp_R_file = gsub("\\\\", "/", temp_R_file)
103
+        # }
104
+        # save(device_fun, device_info, temp_image, heatmap_width, raster_quality, heatmap_height, raster_device_param,
105
+        #     gp, x, expand_index, nc, nr, col_matrix, row_order, column_order, y,
106
+        #     file = temp_R_data)
107
+        # R_cmd = qq("
108
+        # library(@{device_info[1]})
109
+        # library(grid)
110
+        # load('@{temp_R_data}')
111
+        # do.call('device_fun', c(list(filename = temp_image, width = max(c(heatmap_width*raster_quality, 1)), height = max(c(heatmap_height*raster_quality, 1))), raster_device_param))
112
+        # grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = unit(1/nc, 'npc'), height = unit(1/nr, 'npc'), gp = do.call('gpar', c(list(fill = col_matrix), gp)))
113
+        # dev.off()
114
+        # q(save = 'no')
115
+        # ", code.pattern = "@\\{CODE\\}")
116
+        # writeLines(R_cmd, con = temp_R_file)
117
+        # if(grepl(" ", temp_R_file)) {
118
+        #     if(is_windows()) {
119
+        #         oe = try(system(qq("\"@{normalizePath(R_binary(), winslash='/')}\" --vanilla < \'@{temp_R_file}\'", code.pattern = "@\\{CODE\\}"), ignore.stdout = TRUE, ignore.stderr = TRUE, show.output.on.console = FALSE), silent = TRUE)
120
+        #     } else {
121
+        #         oe = try(system(qq("\"@{normalizePath(R_binary(), winslash='/')}\" --vanilla < \'@{temp_R_file}\'", code.pattern = "@\\{CODE\\}"), ignore.stdout = TRUE, ignore.stderr = TRUE), silent = TRUE)
122
+        #     }
123
+        # } else {
124
+        #     if(is_windows()) {
125
+        #         oe = try(system(qq("\"@{normalizePath(R_binary(), winslash='/')}\" --vanilla < @{temp_R_file}", code.pattern = "@\\{CODE\\}"), ignore.stdout = TRUE, ignore.stderr = TRUE, show.output.on.console = FALSE), silent = TRUE)
126
+        #     } else {
127
+        #         oe = try(system(qq("\"@{normalizePath(R_binary(), winslash='/')}\" --vanilla < @{temp_R_file}", code.pattern = "@\\{CODE\\}"), ignore.stdout = TRUE, ignore.stderr = TRUE), silent = TRUE)
128
+        #     }
129
+        # }
130
+        # ############################################
131
+        # file.remove(temp_R_data)
132
+        # file.remove(temp_R_file)
133
+        # if(inherits(oe, "try-error")) {
134
+        #     stop(oe)
135
+        # }
136
+        image = getFromNamespace(device_info[3], ns = device_info[2])(temp_image)
137
+        image = as.raster(image)
138
+        grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
139
+        file.remove(temp_image)
140
+
141
+    } else {
142
+        if(any(names(gp) %in% c("type"))) {
143
+            if(gp$type == "none") {
144
+            } else {
145
+                grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = unit(1/nc, "npc"), height = unit(1/nr, "npc"), gp = do.call("gpar", c(list(fill = col_matrix), gp)))
146
+            }
147
+        } else {
148
+            grid.rect(x[expand_index[[2]]], y[expand_index[[1]]], width = unit(1/nc, "npc"), height = unit(1/nr, "npc"), gp = do.call("gpar", c(list(fill = col_matrix), gp)))
149
+        }
150
+
151
+        if(is.function(cell_fun)) {
152
+            for(i in row_order) {
153
+                for(j in column_order) {
154
+                    cell_fun(j, i, unit(x[which(column_order == j)], "npc"), unit(y[which(row_order == i)], "npc"), unit(1/nc, "npc"), unit(1/nr, "npc"), col_matrix[which(row_order == i), which(column_order == j)])
155
+                }
156
+            }
157
+        }
158
+    }
159
+
160
+    if(!identical(border, FALSE)) {
161
+        grid.rect(gp = gpar(fill = "transparent", col = border))
162
+    }
163
+
164
+    upViewport()
165
+
166
+})
167
+
168
+is_windows = function() {
169
+    tolower(.Platform$OS.type) == "windows"
170
+}
171
+
172
+R_binary = function() {
173
+    R_exe = ifelse(is_windows(), "R.exe", "R")
174
+    return(file.path(R.home("bin"), R_exe))
175
+}
176
+
177
+# == title
178
+# Draw Heatmap Dendrograms
179
+#
180
+# == param
181
+# -object A `Heatmap-class` object.
182
+# -which Are the dendrograms put on the row or on the column of the heatmap?
183
+# -k Slice index.
184
+# -... Pass to `grid::viewport` which includes the complete heatmap dendrograms.
185
+#
186
+# == details
187
+# A viewport is created which contains dendrograms.
188
+#
189
+# This function is only for internal use.
190
+#
191
+# == value
192
+# This function returns no value.
193
+#
194
+# == seealso
195
+# `grid.dendrogram`
196
+#
197
+# == author
198
+# Zuguang Gu <z.gu@dkfz.de>