Browse code

various updates

Zuguang Gu authored on 23/06/2017 21:05:07
Showing 15 changed files

... ...
@@ -97,8 +97,8 @@ exportMethods(set_component_height)
97 97
 import(grDevices)
98 98
 import(graphics)
99 99
 import(grid)
100
-import(stats)
101 100
 import(methods)
101
+import(stats)
102 102
 importFrom("GetoptLong", qq)
103 103
 importFrom("GetoptLong", qq.options)
104 104
 importFrom("GetoptLong", qqcat)
... ...
@@ -1,6 +1,15 @@
1 1
 CHANGES in VERSION 1.15.1
2 2
 
3 3
 * random colors are generated by new `rand_color()` function in circlize package.
4
+* add `density_param` in `densityHeatmap()` function
5
+* annotations with duplicated names have no legends any more
6
+* re-implement `grid.xaxis()` to draw axis labels rotated 90 degrees
7
+* grids in discrete legend are arranged by rows if ncol > 1
8
+* raster image is generated in a independent R session
9
+* empty string in annotation or heatmap is mapped to NA
10
+* annotation and heatmap legends can be merged into one column. 
11
+
12
+=======================
4 13
 
5 14
 CHANGES in VERSION 1.13.2
6 15
 
7 16
deleted file mode 100755
... ...
@@ -1,3 +0,0 @@
1
-[Dolphin]
2
-Timestamp=2015,6,15,11,33,52
3
-ViewMode=2
... ...
@@ -180,6 +180,7 @@ setMethod(f = "map_to_colors",
180 180
 	x2 = vector(length = length(x))
181 181
 
182 182
 	if(object@type == "discrete") {
183
+		x[grepl("^\\s*$", x)] = NA
183 184
 		lna = is.na(x)
184 185
 
185 186
 		if(is.numeric(x)) x = as.character(x)
... ...
@@ -214,7 +215,7 @@ setMethod(f = "map_to_colors",
214 215
 # -color_bar if the mapping is continuous, whether show the legend as discrete color bar or continuous color bar
215 216
 # -grid_height height of each legend grid.
216 217
 # -grid_width width of each legend grid.
217
-# -grid_border color for legend grid borders.
218
+# -border color for legend grid borders.
218 219
 # -at break values of the legend
219 220
 # -labels labels corresponding to break values
220 221
 # -labels_gp graphcial parameters for legend labels
... ...
@@ -247,7 +248,7 @@ setMethod(f = "color_mapping_legend",
247 248
 	color_bar = c("discrete", "continuous"),
248 249
 	grid_height = unit(4, "mm"),
249 250
 	grid_width = unit(4, "mm"),
250
-	grid_border = NULL,
251
+	border = NULL,
251 252
 	at = object@levels,
252 253
 	labels = at,
253 254
 	labels_gp = gpar(fontsize = 10),
... ...
@@ -290,13 +291,13 @@ setMethod(f = "color_mapping_legend",
290 291
 			labels = rev(labels)
291 292
 		}
292 293
 		gf = Legend(at = at, labels = labels, title = title, title_gp = title_gp, grid_height = grid_height,
293
-			grid_width = grid_width, border = grid_border, labels_gp = labels_gp, nrow = nrow, ncol = ncol,
294
+			grid_width = grid_width, border = border, labels_gp = labels_gp, nrow = nrow, ncol = ncol,
294 295
 			legend_gp = gpar(fill = map_to_colors(object, at)), title_position = title_position)
295 296
 
296 297
 	} else {
297 298
 
298 299
 		gf = Legend(at = at, labels = labels, col_fun = object@col_fun, title = title, title_gp = title_gp, grid_height = grid_height,
299
-			grid_width = grid_width, border = grid_border, labels_gp = labels_gp, direction = legend_direction,
300
+			grid_width = grid_width, border = border, labels_gp = labels_gp, direction = legend_direction,
300 301
 			legend_width = legend_width, legend_height = legend_height, title_position = title_position)
301 302
 
302 303
 	}
... ...
@@ -202,7 +202,8 @@ Heatmap = setClass("Heatmap",
202 202
 #        is appended to a list of heatmaps.
203 203
 # -show_heatmap_legend whether show heatmap legend?
204 204
 # -heatmap_legend_param a list contains parameters for the heatmap legend. See `color_mapping_legend,ColorMapping-method` for all available parameters.
205
-# -use_raster whether render the heatmap body as a raster image. It helps to reduce file size when the matrix is huge.
205
+# -use_raster whether render the heatmap body as a raster image. It helps to reduce file size when the matrix is huge. Note if ``cell_fun``
206
+#       is set, ``use_raster`` is enforced to be ``FALSE``.
206 207
 # -raster_device graphic device which is used to generate the raster image
207 208
 # -raster_quality a value set to larger than 1 will improve the quality of the raster image.
208 209
 # -raster_device_param a list of further parameters for the selected graphic device
... ...
@@ -230,7 +231,7 @@ Heatmap = function(matrix, col, name,
230 231
     na_col = "grey", 
231 232
     color_space = "LAB",
232 233
     rect_gp = gpar(col = NA), 
233
-    cell_fun = function(j, i, x, y, width, height, fill) NULL,
234
+    cell_fun = NULL,
234 235
     row_title = character(0), 
235 236
     row_title_side = c("left", "right"), 
236 237
     row_title_gp = gpar(fontsize = 14), 
... ...
@@ -1289,6 +1290,11 @@ setMethod(f = "draw_heatmap_body",
1289 1290
     y = (rev(seq_len(nr)) - 0.5) / nr
1290 1291
     expand_index = expand.grid(seq_len(nr), seq_len(nc))
1291 1292
     
1293
+    cell_fun = object@matrix_param$cell_fun
1294
+    if(!is.null(cell_fun)) {
1295
+        use_raster = FALSE
1296
+    }
1297
+        
1292 1298
     if(use_raster) {
1293 1299
         # write the image into a temporary file and read it back
1294 1300
         device_info = switch(raster_device,
... ...
@@ -1314,37 +1320,68 @@ setMethod(f = "draw_heatmap_body",
1314 1320
         temp_image = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", k, "_"), tmpdir = ".", fileext = paste0(".", device_info[2]))
1315 1321
         #getFromNamespace(raster_device, ns = device_info[1])(temp_image, width = heatmap_width*raster_quality, height = heatmap_height*raster_quality)
1316 1322
         device_fun = getFromNamespace(raster_device, ns = device_info[1])
1317
-        do.call("device_fun", c(list(filename = temp_image, width = heatmap_width*raster_quality, height = heatmap_height*raster_quality), raster_device_param))
1318
-    }
1323
+        
1324
+        ############################################
1325
+        ## make the heatmap body in a another process
1326
+        temp_R_data = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", k, "_"), tmpdir = ".", fileext = paste0(".RData"))
1327
+        temp_R_file = tempfile(pattern = paste0(".heatmap_body_", object@name, "_", k, "_"), tmpdir = ".", fileext = paste0(".R"))
1328
+        save(device_fun, device_info, temp_image, heatmap_width, raster_quality, heatmap_height, raster_device_param,
1329
+            gp, x, expand_index, nc, nr, col_matrix, row_order, column_order, y,
1330
+            file = temp_R_data)
1331
+        R_cmd = qq("
1332
+        library(@{device_info[1]})
1333
+        library(grid)
1334
+        load('@{temp_R_data}')
1335
+        do.call('device_fun', c(list(filename = temp_image, width = heatmap_width*raster_quality, height = heatmap_height*raster_quality), raster_device_param))
1336
+        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)))
1337
+        dev.off()
1338
+        q(save = 'no')
1339
+        ", code.pattern = "@\\{CODE\\}")
1340
+        writeLines(R_cmd, con = temp_R_file)
1341
+        oe = try(system(qq("\"@{R_binary()}\" --vanilla < \"@{temp_R_file}\"", code.pattern = "@\\{CODE\\}"), ignore.stdout = TRUE))
1342
+        ############################################
1343
+        file.remove(temp_image)
1344
+        file.remove(temp_R_data)
1345
+        file.remove(temp_R_file)
1346
+        if(inherits(oe, "try-error")) {
1347
+            stop(oe)
1348
+        }
1349
+        image = getFromNamespace(device_info[3], ns = device_info[2])(temp_image)
1350
+        image = as.raster(image)
1351
+        grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
1319 1352
 
1320
-    if(any(names(gp) %in% c("type"))) {
1321
-        if(gp$type == "none") {
1353
+    } else {
1354
+        if(any(names(gp) %in% c("type"))) {
1355
+            if(gp$type == "none") {
1356
+            } else {
1357
+                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)))
1358
+            }
1322 1359
         } else {
1323 1360
             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)))
1324 1361
         }
1325
-    } else {
1326
-        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)))
1327
-    }
1328 1362
 
