Metrics.purs 4.77 KB
Newer Older
1
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
2

3
import Data.Eq.Generic (genericEq)
4
import Data.Generic.Rep (class Generic)
5
import Data.Map (Map)
6
import Data.Map as Map
7
import Data.Maybe (Maybe(..))
8
import Data.Newtype (class Newtype)
9
import Data.Tuple (Tuple(..))
10
import Data.Tuple.Nested ((/\))
11 12
import Gargantext.Components.Charts.Options.Color (green, grey, red)
import Gargantext.Components.Charts.Options.Data (dataSerie)
13 14 15 16
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis')
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2)
import Gargantext.Components.Charts.Options.Type (xAxis)
17
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
18 19
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, Path, Props, ReloadPath)
import Gargantext.Config.REST (AffRESTError)
20
import Gargantext.Hooks.Loader (HashedResponse(..))
21
import Gargantext.Prelude (class Eq, bind, negate, pure, ($), (<$>), (<>))
22
import Gargantext.Routes (SessionRoute(..))
23
import Gargantext.Sessions (Session, get)
24
import Gargantext.Types (TermList(..))
25
import Gargantext.Utils.CacheAPI as GUC
26
import Gargantext.Utils.Reactix as R2
27
import Gargantext.Utils.Toestand as T2
28 29 30 31
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
32

33

34
here :: R2.Here
35
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Metrics"
36 37 38 39 40 41 42

newtype Metric = Metric
  { label :: String
  , x     :: Number
  , y     :: Number
  , cat   :: TermList
  }
43
derive instance Generic Metric _
44 45 46 47
derive instance Newtype Metric _
instance Eq Metric where eq = genericEq
derive newtype instance JSON.ReadForeign Metric
derive newtype instance JSON.WriteForeign Metric
48

49 50
newtype Metrics = Metrics {
     "data" :: Array Metric
51
  }
52 53 54
derive instance Generic Metrics _
derive instance Newtype Metrics _
derive newtype instance JSON.ReadForeign Metrics
55 56 57

type Loaded  = Array Metric

58 59 60 61 62 63
type LoadedProps =
  ( metrics :: Array Metric
  | MetricsProps )

scatterOptions :: Record LoadedProps -> Options
scatterOptions { onClick, onInit, metrics: metrics' } = Options
64
  { mainTitle : "Ngrams Selection Metrics"
65
  , subTitle  : "Local metrics (Inc/Exc, Spe/Gen), Global metrics (TFICF maillage)"
66 67
  , xAxis     : xAxis { min: -1 }
  , yAxis     : yAxis' { position : "", show: true, min : -2}
68
  , series    : map2series $ metric2map metrics'
69
  , addZoom   : false
70
  , tooltip   : mkTooltip { formatter: templateFormatter "{b0}" }
71 72
  , onClick
  , onInit
73 74
  }
  where
75 76
    metric2map :: Array Metric -> Map TermList (Array Metric)
    metric2map ds = Map.fromFoldableWith (<>) $ (\(Metric m) -> Tuple m.cat [Metric m]) <$> ds
77 78

    --{-
79
    map2series :: Map TermList (Array Metric) -> Array Series
80
    map2series ms = toSeries <$> Map.toUnfoldable ms
81
      where
82
        -- TODO colors are not respected yet
83 84
        toSeries (Tuple k ms') =
            seriesScatterD2 {symbolSize: 5.0} (toSerie color <$> ms')
85 86 87 88
          where
            color =
              case k of
                StopTerm -> red
89
                MapTerm -> green
90
                CandidateTerm -> grey
91 92
            toSerie color' (Metric {label,x,y}) =
              dataSerie { name: label, itemStyle: itemStyle {color: color'}
93 94 95
                     -- , label: {show: true}
                        , value: [x,y]
                        }
96
    --}
97

98
getMetricsHash :: Session -> ReloadPath -> AffRESTError String
99 100
getMetricsHash session (_ /\ { corpusId, listId, tabType }) =
  get session $ CorpusMetricsHash { listId, tabType } (Just corpusId)
101

102 103 104 105 106 107 108
chartUrl :: Record Path -> SessionRoute
chartUrl { corpusId, limit, listId, tabType } = CorpusMetrics { limit, listId, tabType } (Just corpusId)

handleResponse :: HashedResponse Metrics -> Loaded
handleResponse (HashedResponse { value: Metrics ms }) = ms."data"

mkRequest :: Session -> ReloadPath -> GUC.Request
109
mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
110

111
metrics :: Record Props -> R.Element
112
metrics props = R.createElement metricsCpt props []
113
metricsCpt :: R.Component Props
114
metricsCpt = here.component "etrics" cpt
115
  where
116
    cpt { onClick, onInit, path, session } _ = do
117 118
      reload <- T.useBox T2.newReload

119
      pure $ metricsWithCacheLoadView {
120
          getMetricsHash
121 122 123 124 125 126
        , handleResponse
        , loaded
        , mkRequest: mkRequest session
        , path
        , reload
        , session
127 128
        , onClick
        , onInit
129 130 131
        }


132 133 134 135
loaded :: R2.Leaf LoadedProps
loaded = R2.leaf loadedCpt
loadedCpt :: R.Component LoadedProps
loadedCpt = here.component "loaded" cpt where
136
  cpt p _ = do
137 138 139 140 141
    pure $ H.div {} [
      {-  U.reloadButton reload
      , U.chartUpdateButton { chartType: Scatter, path, reload, session }
      , -} chart $ scatterOptions p
      ]