Browse code

imporved according to the package reference

jokergoo authored on 05/10/2018 12:02:50
Showing8 changed files

... ...
@@ -158,7 +158,7 @@ anno_simple = function(x, col, na_col = "grey",
158 158
 	input_is_matrix = is.matrix(x)
159 159
 
160 160
 	anno_size = anno_width_and_height(which, width, height, 
161
-		ht_opt$anno_simple_row_size*ifelse(input_is_matrix, ncol(x), 1))
161
+		ht_opt$anno_simple_size*ifelse(input_is_matrix, ncol(x), 1))
162 162
 	
163 163
 	if(missing(col)) {
164 164
 		col = default_col(x)
... ...
@@ -292,9 +292,9 @@ Heatmap = function(matrix, col, name,
292 292
     row_split = split,
293 293
     column_km = 1,
294 294
     column_split = NULL,
295
-    gap = unit(0.5, "mm"),
296
-    row_gap = unit(0.5, "mm"),
297
-    column_gap = unit(0.5, "mm"),
295
+    gap = unit(1, "mm"),
296
+    row_gap = unit(1, "mm"),
297
+    column_gap = unit(1, "mm"),
298 298
 
299 299
     width = unit(1, "npc"),
300 300
     heatmap_body_width = NULL,
... ...
@@ -350,6 +350,7 @@ Heatmap = function(matrix, col, name,
350 350
 
351 351
     if(is.data.frame(matrix)) {
352 352
         if(verbose) qqcat("convert data frame to matrix\n")
353
+        warnings("The input is a data frame, convert to the matrix.")
353 354
         matrix = as.matrix(matrix)
354 355
     }
355 356
     if(!is.matrix(matrix)) {
... ...
@@ -525,7 +526,7 @@ Heatmap = function(matrix, col, name,
525 526
     }
526 527
     
527 528
     ##### titles, should also consider titles after row splitting #####
528
-    if(length(row_title) == 0) {
529
+    if(length(row_title) != 1) {
529 530
     } else if(!inherits(row_title, c("expression", "call"))) {
530 531
         if(is.na(row_title)) {
531 532
             row_title = character(0)
... ...
@@ -539,7 +540,7 @@ Heatmap = function(matrix, col, name,
539 540
     .Object@row_title_param$gp = check_gp(row_title_gp)  # if the number of settings is same as number of row-splits, gp will be adjusted by `make_row_dend`
540 541
     .Object@row_title_param$just = get_text_just(rot = row_title_rot, side = .Object@row_title_param$side)
541 542
 
542
-    if(length(column_title) == 0) {
543
+    if(length(column_title) != 1) {
543 544
     } else if(!inherits(column_title, c("expression", "call"))) {
544 545
         if(is.na(column_title)) {
545 546
             column_title = character(0)
... ...
@@ -33,13 +33,14 @@
33 33
 
34 34
 
35 35
 subset_heatmap_by_row = function(ht, ind) {
36
-    ht@row_order = intersect(ht@row_order, ind)
36
+    ht@row_order = order(intersect(ht@row_order, ind))
37 37
     if(!is.null(ht@row_dend_param$obj)) {
38 38
         stop("row dend is specified as a clustering object, cannot do subsetting.")
39 39
     }
40 40
     ht@matrix = ht@matrix[ind, , drop = FALSE]
41 41
     if(!is.null(ht@row_names_param$labels)) {
42 42
         ht@row_names_param$labels = ht@row_names_param$labels[ind]
43
+        ht@row_names_param$anno = ht@row_names_param$anno[ind]
43 44
     }
44 45
     ht@row_names_param$gp = subset_gp(ht@row_names_param$gp, ind)
45 46
     if(length(ht@left_annotation)) {
... ...
@@ -52,13 +53,14 @@ subset_heatmap_by_row = function(ht, ind) {
52 53
 }
53 54
 
54 55
 subset_heatmap_by_column = function(ht, ind) {
55
-    ht@column_order = intersect(ht@column_order, ind)
56
+    ht@column_order = order(intersect(ht@column_order, ind))
56 57
     if(!is.null(ht@column_dend_param$obj)) {
57 58
         stop("column dend is specified as a clustering object, cannot do subsetting.")
58 59
     }
59 60
     ht@matrix = ht@matrix[, ind, drop = FALSE]
60 61
     if(!is.null(ht@column_names_param$labels)) {
61 62
         ht@column_names_param$labels = ht@column_names_param$labels[ind]
63
+        ht@column_names_param$anno = ht@column_names_param$anno[ind]
62 64
     }
63 65
     ht@column_names_param$gp = subset_gp(ht@column_names_param$gp, ind)
64 66
     if(length(ht@top_annotation)) {
... ...
@@ -87,18 +87,23 @@ HeatmapAnnotation = function(...,
87 87
 	annotation_legend_param = list(), 
88 88
 	show_legend = TRUE, 
89 89
 	which = c("column", "row"), 
90
-	annotation_height = NULL, 
91
-	annotation_width = NULL, 
92
-	height = NULL,   # total height
93
-	width = NULL,    # total width
94 90
 	gp = gpar(col = NA),
95 91
 	border = FALSE,
96 92
 	gap = unit(0, "mm"),
93
+	
97 94
 	show_annotation_name = TRUE,
98 95
 	annotation_name_gp = gpar(),
99 96
 	annotation_name_offset = unit(1, "mm"),
100 97
 	annotation_name_side = ifelse(which == "column", "right", "bottom"),
101
-	annotation_name_rot = ifelse(which == "column", 0, 90)) {
98
+	annotation_name_rot = ifelse(which == "column", 0, 90),
99
+	
100
+	annotation_height = NULL, 
101
+	annotation_width = NULL, 
102
+	height = NULL,
103
+	width = NULL,
104
+	anno_simple_size = ht_opt$anno_simple_size,
105
+	simple_anno_size_adjust = FALSE
106
+	) {
102 107
 
103 108
 	.ENV$current_annotation_which = NULL
104 109
 	which = match.arg(which)[1]
... ...
@@ -336,26 +341,9 @@ HeatmapAnnotation = function(...,
336 341
     global_height = NULL
337 342
     global_width = NULL
338 343
     if(which == "column") {
339
-    	if(is.null(annotation_height)) {
340
-    		if(!is.null(height)) {
341
-    			global_height = height
342
-    		}
343
-    		anno_size = do.call("unit.c", lapply(anno_list, height))
344
-			height = sum(anno_size) + sum(gap) - gap[n_total_anno]
345
-    	} else {
346
-    		if(length(annotation_height) != n_total_anno) {
347
-    			stop(qq("Length of `annotation_height` should be @{n_total_anno}"))
348
-    		}
349
-    		if(!is.unit(annotation_height)) {
350
-    			stop("`annotation_height` should be unit object")
351
-    		}
352
-    		if(!all(sapply(seq_along(annotation_height), function(x) is_abs_unit(annotation_height[i])))) {
353
-    			stop("`annotation_height` should only contain absolute units")
354
-    		}
355
-    		anno_size = annotation_height
356
-    		height = sum(anno_size) + sum(gap) - gap[n_total_anno]
357
-    	}
358
-
344
+		anno_size = do.call("unit.c", lapply(anno_list, height))
345
+		height = sum(anno_size) + sum(gap) - gap[n_total_anno]
346
+    	
359 347
     	# for width, only look at `width`
360 348
     	if(is.null(width)) {
361 349
     		width = unit(1, "npc")
... ...
@@ -365,26 +353,10 @@ HeatmapAnnotation = function(...,
365 353
     	}
366 354
     	
367 355
     } else if(which == "row") {
368
-    	if(is.null(annotation_width)) {
369
-    		if(!is.null(width)) {
370
-    			global_width = width
371
-    		}
372
-    		anno_size = do.call("unit.c", lapply(anno_list, width))
373
-			width = sum(anno_size) + sum(gap) - gap[n_total_anno]
374
-    	} else {
375
-    		if(length(annotation_width) != n_total_anno) {
376
-    			stop(qq("Length of `annotation_width` should be @{n_total_anno}"))
377
-    		}
378
-    		if(!is.unit(annotation_width)) {
379
-    			stop("`annotation_width` should be unit object")
380
-    		}
381
-    		if(!all(sapply(seq_along(annotation_width), function(x) is_abs_unit(annotation_width[i])))) {
382
-    			stop("`annotation_width` should only contain absolute units")
383
-    		}
384
-    		anno_size = annotation_width
385
-    		width = sum(anno_size) + sum(gap) - gap[n_total_anno]
386
-    	}
387 356
 
357
+		anno_size = do.call("unit.c", lapply(anno_list, width))
358
+		width = sum(anno_size) + sum(gap) - gap[n_total_anno]
359
+    	
388 360
     	if(is.null(height)) {
389 361
     		height = unit(1, "npc")
390 362
     	}
... ...
@@ -417,13 +389,14 @@ HeatmapAnnotation = function(...,
417 389
     }
418 390
     .Object@extended = extended
419 391
 
420
-    ### if global width or height was set, adjust it
421
-    if(!is.null(global_height)) {
422
-    	height(.Object) = global_height
423
-    }
424
-    if(!is.null(global_width)) {
425
-    	width(.Object) = global_width
426
-    }
392
+    ## adjust height/width if `width`/`annotation_width` is set
393
+    if(which == "column") {
394
+	    .Object = resize(.Object, height = height, annotation_height = annotation_height,
395
+	    	anno_simple_size = anno_simple_size, simple_anno_size_adjust = simple_anno_size_adjust)
396
+	} else {
397
+		.Object = resize(.Object, width = width, annotation_width = annotation_width, 
398
+			anno_simple_size = anno_simple_size, simple_anno_size_adjust = simple_anno_size_adjust)
399
+	}
427 400
 
428 401
     return(.Object)
429 402
 }
... ...
@@ -972,7 +945,7 @@ length.HeatmapAnnotation = function(x) {
972 945
 # -annotation_width A vector of of annotation widths in `grid::unit` class.
973 946
 # -height The height of the complete heatmap annotation.
974 947
 # -width The width of the complete heatmap annotation.
975
-# -anno_simple_row_size The size of one line of the simple annotation.
948
+# -anno_simple_size The size of one line of the simple annotation.
976 949
 # -simple_anno_size_adjust Whether adjust the size of the simple annotation?
977 950
 #
978 951
 # == details
... ...
@@ -983,10 +956,10 @@ length.HeatmapAnnotation = function(x) {
983 956
 #    ``annotation_height`` are absolute units, ``height`` is ignored.
984 957
 # 2. if ``annotation_height`` contains non-absolute units, ``height`` also need to be set and the
985 958
 #    non-absolute unit should be set in a simple form such as 1:10 or ``unit(1, "null")``.
986
-# 3. ``anno_simple_row_size`` is only used when ``annotation_height`` is NULL.
959
+# 3. ``anno_simple_size`` is only used when ``annotation_height`` is NULL.
987 960
 # 4. if only ``height`` is set, non-simple annotation is adjusted while keep simple anntation unchanged.
988 961
 # 5. if only ``height`` is set and all annotations are simple annotations, all anntations are adjusted.
989
-#      and ``anno_simple_row_size`` is disabled.
962
+#      and ``anno_simple_size`` is disabled.
990 963
 # 6. If ``simple_anno_size_adjust`` is ``FALSE``, the size of the simple annotations will not change.
991 964
 #
992 965
 setMethod(f = "resize",
... ...
@@ -996,7 +969,7 @@ setMethod(f = "resize",
996 969
 	annotation_width = NULL,
997 970
 	height = NULL, 
998 971
 	width = NULL, 
999
-	anno_simple_row_size = ht_opt$anno_simple_row_size,
972
+	anno_simple_size = ht_opt$anno_simple_size,
1000 973
 	simple_anno_size_adjust = FALSE) {
1001 974
 
1002 975
 	if(object@which == "column") {
... ...
@@ -1162,10 +1135,10 @@ setMethod(f = "resize",
1162 1135
 
1163 1136
 			anno_size2 = anno_size
1164 1137
 			# size_adjusted = convertUnitFun(size_adjusted, "mm", valueOnly = TRUE)
1165
-			if(is.null(anno_simple_row_size)) {
1166
-				anno_simple_row_size = 5
1138
+			if(is.null(anno_simple_size)) {
1139
+				anno_simple_size = 5
1167 1140
 			} else {
1168
-				anno_simple_row_size = convertUnitFun(anno_simple_row_size, "mm", valueOnly = TRUE)
1141
+				anno_simple_size = convertUnitFun(anno_simple_size, "mm", valueOnly = TRUE)
1169 1142
 			}
1170 1143
 
1171 1144
 			if(size_adjusted <= sum(gap)) {
... ...
@@ -1173,12 +1146,12 @@ setMethod(f = "resize",
1173 1146
 			}
1174 1147
 
1175 1148
 			## fix the size of simple annotation and zoom function annotations
1176
-			ts = size_adjusted - sum(gap) - sum(anno_size[l_simple_anno]*anno_simple_row_size/5)
1149
+			ts = size_adjusted - sum(gap) - sum(anno_size[l_simple_anno]*anno_simple_size/5)
1177 1150
 			if(ts < 0) {
1178 1151
 				stop(paste0(size_name, " you set is too small."))
1179 1152
 			}
1180 1153
 			anno_size2[!l_simple_anno] = anno_size[!l_simple_anno]/sum(anno_size[!l_simple_anno]) * ts
1181
-			anno_size2[l_simple_anno] = anno_size[l_simple_anno]*anno_simple_row_size/5
1154
+			anno_size2[l_simple_anno] = anno_size[l_simple_anno]*anno_simple_size/5
1182 1155
 
1183 1156
 			size_adjusted = unit(size_adjusted, "mm")
1184 1157
 			anno_size2 = unit(anno_size2, "mm")
... ...
@@ -310,7 +310,8 @@ setMethod(f = "draw",
310 310
     main_heatmap = which(sapply(object@ht_list, inherits, "Heatmap"))[1],
311 311
     padding = NULL,
312 312
     adjust_annotation_extension = TRUE,
313
-
313
+    
314
+    auto_adjust = TRUE,
314 315
     row_dend_side = c("original", "left", "right"),
315 316
     row_sub_title_side = c("original", "left", "right"),
316 317
     column_dend_side = c("original", "top", "bottom"),
... ...
@@ -518,14 +519,14 @@ setMethod(f = "draw",
518 519
 
519 520
     if(is_abs_unit(ht_list_width)) {
520 521
         ht_list_width = unit(round(convertWidth(ht_list_width, "mm", valueOnly = TRUE)), "mm")
521
-        qqcat("Since all heatmaps/annotations have absolute units, the total width of the plot is @{ht_list_width} mm.\n")
522
+        qqcat("Since all heatmaps/annotations have absolute units, the total width of the plot is @{ht_list_width}\n")
522 523
         w = ht_list_width
523 524
     } else {
524 525
         w = unit(1, "npc")
525 526
     }
526 527
     if(is_abs_unit(ht_list_height)) {
527 528
         ht_list_height = unit(round(convertHeight(ht_list_height, "mm", valueOnly = TRUE)), "mm")
528
-        qqcat("Since all heatmaps/annotations have absolute units, the total height of the plot is @{ht_list_height} mm.\n")
529
+        qqcat("Since all heatmaps/annotations have absolute units, the total height of the plot is @{ht_list_height}\n")
529 530
         h = ht_list_height
530 531
     } else {
531 532
         h = unit(1, "npc")
... ...
@@ -26,7 +26,7 @@ setMethod(f = "row_order",
26 26
 	object = make_layout(object)
27 27
 
28 28
 	n = length(object@ht_list)
29
-	ht_index = sapply(seq_along(object@ht_list), function(i) inherits(object@ht_list[[i]], "Heatmap"))
29
+	ht_index = which(sapply(seq_along(object@ht_list), function(i) inherits(object@ht_list[[i]], "Heatmap")))
30 30
 	if(length(ht_index) == 0) {
31 31
 		return(NULL)
32 32
 	}
... ...
@@ -45,7 +45,7 @@ setMethod(f = "row_order",
45 45
 	        lt_rd = c(lt_rd, list(lt))
46 46
 	    }
47 47
 	    names(lt_rd) = names(object@ht_list)[ht_index]
48
-	    return(lt_rd)
48
+	    proper_format_lt(lt_rd)
49 49
 	}
50 50
 })
51 51
 
... ...
@@ -111,7 +111,7 @@ setMethod(f = "column_order",
111 111
 	object = make_layout(object)
112 112
 
113 113
 	n = length(object@ht_list)
114
-	ht_index = sapply(seq_along(object@ht_list), function(i) inherits(object@ht_list[[i]], "Heatmap"))
114
+	ht_index = which(sapply(seq_along(object@ht_list), function(i) inherits(object@ht_list[[i]], "Heatmap")))
115 115
 	if(length(ht_index) == 0) {
116 116
 		return(NULL)
117 117
 	}
... ...
@@ -130,8 +130,7 @@ setMethod(f = "column_order",
130 130
 	        lt_rd = c(lt_rd, list(lt))
131 131
 	    }
132 132
 	    names(lt_rd) = names(object@ht_list)[ht_index]
133
-	    if(length(lt_rd) == 1) lt_rd = lt_rd[[1]]
134
-	    return(lt_rd)
133
+	    proper_format_lt(lt_rd)
135 134
 	}
136 135
 })
137 136
 
... ...
@@ -195,7 +194,7 @@ setMethod(f = "row_dend",
195 194
 	object = make_layout(object)
196 195
 
197 196
 	n = length(object@ht_list)
198
-	ht_index = sapply(seq_along(object@ht_list), function(i) inherits(object@ht_list[[i]], "Heatmap"))
197
+	ht_index = which(sapply(seq_along(object@ht_list), function(i) inherits(object@ht_list[[i]], "Heatmap")))
199 198
 	if(length(ht_index) == 0) {
200 199
 		return(NULL)
201 200
 	}
... ...
@@ -214,7 +213,7 @@ setMethod(f = "row_dend",
214 213
 	        lt_rd = c(lt_rd, list(lt))
215 214
 	    }
216 215
 	    names(lt_rd) = names(object@ht_list)[ht_index]
217
-	    return(lt_rd)
216
+	    proper_format_lt(lt_rd)
218 217
 	}
219 218
 })
220 219
 
... ...
@@ -281,7 +280,7 @@ setMethod(f = "column_dend",
281 280
 	object = make_layout(object)
282 281
 
283 282
 	n = length(object@ht_list)
284
-	ht_index = sapply(seq_along(object@ht_list), function(i) inherits(object@ht_list[[i]], "Heatmap"))
283
+	ht_index = which(sapply(seq_along(object@ht_list), function(i) inherits(object@ht_list[[i]], "Heatmap")))
285 284
 	if(length(ht_index) == 0) {
286 285
 		return(NULL)
287 286
 	}
... ...
@@ -300,7 +299,7 @@ setMethod(f = "column_dend",
300 299
 	        lt_rd = c(lt_rd, list(lt))
301 300
 	    }
302 301
 	    names(lt_rd) = names(object@ht_list)[ht_index]
303
-	    return(lt_rd)
302
+	    proper_format_lt(lt_rd)
304 303
 	}
305 304
 })
306 305
 
... ...
@@ -338,3 +337,23 @@ setMethod(f = "column_dend",
338 337
 	}
339 338
 })
340 339
 
340
+
341
+
342
+proper_format_lt = function(lt) {
343
+	n_ht = length(lt)
344
+	# for a single heatmap 
345
+	if(n_ht == 1) {
346
+		if(length(lt[[1]]) == 1) {
347
+			return(lt[[1]][[1]])
348
+		} else {
349
+			return(lt[[1]])
350
+		}
351
+	} else {
352
+		has_splitting = sapply(lt, function(x) length(x) != 1)
353
+		if(has_splitting) {
354
+			return(lt)
355
+		} else {
356
+			return(lapply(lt, function(x) x[[1]]))
357
+		}
358
+	}
359
+}
... ...
@@ -110,7 +110,7 @@ ht_opt = setGlobalOptions(
110 110
 		},
111 111
 		.length = 1),
112 112
 	show_vp_border = FALSE,
113
-	anno_simple_row_size = unit(5, "mm")
113
+	anno_simple_size = unit(5, "mm")
114 114
 )
115 115
 
116 116
 
... ...
@@ -52,6 +52,8 @@ ha = HeatmapAnnotation(foo = anno_empty(), height = unit(4, "cm"))
52 52
 draw(ha, 1:10, test = "anno_empty")
53 53
 ha = HeatmapAnnotation(foo = anno_empty(), bar = 1:10, height = unit(4, "cm"))
54 54
 draw(ha, 1:10, test = "anno_empty")
55
+ha = HeatmapAnnotation(foo = anno_empty(), bar = 1:10, height = unit(4, "cm"))
56
+draw(ha, 1:10, test = "anno_empty")
55 57
 
56 58
 ha = HeatmapAnnotation(foo = function(index) {grid.rect()}, bar = 1:10 height = unit(4, "cm"))
57 59
 draw(ha, 1:10, test = "self-defined function")