module Gargantext.Components.GraphExplorer where import Gargantext.Prelude hiding (max,min) import DOM.Simple.Types (Element) import Data.Array as A import Data.FoldableWithIndex (foldMapWithIndex) import Data.Int (toNumber) import Data.Map as Map import Data.Maybe (Maybe(..), fromJust, maybe) import Data.Nullable (null, Nullable) import Data.Sequence as Seq import Data.Set as Set import Data.Tuple (fst, snd, Tuple(..)) import Data.Tuple.Nested ((/\)) import Effect.Aff (Aff) import Math (log) import Partial.Unsafe (unsafePartial) import Reactix as R import Reactix.DOM.HTML as RH import Record as Record import Gargantext.AsyncTasks as GAT import Gargantext.Components.Forest (forest) import Gargantext.Components.Graph as Graph import Gargantext.Components.GraphExplorer.Controls as Controls import Gargantext.Components.GraphExplorer.Sidebar as Sidebar import Gargantext.Components.GraphExplorer.ToggleButton as Toggle import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Data.Louvain as Louvain import Gargantext.Ends (Frontends, Backend) import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Sigmax as Sigmax import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute) import Gargantext.Sessions (Session, Sessions, get) import Gargantext.Types as Types import Gargantext.Utils.Range as Range import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reload as GUR thisModule :: String thisModule = "Gargantext.Components.GraphExplorer" type LayoutProps = ( asyncTasksRef :: R.Ref (Maybe GAT.Reductor) , backend :: R.State (Maybe Backend) , currentRoute :: AppRoute , frontends :: Frontends , graphId :: GET.GraphId , handed :: Types.Handed , session :: Session , sessions :: Sessions , showLogin :: R.State Boolean ) type Props = ( graph :: SigmaxT.SGraph , graphVersion :: GUR.ReloadS , hyperdataGraph :: GET.HyperdataGraph , mMetaData :: Maybe GET.MetaData | LayoutProps ) -------------------------------------------------------------- explorerLayout :: Record LayoutProps -> R.Element explorerLayout props = R.createElement explorerLayoutCpt props [] explorerLayoutCpt :: R.Component LayoutProps explorerLayoutCpt = R.hooksComponentWithModule thisModule "explorerLayout" cpt where cpt props _ = do graphVersion <- GUR.new pure $ explorerLayoutView graphVersion props explorerLayoutView :: GUR.ReloadS -> Record LayoutProps -> R.Element explorerLayoutView graphVersion p = R.createElement el p [] where el = R.hooksComponentWithModule thisModule "explorerLayoutView" cpt cpt props@{ graphId, session } _ = do useLoader graphId (getNodes session graphVersion) handler where handler loaded = explorer (Record.merge props { graph, graphVersion, hyperdataGraph: loaded, mMetaData }) where GET.HyperdataGraph { graph: hyperdataGraph } = loaded Tuple mMetaData graph = convert hyperdataGraph -------------------------------------------------------------- explorer :: Record Props -> R.Element explorer props = R.createElement explorerCpt props [] explorerCpt :: R.Component Props explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt where cpt props@{ asyncTasksRef , backend , currentRoute , frontends , graph , graphId , graphVersion , handed , hyperdataGraph , mMetaData , session , sessions , showLogin } _ = do let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData let forceAtlasS = if startForceAtlas then SigmaxT.InitialRunning else SigmaxT.InitialStopped dataRef <- R.useRef graph graphRef <- R.useRef null graphVersionRef <- R.useRef (GUR.value graphVersion) treeReload <- GUR.new treeReloadRef <- GUR.newIInitialized treeReload controls <- Controls.useGraphControls { forceAtlasS , graph , graphId , hyperdataGraph , session , treeReload: \_ -> GUR.bump treeReload } multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled 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 (GUR.value graphVersion) -- Reinitialize bunch of state as well. snd controls.removedNodeIds $ const SigmaxT.emptyNodeIds snd controls.selectedNodeIds $ const SigmaxT.emptyNodeIds snd controls.showEdges $ const SigmaxT.EShow snd controls.forceAtlasState $ const forceAtlasS snd controls.graphStage $ const Graph.Init snd controls.showSidePanel $ const GET.InitialClosed pure $ RH.div { className: "graph-meta-container" } [ RH.div { className: "fixed-top navbar navbar-expand-lg" , id: "graph-explorer" } [ rowToggle [ col [ spaces [ Toggle.treeToggleButton controls.showTree ]] , col [ spaces [ Toggle.controlsToggleButton controls.showControls ]] , col [ spaces [ Toggle.sidebarToggleButton controls.showSidePanel ]] ] ] , RH.div { className: "graph-container" } [ inner handed [ rowControls [ Controls.controls controls ] , RH.div { className: "row graph-row" } $ mainLayout handed $ tree { asyncTasksRef , backend , currentRoute , frontends , handed , reload: treeReload , sessions , show: fst controls.showTree , showLogin: snd showLogin , treeReloadRef } /\ RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } [] /\ graphView { controls , elRef: graphRef , graphId , graph , hyperdataGraph , mMetaData , multiSelectEnabledRef } /\ mSidebar mMetaData { frontends , graph , graphId , graphVersion , removedNodeIds : controls.removedNodeIds , session , selectedNodeIds: controls.selectedNodeIds , showSidePanel : controls.showSidePanel , treeReload } ] ] ] mainLayout Types.RightHanded (tree' /\ gc /\ gv /\ sdb) = [tree', gc, gv, sdb] mainLayout Types.LeftHanded (tree' /\ gc /\ gv /\ sdb) = [sdb, gc, gv, tree'] outer = RH.div { className: "col-md-12" } inner h = RH.div { className: "container-fluid " <> hClass } where hClass = case h of Types.LeftHanded -> "lefthanded" Types.RightHanded -> "righthanded" -- rowToggle = RH.div { id: "toggle-container" } rowToggle = RH.ul { className: "navbar-nav ml-auto mr-auto" } rowControls = RH.div { id: "controls-container" } -- col = RH.div { className: "col-md-4" } col = RH.li { className: "nav-item" } pullLeft = RH.div { className: "pull-left" } pullRight = RH.div { className: "pull-right" } -- spaces = RH.div { className: "flex-space-between" } spaces = RH.a { className: "nav-link" } tree :: Record TreeProps -> R.Element tree { show: false } = RH.div { id: "tree" } [] tree { asyncTasksRef, backend, frontends, handed, currentRoute, reload, sessions, showLogin, treeReloadRef } = RH.div {className: "col-md-2 graph-tree"} [ forest { appReload: reload , asyncTasksRef , backend , currentRoute , frontends , handed , sessions , showLogin , treeReloadRef } [] ] mSidebar :: Maybe GET.MetaData -> Record MSidebarProps -> R.Element mSidebar Nothing _ = RH.div {} [] mSidebar (Just metaData) props = Sidebar.sidebar (Record.merge props { metaData }) type TreeProps = ( asyncTasksRef :: R.Ref (Maybe GAT.Reductor) , backend :: R.State (Maybe Backend) , currentRoute :: AppRoute , frontends :: Frontends , handed :: Types.Handed , reload :: GUR.ReloadS , sessions :: Sessions , show :: Boolean , showLogin :: R.Setter Boolean , treeReloadRef :: GUR.ReloadWithInitializeRef ) type MSidebarProps = ( frontends :: Frontends , graph :: SigmaxT.SGraph , graphId :: GET.GraphId , graphVersion :: GUR.ReloadS , removedNodeIds :: R.State SigmaxT.NodeIds , showSidePanel :: R.State GET.SidePanelState , selectedNodeIds :: R.State SigmaxT.NodeIds , session :: Session , treeReload :: GUR.ReloadS ) type GraphProps = ( controls :: Record Controls.Controls , elRef :: R.Ref (Nullable Element) , graphId :: GET.GraphId , graph :: SigmaxT.SGraph , hyperdataGraph :: GET.HyperdataGraph , mMetaData :: Maybe GET.MetaData , multiSelectEnabledRef :: R.Ref Boolean ) graphView :: Record GraphProps -> R.Element --graphView sigmaRef props = R.createElement (R.memo el memoCmp) props [] graphView props = R.createElement graphViewCpt props [] graphViewCpt :: R.Component GraphProps graphViewCpt = R.hooksComponentWithModule thisModule "graphView" cpt where cpt { controls , elRef , graphId , graph , hyperdataGraph: GET.HyperdataGraph { mCamera } , mMetaData , multiSelectEnabledRef } _children = do -- TODO Cache this? let louvainGraph = if (fst controls.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 controls louvainGraph let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData R.useEffect1' (fst controls.multiSelectEnabled) $ do R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled pure $ Graph.graph { elRef , forceAtlas2Settings: Graph.forceAtlas2Settings , graph , mCamera , multiSelectEnabledRef , selectedNodeIds: controls.selectedNodeIds , showEdges: controls.showEdges , sigmaRef: controls.sigmaRef , sigmaSettings: Graph.sigmaSettings , stage: controls.graphStage , startForceAtlas , transformedGraph } convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxT.SGraph convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges} where nodes = foldMapWithIndex nodeFn r.nodes nodeFn _i nn@(GET.Node n) = Seq.singleton { borderColor: color , color : color , equilateral: { numPoints: 3 } , gargType , hidden : false , id : n.id_ , label : n.label , size : log (toNumber n.size + 1.0) , type : modeGraphType gargType , x : n.x -- cos (toNumber i) , y : n.y -- sin (toNumber i) , _original: nn } where cDef (GET.Cluster {clustDefault}) = clustDefault color = GET.intColor (cDef n.attributes) gargType = unsafePartial $ fromJust $ Types.modeFromString n.type_ nodesMap = SigmaxT.nodesMap nodes edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges edgeFn i ee@(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 , _original: ee } where sourceNode = unsafePartial $ fromJust $ Map.lookup e.source nodesMap targetNode = unsafePartial $ fromJust $ Map.lookup e.target nodesMap color = sourceNode.color -- | 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" getNodes :: Session -> GUR.ReloadS -> GET.GraphId -> Aff GET.HyperdataGraph getNodes session graphVersion graphId = get session $ NodeAPI Types.Graph (Just graphId) ("?version=" <> (show $ GUR.value graphVersion)) transformGraph :: Record Controls.Controls -> SigmaxT.SGraph -> SigmaxT.SGraph transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges} where edges = SigmaxT.graphEdges graph nodes = SigmaxT.graphNodes graph selectedEdgeIds = Set.fromFoldable $ Seq.map _.id $ SigmaxT.neighbouringEdges graph (fst controls.selectedNodeIds) hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds) newEdges' = Seq.filter edgeFilter $ Seq.map ( edgeHideWeight <<< edgeHideConfluence <<< edgeShowFilter <<< edgeMarked ) edges newNodes = Seq.filter nodeFilter $ Seq.map (nodeMarked <<< nodeHideSize) nodes newEdges = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges' edgeFilter e = true nodeFilter n = nodeRemovedFilter n nodeSizeFilter :: Record SigmaxT.Node -> Boolean nodeSizeFilter node@{ size } = Range.within (fst controls.nodeSize) size nodeRemovedFilter node@{ id } = not $ Set.member id $ fst controls.removedNodeIds edgeConfluenceFilter :: Record SigmaxT.Edge -> Boolean edgeConfluenceFilter edge@{ confluence } = Range.within (fst controls.edgeConfluence) confluence edgeWeightFilter :: Record SigmaxT.Edge -> Boolean edgeWeightFilter edge@{ weightIdx } = Range.within (fst controls.edgeWeight) $ toNumber weightIdx edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge edgeHideConfluence edge@{ confluence } = if Range.within (fst controls.edgeConfluence) confluence then edge else edge { hidden = true } edgeHideWeight :: Record SigmaxT.Edge -> Record SigmaxT.Edge edgeHideWeight edge@{ weightIdx } = if Range.within (fst controls.edgeWeight) $ toNumber weightIdx then edge else edge { hidden = true } edgeShowFilter :: Record SigmaxT.Edge -> Record SigmaxT.Edge edgeShowFilter edge = if (SigmaxT.edgeStateHidden $ fst controls.showEdges) then edge { hidden = true } else edge edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds) edgeMarked :: Record SigmaxT.Edge -> Record SigmaxT.Edge edgeMarked edge@{ id, sourceNode } = do let isSelected = Set.member id selectedEdgeIds case Tuple hasSelection isSelected of Tuple false true -> edge { color = "#ff0000" } Tuple true true -> edge { color = sourceNode.color } Tuple true false -> edge { color = "rgba(221, 221, 221, 0.5)" } _ -> edge nodeMarked :: Record SigmaxT.Node -> Record SigmaxT.Node nodeMarked node@{ id } = if Set.member id (fst controls.selectedNodeIds) then node { borderColor = "#000", type = "selected" } else node nodeHideSize :: Record SigmaxT.Node -> Record SigmaxT.Node nodeHideSize node@{ size } = if Range.within (fst controls.nodeSize) size then node else node { hidden = true }