Browse code

add anno_zoom()

Zuguang Gu authored on 12/12/2018 21:54:43
Showing12 changed files

... ...
@@ -132,6 +132,7 @@ export("anno_points")
132 132
 export("anno_simple")
133 133
 export("anno_summary")
134 134
 export("anno_text")
135
+export("anno_zoom")
135 136
 export("annotation_axis_grob")
136 137
 export("cluster_within_group")
137 138
 export("columnAnnotation")
... ...
@@ -147,6 +148,7 @@ export("decorate_row_names")
147 148
 export("decorate_row_title")
148 149
 export("decorate_title")
149 150
 export("default_axis_param")
151
+export("default_get_type")
150 152
 export("dend_heights")
151 153
 export("dend_xy")
152 154
 export("dendrogramGrob")
... ...
@@ -1,8 +1,9 @@
1
+
1 2
 CHANGES in VERSION 1.99.4
2 3
 
3 4
 * anno_mark() is now calculated in multiple slices.
4
-* oncoPrint(): automatically split the alteration type if the separator is one of
5
-  ";:,|".
5
+* oncoPrint(): automatically split the alteration type if the separator is one of ";:,|".
6
+* add anno_zoom()
6 7
 
7 8
 ========================
8 9
 
... ...
@@ -2619,6 +2619,7 @@ row_anno_text = function(...) {
2619 2619
 # -labels_gp Graphic settings for the labels.
2620 2620
 # -padding Padding between neighbouring labels in the plot.
2621 2621
 # -link_width Width of the segments.
2622
+# -link_height Similar as ``link_width``, used for column annotation.
2622 2623
 # -extend By default, the region for the labels has the same width (if it is a column annotation) or
2623 2624
 #         same height (if it is a row annotation) as the heatmap. The size can be extended by this options.
2624 2625
 #         The value can be a proportion number or  a `grid::unit` object. The length can be either one or two.
... ...
@@ -2645,7 +2646,8 @@ row_anno_text = function(...) {
2645 2646
 anno_mark = function(at, labels, which = c("column", "row"), 
2646 2647
 	side = ifelse(which == "column", "top", "right"),
2647 2648
 	lines_gp = gpar(), labels_gp = gpar(), padding = 0.5, 
2648
-	link_width = unit(5, "mm"), link_gp = lines_gp, 
2649
+	link_width = unit(5, "mm"), link_height = link_width,
2650
+	link_gp = lines_gp, 
2649 2651
 	extend = unit(0, "mm")) {
2650 2652
 
2651 2653
 	if(is.null(.ENV$current_annotation_which)) {
... ...
@@ -2707,7 +2709,7 @@ anno_mark = function(at, labels, which = c("column", "row"),
2707 2709
 		}
2708 2710
 		h1 = pos - text_height*0.5
2709 2711
 		h2 = pos + text_height*0.5
2710
-		pos_adjusted = rev(smartAlign(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2])))
2712
+		pos_adjusted = smartAlign(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2]))
2711 2713
 		h = (pos_adjusted[, 1] + pos_adjusted[, 2])/2
2712 2714
 
2713 2715
 		n2 = length(labels)
... ...
@@ -2758,17 +2760,17 @@ anno_mark = function(at, labels, which = c("column", "row"),
2758 2760
 
2759 2761
 		n2 = length(labels)
2760 2762
 		if(side == "top") {
2761
-			grid.text(labels, h, rep(link_width, n2), default.units = "native", gp = labels_gp, rot = 90, just = "left")
2762
-			link_width = link_width - unit(1, "mm")
2763
-			grid.segments(pos, unit(rep(0, n2), "npc"), pos, rep(link_width*(1/3), n2), default.units = "native", gp = link_gp)
2764
-			grid.segments(pos, rep(link_width*(1/3), n2), h, rep(link_width*(2/3), n2), default.units = "native", gp = link_gp)
2765
-			grid.segments(h, rep(link_width*(2/3), n2), h, rep(link_width, n), default.units = "native", gp = link_gp)
2763
+			grid.text(labels, h, rep(link_height, n2), default.units = "native", gp = labels_gp, rot = 90, just = "left")
2764
+			link_height = link_height - unit(1, "mm")
2765
+			grid.segments(pos, unit(rep(0, n2), "npc"), pos, rep(link_height*(1/3), n2), default.units = "native", gp = link_gp)
2766
+			grid.segments(pos, rep(link_height*(1/3), n2), h, rep(link_height*(2/3), n2), default.units = "native", gp = link_gp)
2767
+			grid.segments(h, rep(link_height*(2/3), n2), h, rep(link_height, n), default.units = "native", gp = link_gp)
2766 2768
 		} else {
2767 2769
 			grid.text(labels, h, rep(max_text_width(labels, gp = labels_gp), n2), default.units = "native", gp = labels_gp, rot = 90, just = "right")
2768
-			link_width = link_width - unit(1, "mm")
2769
-			grid.segments(pos, unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_width*(1/3), n2), default.units = "native", gp = link_gp)
2770
-			grid.segments(pos, unit(1, "npc")-rep(link_width*(1/3), n2), h, unit(1, "npc")-rep(link_width*(2/3), n2), default.units = "native", gp = link_gp)
2771
-			grid.segments(h, unit(1, "npc")-rep(link_width*(2/3), n2), h, unit(1, "npc")-rep(link_width, n2), default.units = "native", gp = link_gp)
2770
+			link_height = link_height - unit(1, "mm")
2771
+			grid.segments(pos, unit(rep(1, n2), "npc"), pos, unit(1, "npc")-rep(link_height*(1/3), n2), default.units = "native", gp = link_gp)
2772
+			grid.segments(pos, unit(1, "npc")-rep(link_height*(1/3), n2), h, unit(1, "npc")-rep(link_height*(2/3), n2), default.units = "native", gp = link_gp)
2773
+			grid.segments(h, unit(1, "npc")-rep(link_height*(2/3), n2), h, unit(1, "npc")-rep(link_height, n2), default.units = "native", gp = link_gp)
2772 2774
 		}
