GraphExplorer.purs 15.4 KB
Newer Older
James Laver's avatar
James Laver committed
1 2 3 4
module Gargantext.Components.GraphExplorer where

import Gargantext.Prelude hiding (max,min)

5
import DOM.Simple.Types (Element)
6
import Data.Array as A
7
import Data.FoldableWithIndex (foldMapWithIndex)
James Laver's avatar
James Laver committed
8
import Data.Int (toNumber)
9
import Data.Map as Map
10
import Data.Maybe (Maybe(..), fromJust, maybe)
11
import Data.Nullable (null, Nullable)
James Laver's avatar
James Laver committed
12
import Data.Sequence as Seq
13 14
import Data.Set as Set
import Data.Tuple (fst, snd, Tuple(..))
15
import Data.Tuple.Nested ((/\))
James Laver's avatar
James Laver committed
16
import Effect.Aff (Aff)
17 18 19 20
import Math (log)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
21
import Record as Record
22

23 24
import Gargantext.Components.Forest (forest)
import Gargantext.Components.Graph as Graph
James Laver's avatar
James Laver committed
25
import Gargantext.Components.GraphExplorer.Controls as Controls
26
import Gargantext.Components.GraphExplorer.Sidebar as Sidebar
James Laver's avatar
James Laver committed
27
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
28
import Gargantext.Components.GraphExplorer.Types as GET
29
import Gargantext.Data.Louvain as Louvain
30
import Gargantext.Ends (Frontends)
31 32
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax as Sigmax
33
import Gargantext.Hooks.Sigmax.Types as SigmaxT
34
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
35
import Gargantext.Sessions (Session, Sessions, get)
36
import Gargantext.Types as Types
37
import Gargantext.Utils.Range as Range
38
import Gargantext.Utils.Reactix as R2
James Laver's avatar
James Laver committed
39

40 41
thisModule = "Gargantext.Components.GraphExplorer"

42
type LayoutProps =
43
  ( frontends :: Frontends
44
  , graphId :: GET.GraphId
45
  , handed :: Types.Handed
46
  , mCurrentRoute :: AppRoute
47
  , session :: Session
48
  , sessions :: Sessions
49
  , showLogin :: R.State Boolean
50
  )
51

52
type Props = (
53
    graph :: SigmaxT.SGraph
54
  , graphVersion :: R.State Int
55
  , hyperdataGraph :: GET.HyperdataGraph
56 57
  , mMetaData :: Maybe GET.MetaData
  | LayoutProps
58
  )
James Laver's avatar
James Laver committed
59

60
--------------------------------------------------------------
61 62
explorerLayout :: Record LayoutProps -> R.Element
explorerLayout props = R.createElement explorerLayoutCpt props []
63

64
explorerLayoutCpt :: R.Component LayoutProps
65
explorerLayoutCpt = R2.hooksComponent thisModule "explorerLayout" cpt
66
  where
67 68 69 70 71 72 73 74
    cpt props _ = do
      graphVersion <- R.useState' 0

      pure $ explorerLayoutView graphVersion props

explorerLayoutView :: R.State Int -> Record LayoutProps -> R.Element
explorerLayoutView graphVersion p = R.createElement el p []
  where
75
    el = R2.hooksComponent thisModule "explorerLayoutView" cpt
76
    cpt props@{ graphId, session } _ = do
77
      useLoader graphId (getNodes session graphVersion) handler
78
      where
79
        handler loaded =
80 81 82 83
          explorer (Record.merge props { graph, graphVersion, hyperdataGraph: loaded, mMetaData })
          where
            GET.HyperdataGraph { graph: hyperdataGraph } = loaded
            (Tuple mMetaData graph) = convert hyperdataGraph
84

85
--------------------------------------------------------------
86 87
explorer :: Record Props -> R.Element
explorer props = R.createElement explorerCpt props []
James Laver's avatar
James Laver committed
88

89
explorerCpt :: R.Component Props
90
explorerCpt = R2.hooksComponent thisModule "explorer" cpt
James Laver's avatar
James Laver committed
91
  where
92 93 94 95 96
    cpt props@{ frontends
              , graph
              , graphId
              , graphVersion
              , handed
97
              , hyperdataGraph
98 99 100 101 102
              , mCurrentRoute
              , mMetaData
              , session
              , sessions
              , showLogin
103
              } _ = do
104 105 106 107

      let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData
      let forceAtlasS = if startForceAtlas then SigmaxT.InitialRunning else SigmaxT.InitialStopped

