GraphExplorer.purs 13.9 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)
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
import Gargantext.Components.Forest (forest)
import Gargantext.Components.Graph as Graph
James Laver's avatar
James Laver committed
19
import Gargantext.Components.GraphExplorer.Controls as Controls
20
import Gargantext.Components.GraphExplorer.Sidebar as Sidebar
James Laver's avatar
James Laver committed
21
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
22
import Gargantext.Components.GraphExplorer.Types as GET
23
import Gargantext.Data.Louvain as Louvain
24
import Gargantext.Ends (Frontends)
25 26
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax as Sigmax
27
import Gargantext.Hooks.Sigmax.Types as SigmaxT
28
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
29
import Gargantext.Sessions (Session, Sessions, get)
30
import Gargantext.Types as Types
31
import Gargantext.Utils.Range as Range
32
import Gargantext.Utils.Reactix as R2
33 34 35 36
import Math (log)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
James Laver's avatar
James Laver committed
37

38 39
type GraphId = Int

40 41
type LayoutProps =
  ( graphId :: GraphId
42
  , frontends :: Frontends
43
  , mCurrentRoute :: AppRoute
44
  , session :: Session
45
  , sessions :: Sessions
46
  , showLogin :: R.State Boolean
47
  )
48

49
type Props = (
50
    graph :: SigmaxT.SGraph
51
  , graphVersion :: R.State Int
52 53
  , mMetaData :: Maybe GET.MetaData
  | LayoutProps
54
  )
James Laver's avatar
James Laver committed
55

56
--------------------------------------------------------------
57 58
explorerLayout :: Record LayoutProps -> R.Element
explorerLayout props = R.createElement explorerLayoutCpt props []
59

60 61
explorerLayoutCpt :: R.Component LayoutProps
explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt
62
  where
63 64 65 66 67 68 69 70 71
    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
    el = R.hooksComponent "G.C.GE.explorerLayoutView" cpt
72
    cpt {frontends, graphId, mCurrentRoute, session, sessions, showLogin } _ = do
73
      useLoader graphId (getNodes session graphVersion) handler
74
      where
75
        handler loaded =
76 77 78 79 80 81 82 83
          explorer { frontends
                   , graph
                   , graphId
                   , graphVersion
                   , mCurrentRoute
                   , mMetaData
                   , session
                   , sessions
84
                   , showLogin }
85
          where (Tuple mMetaData graph) = convert loaded
86

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

91 92
explorerCpt :: R.Component Props
explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
James Laver's avatar
James Laver committed
93
  where
94
    cpt {frontends, graph, graphId, graphVersion, mCurrentRoute, mMetaData, session, sessions, showLogin } _ = do
95
      dataRef <- R.useRef graph
96
      graphRef <- R.useRef null
97
      graphVersionRef <- R.useRef (fst graphVersion)
98
      controls <- Controls.useGraphControls graph
99
      multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled
100

101
      R.useEffect' $ do
102
        let readData = R.readRef dataRef
103
        let gv = R.readRef graphVersionRef
104
        if SigmaxT.eqGraph readData graph then
105 106
          pure unit
        else do
107
          -- Graph data changed, reinitialize sigma.
108 109 110
          let rSigma = R.readRef controls.sigmaRef
          Sigmax.cleanupSigma rSigma "explorerCpt"
          R.setRef dataRef graph
111
          R.setRef graphVersionRef (fst graphVersion)
112
          -- Reinitialize bunch of state as well.
113 114 115 116
          snd controls.removedNodeIds $ const SigmaxT.emptyNodeIds
          snd controls.selectedNodeIds $ const SigmaxT.emptyNodeIds
          snd controls.showEdges $ const SigmaxT.EShow
          snd controls.forceAtlasState $ const SigmaxT.InitialRunning
117
          snd controls.graphStage $ const Graph.Init
118
          snd controls.showSidePanel $ const GET.InitialClosed
119

James Laver's avatar
James Laver committed
120
      pure $
121 122
        RH.div
          { id: "graph-explorer" }
