[FUN] flouvain function.

src/Data/Graph/Clustering/Example.hs

 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE TupleSections     #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module Data.Graph.Clustering.Example where
 
@@ -16,8 +18,8 @@ import Text.Parsec.Language (haskellStyle)
 import qualified Text.Parsec.Token as PT
 
 -- | Utility function to remap Gr () Double into FGraph () ()
-exampleRemap :: Gr () Double -> FGraph () ()
-exampleRemap gr = gmap remap gr
+toFgraph :: Gr () Double -> FGraph () ()
+toFgraph gr = gmap remap gr
   where
     remap :: Context () Double -> Context () (Weight, ())
     remap (p, v, l, s) = (p', v, l, s')
@@ -33,16 +35,16 @@ exampleRemap gr = gmap remap gr
 iterateOnce :: Gr () Double -> CGr
 iterateOnce gr = iteration fgr cgr
   where
-    fgr = exampleRemap gr
+    fgr = toFgraph    gr
     cgr = initialCGr fgr
 
 runIterations :: Int -> Gr () Double -> IO ()
 runIterations n gr = do
-  let fgr = exampleRemap gr
+  let fgr       = toFgraph gr
   let fgrWeight = graphWeight fgr
-  let initCgr = initialCGr fgr
+  let initCgr   = initialCGr fgr
 
-  putStrLn "Initial modularity: "
+  putStrLn ("Initial modularity: " :: Text)
   putStrLn $ T.unpack $ show $ modularity fgr initCgr fgrWeight
 
   foldM_ (runIteration fgr fgrWeight) initCgr [0..n]
@@ -50,18 +52,18 @@ runIterations n gr = do
   where
     runIteration fgr fgrWeight iterCgr i = do
       let iterNextCgr = iteration fgr iterCgr
-      putStrLn $ "----- ITERATION " <> show i
+      putStrLn $ ("----- ITERATION " :: Text) <> show i
       putStrLn $ prettify iterNextCgr
-      putStrLn $ show i <> " iteration modularity: "
+      putStrLn $ show i <> (" iteration modularity: " :: Text)
       putStrLn $ T.unpack $ show $ modularity fgr iterNextCgr fgrWeight
       return iterNextCgr
 
 runLouvainFirstStepIterate :: Int -> Gr () Double -> (Modularity, CGr)
 runLouvainFirstStepIterate n gr = (modularity fgr cgr m, cgr)
   where
-    fgr = exampleRemap gr
+    fgr = toFgraph gr
     cgr = louvainFirstStepIterate n fgr
-    m = graphWeight fgr
+    m   = graphWeight fgr
 
 -- | egr <- readPythonGraph "<file-path>"
 -- let gr = head $ Data.Either.rights [egr]
@@ -152,9 +154,7 @@ gU = mkGraph' eU
 cuiller :: Gr () Double
 cuiller = gU
 
-
 -- Visual representation:
--- 
 --    2
 --   / \
 --  1   3

src/Data/Graph/Clustering/FLouvain.hs

@@ -57,7 +57,10 @@ data ClusteringMethod = Glue | Klue
 -- 'a' is the initial value
 fixPt :: Int -> (a -> a) -> (a -> Bool) -> a -> a
 fixPt 0 iterator _ init = iterator init
-fixPt n iterator cond init = if cond next then fixPt (n - 1) iterator cond init else next
+fixPt n iterator cond init = 
+  if cond next
+     then fixPt (n - 1) iterator cond init
+     else next
   where
     next = iterator init
 
@@ -65,10 +68,10 @@ fixPt n iterator cond init = if cond next then fixPt (n - 1) iterator cond init
 louvainFirstStepIterate :: Int -> FGraph a b -> CGr
 louvainFirstStepIterate n gr = fixPt n iterator cond initCGr
   where
-    initCGr = initialCGr gr
-    grWeight = graphWeight gr
-    iterator cgr = iteration gr cgr
-    cond cgr = (unModularity $ modularity gr cgr grWeight) < 0.1
+    initCGr      = initialCGr  gr
+    grWeight     = graphWeight gr
+    iterator cgr = iteration   gr cgr
+    cond cgr     = (unModularity $ modularity gr cgr grWeight) < 0.1
 
 ------------------------------------------------------------------------
 -- | Specific FGL needed functions

src/Data/Graph/Clustering/Louvain.hs

@@ -18,10 +18,12 @@ References:
 module Data.Graph.Clustering.Louvain 
   where
 
+import Data.Tuple.Extra (fst3)
 import Data.List (maximumBy, nub, intersect, foldl', zipWith, concat)
 import Data.Graph.Inductive
 import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
-
+import Data.Graph.Clustering.FLouvain (louvainFirstStepIterate, Community(..), initialCGr)
+import Data.Graph.Clustering.Example (toFgraph)
 ------------------------------------------------------------------------
 -- | Definitions
 ------------------------------------------------------------------------
@@ -31,6 +33,11 @@ type Community = [Node]
 -- type Partition = [Community]
 type Reverse = Bool
 
+------------------------------------------------------------------------
+flouvain :: Int -> Gr () Double -> [[Node]]
+flouvain n g = map (fst3 . unCommunity . snd) $ labNodes g'
+  where
+    g' = louvainFirstStepIterate n (toFgraph g)
 ------------------------------------------------------------------------
 hLouvain :: (Eq b, DynGraph gr)
          => Reverse
@@ -41,7 +48,6 @@ hLouvain r g = concat $ toLouvainNode (bestpartition r g)
     toLouvainNode :: [[Node]] -> [[LouvainNode]]
     toLouvainNode ns = zipWith (\cId ns' -> map (\n -> LouvainNode n cId) ns')
                                [1..] ns
-
 ------------------------------------------------------------------------
 -- | Partitionning the graph
 ------------------------------------------------------------------------