Browse code

update

Zuguang Gu authored on 31/10/2018 15:23:59
Showing7 changed files

... ...
@@ -2599,13 +2599,12 @@ anno_mark = function(at, labels, which = c("column", "row"),
2599 2599
 		link_gp = subset_gp(link_gp, labels2index[labels])
2600 2600
 
2601 2601
 		pushViewport(viewport(xscale = c(0, 1), yscale = c(0.5, n+0.5)))
2602
-		# go to the parent viewport
2603
-
2602
+		if(inherits(extend, "unit")) extend = convertHeight(extend, "native", valueOnly = TRUE)
2604 2603
 		text_height = convertHeight(grobHeight(textGrob(labels, gp = labels_gp))*(1+padding), "native", valueOnly = TRUE)
2605 2604
 		i2 = rev(which(index %in% at))
2606 2605
 		h1 = n-i2+1 - text_height*0.5
2607 2606
 		h2 = n-i2+1 + text_height*0.5
2608
-		pos = rev(smartAlign(h1, h2, c(0.5, n+0.5)))
2607
+		pos = rev(smartAlign(h1, h2, c(0.5 - extend[1], n+0.5 + extend[2])))
2609 2608
 		h = (pos[, 1] + pos[, 2])/2
2610 2609
 
2611 2610
 		n2 = length(labels)
... ...
@@ -1073,21 +1073,22 @@ make_cluster = function(object, which = c("row", "column")) {
1073 1073
         if(which == "row") {
1074 1074
             km.fit = kmeans(mat, centers = km)
1075 1075
             cl = km.fit$cluster
1076
-            meanmat = lapply(unique(cl), function(i) {
1076
+            meanmat = lapply(sort(unique(cl)), function(i) {
1077 1077
                 colMeans(mat[cl == i, , drop = FALSE])
1078 1078
             })
1079 1079
         } else {
1080 1080
             km.fit = kmeans(t(mat), centers = km)
1081 1081
             cl = km.fit$cluster
1082
-            meanmat = lapply(unique(cl), function(i) {
1082
+            meanmat = lapply(sort(unique(cl)), function(i) {
1083 1083
                 rowMeans(mat[, cl == i, drop = FALSE])
1084 1084
             })
1085 1085
         }
1086
-        
1087
-        meanmat = as.matrix(as.data.frame(meanmat))
1086
+
1087
+        meanmat = do.call("cbind", meanmat)
1088 1088
         hc = hclust(dist(t(meanmat)))
1089 1089
         weight = colMeans(meanmat)
1090
-        hc = as.hclust(reorder(as.dendrogram(hc), -weight, mean))
1090
+        hc = as.hclust(reorder(as.dendrogram(hc), weight, mean))
1091
+
1091 1092
         cl2 = numeric(length(cl))
1092 1093
         for(i in seq_along(hc$order)) {
1093 1094
             cl2[cl == hc$order[i]] = i
... ...
@@ -101,9 +101,9 @@ HeatmapAnnotation = function(...,
101 101
 	
102 102
 	show_annotation_name = TRUE,
103 103
 	annotation_name_gp = gpar(),
104
-	annotation_name_offset = unit(1, "mm"),
104
+	annotation_name_offset = NULL,
105 105
 	annotation_name_side = ifelse(which == "column", "right", "bottom"),
106
-	annotation_name_rot = ifelse(which == "column", 0, 90),
106
+	annotation_name_rot = NULL,
107 107
 	
108 108
 	annotation_height = NULL, 
109 109
 	annotation_width = NULL, 
... ...
@@ -242,9 +242,10 @@ HeatmapAnnotation = function(...,
242 242
 
243 243
     an = names(anno_value_list)
244 244
     show_annotation_name = recycle_param(show_annotation_name, an, TRUE)
245
-    annotation_name_offset = recycle_param(annotation_name_offset, an, TRUE)
246
-    annotation_name_side = recycle_param(annotation_name_side, an, TRUE)
247
-    annotation_name_rot = recycle_param(annotation_name_rot, an, TRUE)
245
+    annotation_name_side = recycle_param(annotation_name_side, an, ifelse(which == "column", "right", "bottom"))
246
+    if(inherits(annotation_name_offset, "unit")) annotation_name_offset = unit_to_str(annotation_name_offset)
247
+    annotation_name_offset = recycle_param(annotation_name_offset, an, NULL, as.list = TRUE)
248
+    annotation_name_rot = recycle_param(annotation_name_rot, an, NULL, as.list = TRUE)
248 249
     if(missing(border)) {
249 250
     	if(!is.null(ht_opt$annotation_border)) border = ht_opt$annotation_border
250 251
     }
... ...
@@ -296,16 +297,11 @@ HeatmapAnnotation = function(...,
296 297
 		arg_list = list(name = ag, which = which,
297 298
 				show_name = show_annotation_name[i_anno], 
298 299
 				name_gp = subset_gp(annotation_name_gp, i_anno), 
299
-	        	name_offset = annotation_name_offset[i_anno], 
300
+	        	name_offset = annotation_name_offset[[i_anno]], 
300 301
 	        	name_side = annotation_name_side[i_anno], 
301
-	        	name_rot = annotation_name_rot[i_anno],
302
+	        	name_rot = annotation_name_rot[[i_anno]],
302 303
 	        	border = border[i_anno])
303
-		# if(!is_name_offset_called) {
304
-		# 	arg_list$name_rot = NULL
305
-		# }
306
-		# if(!is_name_rot_called) {
307
-		# 	arg_list$name_offset = NULL
308
-		# }
304
+
309 305
 		if(inherits(anno_value_list[[ag]], c("function", "AnnotationFunction"))) {
310 306
 			arg_list$fun = anno_value_list[[ag]]
311 307
 			if(inherits(anno_value_list[[ag]], "function")) {
... ...
@@ -149,9 +149,9 @@ SingleAnnotation = function(name, value, col, fun,
149 149
 	legend_param = list(),
150 150
 	show_name = TRUE, 
151 151
 	name_gp = gpar(fontsize = 12),
152
-	name_offset = unit(1, "mm"),
152
+	name_offset = NULL,
153 153
 	name_side = ifelse(which == "column", "right", "bottom"),
154
-    name_rot = ifelse(which == "column", 0, 90),
154
+    name_rot = NULL,
155 155
     anno_simple_size = ht_opt$anno_simple_size,
156 156
     width = NULL, height = NULL) {
157 157
 
... ...
@@ -188,8 +188,10 @@ SingleAnnotation = function(name, value, col, fun,
188 188
     }
189 189
     .Object@name = name
190 190
 
191
-    if(!name_rot %in% c(0, 90, 180, 270)) {
192
-        stop_wrap(qq("@{name}: `name_rot` can only take values in c(0, 90, 180, 270)"))
191
+    if(!is.null(name_rot)) {
192
+        if(!name_rot %in% c(0, 90, 180, 270)) {
193
+            stop_wrap(qq("@{name}: `name_rot` can only take values in c(0, 90, 180, 270)"))
194
+        }
193 195
     }
194 196
 
195 197
     if(verbose) qqcat("create a SingleAnnotation with name '@{name}'\n")
... ...
@@ -224,8 +226,9 @@ SingleAnnotation = function(name, value, col, fun,
224 226
         }
225 227
     }
226 228
 
227
-    is_name_offset_called = !missing(name_offset)
228
-    is_name_rot_called = !missing(name_rot)
229
+    # if SingleAnnotation is called by HeatmapAnnotation, following two variables are all TRUE
230
+    is_name_offset_called = !is.null(name_offset)
231
+    is_name_rot_called = !is.null(name_rot)
229 232
     anno_fun_extend = unit(c(0, 0, 0, 0), "mm")
230 233
     if(!missing(fun)) {
231 234
         if(inherits(fun, "AnnotationFunction")) {
... ...
@@ -240,6 +243,15 @@ SingleAnnotation = function(name, value, col, fun,
240 243
         }
241 244
     }
242 245
 
246
+    if(!is.null(name_offset)) {
247
+        if(is.character(name_offset)) {
248
+            name_offset = to_unit(name_offset)
249
+        }
250
+    } else {
251
+        name_offset = unit(1, "mm")
252
+    }
253
+    name_rot = ifelse(which == "column", 0, 90)
254
+
243 255
     anno_name = name
244 256
     if(which == "column") {
245 257
         if(verbose) qqcat("@{name}: it is a column annotation\n")
... ...
@@ -326,15 +326,25 @@ oncoPrint = function(mat,
326 326
 	}
327 327
 
328 328
 	if(show_pct) {
329
-		pct_ha = rowAnnotation(pct = anno_text(pct, just = "right", location = unit(1, "npc"), gp = pct_gp),
330
-				show_annotation_name = FALSE)
329
+		if(pct_side == "left") {
330
+			pct_ha = rowAnnotation(pct = anno_text(pct, just = "right", location = unit(1, "npc"), gp = pct_gp, width = max_text_width(pct, gp = pct_gp) + unit(1, "mm")),
331
+					show_annotation_name = FALSE)
332
+		} else {
333
+			pct_ha = rowAnnotation(pct = anno_text(pct, just = "left", location = unit(0, "npc"), gp = pct_gp, width = max_text_width(pct, gp = pct_gp) + unit(1, "mm")),
334
+					show_annotation_name = FALSE)
335
+		}
331 336
 		names(pct_ha) = paste0("pct_", random_str())
332 337
 	} else {
333 338
 		pct_ha = NULL
334 339
 	}
335 340
 	if(show_row_names) {
336
-		rn_ha = rowAnnotation(rownames = anno_text(row_labels, gp = pct_gp, just = "left", location = unit(0, "npc")),
337
-			show_annotation_name = FALSE)
341
+		if(row_names_side == "right") {
342
+			rn_ha = rowAnnotation(rownames = anno_text(row_labels, gp = row_names_gp, just = "left", location = unit(0, "npc"), width = max_text_width(pct, gp = row_names_gp) + unit(1, "mm")),
343
+				show_annotation_name = FALSE)
344
+		} else {
345
+			rn_ha = rowAnnotation(rownames = anno_text(row_labels, gp = row_names_gp, just = "right", location = unit(1, "npc"), width = max_text_width(pct, gp = row_names_gp) + unit(1, "mm")),
346
+				show_annotation_name = FALSE)
347
+		}
338 348
 		names(rn_ha) = paste0("rownames_", random_str())
339 349
 	} else {
340 350
 		rn_ha = NULL
... ...
@@ -522,9 +522,18 @@ normalize_graphic_param_to_mat = function(x, nc, nr, name) {
522 522
     }
523 523
 }
524 524
 
525
-recycle_param = function(x, all_names, default) {
525
+recycle_param = function(x, all_names, default, as.list = FALSE) {
526 526
     n = length(all_names)
527
-    if(length(x) == n) {
527
+    if(length(x) == 0) {
528
+        if(as.list) {
529
+            rep(list(default), n)
530
+        } else {
531
+            rep(default, n)
532
+        }
533
+    } else if(length(x) == n) {
534
+        if(as.list) {
535
+            x = lapply(1:n, x[i])
536
+        }
528 537
         return(x)
529 538
     } else {
530 539
         nm = names(x)
... ...
@@ -533,18 +542,39 @@ recycle_param = function(x, all_names, default) {
533 542
         }
534 543
         if(is.null(nm)) {
535 544
             if(length(x) == 1) {
536
-                x = rep(x, n)
545
+                if(as.list) {
546
+                    x = lapply(1:n , function(x) x)
547
+                } else {
548
+                    x = rep(x, n)
549
+                }
537 550
             } else {
538 551
                 if(length(x) > n) {
539 552
                     x = x[1:n]
553
+                    if(as.list) {
554
+                        x = lapply(1:n, x[i])
555
+                    }
540 556
                 } else {
541
-                    x = c(x, rep(default, n - length(x)))
557
+                    if(as.list) {
558
+                        x = c(lapply(seq_along(x), function(i) x[i], 
559
+                              rep(list(default), n - length(x))))
560
+                    } else {
561
+                        x = c(x, rep(default, n - length(x)))
562
+                    }
542 563
                 }
543 564
             }
544 565
         } else {
545
-            x2 = structure(rep(default, n), names = all_names)
546
-            x2[intersect(nm, all_names)] = x[intersect(nm, all_names)]
547
-            x = x2
566
+            if(as.list) {
567
+                x2 = rep(list(default), n)
568
+                names(x2) = all_names
569
+                for(cn in intersect(nm, all_names)) {
570
+                    x2[[cn]] = x[cn]
571
+                }
572
+                x = x2
573
+            } else {
574
+                x2 = structure(rep(default, n), names = all_names)
575
+                x2[intersect(nm, all_names)] = x[intersect(nm, all_names)]
576
+                x = x2
577
+            }
548 578
         }
549 579
         return(x)
550 580
     }
... ...
@@ -777,3 +807,17 @@ random_str = function() {
777 807
     paste(sample(c(letters, LETTERS, 0:9), 8), collapse = "")
778 808
 }
779 809
 
810
+
811
+
812
+to_unit_str = function(unit) {
813
+    as.character(unit)
814
+}
815
+
816
+to_unit = function(str) {
817
+    d = gsub("[^\\d]+$", "", str, perl = TRUE)
818
+    u = gsub("[\\d.]", "", str, perl = TRUE)
819
+    unit(as.numeric(d), u)
820
+}
821
+
822
+
823
+
... ...
@@ -22,7 +22,7 @@ h1, h2, h3, h4, h5 {
22 22
 
23 23
 ### There is no plot comming out after running Heatmap() function.
24 24
 
25
-In this case, you need to use `draw()` function explicitly. See https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#plot-the-heatmap.
25
+In this case, you need to use `draw()` function explicitly. See https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#plot-the-heatmap and https://jokergoo.github.io/ComplexHeatmap-reference/book/a-list-of-heatmaps.html#plot-the-heamtap-list.
26 26
 
27 27
 ### Retrieve orders and dendrograms.
28 28
 
... ...
@@ -30,6 +30,10 @@ For retrieving orders and dendrograms from a single heatmap. See https://jokergo
30 30
 
31 31
 For retrieving orders and dendrograms from a list of heatmaps. See https://jokergoo.github.io/ComplexHeatmap-reference/book/a-list-of-heatmaps.html#get-orders-and-dendrograms-from-a-list-of-heatmaps.
32 32
 
33
+### How should I control the height or width of the heatmap annotations?
34
+
35
+### How should I control the axes of the annotations?
36
+
33 37
 ### How to control the style of legends?
34 38
 
35 39
 The style of legends can be controlled by `heatmap_legend_param` in `Heatmap()`, or