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

3 4
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
5 6
import Data.Map as Map
import Data.Map (Map)
7
import Data.Maybe (Maybe(..))
8
import Data.Tuple (Tuple(..))
9
import Data.Tuple.Nested ((/\))
10
import Effect.Aff (Aff, launchAff_)
11
import Reactix as R
12
import Reactix.DOM.HTML as H
13

14 15
import Gargantext.Prelude

16 17 18 19 20 21
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis')
import Gargantext.Components.Charts.Options.Type (xAxis)
import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2)
import Gargantext.Components.Charts.Options.Color (green, grey, red)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie)
22
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
23
import Gargantext.Components.Nodes.Corpus.Chart.Types
24
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
25
import Gargantext.Hooks.Loader (HashedResponse(..))
26
import Gargantext.Routes (SessionRoute(..))
27
import Gargantext.Sessions (Session, get)
28
import Gargantext.Types (ChartType(..), TabType, TermList(..))
29
import Gargantext.Utils.CacheAPI as GUC
30 31 32
import Gargantext.Utils.Reactix as R2

thisModule = "Gargantext.Components.Nodes.Corpus.Chart.Metrics"
33 34 35 36 37 38 39 40 41 42 43

newtype Metric = Metric
  { label :: String
  , x     :: Number
  , y     :: Number
  , cat   :: TermList
  }

instance decodeMetric :: DecodeJson Metric where
  decodeJson json = do
    obj   <- decodeJson json
44 45 46 47
    label <- obj .: "label"
    x     <- obj .: "x"
    y     <- obj .: "y"
    cat   <- obj .: "cat"
48 49
    pure $ Metric { label, x, y, cat }

50 51 52 53 54 55 56 57
instance encodeMetric :: EncodeJson Metric where
  encodeJson (Metric { label, x, y, cat }) =
       "label"  := encodeJson label
    ~> "x"      := encodeJson x
    ~> "y"      := encodeJson y
    ~> "cat"    := encodeJson cat
    ~> jsonEmptyObject

58 59
newtype Metrics = Metrics {
     "data" :: Array Metric
60 61 62 63 64
  }

instance decodeMetrics :: DecodeJson Metrics where
  decodeJson json = do
    obj <- decodeJson json
65
    d   <- obj .: "data"
66 67 68 69
    pure $ Metrics { "data": d }

type Loaded  = Array Metric

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

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

104
getMetricsHash :: Session -> ReloadPath -> Aff String
105 106
getMetricsHash session (_ /\ { corpusId, listId, tabType }) =
  get session $ CorpusMetricsHash { listId, tabType } (Just corpusId)
107

108 109 110 111 112 113 114 115 116
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
mkRequest session (_ /\ path@{ corpusId, limit, listId, tabType }) = GUC.makeGetRequest session $ chartUrl path

117
metrics :: Record Props -> R.Element
118
metrics props = R.createElement metricsCpt props []
119

120
metricsCpt :: R.Component Props
121
metricsCpt = R.hooksComponentWithModule thisModule "etrics" cpt
122
  where
123
    cpt {path, session} _ = do
124
      reload <- R.useState' 0
125
      pure $ metricsWithCacheLoadView {
126
          getMetricsHash
127 128 129 130 131 132 133 134 135 136 137
        , handleResponse
        , loaded
        , mkRequest: mkRequest session
        , path
        , reload
        , session
        }


loaded :: Record MetricsProps -> Loaded -> R.Element
loaded { path, reload, session } loaded =
138
  H.div {} [
139
  {-  U.reloadButton reload
140
  , U.chartUpdateButton { chartType: Scatter, path, reload, session }
141
  , -} chart $ scatterOptions loaded
142
  ]