[ILouvain] ok for consecutives steps, testing now.

src/Data/Graph/Clustering/HLouvain.hs

@@ -183,25 +183,31 @@ modulare :: DynGraph gr => gr a b -> Set Node -> Double
 modulare = hmodularity
 
 hmodularity :: DynGraph gr => gr a b -> Set Node -> Double
-hmodularity gr ns = coverage - edgeDensity
+hmodularity g ns = coverage - edgeDensity
   where
     coverage :: Double
-    coverage  = sizeSubGraph / sizeAllGraph 
-      where
-          sizeSubGraph :: Double
-          sizeSubGraph = fromIntegral ( G.size $ subgraph' ns gr )
+    coverage  = -- trace ("coverage" :: Text) $
+      sizeSubGraph / sizeAllGraph
+        where
+            sizeSubGraph :: Double
+            sizeSubGraph = -- trace ("sizeSubGraph" :: Text) $
+              fromIntegral ( G.size $ subgraph' ns g )
 
-          sizeAllGraph :: Double
-          sizeAllGraph = fromIntegral (G.size gr)
+            sizeAllGraph :: Double
+            sizeAllGraph = -- trace ("sizeAllGraph" :: Text) $
+              fromIntegral (G.size g)
 
     edgeDensity :: Double
-    edgeDensity = (sum (Set.map (\node -> (degree node) / links ) ns)) ** 2
-      where
-          degree :: Node -> Double
-          degree node = fromIntegral (G.deg gr node)
-
-          links :: Double
-          links       = fromIntegral (2 * (G.size gr))
+    edgeDensity = -- trace ("edgeDensity" :: Text) $
+      (sum (Set.map (\node -> (degree node) / links ) ns)) ** 2
+        where
+            degree :: Node -> Double
+            degree node = -- trace ("degree" :: Text) $
+              fromIntegral (G.deg g node)
+
+            links :: Double
+            links  = -- trace ("links" :: Text) $
+              fromIntegral (2 * (G.size g))
 
 subgraph' :: DynGraph gr => Set Node -> gr a b -> gr a b
 subgraph' ns = G.subgraph (Set.toList ns)

src/Data/Graph/Clustering/ILouvain.hs

@@ -29,55 +29,76 @@ type HyperContext a b = Context (Gr () a) b
 -- TODO Later (hypothesis still)
 -- type StreamGraph  a b = Gr a (Gr () b)
 
-
 toNodes :: HyperGraph a a -> [[Node]]
-toNodes g = map (\n -> hnodes g n) (nodes g)
+toNodes g = map (hnodes g) (nodes g)
 
-iLouvain :: Eq a => HyperGraph a a -> HyperGraph a a
-iLouvain g = iLouvain' g (iLouvain' g g)
+iLouvain :: (Eq a, Show a)
+         => Int -> HyperGraph a a -> HyperGraph a a
+iLouvain 1 g = (iLouvain' g g)
+iLouvain 2 g = iLouvain' g (iLouvain 1 g)
+iLouvain 3 g = iLouvain' g (iLouvain 2 g)
+iLouvain 4 g = iLouvain' g (iLouvain 3 g)
+iLouvain 5 g = iLouvain' g (iLouvain 4 g)
 
-iLouvain' :: (Eq a)
+iLouvain' :: (Eq a, Show a)
           => HyperGraph a a
           -> HyperGraph a a
           -> HyperGraph a a
-iLouvain' g0 g = iLouvain'' g $ filter (\n -> elem n (nodes g)) ps
+iLouvain' g0 g = iLouvain'' g0 $ filter (\n -> elem n (nodes g)) ps
   where
-    ps = path' g0
+    -- quick trick to filter path but path of HyperGraph can be different
+    ps = nodes g0
+    -- ps = path' g0
 
-iLouvain'' :: HyperGraph a a
+iLouvain'' :: Show a
+           => 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
+iLouvain'' g ns  = foldl' (\g1 n -> step' g g1 n
+                          $ filter (\m -> elem m (nodes g1))
+                          $ neighbors g n
+                          ) g ns
+-- /!\ Above fixes possible error
+-- g1 has holes in network (case below):
+-- iLouvain'' g ns  = foldl' (\g1 n -> step' g g1 n $ neighbors g1 n) g ns
+
+step' :: Show a
+     => HyperGraph a b
      -> HyperGraph a a
      -> Node
      -> [Node]
      -> HyperGraph a a
