[PHYLO] Code Review + Tools start.

package.yaml

@@ -71,6 +71,9 @@ library:
   - Gargantext.Viz.Graph
   - Gargantext.Viz.Graph.Distances.Matrice
   - Gargantext.Viz.Graph.Index
+  - Gargantext.Viz.Phylo
+  - Gargantext.Viz.Phylo.Tools
+  - Gargantext.Viz.Phylo.Example
   dependencies:
   - QuickCheck
   - accelerate

src/Gargantext/Viz/Phylo.hs

@@ -75,12 +75,15 @@ data Phylo =
            }
            deriving (Generic, Show)
 
+
+-- | Date : a simple Integer
+type Date = Int
+
 -- | UTCTime in seconds since UNIX epoch
 -- type Start   = POSIXTime
 -- type End     = POSIXTime
-type Start   = Int
-type End     = Int
-
+type Start   = Date
+type End     = Date
 
 -- | PhyloStep : steps of phylomemy on temporal axis
 -- Period: tuple (start date, end date) of the step of the phylomemy

src/Gargantext/Viz/Phylo/Example.hs

@@ -61,8 +61,6 @@ import Gargantext.Viz.Phylo.Tools
 -- | Types | --
 
 
--- | Date : a simple Integer
-type Date = Int
 -- | Document : a piece of Text linked to a Date
 data Document = Document
       { date :: Date
@@ -133,8 +131,11 @@ getKeyPair (x,y) m = case findPair (x,y) m of
                         | otherwise      = Nothing
                       --------------------------------------
 
-listToCombi :: (a -> b) -> [a] -> [(b,b)]
-listToCombi f l = [(f x, f y) | (x:rest) <- tails l, y <- rest]
+-- | 
+listToCombi :: forall a b. (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   (/docs)
@@ -182,19 +183,22 @@ 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)
+                                                    (sort $ map findIdx
+                                                          $ Set.toList
+                                                          $ fst fis
+                                                          )
                                                     (singleton "support" (fromIntegral $ snd fis))
                                                     [] [] [] []
 
 fisToPhyloLevel :: Map (Date, Date) Fis -> Phylo -> Phylo
-fisToPhyloLevel m p = over (phylo_periods . traverse) 
+fisToPhyloLevel m p = over (phylo_periods . traverse)
                            (\period ->
                               let periodId = _phylo_periodId period
                                   fisList  = zip [1..] (Map.toList (m ! periodId))
                               in  over (phylo_periodLevels)
                                        (\levels ->
                                           let groups = map (\fis -> cliqueToGroup periodId 1 (fst fis) "" (snd fis)) fisList
-                                          in (PhyloLevel (periodId, 1) groups) : levels 
+                                          in (PhyloLevel (periodId, 1) groups) : levels
                                        ) period
                            ) p
 
@@ -202,7 +206,7 @@ fisToPhyloLevel m p = over (phylo_periods . traverse)
 phyloFisFiltered :: Map (Date, Date) Fis
 phyloFisFiltered = filterFisBySupport True 1 (filterFisByNested phyloFis)
 
-filterFisBySupport :: Bool -> Int -> Map (Date, Date) Fis -> Map (Date, Date) Fis 
+filterFisBySupport :: Bool -> Int -> Map (Date, Date) Fis -> Map (Date, Date) Fis
 filterFisBySupport empty min m = case empty of
   True  -> Map.map (\fis -> filterMinorFis min fis) m
   False -> Map.map (\fis -> filterMinorFisNonEmpty min fis) m
@@ -278,27 +282,6 @@ addPointer :: Semigroup field
 addPointer field targetPointer current =
   set field (<> targetPointer) current
 
-getNgrams :: PhyloGroup -> [Int]
-getNgrams =  _phylo_groupNgrams
-
-getGroups :: Phylo -> [PhyloGroup]
-getGroups = view (phylo_periods . traverse . phylo_periodLevels . traverse . phylo_levelGroups)
-
-getGroupId :: PhyloGroup -> PhyloGroupId
-getGroupId = view (phylo_groupId)
-
-getGroupLvl :: PhyloGroup -> Int
-getGroupLvl = snd . fst . getGroupId
-
-getGroupPeriod :: PhyloGroup -> (Date,Date)
-getGroupPeriod = fst . fst . getGroupId
-
-getGroupsByLevelAndPeriod :: Int -> (Date,Date) -> Phylo -> [PhyloGroup]
-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'
   | null l'          = False
@@ -374,7 +357,7 @@ setPhyloLevel lvl (PhyloLevel (periodId, lvl') lvlGroups)
       lvlGroups' = map (\g -> setGroupIdLvl lvl g) lvlGroups
 
 copyPhyloLevel :: Int -> [PhyloLevel] -> [PhyloLevel]
-copyPhyloLevel lvl l = (setPhyloLevel lvl (head l)) : l 
+copyPhyloLevel lvl l = (setPhyloLevel lvl (head l)) : l
 
 alterLvl :: Int -> [PhyloPeriod] -> [PhyloPeriod]
 alterLvl lvl l = map (\p -> PhyloPeriod (_phylo_periodId p) (copyPhyloLevel lvl $ _phylo_periodLevels p)) l

src/Gargantext/Viz/Phylo/Tools.hs

@@ -17,5 +17,34 @@ Portability : POSIX
 module Gargantext.Viz.Phylo.Tools
   where
 
+import Control.Lens hiding (both)
+import Data.Tuple.Extra
+import Gargantext.Prelude hiding (head)
+import Gargantext.Viz.Phylo
+import qualified Data.List as List
+
+
+
+-- | To get Ngrams out of a Gargantext.Viz.Phylo.PhyloGroup
+getNgrams :: PhyloGroup -> [Int]
+getNgrams =  _phylo_groupNgrams
+
+getGroups :: Phylo -> [PhyloGroup]
+getGroups = view (phylo_periods . traverse . phylo_periodLevels . traverse . phylo_levelGroups)
+
+getGroupId :: PhyloGroup -> PhyloGroupId
+getGroupId = view (phylo_groupId)
+
+getGroupLvl :: PhyloGroup -> Int
+getGroupLvl = snd . fst . getGroupId
+
+getGroupPeriod :: PhyloGroup -> (Date,Date)
+getGroupPeriod = fst . fst . getGroupId
+
+getGroupsByLevelAndPeriod :: Int -> (Date,Date) -> Phylo -> [PhyloGroup]
+getGroupsByLevelAndPeriod lvl period p = List.filter testGroup  (getGroups p)
+  where
+    testGroup group = (getGroupLvl    group == lvl   )
+                   && (getGroupPeriod group == period)