Merge branch 'dev-ngrams-repo' of...

Merge branch 'dev-ngrams-repo' of https://gitlab.iscpif.fr/gargantext/haskell-gargantext into dev-ngrams-repo

package.yaml

@@ -50,6 +50,7 @@ library:
   - Gargantext.Text.Examples
   - Gargantext.Text.List.CSV
   - Gargantext.Text.Metrics
+  - Gargantext.Text.Metrics.TFICF
   - Gargantext.Text.Metrics.CharByChar
   - Gargantext.Text.Metrics.Count
   - Gargantext.Text.Parsers

src/Gargantext/API.hs

@@ -248,10 +248,12 @@ type GargAPI' =
                         :> QueryParam "limit"  Int
                         :> QueryParam "order"  OrderBy
                         :> SearchAPI
-           
+
+           -- TODO move to NodeAPI?
            :<|> "graph" :> Summary "Graph endpoint"
                         :> Capture "id" NodeId       :> GraphAPI
-           
+
+           -- TODO move to NodeAPI?
            -- Tree endpoint
            :<|> "tree" :> Summary "Tree endpoint"
                        :> Capture "id" NodeId        :> TreeAPI
@@ -285,15 +287,17 @@ serverGargAPI :: GargServer GargAPI
 serverGargAPI -- orchestrator
        =  auth
      :<|> roots
-     :<|> nodeAPI  (Proxy :: Proxy HyperdataAny)
-     :<|> nodeAPI  (Proxy :: Proxy HyperdataCorpus)
-     :<|> nodeAPI  (Proxy :: Proxy HyperdataAnnuaire)
+     :<|> nodeAPI  (Proxy :: Proxy HyperdataAny)      fakeUserId
+     :<|> nodeAPI  (Proxy :: Proxy HyperdataCorpus)   fakeUserId
+     :<|> nodeAPI  (Proxy :: Proxy HyperdataAnnuaire) fakeUserId
      :<|> nodesAPI
      :<|> count -- TODO: undefined
      :<|> search
      :<|> graphAPI -- TODO: mock
      :<|> treeAPI
   --   :<|> orchestrator
+  where
+    fakeUserId = 1 -- TODO
 
 serverIndex :: Server (Get '[HTML] Html)
 serverIndex = $(do (Just s) <- liftIO (fileTypeToFileTree (FileTypeFile "purescript-gargantext/dist/index.html"))

src/Gargantext/API/Count.hs

@@ -44,6 +44,8 @@ import Gargantext.Prelude
 import Gargantext.Core.Utils.Prefix (unPrefix)
 
 -----------------------------------------------------------------------
+-- TODO-ACCESS: CanCount
+-- TODO-EVENTS: No events as this is a read only query.
 type CountAPI = Post '[JSON] Counts
 
 -----------------------------------------------------------------------

src/Gargantext/API/Node.hs

@@ -50,7 +50,7 @@ import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, TableNgramsApiGet, ta
 import Gargantext.Prelude
 import Gargantext.Database.Types.Node
 import Gargantext.Database.Utils -- (Cmd, CmdM)
-import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, deleteNode, deleteNodes, mk, JSONB, NodeError(..), HasNodeError(..))
+import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, NodeError(..), HasNodeError(..))
 import Gargantext.Database.Node.Children (getChildren)
 import qualified Gargantext.Database.Node.Update as U (update, Update(..))
 import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),FacetChart,runViewAuthorsDoc)
@@ -76,7 +76,11 @@ type GargServer api = forall env m. (CmdM env ServantErr m, HasRepoVar env)
                                  => ServerT api m
 
 -------------------------------------------------------------------
--- | TODO : access by admin only
+-- TODO-ACCESS: access by admin only.
+--              At first let's just have an isAdmin check.
+--              Later: check userId CanDeleteNodes Nothing
+-- TODO-EVENTS: DeletedNodes [NodeId]
+--              {"tag": "DeletedNodes", "nodes": [Int*]}
 type NodesAPI  = Delete '[JSON] Int
 
 -- | Delete Nodes
@@ -86,8 +90,13 @@ nodesAPI :: [NodeId] -> GargServer NodesAPI
 nodesAPI ids = deleteNodes ids
 
 ------------------------------------------------------------------------
