1. ComplexHeatmap
  2. Commit 36c3a378f92fb11ff3f5c71e04a31f612543d66e
Browse code

add UpSet()

Zuguang Gu authored on 26/12/2018 08:44:58
Showing 6 changed files
R/Upset.R
History View file @ 36c3a37
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,612 @@
1 
+
2 
+make_comb_mat_from_matrix = function(x, mode, top_n_sets = Inf, min_set_size = -Inf) {
3 
+	# check whether x is a binary matrix
4 
+	if(is.data.frame(x)) {
5 
+		lc = sapply(x, function(x) {
6 
+			if(is.numeric(x)) {
7 
+				all(x == 0 | x == 1)
8 
+			} else if(is.logical(x)) {
9 
+				TRUE
10 
+			} else {
11 
+				FALSE
12 
+			}
13 
+		})
14 
+	} else if(is.matrix(x)) {
15 
+		lc = apply(x, 2, function(x) {
16 
+			if(is.numeric(x)) {
17 
+				all(x == 0 | x == 1)
18 
+			} else if(is.logical(x)) {
19 
+				TRUE
20 
+			} else {
21 
+				FALSE
22 
+			}
23 
+		})
24 
+	}
25 
+	if(sum(lc) < 1) {
26 
+		stop_wrap("Can not find columns which are logical or only contain 0 or 1.")
27 
+	} else {
28 
+		x = x[, lc, drop = FALSE]
29 
+	}
30 
+	if(is.null(colnames(x))) {
31 
+		stop_wrap("The matrix or the data frame must have column names.")
32 
+	}
33 
+
34 
+	x = as.matrix(x) + 0
35 
+	set_size = colSums(x)
36 
+	l = set_size >= min_set_size & rank(max(set_size) - set_size) <= top_n_sets
37 
+
38 
+	set_size = set_size[l]
39 
+	x = x[, l, drop = FALSE]
40 
+	x = x[rowSums(x) > 0, , drop = FALSE]
41 
+
42 
+	comb_mat = unique(x)
43 
+	rn = apply(comb_mat, 1, binaryToInt)
44 
+	tb = table(apply(x, 1, binaryToInt))
45 
+	comb_size = as.vector(tb[as.character(rn)])
46 
+
47 
+	rownames(comb_mat) = NULL
48 
+	comb_mat = t(comb_mat)
49 
+
50 
+	nc = ncol(comb_mat)
51 
+	comb_mat2 = matrix(nr = nrow(comb_mat), nc = nc*(nc-1)/2)
52 
+	rownames(comb_mat2) = rownames(comb_mat)
53 
+	if(mode == "intersect") {
54 
+		if(nc > 1) {
55 
+			ic = 0
56 
+			for(i in 1:(nc-1)) {
57 
+				for(j in (i+1):nc) {
58 
+					ic = ic + 1
59 
+					comb_mat2[, ic] = (comb_mat[, i] & comb_mat[, j]) + 0
60 
+				}
61 
+			}
62 
+		}
63 
+	} else if(mode == "union") {
64 
+		if(nc > 1) {
65 
+			ic = 0
66 
+			for(i in 1:(nc-1)) {
67 
+				for(j in (i+1):nc) {
68 
+					ic = ic + 1
69 
+					comb_mat2[, ic] = (comb_mat[, i] | comb_mat[, j]) + 0
70 
+				}
71 
+			}
72 
+		}
73 
+	}
74 
+	comb_mat2 = comb_mat2[, colSums(comb_mat2) > 0, drop = FALSE]
75 
+
76 
+	if(mode %in% c("intersect", "union")) {
77 
+		comb_mat = unique(comb_mat2, MARGIN = 2)
78 
+		comb_size = apply(comb_mat, 2, function(query) {
79 
+			if(mode == "intersect") {
80 
+				l_subset = query == 1
81 
+				l = apply(x, 1, function(y) all(y[l_subset] == 1))
82 
+			} else if(mode == "union") {
83 
+				l_subset = query == 1
84 
+				l = apply(x, 1, function(y) {
85 
+					if(all(y[!l_subset] == 0)) {
86 
+						sum(y[l_subset]) > 0
87 
+					} else {
88 
+						FALSE
89 
+					}
90 
+				})
91 
+			}
92 
+			sum(l)
93 
+		})
94 
+	}
95 
+
96 
+	attr(comb_mat, "set_size") = set_size
97 
+	attr(comb_mat, "comb_size") = comb_size
98 
+	attr(comb_mat, "mode") = mode
99 
+	attr(comb_mat, "set_on_rows") = TRUE
100 
+	attr(comb_mat, "x") = x
101 
+	class(comb_mat) = c("comb_mat", "matrix")
102 
+	return(comb_mat)
103 
+
104 
+}
105 
+
106 
+make_comb_mat_from_list = function(lt, mode, value_fun = length, top_n_sets = Inf, min_set_size = -Inf) {
107 
+	n = length(lt)
108 
+    nm = names(lt)
109 
+    if(is.null(nm)) {
110 
+    	stop_wrap("The list must have names.")
111 
+    }
112 
+
113 
+    if(inherits(lt[[1]], "GRanges")) {
114 
+    	set_size = sapply(lt, function(x) {
115 
+	    	value_fun(union(x, GRanges()))
116 
+	    })
117 
+    } else if(inherits(lt[[1]], "IRanges")) {
118 
+    	set_size = sapply(lt, function(x) {
119 
+	    	value_fun(union(x, IRanges()))
120 
+	    })
121 
+    } else {
122 
+	    set_size = sapply(lt, function(x) {
123 
+	    	value_fun(union(x, NULL))
124 
+	    })
125 
+	}
126 
+
127 
+	l = set_size >= min_set_size & rank(max(set_size) - set_size) <= top_n_sets
128 
+
129 
+	set_size = set_size[l]
130 
+	lt = lt[l]
131 
+	n = length(lt)
132 
+    nm = names(lt)
133 
+
134 
+    comb_mat = matrix(FALSE, nrow = n, ncol = sum(choose(n, 1:n)))
135 
+    rownames(comb_mat) = nm
136 
+    j = 1
137 
+    for(k in 1:n) {
138 
+        comb = combn(n, k)
139 
+        for(i in 1:ncol(comb)) {
140 
+            comb_mat[comb[, i], j] = TRUE
141 
+            j = j + 1
142 
+        }
143 
+    }
144 
+
145 
+    get_comb_size = function(lt, mode, do = rep(TRUE, length(lt)), value_fun = length) {
146 
+        set1_index = which(do)
147 
+        set2_index = which(!do)
148 
+
149 
+        s = lt[[ set1_index[1] ]]
150 
+        if(mode == "distinct") {
151 
+	        for(i in set1_index[-1]) {
152 
+	            s = intersect(s, lt[[ i ]])
153 
+	        }
154 
+
155 
+	        for(i in set2_index) {
156 
+	            s = setdiff(s, lt[[ i ]])
157 
+	        }
158 
+	    } else if(mode == "intersect") {
159 
+	    	for(i in set1_index[-1]) {
160 
+	            s = intersect(s, lt[[ i ]])
161 
+	        }
162 
+	    } else if(mode == "union") {
163 
+	    	for(i in set1_index[-1]) {
164 
+	            s = union(s, lt[[ i ]])
165 
+	        }
166 
+	    }
167 
+        value_fun(s)
168 
+    }
169 
+
170 
+    comb_size = numeric(ncol(comb_mat))
171 
+    for(i in seq_len(ncol(comb_mat))) {
172 
+        comb_size[i] = get_comb_size(lt, mode = mode, comb_mat[, i], value_fun = value_fun)
173 
+    }
174 
+
175 
+    comb_mat = comb_mat + 0
176 
+    attr(comb_mat, "set_size") = set_size
177 
+	attr(comb_mat, "comb_size") = comb_size
178 
+	attr(comb_mat, "mode") = mode
179 
+	attr(comb_mat, "set_on_rows") = TRUE
180 
+	attr(comb_mat, "lt") = lt
181 
+	class(comb_mat) = c("comb_mat", "matrix")
182 
+	return(comb_mat)
183 
+}
184 
+
185 
+# == title
186 
+# Convert a List of Sets to a Binary Matrix
187 
+#
188 
+# == param
189 
+# -lt A list of vectors.
190 
+#
191 
+# == details
192 
+# It converts the list which have m sets to a binary matrix with n rows and m columns
193 
+# where n is the number of union of all sets in the list.
194 
+#
195 
+# == example
196 
+# set.seed(123)
197 
+# lt = list(a = sample(letters, 10),
198 
+# 	      b = sample(letters, 15),
199 
+# 	      c = sample(letters, 20))
200 
+# list_to_matrix(lt)
201 
+list_to_matrix = function(lt) {
202 
+	cn = unique(unlist(lt))
203 
+	mat = matrix(0, nrow = length(cn), ncol = length(lt))
204 
+	rownames(mat) = cn
205 
+	colnames(mat) = names(lt)
206 
+	for(i in seq_along(lt)) {
207 
+		mat[unique(lt[[i]]), i] = 1
208 
+	}
209 
+	return(mat)
210 
+}
211 
+
212 
+# == title
213 
+# Make a Combination matrix for UpSet Plot
214 
+#
215 
+# == param
216 
+# -...
217 
+# -mode
218 
+# -top_n_sets
219 
+# -min_set_size
220 
+# -value_fun
221 
+make_comb_mat = function(..., mode = c("distinct", "intersect", "union"),
222 
+	top_n_sets = Inf, min_set_size = -Inf, value_fun) {
223 
+
224 
+	lt = list(...)
225 
+
226 
+	mode = match.arg(mode)[1]
227 
+	if(length(lt) == 1) {
228 
+		lt = lt[[1]]
229 
+		if(!is.null(dim(lt))) {
230 
+			return(make_comb_mat_from_matrix(lt, mode = mode, top_n_sets = top_n_sets, min_set_size = min_set_size))
231 
+		}
232 
+	}
233 
+
234 
+	if(missing(value_fun)) {
235 
+		if(inherits(lt[[1]], "GRanges")) {
236 
+			value_fun = function(x) sum(as.numeric(end(x) - start(x) + 1))
237 
+		} else if(inherits(lt[[1]], "IRanges")) {
238 
+			value_fun = function(x) sum(as.numeric(end(x) - start(x) + 1))
239 
+		} else {
240 
+			value_fun = length
241 
+		}
242 
+	}
243 
+	make_comb_mat_from_list(lt, value_fun, mode = mode, top_n_sets = top_n_sets, min_set_size = min_set_size)
244 
+}
245 
+
246 
+# == title
247 
+# Set Names
248 
+#
249 
+# == param
250 
+# -m A combination matrix returned by `make_comb_mat`.
251 
+#
252 
+# == value
253 
+# A vector of set names.
254 
+#
255 
+# == example
256 
+# set.seed(123)
257 
+# lt = list(a = sample(letters, 10),
258 
+# 	      b = sample(letters, 15),
259 
+# 	      c = sample(letters, 20))
260 
+# m = make_comb_mat(lt)
261 
+# set_name(m)
262 
+set_name = function(m) {
263 
+	set_on_rows = attr(m, "set_on_rows")
264 
+	if(set_on_rows) {
265 
+		rownames(m)
266 
+	} else {
267 
+		colnames(m)
268 
+	}
269 
+}
270 
+
271 
+# == title
272 
+# Set Sizes
273 
+#
274 
+# == param
275 
+# -m A combination matrix returned by `make_comb_mat`.
276 
+#
277 
+# == value
278 
+# A vector of set sizes.
279 
+#
280 
+# == example
281 
+# set.seed(123)
282 
+# lt = list(a = sample(letters, 10),
283 
+# 	      b = sample(letters, 15),
284 
+# 	      c = sample(letters, 20))
285 
+# m = make_comb_mat(lt)
286 
+# set_size(m)
287 
+set_size = function(m) {
288 
+	attr(m, "set_size")
289 
+}
290 
+
291 
+# == title
292 
+# Sizes of the Combination sets
293 
+#
294 
+# == param
295 
+# -m A combination matrix returned by `make_comb_mat`.
296 
+#
297 
+# == value
298 
+# A vector of sizes of the combination sets.
299 
+#
300 
+# == example
301 
+# set.seed(123)
302 
+# lt = list(a = sample(letters, 10),
303 
+# 	      b = sample(letters, 15),
304 
+# 	      c = sample(letters, 20))
305 
+# m = make_comb_mat(lt)
306 
+# comb_size(m)
307 
+comb_size = function(m) {
308 
+	attr(m, "comb_size")
309 
+}
310 
+
311 
+# == title
312 
+# Names of the Combination sets
313 
+#
314 
+# == param
315 
+# -m A combination matrix returned by `make_comb_mat`.
316 
+#
317 
+# == details
318 
+# The name of the combination sets are formatted as a string
319 
+# of binary bits. E.g. for three sets of "a", "b", "c", the combination
320 
+# set with name "101" corresponds to select set a, not select set b
321 
+# and select set c. The definition of "select" depends on the value of
322 
+# ``mode`` from `make_comb_mat`.
323 
+#
324 
+# == value
325 
+# A vector of names of the combination sets.
326 
+#
327 
+# == example
328 
+# set.seed(123)
329 
+# lt = list(a = sample(letters, 10),
330 
+# 	      b = sample(letters, 15),
331 
+# 	      c = sample(letters, 20))
332 
+# m = make_comb_mat(lt)
333 
+# comb_name(m)
334 
+comb_name = function(m) {
335 
+	set_on_rows = attr(m, "set_on_rows")
336 
+	if(set_on_rows) {
337 
+		apply(m, 2, paste, collapse = "")
338 
+	} else {
339 
+		apply(m, 1, paste, collapse = "")
340 
+	}
341 
+}
342 
+
343 
+# == title
344 
+# Degrees of the Combination sets
345 
+#
346 
+# == param
347 
+# -m A combination matrix returned by `make_comb_mat`.
348 
+#
349 
+# == details
350 
+# The degree for a combination set is the number of sets that are selected.
351 
+#
352 
+# == value
353 
+# A vector of degrees of the combination sets.
354 
+#
355 
+# == example
356 
+# set.seed(123)
357 
+# lt = list(a = sample(letters, 10),
358 
+# 	      b = sample(letters, 15),
359 
+# 	      c = sample(letters, 20))
360 
+# m = make_comb_mat(lt)
361 
+# comb_degree(m)
362 
+comb_degree = function(m) {
363 
+	set_on_rows = attr(m, "set_on_rows")
364 
+	if(set_on_rows) {
365 
+		colSums(m)
366 
+	} else {
367 
+		rowSums(m)
368 
+	}
369 
+}
370 
+
371 
+extract_comb = function(m, comb_name) {
372 
+	all_comb_names = comb_name(m)
373 
+	if(!comb_name %in% all_comb_names) {
374 
+		stop_wrap(paste0("Cannot find a combination name:	", comb_name, ", valid combination name should be in `comb_name(m)`."))
375 
+	}
376 
+
377 
+	query = as.numeric(strsplit(comb_name, "")[[1]])
378 
+
379 
+	x = attr(m, "x")
380 
+	lt = attr(m, "lt")
381 
+	mode = attr(m, "mode")
382 
+	if(!is.null(x)) {
383 
+		if(mode == "distinct") {
384 
+			l = apply(x, 1, function(y) all(y == query))
385 
+		} else if(mode == "intersect") {
386 
+			l_subset = query == 1
387 
+			l = apply(x, 1, function(y) all(y[l_subset] == 1))
388 
+		} else if(mode == "union") {
389 
+			l_subset = query == 1
390 
+			l = apply(x, 1, function(y) {
391 
+				if(all(y[!l_subset] == 0)) {
392 
+					sum(y[l_subset]) > 0
393 
+				} else {
394 
+					FALSE
395 
+				}
396 
+			})
397 
+		}
398 
+
399 
+		rn = rownames(x)
400 
+		if(is.null(rn)) {
401 
+			return(seq_len(nrow(x))[l])
402 
+		} else {
403 
+			return(rn[l])
404 
+		}
405 
+	}
406 
+	if(!is.null(lt)) {
407 
+		do_comb = function(lt, mode, do = rep(TRUE, length(lt))) {
408 
+	        set1_index = which(do)
409 
+	        set2_index = which(!do)
410 
+
411 
+	        s = lt[[ set1_index[1] ]]
412 
+
413 
+	        if(mode == "distinct") {
414 
+		        for(i in set1_index[-1]) {
415 
+		            s = intersect(s, lt[[ i ]])
416 
+		        }
417 
+
418 
+		        for(i in set2_index) {
419 
+		            s = setdiff(s, lt[[ i ]])
420 
+		        }
421 
+		    } else if(mode == "intersect") {
422 
+		    	for(i in set1_index[-1]) {
423 
+		            s = intersect(s, lt[[ i ]])
424 
+		        }
425 
+		    } else if(mode == "union") {
426 
+		    	for(i in set1_index[-1]) {
427 
+		            s = union(s, lt[[ i ]])
428 
+		        }
429 
+		    }
430 
+	        s
431 
+	    }
432 
+
433 
+	    do = as.logical(as.numeric(strsplit(comb_name, "")[[1]]))
434 
+	    do_comb(lt, mode, do)
435 
+	}
436 
+}
437 
+
438 
+# == title
439 
+# Transpost the Combination Matrix
440 
+#
441 
+# == param
442 
+# -x A combination matrix returned by `make_comb_mat`.
443 
+#
444 
+# == example
445 
+# set.seed(123)
446 
+# lt = list(a = sample(letters, 10),
447 
+# 	      b = sample(letters, 15),
448 
+# 	      c = sample(letters, 20))
449 
+# m = make_comb_mat(lt)
450 
+# t(m)
451 
+t.comb_mat = function(x) {
452 
+	x2 = t.default(x)
453 
+	attr(x2, "set_on_rows") = !attr(x, "set_on_rows")
454 
+	x2
455 
+}
456 
+
457 
+# == title
458 
+# Subset the Combination Matrix
459 
+#
460 
+# == param
461 
+# -x A combination matrix returned by `make_comb_mat`.
462 
+# -i Indices on rows.
463 
+# -j Indices on columns
464 
+# -drop It is always reset to ``FALSE`` internally.
465 
+#
466 
+"[.comb_mat" = function(x, i, j, drop = FALSE) {
467 
+	set_size = attr(x, "set_size")
468 
+	comb_size = attr(x, "comb_size")
469 
+	set_on_rows = attr(x, "set_on_rows")
470 
+	mode = attr(x, "mode")
471 
+
472 
+	class(x) = "matrix"
473 
+
474 
+	if(set_on_rows) {
475 
+		if(nargs() == 2) {
476 
+			return(x[i])
477 
+		}
478 
+		if(missing(i)) {
479 
+			x2 = x[, j, drop = FALSE]
480 
+			comb_size = comb_size[j]
481 
+		} else if(missing(j)) {
482 
+			x2 = x[i, , drop = FALSE]
483 
+			set_size = set_size[i]
484 
+		} else {
485 
+			x2 = x[i, j, drop = FALSE]
486 
+			set_size = set_size[i]
487 
+			comb_size = comb_size[j]
488 
+		}
489 
+	} else {
490 
+		if(nargs() == 2) {
491 
+			return(x[i])
492 
+		}
493 
+		if(missing(i)) {
494 
+			x2 = x[, j, drop = FALSE]
495 
+			set_size = set_size[j]
496 
+		} else if(missing(j)) {
497 
+			x2 = x[i, , drop = FALSE]
498 
+			comb_size = comb_size[i]
499 
+		} else {
500 
+			x2 = x[i, j, drop = FALSE]
501 
+			comb_size = comb_size[i]
502 
+			set_size = set_size[j]
503 
+		}
504 
+	}
505 
+
506 
+	attr(x2, "set_size") = set_size
507 
+	attr(x2, "comb_size") = comb_size
508 
+	attr(x2, "mode") = mode
509 
+	attr(x2, "set_on_rows") = set_on_rows
510 
+	class(x2) = c("comb_mat", "matrix")
511 
+	return(x2)
512 
+}
513 
+
514 
+# == title
515 
+# Print the comb_mat Object
516 
+#
517 
+# == param
518 
+# -x A combination matrix returned by `make_comb_mat`.
519 
+# -... Other arguments
520 
+#
521 
+print.comb_mat = function(x, ...) {
522 
+	set_size = attr(x, "set_size")
523 
+	comb_size = attr(x, "comb_size")
524 
+	set_on_rows = attr(x, "set_on_rows")
525 
+	mode = attr(x, "mode")
526 
+
527 
+	cat("A combination matrix with", length(set_size), "sets and", length(comb_size), "combinations.\n")
528 
+	cat("  ranges of #combination set: c(", min(comb_size), ", ", max(comb_size), ").\n", sep = "")
529 
+	cat("  mode for the combination size: ", mode, ".\n", sep = "")
530 
+	if(set_on_rows) {
531 
+		cat("  sets are on rows.\n")
532 
+	} else {
533 
+		cat("  sets are on columns\n")
534 
+	}
535 
+}
536 
+
537 
+# == title
538 
+# Make the UpSet plot
539 
+#
540 
+UpSet = function(m, set_order = order(set_size(m), decreasing = TRUE),
541 
+	comb_order = order(comb_size(m), decreasing = TRUE), ...) {
542 
+
543 
+	set_on_rows = attr(m, "set_on_rows")
544 
+	mode = attr(m, "mode")
545 
+
546 
+	m2 = m
547 
+
548 
+	class(m2) = "matrix"
549 
+
550 
+	if(set_on_rows) {
551 
+		layer_fun = function(j, i, x, y, w, h, fill) {
552 
+			nr = round(1/as.numeric(h[1]))
553 
+			nc = round(1/as.numeric(w[1]))
554 
+			subm = matrix(pindex(m2, i, j), nrow = nr, byrow = FALSE)
555 
+			for(k in seq_len(nr)) {
556 
+				if(k %% 2) {
557 
+					grid.rect(y = k/nr, height = 1/nr, just = "top", gp = gpar(fill = "#F0F0F0", col = NA))
558 
+				}
559 
+			}
560 
+			grid.points(x, y, size = unit(3, "mm"), pch = 16, gp = gpar(col = ifelse(pindex(m2, i, j), "black", "#CCCCCC")))
561 
+			for(k in seq_len(nc)) {
562 
+		        if(sum(subm[, k]) >= 2) {
563 
+		            i_min = min(which(subm[, k] > 0))
564 
+		            i_max = max(which(subm[, k] > 0))
565 
+		            grid.lines(c(k - 0.5, k - 0.5)/nc, (nr - c(i_min, i_max) + 0.5)/nr, gp = gpar(col = "black", lwd = 2))
566 
+		        }
567 
+		    }
568 
+		}
569 
+		ht = Heatmap(m2, cluster_rows = FALSE, cluster_columns = FALSE, rect_gp = gpar(type = "none"),
570 
+			layer_fun = layer_fun, show_heatmap_legend = FALSE,
571 
+			top_annotation = HeatmapAnnotation("Combination size" = anno_barplot(comb_size(m),
572 
+					border = FALSE, gp = gpar(fill = "black"), height = unit(2, "cm")),
573 
+				annotation_name_side = "left", annotation_name_rot = 0),
574 
+			right_annotation = rowAnnotation("Set size" = anno_barplot(set_size(m), border = FALSE,
575 
+					gp = gpar(fill = "black"), width = unit(3, "cm"))),
576 
+			row_names_side = "left",
577 
+			row_order = set_order, column_order = comb_order, ...)
578 
+	} else {
579 
+		layer_fun = function(j, i, x, y, w, h, fill) {
580 
+			nr = round(1/as.numeric(h[1]))
581 
+			nc = round(1/as.numeric(w[1]))
582 
+			subm = matrix(pindex(m2, i, j), nrow = nr, byrow = FALSE)
583 
+			for(k in seq_len(nc)) {
584 
+				if(k %% 2) {
585 
+					grid.rect(x = k/nc, width = 1/nc, just = "right", gp = gpar(fill = "#F0F0F0", col = NA))
586 
+				}
587 
+			}
588 
+			grid.points(x, y, size = unit(3, "mm"), pch = 16, gp = gpar(col = ifelse(pindex(m2, i, j), "black", "#CCCCCC")))
589 
+			for(k in seq_len(nr)) {
590 
+		        if(sum(subm[k, ]) >= 2) {
591 
+		            i_min = min(which(subm[k, ] > 0))
592 
+		            i_max = max(which(subm[k, ] > 0))
593 
+		            grid.lines((c(i_min, i_max) - 0.5)/nc, (nr - c(k ,k) + 0.5)/nr, gp = gpar(col = "black", lwd = 2))
594 
+		        }
595 
+		    }
596 
+		}
597 
+		ht = Heatmap(m2, cluster_rows = FALSE, cluster_columns = FALSE, rect_gp = gpar(type = "none"),
598 
+			layer_fun = layer_fun, show_heatmap_legend = FALSE,
599 
+			right_annotation = rowAnnotation("Combination size" = anno_barplot(comb_size(m),
600 
+				border = FALSE, gp = gpar(fill = "black"), width = unit(2, "cm"))),
601 
+			top_annotation = HeatmapAnnotation("Set size" = anno_barplot(set_size(m), border = FALSE, gp = gpar(fill = "black"),
602 
+				height = unit(3, "cm")),
603 
+				annotation_name_side = "left", annotation_name_rot = 0),
604 
+			row_order = comb_order, column_order = set_order, ...)
605 
+	}
606 
+	ht
607 
+}
608 
+
609 
+
610 
+binaryToInt = function(x) {
611 
+	sum(x * 2^(rev(seq_along(x)) - 1))
612 
+}
R/utils.R
History View file @ 36c3a37
... ... 
@@ -804,8 +804,8 @@ grid.boxplot = function(value, pos, outline = TRUE, box_width = 0.6,
804 804 
     }
