R/export2cytoscape.R

In rsilvabioinfo/ProbMetab: Probabilistic annotation of LC-MS based metabolomics

#' export2cytoscape
#'
#' Exports a graph to Cytoscape with optional node and edge attributes.
#' @param gr a graphNEL object generated by edge matrices provided by reac2cor. 
#' @param node.label a character vector containing the name of each node. 
#' @param cwName Cytoscape window name. 
#' @param node.form data.frame containing the names of the nodes in the first 
#' column, and TRUE/FALSE vectors for graph parameters in the additional
#' columns. The column name should have the parameter type, color and shape
#' and the value in the format "color.#FF0000".
#' @param edge.form data.frame containing the names of the nodes in the first 
#' column, and TRUE/FALSE vectors for graph parameters in the additional
#' columns. The column name should have the parameter type, color, width and style, 
#' and the value in the format "color.#FF0000".
#' @param cpdInfo matrix of pathway information, with pathway code, name and
#' the counting how many nodes each pathway has.
#' @param classTable matrix of classification generated by export.class.table. 
#' If the user provides this matrix the information is sent to Cytoscape
#' as node attributes, and the user can visualize it in the data panel. 
#' @param pos node position list given by get.kgml.positions function. 
#' @return Exports a graph to Cytoscape window, with additional parameters. 
#'
#' @export

export2cytoscape <- function(gr, node.label, cwName="test", node.form=NULL, edge.form=NULL, cpdInfo=NULL, classTable=NULL, pos=NULL) {

#require(RCytoscape)

g2 <- new ('graphNEL', edgemode='undirected')
i <- 1; system.time(lapply(gr@edgeL, function(x) { if(length(x$edges)) { gr@edgeL[[i]]$edges <<- x$edges[x$edges>i] }; i <<- i+1 }) )

cw5 <- new.CytoscapeWindow (cwName, graph=g2)
cw5@graph<- gr 
displayGraph (cw5)
setNodeLabelDirect(cw5, nodes(gr), node.label)
layoutNetwork (cw5, layout.name='grid')
setDefaultNodeColor (cw5, '#D3D3D3')
#setDefaultNodeShape (cw5, "ellipse")
setDefaultNodeSize (cw5, 10)
setNodeOpacityDirect(cw5, nodes(gr), 0)
setNodeLabelOpacityDirect(cw5, nodes(gr), 200) 
redraw(cw5)

  format.node <- function(x, type, par) {
       switch(type,
              color = setNodeColorDirect(cw5, x, par),
              shape = setNodeShapeDirect(cw5, x, par),
              border = setNodeBorderColorDirect(cw5, x, par),
              borderw = setNodeBorderWidthDirect(cw5, x, par),
	      lcolor = setNodeLabelColorDirect(cw5, x, par)
	)
     }
  
  format.edge <- function(x, type, par) {
       switch(type,
              color = setEdgeColorDirect(cw5, x, par),
              width = setEdgeLineWidthDirect (cw5, x, par),
              border = setNodeBorderColorDirect(cw5, x, par)
	)
     }
 
	if(!is.null(node.form)) {
		nodes.names <- as.character(node.form[,1])
		for(i in 2:ncol(node.form)) format.node(nodes.names[node.form[,i]], strsplit(colnames(node.form)[i], "\\.")[[1]][1], strsplit(colnames(node.form)[i], "\\.")[[1]][2])
	}
  	if(!is.null(edge.form)) {
		edge.names <- as.character(edge.form[,1])
		for(i in 2:ncol(edge.form)) format.edge(cy2.edge.names(cw5@graph)[edge.names[edge.form[,i]]], strsplit(colnames(edge.form)[i], "\\.")[[1]][1], strsplit(colnames(edge.form)[i], "\\.")[[1]][2])
	}
if(!is.null(cpdInfo)) {  
	cw5@graph = graph::addNode ('lfc.plot', cw5@graph)   # this is the new informational node

	png("testcy.png") 

	 op <- par(mar = rep(0, 4)) 
	 cpdInfo <- as.matrix(cpdInfo)
	 cpdInfo <- rbind(cpdInfo[1,], c("","",""), cpdInfo[-1,]) 
	 nr <- nrow(cpdInfo)
	 plot(rep(1:3,each=nr), rep(1:nr,3), axes=FALSE, ann=FALSE, type="n") 

	 text(rep(1,nr), nr:2, labels=cpdInfo[-1,1], cex=.7) 
	 text(rep(2,nr), nr:2, labels=cpdInfo[-1,2], cex=.7)
	 text(rep(3,nr), nr:2, labels=cpdInfo[-1,3], cex=.7)
	 text(c(1,2,2.7), rep(nr,3) , labels=cpdInfo[1,], cex=.8, font=2)

	dev.off() 
	setNodeImageDirect (cw5, 'lfc.plot', sprintf ('file://%s/%s', getwd (), 'testcy.png'))
    	setNodeSizeDirect (cw5, 'lfc.plot', 600)
	displayGraph (cw5)

} 

if(!is.null(classTable)){

	for(i in 1:nrow(classTable)) if(classTable[i,1]=="") classTable[i,c(1,4,6,7)] <- classTable[i-1,c(1,4,6,7)]

	msel <- as.matrix(classTable[,1:7])
	msel <- cbind(msel[,6], msel[,-6])
	colnames(msel)[1] <- "Id"
	msel[,1] <- sub("^\\s+","", msel[,1])
	colnames(msel)[1] <- "Id"
	ids <- unique(msel[,1]) 
	attrMatrix <- matrix("", nrow=length(ids), ncol=ncol(msel)-1)
	for(i in 1:length(ids)) {
		attrMatrix[i,1] <- unique(msel[msel[,1]==ids[i],2]) 
		attrMatrix[i,2] <- paste("[", paste(msel[msel[,1]==ids[i],3], collapse=", "),"]", sep="") 
		attrMatrix[i,3] <- paste("[", paste(msel[msel[,1]==ids[i],4], collapse=", "),"]", sep="") 
		attrMatrix[i,4] <- unique(msel[msel[,1]==ids[i],5])
		attrMatrix[i,5] <- paste("[", paste(msel[msel[,1]==ids[i],6], collapse=", "),"]", sep="") 
		attrMatrix[i,6] <- unique(msel[msel[,1]==ids[i],7])  
	}

	ids <- as.numeric(unique(msel[,1]) )
	 attrMatrix <- cbind(ids, attrMatrix) 
	 colnames(attrMatrix) <- colnames(msel)
	subSel <- sapply(nodes(gr), function(x) which(attrMatrix[,1]==x))
	for(j in 2:ncol(attrMatrix)) setNodeAttributesDirect(cw5, colnames(attrMatrix)[j], "String", nodes(gr),attrMatrix[subSel,j] )
}
	if(!is.null(pos)) {
		setNodePosition(cw5, nodes(gr), x.coords=as.numeric(pos$posMatrix[,"grx"]),y.coords=as.numeric(pos$posMatrix[,"gry"]))
	}
	redraw(cw5)
}