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

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

48
type Props =
49 50
  ( fa2Ref   :: R.Ref (Maybe ForceAtlas.FA2Layout)
  , sigmaRef :: R.Ref Sigmax.Sigma
51 52
  )

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

    { showSidebar
    , showDoc
    , mMetaData
    , showControls
    , graphId
arturo's avatar
arturo committed
70 71 72
    } <- GraphStore.use

    session <- useSession
arturo's avatar
arturo committed
73 74 75 76 77 78

    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
79 80 81 82

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

arturo's avatar
arturo committed
83 84
    -- | Hooks
    -- |
arturo's avatar
arturo committed
85

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

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

arturo's avatar
arturo committed
90

arturo's avatar
arturo committed
91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
    -- 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
111 112 113 114 115 116
    -- | Computed
    -- |
    let
      closeDoc :: Unit -> Effect Unit
      closeDoc _ = T.write_ Nothing showDoc

arturo's avatar
arturo committed
117 118
    -- | Render
    -- |
arturo's avatar
arturo committed
119 120 121 122 123 124 125 126

    pure $

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

arturo's avatar
arturo committed
142 143 144 145 146 147 148 149 150 151
            H.div
            { className: "graph-layout__focus" }
            [
              H.div
              { className: "graph-layout__focus__inner" }
              [
                docFocus
                { session
                , graphSideDoc
                , closeCallback: closeDoc
152
                , key: show $ getter _.docId graphSideDoc
arturo's avatar
arturo committed
153 154 155
                }
              ]
            ]
arturo's avatar
arturo committed
156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
        ,
          -- 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
177
                  { frontends: defaultFrontends
arturo's avatar
arturo committed
178 179 180 181 182
                  , metaData
                  , session
                  }
            ]
          ]
arturo's avatar
arturo committed
183 184 185 186 187 188 189 190 191 192
        ]
      ,
        -- 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
193
          Controls.controls
194 195
          { fa2Ref
          , reloadForest: reloadForest
arturo's avatar
arturo committed
196 197
          , sigmaRef
          }
arturo's avatar
arturo committed
198 199 200 201 202 203 204 205 206
        ]
      ,
        -- Content
        H.div
        { ref: graphRef
        , className: "graph-layout__content"
        }
        [
          graphView
arturo's avatar
arturo committed
207
          { elRef: graphRef
208
          , fa2Ref
arturo's avatar
arturo committed
209
          , sigmaRef
arturo's avatar
arturo committed
210
          }
211
        ]
arturo's avatar
arturo committed
212
      ]
213

arturo's avatar
arturo committed
214
--------------------------------------------------------------
215

216
type GraphProps =
217 218 219
  ( elRef    :: R.Ref (Nullable Element)
  , fa2Ref   :: R.Ref (Maybe ForceAtlas.FA2Layout)
  , sigmaRef :: R.Ref Sigmax.Sigma
arturo's avatar
arturo committed
220
  )
221

arturo's avatar
arturo committed
222 223
graphView :: R2.Leaf GraphProps
graphView = R2.leaf graphViewCpt
arturo's avatar
arturo committed
224 225
graphViewCpt :: R.Memo GraphProps
graphViewCpt = R.memo' $ here.component "graphView" cpt where
arturo's avatar
arturo committed
226
  cpt { elRef
227
      , fa2Ref
arturo's avatar
arturo committed
228 229 230 231 232 233 234 235 236 237 238 239
      , sigmaRef
      } _ = do
    -- | States
    -- |
    { edgeConfluence
    , edgeWeight
    , nodeSize
    , removedNodeIds
    , selectedNodeIds
    , showEdges
    , showLouvain
    , graph
arturo's avatar
arturo committed
240
    } <- GraphStore.use
