Layout.purs 16.2 KB
Newer Older
arturo's avatar
arturo committed
1
module Gargantext.Components.GraphExplorer.Layout where
James Laver's avatar
James Laver committed
2

3 4
import Gargantext.Prelude hiding (max, min)

5
import DOM.Simple.Types (Element)
6
import Data.Array as A
7
import Data.FoldableWithIndex (foldMapWithIndex)
8 9
import Data.Hashable as Hashable
import Data.HashSet as HashSet
10
import Data.Int (floor, toNumber)
11
import Data.Map as Map
arturo's avatar
arturo committed
12
import Data.Maybe (Maybe(..), fromJust)
13
import Data.Nullable (null, Nullable)
James Laver's avatar
James Laver committed
14
import Data.Sequence as Seq
15
import Data.Set as Set
16
import Data.Tuple (Tuple(..))
arturo's avatar
arturo committed
17 18
import Effect (Effect)
import Gargantext.Components.App.Store as AppStore
arturo's avatar
arturo committed
19
import Gargantext.Components.Bootstrap as B
arturo's avatar
arturo committed
20
import Gargantext.Components.GraphExplorer.Frame.DocFocus (docFocus)
21
import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
arturo's avatar
arturo committed
22 23
import Gargantext.Components.GraphExplorer.Resources as Graph
import Gargantext.Components.GraphExplorer.Sidebar as GES
arturo's avatar
arturo committed
24 25
import Gargantext.Components.GraphExplorer.Store as GraphStore
import Gargantext.Components.GraphExplorer.Toolbar.Controls as Controls
26
import Gargantext.Components.GraphExplorer.TopBar as GETB
arturo's avatar
arturo committed
27
import Gargantext.Components.GraphExplorer.Types (GraphSideDoc)
28
import Gargantext.Components.GraphExplorer.Types as GET
29
import Gargantext.Components.GraphExplorer.Utils as GEU
arturo's avatar
arturo committed
30
import Gargantext.Config (defaultFrontends)
31
import Gargantext.Hooks.Session (useSession)
32
import Gargantext.Hooks.Sigmax.ForceAtlas2 as ForceAtlas
33
import Gargantext.Hooks.Sigmax.Noverlap as Noverlap
arturo's avatar
arturo committed
34
import Gargantext.Hooks.Sigmax as Sigmax
35
import Gargantext.Hooks.Sigmax.Types as SigmaxT
arturo's avatar
arturo committed
36
import Gargantext.Types as GT
37
import Gargantext.Types as Types
38
import Gargantext.Utils (getter, (?))
39
import Gargantext.Utils.Range as Range
40
import Gargantext.Utils.Reactix as R2
41 42
import Partial.Unsafe (unsafePartial)
import Reactix as R
arturo's avatar
arturo committed
43
import Reactix.DOM.HTML as H
arturo's avatar
arturo committed
44
import Toestand as T
James Laver's avatar
James Laver committed
45

arturo's avatar
arturo committed
46 47
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Layout"
48

49
type Props =
50
  ( fa2Ref   :: R.Ref (Maybe ForceAtlas.FA2Layout)
51
  , noverlapRef :: R.Ref (Maybe Noverlap.NoverlapLayout)
52
  , sigmaRef :: R.Ref Sigmax.Sigma
53 54
  )

arturo's avatar
arturo committed
55 56
layout :: R2.Leaf Props
layout = R2.leaf layoutCpt
57 58
layoutCpt :: R.Component Props
layoutCpt = here.component "layout" cpt where
59
  cpt { fa2Ref
60
      , noverlapRef
61
      , sigmaRef
arturo's avatar
arturo committed
62
      } _ = do
arturo's avatar
arturo committed
63 64
    -- | States
    -- |
arturo's avatar
arturo committed
65 66
    { reloadForest
    } <- AppStore.use
arturo's avatar
arturo committed
67 68 69 70 71 72

    { showSidebar
    , showDoc
    , mMetaData
    , showControls
    , graphId
arturo's avatar
arturo committed
73 74
    } <- GraphStore.use

75 76
    session <- useSession

arturo's avatar
arturo committed
77 78 79 80 81
    showSidebar'  <- R2.useLive' showSidebar
    showDoc'      <- R2.useLive' showDoc
    mMetaData'    <- R2.useLive' mMetaData
    showControls' <- R2.useLive' showControls
    graphId'      <- R2.useLive' graphId
