Browse code

fixes to cope with GOSemSim package update

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

Erik Dassi authored on 05/10/2016 07:41:10
Showing1 changed files
... ...
@@ -360,7 +360,7 @@ specificOntologyResult <- function(object, ontology) {
360 360
 
361 361
 comparisonBetweenTwoLists <- function(go1,go2,ontology,direction) {
362 362
 
363
-	ontData <- semData('org.Hs.eg.db', ont=ontology)
363
+	ontData <- godata('org.Hs.eg.db', ont=ontology)
364 364
 	finalmat <- NULL
365 365
 	for (i in 1:nrow(go1)) {
366 366
 		mat <- NULL
Browse code

fixes to cope with GOSemSim package update

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

Erik Dassi authored on 05/10/2016 07:20:08
Showing1 changed files
... ...
@@ -360,11 +360,12 @@ specificOntologyResult <- function(object, ontology) {
360 360
 
361 361
 comparisonBetweenTwoLists <- function(go1,go2,ontology,direction) {
362 362
 
363
+	ontData <- semData('org.Hs.eg.db', ont=ontology)
363 364
 	finalmat <- NULL
364 365
 	for (i in 1:nrow(go1)) {
365 366
 		mat <- NULL
366 367
 		for (j in 1:nrow(go2)) {
367
-			sim <- goSim(go1[i, 1], go2[j, 1], measure="Wang")
368
+			sim <- goSim(go1[i, 1], go2[j, 1], semData=ontData, measure="Wang")
368 369
 			mat <- rbind(mat, c(go1[i, 1],go1[i, 2],go2[j, 1],go2[j, 2],sim))	
369 370
 		}
370 371
 		
Browse code

updated call to GOSemSim's goSim function (does not require organism&ontology parameters anymore)

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

Erik Dassi authored on 03/10/2016 14:39:17
Showing1 changed files
... ...
@@ -364,8 +364,7 @@ comparisonBetweenTwoLists <- function(go1,go2,ontology,direction) {
364 364
 	for (i in 1:nrow(go1)) {
365 365
 		mat <- NULL
366 366
 		for (j in 1:nrow(go2)) {
367
-			sim <- goSim(go1[i, 1], go2[j, 1], 
368
-									 organism="human", measure="Wang", ont = ontology)
367
+			sim <- goSim(go1[i, 1], go2[j, 1], measure="Wang")
369 368
 			mat <- rbind(mat, c(go1[i, 1],go1[i, 2],go2[j, 1],go2[j, 2],sim))	
370 369
 		}
371 370
 		
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,391 @@
1
+## Class declaration
2
+###############################################################################
3
+
4
+setClass("GOsets", contains="EnrichedSets")
5
+
6
+
7
+## Generics declaration (getters, setters and methods)
8
+###############################################################################
9
+
10
+setGeneric("GOComparison", signature="object", 
11
+          function(object) standardGeneric("GOComparison"))
12
+
13
+
14
+## Implementation of getters
15
+###############################################################################
16
+
17
+
18
+## Methods implementation
19
+###############################################################################
20
+
21
+setMethod("Radar", "GOsets", 
22
+	function(object, outputformat="on screen", 
23
+           n.nodes.1stlevel="5", n.nodes.2ndlevel="5", mult.cor=TRUE,
24
+           ontology="MF") {
25
+	
26
+		pvalList1stlevel <- NULL
27
+		pvalList2ndlevel <- NULL
28
+
29
+		if (outputformat == "pdf") pdf(file="Radar.pdf")
30
+		if (outputformat == "postscript") postscript(file="Radar.ps")
31
+		if (outputformat == "jpeg") 
32
+      jpeg(filename="Radar.jpeg", width = 650, height = 500, units = "px", 
33
+					 pointsize = 12, bg = "transparent")
34
+		if (outputformat == "png") 
35
+			png(filename="Radar.png", width = 650, height = 500, units = "px", 
36
+					pointsize = 12, bg = "transparent")
37
+
38
+		if (length(unique(enriched.table(object)[,1])) == 1 ) {
39
+			Atable <- enriched.table(object)[,c("level", "GO.ID", 
40
+																					"term", "pv.fisher.BH")]
41
+			if (!mult.cor) 
42
+				Atable <- enriched.table(object)[,c("level", "GO.ID", 
43
+																					"term", "pv.fisher") ] 	 
44
+		}
45
+		else {
46
+			# take the rows relevant only to the selected ontology
47
+			index <- apply(enriched.table(object), 1, 
48
+										function(row) all(ontology %in% row))
49
+			Atable <- enriched.table(object)[index,
50
+																c("level", "GO.ID", "term", "pv.fisher.BH")]
51
+			if (!mult.cor) 
52
+				Atable <- enriched.table(object)[index,
53
+																c("level", "GO.ID", "term", "pv.fisher")] 
54
+		}
55
+
56
+		indexfirst <- apply(Atable, 1, 
57
+									function(row) all(label.level.enriched(object)[1] %in% row))
58
+		indexsecond <- apply(Atable, 1, 
59
+									function(row) all(label.level.enriched(object)[2] %in% row))
60
+		List1stlevel <- Atable[indexfirst, -c(1) ] 
61
+		List2ndlevel <- Atable[indexsecond, -c(1)]
62
+
63
+		uniquelist <- unique(c(List1stlevel[1:n.nodes.1stlevel,"GO.ID"], 
64
+												   List2ndlevel[1:n.nodes.2ndlevel,"GO.ID"]))
65
+		uniquelistTerms <- unique(c(List1stlevel[1:n.nodes.1stlevel,"term"], 
66
+																List2ndlevel[1:n.nodes.2ndlevel,"term"]))
67
+
68
+		uniquelist <- uniquelist[!is.na(uniquelist)]
69
+		uniquelistTerms <- uniquelistTerms[!is.na(uniquelistTerms)]
70
+
71
+		if (length(List1stlevel[,1]) == 0 | length(List2ndlevel[,1]) == 0) {
72
+			print("One of the lists is empty!")
73
+		}
74
+		else {
75
+			for(i in 1:length(uniquelist)) {
76
+				print(uniquelist[i])
77
+				print(uniquelistTerms[i])
78
+				
79
+				if ((uniquelist[i] %in% List1stlevel[,"GO.ID"]) == TRUE) {
80
+					pvalList1stlevel <- c(pvalList1stlevel, List1stlevel[
81
+																which(List1stlevel[,"GO.ID"] == uniquelist[i]),
82
+																3])
83
+				}
84
+				else {
85
+					pvalList1stlevel <- c(pvalList1stlevel, 1)
86
+				}
87
+				
88
+				if ((uniquelist[i] %in% List2ndlevel[,"GO.ID"]) == TRUE) {
89
+					pvalList2ndlevel  <- c(pvalList2ndlevel, List2ndlevel[
90
+																 which(List2ndlevel[,"GO.ID"]==uniquelist[i]), 
91
+																 3])
92
+				}
93
+				else {
94
+					pvalList2ndlevel <- c(pvalList2ndlevel, 1)
95
+				}
96
+			}
97
+		}
98
+
99
+		matrix <- matrix(c(-log(as.numeric(pvalList1stlevel), base=10), 
100
+											 -log(as.numeric(pvalList2ndlevel), base=10)), 
101
+										 nrow=2, byrow=TRUE)
102
+		print(matrix)
103
+
104
+		if ((sum(matrix == 0)) == (nrow(matrix) * ncol(matrix))) {
105
+			print("There are no significant enriched terms in both levels.")
106
+			print("Try to set mult.cor to FALSE.")
107
+		}
108
+		else {
109
+			par(fig=c(0, 1, 0, 1), mar=c(8, 8, 8, 8), mgp=c(2, 0.75, 0))
110
+			radial.plot(matrix, labels=uniquelistTerms, rp.type="p", 
111
+									grid.unit="-log10 p-value", line.col=c("steelblue3","gold1"),
112
+									show.grid.labels=3, lwd=3, start=1,
113
+									point.symbols=18, point.col="black")
114
+									
115
+			legend("topleft", c(label.level.enriched(object)[1], 
116
+													label.level.enriched(object)[2]), 
117
+						 fill=c("steelblue3", "gold1"), bty="n")
118
+		}
119
+		
120
+		# if a file device is open, close it.
121
+		if (!(outputformat == "on screen")) dev.off()
122
+	}
123
+)
124
+
125
+
126
+setMethod("Heatmap", "GOsets",
127
+	function(object, outputformat="on screen", 
128
+					 n.nodes.1stlevel="5", n.nodes.2ndlevel="5", mult.cor=TRUE, 
129
+					 ontology="MF") {
130
+	
131
+		pvalList1stlevel <- NULL
132
+		pvalList2ndlevel <- NULL
133
+
134
+		if (outputformat == "pdf") pdf(file="GO.Heatmap.pdf")
135
+		if (outputformat =="postscript") postscript(file="GO.Heatmap.ps")
136
+		if (outputformat == "jpeg") 
137
+			jpeg(filename="GO.Heatmap.jpeg", width = 650, height = 500, units = "px",
138
+					 pointsize = 12, bg = "transparent")
139
+		if (outputformat == "png") 
140
+			png(filename="GO.Heatmap.png", width = 650, height = 500, units = "px", 
141
+					pointsize = 12, bg = "transparent")
142
+
143
+		if (length(unique(enriched.table(object)[,1])) == 1 ) {
144
+			Atable <- enriched.table(object)[,c("level", "GO.ID", 
145
+																					"term", "pv.fisher.BH")]
146
+			if (!mult.cor) 
147
+				Atable <- enriched.table(object)[,c("level", "GO.ID", 
148
+																						"term", "pv.fisher") ] 			 
149
+		}
150
+		else {
151
+			# take the rows relevant only to the selected ontology
152
+			index <- apply(enriched.table(object), 1, 
153
+										 function(row) all(ontology %in% row))
154
+			Atable <- enriched.table(object)[index, 
155
+																 c("level","GO.ID","term","pv.fisher.BH")]
156
+			if (!mult.cor) 
157
+				Atable <- enriched.table(object)[index,
158
+																	 c("level","GO.ID","term","pv.fisher")]  
159
+		}
160
+
161
+		indexfirst <- apply(Atable, 1, 
162
+									function(row) all(label.level.enriched(object)[1] %in% row))
163
+		indexsecond <- apply(Atable, 1, 
164
+									function(row) all(label.level.enriched(object)[2] %in% row))
165
+		List1stlevel <- Atable[indexfirst, -c(1) ] 
166
+		List2ndlevel <- Atable[indexsecond, -c(1)]
167
+
168
+		uniquelist <- unique(c(List1stlevel[1:n.nodes.1stlevel, "GO.ID"], 
169
+													 List2ndlevel[1:n.nodes.2ndlevel, "GO.ID"]))
170
+		uniquelistTerms <- unique(c(List1stlevel[1:n.nodes.1stlevel, "term"], 
171
+																List2ndlevel[1:n.nodes.2ndlevel, "term"]))
172
+
173
+		uniquelist <- uniquelist[!is.na(uniquelist)]
174
+		uniquelistTerms <- uniquelistTerms[!is.na(uniquelistTerms)]
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
+				print(uniquelistTerms[i])
184
+				
185
+				if ((uniquelist[i] %in% List1stlevel[,"GO.ID"]) == TRUE) {
186
+					pvalList1stlevel  <-  c(pvalList1stlevel, List1stlevel[
187
+																 which(List1stlevel[,"GO.ID"]==uniquelist[i]),
188
+																 3])
189
+				}
190
+				else {
191
+					pvalList1stlevel <- c(pvalList1stlevel, 1)
192
+				}
193
+					
194
+				if ((uniquelist[i] %in% List2ndlevel[,"GO.ID"]) == TRUE) {
195
+					pvalList2ndlevel  <- c(pvalList2ndlevel, List2ndlevel[
196
+																 which(List2ndlevel[,"GO.ID"]==uniquelist[i]),
197
+																 3])
198
+				}
199
+				else {
200
+					pvalList2ndlevel <- c(pvalList2ndlevel, 1)
201
+				}
202
+			}
203
+		}
204
+
205
+		matrix <- matrix(c(-log(as.numeric(pvalList1stlevel), base=10), 
206
+											 -log(as.numeric(pvalList2ndlevel), base=10)), 
207
+										 ncol=2)
208
+		print(matrix)
209
+
210
+		print(dim(matrix))
211
+		print(dim(uniquelistTerms))
212
+
213
+		if ((sum(matrix == 0)) == (nrow(matrix) * ncol(matrix))) {
214
+			print("There are no significant enriched terms in both levels.")
215
+			print("Try to set mult.cor to FALSE.")
216
+		}
217
+		else {
218
+			rownames(matrix) <- uniquelistTerms
219
+			colnames(matrix) <- c(label.level.enriched(object)[1], 
220
+														label.level.enriched(object)[2])
221
+			print(matrix)
222
+			heatmap.2(matrix, col = RGBColVec(50)[c(26:50)], key=TRUE, 
223
+								margins = c(7,20), keysize=1.5, denscol="white", na.rm = TRUE,
224
+							  scale="none", dendrogram="both", trace="none", 
225
+							  Colv=TRUE, Rowv=TRUE, labRow=NULL, labCol=NULL, 
226
+							  cexRow=1, cexCol=1)
227
+		}
228
+		
229
+		# if a file device is open, close it.
230
+		if (!(outputformat == "on screen")) dev.off()
231
+	}
232
+)
233
+
234
+
235
+setMethod("GOComparison", "GOsets",
236
+	function(object) {
237
+		resulttable <- NULL
238
+
239
+		# identity - stays the same for both of the cases
240
+		# first find the duplicates, then when encountering that duplicate 
241
+		# check wether it is already covered, 
242
+		# 	if not, leave that row as it is, put the label "both levels" 
243
+		# and put it in "coveredDuplicates", 
244
+		# 	if it is already covered mark it for deletion
245
+		
246
+		Atable <- enriched.table(object)[,c("ontology", "level", "GO.ID", "term")]
247
+		duplicates <- Atable[duplicated(Atable[,"GO.ID"]), "GO.ID"]
248
+		Atable$level <- as.character(Atable$level)
249
+		coveredDuplicates <- c()
250
+		rowsForDeletion <- c()
251
+
252
+		for (i in 1:nrow(Atable)) {
253
+			if (any(duplicates == Atable[i, "GO.ID"])) {
254
+				if (all(coveredDuplicates != Atable[i, "GO.ID"])) {
255
+					Atable[i,"level"] <- "both levels"
256
+					coveredDuplicates <- c(coveredDuplicates, Atable[i,"GO.ID"])
257
+				}
258
+				else {
259
+					rowsForDeletion <- c(rowsForDeletion, i)
260
+				}
261
+			}
262
+			else {
263
+				Atable[i,"level"] <- paste(Atable[i,"level"],"only")
264
+			}
265
+		}
266
+
267
+		Atable <- Atable[-c(rowsForDeletion),]
268
+
269
+		if (length(unique(enriched.table(object)[,1])) == 1 ) {
270
+			Btable <- enriched.table(object)[,c("level","GO.ID","term")]
271
+			ontology <- as.character(unique(enriched.table(object)[,1]))
272
+
273
+			indexfirst <- apply(Btable, 1, 
274
+									function(row) all(label.level.enriched(object)[1] %in% row))
275
+			indexsecond <- apply(Btable, 1, 
276
+									function(row) all(label.level.enriched(object)[2] %in% row))
277
+			List1stlevel <- Btable[indexfirst,-c(1)] 
278
+			List2ndlevel <- Btable[indexsecond,-c(1)]
279
+
280
+			if (length(List1stlevel[,1]) == 0 | length(List2ndlevel[,1]) == 0) {
281
+				print("One of the lists is empty!")
282
+			}
283
+			else {
284
+				resulttable1to2 <- comparisonBetweenTwoLists(List1stlevel, 
285
+													List2ndlevel, ontology, 
286
+													paste(label.level.enriched(object)[1], " to ", 
287
+																label.level.enriched(object)[2]))
288
+																
289
+				resulttable2to1 <- comparisonBetweenTwoLists(List2ndlevel, 
290
+													List1stlevel, ontology, 
291
+													paste(label.level.enriched(object)[2], " to ",
292
+																label.level.enriched(object)[1]))
293
+				
294
+				#bind the two result tables
295
+				Similarity.Matrix <- rbind(resulttable1to2, resulttable2to1)
296
+
297
+				totalsimilarity <- c(mean(c(as.numeric(resulttable1to2[,7]), 
298
+																		as.numeric(resulttable2to1[,7]))))
299
+				names(totalsimilarity) <- c(
300
+									as.character(unique(enriched.table(object)[,1])))
301
+			}
302
+		}
303
+		else {	
304
+			ontologyCC <- specificOntologyResult(object, "CC")
305
+			ontologyMF <- specificOntologyResult(object, "MF")
306
+			ontologyBP <- specificOntologyResult(object, "BP")
307
+			
308
+			totalsimilarity <- c(mean(c(as.numeric(ontologyCC$result1[,7]), 
309
+																	as.numeric(ontologyCC$result2[,7]))),
310
+                           mean(c(as.numeric(ontologyMF$result1[,7]), 
311
+																	as.numeric(ontologyMF$result2[,7]))),
312
+                           mean(c(as.numeric(ontologyBP$result1[,7]), 
313
+																	as.numeric(ontologyBP$result2[,7]))))
314
+			names(totalsimilarity) <- c("CC","MF","BP")
315
+
316
+			Similarity.Matrix <- rbind(ontologyCC$result1, ontologyCC$result2, 
317
+																 ontologyMF$result1, ontologyMF$result2, 
318
+																 ontologyBP$result1, ontologyBP$result2)
319
+		}
320
+		
321
+		# return the obtained results table
322
+		return(new("GOsims", 
323
+							similarity.matrix = Similarity.Matrix, 
324
+							identity.matrix = as.matrix(Atable), 
325
+							average.similarity.scores = totalsimilarity))
326
+	}
327
+)
328
+
329
+
330
+## Helper functions
331
+###############################################################################
332
+
333
+specificOntologyResult <- function(object, ontology) {
334
+
335
+	index <- apply(enriched.table(object), 1, 
336
+								 function(row) all(ontology %in% row))
337
+	ontologyTable <- enriched.table(object)[index,c("level", "GO.ID", "term") ] 
338
+	
339
+	indexfirst <- apply(ontologyTable, 1, 
340
+								function(row) all(label.level.enriched(object)[1] %in% row))
341
+	indexsecond <- apply(ontologyTable, 1, 
342
+								function(row) all(label.level.enriched(object)[2] %in% row))
343
+	List1stlevel <- ontologyTable[indexfirst, -c(1)] 
344
+	List2ndlevel <- ontologyTable[indexsecond, -c(1)]
345
+
346
+	if (length(List1stlevel[,1]) == 0 | length(List2ndlevel[,1]) == 0) {
347
+		print("There aren't enough BP GO enriched terms in one of the levels!")
348
+	}
349
+	else {
350
+		resulttable1to2 <- comparisonBetweenTwoLists(List1stlevel, List2ndlevel, 
351
+											 ontology, paste(label.level.enriched(object)[1], " to ",
352
+																			label.level.enriched(object)[2]))
353
+		resulttable2to1 <- comparisonBetweenTwoLists(List2ndlevel, List1stlevel, 
354
+											 ontology, paste(label.level.enriched(object)[2], " to ", 
355
+																			 label.level.enriched(object)[1]))
356
+		
357
+		return(list(result1 = resulttable1to2, result2 = resulttable1to2))
358
+	}
359
+}
360
+
361
+comparisonBetweenTwoLists <- function(go1,go2,ontology,direction) {
362
+
363
+	finalmat <- NULL
364
+	for (i in 1:nrow(go1)) {
365
+		mat <- NULL
366
+		for (j in 1:nrow(go2)) {
367
+			sim <- goSim(go1[i, 1], go2[j, 1], 
368
+									 organism="human", measure="Wang", ont = ontology)
369
+			mat <- rbind(mat, c(go1[i, 1],go1[i, 2],go2[j, 1],go2[j, 2],sim))	
370
+		}
371
+		
372
+		max1.index <- which.max(mat[,5])
373
+		max1 <- mat[max1.index, 5]	
374
+		
375
+		firstgotermID <- mat[max1.index, 3]
376
+		firstgotermTERM <- mat[max1.index, 4]	
377
+		
378
+		finalmat <- rbind(finalmat, c(go1[i, 1], go1[i, 2], 
379
+																	firstgotermID, firstgotermTERM, max1))
380
+		colnames(finalmat) <- c("start.GO.ID", "start.term", 
381
+														"end.GO.ID", "end.term", 
382
+														"similarity.score")			
383
+	}
384
+	
385
+	OntologyAndDirection <- matrix(,nrow=dim(finalmat)[1], ncol=2)
386
+	colnames(OntologyAndDirection) <- c("ontology", "direction")
387
+	OntologyAndDirection[,1] <- ontology
388
+	OntologyAndDirection[,2] <- direction
389
+	
390
+	return(cbind(OntologyAndDirection, finalmat))
391
+}