arturo's avatar
arturo committed
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269

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

    -- | Computed
    -- |

    -- TODO Cache this?
    let louvainGraph =
          if showLouvain' then
            let louvain = Louvain.louvain unit in
            let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph') (SigmaxT.louvainEdges graph') in
            SigmaxT.louvainGraph graph' cluster
          else
            graph'

    let transformedGraph = transformGraph louvainGraph { edgeConfluence'
                                                        , edgeWeight'
                                                        , nodeSize'
                                                        , removedNodeIds'
                                                        , selectedNodeIds'
                                                        , showEdges' }

270
    -- R.useEffect' $ do
271 272 273
    --   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
274

arturo's avatar
arturo committed
275 276 277 278 279
    -- | Render
    -- |
    pure $

      Graph.drawGraph
arturo's avatar
arturo committed
280
      { elRef
281
      , fa2Ref
arturo's avatar
arturo committed
282 283 284 285 286
      , forceAtlas2Settings: Graph.forceAtlas2Settings
      , sigmaRef
      , sigmaSettings: Graph.sigmaSettings
      , transformedGraph
      }
arturo's avatar
arturo committed
287 288

--------------------------------------------------------
289

290 291
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
292
  where
293
    nodes = foldMapWithIndex nodeFn $ GEU.normalizeNodeSize 1 10000 r.nodes
294
    nodeFn _i nn@(GEGT.Node n) =
295 296
      Seq.singleton {
          borderColor: color
297
        , children: n.children
298
        , color : color
299 300
        , equilateral: { numPoints: 3 }
        , gargType
301
        , hidden : false
302
        , highlighted: false
303
        , id    : n.id_
James Laver's avatar
James Laver committed
304
        , label : n.label
305
        , size  : DN.log (toNumber n.size + 1.0)
306
        --, size: toNumber n.size
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 (GEGT.Cluster {clustDefault}) = clustDefault
314
        color = GET.intColor (cDef n.attributes)
315
        gargType =  unsafePartial $ fromJust $ Types.modeFromString n.type_
316
    nodesMap = SigmaxT.nodesMap nodes
317 318
    edges = foldMapWithIndex edgeFn $ A.sortWith (\(GEGT.Edge {weight}) -> weight) r.edges
    edgeFn i ee@(GEGT.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

arturo's avatar
arturo committed
338 339
--------------------------------------------------------------

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

arturo's avatar
arturo committed
348
--------------------------------------------------------------
James Laver's avatar
James Laver committed
349

350

351 352 353 354 355 356 357 358
type LiveProps = (
    edgeConfluence'  :: Range.NumberRange
  , edgeWeight'      :: Range.NumberRange
  , nodeSize'        :: Range.NumberRange
  , removedNodeIds'  :: SigmaxT.NodeIds
  , selectedNodeIds' :: SigmaxT.NodeIds
  , showEdges'       :: SigmaxT.ShowEdgesState
  )
359

360 361 362 363 364
transformGraph :: SigmaxT.SGraph -> Record LiveProps -> SigmaxT.SGraph
transformGraph graph { edgeConfluence'
                     , edgeWeight'
                     , nodeSize'
                     , removedNodeIds'
365
                     , selectedNodeIds' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
366
  where
367 368
    edges = SigmaxT.graphEdges graph
    nodes = SigmaxT.graphNodes graph
369 370 371
    selectedEdgeIds =
      Set.fromFoldable
        $ Seq.map _.id
372 373
        $ SigmaxT.neighbouringEdges graph selectedNodeIds'
    hasSelection = not $ Set.isEmpty selectedNodeIds'
374

375
    newEdges' = Seq.filter edgeFilter $ Seq.map (
376 377 378 379
      -- 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
380 381
      ) edges
    newNodes  = Seq.filter nodeFilter $ Seq.map (nodeMarked <<< nodeHideSize) nodes
382
    newEdges  = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'
383

384
    edgeFilter _e = true
385 386
    nodeFilter n = nodeRemovedFilter n

387
    nodeRemovedFilter { id } = not $ Set.member id removedNodeIds'
388 389 390

    edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeHideConfluence edge@{ confluence } =
391
      if Range.within edgeConfluence' confluence then
392 393 394 395 396 397
        edge
      else
        edge { hidden = true }

    edgeHideWeight :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeHideWeight edge@{ weightIdx } =
398
      if Range.within edgeWeight' $ toNumber weightIdx then
399 400 401 402
        edge
      else
        edge { hidden = true }

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

406
    edgeMarked :: Record SigmaxT.Edge -> Record SigmaxT.Edge
407
    edgeMarked edge@{ id, sourceNode } = do
408
      let isSelected = Set.member id selectedEdgeIds
409 410
      case Tuple hasSelection isSelected of
        Tuple false true  -> edge { color = "#ff0000" }
411 412
        Tuple true  true  -> edge { color = sourceNode.color }
        Tuple true false  -> edge { color = "rgba(221, 221, 221, 0.5)" }
413
        _                 -> edge
414 415

    nodeMarked :: Record SigmaxT.Node -> Record SigmaxT.Node
416
    nodeMarked node@{ id } =
417
      if Set.member id selectedNodeIds' then
418
        node { borderColor = "#000", highlighted = true, type = "selected" }
419
      else
420
        node { highlighted = false }
421 422 423

    nodeHideSize :: Record SigmaxT.Node -> Record SigmaxT.Node
    nodeHideSize node@{ size } =
424
      if Range.within nodeSize' size then
425 426 427
        node
      else
        node { hidden = true }