GraphExplorer.purs 13.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)
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
type GraphId = Int

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

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

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

63 64
explorerLayoutCpt :: R.Component LayoutProps
explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt
65
  where
66 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
    el = R.hooksComponent "G.C.GE.explorerLayoutView" cpt
75
    cpt props@{graphId, session} _ = do
76
      useLoader graphId (getNodes session graphVersion) handler
77
      where
78
        handler loaded =
79
          explorer (Record.merge props { graph, graphVersion, mMetaData })
80
          where (Tuple mMetaData graph) = convert loaded
81

82
--------------------------------------------------------------
83 84
explorer :: Record Props -> R.Element
explorer props = R.createElement explorerCpt props []
James Laver's avatar
James Laver committed
85

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

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

James Laver's avatar
James Laver committed
115
      pure $
116 117
        RH.div
          { id: "graph-explorer" }
118
          [ R2.row
119
            [ outer
120 121 122 123 124 125
              [ inner
                [ row1
                  [ col [ pullLeft [ Toggle.treeToggleButton controls.showTree ] ]
                  , col [ Toggle.controlsToggleButton controls.showControls ]
                  , col [ pullRight [ Toggle.sidebarToggleButton controls.showSidePanel ] ]
                  ]
126
                , rowControls [ Controls.controls controls ]
127
                , R2.row [
128 129 130 131 132 133
                        tree { frontends
                             , mCurrentRoute
                             , reload: props.treeReload
                             , sessions
                             , show: fst controls.showTree
                             , showLogin: 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
                                           , graphId
144
                                           , graphVersion
145
                                           , removedNodeIds: controls.removedNodeIds
146 147 148
                                           , session
                                           , selectedNodeIds: controls.selectedNodeIds
                                           , showSidePanel: fst controls.showSidePanel
149
                                           , treeReload
150
                                           }
151
                      ]
152
                ]
153
              ]
James Laver's avatar
James Laver committed
154 155
            ]
          ]
156

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

165 166 167 168 169 170
    tree :: Record TreeProps -> R.Element
    tree { show: false } = RH.div { id: "tree" } []
    tree { frontends, mCurrentRoute: route, reload, sessions, showLogin } =
      RH.div {className: "col-md-2 graph-tree"} [
        forest { frontends, reload, route, sessions, showLogin }
      ]
171

172
    mSidebar :: Maybe GET.MetaData
173
             -> Record MSidebarProps
174
             -> R.Element
175
    mSidebar Nothing _ = RH.div {} []
176 177 178
    mSidebar (Just metaData) props =
      Sidebar.sidebar (Record.merge props { metaData })

179 180 181 182 183 184 185 186 187 188
type TreeProps =
  (
    frontends :: Frontends
  , mCurrentRoute :: AppRoute
  , reload :: R.State Int
  , sessions :: Sessions
  , show :: Boolean
  , showLogin :: R2.Setter Boolean
  )

189 190 191
type MSidebarProps =
  ( frontends :: Frontends
  , graph :: SigmaxT.SGraph
192
  , graphId :: GraphId
193 194 195 196 197
  , graphVersion :: R.State Int
  , removedNodeIds :: R.State SigmaxT.NodeIds
  , showSidePanel :: GET.SidePanelState
  , selectedNodeIds :: R.State SigmaxT.NodeIds
  , session :: Session
198
  , treeReload :: R.State Int
199
  )
200 201

type GraphProps = (
202 203 204
    controls :: Record Controls.Controls
  , elRef :: R.Ref (Nullable Element)
  , graphId :: GraphId
205
  , graph :: SigmaxT.SGraph
206
  , multiSelectEnabledRef :: R.Ref Boolean
207 208
)

209
graphView :: Record GraphProps -> R.Element
210
--graphView sigmaRef props = R.createElement (R.memo el memoCmp) props []
211 212 213 214
graphView props = R.createElement graphViewCpt props []

graphViewCpt :: R.Component GraphProps
graphViewCpt = R.hooksComponent "GraphView" cpt
215
  where
216
    cpt {controls, elRef, graphId, graph, multiSelectEnabledRef} _children = do
217
      -- TODO Cache this?
218 219 220
      let louvainGraph =
            if (fst controls.showLouvain) then
              let louvain = Louvain.louvain unit in
221 222
              let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph) (SigmaxT.louvainEdges graph) in
              SigmaxT.louvainGraph graph cluster
223 224 225
            else
              graph
      let transformedGraph = transformGraph controls louvainGraph
226

227
      R.useEffect1' (fst controls.multiSelectEnabled) $ do
228 229
        R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled

230 231 232 233
      pure $ Graph.graph {
          elRef
        , forceAtlas2Settings: Graph.forceAtlas2Settings
        , graph
234 235
        , multiSelectEnabledRef
        , selectedNodeIds: controls.selectedNodeIds
236
        , showEdges: controls.showEdges
237
        , sigmaRef: controls.sigmaRef
238
        , sigmaSettings: Graph.sigmaSettings
239
        , stage: controls.graphStage
240
        , transformedGraph
241
        }
242

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

286 287 288 289 290 291
-- | 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
292 293


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


298 299
transformGraph :: Record Controls.Controls -> SigmaxT.SGraph -> SigmaxT.SGraph
transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
300
  where
301 302
    edges = SigmaxT.graphEdges graph
    nodes = SigmaxT.graphNodes graph
303 304 305
    selectedEdgeIds =
      Set.fromFoldable
        $ Seq.map _.id
306
        $ SigmaxT.neighbouringEdges graph (fst controls.selectedNodeIds)
307 308
    hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds)

309 310 311 312 313 314 315 316 317
    --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
318 319
    nodeFilter n = nodeSizeFilter n &&
                   nodeRemovedFilter n
320 321 322 323 324 325 326 327

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

328 329
    nodeRemovedFilter node@{ id } = not $ Set.member id $ fst controls.removedNodeIds

330 331 332 333 334 335
    --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
336
    edgeShowFilter edge =
337
      if (SigmaxT.edgeStateHidden $ fst controls.showEdges) then
338 339 340
        edge { hidden = true }
      else
        edge
341 342 343 344 345
    --edgeWeightFilter edge@{ weight } =
    --  if Range.within (fst controls.edgeWeight) weight then
    --    edge
    --  else
    --    edge { hidden = true }
346
    edgeWeightFilter :: Record SigmaxT.Edge -> Boolean
347
    edgeWeightFilter edge@{ weightIdx } = Range.within (fst controls.edgeWeight) $ toNumber weightIdx
348

349
    edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
350
    edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
351

352
    edgeMarked edge@{ id, sourceNode } = do
353
      let isSelected = Set.member id selectedEdgeIds
354 355
      case Tuple hasSelection isSelected of
        Tuple false true  -> edge { color = "#ff0000" }
356 357
        Tuple true  true  -> edge { color = sourceNode.color }
        Tuple true false  -> edge { color = "rgba(221, 221, 221, 0.5)" }
358
        _                 -> edge
359 360
    nodeMarked node@{ id } =
      if Set.member id (fst controls.selectedNodeIds) then
361
        node { borderColor = "#000", type = "selected" }
362 363
      else
        node