arturo's avatar
arturo committed
82 83 84 85

    -- _dataRef <- R.useRef graph
    graphRef <- R.useRef null

arturo's avatar
arturo committed
86 87
    -- | Hooks
    -- |
arturo's avatar
arturo committed
88

arturo's avatar
arturo committed
89
    topBarPortalKey <- pure $ "portal-topbar::" <> show graphId'
arturo's avatar
arturo committed
90

arturo's avatar
arturo committed
91
    mTopBarHost <- R.unsafeHooksEffect $ R2.getElementById "portal-topbar"
arturo's avatar
arturo committed
92

arturo's avatar
arturo committed
93

arturo's avatar
arturo committed
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
    -- graphVersionRef <- R.useRef graphVersion'
    -- R.useEffect' $ do
    --   let readData = R.readRef dataRef
    --   let gv = R.readRef graphVersionRef
    --   if SigmaxT.eqGraph readData graph then
    --     pure unit
    --   else do
    --     -- Graph data changed, reinitialize sigma.
    --     let rSigma = R.readRef controls.sigmaRef
    --     Sigmax.cleanupSigma rSigma "explorerCpt"
    --     R.setRef dataRef graph
    --     R.setRef graphVersionRef graphVersion'
    --     -- Reinitialize bunch of state as well.
    --     T.write_ SigmaxT.emptyNodeIds controls.removedNodeIds
    --     T.write_ SigmaxT.emptyNodeIds controls.selectedNodeIds
    --     T.write_ SigmaxT.EShow controls.showEdges
    --     T.write_ forceAtlasS controls.forceAtlasState
    --     T.write_ Graph.Init controls.graphStage
    --     T.write_ Types.InitialClosed controls.sidePanelState

arturo's avatar
arturo committed
114 115 116 117 118 119
    -- | Computed
    -- |
    let
      closeDoc :: Unit -> Effect Unit
      closeDoc _ = T.write_ Nothing showDoc

arturo's avatar
arturo committed
120 121
    -- | Render
    -- |