1329
-    cell_fun = object@matrix_param$cell_fun
1330
-    for(i in row_order) {
1331
-        for(j in column_order) {
1332
-            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)])
1363
+        if(is.function(cell_fun)) {
1364
+            for(i in row_order) {
1365
+                for(j in column_order) {
1366
+                    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)])
1367
+                }
1368
+            }
1333 1369
         }
1334 1370
     }
1335 1371
 
1336
-    if(use_raster) {
1337
-        dev.off()
1338
-        image = getFromNamespace(device_info[3], ns = device_info[2])(temp_image)
1339
-        image = as.raster(image)
1340
-        grid.raster(image, width = unit(1, "npc"), height = unit(1, "npc"))
1341
-        file.remove(temp_image)
1342
-    }
1343
-
1344 1372
     upViewport()
1345 1373
 
1346 1374
 })
1347 1375
 
1376
+is_windows = function() {
1377
+    tolower(.Platform$OS.type) == "windows"
1378
+}
1379
+
1380
+R_binary = function() {
1381
+    R_exe = ifelse(is_windows(), "R.exe", "R")
1382
+    return(file.path(R.home("bin"), R_exe))
1383
+}
1384
+
1348 1385
 # == title
1349 1386
 # Draw dendrogram on row or column
1350 1387
 #
