[Phylo] Reading cosmetics / New Tools file.

src/Gargantext/Viz/Phylo/Example.hs

@@ -55,6 +55,7 @@ import Gargantext.Text.Metrics.FrequentItemSet (fisWithSizePolyMap, Size(..))
 import Gargantext.Text.Terms.Mono (monoTexts)
 import Gargantext.Prelude hiding (head)
 import Gargantext.Viz.Phylo
+import Gargantext.Viz.Phylo.Tools
 
 ------------------------------------------------------------------------
 -- | Types | --
@@ -121,7 +122,7 @@ shouldPair g g' = (not . null) $ intersect (getNgrams g) (getNgrams g')
 
 getKeyPair :: (Int,Int) -> Map (Int,Int) a -> (Int,Int)
 getKeyPair (x,y) m = case findPair (x,y) m of
-                      Nothing -> panic "PhyloError"
+                      Nothing -> panic "[ERR][Viz.Phylo.Example.getKeyPair] Nothing"
                       Just i  -> i
                      where
                       --------------------------------------
@@ -136,10 +137,10 @@ listToCombi :: (a -> b) -> [a] -> [(b,b)]
 listToCombi f l = [(f x, f y) | (x:rest) <- tails l, y <- rest]
 
 fisToCooc :: Map (Date, Date) Fis -> Map (Int, Int) Double
-fisToCooc m = map (\v -> v/docs) $ 
-                foldl (\mem x -> 
-                        adjust (+1) (getKeyPair x mem) mem) cooc (concat (map (\x -> 
-                                                                                listToCombi findIdx $ (Set.toList . fst) x) fis))
+fisToCooc m = map   (/docs)
+            $ foldl (\mem x -> adjust (+1) (getKeyPair x mem) mem) cooc
+            $ concat
+            $ map (\x -> listToCombi findIdx $ (Set.toList . fst) x) fis
   where
     --------------------------------------
     fis :: [(Clique,Support)]
@@ -179,8 +180,11 @@ phyloWithGroups1 :: Phylo
 phyloWithGroups1 = updatePhyloByLevel Level_1 phyloLinked_m1_0
 
 cliqueToGroup :: PhyloPeriodId -> Int -> Int -> Ngrams -> (Clique,Support) -> PhyloGroup
-cliqueToGroup period lvl idx label fis = PhyloGroup ((period, lvl), idx) label (sort (map (\x -> 
-                                                                                           findIdx x) (Set.toList $ fst fis))) (singleton "support" (fromIntegral $ snd fis)) [] [] [] []
+cliqueToGroup period lvl idx label fis = PhyloGroup ((period, lvl), idx)
+                                                    label
+                                                    (sort $ map (\x ->  findIdx x) $ Set.toList $ fst fis)
+                                                    (singleton "support" (fromIntegral $ snd fis))
+                                                    [] [] [] []
 
 fisToPhyloLevel :: Map (Date, Date) Fis -> Phylo -> Phylo
 fisToPhyloLevel m p = over (phylo_periods . traverse) 
@@ -233,7 +237,10 @@ filterNestedCliques h l l'
 
 
 filterFisByNested :: Map (Date, Date) Fis -> Map (Date, Date) Fis
-filterFisByNested m = map (\fis -> restrictKeys fis (Set.fromList (filterNestedCliques (head (keys fis)) (keys fis) []))) m
+filterFisByNested = map (\fis -> restrictKeys fis
+                              $ Set.fromList
+                              $ filterNestedCliques (head (keys fis)) (keys fis) []
+                            )
 
 phyloFis :: Map (Date, Date) Fis
 phyloFis = termsToFis phyloTerms 
@@ -272,7 +279,7 @@ addPointer field targetPointer current =
   set field (<> targetPointer) current
 
 getNgrams :: PhyloGroup -> [Int]
-getNgrams g =  _phylo_groupNgrams g 
+getNgrams =  _phylo_groupNgrams
 
 getGroups :: Phylo -> [PhyloGroup]
 getGroups = view (phylo_periods . traverse . phylo_periodLevels . traverse . phylo_levelGroups)
@@ -281,13 +288,16 @@ getGroupId :: PhyloGroup -> PhyloGroupId
 getGroupId = view (phylo_groupId)
 
 getGroupLvl :: PhyloGroup -> Int
-getGroupLvl group = snd $ fst $ getGroupId group
+getGroupLvl = snd . fst . getGroupId
 
 getGroupPeriod :: PhyloGroup -> (Date,Date)
-getGroupPeriod group = fst $ fst $ getGroupId group
+getGroupPeriod = fst . fst . getGroupId
 
 getGroupsByLevelAndPeriod :: Int -> (Date,Date) -> Phylo -> [PhyloGroup]
-getGroupsByLevelAndPeriod lvl period p = List.filter (\group -> (getGroupLvl group == lvl) && (getGroupPeriod group == period)) (getGroups p) 
+getGroupsByLevelAndPeriod lvl period p = List.filter testGroup  (getGroups p)
+  where
+    testGroup group = (getGroupLvl    group == lvl   )
+                   && (getGroupPeriod group == period)
 
 containsIdx :: [Int] -> [Int] -> Bool
 containsIdx l l'
@@ -318,7 +328,8 @@ linkGroupToGroups lvl current targets
     setLevelParents =  over (phylo_groupLevelParents) addPointers
 
     addPointers :: [Pointer] -> [Pointer]
