Document.hs 1.92 KB
Newer Older
Quentin Lobbé's avatar
Quentin Lobbé committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
{-|
Module      : Gargantext.Viz.Phylo.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


-}

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}

module Gargantext.Viz.Phylo.Aggregates.Document
  where

20 21
import Data.List        (last)
import Data.Map         (Map)
22
import Data.Text        (Text)
23
import Data.Tuple       (fst)
Quentin Lobbé's avatar
Quentin Lobbé committed
24
import Data.Vector      (Vector)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
25
import Gargantext.Prelude
26
import Gargantext.Text.Terms.Mono (monoTexts)
Quentin Lobbé's avatar
Quentin Lobbé committed
27 28 29
import Gargantext.Viz.Phylo
import qualified Data.List   as List
import qualified Data.Map    as Map
30
import qualified Data.Vector as Vector
Quentin Lobbé's avatar
Quentin Lobbé committed
31 32


33 34
-- | To init a list of Periods framed by a starting Date and an ending Date
initPeriods :: (Eq date, Enum date) => Grain -> Step -> (date, date) -> [(date, date)]
Alexandre Delanoë's avatar
Alexandre Delanoë committed
35
initPeriods g s (start,end) = map (\l -> (head' "Doc" l, last l))
36
                            $ chunkAlong g s [start .. end]
37 38 39 40 41 42


-- | To group a list of Documents by fixed periods
groupDocsByPeriod :: (Ord date, Enum date) => (doc -> date) -> [(date,date)] -> [doc] -> Map (date, date) [doc]
groupDocsByPeriod _ _   [] = panic "[ERR][Viz.Phylo.Example.docsToPeriods] Empty [Documents] can not have any periods"
groupDocsByPeriod f pds es = Map.fromList $ zip pds $ map (inPeriode f es) pds
Quentin Lobbé's avatar
Quentin Lobbé committed
43 44 45 46 47 48 49 50
  where
    --------------------------------------
    inPeriode :: Ord b => (t -> b) -> [t] -> (b, b) -> [t]
    inPeriode f' h (start,end) =
      fst $ List.partition (\d -> f' d >= start && f' d <= end) h
    --------------------------------------


51
-- | To parse a list of Documents by filtering on a Vector of Ngrams
52 53 54 55
parseDocs :: Vector Ngrams -> [(Date,Text)] -> [Document]
parseDocs roots c = map (\(d,t)
                -> Document d ( filter (\x -> Vector.elem x roots)
                              $ monoTexts t)) c
Quentin Lobbé's avatar
Quentin Lobbé committed
56 57