Merge branch 'dev' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext...
[gargantext.git] / src / Gargantext / Viz / Phylo / Metrics / Clustering.hs
index 9c48946508c65b712740d04b8f6d0079550b7006..d1d77c6f2ea148fa97313d24c387e22070b4c56d 100644 (file)
@@ -17,32 +17,23 @@ Portability : POSIX
 module Gargantext.Viz.Phylo.Metrics.Clustering
   where
 
-import Data.List        (last,head,union,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!))
-import Data.Map         (Map,elems,adjust,unionWith,intersectionWith,fromList,mapKeys)
-import Data.Set         (Set)
-import Data.Tuple       (fst, snd)
-
 import Data.Graph.Clustering.Louvain.CplusPlus
-
-import Gargantext.Prelude             hiding (head)
+import Data.List        (last,concat,null,nub,(++),init,tail,elemIndex,groupBy,(!!))
+import Data.Map         (fromList,mapKeys)
+import Gargantext.Prelude
 import Gargantext.Viz.Phylo
 import Gargantext.Viz.Phylo.Tools
 
-import qualified Data.List   as List
-import qualified Data.Map    as Map
-import qualified Data.Set    as Set
-
-
 -- | To apply the related components method to a PhyloGraph
 -- curr = the current PhyloGroup 
 -- (nodes,edges) = the initial PhyloGraph minus the current PhyloGroup
 -- next = the next PhyloGroups to be added in the cluster  
 -- memo = the memory of the allready created clusters
-relatedComp :: Int -> PhyloGroup -> PhyloGraph -> [PhyloGroup] -> [[PhyloGroup]] -> [[PhyloGroup]]
+relatedComp :: Int -> PhyloGroup -> GroupGraph -> [PhyloGroup] -> [[PhyloGroup]] -> [[PhyloGroup]]
 relatedComp idx curr (nodes,edges) next memo
   | null nodes' && null next' = memo'
-  | (not . null) next'        = relatedComp idx (head next') (nodes',edges) (tail next') memo'
-  | otherwise                 = relatedComp (idx + 1) (head nodes') (tail nodes',edges) [] memo'
+  | (not . null) next'        = relatedComp  idx      (head' "relatedComp1" next' ) (nodes'     ,edges) (tail next') memo'
+  | otherwise                 = relatedComp (idx + 1) (head' "relatedComp2" nodes') (tail nodes',edges) []           memo'
   where
     --------------------------------------
     memo' :: [[PhyloGroup]]
@@ -59,13 +50,7 @@ relatedComp idx curr (nodes,edges) next memo
     --------------------------------------
 
 
-{-
-louvain :: (PhyloNodes,PhyloEdges) -> [Cluster]
-louvain (nodes,edges) = undefined 
--} 
-
-
-louvain :: (PhyloNodes,PhyloEdges) -> IO [[PhyloGroup]]
+louvain :: ([GroupNode],[GroupEdge]) -> IO [[PhyloGroup]]
 louvain (nodes,edges) = map (\community -> map (\node -> nodes !! (l_node_id node)) community)
                       <$> groupBy (\a b -> (l_community_id a) == (l_community_id b))
                       <$> (cLouvain $ mapKeys (\(x,y) -> (idx x, idx y)) $ fromList edges)