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

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

5
import Control.Bind ((=<<))
6
import DOM.Simple.Types (Element)
7
import Data.Array as A
8
import Data.FoldableWithIndex (foldMapWithIndex)
James Laver's avatar
James Laver committed
9
import Data.Int (toNumber)
10
import Data.Map as Map
11
import Data.Maybe (Maybe(..), fromJust, maybe)
12
import Data.Nullable (null, Nullable)
James Laver's avatar
James Laver committed
13
import Data.Sequence as Seq
14
import Data.Set as Set
15
import Data.Tuple (Tuple(..))
16
import Gargantext.Components.App.Data (Boxes)
17
import Gargantext.Components.Graph as Graph
James Laver's avatar
James Laver committed
18
import Gargantext.Components.GraphExplorer.Controls as Controls
19
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
20
import Gargantext.Components.GraphExplorer.Types as GET
21
import Gargantext.Config.REST (AffRESTError, logRESTError)
22 23
import Gargantext.Data.Louvain as Louvain
import Gargantext.Hooks.Loader (useLoader)
24
import Gargantext.Hooks.Sigmax.Sigma (startForceAtlas2)
25
import Gargantext.Hooks.Sigmax.Types as SigmaxT
26 27
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get)
28
import Gargantext.Types as Types
29
import Gargantext.Utils.Range as Range
30
import Gargantext.Utils.Reactix as R2
31
import Gargantext.Utils.Toestand as T2
32 33 34 35 36 37 38
import Math as Math
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Record as Record
import Record.Extra as RX
import Toestand as T
James Laver's avatar
James Laver committed
39

40 41
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer"
42

43
type BaseProps =
44
  ( boxes          :: Boxes
45
  , graphId        :: GET.GraphId
46
  )
47

48
type LayoutProps =
49
  ( session      :: Session
50
  | BaseProps )
51

52
type Props =
53 54 55 56 57
  ( graph          :: SigmaxT.SGraph
  , hyperdataGraph :: GET.HyperdataGraph
  | LayoutProps
  )

58 59 60
type GraphWriteProps =
  ( mMetaData'     :: Maybe GET.MetaData
  | Props
61
  )
James Laver's avatar
James Laver committed
62

63 64 65 66
type LayoutWithKeyProps =
  ( key :: String
  | LayoutProps )

67
--------------------------------------------------------------
68 69 70 71 72 73 74 75
explorerLayoutWithKey :: R2.Component LayoutWithKeyProps
explorerLayoutWithKey = R.createElement explorerLayoutWithKeyCpt
explorerLayoutWithKeyCpt :: R.Component LayoutWithKeyProps
explorerLayoutWithKeyCpt = here.component "explorerLayoutWithKey" cpt where
  cpt { boxes, graphId, session } _ = do
    pure $ explorerLayout { boxes, graphId, session } []


76
explorerLayout :: R2.Component LayoutProps
77
explorerLayout = R.createElement explorerLayoutCpt
78 79
explorerLayoutCpt :: R.Component LayoutProps
explorerLayoutCpt = here.component "explorerLayout" cpt where
80
  cpt props@{ boxes: { graphVersion }, graphId, session } _ = do
81 82
    graphVersion' <- T.useLive T.unequal graphVersion

83 84 85 86
    useLoader { errorHandler
              , loader: getNodes session graphVersion'
              , path: graphId
              , render: handler }
James Laver's avatar
James Laver committed
87
    where
88
      errorHandler = logRESTError here "[explorerLayout]"
89 90
      handler loaded@(GET.HyperdataGraph { graph: hyperdataGraph }) =
        explorerWriteGraph (Record.merge props { graph, hyperdataGraph: loaded, mMetaData' }) []
James Laver's avatar
James Laver committed
91
        where
92
          Tuple mMetaData' graph = convert hyperdataGraph
93

94 95 96 97
explorerWriteGraph :: R2.Component GraphWriteProps
explorerWriteGraph = R.createElement explorerWriteGraphCpt
explorerWriteGraphCpt :: R.Component GraphWriteProps
explorerWriteGraphCpt = here.component "explorerWriteGraph" cpt where
98
  cpt props@{ boxes: { sidePanelGraph }
99 100 101 102 103 104 105 106 107 108 109 110 111
            , graph
            , mMetaData' } _ = do
      R.useEffectOnce' $ do
        T.write_ (Just { mGraph: Just graph
                       , mMetaData: mMetaData'
                       , multiSelectEnabled: false
                       , removedNodeIds: Set.empty
                       , selectedNodeIds: Set.empty
                       , showControls: false
                       , sideTab: GET.SideTabLegend }) sidePanelGraph

      pure $ explorer (RX.pick props :: Record Props) []

112
--------------------------------------------------------------
113 114
explorer :: R2.Component Props
explorer = R.createElement explorerCpt
115
explorerCpt :: R.Component Props
116
explorerCpt = here.component "explorer" cpt
James Laver's avatar
James Laver committed
117
  where
118
    cpt props@{ boxes: { graphVersion, handed, reloadForest, showTree, sidePanelGraph, sidePanelState }
119 120 121 122 123 124
        , graph
        , graphId
        , hyperdataGraph
        , session
        } _ = do
      { mMetaData } <- GEST.focusedSidePanel sidePanelGraph
125
      _graphVersion' <- T.useLive T.unequal graphVersion
126
      handed' <- T.useLive T.unequal handed
127
      mMetaData' <- T.useLive T.unequal mMetaData
128

129
      let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas: sfa }) -> sfa) mMetaData'