123
          [ R2.row
124
            [ outer
125 126 127 128 129 130
              [ inner
                [ row1
                  [ col [ pullLeft [ Toggle.treeToggleButton controls.showTree ] ]
                  , col [ Toggle.controlsToggleButton controls.showControls ]
                  , col [ pullRight [ Toggle.sidebarToggleButton controls.showSidePanel ] ]
                  ]
131
                , rowControls [ Controls.controls controls ]
132 133
                , R2.row [
                        tree (fst controls.showTree) {sessions, mCurrentRoute, frontends} (snd showLogin)
134
                      , RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } []  -- graph container
135 136 137 138
                      , graphView { controls
                                  , elRef: graphRef
                                  , graphId
                                  , graph
139
                                  , multiSelectEnabledRef
140
                                  }
141 142
                      , mSidebar mMetaData { frontends
                                           , graph
143
                                           , graphVersion
144
                                           , removedNodeIds: controls.removedNodeIds
145 146 147 148
                                           , session
                                           , selectedNodeIds: controls.selectedNodeIds
                                           , showSidePanel: fst controls.showSidePanel
                                           }
149
                      ]
150
                ]
151
              ]
James Laver's avatar
James Laver committed
152 153
            ]
          ]
154

155
    outer = RH.div { className: "col-md-12" }
James Laver's avatar
James Laver committed
156
    inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } }
157
    row1  = RH.div { className: "row", style: { paddingBottom: "10px", marginTop: "-24px" } }
158
    rowControls = RH.div { className: "row controls" }
159 160
    col       = RH.div { className: "col-md-4" }
    pullLeft  = RH.div { className: "pull-left" }
James Laver's avatar
James Laver committed
161
    pullRight = RH.div { className: "pull-right" }
162

163 164 165 166 167 168
    tree :: Boolean
         -> {sessions :: Sessions, mCurrentRoute :: AppRoute, frontends :: Frontends}
         -> R2.Setter Boolean
         -> R.Element
    tree false _ _ = RH.div { id: "tree" } []
    tree true {sessions, mCurrentRoute: route, frontends} showLogin =
169
      RH.div {className: "col-md-2 graph-tree"} [forest {sessions, route, frontends, showLogin }]
170

171
    mSidebar :: Maybe GET.MetaData
172
             -> { frontends :: Frontends
173
                , graph :: SigmaxT.SGraph
174
                , graphVersion :: R.State Int
175
                , removedNodeIds :: R.State SigmaxT.NodeIds
176
                , showSidePanel :: GET.SidePanelState
177
                , selectedNodeIds :: R.State SigmaxT.NodeIds
178 179
                , session :: Session }
             -> R.Element
180
    mSidebar Nothing _ = RH.div {} []
181
    mSidebar (Just metaData) {frontends, graph, graphVersion, removedNodeIds, session, selectedNodeIds, showSidePanel} =
182 183
      Sidebar.sidebar { frontends
                      , graph
184
                      , graphVersion
185
                      , metaData
186
                      , removedNodeIds
187 188 189 190
                      , session
                      , selectedNodeIds
                      , showSidePanel
                      }
191 192

type GraphProps = (
193 194 195
    controls :: Record Controls.Controls
  , elRef :: R.Ref (Nullable Element)
  , graphId :: GraphId
196
  , graph :: SigmaxT.SGraph
197
  , multiSelectEnabledRef :: R.Ref Boolean
198 199
)

200
graphView :: Record GraphProps -> R.Element
201
--graphView sigmaRef props = R.createElement (R.memo el memoCmp) props []
202 203 204 205
graphView props = R.createElement graphViewCpt props []

graphViewCpt :: R.Component GraphProps
graphViewCpt = R.hooksComponent "GraphView" cpt
206
  where
207
    cpt {controls, elRef, graphId, graph, multiSelectEnabledRef} _children = do
208
      -- TODO Cache this?
209 210 211
      let louvainGraph =
            if (fst controls.showLouvain) then
              let louvain = Louvain.louvain unit in
212 213
              let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph) (SigmaxT.louvainEdges graph) in
              SigmaxT.louvainGraph graph cluster
214 215 216
            else
              graph
      let transformedGraph = transformGraph controls louvainGraph
217

218
      R.useEffect1' (fst controls.multiSelectEnabled) $ do
