Merge branch 'flouvain' of ssh://gitlab.iscpif.fr:20022/gargantext/clustering-louvain into flouvain

src/Data/Graph/Clustering/Example.hs

@@ -20,12 +20,12 @@ import qualified Text.Parsec.Token as PT
 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
 
@@ -53,7 +53,7 @@ runIterations n gr = do
 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
 
@@ -145,9 +145,7 @@ gU = mkGraph' eU
 cuiller :: Gr () Double
 cuiller = gU
 
-
 -- Visual representation:
--- 
 --    2
 --   / \
 --  1   3

src/Data/Graph/Clustering/FLouvain.hs

@@ -54,7 +54,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
 

src/Data/Graph/Clustering/ILouvain.hs

@@ -84,7 +84,7 @@ mv g [a,b] [ ] = case match a g of
   (Just (p, n, l, s), g1) -> case match b l of
     (Nothing, _) -> panic "mv: snd Node of Path does not exist"
     (Just (p',n',l',s'), g2)  -> (p', n', g2 , s')
-                               -- & (p , n , empty, s )
+                               -- & (p , n , delNode b l, s )
                                & g1
 
 mv g (x:xs) (y:ys) = panic "mv: path too long"

src/Data/Graph/Clustering/Louvain.hs

@@ -19,10 +19,11 @@ 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.Louvain.Utils (LouvainNode(..), toFGraph)
+import Data.Graph.Clustering.FLouvain (louvainFirstStepIterate, Community(..), initialCGr)
 ------------------------------------------------------------------------
 -- | Definitions
 ------------------------------------------------------------------------
@@ -32,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
@@ -42,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
 ------------------------------------------------------------------------

src/Data/Graph/Clustering/Louvain/Utils.hs

@@ -46,16 +46,16 @@ map2graph m = mkGraph' $ map (\((n1,n2), w) -> (n1,n2,w)) $ Map.toList m
 
 
 mkFGraph :: [LNode a] -> [LEdge Double] -> FGraph a ()
-mkFGraph ns es = exampleRemap $ mkGraph ns es
+mkFGraph ns es = toFGraph $ mkGraph ns es
 
 
 mkFGraph' :: [LEdge Double] -> FGraph () ()
-mkFGraph' = exampleRemap . mkGraph'
+mkFGraph' = toFGraph . mkGraph'
 
 
 -- | Utility function to remap Gr () Double into FGraph () ()
-exampleRemap :: forall a. Gr a Double -> FGraph a ()
-exampleRemap gr = gmap remap gr
+toFGraph :: forall a. Gr a Double -> FGraph a ()
+toFGraph gr = gmap remap gr
   where
     remap :: Context a Double -> Context a (Weight, ())
     remap (p, v, l, s) = (p', v, l, s')