arturo's avatar
arturo committed
122 123 124 125 126 127 128 129

    pure $

      H.div
      { className: "graph-layout" }
      [
        -- Topbar
        R2.createPortal' mTopBarHost
130
        [
arturo's avatar
arturo committed
131
          R2.fragmentWithKey topBarPortalKey
132
          [
arturo's avatar
arturo committed
133
            GETB.topBar
arturo's avatar
arturo committed
134
            {}
135 136
          ]
        ]
arturo's avatar
arturo committed
137
      ,
arturo's avatar
arturo committed
138
        -- Sidebar + Focus frame
arturo's avatar
arturo committed
139
        H.div
arturo's avatar
arturo committed
140
        { className: "graph-layout__frame" }
arturo's avatar
arturo committed
141
        [
arturo's avatar
arturo committed
142
          -- Doc focus
arturo's avatar
arturo committed
143
          R2.fromMaybe showDoc' \(graphSideDoc :: GraphSideDoc) ->
arturo's avatar
arturo committed
144

arturo's avatar
arturo committed
145 146 147 148 149 150 151
            H.div
            { className: "graph-layout__focus" }
            [
              H.div
              { className: "graph-layout__focus__inner" }
              [
                docFocus
152 153
                { session
                , graphSideDoc
arturo's avatar
arturo committed
154
                , closeCallback: closeDoc
155
                , key: show $ getter _.docId graphSideDoc
arturo's avatar
arturo committed
156 157 158
                }
              ]
            ]
arturo's avatar
arturo committed
159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179
        ,
          -- Sidebar
          H.div
          { className: "graph-layout__sidebar"
          -- @XXX: ReactJS lack of "keep-alive" feature workaround solution
          -- @link https://github.com/facebook/react/issues/12039
          , style: { display: showSidebar' == GT.Opened ? "block" $ "none" }
          }
          [
            H.div
            { className: "graph-layout__sidebar__inner" }
            [
              case mMetaData' of

                Nothing ->
                  B.caveat
                  {}
                  [ H.text "The current node does not contain any meta data" ]

                Just metaData ->
                  GES.sidebar
arturo's avatar
arturo committed
180
                  { frontends: defaultFrontends
arturo's avatar
arturo committed
181
                  , metaData
182
                  , session
arturo's avatar
arturo committed
183 184 185
                  }
            ]
          ]
arturo's avatar
arturo committed
186 187 188 189 190 191 192 193 194 195
        ]
      ,
        -- Toolbar
        H.div
        { className: "graph-layout__toolbar"
        -- @XXX: ReactJS lack of "keep-alive" feature workaround solution
        -- @link https://github.com/facebook/react/issues/12039
        , style: { display: showControls' ? "block" $ "none" }
        }
        [
arturo's avatar
arturo committed
196
          Controls.controls
197
          { fa2Ref
198
          , noverlapRef
199
          , reloadForest: reloadForest
200
          , session
arturo's avatar
arturo committed
201 202
          , sigmaRef
          }
arturo's avatar
arturo committed
203 204 205 206 207 208 209 210 211
        ]
      ,
        -- Content
        H.div
        { ref: graphRef
        , className: "graph-layout__content"
        }
        [
          graphView
arturo's avatar
arturo committed
212
          { elRef: graphRef
213
          , fa2Ref
214
          , noverlapRef
arturo's avatar
arturo committed
215
          , sigmaRef
arturo's avatar
arturo committed
216
          }
217
        ]
arturo's avatar
arturo committed
218
      ]
219

arturo's avatar
arturo committed
220
--------------------------------------------------------------
221

222
type GraphProps =
223 224
  ( elRef    :: R.Ref (Nullable Element)
  , fa2Ref   :: R.Ref (Maybe ForceAtlas.FA2Layout)
225
  , noverlapRef :: R.Ref (Maybe Noverlap.NoverlapLayout)
226
  , sigmaRef :: R.Ref Sigmax.Sigma
arturo's avatar
arturo committed
227
  )
228

arturo's avatar
arturo committed
229 230
graphView :: R2.Leaf GraphProps
graphView = R2.leaf graphViewCpt
arturo's avatar
arturo committed
231 232
graphViewCpt :: R.Memo GraphProps
graphViewCpt = R.memo' $ here.component "graphView" cpt where
arturo's avatar
arturo committed
233
  cpt { elRef
234
      , fa2Ref
235
      , noverlapRef
arturo's avatar
arturo committed
236 237 238 239 240 241
      , sigmaRef
      } _ = do
    -- | States
    -- |
    { edgeConfluence
    , edgeWeight
242
    , graph
arturo's avatar
arturo committed
243 244 245 246
    , nodeSize
    , removedNodeIds
    , selectedNodeIds
    , showEdges
247
    , transformedGraph
arturo's avatar
arturo committed
248
    } <- GraphStore.use
arturo's avatar
arturo committed
249

250 251 252 253 254 255 256
    -- edgeConfluence'     <- R2.useLive' edgeConfluence
    -- edgeWeight'         <- R2.useLive' edgeWeight
    -- nodeSize'           <- R2.useLive' nodeSize
    -- removedNodeIds'     <- R2.useLive' removedNodeIds
    -- selectedNodeIds'    <- R2.useLive' selectedNodeIds
    -- showEdges'          <- R2.useLive' showEdges
    -- graph'              <- R2.useLive' graph
arturo's avatar
arturo committed
257 258 259 260

    -- | Computed
    -- |

261 262 263 264 265 266 267 268
    -- let transformParams = { edgeConfluence'
    --                       , edgeWeight'
    --                       , nodeSize'
    --                       , removedNodeIds'
    --                       , selectedNodeIds'
    --                       , showEdges' }
    -- -- let transformedGraph = transformGraph graph' transformParams
    -- transformedGraphS <- T.useBox $ transformGraph graph' transformParams
269 270

    -- todo Cache this?
271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290
    -- R.useEffect' $ do
    --   --here.log2 "[graphView] transformedGraph" $ transformGraph graph' transformParams

    --   --let louvain = Louvain.louvain unit in
    --   --let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph') (SigmaxT.louvainEdges graph') in
    --   --SigmaxT.louvainGraph graph' cluster
    --   Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphView (louvainGraph)] no sigma" $ \sigma -> do
    --     newGraph <- Louvain.assignVisible (SigmaxS.graph sigma) {}
    --     -- here.log2 "[graphView] newGraph" newGraph
    --     -- here.log2 "[graphView] nodes" $ A.fromFoldable $ Graphology.nodes newGraph
    --     let cluster = Louvain.cluster newGraph :: DLouvain.LouvainCluster
    --     let lgraph = SigmaxT.louvainGraph graph' cluster :: SigmaxT.SGraph
    --     --T.write_ (transformGraph lgraph transformParams) transformedGraphS
    --     -- apply colors
    --     -- traverse_ (\{ id, color } ->
    --     --   Graphology.mergeNodeAttributes (SigmaxS.graph sigma) id { color }
    --     -- ) (SigmaxT.graphNodes lgraph)
    --     T.write_ lgraph transformedGraphS

    -- transformedGraph <- R2.useLive' transformedGraphS
arturo's avatar
arturo committed
291

292
    -- R.useEffect' $ do
293 294 295
    --   let (SigmaxT.Graph { edges: e }) = transformedGraph
    --   here.log2 "[graphView] transformedGraph edges" $ A.fromFoldable e
    --   here.log2 "[graphView] hidden edges" $ A.filter(_.hidden) $ A.fromFoldable e
296

297 298
    hooksTransformGraph

arturo's avatar
arturo committed
299 300 301 302 303
    -- | Render
    -- |
    pure $

      Graph.drawGraph
arturo's avatar
arturo committed
304
      { elRef
305
      , fa2Ref
306
      , noverlapRef
arturo's avatar
arturo committed
307 308 309 310
      , forceAtlas2Settings: Graph.forceAtlas2Settings
      , sigmaRef
      , sigmaSettings: Graph.sigmaSettings
      }
arturo's avatar
arturo committed
311 312

--------------------------------------------------------
313

314 315
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
316
  where
317
    normalizedNodes :: Array GEGT.Node
318 319
    normalizedNodes = (\n -> GEGT.Node (n { size = floor n.size })) <$>
                      (GEU.normalizeNodeSizeDefault $ (\(GEGT.Node n) -> n { size = toNumber n.size }) <$> r.nodes)
320 321 322
    nodes :: Seq.Seq (Record SigmaxT.Node)
    nodes = foldMapWithIndex nodeFn normalizedNodes
    nodeFn :: Int -> GEGT.Node -> Seq.Seq (Record SigmaxT.Node)
323
    nodeFn _i nn@(GEGT.Node n) =
324
      let (GEGT.Cluster { clustDefault }) = n.attributes in
325 326
      Seq.singleton {
          borderColor: color
327
        , children: n.children
328
        , color : color
329
        , community : clustDefault  -- for the communities-louvain graphology plugin
330 331
        , equilateral: { numPoints: 3 }
        , gargType
332
        , hidden : false
333
        , highlighted: false
334
        , id    : n.id_
James Laver's avatar
James Laver committed
335
        , label : n.label
336
        , size  : toNumber n.size
337
        --, size: toNumber n.size
338
        , type  : modeGraphType gargType
James Laver's avatar
James Laver committed
339 340
        , x     : n.x -- cos (toNumber i)
        , y     : n.y -- sin (toNumber i)
341
        , _original: nn
James Laver's avatar
James Laver committed
342 343
        }
      where
344
        cDef (GEGT.Cluster {clustDefault}) = clustDefault
345
        color = GET.intColor (cDef n.attributes)
346
        gargType =  unsafePartial $ fromJust $ Types.modeFromString n.type_
347
    nodesMap = SigmaxT.nodesMap nodes
348 349
    edges = foldMapWithIndex edgeFn $ A.sortWith (\(GEGT.Edge {weight}) -> weight) r.edges
    edgeFn i ee@(GEGT.Edge e) =
350 351 352 353 354 355 356 357 358 359 360 361
      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
362
        , _original: ee
363
        }