108
      dataRef <- R.useRef graph
109
      graphRef <- R.useRef null
110
      graphVersionRef       <- R.useRef (fst graphVersion)
111 112 113 114 115 116 117 118
      treeReload <- R.useState' 0
      controls              <- Controls.useGraphControls { forceAtlasS
                                                        , graph
                                                        , graphId
                                                        , hyperdataGraph
                                                        , session
                                                        , treeReload: \_ -> (snd treeReload) $ (+) 1
                                                        }
119
      multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled
120

121
      R.useEffect' $ do
122
        let readData = R.readRef dataRef
123
        let gv = R.readRef graphVersionRef
124
        if SigmaxT.eqGraph readData graph then
125 126
          pure unit
        else do
127
          -- Graph data changed, reinitialize sigma.
128 129 130
          let rSigma = R.readRef controls.sigmaRef
          Sigmax.cleanupSigma rSigma "explorerCpt"
          R.setRef dataRef graph
131
          R.setRef graphVersionRef (fst graphVersion)
132
          -- Reinitialize bunch of state as well.
133
          snd controls.removedNodeIds  $ const SigmaxT.emptyNodeIds
134
          snd controls.selectedNodeIds $ const SigmaxT.emptyNodeIds
135
          snd controls.showEdges       $ const SigmaxT.EShow
136
          snd controls.forceAtlasState $ const forceAtlasS
137 138
          snd controls.graphStage      $ const Graph.Init
          snd controls.showSidePanel   $ const GET.InitialClosed
139

James Laver's avatar
James Laver committed
140
      pure $
141 142
        RH.div
          { id: "graph-explorer" }
143
          [ rowToggle
144 145 146
                  [ col [ spaces [ Toggle.treeToggleButton controls.showTree         ]]
                  , col [ spaces [ Toggle.controlsToggleButton controls.showControls ]]
                  , col [ spaces [ Toggle.sidebarToggleButton controls.showSidePanel ]]
147 148
                  ], R2.row
            [ outer
149
              [ inner handed
150
                [ rowControls [ Controls.controls controls ]
151 152 153 154
                , R2.row $ mainLayout handed $
                    tree { frontends
                          , handed
                          , mCurrentRoute
155
                          , reload: treeReload
156 157 158 159 160 161 162 163 164 165
                          , sessions
                          , show: fst controls.showTree
                          , showLogin: snd showLogin }
                    /\
                    RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } []
                    /\
                    graphView { controls
                              , elRef: graphRef
                              , graphId
                              , graph
166 167
                              , hyperdataGraph
                              , mMetaData
168 169 170 171 172 173 174 175 176 177 178 179 180
                              , multiSelectEnabledRef
                              }
                    /\
                    mSidebar mMetaData { frontends
                                        , graph
                                        , graphId
                                        , graphVersion
                                        , removedNodeIds : controls.removedNodeIds
                                        , session
                                        , selectedNodeIds: controls.selectedNodeIds
                                        , showSidePanel  :   controls.showSidePanel
                                        , treeReload
                                        }
181
                ]
182
              ]
James Laver's avatar
James Laver committed
183 184
            ]
          ]
185

186 187 188
    mainLayout Types.RightHanded (tree' /\ gc /\ gv /\ sdb) = [tree', gc, gv, sdb]
    mainLayout Types.LeftHanded (tree' /\ gc /\ gv /\ sdb) = [sdb, gc, gv, tree']

189
    outer = RH.div { className: "col-md-12" }
190
    inner h = RH.div { className: "container-fluid " <> hClass }
191 192 193 194
      where
        hClass = case h of
          Types.LeftHanded -> "lefthanded"
          Types.RightHanded -> "righthanded"
195 196
    rowToggle  = RH.div { id: "toggle-container" }
    rowControls = RH.div { id: "controls-container" }
197
    col       = RH.div { className: "col-md-4" }
198
    pullLeft  = RH.div { className: "pull-left"  }
James Laver's avatar
James Laver committed
199
    pullRight = RH.div { className: "pull-right" }
200 201
    spaces    = RH.div { className: "flex-space-between" }

202

203 204
    tree :: Record TreeProps -> R.Element
    tree { show: false } = RH.div { id: "tree" } []
205
    tree { frontends, handed, mCurrentRoute: route, reload, sessions, showLogin } =
206
      RH.div {className: "col-md-2 graph-tree"} [
207
        forest { frontends, handed, reload, route, sessions, showLogin }
208
      ]
