Browse code

support gridtext

Zuguang Gu authored on 05/02/2020 07:34:10
Showing5 changed files

... ...
@@ -1,8 +1,8 @@
1 1
 Package: ComplexHeatmap
2 2
 Type: Package
3 3
 Title: Make Complex Heatmaps
4
-Version: 2.3.1
5
-Date: 2019-10-22
4
+Version: 2.3.2
5
+Date: 2020-02-05
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,9 @@
1
+CHANGES in VERSION 2.3.2
2
+
3
+* support gridtext
4
+
5
+========================
6
+
1 7
 CHANGES in VERSION 2.3.1
2 8
 
3 9
 * `anno_points()`: allows images as symbols.
... ...
@@ -2010,6 +2010,10 @@ anno_text = function(x, which = c("column", "row"), gp = gpar(),
2010 2010
 	offset = guess_location(), location = guess_location(),
2011 2011
 	width = NULL, height = NULL) {
2012 2012
 	
2013
+	if(inherits(x, "richtext_grob")) {
2014
+		return(anno_richtext(x, which = which, width = width, height = height))
2015
+	}
2016
+
2013 2017
 	ef = function() NULL
2014 2018
 	if(is.null(.ENV$current_annotation_which)) {
2015 2019
 		which = match.arg(which)[1]
... ...
@@ -2142,6 +2146,81 @@ anno_text = function(x, which = c("column", "row"), gp = gpar(),
2142 2146
 	return(anno)
2143 2147
 }
2144 2148
 
2149
+anno_richtext = function(x, which = c("column", "row"), width = NULL, height = NULL) {
2150
+
2151
+	ef = function() NULL
2152
+	if(is.null(.ENV$current_annotation_which)) {
2153
+		which = match.arg(which)[1]
2154
+		dev.null()
2155
+		ef = dev.off2
2156
+	} else {
2157
+		which = .ENV$current_annotation_which
2158
+	}
2159
+
2160
+	on.exit(ef())
2161
+
2162
+	n = length(x)
2163
+	
2164
+	if(which == "column") {
2165
+		if(missing(height)) {
2166
+			height = grobHeight(x)
2167
+			height = convertHeight(height, "mm")
2168
+		}
2169
+		if(missing(width)) {
2170
+			width = unit(1, "npc")
2171
+		}
2172
+	}
2173
+	if(which == "row") {
2174
+		if(missing(width)) {
2175
+			width = grobWidth(x)
2176
+			width = convertWidth(width, "mm")
2177
+		}
2178
+		if(missing(height)) {
2179
+			height = unit(1, "npc")
2180
+		}
2181
+	}
2182
+
2183
+	anno_size = list(width = width, height = height)
2184
+
2185
+	value = x
2186
+
2187
+	row_fun = function(index) {
2188
+		n = length(index)
2189
+		gb = value[index]
2190
+		gb = update_xy(gb, y = unit((n - seq_along(index) + 0.5)/n, "native"))
2191
+		grid.draw(gb)
2192
+	}
2193
+	column_fun = function(index, k = NULL, N = NULL, vp_name = NULL) {
2194
+		n = length(index)
2195
+		gb = value[index]
2196
+		gb = update_xy(gb, x = unit((seq_along(index) - 0.5)/n, "native"))
2197
+		grid.draw(gb)
2198
+	}
2199
+
2200
+	if(which == "row") {
2201
+		fun = row_fun
2202
+	} else if(which == "column") {
2203
+		fun = column_fun
2204
+	}
2205
+
2206
+	anno = AnnotationFunction(
2207
+		fun = fun,
2208
+		fun_name = "anno_richtext",
2209
+		which = which,
2210
+		width = width,
2211
+		height = height,
2212
+		n = n,
2213
+		var_import = list(value),
2214
+		show_name = FALSE
2215
+	)
2216
+
2217
+	anno@subset_rule$value = subset_vector
2218
+
2219
+	anno@subsetable = TRUE
2220
+
2221
+	return(anno)
2222
+}
2223
+
2145 2224
 # == title
2146 2225
 # Joyplot Annotation
2147 2226
 #
2148 2227
new file mode 100644
... ...
@@ -0,0 +1,106 @@
1
+`[.grob` = function(x, i) {
2
+	x2 = x
3
+	for(nm in SUBSETABLE_FIELDS[[ intersect(names(SUBSETABLE_FIELDS), class(x)) ]]) {
4
+		if(inherits(x2[[nm]], "gpar")) {
5
+			# change to the class defined here
6
+			class(x2[[nm]]) = "gpar"
7
+		}
8
+
9
+		if(length(x2[[nm]]) > 1) {
10
+			x2[[nm]] = x2[[nm]][i]
11
+		}
12
+	}
13
+	x2
14
+}
15
+
16
+`[.gpar` = function(x, i) {
17
+	lapply(x, function(y) {
18
+		if(length(y) > 1) {
19
+			y[i]
20
+		} else {
21
+			y
22
+		}
23
+	})
24
+}
25
+
26
+SUBSETABLE_FIELDS = list(
27
+	"text" = c("label", "x", "y", "gp"),
28
+	"richtext_grob" = c("gp", "children", "childrenOrder")
29
+)
30
+
31
+length.text = function(x) {
32
+	length(x$label)
33
+}
34
+
35
+length.richtext_grob = function(x) {
36
+	length(x$children)
37
+}
38
+
39
+update_xy = function (gb, x, y, ...) {
40
+	UseMethod("update_xy")
41
+}
42
+
43
+update_xy.text = function(gb, x, y, ...) {
44
+	n = length(gb$label)
45
+	if(!missing(x)) {
46
+		if(n > 1 & length(x) > 1 && n != length(x)) {
47
+			stop_wrap("Length of `x` should be the same as the length of labels.")
48
+		}
49
+		gb$x = x
50
+	}
51
+	if(!missing(y)) {
52
+		if(n > 1 & length(y) > 1 && n != length(y)) {
53
+			stop_wrap("Length of `y` should be the same as the length of labels.")
54
+		}
55
+		gb$y = y
56
+	}
57
+	gb
58
+}
59
+
60
+update_xy.richtext_grob = function(gb, x, y, ...) {
61
+	n = length(gb$children)
62
+
63
+	if(!missing(x)) {
64
+		if(n > 1 & length(x) > 1 && n != length(x)) {
65
+			stop_wrap("Length of `x` should be the same as the length of labels.")
66
+		}
67
+		for(i in 1:n) {
68
+			if(length(x) == 1) {
69
+				gb$children[[i]]$vp$x = x
70
+			} else {
71
+				gb$children[[i]]$vp$x = x[i]
72
+			}
73
+		}
74
+	}
75
+	if(!missing(y)) {
76
+		if(n > 1 & length(y) > 1 && n != length(y)) {
77
+			stop_wrap("Length of `y` should be the same as the length of labels.")
78
+		}
79
+		for(i in 1:n) {
80
+			if(length(y) == 1) {
81
+				gb$children[[i]]$vp$y = y
82
+			} else {
83
+				gb$children[[i]]$vp$y = y[i]
84
+			}
85
+		}
86
+	}
87
+	gb
88
+}
89
+
90
+textGrob = function(label, ...) {
91
+	if(inherits(label, "grob")) {
92
+		return(label)
93
+	} else {
94
+		grid::textGrob(label, ...)
95
+	}
96
+}
97
+
98
+grid.text = function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"), ...) {
99
+	if(inherits(label, "grob")) {
100
+		gb = label
101
+		gb = update_xy(gb, x, y)
102
+		grid.draw(gb)
103
+	} else {
104
+		grid::grid.text(label, x, y, ...)
105
+	}
106
+}
... ...
@@ -184,6 +184,12 @@ for(rot in seq(0, 360, by = 45)) {
184 184
 	draw(anno, test = paste0("rot =", rot))
185 185
 }
186 186
 
187
+##### test anno_richtext ####
188
+anno = anno_richtext(richtext_grob(month.name, box_gp = gpar(col = "red"), rot = 90, hjust = 1, y = unit(1, "npc")))
189
+draw(anno, test = "month names")
190
+anno = anno_richtext(richtext_grob(month.name, box_gp = gpar(col = "red"), hjust = 0, x = unit(0, "npc")), which = "row")
191
+draw(anno, test = "month names")
192
+
187 193
 
188 194
 
189 195
 ##### test anno_barplot #####