Commit 97a4e7fc authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

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

parents c75e7b68 640915a9
...@@ -198,7 +198,8 @@ delta com ki kiin m = DeltaQ $ acc - dec ...@@ -198,7 +198,8 @@ delta com ki kiin m = DeltaQ $ acc - dec
-- We could avoid the higher complexity, eg. by precomputing the whole graph -- We could avoid the higher complexity, eg. by precomputing the whole graph
-- into a HashMap Node [Edge]. -- into a HashMap Node [Edge].
iteration :: FGraph a b -> CGr -> CGr 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 where
gw = graphWeight gr gw = graphWeight gr
--weightSum = ufold weightSum' 0 gr --weightSum = ufold weightSum' 0 gr
...@@ -221,7 +222,8 @@ step gw ctx@(p, v, l, s) cgr = newCgr ...@@ -221,7 +222,8 @@ step gw ctx@(p, v, l, s) cgr = newCgr
else else
cgr 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 :: Maybe (LNode Community)
mNc = nodeCommunity v cgr mNc = nodeCommunity v cgr
......
...@@ -47,7 +47,6 @@ toSupra = undefined ...@@ -47,7 +47,6 @@ toSupra = undefined
-- 4 -- 4
-- | -- |
-- 5 -- 5
spoon :: HyperGraph Double Double spoon :: HyperGraph Double Double
spoon = mkGraph ns es spoon = mkGraph ns es
where where
...@@ -80,14 +79,22 @@ spoon = mkGraph ns es ...@@ -80,14 +79,22 @@ spoon = mkGraph ns es
mv :: HyperGraph a a mv :: HyperGraph a a
-> [Node] -> [Node] -> [Node] -> [Node]
-> HyperGraph a a -> 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] = 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) -- | Start simple (without path)
mv' :: HyperGraph a a mv' :: HyperGraph a a
...@@ -102,13 +109,17 @@ mvMContext :: Maybe (HyperContext a a) ...@@ -102,13 +109,17 @@ mvMContext :: Maybe (HyperContext a a)
-> Maybe (HyperContext a a) -> Maybe (HyperContext a a)
-> HyperContext a a -> HyperContext a a
mvMContext (Just (a1 ,n ,l ,a2 )) 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 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" merge :: (Graph gr, DynGraph gr)
mvMContext (Just _) _ = panic "Snd Node does not exist" => gr a b -> gr a b -> gr a b
mvMContext _ _ = panic "Both Nodes do not exist" merge = ufold (&)
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment