R/createCytoscapeVizMap.R

In C3c6e6/SetRank: Advanced Gene Set Enrichment Analysis

#' Prepare networks for visualization in Cytoscape
#' 
#' Exports a list of networks in GraphML format and creates a Cytoscape a 
#' VizMap XML file with a visualisation style applicable to all networks.
#' 
#' Each network will be written to a separate file in the specified output 
#' directory. The names of the supplied list of networks will be used as
#' filenames with the \code{.net.xml} extension added. The VizMap file will be 
#' called \code{setrank.xml} and will also be written to the output directory.
#' 
#' @param networkList A named list of networks generated by the 
#' \code{\link[SetRank]{setRankAnalysis}} function.
#' @param outputDir The path where the files should be written to. The 
#' last element in the path will be created when it doesn't exist.
#' @return None. The function writes out files as a side effect.
#' @author Cedric Simillion
cytoscapeExport <- function(networkList, outputDir) {
	if (!file.exists(outputDir)) {
		dir.create(outputDir)
	}
	for (n in names(networkList)) {
		outputFile = sprintf("%s/%s.net.xml", outputDir, n)
		write.graph(networkList[[n]], outputFile, format="graphML")
		fixGraphML(outputFile)
	}
	createCytoscapeVizMap(networkList=networkList, 
			outputFile = sprintf("%s/setrank.xml", outputDir))	 
}

#' Create a Cytoscape visual style for one or more SetRank networks.
#' 
#' Generates a VizMap XML file that can be imported, together with the network
#' in Cytoscape, a tool for network analysis and visualization
#' (url{http://www.cytoscape.org}).
#' 
#' You must either pass a single network, through the \code{network} argument,
#' or a list of networks, through the \code{networkList} argument, to the 
#' function. When using the latter option, the function will generate a single
#' style applicable to all networks. This style allows to easily spot 
#' differences between different networks generated from the same dataset.
#' 
#' Specifying both arguments will results in an error. Networks should of 
#' course be generated by \code{\link[SetRank]{setRankAnalysis}} function.
#' 
#' @param network A single network to generate a style for.
#' @param networkList A list of networks to generate a single style for.
#' @param outputFile The path for the ouputfile.
#' @return None. The function writes out a Cytoscape VizMap XML file as a 
#' side effect.
#' @author Cedric Simillion
#' @import XML
createCytoscapeVizMap <- function(network=NULL, networkList=NULL, 
		outputFile="setrank.xml") {
	if (is.null(network) && is.null(networkList))
		stop("You must either specify a network or a list of networks.")
	else if (!is.null(network) && !is.null(networkList))
		stop("You can only specify a network or a list of networks, not both.")
	if (is.null(networkList)) {
		networkList = list(network)
	}
	attributeTables = list(
			vertices = do.call(rbind, 
					lapply(networkList, get.data.frame, what="vertices")),
			edges = do.call(rbind, lapply(networkList, get.data.frame, what="edges"))
	)
	styleRoot = xmlRoot(styleXML)
	setRankStyle = styleRoot[[1]]
	setRankStyle[["node"]]$children = xmlSApply(setRankStyle[["node"]], 
			handleProperty,	propertyFunctions, attributeTables)
	setRankStyle[["edge"]]$children = xmlSApply(setRankStyle[["edge"]], 
			handleProperty, propertyFunctions, attributeTables)
	styleRoot[[1]] = setRankStyle
	saveXML(styleRoot, outputFile)
	NULL
}

handleProperty <- function(x, propertyFunctions, attributeTables) {
	if (x$name != "visualProperty" ||
			!(x$attributes["name"] %in% names(propertyFunctions))) {
		return(x)
	} 
	property = x$attributes["name"]
	if (property %in% names(propertyFunctions)) {
		x[[1]] = propertyFunctions[[property]](attributeTables)
	}
	return(x)
}

#' Generates a visual property mapping for p-value attributes
#' 
#' Used by the \code{createCytoscapeVizMap} function. For internal use only.
#' @param attributeTables A list of two elements, "\code{node}" and 
#' "\code{edge}" containing the concatenated node and edge attributes for all
#' networks supplied to \code{createCytoscapeVizMap}. 
#' @param graphAttribute The name of the node or edge attribute for which to
#' create the mapping
#' @return An xmlNode object representing the VizMap property mapping.
#' @export 
generatePMapping <- function(attributeTables, graphAttribute) {
	nodeTable = attributeTables$vertices
	edgeTable = attributeTables$edges
	ppValues = c(nodeTable$pp, edgeTable$sourceppDiff, edgeTable$sinkppDiff, 
			edgeTable$ppIntersection)
	ppValues = ppValues[ppValues > 0]
	lowP = -log10(0.05)
	middleP = median(ppValues)
	highP = quantile(ppValues, 0.95)
	generateContinuousMapping(graphAttribute, 
			c("#009999", "#990099", "#cc0000"), c(lowP, middleP, highP),
			lesserValue = "#000000")
}

#' Generates a continuous VizMap property mapping.
#' 
#' Used by the \code{createCytoscapeVizMap} function. For internal use only.
#' @param attributeName The node or edge attribute for which to create a visual
#' property mapping.
#' @param visualValues The values the visual property should have a key points.
#' @param attributeValues The key point attribute values
#' @param attributeType The type of the attribute. Must be either "\code{float}" or 
#' "\code{integer}".
#' @param lesserValue Optional. The value for the visual property for attribute
#' values below the lowest key point specified in \code{attributeValues}.
#' @param greaterValue Optional. The value for the visual property for attribute
#' values above the highest key point specified in \code{attributeValues}.
#' @return An xmlNode object representing the VizMap property mapping.
#' @export 
generateContinuousMapping <- function(attributeName, visualValues, 
		attributeValues, attributeType="float", lesserValue=NA, 
		greaterValue=NA) {
	stopifnot(length(visualValues) == length(attributeValues))
	pMapping = xmlNode("continuousMapping", 
			attrs=c(attributeType=attributeType, 
					attributeName=sprintf("%s", attributeName)))
	children = sapply(1:length(visualValues), function(i) {
				attributes = c(rep(visualValues[i], 3), attributeValues[i])
				names(attributes) = c("lesserValue", "equalValue", 
						"greaterValue", "attrValue")
				if (i == 1 && !is.na(lesserValue)) {
					attributes["lesserValue"] = lesserValue
				} else if (i == length(visualValues) && !is.na(greaterValue)) {
					attributes["greaterValue"] = greaterValue
				}
				xmlNode("continuousMappingPoint", attrs=attributes)
			})
	pMapping = addChildren(pMapping, kids=children)
	pMapping
}

#' Attribute handlers for generating the VizMap XML
#' 
#' A list of functions. Each name corresponds to a node or edge visual
#' property. The function tells the \code{\link{createCytoscapeVizMap}} 
#' function what type of attribute mapping to generate.
#' @docType data
#' @name propertyFunctions
NULL

#' VizMap XML template
#' 
#' Datastructure containg the template for the VizMap XML file. For internal
#' use only
#' @description data
#' @name styleXML
NULL