... ...
@@ -245,9 +245,21 @@ HeatmapAnnotation = function(df, name, col, na_col = "grey",
245 245
 			} else if(is.atomic(anno_arg_list[[ag]])) {
246 246
 
247 247
 			    if(is.null(simple_length)) {
248
-			    	simple_length = length(anno_arg_list[[ag]])
249
-			    } else if(length(anno_arg_list[[ag]]) != simple_length) {
250
-			    	stop("length of simple annotations differ.")
248
+			    	if(is.matrix(anno_arg_list[[ag]])) {
249
+			    		simple_length = nrow(anno_arg_list[[ag]])
250
+			    	} else {
251
+			    		simple_length = length(anno_arg_list[[ag]])
252
+			    	}
253
+			    } else{
254
+			    	if(is.matrix(anno_arg_list[[ag]])) {
255
+			    		if(nrow(anno_arg_list[[ag]]) != simple_length) {
256
+			    			stop("length of simple annotations differ.")
257
+			    		}
258
+			    	} else {
259
+			    		if(length(anno_arg_list[[ag]]) != simple_length) {
260
+			    			stop("length of simple annotations differ.")
261
+			    		}
262
+			    	}
251 263
 			    }
252 264
 				if(missing(col)) {
253 265
 			        anno_list = c(anno_list, list(SingleAnnotation(name = ag, value = anno_arg_list[[ag]], na_col = na_col, which = which, 
... ...
@@ -304,7 +316,15 @@ HeatmapAnnotation = function(df, name, col, na_col = "grey",
304 316
 
305 317
 	if(length(anno_size) == 1) {
306 318
 		if(!is.unit(anno_size)) {
307
-			anno_size = rep(anno_size, n_total_anno)
319
+			anno_size = sapply(anno_list, function(x) {
320
+				if(is_simple_annotation(x)) {
321
+					return(1)
322
+				} else if(is_matrix_annotation(x)) {
323
+					return(attr(x@is_anno_matrix, "k"))
324
+				} else {
325
+					return(2)
326
+				}
327
+			})
308 328
 		}
309 329
 	}
310 330
 
... ...
@@ -183,6 +183,7 @@ setMethod(f = "add_heatmap",
183 183
 # -column_title_side will the title be put on the top or bottom of the heatmap.
184 184
 # -column_title_gp graphic parameters for drawing text.
185 185
 # -heatmap_legend_side side of the heatmap legend.
186
+# -merge_legends whether put heatmap legends and annotation legends in a same column
186 187
 # -show_heatmap_legend whether show heatmap legend.
187 188
 # -heatmap_legend_list a list of self-defined legend, should be wrapped into `grid::grob` objects.
188 189
 # -annotation_legend_side side of annotation legend.
... ...
@@ -226,6 +227,7 @@ setMethod(f = "make_layout",
226 227
     column_title_side = c("top", "bottom"), 
227 228
     column_title_gp = gpar(fontsize = 14), 
228 229
     heatmap_legend_side = c("right", "left", "bottom", "top"), 
230
+    merge_legends = FALSE,
229 231
     show_heatmap_legend = TRUE, 
230 232
     heatmap_legend_list = list(),
231 233
     annotation_legend_side = c("right", "left", "bottom", "top"), 
... ...
@@ -283,6 +285,8 @@ setMethod(f = "make_layout",
283 285
     }
284 286
     object@ht_list_param$gap = gap
285 287
 
288
+    object@ht_list_param$merge_legends = merge_legends
289
+
286 290
     for(i in seq_len(n)) {
287 291
         # if the zero-column matrix is the first one
288 292
         if(inherits(object@ht_list[[i]], "Heatmap")) {
... ...
@@ -445,7 +449,8 @@ setMethod(f = "make_layout",
445 449
     }
446 450
     object@ht_list_param$gap = gap
447 451
     object@ht_list_param$main_heatmap = i_main
448
-    
452
+    object@ht_list_param$merge_legends = merge_legends
453
+
449 454
     n = length(object@ht_list)
450 455
 
451 456
     ## orders of other heatmaps should be changed
... ...
@@ -591,9 +596,15 @@ setMethod(f = "make_layout",
591 596
     for(i in seq_along(object@ht_list)) {
592 597
         ht = object@ht_list[[i]]
593 598
         if(inherits(ht, "Heatmap")) {
599
+            if(merge_legends && !is.null(ht@top_annotation)) {
600
+                ColorMappingList = c(ColorMappingList, get_color_mapping_list(ht@top_annotation))
601
+            }
594 602
             if(ht@heatmap_param$show_heatmap_legend) {
595 603
                 ColorMappingList = c(ColorMappingList, ht@matrix_color_mapping)
596 604
             }
605
+            if(merge_legends && !is.null(ht@bottom_annotation)) {
606
+                ColorMappingList = c(ColorMappingList, get_color_mapping_list(ht@bottom_annotation))
607
+            }
597 608
         }
598 609
         if(inherits(ht, "HeatmapAnnotation")) {
599 610
             ColorMappingList = c(ColorMappingList, get_color_mapping_list(ht))
... ...
@@ -641,16 +652,20 @@ setMethod(f = "make_layout",
641 652
     ## annotation legend to top, bottom, left and right
642 653
     # default values
643 654
     ColorMappingList = list()
644
-    for(i in seq_along(object@ht_list)) {
645
-        ht = object@ht_list[[i]]
646
-        if(inherits(ht, "Heatmap")) {
647
-            if(!is.null(ht@top_annotation)) {
648
-                ColorMappingList = c(ColorMappingList, get_color_mapping_list(ht@top_annotation))
649
-            }
650
-            if(!is.null(ht@bottom_annotation)) {
651
-                ColorMappingList = c(ColorMappingList, get_color_mapping_list(ht@bottom_annotation))
655
+    if(!merge_legends) {
656
+        for(i in seq_along(object@ht_list)) {
657
+            ht = object@ht_list[[i]]
658
+            if(inherits(ht, "Heatmap")) {
659
+                if(!is.null(ht@top_annotation)) {
660
+                    ColorMappingList = c(ColorMappingList, get_color_mapping_list(ht@top_annotation))
661
+                }
662
+                if(!is.null(ht@bottom_annotation)) {
663
+                    ColorMappingList = c(ColorMappingList, get_color_mapping_list(ht@bottom_annotation))
664
+                }
652 665
             }
653 666
         }
667
+    } else {
668
+        annotation_legend_list = list()
654 669
     }
655 670
     if(length(ColorMappingList) == 0 && length(annotation_legend_list) == 0) {
656 671
         show_annotation_legend = FALSE
... ...
@@ -1173,11 +1188,20 @@ setMethod(f = "draw_heatmap_legend",
1173 1188
     ColorMappingList = list()
1174 1189
     ColorMappingParamList = list()
1175 1190
     for(i in seq_along(object@ht_list)) {
1191
+        ht = object@ht_list[[i]]
1176 1192
         if(inherits(object@ht_list[[i]], "Heatmap")) {
1193
+            if(object@ht_list_param$merge_legends && !is.null(ht@top_annotation)) {
1194
+                ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
1195
+                ColorMappingParamList = c.list(ColorMappingParamList, list = get_color_mapping_param_list(ht@top_annotation))
1196
+            }
1177 1197
             if(object@ht_list[[i]]@heatmap_param$show_heatmap_legend) {
1178 1198
                 ColorMappingList = c.list(ColorMappingList, object@ht_list[[i]]@matrix_color_mapping)
1179 1199
                 ColorMappingParamList = c.list(ColorMappingParamList, object@ht_list[[i]]@matrix_color_mapping_param)
1180 1200
             }
1201
+            if(object@ht_list_param$merge_legends && !is.null(ht@bottom_annotation)) {
1202
+                ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
1203
+                ColorMappingParamList = c.list(ColorMappingParamList, list = get_color_mapping_param_list(ht@bottom_annotation))
1204
+            }
1181 1205
         } else if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
1182 1206
             ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(object@ht_list[[i]]))
1183 1207
             ColorMappingParamList = c.list(ColorMappingParamList, list = get_color_mapping_param_list(object@ht_list[[i]]))
... ...
@@ -1298,11 +1322,21 @@ setMethod(f = "heatmap_legend_size",
1298 1322
     ColorMappingList = list()
1299 1323
     ColorMappingParamList = list()
1300 1324
     for(i in seq_along(object@ht_list)) {
1325
+        ht = object@ht_list[[i]]
1301 1326
         if(inherits(object@ht_list[[i]], "Heatmap")) {
1327
+            if(object@ht_list_param$merge_legends && !is.null(ht@top_annotation)) {
1328
+                ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@top_annotation))
1329
+                ColorMappingParamList = c.list(ColorMappingParamList, list = get_color_mapping_param_list(ht@top_annotation))
1330
+            }
1302 1331
             if(object@ht_list[[i]]@heatmap_param$show_heatmap_legend) {
1303 1332
                 ColorMappingList = c.list(ColorMappingList, object@ht_list[[i]]@matrix_color_mapping)
1304 1333
                 ColorMappingParamList = c.list(ColorMappingParamList, object@ht_list[[i]]@matrix_color_mapping_param)
1305 1334
             }
1335
+            if(object@ht_list_param$merge_legends && !is.null(ht@bottom_annotation)) {
1336
+                ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(ht@bottom_annotation))
1337
+                ColorMappingParamList = c.list(ColorMappingParamList, list = get_color_mapping_param_list(ht@bottom_annotation))
1338
+            }
1339
+            
1306 1340
         } else if(inherits(object@ht_list[[i]], "HeatmapAnnotation")) {
1307 1341
             ColorMappingList = c.list(ColorMappingList, list = get_color_mapping_list(object@ht_list[[i]]))
1308 1342
             ColorMappingParamList = c.list(ColorMappingParamList, list = get_color_mapping_param_list(object@ht_list[[i]]))
... ...
@@ -1369,6 +1403,12 @@ draw_legend = function(ColorMappingList, ColorMappingParamList, side = c("right"
1369 1403
 
1370 1404
     side = match.arg(side)[1]
1371 1405
 
1406
+    # remove legends which are duplicated by testing the names
1407
+    legend_names = sapply(ColorMappingList, function(x) x@name)
1408
+    l = !duplicated(legend_names)
1409
+    ColorMappingList = ColorMappingList[l]
1410
+    ColorMappingParamList = ColorMappingParamList[l]
1411
+
1372 1412
     n = length(ColorMappingList)
1373 1413
     if(n == 0 && length(legend_list) == 0) {
1374 1414
         return(unit(c(0, 0), "null"))
... ...
@@ -139,6 +139,7 @@ Legend = function(at, labels = at, nrow = NULL, ncol = 1, col_fun,
139 139
 	return(gf)
140 140
 }
141 141
 
142
+# grids are arranged by rows
142 143
 discrete_legend_body = function(at, labels = at, nrow = NULL, ncol = 1,
143 144
 	grid_height = unit(4, "mm"), grid_width = unit(4, "mm"), gap = unit(2, "mm"),
144 145
 	labels_gp = gpar(fontsize = 10),
... ...
@@ -156,14 +157,18 @@ discrete_legend_body = function(at, labels = at, nrow = NULL, ncol = 1,
156 157
 		nrow = 1
157 158
 		ncol = 1
158 159
 	}
160
+	ncol = ifelse(ncol > n_labels, n_labels, ncol)
161
+
162
+	labels_mat = matrix(c(labels, rep("", nrow*ncol - n_labels)), nrow = nrow, ncol = ncol, byrow = TRUE)
163
+	index_mat = matrix(1:(nrow*ncol), nrow = nrow, ncol = ncol, byrow = TRUE)
164
+
159 165
 
160 166
 	labels_padding_left = unit(1, "mm")
161 167
 	
162 168
 	labels_max_width = NULL
163 169
 	for(i in 1:ncol) {
164
-		index = seq(nrow*(i-1)+1, min(c(nrow*i, n_labels)))
165 170
 		if(i == 1) {
166
-			labels_max_width = max(do.call("unit.c", lapply(labels[index], function(x) {
171
+			labels_max_width = max(do.call("unit.c", lapply(labels_mat[, i], function(x) {
167 172
 					g = grobWidth(textGrob(x, gp = labels_gp))
168 173
 					if(i < ncol) {
169 174
 						g = g + gap
... ...
@@ -171,7 +176,7 @@ discrete_legend_body = function(at, labels = at, nrow = NULL, ncol = 1,
171 176
 					g
172 177
 				})))
173 178
 		} else {
174
-			labels_max_width = unit.c(labels_max_width, max(do.call("unit.c", lapply(labels[index], function(x) {
179
+			labels_max_width = unit.c(labels_max_width, max(do.call("unit.c", lapply(labels_mat[, i], function(x) {
175 180
 					g = grobWidth(textGrob(x, gp = labels_gp))
176 181
 					if(i < ncol) {
177 182
 						g = g + gap
... ...
@@ -191,7 +196,7 @@ discrete_legend_body = function(at, labels = at, nrow = NULL, ncol = 1,
191 196
 
192 197
 	# legend grid
193 198
 	for(i in 1:ncol) {
194
-		index = seq(nrow*(i-1)+1, min(c(nrow*i, n_labels)))
199
+		index = index_mat[, i][labels_mat[, i] != ""]
195 200
 		ni = length(index)
196 201
 		x = unit(rep(0, ni), "npc")
197 202
 		y = (0:(ni-1))*(grid_height)
... ...
@@ -35,7 +35,8 @@ SingleAnnotation = setClass("SingleAnnotation",
35 35
 		show_legend = "logical",
36 36
 		which = "character",
37 37
 		name_to_data_vp = "logical",
38
-		name_param = "list"
38
+		name_param = "list",
39
+        is_anno_matrix = "logical"
39 40
 	),
40 41
 	prototype = list(
41 42
 		color_mapping = NULL,
... ...
@@ -137,14 +138,37 @@ SingleAnnotation = function(name, value, col, fun,
137 138
         stop("`name_rot` can only take values in c(0, 90, 180, 270)")
138 139
     }
139 140
 
140
-    
141
+    .Object@is_anno_matrix = FALSE
142
+    use_mat_column_names = FALSE
143
+    if(!missing(value)) {
144
+        if(is.logical(value)) {
145
+            value = as.character(value)
146
+        }
147
+        if(is.factor(value)) {
148
+            value = as.vector(value)
149
+        }
150
+        if(is.matrix(value)) {
151
+            .Object@is_anno_matrix = TRUE
152
+            attr(.Object@is_anno_matrix, "column_names") = colnames(value)
153
+            attr(.Object@is_anno_matrix, "k") = ncol(value)
154
+            use_mat_column_names = TRUE
155
+            use_mat_nc = ncol(value)
156
+        }
157
+    }
158
+
141 159
     if(which == "column") {
142 160
     	if(!name_side %in% c("left", "right")) {
143 161
     		stop("`name_side` should be 'left' or 'right' when it is a column annotation.")
144 162
     	}
145 163
     	if(name_side == "left") {
146
-    		name_x = unit(0, "npc") - name_offset
147
-    		name_y = unit(0.5, "npc")
164
+    		
165
+            if(use_mat_column_names) {
166
+                name_x = unit(rep(0, use_mat_nc), "npc") - name_offset
167
+                name_y = unit((use_mat_nc - seq_len(use_mat_nc) + 0.5)/use_mat_nc, "npc")
168
+            } else {
169
+                name_x = unit(0, "npc") - name_offset
170
+                name_y = unit(0.5, "npc")
171
+            }
148 172
             if(name_rot == 0) {
149 173
                 name_just = "right"
150 174
             } else if(name_rot == 90) {
... ...
@@ -155,8 +179,13 @@ SingleAnnotation = function(name, value, col, fun,
155 179
                 name_just = "top"
156 180
             }
157 181
     	} else {
158
-    		name_x = unit(1, "npc") + name_offset
159
-    		name_y = unit(0.5, "npc")
182
+            if(use_mat_column_names) {
183
+                name_x = unit(rep(1, use_mat_nc), "npc") + name_offset
184
+                name_y = unit((use_mat_nc - seq_len(use_mat_nc) + 0.5)/use_mat_nc, "npc")
185
+            } else {
186
+        		name_x = unit(1, "npc") + name_offset
187
+        		name_y = unit(0.5, "npc")
188
+            }
160 189
             if(name_rot == 0) {
161 190
                 name_just = "left"
162 191
             } else if(name_rot == 90) {
... ...
@@ -172,8 +201,13 @@ SingleAnnotation = function(name, value, col, fun,
172 201
     		stop("`name_side` should be 'left' or 'right' when it is a column annotation.")
173 202
     	}
174 203
     	if(name_side == "top") {
175
-    		name_x = unit(0.5, "npc")
176
-    		name_y = unit(1, "npc") + name_offset
204
+            if(use_mat_column_names) {
205
+                name_x = unit((seq_len(use_mat_nc) - 0.5)/use_mat_nc, "npc")
206
+                name_y = unit(rep(1, use_mat_nc), "npc") + name_offset
207
+            } else {
208
+        		name_x = unit(0.5, "npc")
209
+        		name_y = unit(1, "npc") + name_offset
210
+            }
177 211
             if(name_rot == 0) {
178 212
                 name_just = "bottom"
179 213
             } else if(name_rot == 90) {
... ...
@@ -184,8 +218,13 @@ SingleAnnotation = function(name, value, col, fun,
184 218
                 name_just = "right"
185 219
             }
186 220
     	} else {
187
-    		name_x = unit(0.5, "npc")
188
-    		name_y = unit(0, "npc") - name_offset
221
+            if(use_mat_column_names) {
222
+                name_x = unit((seq_len(use_mat_nc) - 0.5)/use_mat_nc, "npc")
223
+                name_y = unit(rep(0, use_mat_nc), "npc") - name_offset
224
+            } else {
225
+        		name_x = unit(0.5, "npc")
226
+        		name_y = unit(0, "npc") - name_offset
227
+            }
189 228
             if(name_rot == 0) {
190 229
                 name_just = "top"
191 230
             } else if(name_rot == 90) {
... ...
@@ -209,20 +248,10 @@ SingleAnnotation = function(name, value, col, fun,
209 248
     	stop("You should not set `fill`.")
210 249
     }
211 250
 
212
-    if(!missing(value)) {
213
-	    if(is.logical(value)) {
214
-	    	value = as.character(value)
215
-	    }
216
-	    if(is.factor(value)) {
217
-            value = as.vector(value)
218
-        }
219
-	}
220
-
221 251
     if(missing(fun)) {
222 252
     	if(missing(col)) {
223 253
     		col = default_col(value)
224 254
     	}
225
-        
226 255
     	if(is.atomic(col)) {
227 256
     	    if(is.null(names(col))) {
228 257
                 if(is.factor(value)) {
... ...
@@ -250,17 +279,31 @@ SingleAnnotation = function(name, value, col, fun,
250 279
 	        .Object@fun = function(index) {
251 280
 	        	n = length(index)
252 281
 				x = (seq_len(n) - 0.5) / n
253
-				fill = map_to_colors(color_mapping, value[index])
254
-				#l = which(!is.na(value[index]))
255
-				grid.rect(x, y = 0.5, width = 1/n, height = 1, gp = do.call("gpar", c(list(fill = fill), gp)))
282
+                if(is.matrix(value)) {
283
+                    nc = ncol(value)
284
+                    for(i in seq_len(nc)) {
285
+                        fill = map_to_colors(color_mapping, value[index, i])
286
+                        grid.rect(x, y = (nc-i +0.5)/nc, width = 1/n, height = 1/nc, gp = do.call("gpar", c(list(fill = fill), gp)))
287
+                    }
288
+                } else {
289
+    				fill = map_to_colors(color_mapping, value[index])
290
+    				grid.rect(x, y = 0.5, width = 1/n, height = 1, gp = do.call("gpar", c(list(fill = fill), gp)))
291
+                }
256 292
 			}
257 293
 		} else {
258 294
 			.Object@fun = function(index, k = NULL, N = NULL) {
259 295
 				n = length(index)
260 296
 				y = (n - seq_len(n) + 0.5) / n
261
-				fill = map_to_colors(color_mapping, value[index])
262
-				#l = which(!is.na(value[index]))
263
-				grid.rect(x = 0.5, y, height = 1/n, width = 1, gp = do.call("gpar", c(list(fill = fill), gp)))
297
+                if(is.matrix(value)) {
298
+                    nc = ncol(value)
299
+                    for(i in seq_len(nc)) {
300
+                        fill = map_to_colors(color_mapping, value[index, i])
301
+                        grid.rect(x = (i-0.5)/nc, y, height = 1/n, width = 1/nc, gp = do.call("gpar", c(list(fill = fill), gp)))
302
+                    }
303
+                } else {
304
+    				fill = map_to_colors(color_mapping, value[index])
305
+    				grid.rect(x = 0.5, y, height = 1/n, width = 1, gp = do.call("gpar", c(list(fill = fill), gp)))
306
+                }
264 307
 			}
265 308
 		}
266 309
 
... ...
@@ -342,8 +385,19 @@ setMethod(f = "draw",
342 385
 	}
343 386
 	# add annotation name
344 387
 	if(object@name_param$show) {
345
-		grid.text(object@name, x = object@name_param$x, y = object@name_param$y, just = object@name_param$just, 
346
-			rot = object@name_param$rot, gp = object@name_param$gp)
388
+        if(is_matrix_annotation(object)) {
389
+            if(!is.null(attr(object@is_anno_matrix, "column_names"))) {
390
+                anno_mat_column_names = attr(object@is_anno_matrix, "column_names")
391
+                grid.text(anno_mat_column_names, x = object@name_param$x, y = object@name_param$y, just = object@name_param$just, 
392
+                    rot = object@name_param$rot, gp = object@name_param$gp)
393
+            } else {
394
+                grid.text(object@name, x = object@name_param$x, y = object@name_param$y, just = object@name_param$just, 
395
+                    rot = object@name_param$rot, gp = object@name_param$gp)
396
+            }
397
+        } else {
398
+    		grid.text(object@name, x = object@name_param$x, y = object@name_param$y, just = object@name_param$just, 
399
+    			rot = object@name_param$rot, gp = object@name_param$gp)
400
+        }
347 401
 	}
348 402
 	upViewport()
349 403
 
... ...
@@ -364,7 +418,7 @@ setMethod(f = "draw",
364 418
 setMethod(f = "show",
365 419
 	signature = "SingleAnnotation",
366 420
 	definition = function(object) {
367
-	if(is.null(object@color_mapping)) {
421
+	if(is_fun_annotation(object)) {
368 422
 		cat("An annotation with self-defined function\n")
369 423
 		cat("name:", object@name, "\n")
370 424
 		cat("position:", object@which, "\n")
... ...
@@ -373,5 +427,21 @@ setMethod(f = "show",
373 427
 		cat("name:", object@name, "\n")
374 428
 		cat("position:", object@which, "\n")
375 429
 		cat("show legend:", object@show_legend, "\n")
430
+        if(is_matrix_annotation(object)) {
431
+            cat("a matrix with", attr(object@is_anno_matrix, "k"), "columns\n")
432
+        }
376 433
 	}
377 434
 })
435
+
436
+
437
+is_simple_annotation = function(single_anno) {
438
+    !is_fun_annotation(single_anno) && !is_matrix_annotation(single_anno)
439
+}
440
+
441
+is_matrix_annotation = function(single_anno) {
442
+    single_anno@is_anno_matrix
443
+}
444
+
445
+is_fun_annotation = function(single_anno) {
446
+    is.null(single_anno@color_mapping)
447
+}
... ...
@@ -1229,3 +1229,24 @@ row_anno_link = function(...) {
1229 1229
 column_anno_link = function(...) {
1230 1230
 	anno_link(..., which = "column")
1231 1231
 }
1232
+
1233
+
1234
+grid.xaxis = function(main = TRUE, at = NULL, label = NULL, gp = gpar()) {
1235
+	if(is.null(at)) {
1236
+		at = grid.pretty(current.viewport()$xscale)
1237
+		label = at
1238
+	}
1239
+	if(is.null(label)) {
1240
+		label = at
1241
+	}
1242
+	n = length(at)
1243
+	if(main) {
1244
+		grid.lines(at[c(1, n)], unit(c(0, 0), "native"), gp = gp, default.units = "native")
1245
+		grid.segments(at, unit(rep(-0.5, n), "lines"), at, unit(rep(0, n), "npc"), gp = gp, default.units = "native")
1246
+		grid.text(label, at, unit(rep(-1, n), "lines"), rot = 90, just = "right", gp = gp, default.units = "native")
1247
+	} else {
1248
+		grid.lines(at[c(1, n)], unit(c(1, 1), "native"), gp = gp, default.units = "native")
1249
+		grid.segments(at, unit(1, "npc") + unit(rep(0.5, n), "lines"), at, unit(rep(1, n), "npc"), gp = gp, default.units = "native")
1250
+		grid.text(label, at, unit(1, "npc") + unit(rep(1, n), "lines"), rot = 90, just = "left", gp = gp, default.units = "native")
1251
+	}
1252
+}
... ...
@@ -5,6 +5,7 @@
5 5
 # == param
6 6
 # -data  a matrix or a list. If it is a matrix, density will be calculated by columns.
7 7
 # -col a list of colors that density values are mapped to.
8
+# -density_param parameters send to `stats::density`, ``na.rm`` is enforced to ``TRUE``.
8 9
 # -color_space the color space in which colors are interpolated. Pass to `circlize::colorRamp2`.
9 10
 # -anno annotation for the matrix columns or the list. The value should be a vector or a data frame 
10 11
 #       and colors for annotations are randomly assigned. If you want to customize the annotation colors,
... ...
@@ -33,6 +34,9 @@
33 34
 # in each column (or each vector in the list) through a heatmap. It is useful if you have huge number 
34 35
 # of columns in ``data`` to visualize.
35 36
 #
37
+# The density matrix is generated with 500 rows ranging between the maximun and minimal values in all densities.
38
+# The density values in each row are linearly intepolated between the two density values at the two nearest bounds.
39
+#
36 40
 # == value
37 41
 # No value is returned.
38 42
 #
... ...
@@ -54,6 +58,7 @@
54 58
 #
55 59
 densityHeatmap = function(data, 
56 60
 	col = rev(brewer.pal(11, "Spectral")),
61
+	density_param = list(na.rm = TRUE),
57 62
 	color_space = "LAB", 
58 63
 	anno = NULL, 
59 64
 	ylab = deparse(substitute(data)), 
... ...
@@ -74,12 +79,14 @@ densityHeatmap = function(data,
74 79
 	column_order = NULL,
75 80
 	...) {
76 81
 
82
+	density_param$na.rm = TRUE
83
+
77 84
 	if(is.matrix(data)) {
78
-		density_list = apply(data, 2, density, na.rm = TRUE)
85
+		density_list = apply(data, 2, function(x) do.call(density, c(list(x = x), density_param)))
79 86
 		quantile_list = apply(data, 2, quantile, na.rm = TRUE)
80 87
 		mean_value = apply(data, 2, mean, na.rm = TRUE)
81 88
 	} else if(is.data.frame(data) || is.list(data)) {
82
-		density_list = lapply(data, density, na.rm = TRUE)
89
+		density_list = lapply(data, function(x) do.call(density, c(list(x = x), density_param)))
83 90
 		quantile_list = sapply(data, quantile, na.rm = TRUE)
84 91
 		mean_value = sapply(data, mean, na.rm = TRUE)
85 92
 	} else {
... ...
@@ -11,7 +11,7 @@ Heatmap(matrix, col, name,
11 11
     na_col = "grey",
12 12
     color_space = "LAB",
13 13
     rect_gp = gpar(col = NA),
14
-    cell_fun = function(j, i, x, y, width, height, fill) NULL,
14
+    cell_fun = NULL,
15 15
     row_title = character(0),
16 16
     row_title_side = c("left", "right"),
17 17
     row_title_gp = gpar(fontsize = 14),
... ...
@@ -138,7 +138,7 @@ Heatmap(matrix, col, name,
138 138
   \item{width}{the width of the single heatmap, should be a fixed \code{\link[grid]{unit}} object. It is used for the layout when the heatmap is appended to a list of heatmaps.}
139 139
   \item{show_heatmap_legend}{whether show heatmap legend?}
140 140
   \item{heatmap_legend_param}{a list contains parameters for the heatmap legend. See \code{\link{color_mapping_legend,ColorMapping-method}} for all available parameters.}
141
-  \item{use_raster}{whether render the heatmap body as a raster image. It helps to reduce file size when the matrix is huge.}
141
+  \item{use_raster}{whether render the heatmap body as a raster image. It helps to reduce file size when the matrix is huge. Note if \code{cell_fun} is set, \code{use_raster} is enforced to be \code{FALSE}.}
142 142
   \item{raster_device}{graphic device which is used to generate the raster image}
143 143
   \item{raster_quality}{a value set to larger than 1 will improve the quality of the raster image.}
144 144
   \item{raster_device_param}{a list of further parameters for the selected graphic device}
... ...
@@ -16,7 +16,7 @@ Draw legend based on color mapping
16 16
     color_bar = c("discrete", "continuous"),
17 17
     grid_height = unit(4, "mm"),
18 18
     grid_width = unit(4, "mm"),
19
-    grid_border = NULL,
19
+    border = NULL,
20 20
     at = object@levels,
21 21
     labels = at,
22 22
     labels_gp = gpar(fontsize = 10),
... ...
@@ -36,7 +36,7 @@ Draw legend based on color mapping
36 36
   \item{color_bar}{if the mapping is continuous, whether show the legend as discrete color bar or continuous color bar}
37 37
   \item{grid_height}{height of each legend grid.}
38 38
   \item{grid_width}{width of each legend grid.}
39
-  \item{grid_border}{color for legend grid borders.}
39
+  \item{border}{color for legend grid borders.}
40 40
   \item{at}{break values of the legend}
41 41
   \item{labels}{labels corresponding to break values}
42 42
   \item{labels_gp}{graphcial parameters for legend labels}
... ...
@@ -9,6 +9,7 @@ Use colors to represent density distribution
9 9
 \usage{
10 10
 densityHeatmap(data,
11 11
     col = rev(brewer.pal(11, "Spectral")),
12
+    density_param = list(na.rm = TRUE),
12 13
     color_space = "LAB",
13 14
     anno = NULL,
14 15
     ylab = deparse(substitute(data)),
... ...
@@ -33,6 +34,7 @@ densityHeatmap(data,
33 34
 
34 35
   \item{data}{a matrix or a list. If it is a matrix, density will be calculated by columns.}
35 36
   \item{col}{a list of colors that density values are mapped to.}
37
+  \item{density_param}{parameters send to \code{\link[stats]{density}}, \code{na.rm} is enforced to \code{TRUE}.}
36 38
   \item{color_space}{the color space in which colors are interpolated. Pass to \code{\link[circlize]{colorRamp2}}.}
37 39
   \item{anno}{annotation for the matrix columns or the list. The value should be a vector or a data frame  and colors for annotations are randomly assigned. If you want to customize the annotation colors, use a \code{\link{HeatmapAnnotation-class}} object directly.}
38 40
   \item{ylab}{label on y-axis in the plot}
... ...
@@ -59,6 +61,9 @@ To visualize data distribution in a matrix or in a list, sometimes we use boxplo
59 61
 Here we use colors to map the density values and visualize distribution of values
60 62
 in each column (or each vector in the list) through a heatmap. It is useful if you have huge number 
61 63
 of columns in \code{data} to visualize.
64
+
65
+The density matrix is generated with 500 rows ranging between the maximun and minimal values in all densities.
66
+The density values in each row are linearly intepolated between the two density values at the two nearest bounds.
62 67
 }
63 68
 \value{
64 69
 No value is returned.
... ...
@@ -14,6 +14,7 @@ Make layout for the complete plot
14 14
     column_title_side = c("top", "bottom"),
15 15
     column_title_gp = gpar(fontsize = 14),
16 16
     heatmap_legend_side = c("right", "left", "bottom", "top"),
17
+    merge_legends = FALSE,
17 18
     show_heatmap_legend = TRUE,
18 19
     heatmap_legend_list = list(),
19 20
     annotation_legend_side = c("right", "left", "bottom", "top"),
... ...
@@ -45,6 +46,7 @@ Make layout for the complete plot
45 46
   \item{column_title_side}{will the title be put on the top or bottom of the heatmap.}
46 47
   \item{column_title_gp}{graphic parameters for drawing text.}
47 48
   \item{heatmap_legend_side}{side of the heatmap legend.}
49
+  \item{merge_legends}{whether put heatmap legends and annotation legends in a same column}
48 50
   \item{show_heatmap_legend}{whether show heatmap legend.}
49 51
   \item{heatmap_legend_list}{a list of self-defined legend, should be wrapped into \code{\link[grid]{grob}} objects.}
50 52
   \item{annotation_legend_side}{side of annotation legend.}