--- | TODO: access by admin only
--- To manager the Users roots
+-- | TODO-ACCESS: access by admin only.
+-- At first let's just have an isAdmin check.
+-- Later: CanAccessAnyNode or (CanGetAnyNode, CanPutAnyNode)
+-- To manage the Users roots
+-- TODO-EVENTS:
+--   PutNode ?
+-- TODO needs design discussion.
 type Roots =  Get    '[JSON] [NodeAny]
          :<|> Put    '[JSON] Int -- TODO
 
@@ -98,10 +107,21 @@ roots = (liftIO (putStrLn ( "/user" :: Text)) >> getNodesWithParentId 0 Nothing)
 
 -------------------------------------------------------------------
 -- | Node API Types management
--- TODO : access by users
+-- TODO-ACCESS : access by users
+-- No ownership check is needed if we strictly follow the capability model.
+--
+-- CanGetNode (Node, Children, TableApi, TableNgramsApiGet, PairingApi, ChartApi,
+--             SearchAPI)
+-- CanRenameNode (or part of CanEditNode?)
+-- CanCreateChildren (PostNodeApi)
+-- CanEditNode / CanPutNode TODO not implemented yet
+-- CanDeleteNode
+-- CanPatch (TableNgramsApi)
+-- CanFavorite
+-- CanMoveToTrash
 type NodeAPI a = Get '[JSON] (Node a)
              :<|> "rename" :> RenameApi
-             :<|> PostNodeApi
+             :<|> PostNodeApi -- TODO move to children POST
              :<|> Put    '[JSON] Int
              :<|> Delete '[JSON] Int
              :<|> "children"  :> ChildrenApi a
@@ -122,6 +142,8 @@ type NodeAPI a = Get '[JSON] (Node a)
                         :> QueryParam "order"  OrderBy
                         :> SearchAPI
 
+-- TODO-ACCESS: check userId CanRenameNode nodeId
+-- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
 type RenameApi = Summary " Rename Node"
                :> ReqBody '[JSON] RenameNode
                :> Put     '[JSON] [Int]
@@ -137,10 +159,11 @@ type ChildrenApi a = Summary " Summary children"
                  :> Get '[JSON] [Node a]
 ------------------------------------------------------------------------
 -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
-nodeAPI :: JSONB a => proxy a -> NodeId -> GargServer (NodeAPI a)
-nodeAPI p id =  getNode     id p
+nodeAPI :: JSONB a => proxy a -> UserId -> NodeId -> GargServer (NodeAPI a)
+nodeAPI p uId id
+             =  getNode     id p
            :<|> rename      id
-           :<|> postNode    id
+           :<|> postNode    uId id
            :<|> putNode     id
            :<|> deleteNode  id
            :<|> getChildren id p
@@ -248,6 +271,8 @@ type ChartApi = Summary " Chart API"
              -- :<|> "query"    :> Capture "string" Text       :> Get  '[JSON] Text
 
 ------------------------------------------------------------------------
+-- TODO-ACCESS: CanGetNode
+-- TODO-EVENTS: No events as this is a read only query.
 type GraphAPI   = Get '[JSON] Graph
 
 graphAPI :: NodeId -> GargServer GraphAPI
@@ -255,12 +280,10 @@ graphAPI nId = do
 
   nodeGraph <- getNode nId HyperdataGraph
 
-  let title = "IMT - Scientific publications - 1982-2017 - English"
+  let title = "Title"
   let metadata = GraphMetadata title [maybe 0 identity $ _node_parentId nodeGraph]
