[FIX] TFICF condition (better implemented definition)
[gargantext.git] / src / Gargantext / Viz / Phylo / PhyloTools.hs
index cb6692835b38e58eb0b6f7290f20375eee5a90e2..881f44ebccc8213d502cbd153bb1c76d7d86466d 100644 (file)
@@ -8,17 +8,13 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE ViewPatterns      #-}
 
 module Gargantext.Viz.Phylo.PhyloTools where
 
 import Data.Vector (Vector, elemIndex)
 import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy)
-import Data.Set (Set, size, disjoint)
+import Data.Set (Set, disjoint)
 import Data.Map (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty)
 import Data.String (String)
 import Data.Text (Text, unwords)
@@ -178,7 +174,7 @@ traceClique mFis = foldl (\msg cpt -> msg <> show (countSup cpt cliques) <> " (>
     where
         --------------------------------------
         cliques :: [Double]
-        cliques = sort $ map (fromIntegral . size . _phyloClique_nodes) $ concat $ elems mFis
+        cliques = sort $ map (fromIntegral . length . _phyloClique_nodes) $ concat $ elems mFis
         -------------------------------------- 
 
 
@@ -229,6 +225,9 @@ listToKeys lst = (listToCombi' lst) ++ (listToEqual' lst)
 listToMatrix :: [Int] -> Map (Int,Int) Double
 listToMatrix lst = fromList $ map (\k -> (k,1)) $ listToKeys $ sort lst
 
+listToMatrix' :: [Ngrams] -> Map (Ngrams,Ngrams) Int
+listToMatrix' lst = fromList $ map (\k -> (k,1)) $ listToKeys $ sort lst
+
 listToSeq :: Eq a =>  [a] -> [(a,a)]
 listToSeq l = nubBy (\x y -> fst x == fst y) $ [ (x,y) | (x:rest) <- tails l,  y <- rest ]
 
@@ -398,6 +397,12 @@ relatedComponents graph = foldl' (\acc groups ->
         let acc' = partition (\groups' -> disjoint (Set.fromList groups') (Set.fromList groups)) acc
          in (fst acc') ++ [nub $ concat $ (snd acc') ++ [groups]]) [] graph
 
+toRelatedComponents :: [PhyloGroup] -> [((PhyloGroup,PhyloGroup),Double)] -> [[PhyloGroup]]
+toRelatedComponents nodes edges = 
+  let ref = fromList $ map (\g -> (getGroupId g, g)) nodes
+      clusters = relatedComponents $ ((map (\((g,g'),_) -> [getGroupId g, getGroupId g']) edges) ++ (map (\g -> [getGroupId g]) nodes)) 
+   in map (\cluster -> map (\gId -> ref ! gId) cluster) clusters 
+
 
 traceSynchronyEnd :: Phylo -> Phylo
 traceSynchronyEnd phylo = 
@@ -492,4 +497,4 @@ traceTemporalMatching groups =
 
 traceGroupsProxi :: Map (PhyloGroupId,PhyloGroupId) Double -> Map (PhyloGroupId,PhyloGroupId) Double
 traceGroupsProxi m = 
-    trace ( "\n" <> "-- | " <> show(Map.size m) <> " computed pairs of groups proximity" <> "\n") m
\ No newline at end of file
+    trace ( "\n" <> "-- | " <> show(Map.size m) <> " computed pairs of groups proximity" <> "\n") m