Whooo class types ...

src/Gargantext/Viz/Phylo.hs

@@ -25,6 +25,7 @@ one 8, e54847.
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 module Gargantext.Viz.Phylo where
 
@@ -64,6 +65,7 @@ data Software =
      } deriving (Generic)
 
 ------------------------------------------------------------------------
+
 -- | Phylo datatype descriptor of a phylomemy
 -- Duration : time Segment of the whole phylomemy (start,end)
 -- Ngrams   : list of all (possible) terms contained in the phylomemy (with their id)
@@ -139,27 +141,22 @@ data PhyloBranch =
                  deriving (Generic, Show)                
 
 
--- | PhyloPeriodId : A period of time framed by a starting Date and an ending Date
-type PhyloPeriodId = (Start, End)
 -- | Level : A level of aggregation (-1 = Txt, 0 = Ngrams, 1 = Fis, [2..] = Cluster)  
 type Level = Int 
 -- | Index : A generic index of an element (PhyloGroup, PhyloBranch, etc) in a given List
 type Index = Int
 
 
+type PhyloPeriodId = (Start, End)
 type PhyloLevelId  = (PhyloPeriodId, Level)
 type PhyloGroupId  = (PhyloLevelId, Index)
 type PhyloBranchId = (Level, Index)
 
-type Pointer       = (PhyloGroupId, Weight)
 
+-- | Weight : A generic mesure that can be associated with an Id
 type Weight = Double
-
-
-
-
-
-
+-- | Pointer : A weighted linked with a given PhyloGroup
+type Pointer = (PhyloGroupId, Weight)
 
 
 -- | Ngrams : a contiguous sequence of n terms
@@ -176,7 +173,6 @@ type Support = Int
 type Fis = (Clique,Support)
 
 
-
 -- | Document : a piece of Text linked to a Date
 data Document = Document
       { date :: Date
@@ -184,6 +180,19 @@ data Document = Document
       } deriving (Show)
 
 
+type Cluster = [PhyloGroup]
+
+
+class AppendToPhylo a where
+    addPhyloLevel  :: Level -> Map (Date,Date) [a] -> Phylo -> Phylo
+    initPhyloGroup :: a -> PhyloGroup
+
+-- | A List of PhyloGroup in a PhyloGraph
+type PhyloNodes = [PhyloGroup]
+-- | A List of weighted links between some PhyloGroups in a PhyloGraph
+type PhyloEdges = [(((PhyloGroup,PhyloGroup)),Weight)]
+-- | The association as a Graph between a list of Nodes and a list of Edges
+type PhyloGraph = (PhyloNodes,PhyloEdges)
 
 
 data PhyloError = LevelDoesNotExist
@@ -191,13 +200,9 @@ data PhyloError = LevelDoesNotExist
           deriving (Show)               
 
 
-type PhyloGraph = (PhyloNodes,PhyloEdges)
-type PhyloNodes = [PhyloGroup]
-type PhyloEdges = [(((PhyloGroup,PhyloGroup)),Double)]
-
-
+-- | A List of Proximity mesures or strategies 
 data Proximity  = WeightedLogJaccard | Hamming | FromPairs
-
+-- | A List of Clustering methods 
 data Clustering  = Louvain | RelatedComponents
 
 

src/Gargantext/Viz/Phylo/Example.hs

@@ -24,6 +24,7 @@ TODO:
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 module Gargantext.Viz.Phylo.Example where
 
@@ -87,13 +88,9 @@ phyloToClusters lvl (prox,param) (clus,param') p = Map.fromList
 
 -- | To transform a Cluster into  a Phylogroup 
 clusterToGroup :: PhyloPeriodId -> Level -> Int -> Text -> [PhyloGroup] -> PhyloGroup
-clusterToGroup prd lvl idx lbl groups = PhyloGroup ((prd, lvl), idx)
-                                                   lbl
-                                                   ((sort . nub . concat) $ map getGroupNgrams groups)
-                                                   empty
-                                                   empty
-                                                   [] [] []
-                                                   (map (\g -> (getGroupId g, 1)) groups)
+clusterToGroup prd lvl idx lbl groups = 
+    PhyloGroup ((prd, lvl), idx) lbl ((sort . nub . concat) $ map getGroupNgrams groups) empty empty [] [] [] (map (\g -> (getGroupId g, 1)) groups)
+
 
 -- | To transform a list of Clusters into a new Phylolevel
 clustersToPhyloLevel :: Level -> Map (Date,Date) [[PhyloGroup]] -> Phylo -> Phylo
@@ -108,7 +105,9 @@ clustersToPhyloLevel lvl m p = over (phylo_periods . traverse)
                                           ) period) p
 
 