-                                     [ LegendField 6 "#FFF" "Data processing"
-                                     , LegendField 7 "#FFF" "Networks"
-                                     , LegendField 1 "#FFF" "Material science"
-                                     , LegendField 5 "#FFF" "Energy / Environment"
+                                     [ LegendField 1 "#FFF" "Cluster"
+                                     , LegendField 2 "#FFF" "Cluster"
                                      ]
                          -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
   let cId = maybe (panic "no parentId") identity $ _node_parentId nodeGraph
@@ -302,6 +325,8 @@ instance HasTreeError ServantErr where
       mk TooManyRoots = err500 { errBody = e <> "Too many root nodes"           }
 
 type TreeAPI   = Get '[JSON] (Tree NodeTree)
+-- TODO-ACCESS: CanTree or CanGetNode
+-- TODO-EVENTS: No events as this is a read only query.
 treeAPI :: NodeId -> GargServer TreeAPI
 treeAPI = treeDB
 
@@ -331,8 +356,8 @@ getChart :: NodeId -> Maybe UTCTime -> Maybe UTCTime
                    -> Cmd err [FacetChart]
 getChart _ _ _ = undefined -- TODO
 
-postNode :: NodeId -> PostNode -> Cmd err [NodeId]
-postNode pId (PostNode name nt) = mk nt (Just pId) name
+postNode :: HasNodeError err => UserId -> NodeId -> PostNode -> Cmd err [NodeId]
+postNode uId pId (PostNode name nt) = mkNodeWithParent nt (Just pId) uId name
 
 putNode :: NodeId -> Cmd err Int
 putNode = undefined -- TODO

src/Gargantext/API/Search.hs

@@ -85,6 +85,8 @@ instance ToSchema SearchResults where
       defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
 
 -----------------------------------------------------------------------
+-- TODO-ACCESS: CanSearch? or is it part of CanGetNode
+-- TODO-EVENTS: No event, this is a read-only query.
 type SearchAPI = Post '[JSON] SearchResults
 -----------------------------------------------------------------------
 

src/Gargantext/Database/Flow.hs

@@ -97,7 +97,13 @@ flowInsertAnnuaire name children = do
 
   pure (ids, masterUserId, masterCorpusId, userId, userCorpusId)
 
-
+-- TODO-ACCESS:
+--   check userId       CanFillUserCorpus   userCorpusId
+--   check masterUserId CanFillMasterCorpus masterCorpusId
+--
+-- TODO-EVENTS:
+--   InsertedNgrams ?
+--   InsertedNodeNgrams ?
 flowCorpus' :: HasNodeError err
             => NodeType -> [HyperdataDocument]
             -> ([ReturnId], UserId, CorpusId, UserId, CorpusId)

src/Gargantext/Database/Metrics/TFICF.hs

@@ -143,4 +143,3 @@ GROUP BY nu.id,nu.terms
   |]
 
 
-

src/Gargantext/Database/Node/Document/Insert.hs

@@ -113,6 +113,8 @@ import Database.PostgreSQL.Simple (formatQuery)
 
 data ToDbData = ToDbDocument HyperdataDocument | ToDbContact HyperdataContact
 
+-- TODO-ACCESS: check uId CanInsertDoc pId && checkDocType nodeType
+-- TODO-EVENTS: InsertedNodes
 insertDocuments :: UserId -> ParentId -> NodeType -> [ToDbData] -> Cmd err [ReturnId]
 insertDocuments uId pId nodeType =
     runPGSQuery queryInsert . Only . Values fields . prepare uId pId nodeType

src/Gargantext/Database/Schema/Ngrams.hs

@@ -58,13 +58,11 @@ type NgramsTerms = Text
 type NgramsId    = Int
 type Size        = Int
 
---{-
 data NgramsPoly id terms n = NgramsDb { ngrams_id    :: id
-                                    , ngrams_terms :: terms
-                                    , ngrams_n     :: n
-                                    } deriving (Show)
+                                      , ngrams_terms :: terms
+                                      , ngrams_n     :: n
+                                      } deriving (Show)
 
---}
 type NgramsWrite = NgramsPoly (Maybe (Column PGInt4))
                                    (Column PGText)
                                    (Column PGInt4)
@@ -77,7 +75,6 @@ type NgramsReadNull = NgramsPoly (Column (Nullable PGInt4))
                                  (Column (Nullable PGText))
                                  (Column (Nullable PGInt4))
 
---{-
 type NgramsDb = NgramsPoly Int Text Int
 
 $(makeAdaptorAndInstance "pNgramsDb"    ''NgramsPoly)
@@ -85,17 +82,16 @@ $(makeAdaptorAndInstance "pNgramsDb"    ''NgramsPoly)
 
 ngramsTable :: Table NgramsWrite NgramsRead
 ngramsTable = Table "ngrams" (pNgramsDb NgramsDb { ngrams_id    = optional "id"
-                                            , ngrams_terms = required "terms"
-                                            , ngrams_n     = required "n"
-                                            }
-                                )
---{-
+                                                 , ngrams_terms = required "terms"
+                                                 , ngrams_n     = required "n"
+                                                 }
+                              )
+
 queryNgramsTable :: Query NgramsRead
 queryNgramsTable = queryTable ngramsTable
 
 dbGetNgramsDb :: Cmd err [NgramsDb]
 dbGetNgramsDb = runOpaQuery queryNgramsTable
---}
 
 -- | Main Ngrams Types
 -- | Typed Ngrams
