GraphExplorer.purs 14.2 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 DOM.Simple.Types (Element)
6
import Data.Array as A
7
import Data.Either (Either)
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(..))
James Laver's avatar
James Laver committed
16
import Effect.Aff (Aff)
17
import Gargantext.Components.App.Data (Boxes)
18
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.Types as GEST
21
import Gargantext.Components.GraphExplorer.Types as GET
22
import Gargantext.Config.REST (RESTError, logRESTError)
23 24
import Gargantext.Data.Louvain as Louvain
import Gargantext.Hooks.Loader (useLoader)
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
explorerLayout :: R2.Component LayoutProps
65
explorerLayout = R.createElement explorerLayoutCpt
66 67
explorerLayoutCpt :: R.Component LayoutProps
explorerLayoutCpt = here.component "explorerLayout" cpt where
68
  cpt props@{ boxes: { graphVersion }, graphId, session } _ = do
69 70
    graphVersion' <- T.useLive T.unequal graphVersion

71 72 73 74
    useLoader { errorHandler
              , loader: getNodes session graphVersion'
              , path: graphId
              , render: handler }
James Laver's avatar
James Laver committed
75
    where
76
      errorHandler = logRESTError here "[explorerLayout]"
77 78
      handler loaded@(GET.HyperdataGraph { graph: hyperdataGraph }) =
        explorerWriteGraph (Record.merge props { graph, hyperdataGraph: loaded, mMetaData' }) []
James Laver's avatar
James Laver committed
79
        where
80
          Tuple mMetaData' graph = convert hyperdataGraph
81

82 83 84 85
explorerWriteGraph :: R2.Component GraphWriteProps
explorerWriteGraph = R.createElement explorerWriteGraphCpt
explorerWriteGraphCpt :: R.Component GraphWriteProps
explorerWriteGraphCpt = here.component "explorerWriteGraph" cpt where
86
  cpt props@{ boxes: { sidePanelGraph }
87 88 89 90 91 92 93 94 95 96 97 98 99
            , 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) []

100
--------------------------------------------------------------
101 102
explorer :: R2.Component Props
explorer = R.createElement explorerCpt
103
explorerCpt :: R.Component Props
104
explorerCpt = here.component "explorer" cpt
James Laver's avatar
James Laver committed
105
  where
106
    cpt props@{ boxes: { graphVersion, handed, reloadForest, showTree, sidePanelGraph, sidePanelState }
107 108 109 110 111 112
        , graph
        , graphId
        , hyperdataGraph
        , session
        } _ = do
      { mMetaData } <- GEST.focusedSidePanel sidePanelGraph
113
      _graphVersion' <- T.useLive T.unequal graphVersion
114
      handed' <- T.useLive T.unequal handed
115
      mMetaData' <- T.useLive T.unequal mMetaData
116

117
      let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas: sfa }) -> sfa) mMetaData'
118 119 120 121

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

123
      _dataRef <- R.useRef graph
124
      graphRef <- R.useRef null
125
      controls <- Controls.useGraphControls { forceAtlasS
126 127 128
                                            , graph
                                            , graphId
                                            , hyperdataGraph
129
                                            , reloadForest
130
                                            , session
131
                                            , showTree
132
                                            , sidePanel: sidePanelGraph
133
                                            , sidePanelState }
134

135
      -- graphVersionRef <- R.useRef graphVersion'
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
      -- 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
154

James Laver's avatar
James Laver committed
155
      pure $
156 157
        RH.div { className: "graph-meta-container" }
        [ RH.div { className: "graph-container" }
158
          [ RH.div { className: "container-fluid " <> hClass handed' }
159 160 161
            [ 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" } []
162 163
              , graphView { boxes: props.boxes
                          , controls
164 165 166 167
                          , elRef: graphRef
                          , graph
                          , hyperdataGraph
                          , mMetaData
168
                          } []
169
              ]
James Laver's avatar
James Laver committed
170 171
            ]
          ]
172
        ]
173

174 175 176
    hClass h = case h of
      Types.LeftHanded  -> "lefthanded"
      Types.RightHanded -> "righthanded"
177

178 179 180
type GraphProps =
  ( boxes          :: Boxes
  , controls       :: Record Controls.Controls
181 182 183 184
  , elRef          :: R.Ref (Nullable Element)
  , graph          :: SigmaxT.SGraph
  , hyperdataGraph :: GET.HyperdataGraph
  , mMetaData      :: T.Box (Maybe GET.MetaData)
185 186
)

187 188
graphView :: R2.Component GraphProps
graphView = R.createElement graphViewCpt
189
graphViewCpt :: R.Component GraphProps
190
graphViewCpt = here.component "graphView" cpt
191
  where
