[ILouvain] fix HyperGraph' definition (and functions).

src/Data/Graph/Clustering/ILouvain.hs

@@ -9,13 +9,12 @@ Portability : POSIX
 
 ILouvain: really inductive Graph clustering with destructives updates
 
-Metagraph:
-metagraph (plural metagraphs) (mathematics) A graphical representation of a set of objects and the morphisms relating them
+metagraph (plural metagraphs) (mathematics) A representation of a set of nodes and the morphisms relating them
 https://en.wiktionary.org/wiki/metagraph
 
-todo FGL improvements:
-- deg should have return type Maybe Int
-- match should be Maybe (Context, Graph)
+TODO FGL improvements:
+- deg   :: Graph gr => gr a b -> Node -> Maybe Int
+- match :: Graph gr => Node -> gr a b -> Maybe (Context, Graph)
 
 -}
 
@@ -38,10 +37,10 @@ data NodePath = AllNodes | DfsNodes
 -- MetaGraph (x,y) where x is space (hyper structure of labels), y is
 -- time like (stream structure)
 -- (Below LabGraph definition)
-type HyperGraph' a b c = HyperGraph (HyperGraph a b) c
+type HyperGraph'  a b c = Gr (HyperGraph a b) c
 
-type HyperGraph   a b = Gr (Gr () a) b
-type HyperContext a b = Context (Gr () a) b
+type HyperGraph   a b   = Gr (Gr () a) b
+type HyperContext a b   = Context (Gr () a) b
 
 -- TODO: EdgeGraph (StreamGraph)
 -- type StreamGraph  a b = Gr a (Gr () b)
@@ -59,7 +58,7 @@ iLouvain :: (Eq a, Show a)
 iLouvain 0 s p g = g
 iLouvain n s p g
   | length (toNodes g') <= s = g'
-  | otherwise    = iLouvain' p g g'
+  | otherwise                = iLouvain' p g g'
     where
       g' = iLouvain (n-1) s p g
 
@@ -69,7 +68,7 @@ iLouvain' :: (Eq a, Show a)
           -> HyperGraph a a
           -> HyperGraph a a
           -> HyperGraph a a
-iLouvain' p g g' = -- trace (show ps :: Text)
+iLouvain' p g g' =   -- trace (show ps :: Text)
   iLouvain'' g g' ps -- $ filter (\n -> elem n (nodes g)) ps
     where
       -- quick trick to filter path but path of HyperGraph can be different
@@ -155,14 +154,19 @@ stepMax g g' x xs =
 
 ------------------------------------------------------------------------
 class IsHyperGraph a where
-  hnodes_      :: a -> Node -> [Node]
-  imodularity_ :: a -> a -> [Node] -> Double
-  gmodularity_ :: a -> a -> Double
   toHyperGraph_ :: Gr () Double -> a
-
+  hnodes_       :: a -> Node -> [Node]
   toNodes_      :: a -> [[Node]]
+
+  mv_           :: a -> [Node] -> [Node] -> a
+
+  -- flat is to HyperGraph what is empty to Graph
+  flat_         :: a
   isFlat_       :: a -> Bool
 
+  imodularity_  :: a -> a -> [Node] -> Double
+  gmodularity_  :: a -> a -> Double
+  
 ------------------------------------------------------------------------
 hnodes :: HyperGraph a b -> Node -> [Node]
 hnodes g n = case match n g of
@@ -170,22 +174,24 @@ hnodes g n = case match n g of
   (Just (p, n, l, s), _) -> n : nodes l
 
 hnodes' :: HyperGraph' a b c -> Node -> [Node]
-hnodes' g n = concat $ map (hnodes g) $ hnodes g n
+hnodes' g n = case match n g of
+  (Nothing          , _) -> []
+  (Just (p, n, l, s), _) -> n : (concat $ map (hnodes l) $ nodes l)
+
 ------------------------------------------------------------------------
 toNodes :: HyperGraph a a -> [[Node]]
 toNodes g = map (hnodes g) (nodes g)
 
 toNodes' :: HyperGraph' a b c -> [[Node]]
 toNodes' g = map (hnodes' g) (nodes g)
+
 ------------------------------------------------------------------------
 isFlat :: HyperGraph a b -> Bool
 isFlat g = all (isEmpty . snd) (labNodes g)
 
--- flatten
-{-
-isFlat' :: HyperGraph' a b c-> Bool
-isFlat' g = all (isFlat . concat . (map nodes) . snd) (labNodes g)
--}
+-- needs of flatten?
+isFlat' :: HyperGraph' a b c -> Bool
+isFlat' g = all (isFlat . snd) (labNodes g)
 
 
 {-
@@ -193,6 +199,7 @@ hdeg :: Graph gr => gr a b -> Node -> Maybe Int
 hdeg = undefined
 -}
 ------------------------------------------------------------------------
+------------------------------------------------------------------------
 -- TODO go depth in HyperGraph (modularity at level/depth)
 imodularity :: HyperGraph a b -> HyperGraph a a -> [Node] -> Double
 imodularity g g' ns = -- trace ("imodul" :: Text) $
@@ -207,14 +214,14 @@ imodularity' g g' ns =
                  $ fromList
                  $ concat
                  $ map (hnodes' g') ns
-
-
+------------------------------------------------------------------------
 gmodularity :: HyperGraph a b -> HyperGraph a a -> Double
 gmodularity g g' = sum $ map (\n -> imodularity g g' [n]) $ nodes g'
 
 gmodularity' :: HyperGraph' a b c -> HyperGraph' a b c -> Double
 gmodularity' g g' = sum $ map (\n -> imodularity' g g' [n]) $ nodes g'
 
+------------------------------------------------------------------------
 ------------------------------------------------------------------------
 toHyperGraph :: Gr () Double -> HyperGraph Double Double
 toHyperGraph g = nmap (\_ -> empty) g
@@ -222,6 +229,9 @@ toHyperGraph g = nmap (\_ -> empty) g
 emptyHyperGraph :: HyperGraph Double Double
 emptyHyperGraph = toHyperGraph empty
 
+emptyHyperGraph' :: HyperGraph' Double Double Double
+emptyHyperGraph' = undefined
+
 {-
 toHyperGraph' :: Gr () Double -> HyperGraph' Double Double Double
 toHyperGraph' g = nmap (\_ -> emptyHyperGraph) g
@@ -306,9 +316,9 @@ mvMContext (Just (a1 ,n ,l ,a2 ))
             where
               c = (a1, n, (), a2)
 
-mvMContext _ (Just _) = panic "mvmcontext: First Node  does not exist"
-mvMContext (Just _) _ = panic "mvmcontext: Snd   Node  does not exist"
-mvMContext _ _        = panic "mvmcontext: Both  Nodes do   not exist"
+mvMContext _ (Just _) = panic "mvMContext: First Node  does not exist"
+mvMContext (Just _) _ = panic "mvMContext: Snd   Node  does not exist"
+mvMContext _ _        = panic "mvMContext: Both  Nodes do   not exist"
 
 merge :: (Graph gr, DynGraph gr)
       => gr a b -> gr a b -> gr a b
@@ -336,6 +346,5 @@ path g' = map sortNodes cs
 
 path' :: (DynGraph gr, Eq b) => gr a b -> [Node]
 path' = maybe [] identity  . head . path
-
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------