@@ -193,9 +189,11 @@ indexNgramsTWith = fmap . indexNgramsWith
 indexNgramsWith :: (NgramsTerms -> NgramsId) -> Ngrams -> NgramsIndexed
 indexNgramsWith f n = NgramsIndexed n (f $ _ngramsTerms n)
 
+-- TODO-ACCESS: access must not be checked here but when insertNgrams is called.
 insertNgrams :: [Ngrams] -> Cmd err (Map NgramsTerms NgramsId)
 insertNgrams ns = fromList <$> map (\(NgramIds i t) -> (t, i)) <$> (insertNgrams' ns)
 
+-- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
 insertNgrams' :: [Ngrams] -> Cmd err [NgramIds]
 insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
   where

src/Gargantext/Database/Schema/Node.hs

@@ -500,29 +500,20 @@ childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Nod
 childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
 
 
--- | TODO Use right userId
-mk :: NodeType -> Maybe ParentId -> Text -> Cmd err [NodeId]
-mk nt pId name  = mk' nt userId pId name
-  where
-    userId = 1
+type Name = Text
 
-mk' :: NodeType -> UserId -> Maybe ParentId -> Text -> Cmd err [NodeId]
-mk' nt uId pId name  = insertNodesWithParentR pId [node nt name hd pId uId]
+mkNodeWithParent :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [NodeId]
+mkNodeWithParent NodeUser (Just _) _   _     = nodeError UserNoParent
+mkNodeWithParent _        Nothing  _   _     = nodeError HasParent
+mkNodeWithParent nt       pId     uId name   =
+    insertNodesWithParentR pId [node nt name hd pId uId]
   where
     hd = HyperdataUser . Just . pack $ show EN
 
-type Name = Text
-
-mk'' :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [NodeId]
-mk'' NodeUser Nothing uId name  = mk' NodeUser uId Nothing name
-mk'' NodeUser _       _   _     = nodeError UserNoParent
-mk'' _        Nothing _   _     = nodeError HasParent
-mk'' nt       pId     uId name  = mk' nt uId pId name
-
 mkRoot :: HasNodeError err => Username -> UserId -> Cmd err [RootId]
 mkRoot uname uId = case uId > 0 of
                False -> nodeError NegativeId
-               True  -> mk'' NodeUser Nothing uId uname
+               True  -> mkNodeWithParent NodeUser Nothing uId uname
 
 mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd err [CorpusId]
 mkCorpus n h p u = insertNodesR [nodeCorpusW n h p u]

src/Gargantext/Database/Schema/NodeNgram.hs

@@ -288,6 +288,8 @@ data NodeNgramsUpdate = NodeNgramsUpdate
   }
 
 -- TODO wrap these updates in a transaction.
+-- TODO-ACCESS:
+-- * check userId CanUpdateNgrams userListId
 updateNodeNgrams :: NodeNgramsUpdate -> Cmd err ()
 updateNodeNgrams nnu = do
   updateNodeNgrams' userListId $ _nnu_lists_update nnu

src/Gargantext/Prelude.hs

@@ -26,12 +26,14 @@ module Gargantext.Prelude
   , module Text.Read
   , cs
   , module Data.Maybe
+  , round
   , sortWith
   )
   where
 
 import GHC.Exts (sortWith)
 import GHC.Err.Located (undefined)
+import GHC.Real (round)
 import Control.Monad.IO.Class (MonadIO)
 import Data.Maybe (isJust, fromJust, maybe)
 import Protolude ( Bool(True, False), Int, Int64, Double, Integer

src/Gargantext/Text/Flow.hs

@@ -18,40 +18,33 @@ From text to viz, all the flow of texts in Gargantext.
 module Gargantext.Text.Flow
   where
 
+--import qualified Data.Array.Accelerate as A
+--import qualified Data.Set as DS
 import Control.Monad.Reader
-import GHC.IO (FilePath)
-import qualified Data.Text as T
-import Data.Text.IO (readFile)
-
+import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
 import Data.Map.Strict (Map)
 import Data.Maybe (catMaybes)
---import qualified Data.Set as DS
-import Data.Text (Text)
-
---import qualified Data.Array.Accelerate as A
 import qualified Data.Map.Strict as M
-----------------------------------------------
+import qualified Data.Text as T
+import Data.Text (Text)
+import Data.Text.IO (readFile)
 import Database.PostgreSQL.Simple (Connection)
-
+import GHC.IO (FilePath)
+import Gargantext.Core (Lang)
+import Gargantext.Core.Types (CorpusId)
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Types.Node
-
-import Gargantext.Core (Lang)
 import Gargantext.Prelude
-
-import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
-import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
-import Gargantext.Viz.Graph (Graph(..), data2graph)
-import Gargantext.Text.Metrics.Count (cooc)
-import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..))
-import Gargantext.Text.Terms (TermType, extractTerms)
 import Gargantext.Text.Context (splitBy, SplitContext(Sentences))
