Metrics.purs 5.03 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.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
7 8
import Data.Map as Map
import Data.Map (Map)
9
import Data.Maybe (Maybe(..))
10
import Data.Tuple (Tuple(..))
11
import Data.Tuple.Nested ((/\))
12
import Effect.Aff (Aff)
13
import Reactix as R
14
import Reactix.DOM.HTML as H
15
import Toestand as T
16

17 18
import Gargantext.Prelude (class Eq, bind, negate, pure, ($), (<$>), (<>))

19 20 21 22 23 24
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)
25
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
26
import Gargantext.Components.Nodes.Corpus.Chart.Types
27
  (MetricsProps, Path, Props, ReloadPath)
28
import Gargantext.Hooks.Loader (HashedResponse(..))
29
import Gargantext.Routes (SessionRoute(..))
30
import Gargantext.Sessions (Session, get)
31
import Gargantext.Types (TermList(..))
32
import Gargantext.Utils.CacheAPI as GUC
33
import Gargantext.Utils.Reactix as R2
34
import Gargantext.Utils.Toestand as T2
35

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

newtype Metric = Metric
  { label :: String
  , x     :: Number
  , y     :: Number
  , cat   :: TermList
  }
45 46 47
derive instance genericMetric :: Generic Metric _
instance eqMetric :: Eq Metric where
  eq = genericEq
48 49 50
instance decodeMetric :: DecodeJson Metric where
  decodeJson json = do
    obj   <- decodeJson json
51 52 53 54
    label <- obj .: "label"
    x     <- obj .: "x"
    y     <- obj .: "y"
    cat   <- obj .: "cat"
55
    pure $ Metric { label, x, y, cat }
56 57 58 59 60 61 62 63
instance encodeMetric :: EncodeJson Metric where
  encodeJson (Metric { label, x, y, cat }) =
       "label"  := encodeJson label
    ~> "x"      := encodeJson x
    ~> "y"      := encodeJson y
    ~> "cat"    := encodeJson cat
    ~> jsonEmptyObject

64 65
newtype Metrics = Metrics {
     "data" :: Array Metric
66 67 68 69 70
  }

instance decodeMetrics :: DecodeJson Metrics where
  decodeJson json = do
    obj <- decodeJson json
71
    d   <- obj .: "data"
72 73 74 75
    pure $ Metrics { "data": d }

type Loaded  = Array Metric

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

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

110
getMetricsHash :: Session -> ReloadPath -> Aff String
111 112
getMetricsHash session (_ /\ { corpusId, listId, tabType }) =
  get session $ CorpusMetricsHash { listId, tabType } (Just corpusId)
113

114 115 116 117 118 119 120 121 122
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

123
metrics :: Record Props -> R.Element
124
metrics props = R.createElement metricsCpt props []
125

126
metricsCpt :: R.Component Props
127
metricsCpt = here.component "etrics" cpt
128
  where
129
    cpt {path, session} _ = do
130 131
      reload <- T.useBox T2.newReload

132
      pure $ metricsWithCacheLoadView {
133
          getMetricsHash
134 135 136 137 138 139 140 141 142 143
        , handleResponse
        , loaded
        , mkRequest: mkRequest session
        , path
        , reload
        , session
        }


loaded :: Record MetricsProps -> Loaded -> R.Element
144
loaded { path, reload, session } loaded' =
145
  H.div {} [
146
  {-  U.reloadButton reload
147
  , U.chartUpdateButton { chartType: Scatter, path, reload, session }
148
  , -} chart $ scatterOptions loaded'
149
  ]