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

src/Data/Graph/Clustering/FLouvain.hs

@@ -198,7 +198,8 @@ delta com ki kiin m = DeltaQ $ acc - dec
 -- We could avoid the higher complexity, eg. by precomputing the whole graph
 -- into a HashMap Node [Edge].
 iteration :: FGraph a b -> CGr -> CGr
-iteration gr cs = xdfsFoldWith suc' (\(_, v, _, _) -> step gw $ context gr  v) cs (nodes gr) gr
+iteration gr cs = xdfsFoldWith suc' (\(_, v, _, _)
+                -> step gw $ context gr $ v) cs (nodes gr) gr
   where
     gw = graphWeight gr
     --weightSum = ufold weightSum' 0 gr
@@ -221,7 +222,8 @@ step gw ctx@(p, v, l, s) cgr = newCgr
         else
           cgr
 
-    (bestFitCom, DeltaQ bestFitdq) = maximumBy (\(_, deltaq1) (_, deltaq2) -> compare deltaq1 deltaq2) deltas
+    (bestFitCom, DeltaQ bestFitdq) =
+      maximumBy (\(_, deltaq1) (_, deltaq2) -> compare deltaq1 deltaq2) deltas
 
     mNc :: Maybe (LNode Community)
     mNc = nodeCommunity v cgr

src/Data/Graph/Clustering/ILouvain.hs

@@ -47,7 +47,6 @@ toSupra = undefined
 --    4
 --    |
 --    5
-
 spoon :: HyperGraph Double Double
 spoon = mkGraph ns es
   where
@@ -80,14 +79,22 @@ spoon = mkGraph ns es
 mv :: HyperGraph a a
    -> [Node] -> [Node]
    -> HyperGraph a a
-mv g []  []  = g
-mv g [_] []  = g
-mv g []  [_] = g
+mv g [ ] [ ] = g
+mv g [_] [ ] = g
+mv g [ ] [_] = g
 
 mv g [a]   [b] = mv' g a b
-mv g [a,b] [] = undefined
+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
+    (Nothing, _) -> panic "mv: snd Node of Path does not exist"
+    (Just (p',n',l',s'), g2)  -> (p', n', g2 , s')
+                               -- & (p , n , empty, s )
+                               & g1
+
+mv g (x:xs) (y:ys) = panic "mv: path too long"
 
-mv g (x:xs) (y:ys) = panic "mv path too long"
+                  ----------------------------
 
 -- | Start simple (without path)
 mv' :: HyperGraph a a
@@ -102,13 +109,17 @@ mvMContext :: Maybe (HyperContext a a)
            -> Maybe (HyperContext a a)
            -> HyperContext a a
 mvMContext (Just (a1 ,n ,l ,a2 ))
-           (Just (a1',n',l',a2')) = (a1',n',c'&l,a2')
+           (Just (a1',n',l',a2')) = (a1',n', merge l' (c & l),a2')
             where
-              c' = (a1, n, (), a2)
+              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 "First Node  does not exist"
-mvMContext (Just _) _ = panic "Snd   Node  does not exist"
-mvMContext _ _        = panic "Both  Nodes do   not exist"
+merge :: (Graph gr, DynGraph gr)
+      => gr a b -> gr a b -> gr a b
+merge = ufold (&)
 
 
 ------------------------------------------------------------------------