219 220
        R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled

221 222 223 224
      pure $ Graph.graph {
          elRef
        , forceAtlas2Settings: Graph.forceAtlas2Settings
        , graph
225 226
        , multiSelectEnabledRef
        , selectedNodeIds: controls.selectedNodeIds
227
        , showEdges: controls.showEdges
228
        , sigmaRef: controls.sigmaRef
229
        , sigmaSettings: Graph.sigmaSettings
230
        , stage: controls.graphStage
231
        , transformedGraph
232
        }
233

234 235
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
236 237
  where
    nodes = foldMapWithIndex nodeFn r.nodes
238
    nodeFn _i (GET.Node n) =
James Laver's avatar
James Laver committed
239
      Seq.singleton
240 241
        { borderColor: color
        , color : color
242 243
        , equilateral: { numPoints: 3 }
        , gargType
244
        , hidden : false
245
        , id    : n.id_
James Laver's avatar
James Laver committed
246
        , label : n.label
247
        , size  : log (toNumber n.size + 1.0)
248
        , type  : modeGraphType gargType
James Laver's avatar
James Laver committed
249 250 251 252
        , x     : n.x -- cos (toNumber i)
        , y     : n.y -- sin (toNumber i)
        }
      where
253
        cDef (GET.Cluster {clustDefault}) = clustDefault
254
        color = GET.intColor (cDef n.attributes)
255
        gargType =  unsafePartial $ fromJust $ Types.modeFromString n.type_
256
    nodesMap = SigmaxT.nodesMap nodes
257 258 259 260 261 262 263 264 265 266 267 268 269
    edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges
    edgeFn i (GET.Edge e) = 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
                                          }
270
      where
271 272 273
        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
274

275 276 277 278 279 280
-- | 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
281 282


283 284
getNodes :: Session -> R.State Int -> GraphId -> Aff GET.GraphData
getNodes session (graphVersion /\ _) graphId = get session $ NodeAPI Types.Graph (Just graphId) ("?version=" <> show graphVersion)
285 286


287 288
transformGraph :: Record Controls.Controls -> SigmaxT.SGraph -> SigmaxT.SGraph
transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
289
  where
290 291
    edges = SigmaxT.graphEdges graph
    nodes = SigmaxT.graphNodes graph
292 293 294
    selectedEdgeIds =
      Set.fromFoldable
        $ Seq.map _.id
295
        $ SigmaxT.neighbouringEdges graph (fst controls.selectedNodeIds)
296 297
    hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds)

298 299 300 301 302 303 304 305 306
    --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
307 308
    nodeFilter n = nodeSizeFilter n &&
                   nodeRemovedFilter n
309 310 311 312 313 314 315 316

    --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

317 318
    nodeRemovedFilter node@{ id } = not $ Set.member id $ fst controls.removedNodeIds

319 320 321 322 323 324
    --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
325
    edgeShowFilter edge =
326
      if (SigmaxT.edgeStateHidden $ fst controls.showEdges) then
327 328 329
        edge { hidden = true }
      else
        edge
330 331 332 333 334
    --edgeWeightFilter edge@{ weight } =
    --  if Range.within (fst controls.edgeWeight) weight then
    --    edge
    --  else
    --    edge { hidden = true }
335
    edgeWeightFilter :: Record SigmaxT.Edge -> Boolean
336
    edgeWeightFilter edge@{ weightIdx } = Range.within (fst controls.edgeWeight) $ toNumber weightIdx
337

338
    edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
339
    edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
340

341
    edgeMarked edge@{ id, sourceNode } = do
342
      let isSelected = Set.member id selectedEdgeIds
343 344
      case Tuple hasSelection isSelected of
        Tuple false true  -> edge { color = "#ff0000" }
345 346
        Tuple true  true  -> edge { color = sourceNode.color }
        Tuple true false  -> edge { color = "rgba(221, 221, 221, 0.5)" }
347
        _                 -> edge
348 349
    nodeMarked node@{ id } =
      if Set.member id (fst controls.selectedNodeIds) then
350
        node { borderColor = "#000", type = "selected" }
351 352
      else
        node