130 131 132 133

      let forceAtlasS = if startForceAtlas
                          then SigmaxT.InitialRunning
                          else SigmaxT.InitialStopped
134

135
      _dataRef <- R.useRef graph
136
      graphRef <- R.useRef null
137
      controls <- Controls.useGraphControls { forceAtlasS
138 139 140
                                            , graph
                                            , graphId
                                            , hyperdataGraph
141
                                            , reloadForest
142
                                            , session
143
                                            , showTree
144
                                            , sidePanel: sidePanelGraph
145
                                            , sidePanelState }
146

147
      -- graphVersionRef <- R.useRef graphVersion'
148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
      -- 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
166

James Laver's avatar
James Laver committed
167
      pure $
168 169
        RH.div { className: "graph-meta-container" }
        [ RH.div { className: "graph-container" }
170
          [ RH.div { className: "container-fluid " <> hClass handed' }
171 172 173
            [ RH.div { id: "controls-container" } [ Controls.controls controls [] ]
            , RH.div { className: "row graph-row" }
              [ RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } []
174 175
              , graphView { boxes: props.boxes
                          , controls
176 177 178 179
                          , elRef: graphRef
                          , graph
                          , hyperdataGraph
                          , mMetaData
180
                          } []
181
              ]
James Laver's avatar
James Laver committed
182 183
            ]
          ]
184
        ]
185

186 187 188
    hClass h = case h of
      Types.LeftHanded  -> "lefthanded"
      Types.RightHanded -> "righthanded"
189

190 191 192
type GraphProps =
  ( boxes          :: Boxes
  , controls       :: Record Controls.Controls
193 194 195 196
  , elRef          :: R.Ref (Nullable Element)
  , graph          :: SigmaxT.SGraph
  , hyperdataGraph :: GET.HyperdataGraph
  , mMetaData      :: T.Box (Maybe GET.MetaData)
197 198
)

199 200
graphView :: R2.Component GraphProps
graphView = R.createElement graphViewCpt
201
graphViewCpt :: R.Component GraphProps
202
graphViewCpt = here.component "graphView" cpt
203
  where
204 205
    cpt { boxes
        , controls
206 207 208
        , elRef
        , graph
        , hyperdataGraph: GET.HyperdataGraph { mCamera }
209
        , mMetaData } _children = do
210 211
      edgeConfluence' <- T.useLive T.unequal controls.edgeConfluence
      edgeWeight' <- T.useLive T.unequal controls.edgeWeight
212
      mMetaData' <- T.useLive T.unequal mMetaData
213 214 215 216 217 218 219
      multiSelectEnabled' <- T.useLive T.unequal controls.multiSelectEnabled
      nodeSize' <- T.useLive T.unequal controls.nodeSize
      removedNodeIds' <- T.useLive T.unequal controls.removedNodeIds
      selectedNodeIds' <- T.useLive T.unequal controls.selectedNodeIds
      showEdges' <- T.useLive T.unequal controls.showEdges
      showLouvain' <- T.useLive T.unequal controls.showLouvain

220 221
      multiSelectEnabledRef <- R.useRef multiSelectEnabled'

222
      -- TODO Cache this?
223
      let louvainGraph =
224
            if showLouvain' then
225
              let louvain = Louvain.louvain unit in
226 227
              let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph) (SigmaxT.louvainEdges graph) in
              SigmaxT.louvainGraph graph cluster
228 229
            else
              graph
230
      let transformedGraph = transformGraph louvainGraph { edgeConfluence'
231 232 233 234 235 236
                                                         , edgeWeight'
                                                         , nodeSize'
                                                         , removedNodeIds'
                                                         , selectedNodeIds'
                                                         , showEdges' }
      let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas: sfa }) -> sfa) mMetaData'
237

238 239
      R.useEffect1' multiSelectEnabled' $ do
        R.setRef multiSelectEnabledRef multiSelectEnabled'
240

241 242
      pure $ Graph.graph { boxes
                         , elRef
243 244 245 246 247 248 249 250 251 252 253
                         , forceAtlas2Settings: Graph.forceAtlas2Settings
                         , graph
                         , mCamera
                         , multiSelectEnabledRef
                         , selectedNodeIds: controls.selectedNodeIds
                         , showEdges: controls.showEdges
                         , sigmaRef: controls.sigmaRef
                         , sigmaSettings: Graph.sigmaSettings
                         , stage: controls.graphStage
                         , startForceAtlas
                         , transformedGraph
254
                         } []
