1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Map as Map
import Data.Map (Map)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
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)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType, TermList(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
thisModule = "Gargantext.Components.Nodes.Corpus.Chart.Metrics"
newtype Metric = Metric
{ label :: String
, x :: Number
, y :: Number
, cat :: TermList
}
instance decodeMetric :: DecodeJson Metric where
decodeJson json = do
obj <- decodeJson json
label <- obj .: "label"
x <- obj .: "x"
y <- obj .: "y"
cat <- obj .: "cat"
pure $ Metric { label, x, y, cat }
instance encodeMetric :: EncodeJson Metric where
encodeJson (Metric { label, x, y, cat }) =
"label" := encodeJson label
~> "x" := encodeJson x
~> "y" := encodeJson y
~> "cat" := encodeJson cat
~> jsonEmptyObject
newtype Metrics = Metrics {
"data" :: Array Metric
}
instance decodeMetrics :: DecodeJson Metrics where
decodeJson json = do
obj <- decodeJson json
d <- obj .: "data"
pure $ Metrics { "data": d }
type Loaded = Array Metric
scatterOptions :: Array Metric -> Options
scatterOptions metrics' = Options
{ mainTitle : "Ngrams Selection Metrics"
, subTitle : "Local metrics (Inc/Exc, Spe/Gen), Global metrics (TFICF maillage)"
, xAxis : xAxis { min: -1 }
, yAxis : yAxis' { position : "", show: true, min : -2}
, series : map2series $ metric2map metrics'
, addZoom : false
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
}
where
metric2map :: Array Metric -> Map TermList (Array Metric)
metric2map ds = Map.fromFoldableWith (<>) $ (\(Metric m) -> Tuple m.cat [Metric m]) <$> ds
--{-
map2series :: Map TermList (Array Metric) -> Array Series
map2series ms = toSeries <$> Map.toUnfoldable ms
where
-- TODO colors are not respected yet
toSeries (Tuple k ms') =
seriesScatterD2 {symbolSize: 5.0} (toSerie color <$> ms')
where
color =
case k of
StopTerm -> red
MapTerm -> green
CandidateTerm -> grey
toSerie color' (Metric {label,x,y}) =
dataSerie { name: label, itemStyle: itemStyle {color: color'}
-- , label: {show: true}
, value: [x,y]
}
--}
getMetricsHash :: Session -> ReloadPath -> Aff String
getMetricsHash session (_ /\ { corpusId, listId, tabType }) =
get session $ CorpusMetricsHash { listId, tabType } (Just corpusId)
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
metrics :: Record Props -> R.Element
metrics props = R.createElement metricsCpt props []
metricsCpt :: R.Component Props
metricsCpt = R.hooksComponentWithModule thisModule "etrics" cpt
where
cpt {path, session} _ = do
reload <- R.useState' 0
pure $ metricsWithCacheLoadView {
getMetricsHash
, handleResponse
, loaded
, mkRequest: mkRequest session
, path
, reload
, session
}
loaded :: Record MetricsProps -> Loaded -> R.Element
loaded { path, reload, session } loaded =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: Scatter, path, reload, session }
, -} chart $ scatterOptions loaded
]