-phyloWithGroups2 = clustersToPhyloLevel 2 (phyloToClusters 1 (WeightedLogJaccard,[0]) (RelatedComponents, []) phyloWithBranches_1) phyloWithBranches_1
+phyloWithGroups2 = clustersToPhyloLevel 
+                    2 
+                    (phyloToClusters 1 (WeightedLogJaccard,[0]) (RelatedComponents, []) phyloWithBranches_1) phyloWithBranches_1
 
 ------------------------------------------------------------------------
 -- | STEP 12 | -- Find the Branches
@@ -142,12 +141,9 @@ relatedComp idx curr (nodes,edges) next memo
 
 -- | To transform a PhyloGraph into a list of PhyloBranches by using the relatedComp clustering
 graphToBranches :: Level -> PhyloGraph -> Phylo -> [PhyloBranch]
-graphToBranches lvl (nodes,edges) p = map (\(idx,c) -> PhyloBranch (lvl,idx) "" (map getGroupId c)) $ zip [0..] clusters
-  where
-    -------------------------------------- 
-    clusters :: [[PhyloGroup]]
-    clusters = relatedComp 0 (head nodes) (tail nodes,edges) [] []
-    --------------------------------------
+graphToBranches lvl (nodes,edges) p = map (\(idx,c) -> PhyloBranch (lvl,idx) "" (map getGroupId c)) 
+                                    $ zip [0..] 
+                                    $ relatedComp 0 (head nodes) (tail nodes,edges) [] []
 
 
 -- | To transform a list of PhyloGroups into a PhyloGraph by using a given Proximity mesure
@@ -167,10 +163,7 @@ groupsToGraph (prox,param) groups p = (groups,edges)
 
 -- | To set all the PhyloBranches for a given Level in a Phylo
 setPhyloBranches :: Level -> Phylo -> Phylo 
-setPhyloBranches lvl p = alterPhyloBranches 
-                          (\branches -> branches 
-                                        ++
-                                        (graphToBranches lvl (groupsToGraph (FromPairs,[]) (getGroupsWithLevel lvl p)p)p))p
+setPhyloBranches lvl p = alterPhyloBranches (\l -> l ++ (graphToBranches lvl (groupsToGraph (FromPairs,[]) (getGroupsWithLevel lvl p) p) p) ) p
 
 
 phyloWithBranches_1 = setPhyloBranches 1 phyloWithPair_1_Childs
@@ -365,6 +358,20 @@ fisToPhyloLevel m p = over (phylo_periods . traverse)
                                        ) period ) p
 
 
+-- | to do :  ajouter ce truc à addPhylolevel puis le rendre polymorphique (Fis/Document -> Group)
+
+-- aggregateToPhyloLevel' :: (a -> PhyloGroup) -> Map (Date, Date) [a] -> Phylo -> Phylo 
+-- aggregateToPhyloLevel' f m p = alterPhyloPeriods (\period -> 
+--                                            let periodId = _phylo_periodId period 
+--                                                aggList  = zip [1..] (m ! periodId)
+--                                            in  over (phylo_periodLevels)
+--                                                (\phyloLevels ->
+--                                                   let groups = map f aggList 
+--                                                   in  phyloLevels ++ [PhyloLevel (periodId, 1) groups]
+--                                                ) period) p
+
+
+
 phyloLinked_0_1 :: Phylo
 phyloLinked_0_1 = alterLevelLinks (0,1)  phyloLinked_1_0
 
@@ -472,7 +479,7 @@ phyloLinked_0_m1 = alterLevelLinks (0,(-1)) phyloWithGroups0
 
 -- | To clone the last PhyloLevel of each PhyloPeriod and update it with a new LevelValue 
 clonePhyloLevel :: Level -> Phylo -> Phylo
-clonePhyloLevel lvl p = alterPhyloLevels (\l -> addPhyloLevel (setPhyloLevelId lvl $ head l) l) p 
+clonePhyloLevel lvl p = alterPhyloLevels (\l -> l ++ [setPhyloLevelId lvl $ head l]) p 
 
 
 phyloWithGroups0 :: Phylo
