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 NoImplicitPrelude #-}
  13 {-# LANGUAGE TemplateHaskell   #-}
  14 {-# LANGUAGE DeriveGeneric     #-}
  15 {-# LANGUAGE RankNTypes        #-}
  16 {-# LANGUAGE FlexibleContexts  #-}
  17
  18 module Gargantext.Viz.Chart
  19   where
  20
  21
  22 import Data.Text (Text)
  23 import Data.List (unzip, sortOn)
  24 import Data.Map (toList)
  25 import Data.Aeson.TH (deriveJSON)
  26 import GHC.Generics (Generic)
  27 import Gargantext.Prelude
  28 import Gargantext.Core.Utils.Prefix (unPrefix)
  29 import Gargantext.Database.Schema.NodeNode (selectDocsDates)
  30 import Gargantext.Database.Utils
  31 import Gargantext.Database.Types.Node (CorpusId)
  32 import Gargantext.Text.Metrics.Count (occurrencesWith)
  33 import Gargantext.Core.Types.Main
  34
  35 -- Pie Chart
  36 import Data.Maybe (catMaybes)
  37 import qualified Data.Map as Map
  38 import qualified Data.List as List
  39 import Gargantext.API.Ngrams.Tools
  40 import Gargantext.API.Ngrams.NTree
  41 import Gargantext.Database.Metrics.NgramsByNode
  42 import Gargantext.Database.Schema.Ngrams
  43 import Gargantext.Database.Schema.Node
  44 import Gargantext.Core.Types
  45 import Gargantext.Database.Flow
  46
  47 import Servant
  48
  49
  50 data Chart = ChartHisto | ChartScatter | ChartPie
  51   deriving (Generic)
  52
  53 -- TODO use UTCTime
  54 data Histo = Histo { histo_dates :: [Text]
  55                    , histo_count :: [Int]
  56                    }
  57   deriving (Generic)
  58
  59 histoData :: CorpusId -> Cmd err Histo
  60 histoData cId = do
  61   dates <- selectDocsDates cId
  62   let (ls, css) = unzip
  63                 $ sortOn fst
  64                 $ toList
  65                 $ occurrencesWith identity dates
  66   pure (Histo ls css)
  67
  68
  69 pieData :: FlowCmdM env err m
  70         => CorpusId -> NgramsType -> ListType
  71         -> m Histo
  72 pieData cId nt lt = do
  73   ls <- map (_node_id) <$> getListsWithParentId cId
  74   ts <- mapTermListRoot ls nt
  75   let
  76     dico = filterListWithRoot lt ts
  77     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
  78     group dico' x = case Map.lookup x dico' of
  79         Nothing -> x
  80         Just x' -> maybe x identity x'
  81
  82   (_total,mapTerms) <- countNodesByNgramsWith (group dico)
  83                     <$> getNodesByNgramsOnlyUser cId nt terms
  84   let (dates, count) = unzip $ map (\(t,(d,_)) -> (t, d)) $ Map.toList mapTerms
  85   pure (Histo dates (map round count))
  86
  87
  88 data TreeChartMetrics = TreeChartMetrics { _tcm_data :: [MyTree]
  89                    }
  90   deriving (Generic, Show)
  91
  92 deriveJSON (unPrefix "_tcm_") ''TreeChartMetrics
  93
  94
  95 treeData :: FlowCmdM env err m
  96         => CorpusId -> NgramsType -> ListType
  97         -> m TreeChartMetrics
  98 treeData cId nt lt = do
  99   ls <- map (_node_id) <$> getListsWithParentId cId
 100   ts <- mapTermListRoot ls nt
 101
 102   let
 103     dico = filterListWithRoot lt ts
 104     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
 105
 106   cs' <- getNodesByNgramsOnlyUser cId nt terms
 107
 108   m  <- getListNgrams ls nt
 109   pure $ TreeChartMetrics $ toTree lt cs' m
 110
 111
 112 treeData' :: FlowCmdM env ServantErr m
 113         => CorpusId -> NgramsType -> ListType
 114         -> m TreeChartMetrics
 115 treeData' cId nt lt = do
 116   ls <- map (_node_id) <$> getListsWithParentId cId
 117   ts <- mapTermListRoot ls nt
 118
 119   let
 120     dico = filterListWithRoot lt ts
 121     terms = catMaybes $ List.concat $ map (\(a,b) -> [Just a, b]) $ Map.toList dico
 122
 123   cs' <- getNodesByNgramsOnlyUser cId nt terms
 124
 125   m  <- getListNgrams ls nt
 126   pure $ TreeChartMetrics $ toTree lt cs' m
 127
 128
 129