Metrics.purs 3.83 KB
Newer Older
1
module Gargantext.Pages.Corpus.Chart.Metrics where
2

3 4
import Data.Array (foldl)
import Data.Tuple (Tuple(..))
5 6
import Data.Map as Map
import Data.Map (Map)
7
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
8
import Data.Maybe (Maybe(..), maybe)
9 10 11 12 13 14
import Effect.Aff (Aff)
import Gargantext.Config -- (End(..), Path(..), TabType, toUrl)
import Gargantext.Config.REST (get)
import React (ReactClass, ReactElement, createElement)
import Thermite (Spec, Render, defaultPerformAction, simpleSpec, createClass)
import Gargantext.Prelude
15
import Gargantext.Types (TermList(..))
16 17
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Charts.Options.ECharts
18
import Gargantext.Components.Charts.Options.Type
19
import Gargantext.Components.Charts.Options.Series
20
import Gargantext.Components.Charts.Options.Color
21 22
import Gargantext.Components.Charts.Options.Font
import Gargantext.Components.Charts.Options.Data
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

type Path =
  { corpusId :: Int
  , listId   :: Int
  , tabType  :: TabType
  , limit    :: Maybe Int
  }

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 }

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

loadedMetricsSpec :: Spec {} (Loader.InnerProps Path Loaded ()) Void
loadedMetricsSpec = simpleSpec defaultPerformAction render
  where
    render :: Render {} (Loader.InnerProps Path Loaded ()) Void
    render dispatch {loaded} {} _ = [chart (scatterOptions loaded)]

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

    --{-
80
    map2series :: Map TermList (Array Metric) -> Array Series
81
    map2series ms = toSeries <$> Map.toUnfoldable ms
82
      where
83
        -- TODO colors are not respected yet
84 85
        toSeries (Tuple k ms) =
            seriesScatterD2 {symbolSize: 5.0} (toSerie color <$> ms)
86 87 88 89
          where
            color =
              case k of
                StopTerm -> red
90 91 92 93 94 95 96
                GraphTerm -> green
                CandidateTerm -> grey
            toSerie color (Metric {label,x,y}) =
              dataSerie { name: label, itemStyle: itemStyle {color}
                     -- , label: {show: true}
                        , value: [x,y]
                        }
97
    --}
98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118

getMetrics :: Path -> Aff Loaded
getMetrics {corpusId, listId, limit, tabType} = do
  Metrics ms <- get $ toUrl Back (CorpusMetrics {listId, tabType, limit}) $ Just corpusId
  pure ms."data"

metricsLoaderClass :: ReactClass (Loader.Props Path Loaded)
metricsLoaderClass = Loader.createLoaderClass "MetricsLoader" getMetrics

metricsLoader :: Loader.Props' Path Loaded -> ReactElement
metricsLoader props = createElement metricsLoaderClass props []

metricsSpec :: Spec {} Path Void
metricsSpec = simpleSpec defaultPerformAction render
  where
    render :: Render {} Path Void
    render dispatch path {} _ =
      [ metricsLoader
        { path
        , component: createClass "LoadedMetrics" loadedMetricsSpec (const {})
        } ]