R/EnrichedSets.R
0be990f7
 ## Class declaration
 ###############################################################################
 
 setClass("EnrichedSets", representation(enriched.table="data.frame", 
 																				label.level.enriched="character"))
 
 
 ## Generics declaration (getters, setters and methods)
 ###############################################################################
 
 setGeneric("enriched.table", signature="object", 
           function(object) standardGeneric("enriched.table"))
           
 setGeneric("label.level.enriched", signature="object", 
           function(object) standardGeneric("label.level.enriched"))
 
 setGeneric("Radar", signature="object", 
           function(object, outputformat="on screen",
                    n.nodes.1stlevel="5", n.nodes.2ndlevel="5", mult.cor=TRUE, ...) 
           standardGeneric("Radar"))
           
 setGeneric("Heatmap", signature="object", 
           function(object, outputformat="on screen", 
                    n.nodes.1stlevel="5", n.nodes.2ndlevel="5", mult.cor=TRUE, ...)
           standardGeneric("Heatmap"))
  
 
 ## Implementation of getters
 ###############################################################################
 
 setMethod("enriched.table", "EnrichedSets",
 	function(object) {
 		object@enriched.table
 	}
 )
 
 setMethod("label.level.enriched", "EnrichedSets",
 	function(object) {
 		object@label.level.enriched
 	}
 )
 
 
 ## Methods implementation
 ###############################################################################
 
 setMethod("show", "EnrichedSets",
 	function(object) {
 		print(apply(object@enriched.table, c(1,2), function(x){
 							if(nchar(x) > 30) 
 								return(paste(substr(x,1,30),"...",sep=""))
 							else
 								return(x)
 							})
 				 )
 		print(object@label.level.enriched)
 	}
 )
 
 
 setMethod("Radar", "EnrichedSets", 
 	function(object, outputformat="on screen", 
            n.nodes.1stlevel="5", n.nodes.2ndlevel="5", mult.cor=TRUE) {
 	
 		pvalList1stlevel <- NULL
 		pvalList2ndlevel <- NULL
 
 		if (outputformat == "pdf") pdf(file="Enrichment.Radar.pdf")
 		if (outputformat == "postscript") postscript(file="Enrichment.Radar.ps")
 		if (outputformat == "jpeg") 
       jpeg(filename="Enrichment.Radar.jpeg", width = 650, height = 500, 
 					 units = "px", pointsize = 12, bg = "transparent")
 		if (outputformat == "png") 
 			png(filename="Enrichment.Radar.png", width = 650, height = 500, 
 					units = "px", pointsize = 12, bg = "transparent")
 
 		Atable <- enriched.table(object)[,c("level","ID","list","pv.fisher") ]
 		if (mult.cor) 
 			Atable <- enriched.table(object)[,c("level","ID","list", "pv.fisher.BH") ] 	 
 
 		indexfirst <- apply(Atable, 1, 
 												function(row) all(label.level.enriched(object)[1] %in% row))
 		indexsecond <- apply(Atable, 1, 
 												function(row) all(label.level.enriched(object)[2] %in% row))
 		List1stlevel <- Atable[indexfirst, -c(1)] 
 		List2ndlevel <- Atable[indexsecond, -c(1)]
 
 		uniquelist <- unique(c(List1stlevel[1:n.nodes.1stlevel,"ID"], 
 												   List2ndlevel[1:n.nodes.2ndlevel,"ID"]))
 		uniquelist <- uniquelist[!is.na(uniquelist)]
 
 		if (length(List1stlevel[,1]) == 0 | length(List2ndlevel[,1]) == 0) {
 			print("One of the lists is empty!")
 		}
 		else {
 			for(i in 1:length(uniquelist)) {
 				print(uniquelist[i])
 				
 				if ((uniquelist[i] %in% List1stlevel[,"ID"]) == TRUE) {
 					pvalList1stlevel <- c(pvalList1stlevel, List1stlevel[
 																which(List1stlevel[,"ID"] == uniquelist[i]),
 																3])
 				}
 				else {
 					pvalList1stlevel <- c(pvalList1stlevel, 1)
 				}
 				
 				if ((uniquelist[i] %in% List2ndlevel[,"ID"]) == TRUE) {
 					pvalList2ndlevel  <- c(pvalList2ndlevel, List2ndlevel[
 																 which(List2ndlevel[,"ID"]==uniquelist[i]), 
 																 3])
 				}
 				else {
 					pvalList2ndlevel <- c(pvalList2ndlevel, 1)
 				}
 			}
 		}
 
 		matrix <- matrix(c(-log(as.numeric(pvalList1stlevel), base=10), 
 											 -log(as.numeric(pvalList2ndlevel), base=10)), 
 										 nrow=2, byrow=TRUE)
 		print(matrix)
 
 		if ((sum(matrix == 0)) == (nrow(matrix) * ncol(matrix))) {
 			print("There are no significant enriched regulators in both levels.")
 			print("Try to set mult.cor to FALSE.")
 		}
 		else {
 			par(fig=c(0, 1, 0, 1), mar=c(8, 8, 8, 8), mgp=c(2, 0.75, 0))
 			radial.plot(matrix, labels=uniquelist, rp.type="p", 
 									grid.unit="-log10 p-value", line.col=c("steelblue3","gold1"),
 									show.grid.labels=3, lwd=3, start=1,
 									point.symbols=18, point.col="black")
 									
 			legend("topleft", c(label.level.enriched(object)[1], label.level.enriched(object)[2]), 
 						 fill=c("steelblue3", "gold1"), bty="n")
 		}
 		
 		# if a file device is open, close it.
 		if (!(outputformat == "on screen")) dev.off()
 	}
 )
 
 
 setMethod("Heatmap", "EnrichedSets",
 	function(object, outputformat="on screen", 
 					 n.nodes.1stlevel="5", n.nodes.2ndlevel="5", mult.cor=TRUE) {
 	
 		pvalList1stlevel <- NULL
 		pvalList2ndlevel <- NULL
 
 		if (outputformat == "pdf") pdf(file="Enrichment.Heatmap.pdf")
 		if (outputformat =="postscript") postscript(file="Enrichment.Heatmap.ps")
 		if (outputformat == "jpeg") 
 			jpeg(filename="Enrichment.Heatmap.jpeg", width = 650, height = 500, 
 					 units = "px", pointsize = 12, bg = "transparent")
 		if (outputformat == "png") 
 			png(filename="Enrichment.Heatmap.png", width = 650, height = 500, 
 					units = "px", pointsize = 12, bg = "transparent")
 
 		Atable <- enriched.table(object)[,c("level", "ID", "list", "pv.fisher")]
 		if (mult.cor) 
 			Atable <- enriched.table(object)[,c("level", "ID", "list", "pv.fisher.BH")] 
 
 		indexfirst <- apply(Atable, 1, 
 												function(row) all(label.level.enriched(object)[1] %in% row))
 		indexsecond <- apply(Atable, 1, 
 												function(row) all(label.level.enriched(object)[2] %in% row))
 		List1stlevel <- Atable[indexfirst, -c(1) ] 
 		List2ndlevel <- Atable[indexsecond, -c(1)]
 
 		uniquelist <- unique(c(List1stlevel[1:n.nodes.1stlevel, "ID"], 
 													 List2ndlevel[1:n.nodes.2ndlevel, "ID"]))
 		uniquelist <- uniquelist[!is.na(uniquelist)]
 		
 		if (length(List1stlevel[,1]) == 0 | length(List2ndlevel[,1]) == 0) {
 			print("One of the lists is empty!")
 		}
 		else {
 			for(i in 1:length(uniquelist)) {
 
 				print(uniquelist[i])
 				
 				if ((uniquelist[i] %in% List1stlevel[,"ID"]) == TRUE) {
 					pvalList1stlevel  <-  c(pvalList1stlevel, List1stlevel[
 																 which(List1stlevel[,"ID"]==uniquelist[i]),
 																 3])
 				}
 				else {
 					pvalList1stlevel <- c(pvalList1stlevel, 1)
 				}
 					
 				if ((uniquelist[i] %in% List2ndlevel[,"ID"]) == TRUE) {
 					pvalList2ndlevel  <- c(pvalList2ndlevel, List2ndlevel[
 																 which(List2ndlevel[,"ID"]==uniquelist[i]),
 																 3])
 				}
 				else {
 					pvalList2ndlevel <- c(pvalList2ndlevel, 1)
 				}
 			}
 		}
 
 		matrix <- matrix(c(-log(as.numeric(pvalList1stlevel), base=10), 
 											 -log(as.numeric(pvalList2ndlevel), base=10)), 
 										 ncol=2)
 		print(matrix)
 
 		print(dim(matrix))
 		print(length(uniquelist))
 
 		if ((sum(matrix == 0)) == (nrow(matrix) * ncol(matrix))) {
 			print("There are no significant enriched regulators in both levels.")
 			print("Try to set mult.cor to FALSE.")
 		}
 		else {
 			rownames(matrix) <- uniquelist
 			colnames(matrix) <- c(label.level.enriched(object)[1], 
 														label.level.enriched(object)[2])
 			print(matrix)
 			heatmap.2(matrix, col = RGBColVec(50)[c(26:50)], key=TRUE, 
 								margins = c(7,20), keysize=1.5, denscol="white", na.rm = TRUE,
 							  scale="none", dendrogram="both", trace="none", 
 							  Colv=TRUE, Rowv=TRUE, labRow=NULL, labCol=NULL, 
 							  cexRow=1, cexCol=1)
 		}
 		
 		# if a file device is open, close it.
 		if (!(outputformat == "on screen")) dev.off()
 	}
 )
 
 
 ## Helper functions
 ###############################################################################