255

256 257
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
258 259
  where
    nodes = foldMapWithIndex nodeFn r.nodes
260 261 262
    nodeFn _i nn@(GET.Node n) =
      Seq.singleton {
          borderColor: color
263
        , children: n.children
264
        , color : color
265 266
        , equilateral: { numPoints: 3 }
        , gargType
267
        , hidden : false
268
        , id    : n.id_
James Laver's avatar
James Laver committed
269
        , label : n.label
270
        , size  : Math.log (toNumber n.size + 1.0)
271
        , type  : modeGraphType gargType
James Laver's avatar
James Laver committed
272 273
        , x     : n.x -- cos (toNumber i)
        , y     : n.y -- sin (toNumber i)
274
        , _original: nn
James Laver's avatar
James Laver committed
275 276
        }
      where
277
        cDef (GET.Cluster {clustDefault}) = clustDefault
278
        color = GET.intColor (cDef n.attributes)
279
        gargType =  unsafePartial $ fromJust $ Types.modeFromString n.type_
280
    nodesMap = SigmaxT.nodesMap nodes
281
    edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges
282
    edgeFn i ee@(GET.Edge e) =
283 284 285 286 287 288 289 290 291 292 293 294
      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
295
        , _original: ee
296
        }
297
      where
298 299 300
        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
301

302 303 304 305 306 307
-- | 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
308 309


310
getNodes :: Session -> T2.Reload -> GET.GraphId -> AffRESTError GET.HyperdataGraph
311
getNodes session graphVersion graphId =
312 313
  get session $ NodeAPI Types.Graph
                        (Just graphId)
314
                        ("?version=" <> (show graphVersion))
315

316 317 318 319 320 321 322 323
type LiveProps = (
    edgeConfluence'  :: Range.NumberRange
  , edgeWeight'      :: Range.NumberRange
  , nodeSize'        :: Range.NumberRange
  , removedNodeIds'  :: SigmaxT.NodeIds
  , selectedNodeIds' :: SigmaxT.NodeIds
  , showEdges'       :: SigmaxT.ShowEdgesState
  )
324

325 326 327 328 329
transformGraph :: SigmaxT.SGraph -> Record LiveProps -> SigmaxT.SGraph
transformGraph graph { edgeConfluence'
                     , edgeWeight'
                     , nodeSize'
                     , removedNodeIds'
330
                     , selectedNodeIds' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
331
  where
332 333
    edges = SigmaxT.graphEdges graph
    nodes = SigmaxT.graphNodes graph
334 335 336
    selectedEdgeIds =
      Set.fromFoldable
        $ Seq.map _.id
337 338
        $ SigmaxT.neighbouringEdges graph selectedNodeIds'
    hasSelection = not $ Set.isEmpty selectedNodeIds'
339

340
    newEdges' = Seq.filter edgeFilter $ Seq.map (
341 342 343 344
      -- 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
345 346
      ) edges
    newNodes  = Seq.filter nodeFilter $ Seq.map (nodeMarked <<< nodeHideSize) nodes
347
    newEdges  = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'
348

349
    edgeFilter _e = true
350 351
    nodeFilter n = nodeRemovedFilter n

352
    nodeRemovedFilter { id } = not $ Set.member id removedNodeIds'
353 354 355

    edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeHideConfluence edge@{ confluence } =
356
      if Range.within edgeConfluence' confluence then
357 358 359 360 361 362
        edge
      else
        edge { hidden = true }

    edgeHideWeight :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeHideWeight edge@{ weightIdx } =
363
      if Range.within edgeWeight' $ toNumber weightIdx then
364 365 366 367
        edge
      else
        edge { hidden = true }

368
    edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
369
    edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
370

371
    edgeMarked :: Record SigmaxT.Edge -> Record SigmaxT.Edge
372
    edgeMarked edge@{ id, sourceNode } = do
373
      let isSelected = Set.member id selectedEdgeIds
374 375
      case Tuple hasSelection isSelected of
        Tuple false true  -> edge { color = "#ff0000" }
376 377
        Tuple true  true  -> edge { color = sourceNode.color }
        Tuple true false  -> edge { color = "rgba(221, 221, 221, 0.5)" }
378
        _                 -> edge
379 380

    nodeMarked :: Record SigmaxT.Node -> Record SigmaxT.Node
381
    nodeMarked node@{ id } =
382
      if Set.member id selectedNodeIds' then
383
        node { borderColor = "#000", type = "selected" }
384 385
      else
        node
386 387 388

    nodeHideSize :: Record SigmaxT.Node -> Record SigmaxT.Node
    nodeHideSize node@{ size } =
389
      if Range.within nodeSize' size then
390 391 392
        node
      else
        node { hidden = true }