Browse code

add test_alter_fun()

Zuguang Gu authored on 31/01/2019 10:36:07
Showing7 changed files

... ...
@@ -2,7 +2,7 @@ Package: ComplexHeatmap
2 2
 Type: Package
3 3
 Title: Make Complex Heatmaps
4 4
 Version: 1.99.5
5
-Date: 2018-12-30
5
+Date: 2019-01-31
6 6
 Author: Zuguang Gu
7 7
 Maintainer: Zuguang Gu <z.gu@dkfz.de>
8 8
 Depends: R (>= 3.1.2), methods, grid, graphics, stats, grDevices
... ...
@@ -1,3 +1,3 @@
1
-YEAR: 2018
1
+YEAR: 2019
2 2
 COPYRIGHT HOLDER: Zuguang Gu
3 3
 
... ...
@@ -197,6 +197,7 @@ export("smartAlign2")
197 197
 export("subset_gp")
198 198
 export("subset_matrix_by_row")
199 199
 export("subset_vector")
200
+export("test_alter_fun")
200 201
 export("unify_mat_list")
201 202
 export("upset_right_annotation")
202 203
 export("upset_top_annotation")
... ...
@@ -2,6 +2,7 @@ CHANGES in VERSION 1.99.5
2 2
 
3 3
 * add `UpSet()` and some related functions to make Upset plots
4 4
 * fixed bugs of drawing legends
5
+* add `test_alter_fun()`
5 6
 
6 7
 ========================
7 8
 
... ...
@@ -615,7 +615,133 @@ guess_alter_fun_is_vectorized = function(alter_fun) {
615 615
 # == param
616 616
 # -x A strings which encode multiple altertations.
617 617
 #
618
+# == details
619
+# It recognizes following separators: ``;:,|``.
620
+#
618 621
 default_get_type = function(x) {
619 622
 	x = strsplit(x, "\\s*[;:,|]\\s*")[[1]]
620 623
 	x[!x %in% c("na", "NA")]
621 624
 }
625
+
626
+# == title
627
+# Test alter_fun for oncoPrint()
628
+#
629
+# == param
630
+# -fun The ``alter_fun`` for `oncoPrint`. The value can be a list of functions or a single function. See https://jokergoo.github.io/ComplexHeatmap-reference/book/oncoprint.html#define-the-alter-fun
631
+# -type A vector of alteration types. It is only used when ``fun`` is a single function.
632
+# -asp_ratio The aspect ratio (width/height) for the small rectangles.
633
+#
634
+# == details
635
+# This function helps you to have a quick view of how the graphics for each alteration type
636
+# and combinations look like.
637
+#
638
+# == example
639
+# alter_fun = list(
640
+# 	mut1 = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(fill = "red", col = NA)),
641
+# 	mut2 = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(fill = "blue", col = NA)),
642
+# 	mut3 = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(fill = "yellow", col = NA)),
643
+# 	mut4 = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(fill = "purple", col = NA)),
644
+# 	mut5 = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(lwd = 2)),
645
+# 	mut6 = function(x, y, w, h) grid.points(x, y, pch = 16),
646
+# 	mut7 = function(x, y, w, h) grid.segments(x - w*0.5, y - h*0.5, x + w*0.5, y + h*0.5, gp = gpar(lwd = 2))
647
+# )
648
+# test_alter_fun(alter_fun)
649
+test_alter_fun = function(fun, type, asp_ratio = 1) {
650
+	background_fun = NULL
651
+	if(inherits(fun, "list")) {
652
+		fun_type = "list"
653
+		type = names(fun)
654
+
655
+		if("background" %in% type) {
656
+			background_fun = fun$background
657
+		}
658
+		type = setdiff(type, "background")
659
+
660
+		if(length(type) == 0) {
661
+			stop_wrap("'type' should be of the names of the function list defined in `fun`.")
662
+		}
663
+
664
+		cat("`alter_fun` is defined as a list of functions.\n")
665
+		cat("Functions are defined for following alteration types:\n")
666
+		cat(paste(strwrap(paste(names(fun), collapse = ", "), initial = "  "), collapse = "\n"), "\n")
667
+		if(!is.null(background_fun)) {
668
+			cat("Background is also defined.\n")
669
+		}
670
+	} else{
671
+		fun_type = "function"
672
+		if(length(as.list(formals(fun))) != 5) {
673
+			stop_wrap("If `alter_fun` is defined as a single function, it needs to have five arguments. Check example at https://jokergoo.github.io/ComplexHeatmap-reference/book/oncoprint.html#define-the-alter-fun.")
674
+		}
675
+
676
+		if(missing(type)) {
677
+			stop_wrap("You need to provide a vector of alteration types for `type` argument to test.")
678
+		}
679
+
680
+		type = setdiff(type, "background")
681
+	}
682
+	
683
+	tl = lapply(type, function(x) x)
684
+	names(tl) = type
685
+	if(length(type) >= 2) {
686
+		tl2 = as.list(as.data.frame(combn(type, 2), stringsAsFactors = FALSE))
687
+	} else {
688
+		tl2 = NULL
689
+	}
690
+	if(length(type) >= 3) {
691
+		tl2 = c(tl2, as.list(as.data.frame(combn(type, 3), stringsAsFactors = FALSE)))
692
+	}
693
+
694
+	if(!is.null(tl2)) {
695
+		tl2 = tl2[sample(length(tl2), min(length(tl), length(tl2)), prob = sapply(tl2, length))]
696
+		tl2 = tl2[order(sapply(tl2, length))]
697
+		names(tl2) = sapply(tl2, paste, collapse = "+")
698
+	}
699
+
700
+	# draw the examples
701
+	grid_width = asp_ratio*max_text_height("A")*2
702
+	grid_height = max_text_height("A")*2 + unit(2, "mm")
703
+	text_width_1 = max_text_width(names(tl))
704
+	w = text_width_1 + unit(1, "mm") + grid_width
705
+	if(!is.null(tl2)) {
706
+		text_width_2 = max_text_width(names(tl2))
707
+		w = w + unit(5, "mm") + text_width_2 + unit(1, "mm") + grid_width
708
+	}
709
+	n = length(tl)
710
+	h = grid_height*n
711
+
712
+	grid.newpage()
713
+	pushViewport(viewport(width = w, height = h))
714
+	for(i in 1:n) {
715
+		grid.text(names(tl)[i], text_width_1, (n - i + 0.5)/n, just = "right")
716
+		if(is.null(background_fun)) {
717
+			grid.rect(text_width_1 + unit(1, "mm") + grid_width*0.5, unit((n - i + 0.5)/n, "npc"), grid_width, grid_height - unit(2, "mm"), gp = gpar(fill = "#CCCCCC", col = NA))
718
+		} else {
719
+			background_fun(text_width_1 + unit(1, "mm") + grid_width*0.5, unit((n - i + 0.5)/n, "npc"), grid_width, grid_height - unit(2, "mm"))
720
+		}
721
+		if(fun_type == "list") {
722
+			fun[[ tl[[i]] ]](text_width_1 + unit(1, "mm") + grid_width*0.5, unit((n - i + 0.5)/n, "npc"), grid_width, grid_height - unit(2, "mm"))
723
+		} else {
724
+			fun(text_width_1 + unit(1, "mm") + grid_width*0.5, unit((n - i + 0.5)/n, "npc"), grid_width, grid_height - unit(2, "mm"), tl[[i]])
725
+		}
726
+	}
727
+	if(!is.null(tl2)) {
728
+		n2 = length(tl2)
729
+		for(i in 1:n2) {
730
+			grid.text(names(tl2)[i], text_width_1 + unit(1, "mm") + grid_width + unit(5, "mm") + text_width_2, (n - i + 0.5)/n, just = "right")
731
+			if(is.null(background_fun)) {
732
+				grid.rect(text_width_1 + unit(2, "mm") + unit(5, "mm") + grid_width + text_width_2 + grid_width*0.5, unit((n - i + 0.5)/n, "npc"), grid_width, grid_height - unit(2, "mm"), gp = gpar(fill = "#CCCCCC", col = NA))
733
+			} else {
734
+				background_fun(text_width_1 + unit(2, "mm") + unit(5, "mm") + grid_width + text_width_2 + grid_width*0.5, unit((n - i + 0.5)/n, "npc"), grid_width, grid_height - unit(2, "mm"))
735
+			}
736
+			if(fun_type == "list") {
737
+				for(j in tl2[[i]]) {
738
+					fun[[ j ]](text_width_1 + unit(2, "mm") + unit(5, "mm") + grid_width + text_width_2 + grid_width*0.5, unit((n - i + 0.5)/n, "npc"), grid_width, grid_height - unit(2, "mm"))
739
+				}
740
+			} else {
741
+				fun(text_width_1 + unit(2, "mm") + grid_width + unit(5, "mm") + text_width_2 + grid_width*0.5, unit((n - i + 0.5)/n, "npc"), grid_width, grid_height - unit(2, "mm"), tl2[[i]])
742
+			}
743
+		}
744
+	}
745
+	popViewport()
746
+	
747
+}
... ...
@@ -13,6 +13,9 @@ default_get_type(x)
13 13
 
14 14
   \item{x}{A strings which encode multiple altertations.}
15 15
 
16
+}
17
+\details{
18
+It recognizes following separators: \code{;:,|}.
16 19
 }