192 193
    cpt { boxes
        , controls
194 195 196
        , elRef
        , graph
        , hyperdataGraph: GET.HyperdataGraph { mCamera }
197
        , mMetaData } _children = do
198 199
      edgeConfluence' <- T.useLive T.unequal controls.edgeConfluence
      edgeWeight' <- T.useLive T.unequal controls.edgeWeight
200
      mMetaData' <- T.useLive T.unequal mMetaData
201 202 203 204 205 206 207
      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

208 209
      multiSelectEnabledRef <- R.useRef multiSelectEnabled'

210
      -- TODO Cache this?
211
      let louvainGraph =
212
            if showLouvain' then
213
              let louvain = Louvain.louvain unit in
214 215
              let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph) (SigmaxT.louvainEdges graph) in
              SigmaxT.louvainGraph graph cluster
216 217
            else
              graph
218
      let transformedGraph = transformGraph louvainGraph { edgeConfluence'
219 220 221 222 223 224
                                                         , edgeWeight'
                                                         , nodeSize'
                                                         , removedNodeIds'
                                                         , selectedNodeIds'
                                                         , showEdges' }
      let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas: sfa }) -> sfa) mMetaData'
225

226 227
      R.useEffect1' multiSelectEnabled' $ do
        R.setRef multiSelectEnabledRef multiSelectEnabled'
228

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

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

289 290 291 292 293 294
-- | 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
295 296


297
getNodes :: Session -> T2.Reload -> GET.GraphId -> Aff (Either RESTError GET.HyperdataGraph)
298
getNodes session graphVersion graphId =
299 300
  get session $ NodeAPI Types.Graph
                        (Just graphId)
301
                        ("?version=" <> (show graphVersion))
302

303 304 305 306 307 308 309 310
type LiveProps = (
    edgeConfluence'  :: Range.NumberRange
  , edgeWeight'      :: Range.NumberRange
  , nodeSize'        :: Range.NumberRange
  , removedNodeIds'  :: SigmaxT.NodeIds
  , selectedNodeIds' :: SigmaxT.NodeIds
  , showEdges'       :: SigmaxT.ShowEdgesState
  )
311

312 313 314 315 316
transformGraph :: SigmaxT.SGraph -> Record LiveProps -> SigmaxT.SGraph
transformGraph graph { edgeConfluence'
                     , edgeWeight'
                     , nodeSize'
                     , removedNodeIds'
317
                     , selectedNodeIds' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
318
  where
319 320
    edges = SigmaxT.graphEdges graph
    nodes = SigmaxT.graphNodes graph
321 322 323
    selectedEdgeIds =
      Set.fromFoldable
        $ Seq.map _.id
324 325
        $ SigmaxT.neighbouringEdges graph selectedNodeIds'
    hasSelection = not $ Set.isEmpty selectedNodeIds'
326

327
    newEdges' = Seq.filter edgeFilter $ Seq.map (
328 329 330 331
      -- 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
332 333
      ) edges
    newNodes  = Seq.filter nodeFilter $ Seq.map (nodeMarked <<< nodeHideSize) nodes
334
    newEdges  = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'
335

336
    edgeFilter _e = true
337 338
    nodeFilter n = nodeRemovedFilter n

339
    nodeRemovedFilter { id } = not $ Set.member id removedNodeIds'
340 341 342

    edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeHideConfluence edge@{ confluence } =
343
      if Range.within edgeConfluence' confluence then
344 345 346 347 348 349
        edge
      else
        edge { hidden = true }

    edgeHideWeight :: Record SigmaxT.Edge -> Record SigmaxT.Edge
    edgeHideWeight edge@{ weightIdx } =
350
      if Range.within edgeWeight' $ toNumber weightIdx then
351 352 353 354
        edge
      else
        edge { hidden = true }

355
    edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
356
    edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
357

358
    edgeMarked :: Record SigmaxT.Edge -> Record SigmaxT.Edge
359
    edgeMarked edge@{ id, sourceNode } = do
360
      let isSelected = Set.member id selectedEdgeIds
361 362
      case Tuple hasSelection isSelected of
        Tuple false true  -> edge { color = "#ff0000" }
363 364
        Tuple true  true  -> edge { color = sourceNode.color }
        Tuple true false  -> edge { color = "rgba(221, 221, 221, 0.5)" }
365
        _                 -> edge
366 367

    nodeMarked :: Record SigmaxT.Node -> Record SigmaxT.Node
368
    nodeMarked node@{ id } =
369
      if Set.member id selectedNodeIds' then
370
        node { borderColor = "#000", type = "selected" }
371 372
      else
        node
373 374 375

    nodeHideSize :: Record SigmaxT.Node -> Record SigmaxT.Node
    nodeHideSize node@{ size } =
376
      if Range.within nodeSize' size then
377 378 379
        node
      else
        node { hidden = true }