2773 2775
 		upViewport()
2774 2776
 	}
... ...
@@ -2787,7 +2789,7 @@ anno_mark = function(at, labels, which = c("column", "row"),
2787 2789
 		height = height,
2788 2790
 		n = -1,
2789 2791
 		var_import = list(at, labels2index, at2labels, link_gp, labels_gp, padding, .pos, .scale,
2790
-			side, link_width, extend),
2792
+			side, link_width, link_height, extend),
2791 2793
 		show_name = FALSE
2792 2794
 	)
2793 2795
 
... ...
@@ -3092,3 +3094,393 @@ anno_block = function(gp = gpar(), labels = NULL, labels_gp = gpar(), labels_rot
3092 3094
 	)
3093 3095
 	return(anno) 
3094 3096
 }
3097
+
3098
+# == title
3099
+# Zoom annotation
3100
+#
3101
+# == param
3102
+# -align_to
3103
+# -panel_fun
3104
+# -which Whether it is a column annotation or a row annotation?
3105
+# -side Side of the boxes If it is a column annotation, valid values are "top" and "bottom";
3106
+#       If it is a row annotation, valid values are "left" and "right".
3107
+# -size
3108
+# -gap
3109
+# -link_gp Graphic settings for the segments.
3110
+# -link_width Width of the segments.
3111
+# -link_height Similar as ``link_width``, used for column annotation.
3112
+# -extend By default, the region for the labels has the same width (if it is a column annotation) or
3113
+#         same height (if it is a row annotation) as the heatmap. The size can be extended by this options.
3114
+#         The value can be a proportion number or  a `grid::unit` object. The length can be either one or two.
3115
+# -width Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation.
3116
+# -height Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation.
3117
+#
3118
+# == details
3119
+#
3120
+anno_zoom = function(align_to, panel_fun = function(index, nm = NULL) { grid.rect() }, 
3121
+	which = c("column", "row"), side = ifelse(which == "column", "top", "right"),
3122
+	size = NULL, gap = unit(1, "mm"), 
3123
+	link_width = unit(5, "mm"), link_height = link_width, link_gp = gpar(),
3124
+	extend = unit(0, "mm"), width = NULL, height = NULL) {
3125
+	
3126
+	if(is.null(.ENV$current_annotation_which)) {
3127
+		which = match.arg(which)[1]
3128
+	} else {
3129
+		which = .ENV$current_annotation_which
3130
+	}
3131
+
3132
+	anno_size = anno_width_and_height(which, width, height, unit(2, "cm") + link_width)
3133
+
3134
+	# align_to should be
3135
+	# 1. a vector of class labels that the length should be same as the nrow of the matrix
3136
+	# 2. a list of numeric indices
3137
+
3138
+	if(is.list(align_to)) {
3139
+		if(!any(sapply(align_to, is.numeric))) {
3140
+			stop_wrap(paste0("`at` should be numeric ", which, " index corresponding to the matrix."))
3141
+		}
3142
+	}
3143
+
3144
+	.pos = NULL # position of the rows
3145
+
3146
+	if(length(as.list(formals(panel_fun))) == 1) {
3147
+ 		formals(panel_fun) = alist(index = , nm = NULL)
3148
+	}
3149
+
3150
+	if(length(extend) == 1) extend = rep(extend, 2)
3151
+	if(length(extend) > 2) extend = extend[1:2]
3152
+	if(!inherits(extend, "unit")) extend = unit(extend, "npc")
3153
+
3154
+	# anno_zoom is always executed in one-slice mode (which means mulitple slices
3155
+	# are treated as one big slilce)
3156
+	row_fun = function(index) {
3157
+		n = length(index)
3158
+		if(is.atomic(align_to)) {
3159
+			if(length(setdiff(align_to, index)) == 0 && !any(duplicated(align_to))) {
3160
+				align_to = list(align_to)
3161
+			} else {
3162
+				if(length(align_to) != n) {
3163
+					stop_wrap("If `align_to` is a vector with group labels, the length should be the same as the number of rows in the heatmap.")
3164
+				}
3165
+				lnm = as.character(unique(align_to[index]))
3166
+				align_to = as.list(tapply(seq_along(align_to), align_to, function(x) x))
3167
+				align_to = align_to[lnm]
3168
+			}
3169
+		}
3170
+
3171
+		nrl = sapply(align_to, length)
3172
+		align_to_df = lapply(align_to, function(x) {
3173
+			ind = which(index %in% x)
3174
+			n = length(ind)
3175
+			s = NULL
3176
+			e = NULL
3177
+			s[1] = ind[1]
3178
+			if(n > 1) {
3179
+				ind2 = which(ind[2:n] - ind[1:(n-1)] > 1)
3180
+				if(length(ind2)) s = c(s, ind[ ind2 + 1 ])
3181
+				k = length(s)
3182
+				e[k] = ind[length(ind)]
3183
+				if(length(ind2)) e[1:(k-1)] = ind[1:(n-1)][ ind2 ]
3184
+			} else {
3185
+				e = ind[1]
3186
+			}
3187
+			data.frame(s = s, e = e)
3188
+		})
3189
+
3190
+		# pos is from top to bottom
3191
+		if(is.null(.pos)) {
3192
+			pos = (n:1 - 0.5)/n # position of rows
3193
+		} else {
3194
+			pos = .pos
3195
+		}
3196
+
3197
+		.scale = c(0, 1)
3198
+		pushViewport(viewport(xscale = c(0, 1), yscale = .scale))
3199
+		if(inherits(extend, "unit")) extend = convertHeight(extend, "native", valueOnly = TRUE)
3200
+		
3201
+		# the position of boxes initially are put evenly
3202
+		# add the gap
3203
+		n_boxes = length(align_to)
3204
+		if(length(gap) == 1) gap = rep(gap, n_boxes)
3205
+		if(is.null(size)) size = nrl
3206
+		if(length(size) != length(align_to)) {
3207
+			stop_wrap("Length of `size` should be the same as the number of groups of indices.")
3208
+		}
3209
+		if(!inherits(size, "unit")) {
3210
+			size_is_unit = FALSE
3211
+			if(n_boxes == 1) {
3212
+				h = data.frame(bottom = .scale[1] - extend[1], top = .scale[2] + extend[2])
3213
+			} else {
3214
+				gap = convertHeight(gap, "native", valueOnly = TRUE)
3215
+				box_height = size/sum(size) * (1 + sum(extend) - sum(gap[1:(n_boxes-1)]))
3216
+				h = data.frame(
3217
+						top = cumsum(box_height) + cumsum(gap) - gap[length(gap)] - extend[1]
3218
+					)
3219
+				h$bottom = h$top - box_height
3220
+				h = 1 - h[, 2:1]
3221
+				colnames(h) = c("top", "bottom")
3222
+			}
3223
+		} else {
3224
+			size_is_unit = TRUE
3225
+			box_height = size
3226
+			box_height2 = box_height # box_height2 adds the gap
3227
+			for(i in 1:n_boxes) {
3228
+				if(i == 1 || i == n_boxes) {
3229
+					if(n_boxes > 1) {
3230
+						box_height2[i] = box_height2[i] + gap[i]*0.5
3231
+					}
3232
+				} else {
3233
+					box_height2[i] = box_height2[i] + gap[i]
3234
+				}
3235
+			}
3236
+			box_height2 = convertHeight(box_height2, "native", valueOnly = TRUE)
3237
+			# the original positions of boxes
3238
+			mean_pos = sapply(align_to, function(ind) mean(pos[ind]))
3239
+			h1 = mean_pos - box_height2*0.5
3240
+			h2 = mean_pos + box_height2*0.5
3241
+			h = smartAlign(rev(h1), rev(h2), c(.scale[1] - extend[1], .scale[2] + extend[2]))
3242
+			colnames(h) = c("bottom", "top")
3243
+			h = h[nrow(h):1, , drop = FALSE]
3244
+
3245
+			# recalcualte h to remove gaps
3246
+			gap_height = convertHeight(gap, "native", valueOnly = TRUE)
3247
+			if(n_boxes > 1) {
3248
+				for(i in 1:n_boxes) {
3249
+					if(i == 1) {
3250
+						h[i, "bottom"] = h[i, "bottom"] + gap_height[i]/2
3251
+					} else if(i == n_boxes) {
3252
+						h[i, "top"] = h[i, "top"] - gap_height[i]/2
3253
+					} else {
3254
+						h[i, "bottom"] = h[i, "bottom"] + gap_height[i]/2
3255
+						h[i, "top"] = h[i, "top"] - gap_height[i]/2
3256
+					}
3257
+				}
3258
+			}
3259
+		}
3260
+		popViewport()
3261
+
3262
+		# draw boxes
3263
+		if(side == "right") {
3264
+			pushViewport(viewport(x = link_width, just = "left", width = anno_size$width - link_width))
3265
+		} else {
3266
+			pushViewport(viewport(x = 0, just = "left", width = anno_size$width - link_width))
3267
+		}
3268
+		for(i in 1:n_boxes) {
3269
+			current_vp_name = current.viewport()$name
3270
+			pushViewport(viewport(y = (h[i, "top"] + h[i, "bottom"])/2, height = h[i, "top"] - h[i, "bottom"], 
3271
+				default.units = "native"))
3272
+			if(is.function(panel_fun)) panel_fun(align_to[[i]], names(align_to)[i])
3273
+			popViewport()
3274
+
3275
+			if(current.viewport()$name != current_vp_name) {
3276
+				stop_wrap("If you push viewports `panel_fun`, you need to pop all them out.")
3277
+			}
3278
+		}
3279
+		popViewport()
3280
+		# draw the links
3281
+		link_gp = recycle_gp(link_gp, n_boxes)
3282
+		if(side == "right") {
3283
+			pushViewport(viewport(x = unit(0, "npc"), just = "left", width = link_width))
3284
+		} else {
3285
+			pushViewport(viewport(x = unit(1, "npc"), just = "right", width = link_width))
3286
+		}
3287
+		for(i in 1:n_boxes) {
3288
+			df = align_to_df[[i]]
3289
+			for(j in 1:nrow(df)) {
3290
+				# draw each polygon
3291
+				if(side == "right") {
3292
+					grid.polygon(unit.c(unit(c(0, 0), "npc"), rep(link_width, 2)),
3293
+						c(pos[df[j, 2]] - 0.5/n, pos[df[j, 1]] + 0.5/n, h[i, "top"], h[i, "bottom"]),
3294
+						default.units = "native", gp = subset_gp(link_gp, i))
3295
+				} else {
3296
+					grid.polygon(unit.c(rep(link_width, 2), unit(c(0, 0), "npc")),
3297
+						c(pos[df[j, 2]] - 0.5/n, pos[df[j, 1]] + 0.5/n, h[i, "top"], h[i, "bottom"]),
3298
+						default.units = "native", gp = subset_gp(link_gp, i))
3299
+				}
3300
+			}
3301
+		}
3302
+ 
3303
+		popViewport()
3304
+		
3305
+	}
3306
+
3307
+	column_fun = function(index) {
3308
+		n = length(index)
3309
+		
3310
+		if(is.atomic(align_to)) {
3311
+			if(length(setdiff(align_to, index)) == 0 && !any(duplicated(align_to))) {
3312
+				align_to = list(align_to)
3313
+			} else {
3314
+				if(length(align_to) != n) {
3315
+					stop_wrap("If `align_to` is a vector with group labels, the length should be the same as the number of columns in the heatmap.")
3316
+				}
3317
+				lnm = as.character(unique(align_to[index]))
3318
+				align_to = as.list(tapply(seq_along(align_to), align_to, function(x) x))
3319
+				align_to = align_to[lnm]
3320
+			}
3321
+		}
3322
+		nrl = sapply(align_to, length)
3323
+		align_to_df = lapply(align_to, function(x) {
3324
+			ind = which(index %in% x)
3325
+			n = length(ind)
3326
+			s = NULL
3327
+			e = NULL
3328
+			s[1] = ind[1]
3329
+			if(n > 1) {
3330
+				ind2 = which(ind[2:n] - ind[1:(n-1)] > 1)
3331
+				if(length(ind2)) s = c(s, ind[ ind2 + 1 ])
3332
+				k = length(s)
3333
+				e[k] = ind[length(ind)]
3334
+				if(length(ind2)) e[1:(k-1)] = ind[1:(n-1)][ ind2 ]
3335
+			} else {
3336
+				e = ind[1]
3337
+			}
3338
+			data.frame(s = s, e = e)
3339
+		})
3340
+
3341
+		if(is.null(.pos)) {
3342
+			pos = (1:n - 0.5)/n 
3343
+		} else {
3344
+			pos = .pos
3345
+		}
3346
+
3347
+		.scale = c(0, 1)
3348
+		pushViewport(viewport(yscale = c(0, 1), xscale = .scale))
3349
+		if(inherits(extend, "unit")) extend = convertWidth(extend, "native", valueOnly = TRUE)
3350
+		
3351
+		# the position of boxes initially are put evenly
3352
+		# add the gap
3353
+		n_boxes = length(align_to)
3354
+		if(length(gap) == 1) gap = rep(gap, n_boxes)
3355
+		if(is.null(size)) size = nrl
3356
+		if(length(size) != length(align_to)) {
3357
+			stop_wrap("Length of `size` should be the same as the number of groups of indices.")
3358
+		}
3359
+		if(!inherits(size, "unit")) {
3360
+			size_is_unit = FALSE
3361
+			if(n_boxes == 1) {
3362
+				h = data.frame(left = .scale[1] - extend[1], right = .scale[2] + extend[2])
3363
+			} else {
3364
+				gap = convertWidth(gap, "native", valueOnly = TRUE)
3365
+				box_width = size/sum(size) * (1 + sum(extend) - sum(gap[1:(n_boxes-1)]))
3366
+				h = data.frame(
3367
+						right = cumsum(box_width) + cumsum(gap) - gap[length(gap)] - extend[1]
3368
+					)
3369
+				h$left = h$right - box_width
3370
+			}
3371
+		} else {
3372
+			size_is_unit = TRUE
3373
+			box_width = size
3374
+			box_width2 = box_width
3375
+			for(i in 1:n_boxes) {
3376
+				if(i == 1 || i == n_boxes) {
3377
+					if(n_boxes > 1) {
3378
+						box_width2[i] = box_width2[i] + gap[i]*0.5
3379
+					}
3380
+				} else {
3381
+					box_width2[i] = box_width2[i] + gap[i]
3382
+				}
3383
+			}
3384
+			box_width2 = convertWidth(box_width2, "native", valueOnly = TRUE)
3385
+			# the original positions of boxes
3386
+			mean_pos = sapply(align_to, function(ind) mean(pos[ind]))
3387
+			h1 = mean_pos - box_width2*0.5
3388
+			h2 = mean_pos + box_width2*0.5
3389
+			h = smartAlign(h1, h2, c(.scale[1] - extend[1], .scale[2] + extend[2]))
3390
+			colnames(h) = c("left", "right")
3391
+
3392
+			# recalcualte h to remove gaps
3393
+			gap_width = convertWidth(gap, "native", valueOnly = TRUE)
3394
+			if(n_boxes > 1) {
3395
+				for(i in 1:n_boxes) {
3396
+					if(i == 1) {
3397
+						h[i, "left"] = h[i, "left"] + gap_width[i]/2
3398
+					} else if(i == n_boxes) {
3399
+						h[i, "right"] = h[i, "right"] - gap_width[i]/2
3400
+					} else {
3401
+						h[i, "left"] = h[i, "left"] + gap_width[i]/2
3402
+						h[i, "right"] = h[i, "right"] - gap_width[i]/2
3403
+					}
3404
+				}
3405
+			}
3406
+		}
3407
+		popViewport()
3408
+
3409
+		# draw boxes
3410
+		if(side == "top") {
3411
+			pushViewport(viewport(y = link_height, just = "bottom", height = anno_size$height - link_height))
3412
+		} else {
3413
+			pushViewport(viewport(y = 0, just = "bottom", height = anno_size$height - link_height))
3414
+		}
3415
+		for(i in 1:n_boxes) {
3416
+			current_vp_name = current.viewport()$name
3417
+			pushViewport(viewport(x = (h[i, "right"] + h[i, "left"])/2, width = h[i, "right"] - h[i, "left"], 
3418
+				default.units = "native"))
3419
+			if(is.function(panel_fun)) panel_fun(align_to[[i]], names(align_to)[i])
3420
+			popViewport()
3421
+
3422
+			if(current.viewport()$name != current_vp_name) {
3423
+				stop_wrap("If you push viewports `panel_fun`, you need to pop all them out.")
3424
+			}
3425
+		}
3426
+		popViewport()
3427
+		# draw the links
3428
+		link_gp = recycle_gp(link_gp, n_boxes)
3429
+		if(side == "top") {
3430
+			pushViewport(viewport(y = unit(0, "npc"), just = "bottom", height = link_height))
3431
+		} else {
3432
+			pushViewport(viewport(y = unit(1, "npc"), just = "top", height = link_height))
3433
+		}
3434
+		for(i in 1:n_boxes) {
3435
+			df = align_to_df[[i]]
3436
+			for(j in 1:nrow(df)) {
3437
+				# draw each polygon
3438
+				if(side == "top") {
3439
+					grid.polygon(
3440
+						c(pos[df[j, 2]] + 0.5/n, pos[df[j, 1]] - 0.5/n, h[i, "left"], h[i, "right"]),
3441
+						unit.c(unit(c(0, 0), "npc"), rep(link_width, 2)),
3442
+						default.units = "native", gp = subset_gp(link_gp, i))
3443
+				} else {
3444
+					grid.polygon(
3445
+						c(pos[df[j, 2]] + 0.5/n, pos[df[j, 1]] - 0.5/n, h[i, "left"], h[i, "right"]),
3446
+						unit.c(rep(link_width, 2), unit(c(0, 0), "npc")),
3447
+						default.units = "native", gp = subset_gp(link_gp, i))
3448
+				}
3449
+			}
3450
+		}
3451
+		popViewport()
3452
+		
3453
+	}
3454
+
3455
+	if(which == "row") {
3456
+		fun = row_fun
3457
+	} else if(which == "column") {
3458
+		fun = column_fun
3459
+	}
3460
+	
3461
+	anno = AnnotationFunction(
3462
+		fun = fun,
3463
+		fun_name = "anno_zoom",
3464
+		which = which,
3465
+		height = anno_size$height,
3466
+		width = anno_size$width,
3467
+		n = -1,
3468
+		var_import = list(align_to, .pos, gap, size, panel_fun, side, anno_size, extend,
3469
+			link_width, link_height, link_gp),
3470
+		show_name = FALSE
3471
+	)
3472
+
3473
+	anno@subset_rule$align_to = function(x, i) {
3474
+		if(is.atomic(x)) {
3475
+			x[i]
3476
+		} else {
3477
+			x = lapply(x, function(x) intersect(x, i))
3478
+			x = x[sapply(x, length) > 0]
3479
+		}
3480
+	}
3481
+
3482
+	anno@subsetable = TRUE
3483
+	return(anno)
3484
+}
3485
+
3486
+
... ...
@@ -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)
... ...
@@ -600,7 +600,7 @@ setMethod(f = "draw_heatmap_list",
600 600
                 anno_mark_param = list()
601 601
                 if(n_slice > 1) {
602 602
                     all_anno_type = anno_type(ht)
603
-                    if("anno_mark" %in% all_anno_type) {
603
+                    if(any(c("anno_zoom", "anno_mark") %in% all_anno_type)) {
604 604
                         ## only make the anno_mark annotation
605 605
                         pushViewport(viewport(y = max_bottom_component_height, height = unit(1, "npc") - max_top_component_height - max_bottom_component_height, just = c("bottom")))
606 606
                         ro_lt = ht_main@row_order_list
... ...
@@ -688,7 +688,7 @@ setMethod(f = "draw_heatmap_list",
688 688
                 anno_mark_param = list()
689 689
                 if(n_slice > 1) {
690 690
                     all_anno_type = anno_type(ht)
691
-                    if("anno_mark" %in% all_anno_type) {
691
+                    if(any(c("anno_zoom", "anno_mark") %in% all_anno_type)) {
692 692
                         ## only make the anno_mark annotation
693 693
                         pushViewport(viewport(x = max_left_component_width, width = unit(1, "npc") - max_left_component_width - max_right_component_width, just = c("left")))
694 694
                         co_lt = ht_main@column_order_list
... ...
@@ -543,7 +543,7 @@ setMethod(f = "draw",
543 543
         anno_mark_param = list()) {
544 544
 
545 545
     ## make the special anno_mark when the anotation is split
546
-    if(object@fun@fun_name == "anno_mark" && length(anno_mark_param) > 0) {
546
+    if(object@fun@fun_name %in% c("anno_mark", "anno_zoom") && length(anno_mark_param) > 0) {
547 547
         if(k > 1) {
548 548
             return(invisible(NULL))
549 549
         } else {
... ...
@@ -9,7 +9,7 @@
9 9
 #      When the value is a list, the names of the list represent alteration types.
10 10
 #      You can use `unify_mat_list` to make all matrix having same row names and column names.
11 11
 # -get_type If different alterations are encoded in the matrix as complex strings, this self-defined function
12
-#           determines how to extract them. It only works when ``mat`` is a matrix.
12
+#           determines how to extract them. It only works when ``mat`` is a matrix. The default value is `default_get_type`.
13 13
 # -alter_fun A single function or a list of functions which defines how to add graphics for different alterations.
14 14
 # -alter_fun_is_vectorized Whether ``alter_fun`` is implemented vectorized. Internally the function will guess.
15 15
 # -col A vector of color for which names correspond to alteration types.
... ...
@@ -51,10 +51,7 @@
51 51
 # Zuguang Gu <z.gu@dkfz.de>
52 52
 #
53 53
 oncoPrint = function(mat, 
54
-	get_type = function(x) {
55
-		x = strsplit(x, "\\s*[;:,|]\\s*")[[1]]
56
-		x[!x %in% c("na", "NA")]
57
-	},
54
+	get_type = default_get_type,
58 55
 	alter_fun, 
59 56
 	alter_fun_is_vectorized = NULL,
60 57
 	col, 
... ...
@@ -611,3 +608,13 @@ guess_alter_fun_is_vectorized = function(alter_fun) {
611 608
 	}
612 609
 }
613 610
 
611
+# == title
612
+# Default get_type for oncoPrint()
613
+#
614
+# == param
615
+# -x A strings which encode multiple altertations.
616
+#
617
+default_get_type = function(x) {
618
+	x = strsplit(x, "\\s*[;:,|]\\s*")[[1]]
619
+	x[!x %in% c("na", "NA")]
620
+}
... ...
@@ -10,7 +10,8 @@ Link annotation with labels
10 10
 anno_mark(at, labels, which = c("column", "row"),
11 11
     side = ifelse(which == "column", "top", "right"),
12 12
     lines_gp = gpar(), labels_gp = gpar(), padding = 0.5,
13
-    link_width = unit(5, "mm"), link_gp = lines_gp,
13
+    link_width = unit(5, "mm"), link_height = link_width,
14
+    link_gp = lines_gp,
14 15
     extend = unit(0, "mm"))
15 16
 }
16 17
 \arguments{
... ...
@@ -24,6 +25,7 @@ anno_mark(at, labels, which = c("column", "row"),
24 25
   \item{labels_gp}{Graphic settings for the labels.}
25 26
   \item{padding}{Padding between neighbouring labels in the plot.}
26 27
   \item{link_width}{Width of the segments.}
28
+  \item{link_height}{Similar as \code{link_width}, used for column annotation.}
27 29
   \item{extend}{By default, the region for the labels has the same width (if it is a column annotation) or same height (if it is a row annotation) as the heatmap. The size can be extended by this options. The value can be a proportion number or  a \code{\link[grid]{unit}} object. The length can be either one or two.}
28 30
 
29 31
 }
30 32
new file mode 100644
... ...
@@ -0,0 +1,39 @@
1
+\name{anno_zoom}
2
+\alias{anno_zoom}
3
+\title{
4
+Zoom annotation
5
+}
6
+\description{
7
+Zoom annotation
8
+}
9
+\usage{
10
+anno_zoom(align_to, panel_fun = function(index, nm = NULL) { grid.rect() },
11
+    which = c("column", "row"), side = ifelse(which == "column", "top", "right"),
12
+    size = NULL, gap = unit(1, "mm"),
13
+    link_width = unit(5, "mm"), link_height = link_width, link_gp = gpar(),
14
+    extend = unit(0, "mm"), width = NULL, height = NULL)
15
+}
16
+\arguments{
17
+
18
+  \item{align_to}{-align_to}
19
+  \item{panel_fun}{-panel_fun}
20
+  \item{which}{Whether it is a column annotation or a row annotation?}
21
+  \item{side}{Side of the boxes If it is a column annotation, valid values are "top" and "bottom"; If it is a row annotation, valid values are "left" and "right".}
22
+  \item{size}{-size}
23
+  \item{gap}{-gap}
24
+  \item{link_gp}{Graphic settings for the segments.}
25
+  \item{link_width}{Width of the segments.}
26
+  \item{link_height}{Similar as \code{link_width}, used for column annotation.}
27
+  \item{extend}{By default, the region for the labels has the same width (if it is a column annotation) or same height (if it is a row annotation) as the heatmap. The size can be extended by this options. The value can be a proportion number or  a \code{\link[grid]{unit}} object. The length can be either one or two.}
28
+  \item{width}{Width of the annotation. The value should be an absolute unit. Width is not allowed to be set for column annotation.}
29
+  \item{height}{Height of the annotation. The value should be an absolute unit. Height is not allowed to be set for row annotation.}
30
+
31
+}
32
+\details{
33
+
34
+}
35
+\examples{
36
+# There is no example
37
+NULL
38
+
39
+}
0 40
new file mode 100644
... ...
@@ -0,0 +1,20 @@
1
+\name{default_get_type}
2
+\alias{default_get_type}
3
+\title{
4
+Default get_type for oncoPrint()
5
+}
6
+\description{
7
+Default get_type for oncoPrint()
8
+}
9
+\usage{
10
+default_get_type(x)
11
+}
12
+\arguments{
13
+
14
+  \item{x}{A strings which encode multiple altertations.}
15
+
16
+}
17
+\examples{
18
+# There is no example
19
+NULL
20
+}
... ...
@@ -8,7 +8,7 @@ Make oncoPrint
8 8
 }
9 9
 \usage{
10 10
 oncoPrint(mat,
11
-    get_type = function(x) strsplit(x, "\\\\s*[;:,|]\\\\s*")[[1]],
11
+    get_type = default_get_type,
12 12
     alter_fun,
13 13
     alter_fun_is_vectorized = NULL,
14 14
     col,
... ...
@@ -45,7 +45,7 @@ oncoPrint(mat,
45 45
 \arguments{
46 46
 
47 47
   \item{mat}{The value should be a character matrix which encodes mulitple alterations  or a list of matrices for which every matrix contains binary value representing whether the alteration is present or absent.  When the value is a list, the names of the list represent alteration types. You can use \code{\link{unify_mat_list}} to make all matrix having same row names and column names.}
48
-  \item{get_type}{If different alterations are encoded in the matrix as complex strings, this self-defined function determines how to extract them. It only works when \code{mat} is a matrix.}
48
+  \item{get_type}{If different alterations are encoded in the matrix as complex strings, this self-defined function determines how to extract them. It only works when \code{mat} is a matrix. The default value is \code{\link{default_get_type}}.}
49 49
   \item{alter_fun}{A single function or a list of functions which defines how to add graphics for different alterations.}
50 50
   \item{alter_fun_is_vectorized}{Whether \code{alter_fun} is implemented vectorized. Internally the function will guess.}
51 51
   \item{col}{A vector of color for which names correspond to alteration types.}
... ...
@@ -358,9 +358,72 @@ anno = anno_block(gp = gpar(fill = 1:4), labels = letters[1:4], labels_gp = gpar
358 358
 draw(anno, index = 1:10, k = 2, n = 4, test = "anno_block")
359 359
 
360 360
 
361
+### anno_zoom
362
+fa = sort(sample(letters[1:3], 100, replace = TRUE, prob = c(1, 2, 3)))
363
+panel_fun = function(index, nm) {
364
+	grid.rect()
365
+	grid.text(nm)
366
+}
367
+anno = anno_zoom(align_to = fa, which = "row", panel_fun = panel_fun)
368
+draw(anno, index = 1:100, test = "anno_zoom")
369
+
370
+anno = anno_zoom(align_to = fa, which = "row", panel_fun = panel_fun,
371
+	gap = unit(1, "cm"))
372
+draw(anno, index = 1:100, test = "anno_zoom, set gap")
373
+
374
+anno = anno_zoom(align_to = fa, which = "row", panel_fun = panel_fun,
375
+	size = 1:3)
376
+draw(anno, index = 1:100, test = "anno_zoom, size set as relative values")
377
+
378
+anno = anno_zoom(align_to = fa, which = "row", panel_fun = panel_fun,
379
+	size = 1:3, extend = unit(1, "cm"))
380
+draw(anno, index = 1:100, test = "anno_zoom, extend")
381
+
382
+anno = anno_zoom(align_to = fa, which = "row", panel_fun = panel_fun,
383
+	size = unit(1:3, "cm"))
384
+draw(anno, index = 1:100, test = "anno_zoom, size set as absolute values")
385
+
386
+anno = anno_zoom(align_to = fa, which = "row", panel_fun = panel_fun,
387
+	size = unit(c(2, 20, 40), "cm"))
388
+draw(anno, index = 1:100, test = "anno_zoom, big size")
389
+
390
+
391
+anno = anno_zoom(align_to = fa, which = "row", panel_fun = panel_fun,
392
+	size = unit(1:3, "cm"), side = "left")
393
+draw(anno, index = 1:100, test = "anno_zoom, side")
394
+
395
+
396
+anno = anno_zoom(align_to = fa, which = "row", panel_fun = panel_fun,
397
+	size = unit(1:3, "cm"), link_gp = gpar(fill = 1:3))
398
+draw(anno, index = 1:100, test = "anno_zoom, link_gp")
399
+
400
+anno = anno_zoom(align_to = fa, which = "row", panel_fun = panel_fun,
401
+	size = unit(1:3, "cm"), link_gp = gpar(fill = 1:3),
402
+	link_width = unit(2, "cm"), width = unit(4, "cm"))
403
+draw(anno, index = 1:100, test = "anno_zoom, width")
404
+
405
+anno = anno_zoom(align_to = list(a = 1:10, b = 30:45, c = 70:90), 
406
+	which = "row", panel_fun = panel_fun, size = unit(1:3, "cm"))
407
+draw(anno, index = 1:100, test = "anno_zoom, a list of indices")
408
+
409
+anno = anno_zoom(align_to = fa, which = "column", panel_fun = panel_fun,
410
+	size = unit(1:3, "cm"))
411
+draw(anno, index = 1:100, test = "anno_zoom, column annotation")
412
+
413
+
414
+m = matrix(rnorm(100*10), nrow = 100)
415
+hc = hclust(dist(m))
416
+fa2 = cutree(hc, k = 4)
417
+anno = anno_zoom(align_to = fa2, which = "row", panel_fun = panel_fun)
418
+draw(anno, index = hc$order, test = "anno_zoom, column annotation")
361 419
 
420
+anno = anno_zoom(align_to = fa2, which = "column", panel_fun = panel_fun)
421
+draw(anno, index = hc$order, test = "anno_zoom, column annotation")
362 422
 
363 423
 
424
+anno = anno_zoom(align_to = fa2, which = "row", panel_fun = panel_fun)
425
+Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno))
426
+Heatmap(m, cluster_rows = hc, right_annotation = rowAnnotation(foo = anno), row_split = 2)
364 427
 
365 428
 
366 429