Skip to content

C
clustering-louvain
Commit 572d3764 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[ILouvain] adding show to instance definition

parent acda04a3
Hide whitespace changes
Inline Side-by-side
Showing with 9 additions and 7 deletions
src/Data/Graph/Clustering/ILouvain.hs
View file @ 572d3764
...@@ -79,7 +79,7 @@ class IsHyperGraph gr where ...@@ -79,7 +79,7 @@ class IsHyperGraph gr where
hnodes_ :: gr -> Node -> [Node] hnodes_ :: gr -> Node -> [Node]
toNodes_ :: gr -> [[Node]] toNodes_ :: gr -> [[Node]]
mv_ :: gr -> [Node] -> [Node] -> gr mv_ :: Show gr => gr -> [Node] -> [Node] -> gr
-- hdeg_ :: a -> Node -> Maybe Int -- hdeg_ :: a -> Node -> Maybe Int
imodularity_ :: gr -> gr -> [Node] -> Double imodularity_ :: gr -> gr -> [Node] -> Double
...@@ -105,7 +105,8 @@ instance IsHyperGraph (GraphContexts a a) where ...@@ -105,7 +105,8 @@ instance IsHyperGraph (GraphContexts a a) where
toNodes_ :: GraphContexts a a -> [[Node]] toNodes_ :: GraphContexts a a -> [[Node]]
toNodes_ g = map (hnodes_ g) (nodes g) toNodes_ g = map (hnodes_ g) (nodes g)
mv_ :: GraphContexts a a mv_ :: Show (GraphContexts a a)
=> GraphContexts a a
-> [Node] -> [Node] -> [Node] -> [Node]
-> GraphContexts a a -> GraphContexts a a
mv_ g [ ] [ ] = g mv_ g [ ] [ ] = g
...@@ -129,7 +130,8 @@ instance IsHyperGraph (GraphContexts a a) where ...@@ -129,7 +130,8 @@ instance IsHyperGraph (GraphContexts a a) where
instance IsHyperGraph (GraphContexts' a a a) where instance IsHyperGraph (GraphContexts' a a a) where
mv_ :: GraphContexts' a a a mv_ :: Show (GraphContexts' a a a)
=> GraphContexts' a a a
-> [Node] -> [Node] -> [Node] -> [Node]
-> GraphContexts' a a a -> GraphContexts' a a a
mv_ g [ ] [ ] = g mv_ g [ ] [ ] = g
...@@ -141,15 +143,15 @@ instance IsHyperGraph (GraphContexts' a a a) where ...@@ -141,15 +143,15 @@ instance IsHyperGraph (GraphContexts' a a a) where
(Just (p',n',cs',s'), g2) -> (p',n', c:cs,s') & g2 (Just (p',n',cs',s'), g2) -> (p',n', c:cs,s') & g2
where where
c = (p,n, concat $ map thd4 cs, s) c = (p,n, concat $ map thd4 cs, s)
(Nothing, _) -> panic $ "mv: snd path does not exist: " -- <> show b (Nothing, _) -> panic $ "mv: snd path does not exist: " <> show b
(Nothing, _) -> panic $ "mv: fst path does not exist: " -- <> show a (Nothing, _) -> panic $ "mv: fst path does not exist: " <> show a
mv_ g [a,b] [ ] = case match a g of mv_ g [a,b] [ ] = case match a g of
(Just (p,n,cs,s), g1) -> case match b (foldr (&) (empty :: GraphContexts a a) cs) of (Just (p,n,cs,s), g1) -> case match b (foldr (&) (empty :: GraphContexts a a) cs) of
(Just (p',n',cs',s'), g2) -> (p', n', map (\(p'',n'',c'',s'') -> (p'',n'',[(p'',n'',c'',s'')],s'')) cs', s') & (Just (p',n',cs',s'), g2) -> (p', n', map (\(p'',n'',c'',s'') -> (p'',n'',[(p'',n'',c'',s'')],s'')) cs', s') &
((p, n, gsel (const True) g2, s) & g1) ((p, n, gsel (const True) g2, s) & g1)
(Nothing, _) -> panic $ "mv: snd path does not exist: " -- <> show b (Nothing, _) -> panic $ "mv: snd path does not exist: " <> show b
(Nothing, _) -> panic $ "mv: fst path does not exist: " -- <> show a (Nothing, _) -> panic $ "mv: fst path does not exist: " <> show a
mv_ g [a,b] [c] = mv_ (mv_ g [a,b] []) [b] [c] mv_ g [a,b] [c] = mv_ (mv_ g [a,b] []) [b] [c]
mv_ _ [_] [_] = panic "path too long"j mv_ _ [_] [_] = panic "path too long"j
......
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