[FEAT] Separate function for clusters. Need to optimized.

louvain.cabal

@@ -15,9 +15,10 @@ cabal-version:       >=1.10
 
 library
   hs-source-dirs:      src
-  exposed-modules:     Data.Louvain
+  exposed-modules:     Data.Louvain, Data.GexfParser
   build-depends:       base >= 4.7 && < 5
                        , fgl
+                       , hxt
   default-language:    Haskell2010
 
 -- executable louvain-exe

src/Data/GexfParser.hs

+{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}
+
+module Data.GexfParser where
+
+import Text.XML.HXT.Core
+import qualified Data.Graph as DataGraph
+import qualified Data.Graph.Inductive as FGL
+import System.Environment (getArgs)
+
+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)
+
+
+getDataGraphNode' :: Graph -> String -> (Int, [Int])
+getDataGraphNode' graph node = (read node, Prelude.map read (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)
+
+getDataGraphNodeList' :: Graph -> [(Int, [Int])]
+getDataGraphNodeList' graph = map (getDataGraphNode' graph) (nodes graph)
+
+--  Convert Graph structure to Data.Graph-importable tuple list
+importGraph :: FilePath -> IO [(Int, [Int])]
+importGraph file = do
+    graphs <- runX (readDocument [withValidate no] file >>> parseGraph)
+    let graphEdges = getDataGraphNodeList' $ head graphs
+    return graphEdges
+
+--importGraph' :: FilePath -> IO [(Int, [Int])]
+importGraph' file = runX (readDocument [withValidate no] file >>> parseGraph)
+
+importGraph'' :: FilePath -> IO [FGL.LEdge Double]
+importGraph'' file = Prelude.map (\(a,b) -> (read a, read b, 1)) <$> edges <$> head <$> importGraph' file
+
+
+--main :: IO()
+main = do
+    [file] <- getArgs
+    importGraph file >>= print
+
+    -- 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)

src/Data/Louvain.hs

@@ -20,7 +20,6 @@ mkGraph' es = mkGraph ns es
             where ns' = S.toList . S.fromList $ concat (Prelude.map edge2nodes es)
 
 
-
 edge2nodes :: LEdge b -> [Node]
 edge2nodes (a,b,_) = [a,b]
 
@@ -121,8 +120,14 @@ separate (x:xs) = let recur = separate xs
                         return $ (x:y):ys
                   in split ++ noSplit
 
+separate' xs = [ takeDrop t (rotate r xs) 
+               | t <- [1.. fromIntegral (length xs) - 1 ]
+               , r <- [0.. fromIntegral (length xs)     ]
+               ]
+
+
 gpartition :: DynGraph gr => gr a b -> [[[Node]]]
-gpartition gr = separate (nodes gr)
+gpartition gr = separate' (nodes gr)
 
 modularities :: DynGraph gr => gr a b -> [[Node]] -> Double
 modularities gr xs = sum $ Prelude.map (\y -> modularity gr y) xs

src/Lib.hs

-module Lib
-    ( someFunc
-    ) where
-
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"