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

src/Data/Graph/Clustering/ILouvain.hs

@@ -14,25 +14,37 @@ ILouvain: really inductive Graph
 module Data.Graph.Clustering.ILouvain
   where
 
+import Data.Set (fromList)
 import Data.Maybe (catMaybes)
 import Data.List (zip, cycle)
 import Protolude hiding (empty, (&))
 import Data.Graph.Inductive
+import qualified Data.Graph.Clustering.HLouvain as H
 
 ------------------------------------------------------------------------
 -- HyperGraph Definition
 type HyperGraph   a b = Gr (Gr () a) b
 type HyperContext a b = Context (Gr () a) b
 
+-- TODO Later (hypothesis still)
+-- type StreamGraph  a b = Gr a (Gr () b)
 
-toInfra :: Gr (Gr () a) b -> Gr () a
-toInfra = undefined
 
-toSupra :: Gr () a -> Gr (Gr () a) b
-toSupra = undefined
+hnodes :: HyperGraph a b -> Node -> [Node]
+hnodes g n = case match n g of
+  (Nothing, _) -> []
+  (Just (p, n, l, s), _) -> n : nodes l
+
+hedges :: HyperGraph a b -> Node -> [Edge]
+hedges = undefined
+
+hneighbors :: HyperGraph a b -> Node -> [Node]
+hneighbors = undefined
+
+------------------------------------------------------------------------
+modularity :: HyperGraph a b -> [Node] -> Double
+modularity g ns = H.modularity g (fromList ns)
 
--- TODO Later (hypothesis still)
--- type StreamGraph  a b = Gr a (Gr () b)
 ------------------------------------------------------------------------
 -- Spoon Graph
 --    1
@@ -78,14 +90,16 @@ mv g [ ] [ ] = g
 mv g [_] [ ] = g
 mv g [ ] [_] = g
 
-mv g [a]   [b] = mv' g a b
+mv g [a] [b] = case a == b of
+  True  -> panic "mv, impossible: moved node is same as destination"
+  False -> mv' g a b
 mv g [a,b] [ ] = case match a g of
   (Nothing,  _) -> panic "mv: fst Node of Path does not exist"
   (Just (p, n, l, s), g1) -> case match b l of
+    (Just (p',n',l',s'), g2)  -> (p', n', g2, s')
+                               & ((p , n , delNode b l , s )
+                               & g1)
     (Nothing, _) -> panic "mv: snd Node of Path does not exist"
-    (Just (p',n',l',s'), g2)  -> (p', n', g2 , s')
-                               -- & (p , n , delNode b l, s )
-                               & g1
 
 mv g (x:xs) (y:ys) = panic "mv: path too long"
 
@@ -116,7 +130,9 @@ merge :: (Graph gr, DynGraph gr)
       => gr a b -> gr a b -> gr a b
 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
 {-