209

210
    mSidebar :: Maybe GET.MetaData
211
             -> Record MSidebarProps
212
             -> R.Element
213
    mSidebar  Nothing            _ = RH.div {} []
214 215 216
    mSidebar (Just metaData) props =
      Sidebar.sidebar (Record.merge props { metaData })

217 218 219
type TreeProps =
  (
    frontends :: Frontends
220
  , handed :: Types.Handed
221 222 223 224 225 226 227
  , mCurrentRoute :: AppRoute
  , reload :: R.State Int
  , sessions :: Sessions
  , show :: Boolean
  , showLogin :: R2.Setter Boolean
  )

228
type MSidebarProps =
229 230
  ( frontends       :: Frontends
  , graph           :: SigmaxT.SGraph
231
  , graphId         :: GET.GraphId
232 233 234
  , graphVersion    :: R.State Int
  , removedNodeIds  :: R.State SigmaxT.NodeIds
  , showSidePanel   :: R.State GET.SidePanelState
235
  , selectedNodeIds :: R.State SigmaxT.NodeIds
236 237
  , session         :: Session
  , treeReload      :: R.State Int
238
  )
239 240

type GraphProps = (
241 242 243 244 245 246
    controls              :: Record Controls.Controls
  , elRef                 :: R.Ref (Nullable Element)
  , graphId               :: GET.GraphId
  , graph                 :: SigmaxT.SGraph
  , hyperdataGraph        :: GET.HyperdataGraph
  , mMetaData             :: Maybe GET.MetaData
247
  , multiSelectEnabledRef :: R.Ref Boolean
248 249
)

250
graphView :: Record GraphProps -> R.Element
251
--graphView sigmaRef props = R.createElement (R.memo el memoCmp) props []
252 253 254
graphView props = R.createElement graphViewCpt props []

graphViewCpt :: R.Component GraphProps
255
graphViewCpt = R2.hooksComponent thisModule "graphView" cpt
256
  where
257 258 259 260 261 262 263
    cpt { controls
        , elRef
        , graphId
        , graph
        , hyperdataGraph: GET.HyperdataGraph { mCamera }
        , mMetaData
        , multiSelectEnabledRef } _children = do
264
      -- TODO Cache this?
265 266 267
      let louvainGraph =
            if (fst controls.showLouvain) then
              let louvain = Louvain.louvain unit in
268 269
              let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph) (SigmaxT.louvainEdges graph) in
              SigmaxT.louvainGraph graph cluster
270 271 272
            else
              graph
      let transformedGraph = transformGraph controls louvainGraph
273
      let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData
274

275
      R.useEffect1' (fst controls.multiSelectEnabled) $ do
276 277
        R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled

278 279 280 281
      pure $ Graph.graph {
          elRef
        , forceAtlas2Settings: Graph.forceAtlas2Settings
        , graph
282
        , mCamera
283 284
        , multiSelectEnabledRef
        , selectedNodeIds: controls.selectedNodeIds
285
        , showEdges: controls.showEdges
286
        , sigmaRef: controls.sigmaRef
287
        , sigmaSettings: Graph.sigmaSettings
288
        , stage: controls.graphStage
289
        , startForceAtlas
290
        , transformedGraph
291
        }
292

293 294
convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxT.SGraph
convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
James Laver's avatar
James Laver committed
295 296
  where
    nodes = foldMapWithIndex nodeFn r.nodes
297 298 299
    nodeFn _i nn@(GET.Node n) =
      Seq.singleton {
          borderColor: color
300
        , color : color
301 302
        , equilateral: { numPoints: 3 }
        , gargType
303
        , hidden : false
304
        , id    : n.id_
James Laver's avatar
James Laver committed
305
        , label : n.label
306
        , size  : log (toNumber n.size + 1.0)
307
        , type  : modeGraphType gargType
James Laver's avatar
James Laver committed
308 309
        , x     : n.x -- cos (toNumber i)
        , y     : n.y -- sin (toNumber i)
310
        , _original: nn
James Laver's avatar
James Laver committed
311 312
        }
      where
313
        cDef (GET.Cluster {clustDefault}) = clustDefault
314
        color = GET.intColor (cDef n.attributes)
315
        gargType =  unsafePartial $ fromJust $ Types.modeFromString n.type_
316
    nodesMap = SigmaxT.nodesMap nodes
317
    edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges
318
    edgeFn i ee@(GET.Edge e) =