364
      where
365 366 367
        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
368

arturo's avatar
arturo committed
369 370
--------------------------------------------------------------

371 372
-- | See sigmajs/plugins/sigma.renderers.customShapes/shape-library.js
modeGraphType :: Types.Mode -> String
373
modeGraphType Types.Authors     = "triangle"
374 375
modeGraphType Types.Institutes  = "square"
modeGraphType Types.Sources     = "diamond"
376
--modeGraphType Types.Terms       = "def"
377
--modeGraphType Types.Terms       = "circle"
378
modeGraphType Types.Terms       = "ccircle"
James Laver's avatar
James Laver committed
379

arturo's avatar
arturo committed
380
--------------------------------------------------------------
James Laver's avatar
James Laver committed
381

382

383 384 385 386 387 388 389 390
type LiveProps = (
    edgeConfluence'  :: Range.NumberRange
  , edgeWeight'      :: Range.NumberRange
  , nodeSize'        :: Range.NumberRange
  , removedNodeIds'  :: SigmaxT.NodeIds
  , selectedNodeIds' :: SigmaxT.NodeIds
  , showEdges'       :: SigmaxT.ShowEdgesState
  )
391

392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427
hashLiveProps :: Record LiveProps -> Int
hashLiveProps p = Hashable.hash { edgeConfluence': p.edgeConfluence'
                                , edgeWeight': p.edgeWeight'
                                , nodeSize: p.nodeSize'
                                , removedNodeIds': HashSet.fromFoldable p.removedNodeIds'
                                , selectedNodeIds': HashSet.fromFoldable p.selectedNodeIds'
                                , showEdges': p.showEdges' }

