Commit 89722cf7 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Debug] first iteration ok, needs more clustering and conv to fixed point.

parent aaed14eb
...@@ -4,7 +4,7 @@ cabal-version: 1.12 ...@@ -4,7 +4,7 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: e1e53adbd24148d990b70f078530a01370effd8531413470ea9947aa095bf247 -- hash: 34278ee95f4de4f41ad7ba7e08818b4a24fad95acd67aa0a682a260b2db2832e
name: clustering-louvain name: clustering-louvain
version: 0.1.0.0 version: 0.1.0.0
...@@ -44,6 +44,7 @@ library ...@@ -44,6 +44,7 @@ library
, hxt , hxt
, parsec , parsec
, protolude , protolude
, simple-reflect
, text , text
, turtle , turtle
, vector , vector
......
...@@ -49,6 +49,7 @@ library: ...@@ -49,6 +49,7 @@ library:
- parsec - parsec
- turtle - turtle
- foldl - foldl
- simple-reflect
tests: tests:
louvain-test: louvain-test:
main: Spec.hs main: Spec.hs
......
...@@ -13,6 +13,7 @@ ILouvain: really inductive Graph ...@@ -13,6 +13,7 @@ ILouvain: really inductive Graph
module Data.Graph.Clustering.ILouvain module Data.Graph.Clustering.ILouvain
where where
import Debug.SimpleReflect
import Data.Set (fromList) import Data.Set (fromList)
import Data.Maybe (catMaybes, maybe) import Data.Maybe (catMaybes, maybe)
import Data.List (zip, cycle) import Data.List (zip, cycle)
...@@ -36,12 +37,10 @@ convergence g = if m - m' > 0.1 then g else g' ...@@ -36,12 +37,10 @@ convergence g = if m - m' > 0.1 then g else g'
g' = step g g' = step g
-} -}
toNodes g = map (\n -> hnodes g n) (nodes g)
iLouvain :: (Eq a) => HyperGraph a a -> HyperGraph a a
iLouvain :: (Eq a) => HyperGraph a a -> [[Node]] iLouvain g = iLouvain' g $ nodes g
iLouvain g = toNodes $ iLouvain' g $ path' g
where
toNodes g = map (\n -> hnodes g n) (nodes g)
iLouvain' :: HyperGraph a a -> [Node] -> HyperGraph a a iLouvain' :: HyperGraph a a -> [Node] -> HyperGraph a a
iLouvain' g [ ] = g iLouvain' g [ ] = g
...@@ -53,14 +52,16 @@ step' :: HyperGraph a b ...@@ -53,14 +52,16 @@ step' :: HyperGraph a b
-> Node -> Node
-> [Node] -> [Node]
-> HyperGraph a a -> HyperGraph a a
step' g g' n ns = foldl' (\g1 n' -> step g g1 n n') g' ns step' g g' n ns = foldl' (\g1 n' -> case match n g1 of
(Nothing, _) -> g1
(Just _, _ ) -> step g g1 n n') g' ns
step :: HyperGraph a b step :: HyperGraph a b
-> HyperGraph a a -> HyperGraph a a
-> Node -> Node
-> Node -> Node
-> HyperGraph a a -> HyperGraph a a
step g g' n1 n2 = step g g' n1 n2 = -- trace (show n1 :: Text) $
if s2 > 0 && s2 > s1 if s2 > 0 && s2 > s1
then mv g' [n1] [n2] then mv g' [n1] [n2]
else g' else g'
...@@ -73,10 +74,10 @@ hnodes :: HyperGraph a b -> Node -> [Node] ...@@ -73,10 +74,10 @@ hnodes :: HyperGraph a b -> Node -> [Node]
hnodes g n = case match n g of hnodes g n = case match n g of
(Nothing, _) -> [] (Nothing, _) -> []
(Just (p, n, l, s), _) -> n : nodes l (Just (p, n, l, s), _) -> n : nodes l
{-
hdeg :: Graph gr => gr a b -> Node -> Maybe Int hdeg :: Graph gr => gr a b -> Node -> Maybe Int
hdeg = undefined hdeg = undefined
-}
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO go depth in HyperGraph (modularity at level/depth) -- TODO go depth in HyperGraph (modularity at level/depth)
imodularity :: HyperGraph a b -> [Node] -> Double imodularity :: HyperGraph a b -> [Node] -> Double
...@@ -135,7 +136,7 @@ mv g [a] [b] = case a == b of ...@@ -135,7 +136,7 @@ mv g [a] [b] = case a == b of
True -> panic "mv, impossible: moved node is same as destination" True -> panic "mv, impossible: moved node is same as destination"
False -> mv' g a b False -> mv' g a b
mv g [a,b] [ ] = case match a g of mv g [a,b] [ ] = case match a g of
(Nothing, _) -> panic "mv: fst Node of Path does not exist" (Nothing, _) -> panic $ "mv: fst Node of Path does not exist: " <> show a
(Just (p, n, l, s), g1) -> case match b l of (Just (p, n, l, s), g1) -> case match b l of
(Just (p',n',l',s'), g2) -> (p', n', g2, s') (Just (p',n',l',s'), g2) -> (p', n', g2, s')
& ((p , n , delNode b l , s ) & ((p , n , delNode b l , s )
......
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