[ILouvain] fix paths

src/Data/Graph/Clustering/FLouvain.hs

 {-|
 Module      : Data.Graph.Clustering.FLouvain
 Description : Purely functional (Inductive) Louvain clustering
-Copyright   : (c) Alexandre Delanoë, CNRS, 2020-Present
+Copyright   : (c) CNRS, 2020-Present
 License     : AGPL + CECILL v3
-Maintainer  : alexandre.delanoe+louvain@iscpif.fr
+Maintainer  : contact@gargantext.org
 Stability   : experimental
 Portability : POSIX
 

src/Data/Graph/Clustering/HLouvain.hs

@@ -103,7 +103,7 @@ toDendo :: DynGraph gr
         -> Dendogram
 toDendo g n = Dendogram [Gram n] s
   where
-    s = modularity g (Set.singleton n)
+    s = hmodularity g (Set.singleton n)
 
 toDendoD :: DynGraph gr
          => gr n e
@@ -173,17 +173,17 @@ class HasScore a
 instance HasScore Dendogram
   where
     hasScore :: DynGraph gr => gr a b -> Dendogram -> Double
-    hasScore g m = modularity g (nodesD m)
+    hasScore g m = hmodularity g (nodesD m)
 
 instance HasScore [Dendogram]
   where
-    hasScore g ds = modularity g (Set.unions $ map nodesD ds)
+    hasScore g ds = hmodularity g (Set.unions $ map nodesD ds)
 
 modulare :: DynGraph gr => gr a b -> Set Node -> Double
-modulare = modularity
+modulare = hmodularity
 
-modularity :: DynGraph gr => gr a b -> Set Node -> Double
-modularity gr ns = coverage - edgeDensity
+hmodularity :: DynGraph gr => gr a b -> Set Node -> Double
+hmodularity gr ns = coverage - edgeDensity
   where
     coverage :: Double
     coverage  = sizeSubGraph / sizeAllGraph 

src/Data/Graph/Clustering/ILouvain.hs

@@ -7,7 +7,8 @@ Maintainer  : alexandre.delanoe+louvain@iscpif.fr
 Stability   : experimental
 Portability : POSIX
 
-ILouvain: really inductive Graph
+ILouvain: really inductive Graph clustering with destructives updates
+
 -}
 
 module Data.Graph.Clustering.ILouvain
@@ -28,40 +29,44 @@ type HyperContext a b = Context (Gr () a) b
 -- TODO Later (hypothesis still)
 -- type StreamGraph  a b = Gr a (Gr () b)
 
-{-
-convergence :: HyperGraph a b -> HyperGraph a b
-convergence g = if m - m' > 0.1 then g else g'
-  where
-    m  = modularity g  (hnodes g )
-    m' = modularity g' (hnodes g')
-    g' = step g
--}
 
+toNodes :: HyperGraph a a -> [[Node]]
 toNodes g = map (\n -> hnodes g n) (nodes g)
 
-iLouvain :: (Eq a) => HyperGraph a a -> HyperGraph a a
-iLouvain g = iLouvain' g $ nodes g
+iLouvain :: Eq a => HyperGraph a a -> HyperGraph a a
+iLouvain g = iLouvain' g (iLouvain' g g)
 
-iLouvain' :: HyperGraph a a -> [Node] -> HyperGraph a a
-iLouvain' g [ ] = g
-iLouvain' g [_] = g
-iLouvain' g ns  = foldl' (\g1 n -> step' g g1 n $ neighbors g1 n) g ns
+iLouvain' :: (Eq a)
+          => HyperGraph a a
+          -> HyperGraph a a
+          -> HyperGraph a a
+iLouvain' g0 g = iLouvain'' g $ filter (\n -> elem n (nodes g)) ps
+  where
+    ps = path' g0
+
+iLouvain'' :: HyperGraph a a
+           -> [Node]
+           -> HyperGraph a a
+iLouvain'' g [ ] = g
+iLouvain'' g [_] = g
+iLouvain'' g ns  = foldl' (\g1 n -> step' g g1 n $ neighbors g1 n) g ns
 
 step' :: HyperGraph a b
      -> HyperGraph a a
      -> Node
      -> [Node]
      -> HyperGraph a a
-step' g g' n ns = foldl' (\g1 n' -> case match n g1 of
-                         (Nothing, _) -> g1
-                         (Just _, _ ) ->  step g g1 n n') g' ns
+step' g g' n ns =
+  foldl' (\g1 n' -> case match n g1 of
+           (Nothing, _) -> g1
+           (Just _, _ ) ->  step g g1 n n') g' ns
 
 step :: HyperGraph a b
      -> HyperGraph a a
      -> Node
      -> Node
      -> HyperGraph a a
-step g g' n1 n2 = -- trace (show n1 :: Text) $
+step g g' n1 n2 = trace (show n1 :: Text) $
   if s2 > 0 && s2 > s1
     then mv g' [n1] [n2]
     else g'
@@ -81,10 +86,11 @@ hdeg = undefined
 ------------------------------------------------------------------------
 -- TODO go depth in HyperGraph (modularity at level/depth)
 imodularity :: HyperGraph a b -> [Node] -> Double
-imodularity g ns = H.modularity g (fromList ns)
+imodularity g ns = H.hmodularity g (fromList ns')
+  where
+    ns' = concat $ map (\n -> hnodes g n) ns
 
 ------------------------------------------------------------------------
-
 toHyperGraph :: Gr () Double -> HyperGraph Double Double
 toHyperGraph g = nmap (\_ -> empty) g
 ------------------------------------------------------------------------
@@ -175,18 +181,6 @@ merge = ufold (&)
 ------------------------------------------------------------------------
 test_mv :: Ord a => HyperGraph a a -> Node -> Node -> Bool
 test_mv g a b = (mv (mv g [a] [b]) [b,a] []) == g
-------------------------------------------------------------------------
--- | Recursive Node of Graph
-{-
-rnodes :: RGraph -> [Node]
-rnodes Empty = []
-rnodes g     = concat $ map (\(x1, x2) -> [x1] <> rnodes x2) $ labNodes g
-
-rlabNodes :: Graph' a b -> [LNode a]
-rlabNodes Empty' = []
-rlabNodes g      = labNodes g
--}
-
 ------------------------------------------------------------------------
 -- Paths in the Graph to be tested
 -- Directed graph strategy