-    addPointers lp = lp ++ Maybe.mapMaybe (\target -> if shouldLink lvl (_phylo_groupNgrams current) (_phylo_groupNgrams target)
+    addPointers lp = lp ++ Maybe.mapMaybe (\target -> if shouldLink lvl (_phylo_groupNgrams current)
+                                                                        (_phylo_groupNgrams target )
                                                       then Just ((getGroupId target),1)
                                                       else Nothing
                                                ) targets 
@@ -333,7 +344,13 @@ linkGroupsByLevel lvl p groups  = map (\group ->
   else group ) groups
 
 phyloToLinks :: LinkLvl -> Phylo -> Phylo
-phyloToLinks lvl p = over (phylo_periods . traverse . phylo_periodLevels . traverse . phylo_levelGroups) (\groups -> linkGroupsByLevel lvl p groups) p
+phyloToLinks lvl p = over ( phylo_periods
+                          .  traverse
+                          . phylo_periodLevels
+                          .  traverse
+                          . phylo_levelGroups
+                          )
+                          (linkGroupsByLevel lvl p) p
 
 phyloLinked_0_m1 :: Phylo
 phyloLinked_0_m1 = phyloToLinks lvl_0_m1  phyloWithGroups0
@@ -376,7 +393,11 @@ findIdx n = case (elemIndex n (_phylo_ngrams phylo)) of
               Just i  -> i
 
 ngramsToGroup :: [Ngrams] -> Text -> Int -> Int -> Int -> Int -> PhyloGroup
-ngramsToGroup terms label idx lvl from to = PhyloGroup (((from, to), lvl), idx) label (sort (map (\x -> findIdx x) terms)) (Map.empty) [] [] [] []
+ngramsToGroup terms label idx lvl from to = PhyloGroup (((from, to), lvl), idx)
+                                                       label
+                                                       (sort (map (\x -> findIdx x) terms))
+                                                       (Map.empty)
+                                                       [] [] [] []
 
 docsToLevel :: (Date, Date) -> Corpus -> PhyloLevel
 docsToLevel k v = PhyloLevel (k,(-1)) (map (\x ->

src/Gargantext/Viz/Phylo/Tools.hs

 {-|
 Module      : Gargantext.Viz.Phylo.Tools
-Description : Phylomemy tools
+Description : Phylomemy Tools to build/manage it
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-Phylo Toolbox:
-- functions to build a Phylo
-- functions to filter the cliques
-- functions to manage a Phylo
-
-Group Functions (TODO list)
-- cohesion sur un groupe
-- distance au dernier branchement
-- âge du groupe
-
-Futre Idea: temporal zoom on Phylo
-phyloZoomOut :: (PeriodGrain, Phylo) -> [(PeriodGrain, Phylo)]
-(from smallest granularity, it increases (zoom out) the periods of the Phylo)
-Moral idea: viz from out to in
 
 -}
 
@@ -28,76 +14,8 @@ Moral idea: viz from out to in
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Gargantext.Viz.Phylo.Tools where
-
-import Data.Set (Set)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Gargantext.Prelude
-import Gargantext.Viz.Phylo
-import Gargantext.Viz.Phylo.Example
-
-type MinSize = Int
-
--- | Building a phylo
--- (Indicative and schematic function)
--- buildPhylo :: Support -> MinSize
---                       -> Map Clique Support -> Phylo
--- buildPhylo s m mcs = level2Phylo
---                    . groups2level
---                    . clusters2group
---                    . Map.map clique2cluster
---                    . filterCliques s m
-
-level2Phylo :: PhyloLevel -> Phylo -> Phylo
-level2Phylo = undefined
-
-groups2level :: [PhyloGroup] -> PhyloLevel
-groups2level = undefined
-
--- clusters2group :: [Cluster Ngrams] -> PhyloGroup
--- clusters2group = undefined
-
--- clique2cluster :: Clique -> Cluster Ngrams
--- clique2cluster = undefined
-
--- | Filtering the cliques before bulding the Phylo
--- (Support and MinSize as parameter of the finale function to build a phylo)
--- idea: log of Corpus size (of docs)
-filterCliques :: Support -> MinSize
-                         -> Map Clique Support -> [Clique]
-filterCliques s ms = maximalCliques
-                   . filterWithSizeSet ms
-                   . Map.keys
-                   . filterWithSupport s
-
--- | Hapaxify / Threshold
--- hapax s = 1
--- ?  
-filterWithSupport :: Support -> Map Clique Support -> Map Clique Support
-filterWithSupport s = Map.filter (>s)
-
-filterWithSizeSet :: MinSize -> [Clique] -> [Clique]
-filterWithSizeSet = undefined
-
--- | filtre les cliques de ngrams compris dans une clique plus grande
--- /!\ optim inside
-maximalCliques :: [Clique] -> [Clique]
-maximalCliques = undefined
-
-
--- | Phylo management
-
--- | PhyloLevel Management
-viewGroups :: (Start,End) -> PhyloLevel -> Phylo -> [PhyloGroup]
-viewGroups = undefined
+module Gargantext.Viz.Phylo.Tools
+  where
 
-viewLevels :: (Start,End) -> Phylo -> [PhyloLevel]
-viewLevels = undefined
 
--- | tous les terme des champs, tous les parents et les enfants
-setGroup :: PhyloGroup -> PhyloGroup -> PhyloGroup
-setGroup = undefined
---removeTerms :: recalculer les cliques pour ces termes
---addTerms