annotate Dotplot_Release/pheatmap_j.R @ 3:fcc56a8fc3a0 draft

Uploaded
author bornea
date Fri, 29 Jan 2016 09:57:59 -0500
parents dfa3436beb67
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
1 lo = function(rown, coln, nrow, ncol, cellheight = NA, cellwidth = NA, treeheight_col, treeheight_row, legend, annotation, annotation_colors, annotation_legend, main, fontsize, fontsize_row, fontsize_col, ...){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
2 # Get height of colnames and length of rownames
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
3 if(!is.null(coln[1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
4 longest_coln = which.max(strwidth(coln, units = 'in'))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
5 gp = list(fontsize = fontsize_col, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
6 coln_height = unit(1, "grobheight", textGrob(coln[longest_coln], rot = 90, gp = do.call(gpar, gp))) + unit(5, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
7 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
8 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
9 coln_height = unit(5, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
10 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
11
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
12 if(!is.null(rown[1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
13 longest_rown = which.max(strwidth(rown, units = 'in'))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
14 gp = list(fontsize = fontsize_row, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
15 rown_width = unit(1, "grobwidth", textGrob(rown[longest_rown], gp = do.call(gpar, gp))) + unit(10, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
16 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
17 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
18 rown_width = unit(5, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
19 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
20
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
21 gp = list(fontsize = fontsize, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
22 # Legend position
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
23 if(!is.na(legend[1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
24 longest_break = which.max(nchar(names(legend)))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
25 longest_break = unit(1.1, "grobwidth", textGrob(as.character(names(legend))[longest_break], gp = do.call(gpar, gp)))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
26 title_length = unit(1.1, "grobwidth", textGrob("Scale", gp = gpar(fontface = "bold", ...)))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
27 legend_width = unit(12, "bigpts") + longest_break * 1.2
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
28 legend_width = max(title_length, legend_width)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
29 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
30 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
31 legend_width = unit(0, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
32 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
33
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
34 # Set main title height
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
35 if(is.na(main)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
36 main_height = unit(0, "npc")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
37 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
38 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
39 main_height = unit(1.5, "grobheight", textGrob(main, gp = gpar(fontsize = 1.3 * fontsize, ...)))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
40 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
41
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
42 # Column annotations
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
43 if(!is.na(annotation[[1]][1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
44 # Column annotation height
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
45 annot_height = unit(ncol(annotation) * (8 + 2) + 2, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
46 # Width of the correponding legend
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
47 longest_ann = which.max(nchar(as.matrix(annotation)))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
48 annot_legend_width = unit(1.2, "grobwidth", textGrob(as.matrix(annotation)[longest_ann], gp = gpar(...))) + unit(12, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
49 if(!annotation_legend){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
50 annot_legend_width = unit(0, "npc")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
51 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
52 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
53 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
54 annot_height = unit(0, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
55 annot_legend_width = unit(0, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
56 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
57
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
58 # Tree height
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
59 treeheight_col = unit(treeheight_col, "bigpts") + unit(5, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
60 treeheight_row = unit(treeheight_row, "bigpts") + unit(5, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
61
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
62 # Set cell sizes
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
63 if(is.na(cellwidth)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
64 matwidth = unit(1, "npc") - rown_width - legend_width - treeheight_row - annot_legend_width
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
65 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
66 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
67 matwidth = unit(cellwidth * ncol, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
68 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
69
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
70 if(is.na(cellheight)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
71 matheight = unit(1, "npc") - main_height - coln_height - treeheight_col - annot_height
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
72 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
73 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
74 matheight = unit(cellheight * nrow, "bigpts")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
75 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
76
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
77
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
78 # Produce layout()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
79 pushViewport(viewport(layout = grid.layout(nrow = 5, ncol = 5, widths = unit.c(treeheight_row, matwidth, rown_width, legend_width, annot_legend_width), heights = unit.c(main_height, treeheight_col, annot_height, matheight, coln_height)), gp = do.call(gpar, gp)))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
80
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
81 # Get cell dimensions
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
82 pushViewport(vplayout(4, 2))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
83 cellwidth = convertWidth(unit(0:1, "npc"), "bigpts", valueOnly = T)[2] / ncol
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
84 cellheight = convertHeight(unit(0:1, "npc"), "bigpts", valueOnly = T)[2] / nrow
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
85 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
86
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
87 # Return minimal cell dimension in bigpts to decide if borders are drawn
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
88 mindim = min(cellwidth, cellheight)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
89 return(mindim)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
90 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
91
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
92 draw_dendrogram = function(hc, horizontal = T){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
93 h = hc$height / max(hc$height) / 1.05
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
94 m = hc$merge
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
95 o = hc$order
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
96 n = length(o)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
97
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
98 m[m > 0] = n + m[m > 0]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
99 m[m < 0] = abs(m[m < 0])
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
100
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
101 dist = matrix(0, nrow = 2 * n - 1, ncol = 2, dimnames = list(NULL, c("x", "y")))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
102 dist[1:n, 1] = 1 / n / 2 + (1 / n) * (match(1:n, o) - 1)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
103
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
104 for(i in 1:nrow(m)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
105 dist[n + i, 1] = (dist[m[i, 1], 1] + dist[m[i, 2], 1]) / 2
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
106 dist[n + i, 2] = h[i]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
107 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
108
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
109 draw_connection = function(x1, x2, y1, y2, y){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
110 grid.lines(x = c(x1, x1), y = c(y1, y))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
111 grid.lines(x = c(x2, x2), y = c(y2, y))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
112 grid.lines(x = c(x1, x2), y = c(y, y))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
113 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
114
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
115 if(horizontal){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
116 for(i in 1:nrow(m)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
117 draw_connection(dist[m[i, 1], 1], dist[m[i, 2], 1], dist[m[i, 1], 2], dist[m[i, 2], 2], h[i])
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
118 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
119 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
120
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
121 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
122 gr = rectGrob()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
123 pushViewport(viewport(height = unit(1, "grobwidth", gr), width = unit(1, "grobheight", gr), angle = 90))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
124 dist[, 1] = 1 - dist[, 1]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
125 for(i in 1:nrow(m)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
126 draw_connection(dist[m[i, 1], 1], dist[m[i, 2], 1], dist[m[i, 1], 2], dist[m[i, 2], 2], h[i])
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
127 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
128 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
129 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
130 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
131
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
132 draw_matrix = function(matrix, border_color, border_width, fmat, fontsize_number){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
133 n = nrow(matrix)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
134 m = ncol(matrix)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
135 x = (1:m)/m - 1/2/m
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
136 y = 1 - ((1:n)/n - 1/2/n)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
137 for(i in 1:m){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
138 grid.rect(x = x[i], y = y[1:n], width = 1/m, height = 1/n, gp = gpar(fill = matrix[,i], col = border_color, lwd = border_width))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
139 if(attr(fmat, "draw")){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
140 grid.text(x = x[i], y = y[1:n], label = fmat[, i], gp = gpar(col = "grey30", fontsize = fontsize_number))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
141 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
142 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
143 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
144
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
145 draw_colnames = function(coln, ...){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
146 m = length(coln)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
147 x = (1:m)/m - 1/2/m
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
148 grid.text(coln, x = x, y = unit(0.96, "npc"), just="right", rot = 90, gp = gpar(...))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
149 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
150
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
151 draw_rownames = function(rown, ...){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
152 n = length(rown)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
153 y = 1 - ((1:n)/n - 1/2/n)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
154 grid.text(rown, x = unit(0.04, "npc"), y = y, vjust = 0.5, hjust = 0, gp = gpar(...))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
155 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
156
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
157 draw_legend = function(color, breaks, legend, ...){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
158 height = min(unit(1, "npc"), unit(150, "bigpts"))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
159 pushViewport(viewport(x = 0, y = unit(1, "npc"), just = c(0, 1), height = height))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
160 legend_pos = (legend - min(breaks)) / (max(breaks) - min(breaks))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
161 breaks = (breaks - min(breaks)) / (max(breaks) - min(breaks))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
162 h = breaks[-1] - breaks[-length(breaks)]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
163 grid.rect(x = 0, y = breaks[-length(breaks)], width = unit(10, "bigpts"), height = h, hjust = 0, vjust = 0, gp = gpar(fill = color, col = "#FFFFFF00"))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
164 grid.text(names(legend), x = unit(12, "bigpts"), y = legend_pos, hjust = 0, gp = gpar(...))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
165 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
166 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
167
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
168 convert_annotations = function(annotation, annotation_colors){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
169 new = annotation
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
170 for(i in 1:ncol(annotation)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
171 a = annotation[, i]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
172 b = annotation_colors[[colnames(annotation)[i]]]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
173 if(is.character(a) | is.factor(a)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
174 a = as.character(a)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
175 if(length(setdiff(a, names(b))) > 0){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
176 stop(sprintf("Factor levels on variable %s do not match with annotation_colors", colnames(annotation)[i]))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
177 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
178 new[, i] = b[a]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
179 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
180 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
181 a = cut(a, breaks = 100)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
182 new[, i] = colorRampPalette(b)(100)[a]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
183 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
184 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
185 return(as.matrix(new))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
186 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
187
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
188 draw_annotations = function(converted_annotations, border_color, border_width){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
189 n = ncol(converted_annotations)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
190 m = nrow(converted_annotations)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
191 x = (1:m)/m - 1/2/m
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
192 y = cumsum(rep(8, n)) - 4 + cumsum(rep(2, n))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
193 for(i in 1:m){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
194 grid.rect(x = x[i], unit(y[1:n], "bigpts"), width = 1/m, height = unit(8, "bigpts"), gp = gpar(fill = converted_annotations[i, ], col = border_color, lwd = border_width))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
195 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
196 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
197
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
198 draw_annotation_legend = function(annotation, annotation_colors, border_color, border_width, ...){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
199 y = unit(1, "npc")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
200 text_height = unit(1, "grobheight", textGrob("FGH", gp = gpar(...)))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
201 for(i in names(annotation_colors)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
202 grid.text(i, x = 0, y = y, vjust = 1, hjust = 0, gp = gpar(fontface = "bold", ...))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
203 y = y - 1.5 * text_height
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
204 if(is.character(annotation[, i]) | is.factor(annotation[, i])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
205 for(j in 1:length(annotation_colors[[i]])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
206 grid.rect(x = unit(0, "npc"), y = y, hjust = 0, vjust = 1, height = text_height, width = text_height, gp = gpar(col = border_color, lwd = border_width, fill = annotation_colors[[i]][j]))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
207 grid.text(names(annotation_colors[[i]])[j], x = text_height * 1.3, y = y, hjust = 0, vjust = 1, gp = gpar(...))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
208 y = y - 1.5 * text_height
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
209 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
210 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
211 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
212 yy = y - 4 * text_height + seq(0, 1, 0.02) * 4 * text_height
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
213 h = 4 * text_height * 0.02
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
214 grid.rect(x = unit(0, "npc"), y = yy, hjust = 0, vjust = 1, height = h, width = text_height, gp = gpar(col = "#FFFFFF00", fill = colorRampPalette(annotation_colors[[i]])(50)))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
215 txt = rev(range(grid.pretty(range(annotation[, i], na.rm = TRUE))))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
216 yy = y - c(0, 3) * text_height
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
217 grid.text(txt, x = text_height * 1.3, y = yy, hjust = 0, vjust = 1, gp = gpar(...))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
218 y = y - 4.5 * text_height
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
219 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
220 y = y - 1.5 * text_height
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
221 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
222 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
223
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
224 draw_main = function(text, ...){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
225 grid.text(text, gp = gpar(fontface = "bold", ...))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
226 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
227
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
228 vplayout = function(x, y){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
229 return(viewport(layout.pos.row = x, layout.pos.col = y))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
230 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
231
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
232 heatmap_motor = function(matrix, border_color, border_width, cellwidth, cellheight, tree_col, tree_row, treeheight_col, treeheight_row, filename, width, height, breaks, color, legend, annotation, annotation_colors, annotation_legend, main, fontsize, fontsize_row, fontsize_col, fmat, fontsize_number, ...){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
233 grid.newpage()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
234
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
235 # Set layout
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
236 mindim = lo(coln = colnames(matrix), rown = rownames(matrix), nrow = nrow(matrix), ncol = ncol(matrix), cellwidth = cellwidth, cellheight = cellheight, treeheight_col = treeheight_col, treeheight_row = treeheight_row, legend = legend, annotation = annotation, annotation_colors = annotation_colors, annotation_legend = annotation_legend, main = main, fontsize = fontsize, fontsize_row = fontsize_row, fontsize_col = fontsize_col, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
237
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
238 if(!is.na(filename)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
239 pushViewport(vplayout(1:5, 1:5))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
240
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
241 if(is.na(height)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
242 height = convertHeight(unit(0:1, "npc"), "inches", valueOnly = T)[2]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
243 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
244 if(is.na(width)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
245 width = convertWidth(unit(0:1, "npc"), "inches", valueOnly = T)[2]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
246 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
247
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
248 # Get file type
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
249 r = regexpr("\\.[a-zA-Z]*$", filename)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
250 if(r == -1) stop("Improper filename")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
251 ending = substr(filename, r + 1, r + attr(r, "match.length"))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
252
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
253 f = switch(ending,
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
254 pdf = function(x, ...) pdf(x, ...),
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
255 png = function(x, ...) png(x, units = "in", res = 300, ...),
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
256 jpeg = function(x, ...) jpeg(x, units = "in", res = 300, ...),
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
257 jpg = function(x, ...) jpeg(x, units = "in", res = 300, ...),
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
258 tiff = function(x, ...) tiff(x, units = "in", res = 300, compression = "lzw", ...),
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
259 bmp = function(x, ...) bmp(x, units = "in", res = 300, ...),
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
260 stop("File type should be: pdf, png, bmp, jpg, tiff")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
261 )
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
262
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
263 # print(sprintf("height:%f width:%f", height, width))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
264 f(filename, height = height, width = width)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
265 heatmap_motor(matrix, cellwidth = cellwidth, cellheight = cellheight, border_color = border_color, border_width = border_width, tree_col = tree_col, tree_row = tree_row, treeheight_col = treeheight_col, treeheight_row = treeheight_row, breaks = breaks, color = color, legend = legend, annotation = annotation, annotation_colors = annotation_colors, annotation_legend = annotation_legend, filename = NA, main = main, fontsize = fontsize, fontsize_row = fontsize_row, fontsize_col = fontsize_col, fmat = fmat, fontsize_number = fontsize_number, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
266 dev.off()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
267 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
268 return()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
269 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
270
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
271 # Omit border color if cell size is too small
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
272 if(mindim < 3) border_color = NA
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
273
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
274 # Draw title
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
275 if(!is.na(main)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
276 pushViewport(vplayout(1, 2))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
277 draw_main(main, fontsize = 1.3 * fontsize, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
278 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
279 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
280
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
281 # Draw tree for the columns
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
282 if(!is.na(tree_col[[1]][1]) & treeheight_col != 0){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
283 pushViewport(vplayout(2, 2))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
284 draw_dendrogram(tree_col, horizontal = T)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
285 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
286 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
287
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
288 # Draw tree for the rows
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
289 if(!is.na(tree_row[[1]][1]) & treeheight_row != 0){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
290 pushViewport(vplayout(4, 1))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
291 draw_dendrogram(tree_row, horizontal = F)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
292 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
293 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
294
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
295 # Draw matrix
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
296 pushViewport(vplayout(4, 2))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
297 draw_matrix(matrix, border_color, border_width, fmat, fontsize_number)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
298 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
299
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
300 # Draw colnames
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
301 if(length(colnames(matrix)) != 0){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
302 pushViewport(vplayout(5, 2))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
303 pars = list(colnames(matrix), fontsize = fontsize_col, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
304 do.call(draw_colnames, pars)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
305 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
306 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
307
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
308 # Draw rownames
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
309 if(length(rownames(matrix)) != 0){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
310 pushViewport(vplayout(4, 3))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
311 pars = list(rownames(matrix), fontsize = fontsize_row, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
312 do.call(draw_rownames, pars)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
313 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
314 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
315
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
316 # Draw annotation tracks
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
317 if(!is.na(annotation[[1]][1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
318 pushViewport(vplayout(3, 2))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
319 converted_annotation = convert_annotations(annotation, annotation_colors)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
320 draw_annotations(converted_annotation, border_color, border_width)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
321 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
322 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
323
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
324 # Draw annotation legend
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
325 if(!is.na(annotation[[1]][1]) & annotation_legend){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
326 if(length(rownames(matrix)) != 0){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
327 pushViewport(vplayout(4:5, 5))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
328 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
329 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
330 pushViewport(vplayout(3:5, 5))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
331 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
332 draw_annotation_legend(annotation, annotation_colors, border_color, border_width, fontsize = fontsize, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
333 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
334 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
335
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
336 # Draw legend
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
337 if(!is.na(legend[1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
338 length(colnames(matrix))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
339 if(length(rownames(matrix)) != 0){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
340 pushViewport(vplayout(4:5, 4))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
341 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
342 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
343 pushViewport(vplayout(3:5, 4))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
344 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
345 draw_legend(color, breaks, legend, fontsize = fontsize, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
346 upViewport()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
347 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
348
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
349
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
350 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
351
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
352 generate_breaks = function(x, n, center = F){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
353 if(center){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
354 m = max(abs(c(min(x, na.rm = T), max(x, na.rm = T))))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
355 res = seq(-m, m, length.out = n + 1)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
356 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
357 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
358 res = seq(min(x, na.rm = T), max(x, na.rm = T), length.out = n + 1)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
359 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
360
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
361 return(res)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
362 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
363
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
364 scale_vec_colours = function(x, col = rainbow(10), breaks = NA){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
365 return(col[as.numeric(cut(x, breaks = breaks, include.lowest = T))])
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
366 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
367
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
368 scale_colours = function(mat, col = rainbow(10), breaks = NA){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
369 mat = as.matrix(mat)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
370 return(matrix(scale_vec_colours(as.vector(mat), col = col, breaks = breaks), nrow(mat), ncol(mat), dimnames = list(rownames(mat), colnames(mat))))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
371 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
372
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
373 cluster_mat = function(mat, distance, method){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
374 if(!(method %in% c("ward", "single", "complete", "average", "mcquitty", "median", "centroid"))){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
375 stop("clustering method has to one form the list: 'ward', 'single', 'complete', 'average', 'mcquitty', 'median' or 'centroid'.")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
376 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
377 if(!(distance[1] %in% c("correlation", "euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski")) & class(distance) != "dist"){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
378 print(!(distance[1] %in% c("correlation", "euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski")) | class(distance) != "dist")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
379 stop("distance has to be a dissimilarity structure as produced by dist or one measure form the list: 'correlation', 'euclidean', 'maximum', 'manhattan', 'canberra', 'binary', 'minkowski'")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
380 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
381 if(distance[1] == "correlation"){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
382 d = as.dist(1 - cor(t(mat)))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
383 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
384 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
385 if(class(distance) == "dist"){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
386 d = distance
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
387 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
388 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
389 d = dist(mat, method = distance)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
390 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
391 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
392
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
393 return(hclust(d, method = method))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
394 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
395
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
396 scale_rows = function(x){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
397 m = apply(x, 1, mean, na.rm = T)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
398 s = apply(x, 1, sd, na.rm = T)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
399 return((x - m) / s)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
400 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
401
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
402 scale_mat = function(mat, scale){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
403 if(!(scale %in% c("none", "row", "column"))){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
404 stop("scale argument shoud take values: 'none', 'row' or 'column'")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
405 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
406 mat = switch(scale, none = mat, row = scale_rows(mat), column = t(scale_rows(t(mat))))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
407 return(mat)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
408 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
409
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
410 generate_annotation_colours = function(annotation, annotation_colors, drop){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
411 if(is.na(annotation_colors)[[1]][1]){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
412 annotation_colors = list()
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
413 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
414 count = 0
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
415 for(i in 1:ncol(annotation)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
416 if(is.character(annotation[, i]) | is.factor(annotation[, i])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
417 if (is.factor(annotation[, i]) & !drop){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
418 count = count + length(levels(annotation[, i]))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
419 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
420 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
421 count = count + length(unique(annotation[, i]))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
422 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
423 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
424 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
425
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
426 factor_colors = hsv((seq(0, 1, length.out = count + 1)[-1] +
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
427 0.2)%%1, 0.7, 0.95)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
428
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
429 set.seed(3453)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
430
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
431 for(i in 1:ncol(annotation)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
432 if(!(colnames(annotation)[i] %in% names(annotation_colors))){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
433 if(is.character(annotation[, i]) | is.factor(annotation[, i])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
434 n = length(unique(annotation[, i]))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
435 if (is.factor(annotation[, i]) & !drop){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
436 n = length(levels(annotation[, i]))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
437 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
438 ind = sample(1:length(factor_colors), n)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
439 annotation_colors[[colnames(annotation)[i]]] = factor_colors[ind]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
440 l = levels(as.factor(annotation[, i]))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
441 l = l[l %in% unique(annotation[, i])]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
442 if (is.factor(annotation[, i]) & !drop){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
443 l = levels(annotation[, i])
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
444 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
445 names(annotation_colors[[colnames(annotation)[i]]]) = l
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
446 factor_colors = factor_colors[-ind]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
447 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
448 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
449 r = runif(1)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
450 annotation_colors[[colnames(annotation)[i]]] = hsv(r, c(0.1, 1), 1)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
451 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
452 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
453 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
454 return(annotation_colors)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
455 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
456
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
457 kmeans_pheatmap = function(mat, k = min(nrow(mat), 150), sd_limit = NA, ...){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
458 # Filter data
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
459 if(!is.na(sd_limit)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
460 s = apply(mat, 1, sd)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
461 mat = mat[s > sd_limit, ]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
462 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
463
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
464 # Cluster data
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
465 set.seed(1245678)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
466 km = kmeans(mat, k, iter.max = 100)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
467 mat2 = km$centers
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
468
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
469 # Compose rownames
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
470 t = table(km$cluster)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
471 rownames(mat2) = sprintf("cl%s_size_%d", names(t), t)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
472
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
473 # Draw heatmap
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
474 pheatmap(mat2, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
475 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
476
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
477 #' A function to draw clustered heatmaps.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
478 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
479 #' A function to draw clustered heatmaps where one has better control over some graphical
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
480 #' parameters such as cell size, etc.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
481 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
482 #' The function also allows to aggregate the rows using kmeans clustering. This is
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
483 #' advisable if number of rows is so big that R cannot handle their hierarchical
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
484 #' clustering anymore, roughly more than 1000. Instead of showing all the rows
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
485 #' separately one can cluster the rows in advance and show only the cluster centers.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
486 #' The number of clusters can be tuned with parameter kmeans_k.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
487 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
488 #' @param mat numeric matrix of the values to be plotted.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
489 #' @param color vector of colors used in heatmap.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
490 #' @param kmeans_k the number of kmeans clusters to make, if we want to agggregate the
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
491 #' rows before drawing heatmap. If NA then the rows are not aggregated.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
492 #' @param breaks a sequence of numbers that covers the range of values in mat and is one
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
493 #' element longer than color vector. Used for mapping values to colors. Useful, if needed
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
494 #' to map certain values to certain colors, to certain values. If value is NA then the
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
495 #' breaks are calculated automatically.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
496 #' @param border_color color of cell borders on heatmap, use NA if no border should be
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
497 #' drawn.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
498 #' @param cellwidth individual cell width in points. If left as NA, then the values
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
499 #' depend on the size of plotting window.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
500 #' @param cellheight individual cell height in points. If left as NA,
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
501 #' then the values depend on the size of plotting window.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
502 #' @param scale character indicating if the values should be centered and scaled in
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
503 #' either the row direction or the column direction, or none. Corresponding values are
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
504 #' \code{"row"}, \code{"column"} and \code{"none"}
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
505 #' @param cluster_rows boolean values determining if rows should be clustered,
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
506 #' @param cluster_cols boolean values determining if columns should be clustered.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
507 #' @param clustering_distance_rows distance measure used in clustering rows. Possible
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
508 #' values are \code{"correlation"} for Pearson correlation and all the distances
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
509 #' supported by \code{\link{dist}}, such as \code{"euclidean"}, etc. If the value is none
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
510 #' of the above it is assumed that a distance matrix is provided.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
511 #' @param clustering_distance_cols distance measure used in clustering columns. Possible
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
512 #' values the same as for clustering_distance_rows.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
513 #' @param clustering_method clustering method used. Accepts the same values as
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
514 #' \code{\link{hclust}}.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
515 #' @param treeheight_row the height of a tree for rows, if these are clustered.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
516 #' Default value 50 points.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
517 #' @param treeheight_col the height of a tree for columns, if these are clustered.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
518 #' Default value 50 points.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
519 #' @param legend logical to determine if legend should be drawn or not.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
520 #' @param legend_breaks vector of breakpoints for the legend.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
521 #' @param legend_labels vector of labels for the \code{legend_breaks}.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
522 #' @param annotation data frame that specifies the annotations shown on top of the
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
523 #' columns. Each row defines the features for a specific column. The columns in the data
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
524 #' and rows in the annotation are matched using corresponding row and column names. Note
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
525 #' that color schemes takes into account if variable is continuous or discrete.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
526 #' @param annotation_colors list for specifying annotation track colors manually. It is
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
527 #' possible to define the colors for only some of the features. Check examples for
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
528 #' details.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
529 #' @param annotation_legend boolean value showing if the legend for annotation tracks
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
530 #' should be drawn.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
531 #' @param drop_levels logical to determine if unused levels are also shown in the legend
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
532 #' @param show_rownames boolean specifying if column names are be shown.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
533 #' @param show_colnames boolean specifying if column names are be shown.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
534 #' @param main the title of the plot
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
535 #' @param fontsize base fontsize for the plot
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
536 #' @param fontsize_row fontsize for rownames (Default: fontsize)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
537 #' @param fontsize_col fontsize for colnames (Default: fontsize)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
538 #' @param display_numbers logical determining if the numeric values are also printed to
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
539 #' the cells.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
540 #' @param number_format format strings (C printf style) of the numbers shown in cells.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
541 #' For example "\code{\%.2f}" shows 2 decimal places and "\code{\%.1e}" shows exponential
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
542 #' notation (see more in \code{\link{sprintf}}).
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
543 #' @param fontsize_number fontsize of the numbers displayed in cells
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
544 #' @param filename file path where to save the picture. Filetype is decided by
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
545 #' the extension in the path. Currently following formats are supported: png, pdf, tiff,
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
546 #' bmp, jpeg. Even if the plot does not fit into the plotting window, the file size is
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
547 #' calculated so that the plot would fit there, unless specified otherwise.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
548 #' @param width manual option for determining the output file width in inches.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
549 #' @param height manual option for determining the output file height in inches.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
550 #' @param \dots graphical parameters for the text used in plot. Parameters passed to
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
551 #' \code{\link{grid.text}}, see \code{\link{gpar}}.
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
552 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
553 #' @return
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
554 #' Invisibly a list of components
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
555 #' \itemize{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
556 #' \item \code{tree_row} the clustering of rows as \code{\link{hclust}} object
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
557 #' \item \code{tree_col} the clustering of columns as \code{\link{hclust}} object
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
558 #' \item \code{kmeans} the kmeans clustering of rows if parameter \code{kmeans_k} was
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
559 #' specified
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
560 #' }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
561 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
562 #' @author Raivo Kolde <rkolde@@gmail.com>
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
563 #' @examples
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
564 #' # Generate some data
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
565 #' test = matrix(rnorm(200), 20, 10)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
566 #' test[1:10, seq(1, 10, 2)] = test[1:10, seq(1, 10, 2)] + 3
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
567 #' test[11:20, seq(2, 10, 2)] = test[11:20, seq(2, 10, 2)] + 2
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
568 #' test[15:20, seq(2, 10, 2)] = test[15:20, seq(2, 10, 2)] + 4
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
569 #' colnames(test) = paste("Test", 1:10, sep = "")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
570 #' rownames(test) = paste("Gene", 1:20, sep = "")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
571 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
572 #' # Draw heatmaps
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
573 #' pheatmap(test)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
574 #' pheatmap(test, kmeans_k = 2)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
575 #' pheatmap(test, scale = "row", clustering_distance_rows = "correlation")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
576 #' pheatmap(test, color = colorRampPalette(c("navy", "white", "firebrick3"))(50))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
577 #' pheatmap(test, cluster_row = FALSE)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
578 #' pheatmap(test, legend = FALSE)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
579 #' pheatmap(test, display_numbers = TRUE)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
580 #' pheatmap(test, display_numbers = TRUE, number_format = "%.1e")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
581 #' pheatmap(test, cluster_row = FALSE, legend_breaks = -1:4, legend_labels = c("0",
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
582 #' "1e-4", "1e-3", "1e-2", "1e-1", "1"))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
583 #' pheatmap(test, cellwidth = 15, cellheight = 12, main = "Example heatmap")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
584 #' pheatmap(test, cellwidth = 15, cellheight = 12, fontsize = 8, filename = "test.pdf")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
585 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
586 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
587 #' # Generate column annotations
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
588 #' annotation = data.frame(Var1 = factor(1:10 %% 2 == 0,
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
589 #' labels = c("Class1", "Class2")), Var2 = 1:10)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
590 #' annotation$Var1 = factor(annotation$Var1, levels = c("Class1", "Class2", "Class3"))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
591 #' rownames(annotation) = paste("Test", 1:10, sep = "")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
592 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
593 #' pheatmap(test, annotation = annotation)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
594 #' pheatmap(test, annotation = annotation, annotation_legend = FALSE)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
595 #' pheatmap(test, annotation = annotation, annotation_legend = FALSE, drop_levels = FALSE)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
596 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
597 #' # Specify colors
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
598 #' Var1 = c("navy", "darkgreen")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
599 #' names(Var1) = c("Class1", "Class2")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
600 #' Var2 = c("lightgreen", "navy")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
601 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
602 #' ann_colors = list(Var1 = Var1, Var2 = Var2)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
603 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
604 #' pheatmap(test, annotation = annotation, annotation_colors = ann_colors, main = "Example")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
605 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
606 #' # Specifying clustering from distance matrix
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
607 #' drows = dist(test, method = "minkowski")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
608 #' dcols = dist(t(test), method = "minkowski")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
609 #' pheatmap(test, clustering_distance_rows = drows, clustering_distance_cols = dcols)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
610 #'
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
611 #' @export
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
612 pheatmap_j = function(mat, color = colorRampPalette(rev(brewer.pal(n = 7, name = "RdYlBu")))(100), kmeans_k = NA, breaks = NA, border_color = "grey60", border_width = 1, cellwidth = NA, cellheight = NA, scale = "none", cluster_rows = TRUE, cluster_cols = TRUE, clustering_distance_rows = "euclidean", clustering_distance_cols = "euclidean", clustering_method = "complete", treeheight_row = ifelse(cluster_rows, 50, 0), treeheight_col = ifelse(cluster_cols, 50, 0), legend = TRUE, legend_breaks = NA, legend_labels = NA, annotation = NA, annotation_colors = NA, annotation_legend = TRUE, drop_levels = TRUE, show_rownames = T, show_colnames = T, main = NA, fontsize = 10, fontsize_row = fontsize, fontsize_col = fontsize, display_numbers = F, number_format = "%.2f", fontsize_number = 0.8 * fontsize, filename = NA, width = NA, height = NA, ...){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
613
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
614 # Preprocess matrix
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
615 mat = as.matrix(mat)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
616 if(scale != "none"){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
617 mat = scale_mat(mat, scale)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
618 if(is.na(breaks)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
619 breaks = generate_breaks(mat, length(color), center = T)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
620 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
621 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
622
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
623
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
624 # Kmeans
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
625 if(!is.na(kmeans_k)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
626 # Cluster data
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
627 km = kmeans(mat, kmeans_k, iter.max = 100)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
628 mat = km$centers
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
629
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
630 # Compose rownames
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
631 t = table(km$cluster)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
632 rownames(mat) = sprintf("cl%s_size_%d", names(t), t)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
633 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
634 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
635 km = NA
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
636 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
637
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
638 # Do clustering
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
639 if(cluster_rows){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
640 tree_row = cluster_mat(mat, distance = clustering_distance_rows, method = clustering_method)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
641 mat = mat[tree_row$order, , drop = FALSE]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
642 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
643 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
644 tree_row = NA
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
645 treeheight_row = 0
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
646 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
647
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
648 if(cluster_cols){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
649 tree_col = cluster_mat(t(mat), distance = clustering_distance_cols, method = clustering_method)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
650 mat = mat[, tree_col$order, drop = FALSE]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
651 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
652 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
653 tree_col = NA
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
654 treeheight_col = 0
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
655 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
656
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
657 # Format numbers to be displayed in cells
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
658 if(display_numbers){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
659 fmat = matrix(sprintf(number_format, mat), nrow = nrow(mat), ncol = ncol(mat))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
660 attr(fmat, "draw") = TRUE
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
661 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
662 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
663 fmat = matrix(NA, nrow = nrow(mat), ncol = ncol(mat))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
664 attr(fmat, "draw") = FALSE
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
665 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
666
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
667
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
668 # Colors and scales
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
669 if(!is.na(legend_breaks[1]) & !is.na(legend_labels[1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
670 if(length(legend_breaks) != length(legend_labels)){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
671 stop("Lengths of legend_breaks and legend_labels must be the same")
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
672 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
673 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
674
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
675
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
676 if(is.na(breaks[1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
677 breaks = generate_breaks(as.vector(mat), length(color))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
678 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
679 if (legend & is.na(legend_breaks[1])) {
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
680 legend = grid.pretty(range(as.vector(breaks)))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
681 names(legend) = legend
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
682 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
683 else if(legend & !is.na(legend_breaks[1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
684 legend = legend_breaks[legend_breaks >= min(breaks) & legend_breaks <= max(breaks)]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
685
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
686 if(!is.na(legend_labels[1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
687 legend_labels = legend_labels[legend_breaks >= min(breaks) & legend_breaks <= max(breaks)]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
688 names(legend) = legend_labels
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
689 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
690 else{
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
691 names(legend) = legend
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
692 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
693 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
694 else {
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
695 legend = NA
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
696 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
697 mat = scale_colours(mat, col = color, breaks = breaks)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
698
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
699 # Preparing annotation colors
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
700 if(!is.na(annotation[[1]][1])){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
701 annotation = annotation[colnames(mat), , drop = F]
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
702 annotation_colors = generate_annotation_colours(annotation, annotation_colors, drop = drop_levels)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
703 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
704
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
705 if(!show_rownames){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
706 rownames(mat) = NULL
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
707 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
708
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
709 if(!show_colnames){
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
710 colnames(mat) = NULL
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
711 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
712
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
713 # Draw heatmap
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
714 heatmap_motor(mat, border_color = border_color, border_width = border_width, cellwidth = cellwidth, cellheight = cellheight, treeheight_col = treeheight_col, treeheight_row = treeheight_row, tree_col = tree_col, tree_row = tree_row, filename = filename, width = width, height = height, breaks = breaks, color = color, legend = legend, annotation = annotation, annotation_colors = annotation_colors, annotation_legend = annotation_legend, main = main, fontsize = fontsize, fontsize_row = fontsize_row, fontsize_col = fontsize_col, fmat = fmat, fontsize_number = fontsize_number, ...)
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
715
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
716 invisible(list(tree_row = tree_row, tree_col = tree_col, kmeans = km))
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
717 }
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
718
dfa3436beb67 Uploaded
bornea
parents:
diff changeset
719