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]]
--------------------------------------
-{-
-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)