问题
I'm trying to read a GraphML file containing a single directed Graph into a Haskell Data.Graph in order to run an analysis using the Math.Combinatorics.Graph module.
However, I can't find any module that allows me to read a GraphML file, producing a Data.Graph
. One related module I found is ForSyDe.Backend.GraphML. However, this seems to be specific to the ForSyDe
DSL and I currently can't think of a way to use it to read a plain Data.Graph
.
Could you point me to a library allowing me to read GraphML, preferably with some example code on how to use it?
回答1:
After more than a week of searching, I assume there is currently no GraphML parser library in existence. Therefore I wrote my own minimal parser.
Let's assume we have this GraphML:
<?xml version="1.0" encoding="UTF-8"?>
<graphml xmlns="http://graphml.graphdrawing.org/xmlns"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://graphml.graphdrawing.org/xmlns
http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd">
<graph id="G" edgedefault="undirected">
<node id="n0"/>
<node id="n1"/>
<node id="n2"/>
<node id="n3"/>
<edge id="e1" source="n0" target="n1"/>
<edge id="e1" source="n1" target="n2"/>
<edge id="e1" source="n1" target="n3"/>
<edge id="e1" source="n3" target="n0"/>
</graph>
</graphml>
I created this HXT-based parser that's able to parse a minimal subset of GraphML (just enough to create a Data.Graph of the above GraphML). The main
function of the following file represents an example of how to use it: It prints the list of nodes in the graph (also see this related question ).
{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}
import Text.XML.HXT.Core
import qualified Data.Graph as DataGraph
data Graph = Graph
{ graphId :: String,
nodes :: [String],
edges :: [(String, String)] -- (Source, target)
}
deriving (Show, Eq)
atTag tag = deep (isElem >>> hasName tag)
parseEdges = atTag "edge" >>>
proc e -> do
source <- getAttrValue "source" -< e
target <- getAttrValue "target" -< e
returnA -< (source, target)
parseNodes = atTag "node" >>>
proc n -> do
nodeId <- getAttrValue "id" -< n
returnA -< nodeId
parseGraph = atTag "graph" >>>
proc g -> do
graphId <- getAttrValue "id" -< g
nodes <- listA parseNodes -< g
edges <- listA parseEdges -< g
returnA -< Graph{graphId=graphId, nodes=nodes, edges=edges}
getEdges = atTag "edge" >>> getAttrValue "source"
-- Get targets for a single node in a Graph
getTargets :: String -> Graph -> [String]
getTargets source graph = map snd $ filter ((==source).fst) $ edges graph
-- Convert a graph node into a Data.Graph-usable
getDataGraphNode :: Graph -> String -> (String, String, [String])
getDataGraphNode graph node = (node, node, getTargets node graph)
-- Convert a Graph instance into a Data.Graph list of (node, nodeid, edge) tuples
getDataGraphNodeList :: Graph -> [(String, String, [String])]
getDataGraphNodeList graph = map (getDataGraphNode graph) (nodes graph)
main :: IO()
main = do
graphs <- runX (readDocument [withValidate no] "foo.graphml" >>> parseGraph)
-- Convert Graph structure to Data.Graph-importable tuple list
let graphEdges = getDataGraphNodeList $ head graphs
-- Convert to a Data.Graph
let (graph, vertexMap) = DataGraph.graphFromEdges' graphEdges
-- Example of what to do with the Graph: Print vertices
print $ map ((\ (vid, _, _) -> vid) . vertexMap) (DataGraph.vertices graph)
来源:https://stackoverflow.com/questions/21035103/reading-graphml-in-haskell