src/Gargantext/Core/Viz/Chart.hs

   1 {-|
   2 Module      : Gargantext.Core.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.Core.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.Prelude
  26 import Gargantext.Database.Query.Table.Node
  27 import Gargantext.Database.Query.Table.Node.Select
  28 import Gargantext.Database.Query.Table.NodeNode (selectDocsDates)
  29 import Gargantext.Database.Schema.Node
  30 import Gargantext.Prelude
  31 import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
  32
  33 -- Pie Chart
  34 import Gargantext.API.Ngrams.NTree
  35 import Gargantext.API.Ngrams.Tools
  36 import Gargantext.Core.Types
  37 import Gargantext.Database.Action.Flow
  38 import Gargantext.Database.Action.Metrics.NgramsByNode
  39 import Gargantext.Database.Schema.Ngrams
  40 import Gargantext.Core.Viz.Types
  41
  42 histoData :: CorpusId -> Cmd err Histo
  43 histoData cId = do
  44   dates <- selectDocsDates cId
  45   let (ls, css) = unzip
  46                 $ sortOn fst
  47                 $ toList
  48                 $ occurrencesWith identity dates
  49   pure (Histo ls css)
  50
  51
  52 chartData :: FlowCmdM env err m
  53         => CorpusId -> NgramsType -> ListType
  54         -> m Histo
  55 chartData cId nt lt = do
  56   ls' <- selectNodesWithUsername NodeList userMaster
  57   ls <- map (_node_id) <$> getListsWithParentId cId
  58   ts <- mapTermListRoot ls nt <$> getRepo
  59   let
  60     dico = filterListWithRoot lt ts
  61     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
  62     group dico' x = case Map.lookup x dico' of
  63         Nothing -> x
  64         Just x' -> maybe x identity x'
  65
  66   (_total,mapTerms) <- countNodesByNgramsWith (group dico)
  67                     <$> getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
  68   let (dates, count) = unzip $ map (\(t,(d,_)) -> (t, d)) $ Map.toList mapTerms
  69   pure (Histo dates (map round count))
  70
  71
  72 treeData :: FlowCmdM env err m
  73         => CorpusId -> NgramsType -> ListType
  74         -> m [MyTree]
  75 treeData cId nt lt = do
  76   ls' <- selectNodesWithUsername NodeList userMaster
  77   ls <- map (_node_id) <$> getListsWithParentId cId
  78   ts <- mapTermListRoot ls nt <$> getRepo
  79
  80   let
  81     dico = filterListWithRoot lt ts
  82     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
  83
  84   cs' <- getNodesByNgramsOnlyUser cId (ls' <> ls) nt terms
  85
  86   m  <- getListNgrams ls nt
  87   pure $ toTree lt cs' m
  88