Browse code

Merge branch 'master' into devel

git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ComplexHeatmap@108530 bc3139a8-67e5-0310-9ffc-ced21a209358

z.gu authored on 15/09/2015 19:38:08
Showing 5 changed files

... ...
@@ -5,7 +5,7 @@ Version: 1.4.2
5 5
 Date: 2015-9-14
6 6
 Author: Zuguang Gu
7 7
 Maintainer: Zuguang Gu <z.gu@dkfz.de>
8
-Depends: R (>= 3.1.2), grid, graphics, stats, grDevices
8
+Depends: R (>= 3.1.0), grid, graphics, stats, grDevices
9 9
 Imports: methods, circlize (>= 0.3.1), GetoptLong, colorspace,
10 10
     RColorBrewer, dendextend (>= 1.0.1), GlobalOptions (>= 0.0.6)
11 11
 Suggests: testthat (>= 0.3), knitr, markdown, cluster, MASS, pvclust, 
... ...
@@ -1,5 +1,6 @@
1 1
 CHANGES in VERSION 1.4.2
2 2
 
3
+* order of annotations can be adjusted arbitrarily
3 4
 * anno_barplot: scales are adjusted according to the baseline
4 5
 
5 6
 ===================================
... ...
@@ -67,7 +67,7 @@ HeatmapAnnotation = setClass("HeatmapAnnotation",
67 67
 #
68 68
 HeatmapAnnotation = function(df, name, col, 
69 69
 	annotation_legend_param = list(), 
70
-	show_legend = rep(TRUE, n_anno), 
70
+	show_legend = TRUE, 
71 71
 	..., 
72 72
 	which = c("column", "row"), 
73 73
 	annotation_height = 1, 
... ...
@@ -90,84 +90,117 @@ HeatmapAnnotation = function(df, name, col,
90 90
 	.Object@name = name
91 91
 	n_anno = 0
92 92
 
93
-	if(!missing(df)) {
94
-		if(is.null(colnames(df))) {
95
-	        stop("`df` should have column names.")
96
-	    }
97
-
98
-	    anno_name = colnames(df)
99
-	    n_anno = ncol(df)
100
-
101
-	    if(length(show_legend) == 1) {
102
-	    	show_legend = rep(show_legend, n_anno)
103
-	    }
104
-
105
-	    if(length(annotation_legend_param) == 0) {
106
-	    	annotation_legend_param = rep.list(NULL, n_anno)
107
-	    } else if(inherits(annotation_legend_param, "list")) {
108
-	    	if(all(sapply(annotation_legend_param, inherits, "list"))) {  # if it is a list of lists
109
-	    		nl = length(annotation_legend_param)
110
-	    		if(nl > n_anno) {
111
-	    			stop("Amount of legend params is larger than the number of simple annotations.")
112
-	    		}
113
-	    		if(is.null(names(annotation_legend_param))) {
114
-	    			names(annotation_legend_param) = anno_name[seq_len(nl)]
115
-	    		} else if(length(setdiff(names(annotation_legend_param), anno_name))) {
116
-	    			stop("Some names in 'annotation_legend_param' are not in names of simple annotations.")
117
-	    		} else {
118
-	    			annotation_legend_param = annotation_legend_param[ intersect(anno_name, names(annotation_legend_param)) ]
119
-	    		}
120
-	    		lp = rep.list(NULL, n_anno)
121
-
122
-	    		names(lp) = anno_name
123
-	    		for(i in seq_along(lp)) {
124
-	    			lp[[i]] = annotation_legend_param[[i]]
125
-	    		}
126
-	    		annotation_legend_param = lp
127
-	    	} else {
128
-	    		annotation_legend_param = rep.list(annotation_legend_param, n_anno)
129
-	    	}
130
-	    }
131
-
132
-
133
-	    if(missing(col)) {
134
-	        for(i in seq_len(n_anno)) {
135
-	        	anno_list = c(anno_list, list(SingleAnnotation(name = anno_name[i], value = df[, i], which = which, show_legend = show_legend[i], gp = gp, legend_param = annotation_legend_param[[i]])))
136
-	        }
137
-	    } else {
138
-	        for(i in seq_len(n_anno)) {
139
-	        	if(is.null(col[[ anno_name[i] ]])) { # if the color is not provided
140
-	        		anno_list = c(anno_list, list(SingleAnnotation(name = anno_name[i], value = df[, i], which = which, show_legend = show_legend[i], gp = gp, legend_param = annotation_legend_param[[i]])))
141
-	        	} else {
142
-	        		anno_list = c(anno_list, list(SingleAnnotation(name = anno_name[i], value = df[, i], col = col[[ anno_name[i] ]], which = which, show_legend = show_legend[i], gp = gp, legend_param = annotation_legend_param[[i]])))
143
-	        	}
144
-	        }
145
-	    }
93
+    arg_list = as.list(match.call())[-1]
94
+    called_args = names(arg_list)
95
+    anno_args = setdiff(called_args, c("name", "col", "annotation_legend_param", "show_legend", "which", 
96
+    	                             "annotation_height", "annotation_width", "height", "width", "gp", "gap"))
97
+    if(any(anno_args == "")) stop("annotations should have names.")
98
+    if(any(duplicated(anno_args))) stop("names of annotations should be unique.")
99
+    anno_arg_list = list(...)
100
+    if(length(anno_arg_list)) {
101
+	    n_simple_anno = {if("df" %in% anno_args) ncol(df) else 0} + sum(sapply(anno_arg_list, is.atomic))
102
+	    simple_anno_name = c({if("df" %in% anno_args) colnames(df) else NULL}, anno_args[sapply(anno_arg_list, is.atomic)])
103
+	} else {
104
+		n_simple_anno = {if("df" %in% anno_args) ncol(df) else 0}
105
+	    simple_anno_name = {if("df" %in% anno_args) colnames(df) else NULL}
146 106
 	}
147
-	if(which == "column") {
148
-		anno_list = rev(anno_list)
107
+
108
+    if(any(duplicated(simple_anno_name))) stop("names of simple annotations should be unique.")
109
+
110
+    # normalize `show_legend`
111
+    if(length(show_legend) == 1) {
112
+		show_legend = rep(show_legend, n_simple_anno)
149 113
 	}
150 114
 
151
-	# self-defined anntatoin graph are passed by a list of named functions
152
-	fun_list = list(...)
153
-	if(length(fun_list)) {
154
-		if(! all(sapply(fun_list, is.function))) {
155
-			stop("`...` should only contains functions.")
115
+	# normalize `heatmap_legend_param`
116
+	if(length(annotation_legend_param) == 0) {
117
+		annotation_legend_param = rep.list(NULL, n_simple_anno)
118
+	} else if(inherits(annotation_legend_param, "list")) {
119
+		if(all(sapply(annotation_legend_param, inherits, "list"))) {  # if it is a list of lists
120
+			nl = length(annotation_legend_param)
121
+			if(nl > n_simple_anno) {
122
+				stop("Amount of legend params is larger than the number of simple annotations.")
123
+			}
124
+			if(is.null(names(annotation_legend_param))) {
125
+				names(annotation_legend_param) = simple_anno_name[seq_len(nl)]
126
+			} else if(length(setdiff(names(annotation_legend_param), simple_anno_name))) {
127
+				stop("Some names in 'annotation_legend_param' are not in names of simple annotations.")
128
+			} else {
129
+				annotation_legend_param = annotation_legend_param[ intersect(simple_anno_name, names(annotation_legend_param)) ]
130
+			}
131
+			lp = rep.list(NULL, n_simple_anno)
132
+
133
+			names(lp) = simple_anno_name
134
+			for(i in seq_along(lp)) {
135
+				lp[[i]] = annotation_legend_param[[i]]
136
+			}
137
+			annotation_legend_param = lp
138
+		} else {
139
+			annotation_legend_param = rep.list(annotation_legend_param, n_simple_anno)
156 140
 		}
141
+	}
157 142
 
158
-		fun_name = names(fun_list)
159
-		if(is.null(fun_name)) {
160
-			stop("functions should be specified as named arguments.")
161
-		}
162
-		if(any(fun_name %in% c("df", "col", "show_legend", "which", "height", "width", "annotation_height", "annotation_width", "gp", "color_bar"))) {
163
-			stop("function names should be same as other argument names.")
164
-		}
165
-			
166
-		for(i in seq_along(fun_name)) {
167
-			anno_list = c(anno_list, list(SingleAnnotation(name = fun_name[i], fun = fun_list[[i]], which = which)))
143
+	i_simple = 0
144
+	simple_length = NULL
145
+    for(ag in anno_args) {
146
+		if(ag == "df") {
147
+			if(is.null(colnames(df))) {
148
+		        stop("`df` should have column names.")
149
+		    }
150
+		    if(is.null(simple_length)) {
151
+		    	simple_length = nrow(df)
152
+		    } else if(nrow(df) != simple_length) {
153
+		    	stop("length of simple annotations differ.")
154
+		    }
155
+
156
+		    anno_name = colnames(df)
157
+		    n_anno = ncol(df)
158
+
159
+		    if(missing(col)) {
160
+		        for(i in seq_len(n_anno)) {
161
+		        	anno_list = c(anno_list, list(SingleAnnotation(name = anno_name[i], value = df[, i], which = which, show_legend = show_legend[i_simple + i], gp = gp, legend_param = annotation_legend_param[[i_simple + i]])))
162
+		        }
163
+		    } else {
164
+		        for(i in seq_len(n_anno)) {
165
+		        	if(is.null(col[[ anno_name[i] ]])) { # if the color is not provided
166
+		        		anno_list = c(anno_list, list(SingleAnnotation(name = anno_name[i], value = df[, i], which = which, show_legend = show_legend[i_simple + i], gp = gp, legend_param = annotation_legend_param[[i_simple + i]])))
167
+		        	} else {
168
+		        		anno_list = c(anno_list, list(SingleAnnotation(name = anno_name[i], value = df[, i], col = col[[ anno_name[i] ]], which = which, show_legend = show_legend[i_simple + i], gp = gp, legend_param = annotation_legend_param[[i_simple + i]])))
169
+		        	}
170
+		        }
171
+		    }
172
+		    i_simple = i_simple + n_anno
173
+		} else {
174
+			if(inherits(anno_arg_list[[ag]], "function")) {
175
+				anno_list = c(anno_list, list(SingleAnnotation(name = ag, fun = anno_arg_list[[ag]], which = which)))
176
+			} else if(is.atomic(anno_arg_list[[ag]])) {
177
+
178
+			    if(is.null(simple_length)) {
179
+			    	simple_length = length(anno_arg_list[[ag]])
180
+			    } else if(length(anno_arg_list[[ag]]) != simple_length) {
181
+			    	stop("length of simple annotations differ.")
182
+			    }
183
+
184
+				if(missing(col)) {
185
+			        anno_list = c(anno_list, list(SingleAnnotation(name = ag, value = anno_arg_list[[ag]], which = which, show_legend = show_legend[i_simple + 1], gp = gp, legend_param = annotation_legend_param[[i_simple + 1]])))
186
+			    } else {
187
+			        if(is.null(col[[ ag ]])) { # if the color is not provided
188
+			        	anno_list = c(anno_list, list(SingleAnnotation(name = ag, value = anno_arg_list[[ag]], which = which, show_legend = show_legend[i_simple + 1], gp = gp, legend_param = annotation_legend_param[[i_simple + 1]])))
189
+			        } else {
190
+			        	anno_list = c(anno_list, list(SingleAnnotation(name = ag, value = anno_arg_list[[ag]], col = col[[ ag ]], which = which, show_legend = show_legend[i_simple + 1], gp = gp, legend_param = annotation_legend_param[[i_simple + 1]])))
191
+			        }
192
+			    }
193
+			    i_simple = i_simple + 1
194
+			} else {
195
+				stop("additional arguments should be annotation vectors or annotation functions.")
196
+			} 
168 197
 		}
169 198
 	}
170 199
 
200
+	if(which == "column") {
201
+		anno_list = rev(anno_list)
202
+	}
203
+
171 204
 	n_anno = length(anno_list)
172 205
 
173 206
 	if(is.null(gap)) gap = unit(0, "mm")
... ...
@@ -9,7 +9,7 @@ Constructor method for HeatmapAnnotation class
9 9
 \usage{
10 10
 HeatmapAnnotation(df, name, col,
11 11
     annotation_legend_param = list(),
12
-    show_legend = rep(TRUE, n_anno),
12
+    show_legend = TRUE,
13 13
     ...,
14 14
     which = c("column", "row"),
15 15
     annotation_height = 1,
... ...
@@ -89,6 +89,18 @@ ha
89 89
 draw(ha, 1:10)
90 90
 ```
91 91
 
92
+Also individual annotations can be specified as vectors:
93
+
94
+```{r heatmap_annotation_vector, fig.width = 7, fig.height = 1}
95
+ha = HeatmapAnnotation(type = c(rep("a", 5), rep("b", 5)),
96
+                       age = sample(1:20, 10),
97
+    col = list(type = c("a" = "red", "b" = "blue"),
98
+               age = colorRamp2(c(0, 20), c("white", "red")))
99
+)
100
+ha
101
+draw(ha, 1:10)
102
+```
103
+
92 104
 To put column annotation to the heatmap, specify `top_annotation` and `bottom_annotation` in `Heatmap()`.
93 105
 
94 106
 ```{r heatmap_column_annotation}
... ...
@@ -179,6 +191,19 @@ ha
179 191
 draw(ha, 1:10)
180 192
 ```
181 193
 
194
+Since simple annotations can also be specified as vectors, actually you arrange annotations in any order:
195
+
196
+```{r, fig.width = 7, fig.height = 2}
197
+ha = HeatmapAnnotation(type = c(rep("a", 5), rep("b", 5)),
198
+                       points = anno_points(value),
199
+                       age = sample(1:20, 10), 
200
+                       bars = anno_barplot(value),
201
+    col = list(type = c("a" = "red", "b" = "blue"),
202
+               age = colorRamp2(c(0, 20), c("white", "red"))))
203
+ha
204
+draw(ha, 1:10)
205
+```
206
+
182 207
 For some of the `anno_*` functions, graphic parameters can be set by `gp` argument.
183 208
 Also note how we specify `baseline` in `anno_barplot()`.
184 209