805 805 
 }
806 806
807 
-random_str = function() {
808 
-    paste(sample(c(letters, LETTERS, 0:9), 8), collapse = "")
807 
+random_str = function(k = 1, len = 10) {
808 
+    sapply(seq_len(k), function(i) paste(sample(c(letters, LETTERS, 0:9), len), collapse = ""))
809 809 
 }
810 810
811 811
Rprof.out
History View file @ 36c3a37
812 812 
new file mode 100644
... ... 
@@ -0,0 +1,69 @@
1 
+sample.interval=20000
2 
+"FUN" "lapply" "unlist" "unique" "findLocalsList1" "FUN" "lapply" "unlist" "unique" "findLocalsList1" "FUN" "lapply" "unlist" "unique" "findLocalsList1" "unique" "FUN" "lapply" "unlist" "unique" "findLocalsList1" "FUN" "lapply" "unlist" "unique" "findLocalsList1" "findLocalsList" "funEnv" "make.functionContext" "cmpfun" "doTryCatch" "tryCatchOne" "tryCatchList" "tryCatch" "compiler:::tryCmpfun" "make_comb_mat_from_matrix" "make_comb_mat"
3 
+"parent.env" "findCenvVar" "getInlineInfo" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "genCode" "h" "tryInline" "cmpCall" "cmp" "genCode" "cb$putconst" "cmpCallArgs" "cmpCallSymFun" "cmpCall" "cmp" "cmpSymbolAssign" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "genCode" "cmpfun" "doTryCatch" "tryCatchOne" "tryCatchList" "tryCatch" "compiler:::tryCmpfun" "make_comb_mat_from_matrix" "make_comb_mat"
4 
+"exists" "findCenvVar" "findLocVar" "cmpCall" "cmp" "genCode" "cb$putconst" "cmpCallArgs" "cmpCallSymFun" "cmpCall" "cmp" "cmpSymbolAssign" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "genCode" "cmpfun" "doTryCatch" "tryCatchOne" "tryCatchList" "tryCatch" "compiler:::tryCmpfun" "make_comb_mat_from_matrix" "make_comb_mat"
5 
+"parent.env" "findCenvVar" "getInlineInfo" "tryInline" "cmpCall" "cmp" "cmpForBody" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "cmpForBody" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "genCode" "cmpfun" "doTryCatch" "tryCatchOne" "tryCatchList" "tryCatch" "compiler:::tryCmpfun" "make_comb_mat_from_matrix" "make_comb_mat"
6 
+"cmpPrim2" "h" "tryInline" "cmpCall" "cmp" "cmpPrim2" "h" "tryInline" "cmpCall" "cmp" "cmpComplexAssign" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "cmpForBody" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "cmpForBody" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "genCode" "cmpfun" "doTryCatch" "tryCatchOne" "tryCatchList" "tryCatch" "compiler:::tryCmpfun" "make_comb_mat_from_matrix" "make_comb_mat"
7 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
8 
+"paste" "FUN" "apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
9 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
10 
+"exists" "findCenvVar" "getInlineInfo" "isBaseVar" "getFoldFun" "constantFoldCall" "constantFold" "constantFoldCall" "constantFold" "cmp" "cmpPrim2" "h" "tryInline" "cmpCall" "cmp" "cmpPrim2" "h" "tryInline" "cmpCall" "cmp" "cmpBuiltinArgs" "h" "tryInline" "cmpCall" "cmp" "h" "tryInline" "cmpCall" "cmp" "genCode" "cmpfun" "doTryCatch" "tryCatchOne" "tryCatchList" "tryCatch" "compiler:::tryCmpfun" "FUN" "apply" "make_comb_mat_from_matrix" "make_comb_mat"
11 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
12 
+"rev" "standardGeneric" "rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
13 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
14 
+"make_comb_mat_from_matrix" "make_comb_mat"
15 
+"make_comb_mat_from_matrix" "make_comb_mat"
16 
+"make_comb_mat_from_matrix" "make_comb_mat"
17 
+"make_comb_mat_from_matrix" "make_comb_mat"
18 
+"make_comb_mat_from_matrix" "make_comb_mat"
19 
+"make_comb_mat_from_matrix" "make_comb_mat"
20 
+"make_comb_mat_from_matrix" "make_comb_mat"
21 
+"make_comb_mat_from_matrix" "make_comb_mat"
22 
+"paste" "FUN" "apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
23 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
24 
+"paste" "FUN" "apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
25 
+"paste" "FUN" "apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
26 
+"paste" "FUN" "apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
27 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
28 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
29 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
30 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
31 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
32 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
33 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
34 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
35 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
36 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
37 
+"paste" "FUN" "apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
38 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
39 
+"apply" "unique.matrix" "unique" "standardGeneric" "unique" "make_comb_mat_from_matrix" "make_comb_mat"
40 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
41 
+"FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
42 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
43 
+"rev" "standardGeneric" "rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
44 
+"rev" "standardGeneric" "rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
45 
+"rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
46 
+"FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
47 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
48 
+"standardGeneric" "rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
49 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
50 
+"FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
51 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
52 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
53 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
54 
+"rev" "standardGeneric" "rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
55 
+"rev" "standardGeneric" "rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
56 
+"standardGeneric" "rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
57 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
58 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
59 
+"rev" "standardGeneric" "rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
60 
+"rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
61 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
62 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
63 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
64 
+"rev" "standardGeneric" "rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
65 
+"rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
66 
+"apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
67 
+"rev.default" "rev" "standardGeneric" "rev" "FUN" "apply" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
68 
+"as.character" "factor" "base::table" "table" "eval" "eval" "standardGeneric" "eval" "standardGeneric" "table" "make_comb_mat_from_matrix" "make_comb_mat"
69 
+"is.factor" "unique.default" "FUN" "lapply" "summaryRprof"
tests/testthat/test-HeatmapList-class.R
History View file @ 36c3a37
... ... 
@@ -110,4 +110,3 @@ summary(ht_list[c("rnorm", "foo"), 1:5])
110 110
111 111
112 112
113 
-
tests/testthat/test-Legend.R
History View file @ 36c3a37
... ... 
@@ -231,3 +231,12 @@ lgd = Legend(col_fun = col_fun, title = "foo", at = c(0, 0.1, 0.5, 0.75, 1),
231 231 
 	direction = "horizontal")
232 232 
 draw(lgd, test = "unequal interval breaks with labels")
233 233
234 
+
235 
+#### position of legends to heatmaps ##
236 
+m = matrix(rnorm(100), 10)
237 
+rownames(m) = random_str(10, len = 20)
238 
+colnames(m) = random_str(10, len = 20)
239 
+Heatmap(m)
240 
+
241 
+
242 
+
tests/testthat/test-upset.R
History View file @ 36c3a37
234 243 
new file mode 100644
... ... 
@@ -0,0 +1,62 @@
1 
+set.seed(123)
2 
+lt = list(a = sample(letters, 10),
3 
+	      b = sample(letters, 15),
4 
+	      c = sample(letters, 20))
5 
+
6 
+m = make_comb_mat(lt)
7 
+t(m)
8 
+set_name(m)
9 
+comb_name(m)
10 
+set_size(m)
11 
+comb_size(m)
12 
+lapply(comb_name(m), function(x) extract_comb(m, x))
13 
+UpSet(m)
14 
+UpSet(t(m))
15 
+
16 
+set_name(t(m))
17 
+comb_name(t(m))
18 
+set_size(t(m))
19 
+comb_size(t(m))
20 
+lapply(comb_name(t(m)), function(x) extract_comb(t(m), x))
21 
+
22 
+m = make_comb_mat(lt, mode = "intersect")
23 
+lapply(comb_name(m), function(x) extract_comb(m, x))
24 
+UpSet(m)
25 
+
26 
+m = make_comb_mat(lt, mode = "union")
27 
+lapply(comb_name(m), function(x) extract_comb(m, x))
28 
+UpSet(m)
29 
+
30 
+
31 
+movies <- read.csv(system.file("extdata", "movies.csv", package = "UpSetR"),
32 
+    header = T, sep = ";")
33 
+m = make_comb_mat(movies, top_n_sets = 6)
34 
+t(m)
35 
+set_name(m)
36 
+comb_name(m)
37 
+set_size(m)
38 
+comb_size(m)
39 
+lapply(comb_name(m), function(x) extract_comb(m, x))
40 
+
41 
+set_name(t(m))
42 
+comb_name(t(m))
43 
+set_size(t(m))
44 
+comb_size(t(m))
45 
+lapply(comb_name(t(m)), function(x) extract_comb(t(m), x))
46 
+
47 
+UpSet(m)
48 
+UpSet(t(m))
49 
+
50 
+m = make_comb_mat(movies, top_n_sets = 6, mode = "intersect")
51 
+m = make_comb_mat(movies, top_n_sets = 6, mode = "union")
52 
+
53 
+
54 
+
55 
+library(circlize)
56 
+library(GenomicRanges)
57 
+lt = lapply(1:4, function(i) generateRandomBed())
58 
+lt = lapply(lt, function(df) GRanges(seqnames = df[, 1], ranges = IRanges(df[, 2], df[, 3])))
59 
+names(lt) = letters[1:4]
60 
+m = make_comb_mat(lt)
61 
+
62 
+