Browse code

add tRanslatome package

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/tRanslatome@77226 bc3139a8-67e5-0310-9ffc-ced21a209358

Martin Morgan authored on 05/06/2013 23:20:36
Showing1 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,235 @@
1
+## Class declaration
2
+###############################################################################
3
+
4
+setClass("EnrichedSets", representation(enriched.table="data.frame", 
5
+																				label.level.enriched="character"))
6
+
7
+
8
+## Generics declaration (getters, setters and methods)
9
+###############################################################################
10
+
11
+setGeneric("enriched.table", signature="object", 
12
+          function(object) standardGeneric("enriched.table"))
13
+          
14
+setGeneric("label.level.enriched", signature="object", 
15
+          function(object) standardGeneric("label.level.enriched"))
16
+
17
+setGeneric("Radar", signature="object", 
18
+          function(object, outputformat="on screen",
19
+                   n.nodes.1stlevel="5", n.nodes.2ndlevel="5", mult.cor=TRUE, ...) 
20
+          standardGeneric("Radar"))
21
+          
22
+setGeneric("Heatmap", signature="object", 
23
+          function(object, outputformat="on screen", 
24
+                   n.nodes.1stlevel="5", n.nodes.2ndlevel="5", mult.cor=TRUE, ...)
25
+          standardGeneric("Heatmap"))
26
+ 
27
+
28
+## Implementation of getters
29
+###############################################################################
30
+
31
+setMethod("enriched.table", "EnrichedSets",
32
+	function(object) {
33
+		object@enriched.table
34
+	}
35
+)
36
+
37
+setMethod("label.level.enriched", "EnrichedSets",
38
+	function(object) {
39
+		object@label.level.enriched
40
+	}
41
+)
42
+
43
+
44
+## Methods implementation
45
+###############################################################################
46
+
47
+setMethod("show", "EnrichedSets",
48
+	function(object) {
49
+		print(apply(object@enriched.table, c(1,2), function(x){
50
+							if(nchar(x) > 30) 
51
+								return(paste(substr(x,1,30),"...",sep=""))
52
+							else
53
+								return(x)
54
+							})
55
+				 )
56
+		print(object@label.level.enriched)
57
+	}
58
+)
59
+
60
+
61
+setMethod("Radar", "EnrichedSets", 
62
+	function(object, outputformat="on screen", 
63
+           n.nodes.1stlevel="5", n.nodes.2ndlevel="5", mult.cor=TRUE) {
64
+	
65
+		pvalList1stlevel <- NULL
66
+		pvalList2ndlevel <- NULL
67
+
68
+		if (outputformat == "pdf") pdf(file="Enrichment.Radar.pdf")
69
+		if (outputformat == "postscript") postscript(file="Enrichment.Radar.ps")
70
+		if (outputformat == "jpeg") 
71
+      jpeg(filename="Enrichment.Radar.jpeg", width = 650, height = 500, 
72
+					 units = "px", pointsize = 12, bg = "transparent")
73
+		if (outputformat == "png") 
74
+			png(filename="Enrichment.Radar.png", width = 650, height = 500, 
75
+					units = "px", pointsize = 12, bg = "transparent")
76
+
77
+		Atable <- enriched.table(object)[,c("level","ID","list","pv.fisher") ]
78
+		if (mult.cor) 
79
+			Atable <- enriched.table(object)[,c("level","ID","list", "pv.fisher.BH") ] 	 
80
+
81
+		indexfirst <- apply(Atable, 1, 
82
+												function(row) all(label.level.enriched(object)[1] %in% row))
83
+		indexsecond <- apply(Atable, 1, 
84
+												function(row) all(label.level.enriched(object)[2] %in% row))
85
+		List1stlevel <- Atable[indexfirst, -c(1)] 
86
+		List2ndlevel <- Atable[indexsecond, -c(1)]
87
+
88
+		uniquelist <- unique(c(List1stlevel[1:n.nodes.1stlevel,"ID"], 
89
+												   List2ndlevel[1:n.nodes.2ndlevel,"ID"]))
90
+		uniquelist <- uniquelist[!is.na(uniquelist)]
91
+
92
+		if (length(List1stlevel[,1]) == 0 | length(List2ndlevel[,1]) == 0) {
93
+			print("One of the lists is empty!")
94
+		}
95
+		else {
96
+			for(i in 1:length(uniquelist)) {
97
+				print(uniquelist[i])
98
+				
99
+				if ((uniquelist[i] %in% List1stlevel[,"ID"]) == TRUE) {
100
+					pvalList1stlevel <- c(pvalList1stlevel, List1stlevel[
101
+																which(List1stlevel[,"ID"] == uniquelist[i]),
102
+																3])
103
+				}
104
+				else {
105
+					pvalList1stlevel <- c(pvalList1stlevel, 1)
106
+				}
107
+				
108
+				if ((uniquelist[i] %in% List2ndlevel[,"ID"]) == TRUE) {
109
+					pvalList2ndlevel  <- c(pvalList2ndlevel, List2ndlevel[
110
+																 which(List2ndlevel[,"ID"]==uniquelist[i]), 
111
+																 3])
112
+				}
113
+				else {
114
+					pvalList2ndlevel <- c(pvalList2ndlevel, 1)
115
+				}
116
+			}
117
+		}
118
+
119
+		matrix <- matrix(c(-log(as.numeric(pvalList1stlevel), base=10), 
120
+											 -log(as.numeric(pvalList2ndlevel), base=10)), 
121
+										 nrow=2, byrow=TRUE)
122
+		print(matrix)
123
+
124
+		if ((sum(matrix == 0)) == (nrow(matrix) * ncol(matrix))) {
125
+			print("There are no significant enriched regulators in both levels.")
126
+			print("Try to set mult.cor to FALSE.")
127
+		}
128
+		else {
129
+			par(fig=c(0, 1, 0, 1), mar=c(8, 8, 8, 8), mgp=c(2, 0.75, 0))
130
+			radial.plot(matrix, labels=uniquelist, rp.type="p", 
131
+									grid.unit="-log10 p-value", line.col=c("steelblue3","gold1"),
132
+									show.grid.labels=3, lwd=3, start=1,
133
+									point.symbols=18, point.col="black")
134
+									
135
+			legend("topleft", c(label.level.enriched(object)[1], label.level.enriched(object)[2]), 
136
+						 fill=c("steelblue3", "gold1"), bty="n")
137
+		}
138
+		
139
+		# if a file device is open, close it.
140
+		if (!(outputformat == "on screen")) dev.off()
141
+	}
142
+)
143
+
144
+
145
+setMethod("Heatmap", "EnrichedSets",
146
+	function(object, outputformat="on screen", 
147
+					 n.nodes.1stlevel="5", n.nodes.2ndlevel="5", mult.cor=TRUE) {
148
+	
149
+		pvalList1stlevel <- NULL
150
+		pvalList2ndlevel <- NULL
151
+
152
+		if (outputformat == "pdf") pdf(file="Enrichment.Heatmap.pdf")
153
+		if (outputformat =="postscript") postscript(file="Enrichment.Heatmap.ps")
154
+		if (outputformat == "jpeg") 
155
+			jpeg(filename="Enrichment.Heatmap.jpeg", width = 650, height = 500, 
156
+					 units = "px", pointsize = 12, bg = "transparent")
157
+		if (outputformat == "png") 
158
+			png(filename="Enrichment.Heatmap.png", width = 650, height = 500, 
159
+					units = "px", pointsize = 12, bg = "transparent")
160
+
161
+		Atable <- enriched.table(object)[,c("level", "ID", "list", "pv.fisher")]
162
+		if (mult.cor) 
163
+			Atable <- enriched.table(object)[,c("level", "ID", "list", "pv.fisher.BH")] 
164
+
165
+		indexfirst <- apply(Atable, 1, 
166
+												function(row) all(label.level.enriched(object)[1] %in% row))
167
+		indexsecond <- apply(Atable, 1, 
168
+												function(row) all(label.level.enriched(object)[2] %in% row))
169
+		List1stlevel <- Atable[indexfirst, -c(1) ] 
170
+		List2ndlevel <- Atable[indexsecond, -c(1)]
171
+
172
+		uniquelist <- unique(c(List1stlevel[1:n.nodes.1stlevel, "ID"], 
173
+													 List2ndlevel[1:n.nodes.2ndlevel, "ID"]))
174
+		uniquelist <- uniquelist[!is.na(uniquelist)]
175
+		
176
+		if (length(List1stlevel[,1]) == 0 | length(List2ndlevel[,1]) == 0) {
177
+			print("One of the lists is empty!")
178
+		}
179
+		else {
180
+			for(i in 1:length(uniquelist)) {
181
+
182
+				print(uniquelist[i])
183
+				
184
+				if ((uniquelist[i] %in% List1stlevel[,"ID"]) == TRUE) {
185
+					pvalList1stlevel  <-  c(pvalList1stlevel, List1stlevel[
186
+																 which(List1stlevel[,"ID"]==uniquelist[i]),
187
+																 3])
188
+				}
189
+				else {
190
+					pvalList1stlevel <- c(pvalList1stlevel, 1)
191
+				}
192
+					
193
+				if ((uniquelist[i] %in% List2ndlevel[,"ID"]) == TRUE) {
194
+					pvalList2ndlevel  <- c(pvalList2ndlevel, List2ndlevel[
195
+																 which(List2ndlevel[,"ID"]==uniquelist[i]),
196
+																 3])
197
+				}
198
+				else {
199
+					pvalList2ndlevel <- c(pvalList2ndlevel, 1)
200
+				}
201
+			}
202
+		}
203
+
204
+		matrix <- matrix(c(-log(as.numeric(pvalList1stlevel), base=10), 
205
+											 -log(as.numeric(pvalList2ndlevel), base=10)), 
206
+										 ncol=2)
207
+		print(matrix)
208
+
209
+		print(dim(matrix))
210
+		print(length(uniquelist))
211
+
212
+		if ((sum(matrix == 0)) == (nrow(matrix) * ncol(matrix))) {
213
+			print("There are no significant enriched regulators in both levels.")
214
+			print("Try to set mult.cor to FALSE.")
215
+		}
216
+		else {
217
+			rownames(matrix) <- uniquelist
218
+			colnames(matrix) <- c(label.level.enriched(object)[1], 
219
+														label.level.enriched(object)[2])
220
+			print(matrix)
221
+			heatmap.2(matrix, col = RGBColVec(50)[c(26:50)], key=TRUE, 
222
+								margins = c(7,20), keysize=1.5, denscol="white", na.rm = TRUE,
223
+							  scale="none", dendrogram="both", trace="none", 
224
+							  Colv=TRUE, Rowv=TRUE, labRow=NULL, labCol=NULL, 
225
+							  cexRow=1, cexCol=1)
226
+		}
227
+		
228
+		# if a file device is open, close it.
229
+		if (!(outputformat == "on screen")) dev.off()
230
+	}
231
+)
232
+
233
+
234
+## Helper functions
235
+###############################################################################