src/Gargantext/Viz/Chart.hs

   1 {-|
   2 Module      : Gargantext.Viz.Chart
   3 Description : Graph utils
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE TemplateHaskell   #-}
  13
  14 module Gargantext.Viz.Chart
  15   where
  16
  17 import Data.List (unzip, sortOn)
  18 import Data.Map (toList)
  19 import qualified Data.List as List
  20 import qualified Data.Map as Map
  21 import Data.Maybe (catMaybes)
  22
  23 import Gargantext.Core.Types.Main
  24 import Gargantext.Database.Admin.Config
  25 import Gargantext.Database.Admin.Types.Node (CorpusId)
  26 import Gargantext.Database.Prelude
  27 import Gargantext.Database.Query.Table.Node
  28 import Gargantext.Database.Query.Table.Node.Select
  29 import Gargantext.Database.Query.Table.NodeNode (selectDocsDates)
  30 import Gargantext.Database.Schema.Node
  31 import Gargantext.Prelude
  32 import Gargantext.Text.Metrics.Count (occurrencesWith)
  33
  34 -- Pie Chart
  35 import Gargantext.API.Ngrams.NTree
  36 import Gargantext.API.Ngrams.Tools
  37 import Gargantext.Core.Types
  38 import Gargantext.Database.Action.Flow
  39 import Gargantext.Database.Action.Metrics.NgramsByNode
  40 import Gargantext.Database.Schema.Ngrams
  41 import Gargantext.Viz.Types
  42
  43 histoData :: CorpusId -> Cmd err Histo
  44 histoData cId = do
  45   dates <- selectDocsDates cId
  46   let (ls, css) = unzip
  47                 $ sortOn fst
  48                 $ toList
  49                 $ occurrencesWith identity dates
  50   pure (Histo ls css)
  51
  52
  53 chartData :: FlowCmdM env err m
  54         => CorpusId -> NgramsType -> ListType
  55         -> m Histo
  56 chartData cId nt lt = do
  57   ls' <- selectNodesWithUsername NodeList userMaster
  58   ls <- map (_node_id) <$> getListsWithParentId cId
  59   ts <- mapTermListRoot ls nt <$> getRepo
  60   let
  61     dico = filterListWithRoot lt ts
  62     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
  63     group dico' x = case Map.lookup x dico' of
  64         Nothing -> x
  65         Just x' -> maybe x identity x'
  66
  67   (_total,mapTerms) <- countNodesByNgramsWith (group dico)
  68                     <$> getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
  69   let (dates, count) = unzip $ map (\(t,(d,_)) -> (t, d)) $ Map.toList mapTerms
  70   pure (Histo dates (map round count))
  71
  72
  73 treeData :: FlowCmdM env err m
  74         => CorpusId -> NgramsType -> ListType
  75         -> m [MyTree]
  76 treeData cId nt lt = do
  77   ls' <- selectNodesWithUsername NodeList userMaster
  78   ls <- map (_node_id) <$> getListsWithParentId cId
  79   ts <- mapTermListRoot ls nt <$> getRepo
  80
  81   let
  82     dico = filterListWithRoot lt ts
  83     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
  84
  85   cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
  86
  87   m  <- getListNgrams ls nt
  88   pure $ toTree lt cs' m
  89