@@ -503,13 +510,41 @@ docsToPhyloPeriods lvl docs p = map (\(id,l) -> initPhyloPeriod id l)
 -- | To update a Phylo for a given Levels
 updatePhyloByLevel :: Level -> Phylo -> Phylo 
 updatePhyloByLevel lvl p
-  | lvl < 0   = appendPhyloPeriods (docsToPhyloPeriods lvl phyloPeriods p) p
+  | lvl < 0   = appendToPhyloPeriods (docsToPhyloPeriods lvl phyloPeriods p) p
   | lvl == 0  = clonePhyloLevel lvl p
   | lvl == 1  = fisToPhyloLevel phyloFisFiltered p
   | lvl > 1   = undefined
   | otherwise = panic ("[ERR][Viz.Phylo.Example.updatePhyloByLevel] Level not defined")
 
 
+instance AppendToPhylo Fis 
+  where
+    --------------------------------------
+    -- | Level -> Map (Date,Date) [Fis] -> Phylo -> Phylo 
+    addPhyloLevel lvl m p
+      | lvl == 1  = fisToPhyloLevel m p
+      | otherwise = panic ("[ERR][Viz.Phylo.Example.addPhyloLevel] No process declared for adding Fis at level <> 1")    
+    --------------------------------------
+
+
+instance AppendToPhylo Cluster 
+  where
+  --------------------------------------
+  -- | appendByLevel :: Level -> Map (Date,Date) [Cluster] -> Phylo -> Phylo 
+    addPhyloLevel lvl m p = undefined
+  --------------------------------------
+
+
+instance AppendToPhylo Document 
+  where
+  --------------------------------------
+  -- | Level -> Map (Date,Date) [Document] -> Phylo -> Phylo 
+    addPhyloLevel lvl m p 
+      | lvl < 0   = over (phylo_periods) (++ docsToPhyloPeriods lvl m p) p
+      | otherwise = panic ("[ERR][Viz.Phylo.Example.addPhyloLevel] No process declared for adding Documents at level <> -1")
+  --------------------------------------
+
+
 phyloWithGroupsm1 :: Phylo
 phyloWithGroupsm1 = updatePhyloByLevel (-1) phylo
 

src/Gargantext/Viz/Phylo/Tools.hs

@@ -13,6 +13,7 @@ Portability : POSIX
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 module Gargantext.Viz.Phylo.Tools
   where
@@ -42,11 +43,6 @@ addGroupIdToBranch :: PhyloGroupId -> PhyloBranch -> PhyloBranch
 addGroupIdToBranch id b = over (phylo_branchGroups) (++ [id]) b
 
 
--- | To add a PhyloLevel at the end of a list of PhyloLevels
-addPhyloLevel :: PhyloLevel -> [PhyloLevel] -> [PhyloLevel]
-addPhyloLevel lvl l = l ++ [lvl] 
-
-
 -- | To alter each list of PhyloGroups following a given function
 alterPhyloGroups :: ([PhyloGroup] -> [PhyloGroup]) -> Phylo -> Phylo
 alterPhyloGroups f p = over ( phylo_periods
@@ -76,8 +72,8 @@ alterPhyloLevels f p = over ( phylo_periods
 
 
 -- | To append a list of PhyloPeriod to a Phylo
-appendPhyloPeriods :: [PhyloPeriod] -> Phylo -> Phylo
-appendPhyloPeriods l p = over (phylo_periods) (++ l) p
+appendToPhyloPeriods :: [PhyloPeriod] -> Phylo -> Phylo
+appendToPhyloPeriods l p = over (phylo_periods) (++ l) p
 
 
 -- | Does a List of Sets contains at least one Set of an other List
@@ -247,6 +243,11 @@ getPhyloPeriods p = map _phylo_periodId
                   $ view (phylo_periods) p
 
 
+-- | To get the id of a given PhyloPeriod
+getPhyloPeriodId :: PhyloPeriod -> PhyloPeriodId
+getPhyloPeriodId prd = _phylo_periodId prd 
+
+
 -- | To create a PhyloGroup in a Phylo out of a list of Ngrams and a set of parameters 
 initGroup :: [Ngrams] -> Text -> Int -> Int -> Int -> Int -> Phylo -> PhyloGroup
 initGroup ngrams lbl idx lvl from to p = PhyloGroup