319 320 321 322 323 324 325 326 327 328 329 330
      Seq.singleton
        { id : e.id_
        , color
        , confluence : e.confluence
        , hidden : false
        , size: 1.0
        , source : e.source
        , sourceNode
        , target : e.target
        , targetNode
        , weight : e.weight
        , weightIdx: i
331
        , _original: ee
332
        }
333
      where
334 335 336
        sourceNode = unsafePartial $ fromJust $ Map.lookup e.source nodesMap
        targetNode = unsafePartial $ fromJust $ Map.lookup e.target nodesMap
        color = sourceNode.color
James Laver's avatar
James Laver committed
337

338 339 340 341 342 343
-- | See sigmajs/plugins/sigma.renderers.customShapes/shape-library.js
modeGraphType :: Types.Mode -> String
modeGraphType Types.Authors = "square"
modeGraphType Types.Institutes = "equilateral"
modeGraphType Types.Sources = "star"
modeGraphType Types.Terms = "def"
James Laver's avatar
James Laver committed
344 345


346
getNodes :: Session -> R.State Int -> GET.GraphId -> Aff GET.HyperdataGraph
347
getNodes session (graphVersion /\ _) graphId = get session $ NodeAPI Types.Graph (Just graphId) ("?version=" <> show graphVersion)
348 349


350 351
transformGraph :: Record Controls.Controls -> SigmaxT.SGraph -> SigmaxT.SGraph
transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
352
  where
353 354
    edges = SigmaxT.graphEdges graph
    nodes = SigmaxT.graphNodes graph
355 356 357
    selectedEdgeIds =
      Set.fromFoldable
        $ Seq.map _.id
358
        $ SigmaxT.neighbouringEdges graph (fst controls.selectedNodeIds)
359 360
    hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds)

361 362 363 364 365 366 367 368 369
    --newNodes = Seq.map (nodeSizeFilter <<< nodeMarked) nodes
    --newEdges = Seq.map (edgeConfluenceFilter <<< edgeWeightFilter <<< edgeShowFilter <<< edgeMarked) edges
    newEdges' = Seq.filter edgeFilter $ Seq.map (edgeShowFilter <<< edgeMarked) edges
    newNodes = Seq.filter nodeFilter $ Seq.map (nodeMarked) nodes
    newEdges = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'

    edgeFilter e = edgeConfluenceFilter e &&
                   edgeWeightFilter e
                   --edgeShowFilter e
370 371
    nodeFilter n = nodeSizeFilter n &&
                   nodeRemovedFilter n
372 373 374 375 376 377 378 379

    --nodeSizeFilter node@{ size } =
    --  if Range.within (fst controls.nodeSize) size then
    --    node
    --  else
    --    node { hidden = true }
    nodeSizeFilter node@{ size } = Range.within (fst controls.nodeSize) size

380 381
    nodeRemovedFilter node@{ id } = not $ Set.member id $ fst controls.removedNodeIds

382 383 384 385 386 387
    --edgeConfluenceFilter edge@{ confluence } =
    --  if Range.within (fst controls.edgeConfluence) confluence then
    --    edge
    --  else
    --    edge { hidden = true }
    edgeConfluenceFilter edge@{ confluence } = Range.within (fst controls.edgeConfluence) confluence
388
    edgeShowFilter edge =
389
      if (SigmaxT.edgeStateHidden $ fst controls.showEdges) then
390 391 392
        edge { hidden = true }
      else
        edge
393 394 395 396 397
    --edgeWeightFilter edge@{ weight } =
    --  if Range.within (fst controls.edgeWeight) weight then
    --    edge
    --  else
    --    edge { hidden = true }
398
    edgeWeightFilter :: Record SigmaxT.Edge -> Boolean
399
    edgeWeightFilter edge@{ weightIdx } = Range.within (fst controls.edgeWeight) $ toNumber weightIdx
400

401
    edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
402
    edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
403

404
    edgeMarked edge@{ id, sourceNode } = do
405
      let isSelected = Set.member id selectedEdgeIds
406 407
      case Tuple hasSelection isSelected of
        Tuple false true  -> edge { color = "#ff0000" }
408 409
        Tuple true  true  -> edge { color = sourceNode.color }
        Tuple true false  -> edge { color = "rgba(221, 221, 221, 0.5)" }
410
        _                 -> edge
411 412
    nodeMarked node@{ id } =
      if Set.member id (fst controls.selectedNodeIds) then
413
        node { borderColor = "#000", type = "selected" }
414 415
      else
        node