-step' g g' n ns =
+step' g g' n ns = -- trace ("step'" :: Text) $
   foldl' (\g1 n' -> case match n g1 of
            (Nothing, _) -> g1
-           (Just _, _ ) ->  step g g1 n n') g' ns
+           (Just _, _ ) -> step g g1 n n'
+          ) g' ns
 
-step :: HyperGraph a b
+step :: Show a
+     => HyperGraph a b
      -> HyperGraph a a
      -> Node
      -> Node
      -> HyperGraph a a
-step g g' n1 n2 = trace (show n1 :: Text) $
-  if s2 > 0 && s2 > s1
-    then mv g' [n1] [n2]
-    else g'
+step g g' n1 n2 = -- trace ("step" :: Text) $
+  -- if s2 > 0 && s2 >= s1
+  if s2 >= s1
+    then -- trace ("step:mv" :: Text) $
+      mv g' [n1] [n2]
+    else -- trace ("step:else" :: Text) $
+      g'
   where
-    s1 = imodularity g [n1]
-    s2 = imodularity g [n1,n2]
+    s1 = -- trace ("mod1" :: Text) $
+      imodularity g [n1]
+    s2 = -- trace ("mod2" :: Text) $
+      imodularity g [n1,n2]
 
 ------------------------------------------------------------------------
 hnodes :: HyperGraph a b -> Node -> [Node]
 hnodes g n = case match n g of
-  (Nothing, _) -> []
+  (Nothing          , _) -> []
   (Just (p, n, l, s), _) -> n : nodes l
 {-
 hdeg :: Graph gr => gr a b -> Node -> Maybe Int
@@ -86,9 +107,11 @@ hdeg = undefined
 ------------------------------------------------------------------------
 -- TODO go depth in HyperGraph (modularity at level/depth)
 imodularity :: HyperGraph a b -> [Node] -> Double
-imodularity g ns = H.hmodularity g (fromList ns')
-  where
-    ns' = concat $ map (\n -> hnodes g n) ns
+imodularity g ns = -- trace ("imodul" :: Text) $
+                   H.hmodularity g
+                 $ fromList
+                 $ concat
+                 $ map (hnodes g) ns
 
 ------------------------------------------------------------------------
 toHyperGraph :: Gr () Double -> HyperGraph Double Double
@@ -131,7 +154,7 @@ spoon = mkGraph ns es
 
 -- Move target type
 -- let's start simple: path lenght <= 2 max
-mv :: HyperGraph a a
+mv :: Show a => HyperGraph a a
    -> [Node] -> [Node]
    -> HyperGraph a a
 mv g [ ] [ ] = g
@@ -154,13 +177,14 @@ mv g (x:xs) (y:ys) = panic "mv: path too long"
                   ----------------------------
 
 -- | Start simple (without path)
-mv' :: HyperGraph a a
+mv' :: Show a => HyperGraph a a
     -> Node -> Node
     -> HyperGraph a a
-mv' g n1 n2 =  (mvMContext c1 c2) & g2
-  where
-    (c1, g1) = match n1 g
-    (c2, g2) = match n2 g1
+mv' g n1 n2 = -- trace (show (c1,c2) :: Text) $ 
+  (mvMContext c1 c2) & g2
+    where
+      (c1, g1) = match n1 g
+      (c2, g2) = match n2 g1
 
 mvMContext :: Maybe (HyperContext a a)
            -> Maybe (HyperContext a a)
@@ -179,7 +203,7 @@ merge :: (Graph gr, DynGraph gr)
 merge = ufold (&)
 
 ------------------------------------------------------------------------
-test_mv :: Ord a => HyperGraph a a -> Node -> Node -> Bool
+test_mv :: (Ord a, Show a) => HyperGraph a a -> Node -> Node -> Bool
 test_mv g a b = (mv (mv g [a] [b]) [b,a] []) == g
 ------------------------------------------------------------------------
 -- Paths in the Graph to be tested