-import Gargantext.Core.Types (CorpusId)
-
+import Gargantext.Text.Metrics (filterCooc, FilterConfig(..), Clusters(..), SampleBins(..), DefaultValue(..), MapListSize(..), InclusionSize(..))
+import Gargantext.Text.Metrics.Count (cooc)
 import Gargantext.Text.Parsers.CSV
-
-import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
-
+import Gargantext.Text.Terms (TermType, extractTerms)
+import Gargantext.Viz.Graph (Graph(..), data2graph)
+import Gargantext.Viz.Graph.Bridgeness (bridgeness)
+import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
+--import Gargantext.Viz.Graph.Distances.Matrice (distributional)
+import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
 {-
   ____                             _            _
  / ___| __ _ _ __ __ _  __ _ _ __ | |_ _____  _| |_
@@ -161,12 +154,13 @@ cooc2graph myCooc = do
 
 --  let distance = fromIndex fi distanceMap
   --printDebug "distance" $ M.size distance
-  
+
   partitions <- case M.size distanceMap > 0 of
                   True  -> cLouvain distanceMap
                   False -> panic "Text.Flow: DistanceMap is empty"
 -- Building : -> Graph -> JSON
   --printDebug "partitions" $ DS.size $ DS.fromList $ map (l_community_id) partitions
   --printDebug "partitions" partitions
-  pure $ data2graph (M.toList ti) myCooc4 distanceMap partitions
+  let distanceMap' = bridgeness 300 partitions distanceMap
+  pure $ data2graph (M.toList ti) myCooc4 distanceMap' partitions
 

src/Gargantext/Text/Metrics.hs

@@ -63,7 +63,7 @@ filterCooc' (FilterConfig _ _ _ _ (DefaultValue dv)) ts m = trace ("coocScored "
   where
     selection  = [(x,y) | x <- ts
                         , y <- ts
-                      --  , x >= y
+                        , x > y
                         ]
 
 

src/Gargantext/Viz/Graph/Bridgeness.hs

+{-|
+Module      : Gargantext.Viz.Graph.Bridgeness
+Description : Bridgeness filter
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
+filters inter-communities links.
+
+-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Gargantext.Viz.Graph.Bridgeness (bridgeness)
+  where
+--import GHC.Base (Semigroup)
+import Gargantext.Prelude
+--import Data.Tuple.Extra (swap)
+--import Gargantext.Viz.Graph
+import Data.Map (Map, fromListWith, lookup, fromList, delete, toList, mapKeys, mapWithKey, elems)
+import qualified Data.Map as DM
+import Data.Maybe (fromJust)
+import Data.List (concat, sortOn)
+import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
+
+
+-- TODO mv in Louvain Lib
+type LouvainNodeId = Int
+type CommunityId   = Int
+
+type Bridgeness = Double
+
+
+bridgeness :: Bridgeness
+           -> [LouvainNode]
+           -> Map (LouvainNodeId, LouvainNodeId) Double
+           -> Map (LouvainNodeId, LouvainNodeId) Double
+bridgeness b ns = DM.fromList
+                . concat
+                . DM.elems
+                . filterComs b
+                . groupEdges (nodeId2comId ns)
+
+nodeId2comId :: [LouvainNode] -> Map LouvainNodeId CommunityId
+nodeId2comId ns = fromList [ (nId,cId) | LouvainNode nId cId <- ns]
+
+groupEdges :: Map LouvainNodeId CommunityId
+           -> Map (LouvainNodeId, LouvainNodeId) Double
+           -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
+groupEdges m = mapKeys fromJust
+             . delete Nothing
+             . fromListWith (<>)
+             . map (\((n1,n2), d)
+                     -> ((,) <$> lookup n1 m
+                             <*> lookup n2 m
+                        , [((n1,n2),d)]
+                        )
+                   )
+             . toList
+
+filterComs :: Bridgeness
+           -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
+           -> Map (CommunityId, CommunityId) [((LouvainNodeId, LouvainNodeId), Double)]
+filterComs b m = mapWithKey filter' m
+  where
+    filter' (c1,c2) a = case c1 == c2 of
+      True  -> a
+      False -> take n $ sortOn snd a
+        where
+          n = round $ b * a' / t
+          a'= fromIntegral $ length a
+          t = fromIntegral $ length $ concat $ elems m
+
+

src/Gargantext/Viz/Graph/Utils.hs

 {-|
-Module      : Gargantext.Graph.Distances.Utils
+Module      : Gargantext.Viz.Graph.Utils
 Description : 
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3

src/Gargantext/Viz/Phylo/Example.hs

@@ -39,6 +39,7 @@ import Data.Set (Set)
 import Gargantext.Text.Metrics.FrequentItemSet (fisWithSizePolyMap, Size(..))
 import Gargantext.Text.Terms.Mono (monoTexts)
 import Gargantext.Prelude
+import Gargantext.Viz.Phylo (Phylo)
 
 ------------------------------------------------------------------------
 -- | For this example Date is simply an Integer
@@ -55,23 +56,53 @@ type Ngrams  = Text
 type MapList = [Ngrams]
 type PeriodeSize = Int
 -- data Periodes b a = Map (b,b) a
+type Occurrences = Int
+
+
+
 
 ------------------------------------------------------------------------
+-- | Phylo == Phylo' ?
+type Phylo' a = [Strate a]
+
+data Strate a = Strate { strate_date     :: (Date,Date)
+                       , strate_clusters :: [Cluster a]
+                       }
+
+data Cluster a = Cluster { cluster_id :: Int
+                         , cluster_ngrams :: Set Ngrams
+                         , cluster_score  :: a
+                         , cluster_parent :: [(Cluster a, Double)]
+                         }
+
+------------------------------------------------------------------------
+phyloExampleFinal :: Phylo
+phyloExampleFinal = undefined
+
+--------------------------------------------------------------------
+appariement :: Map (Date, Date) (Map (Set Ngrams) Int)
+appariement = undefined
+
+--------------------------------------------------------------------
+
+phyloExample :: Map (Date, Date) (Map (Set Ngrams) Int)
+phyloExample = fis phyloTerms
 
 fis :: Map (Date, Date) [Document]
     -> Map (Date, Date) (Map (Set Ngrams) Int)
 fis = phylo (words . text)
 
+phyloTerms :: Map (Date, Date) [Document]
+phyloTerms = toPeriodes date 5 3 $ cleanCorpus mapList phyloCorpus
+
+------------------------------------------------------------------------
+
 -- | TODO: parameters has to be checked
 -- | TODO FIS on monotexts
 phylo :: (Document -> [Ngrams])
       -> Map (Date, Date) [Document]
       -> Map (Date, Date) (Map (Set Ngrams) Int)
 phylo f = DM.map (\d -> fisWithSizePolyMap (Segment 1 20) 1 (map f d))
-
-phyloTerms :: Map (Date, Date) [Document]
-phyloTerms = toPeriodes date 5 3 $ cleanCorpus mapList phyloCorpus
-
 ------------------------------------------------------------------------
 toPeriodes :: (Ord date, Enum date) => (doc -> date)
      -> Grain -> Step -> [doc] -> Map (date, date) [doc]
@@ -102,13 +133,11 @@ actants = [ "Cleopatre"   , "Ptolemee", "Ptolemee-XIII", "Ptolemee-XIV"
           , "Marc-Antoine", "Cesar"   , "Antoine"      , "Octave"  , "Rome"
           , "Alexandrie"  , "Auguste" , "Pompee"       , "Cassius" , "Brutus"]
 
-phyloCorpus :: Corpus
-phyloCorpus = map (\(d,t) -> Document d t) corpus
-
-
+phyloCorpus :: Corpus --[Document]
+phyloCorpus = map (\(d,t) -> Document d t) phyloExampleCorpus
 
 
 ------------------------------------------------------------------------
-corpus :: [(Date, Text)]
-corpus = DL.sortOn fst [ (-51,"Cleopatre règne sur l’egypte entre 51 et 30 av. J.-C. avec ses frères-epoux Ptolemee-XIII et Ptolemee-XIV, puis aux côtes du general romain Marc-Antoine. Elle est celèbre pour avoir ete la compagne de Jules Cesar puis d'Antoine, avec lesquels elle a eu plusieurs enfants. Partie prenante dans la guerre civile opposant Antoine à Octave, elle est vaincue à la bataille d'Actium en 31 av. J.-C. Sa defaite va permettre aux Romains de mener à bien la conquête de l’egypte, evenement qui marquera la fin de l'epoque hellenistique."), (-40,"Il existe relativement peu d'informations sur son sejour à Rome, au lendemain de l'assassinat de Cesar, ou sur la periode passee à Alexandrie durant l'absence d'Antoine, entre -40 et -37."), (-48,"L'historiographie antique lui est globalement defavorable car inspiree par son vainqueur, l'empereur Auguste, et par son entourage, dont l'interêt est de la noircir, afin d'en faire l'adversaire malfaisant de Rome et le mauvais genie d'Antoine. On observe par ailleurs que Cesar ne fait aucune mention de sa liaison avec elle dans les Commentaires sur la Guerre civile"), (-69,"Cleopatre est nee au cours de l'hiver -69/-686 probablement à Alexandrie."), (-48,"Pompee a en effet ete le protecteur de Ptolemee XII, le père de Cleopatre et de Ptolemee-XIII dont il se considère comme le tuteur."), (-48,"Ptolemee-XIII et Cleopatre auraient d'ailleurs aide Pompee par l'envoi d'une flotte de soixante navires."), (-48,"Mais le jeune roi Ptolemee-XIII et ses conseillers jugent sa cause perdue et pensent s'attirer les bonnes graces du vainqueur en le faisant assassiner à peine a-t-il pose le pied sur le sol egyptien, près de Peluse, le 30 juillet 48 av. J.-C., sous les yeux de son entourage."), (-48,"Cesar fait enterrer la tête de Pompee dans le bosquet de Nemesis en bordure du mur est de l'enceinte d'Alexandrie. Pour autant la mort de Pompee est une aubaine pour Cesar qui tente par ailleurs de profiter des querelles dynastiques pour annexer l’egypte."), (-48,"Il est difficile de se prononcer clairement sur les raisons qui ont pousse Cesar à s'attarder à Alexandrie. Il y a des raisons politiques, mais aussi des raisons plus sentimentales (Cleopatre ?). Il tente d'abord d'obtenir le remboursement de dettes que Ptolemee XII"), (-46,"Les deux souverains sont convoques par Cesar au palais royal d'Alexandrie. Ptolemee-XIII s'y rend après diverses tergiversations ainsi que Cleopatre."), (-47,"A Rome, Cleopatre epouse alors un autre de ses frères cadets, à Alexandrie, Ptolemee-XIV, sur l'injonction de Jules Cesar"), (-46,"Cesar a-t-il comme objectif de montrer ce qu'il en coûte de se revolter contre Rome en faisant figurer dans son triomphe la sœur de Cleopatre et de Ptolemee-XIV, Arsinoe, qui s'est fait reconnaître reine par les troupes de Ptolemee-XIII ?"), (-44,"Au debut de l'annee -44, Cesar est assassine par Brutus. Profitant de la situation confuse qui s'ensuit, Cleopatre quitte alors Rome à la mi-avril, faisant escale en Grèce. Elle parvient à Alexandrie en juillet -44."), (-44,"La guerre que se livrent les assassins de Cesar, Cassius et Brutus et ses heritiers, Octave et Marc-Antoine, oblige Cleopatre à des contorsions diplomatiques."), (-41,"Nous ignorons depuis quand Cleopatre, agee de 29 ans en -41, et Marc-Antoine, qui a une quarantaine d'annees, se connaissent. Marc-Antoine est l'un des officiers qui ont participe au retablissement de Ptolemee XII.  Il est plus vraisemblable qu'ils se soient frequentes lors du sejour à Rome de Cleopatre."), (-42,"Brutus tient la Grèce tandis que Cassius s'installe en Syrie. Le gouverneur de Cleopatre à Chypre, Serapion, vient en aide à Cassius."), (-42,"Cassius aurait envisage de s'emparer d'Alexandrie quand le 'debarquement' en Grèce d'Antoine et d'Octave l'oblige à renoncer à ses projets")]
+phyloExampleCorpus :: [(Date, Text)]
+phyloExampleCorpus = DL.sortOn fst [ (-51,"Cleopatre règne sur l’egypte entre 51 et 30 av. J.-C. avec ses frères-epoux Ptolemee-XIII et Ptolemee-XIV, puis aux côtes du general romain Marc-Antoine. Elle est celèbre pour avoir ete la compagne de Jules Cesar puis d'Antoine, avec lesquels elle a eu plusieurs enfants. Partie prenante dans la guerre civile opposant Antoine à Octave, elle est vaincue à la bataille d'Actium en 31 av. J.-C. Sa defaite va permettre aux Romains de mener à bien la conquête de l’egypte, evenement qui marquera la fin de l'epoque hellenistique."), (-40,"Il existe relativement peu d'informations sur son sejour à Rome, au lendemain de l'assassinat de Cesar, ou sur la periode passee à Alexandrie durant l'absence d'Antoine, entre -40 et -37."), (-48,"L'historiographie antique lui est globalement defavorable car inspiree par son vainqueur, l'empereur Auguste, et par son entourage, dont l'interêt est de la noircir, afin d'en faire l'adversaire malfaisant de Rome et le mauvais genie d'Antoine. On observe par ailleurs que Cesar ne fait aucune mention de sa liaison avec elle dans les Commentaires sur la Guerre civile"), (-69,"Cleopatre est nee au cours de l'hiver -69/-686 probablement à Alexandrie."), (-48,"Pompee a en effet ete le protecteur de Ptolemee XII, le père de Cleopatre et de Ptolemee-XIII dont il se considère comme le tuteur."), (-48,"Ptolemee-XIII et Cleopatre auraient d'ailleurs aide Pompee par l'envoi d'une flotte de soixante navires."), (-48,"Mais le jeune roi Ptolemee-XIII et ses conseillers jugent sa cause perdue et pensent s'attirer les bonnes graces du vainqueur en le faisant assassiner à peine a-t-il pose le pied sur le sol egyptien, près de Peluse, le 30 juillet 48 av. J.-C., sous les yeux de son entourage."), (-48,"Cesar fait enterrer la tête de Pompee dans le bosquet de Nemesis en bordure du mur est de l'enceinte d'Alexandrie. Pour autant la mort de Pompee est une aubaine pour Cesar qui tente par ailleurs de profiter des querelles dynastiques pour annexer l’egypte."), (-48,"Il est difficile de se prononcer clairement sur les raisons qui ont pousse Cesar à s'attarder à Alexandrie. Il y a des raisons politiques, mais aussi des raisons plus sentimentales (Cleopatre ?). Il tente d'abord d'obtenir le remboursement de dettes que Ptolemee XII"), (-46,"Les deux souverains sont convoques par Cesar au palais royal d'Alexandrie. Ptolemee-XIII s'y rend après diverses tergiversations ainsi que Cleopatre."), (-47,"A Rome, Cleopatre epouse alors un autre de ses frères cadets, à Alexandrie, Ptolemee-XIV, sur l'injonction de Jules Cesar"), (-46,"Cesar a-t-il comme objectif de montrer ce qu'il en coûte de se revolter contre Rome en faisant figurer dans son triomphe la sœur de Cleopatre et de Ptolemee-XIV, Arsinoe, qui s'est fait reconnaître reine par les troupes de Ptolemee-XIII ?"), (-44,"Au debut de l'annee -44, Cesar est assassine par Brutus. Profitant de la situation confuse qui s'ensuit, Cleopatre quitte alors Rome à la mi-avril, faisant escale en Grèce. Elle parvient à Alexandrie en juillet -44."), (-44,"La guerre que se livrent les assassins de Cesar, Cassius et Brutus et ses heritiers, Octave et Marc-Antoine, oblige Cleopatre à des contorsions diplomatiques."), (-41,"Nous ignorons depuis quand Cleopatre, agee de 29 ans en -41, et Marc-Antoine, qui a une quarantaine d'annees, se connaissent. Marc-Antoine est l'un des officiers qui ont participe au retablissement de Ptolemee XII.  Il est plus vraisemblable qu'ils se soient frequentes lors du sejour à Rome de Cleopatre."), (-42,"Brutus tient la Grèce tandis que Cassius s'installe en Syrie. Le gouverneur de Cleopatre à Chypre, Serapion, vient en aide à Cassius."), (-42,"Cassius aurait envisage de s'emparer d'Alexandrie quand le 'debarquement' en Grèce d'Antoine et d'Octave l'oblige à renoncer à ses projets")]