transformGraphStoreParams :: R.Hooks (Record LiveProps)
transformGraphStoreParams = do
  store <- GraphStore.use

  edgeConfluence' <- R2.useLive' store.edgeConfluence
  edgeWeight' <- R2.useLive' store.edgeWeight
  nodeSize' <- R2.useLive' store.nodeSize
  removedNodeIds' <- R2.useLive' store.removedNodeIds
  selectedNodeIds' <- R2.useLive' store.selectedNodeIds
  showEdges' <- R2.useLive' store.showEdges

  pure { edgeConfluence'
       , edgeWeight'
       , nodeSize'
       , removedNodeIds'
       , selectedNodeIds'
       , showEdges' }

hooksTransformGraph :: R.Hooks Unit
hooksTransformGraph = do
  store <- GraphStore.use

  params <- transformGraphStoreParams
  graph' <- R2.useLive' store.graph

  R.useEffect2' (hashLiveProps params) graph' $ do
    T.write_ (transformGraph graph' params) store.transformedGraph

428 429 430 431 432
transformGraph :: SigmaxT.SGraph -> Record LiveProps -> SigmaxT.SGraph
transformGraph graph { edgeConfluence'
                     , edgeWeight'
                     , nodeSize'
                     , removedNodeIds'
433
                     , selectedNodeIds' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
434
  where
435 436
    edges = SigmaxT.graphEdges graph
    nodes = SigmaxT.graphNodes graph
437 438 439
    selectedEdgeIds =
      Set.fromFoldable
        $ Seq.map _.id
440
        $ SigmaxT.neighboringEdges graph selectedNodeIds'
441
    hasSelection = not $ Set.isEmpty selectedNodeIds'
442

443
    newEdges' = Seq.filter edgeFilter $ Seq.map (
444 445 446 447
      -- NOTE We don't use edgeShowFilter anymore because of
      -- https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/304
      -- edgeHideWeight <<< edgeHideConfluence <<< edgeShowFilter <<< edgeMarked
      edgeHideWeight <<< edgeHideConfluence <<< edgeMarked
448 449
      ) edges
    newNodes  = Seq.filter nodeFilter $ Seq.map (nodeMarked <<< nodeHideSize) nodes
450
    newEdges  = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'
451

452
    edgeFilter _e = true
453 454
    nodeFilter n = nodeRemovedFilter n

455
    nodeRemovedFilter { id } = not $ Set.member id removedNodeIds'
456 457 458

    edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeHideConfluence edge@{ confluence } =
459
      if Range.within edgeConfluence' confluence then
460 461 462 463 464 465
        edge
      else
        edge { hidden = true }

    edgeHideWeight :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeHideWeight edge@{ weightIdx } =
466
      if Range.within edgeWeight' $ toNumber weightIdx then
467 468 469 470
        edge
      else
        edge { hidden = true }

471
    edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
472
    edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
473

474
    edgeMarked :: Record SigmaxT.Edge -> Record SigmaxT.Edge
475
    edgeMarked edge@{ id, sourceNode } = do
476
      let isSelected = Set.member id selectedEdgeIds
477 478
      case Tuple hasSelection isSelected of
        Tuple false true  -> edge { color = "#ff0000" }
479 480
        Tuple true  true  -> edge { color = sourceNode.color }
        Tuple true false  -> edge { color = "rgba(221, 221, 221, 0.5)" }
481
        _                 -> edge
482 483

    nodeMarked :: Record SigmaxT.Node -> Record SigmaxT.Node
484
    nodeMarked node@{ id } =
485
      if Set.member id selectedNodeIds' then
486
        node { borderColor = "#000", highlighted = true, type = "selected" }
487
      else
488
        node { highlighted = false }
489 490 491

    nodeHideSize :: Record SigmaxT.Node -> Record SigmaxT.Node
    nodeHideSize node@{ size } =
492
      if Range.within nodeSize' size then
493 494 495
        node
      else
        node { hidden = true }