17 20
 \examples{
18 21
 # There is no example
19 22
new file mode 100644
... ...
@@ -0,0 +1,34 @@
1
+\name{test_alter_fun}
2
+\alias{test_alter_fun}
3
+\title{
4
+Test alter_fun for oncoPrint()
5
+}
6
+\description{
7
+Test alter_fun for oncoPrint()
8
+}
9
+\usage{
10
+test_alter_fun(fun, type, asp_ratio = 1)
11
+}
12
+\arguments{
13
+
14
+  \item{fun}{The \code{alter_fun} for \code{\link{oncoPrint}}. The value can be a list of functions or a single function. See \url{https://jokergoo.github.io/ComplexHeatmap-reference/book/oncoprint.html#define-the-alter-fun}}
15
+  \item{type}{A vector of alteration types. It is only used when \code{fun} is a single function.}
16
+  \item{asp_ratio}{The aspect ratio (width/height) for the small rectangles.}
17
+
18
+}
19
+\details{
20
+This function helps you to have a quick view of how the graphics for each alteration type
21
+and combinations look like.
22
+}
23
+\examples{
24
+alter_fun = list(
25
+	mut1 = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(fill = "red", col = NA)),
26
+	mut2 = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(fill = "blue", col = NA)),
27
+	mut3 = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(fill = "yellow", col = NA)),
28
+	mut4 = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(fill = "purple", col = NA)),
29
+	mut5 = function(x, y, w, h) grid.rect(x, y, w, h, gp = gpar(lwd = 2)),
30
+	mut6 = function(x, y, w, h) grid.points(x, y, pch = 16),
31
+	mut7 = function(x, y, w, h) grid.segments(x - w*0.5, y - h*0.5, x + w*0.5, y + h*0.5, gp = gpar(lwd = 2))
32
+)
33
+test_alter_fun(alter_fun)
34
+}