[graph] fixes to louvain refreshing too much

Also, fixed graph comparison function.

This should be both fast and more exact now (previously it only
compared node/edge list sizes, now it compares their appropriate
hashes).
parent 66b95fcb
Pipeline #3635 failed with stage
in 0 seconds
......@@ -87,6 +87,7 @@ to generate this file without the comments in this block.
, "typelevel-prelude"
, "uint"
, "unfoldable"
, "unordered-collections"
, "unsafe-coerce"
, "uri"
, "uuid"
......
......@@ -26,13 +26,10 @@ import Gargantext.Components.GraphExplorer.Types (GraphSideDoc)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Config (defaultFrontends)
import Gargantext.Data.Louvain as DLouvain
import Gargantext.Hooks.Session (useSession)
import Gargantext.Hooks.Sigmax.ForceAtlas2 as ForceAtlas
import Gargantext.Hooks.Sigmax.Louvain as Louvain
import Gargantext.Hooks.Sigmax.Noverlap as Noverlap
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as SigmaxS
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Types as GT
import Gargantext.Types as Types
......@@ -240,54 +237,55 @@ graphViewCpt = R.memo' $ here.component "graphView" cpt where
-- |
{ edgeConfluence
, edgeWeight
, graph
, nodeSize
, removedNodeIds
, selectedNodeIds
, showEdges
, graph
, transformedGraph
} <- GraphStore.use
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
-- 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
-- | Computed
-- |
let transformParams = { edgeConfluence'
, edgeWeight'
, nodeSize'
, removedNodeIds'
, selectedNodeIds'
, showEdges' }
-- let transformedGraph = transformGraph graph' transformParams
transformedGraphS <- T.useBox $ transformGraph graph' transformParams
-- let transformParams = { edgeConfluence'
-- , edgeWeight'
-- , nodeSize'
-- , removedNodeIds'
-- , selectedNodeIds'
-- , showEdges' }
-- -- let transformedGraph = transformGraph graph' transformParams
-- transformedGraphS <- T.useBox $ transformGraph graph' transformParams
-- todo Cache this?
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
-- 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
-- R.useEffect' $ do
-- let (SigmaxT.Graph { edges: e }) = transformedGraph
......@@ -305,7 +303,6 @@ graphViewCpt = R.memo' $ here.component "graphView" cpt where
, forceAtlas2Settings: Graph.forceAtlas2Settings
, sigmaRef
, sigmaSettings: Graph.sigmaSettings
, transformedGraph
}
--------------------------------------------------------
......
......@@ -46,7 +46,6 @@ type Props sigma forceatlas2 =
, forceAtlas2Settings :: forceatlas2
, sigmaRef :: R.Ref Sigmax.Sigma
, sigmaSettings :: sigma
, transformedGraph :: SigmaxTypes.SGraph
)
drawGraph :: forall s fa2. R2.Leaf (Props s fa2)
......@@ -62,30 +61,32 @@ drawGraphCpt = here.component "drawGraph" cpt where
, noverlapRef
, sigmaRef
, forceAtlas2Settings: fa2Settings
, transformedGraph
} _ = do
boxes <- AppStore.use
{ showEdges
, edgeConfluence
{ edgeConfluence
, edgeWeight
, forceAtlasState
, graphStage
, hyperdataGraph
, mouseSelectorSize
, multiSelectEnabled
, nodeSize
, selectedNodeIds
, showEdges
, startForceAtlas
, transformedGraph
} <- GraphStore.use
showEdges' <- R2.useLive' showEdges
edgeConfluence' <- R2.useLive' edgeConfluence
edgeWeight' <- R2.useLive' edgeWeight
forceAtlasState' <- R2.useLive' forceAtlasState
graphStage' <- R2.useLive' graphStage
nodeSize' <- R2.useLive' nodeSize
showEdges' <- R2.useLive' showEdges
startForceAtlas' <- R2.useLive' startForceAtlas
--hyperdataGraph' <- R2.useLive' hyperdataGraph
transformedGraph' <- R2.useLive' transformedGraph
-- | Hooks
-- |
......@@ -206,12 +207,12 @@ drawGraphCpt = here.component "drawGraph" cpt where
-- etc) // drawback: don't forget to modify the effect white-list
R.useEffect' $ do
let updateGraph = do
let tEdgesMap = SigmaxTypes.edgesGraphMap transformedGraph
let tNodesMap = SigmaxTypes.nodesGraphMap transformedGraph
let tEdgesMap = SigmaxTypes.edgesGraphMap transformedGraph'
let tNodesMap = SigmaxTypes.nodesGraphMap transformedGraph'
let updateSigma _ = do
Sigmax.dependOnSigma (R.readRef sigmaRef) "[drawGraph (Ready)] no sigma" $ \sigma -> do
Sigmax.performDiff sigma transformedGraph
Sigmax.performDiff sigma transformedGraph'
-- Sigmax.updateEdges sigma tEdgesMap
-- Sigmax.updateNodes sigma tNodesMap
let edgesState = not $ SigmaxTypes.edgeStateHidden showEdges'
......
......@@ -32,6 +32,7 @@ type Store =
, graphId :: T.Box GET.GraphId
, mMetaData :: T.Box (Maybe GET.MetaData)
, hyperdataGraph :: T.Box GET.HyperdataGraph
, transformedGraph :: T.Box SigmaxT.SGraph
-- Layout
, showControls :: T.Box Boolean
, sideTab :: T.Box GET.SideTab
......@@ -66,6 +67,7 @@ type State =
, graphId :: GET.GraphId
, mMetaData :: Maybe GET.MetaData
, hyperdataGraph :: GET.HyperdataGraph
, transformedGraph :: SigmaxT.SGraph
-- Layout
, showControls :: Boolean
, sideTab :: GET.SideTab
......
......@@ -29,9 +29,11 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileFormat(..
import Gargantext.Components.GraphExplorer.API (cloneGraph)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Data.Louvain as DLouvain
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Camera as Camera
import Gargantext.Hooks.Sigmax.Graphology as Graphology
import Gargantext.Hooks.Sigmax.Louvain as Louvain
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Sessions (Session)
......@@ -158,9 +160,10 @@ edgesToggleButtonCpt = here.component "edgesToggleButton" cpt
------------------------------------------------------
type LouvainButtonProps =
( forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
, graph :: T.Box SigmaxTypes.SGraph
, sigmaRef :: R.Ref Sigmax.Sigma
( forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
, graph :: T.Box SigmaxTypes.SGraph
, sigmaRef :: R.Ref Sigmax.Sigma
, transformedGraph :: T.Box SigmaxTypes.SGraph
)
louvainButton :: R2.Leaf LouvainButtonProps
......@@ -168,13 +171,18 @@ louvainButton = R2.leaf louvainButtonCpt
louvainButtonCpt :: R.Component LouvainButtonProps
louvainButtonCpt = here.component "louvainButton" cpt
where
cpt { forceAtlasState, graph, sigmaRef } _ = do
cpt { forceAtlasState, graph, sigmaRef, transformedGraph } _ = do
graph' <- R2.useLive' graph
forceAtlasState' <- R2.useLive' forceAtlasState
pure $
B.button
{ callback: \_ -> do
Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphView (louvainGraph)] no sigma" $ \sigma -> do
newGraph <- Louvain.assignVisible (Sigma.graph sigma) {}
let cluster = Louvain.cluster newGraph :: DLouvain.LouvainCluster
let lgraph = SigmaxTypes.louvainGraph graph' cluster :: SigmaxTypes.SGraph
T.write_ lgraph transformedGraph
pure unit
, status: SigmaxTypes.forceAtlasComponentStatus forceAtlasState'
......
......@@ -70,6 +70,7 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
, showEdges
, showSidebar
, sideTab
, transformedGraph
} <- GraphStore.use
graphId' <- R2.useLive' graphId
......@@ -207,7 +208,8 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
,
louvainButton { forceAtlasState
, graph
, sigmaRef }
, sigmaRef
, transformedGraph }
]
]
,
......
......@@ -13,7 +13,7 @@ import DOM.Simple (document, querySelector)
import Gargantext.Components.App.Store as AppStore
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.GraphExplorer.Layout (convert, layout)
import Gargantext.Components.GraphExplorer.Layout (convert, layout, transformGraph)
import Gargantext.Components.GraphExplorer.Store as GraphStore
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Config.REST (logRESTError)
......@@ -184,6 +184,17 @@ hydrateStoreCpt = here.component "hydrateStore" cpt where
let nodeSizeMax = maybe 100.0 _.size $ A.last nodesSorted
let nodeSizeRange = Range.Closed { min: nodeSizeMin, max: nodeSizeMax }
let edgeWeight = Range.Closed
{ min: 0.0
, max: I.toNumber $ Seq.length $ SigmaxT.graphEdges graph
}
let transformedGraph = transformGraph graph { edgeConfluence': GraphStore.options.edgeConfluence
, edgeWeight': edgeWeight
, nodeSize': GraphStore.options.nodeSize
, removedNodeIds': GraphStore.options.removedNodeIds
, selectedNodeIds': GraphStore.options.selectedNodeIds
, showEdges': GraphStore.options.showEdges }
-- Hydrate GraphStore
(state :: Record GraphStore.State) <- pure $
......@@ -192,14 +203,12 @@ hydrateStoreCpt = here.component "hydrateStore" cpt where
, graphId
, mMetaData
, hyperdataGraph
, transformedGraph
-- Controls
, startForceAtlas
, forceAtlasState
, noverlapState: SigmaxT.NoverlapPaused
, edgeWeight: Range.Closed
{ min: 0.0
, max: I.toNumber $ Seq.length $ SigmaxT.graphEdges graph
}
, edgeWeight
, edgeConfluenceRange
, nodeSizeRange
-- (cache options)
......
......@@ -229,6 +229,7 @@ performDiff sigma g = do
-- console.log2 "[performDiff] addEdges" $ A.fromFoldable addEdges
-- console.log2 "[performDiff] removeNodes" removeNodes
-- console.log2 "[performDiff] removeEdges" removeEdges
-- console.log2 "[performDiff] updateNodes length" $ A.length $ A.fromFoldable updateNodes
traverse_ (Graphology.addNode sigmaGraph) addNodes
--traverse_ (Graphology.addEdge sigmaGraph) addEdges
-- insert edges in batches, otherwise a maximum recursion error is thrown
......
......@@ -10,6 +10,7 @@ export function _init(graph, settings) {
// console.log('[init] graph', graph, 'settings', settings);
return new FA2Layout(graph, {
settings,
iterations: 1,
getEdgeWeight: 'weight'
})
}
......
......@@ -4,6 +4,7 @@ import DOM.Simple.Types (Element)
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Hashable (hash)
import Data.Show.Generic (genericShow)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
......@@ -11,8 +12,10 @@ import Data.Sequence as Seq
import Data.Set as Set
import Data.Traversable (class Traversable)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Partial.Unsafe (unsafePartial)
import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), (<), mod, not)
import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), (<), mod, not, pure)
import Record.Unsafe (unsafeGet)
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
......@@ -24,14 +27,24 @@ newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} }
derive instance Generic (Graph n e) _
instance (Eq (Record n), Eq (Record e)) => Eq (Graph n e) where
instance ( Eq (Record n)
, Eq (Record e)
, GT.Optional HashableNodeFields n
, GT.Optional HashableEdgeFields e) => Eq (Graph n e) where
--eq = genericEq
eq (Graph { edges: e1, nodes: n1 }) (Graph { edges: e2, nodes: n2 }) =
(Seq.length e1 == Seq.length e2) && (Seq.length n1 == Seq.length n2)
eq g1@(Graph { edges: e1, nodes: n1 }) g2@(Graph { edges: e2, nodes: n2 }) =
-- (Seq.length e1 == Seq.length e2) && (Seq.length n1 == Seq.length n2)
compareGraphEdges g1 g2 &&
compareGraphNodes g1 g2
--instance Eq Graph where
-- eq (Graph {nodes: n1, edges: e1}) (Graph {nodes: n2, edges: e2}) = n1 == n2 && e1 == e2
compareGraphNodes :: forall n e. GT.Optional HashableNodeFields n => Graph n e -> Graph n e -> Boolean
compareGraphNodes (Graph { nodes: n1 }) (Graph { nodes: n2 }) =
(Set.fromFoldable $ Seq.map hashNode n1) == (Set.fromFoldable $ Seq.map hashNode n2)
compareGraphEdges :: forall n e. GT.Optional HashableEdgeFields e => Graph n e -> Graph n e -> Boolean
compareGraphEdges (Graph { edges: e1 }) (Graph { edges: e2 }) =
(Set.fromFoldable $ Seq.map hashEdge e1) == (Set.fromFoldable $ Seq.map hashEdge e2)
type Renderer = { "type" :: String, container :: Element }
......@@ -78,17 +91,51 @@ type EdgeIds = Set.Set EdgeId
type EdgesMap = Map.Map String (Record Edge)
type NodesMap = Map.Map String (Record Node)
type HashableNodeFields =
( id :: NodeId
, borderColor :: String
, color :: String
, equilateral :: { numPoints :: Int }
, hidden :: Boolean
, highlighted :: Boolean )
hashNode :: forall n. GT.Optional HashableNodeFields n => {|n} -> Int
hashNode n = hash rec
where
rec = { id : unsafeGet "id" n
, borderColor : unsafeGet "borderColor" n
, color : unsafeGet "color" n
, equilateral : unsafeGet "equilateral" n
, hidden : unsafeGet "hidden" n
, highlighted : unsafeGet "highlighted" n } :: Record HashableNodeFields
-- | When comparing nodes, we don't want to compare all fields. Only
-- | some are relevant (when updating sigma graph).
-- NOTE For some reason, `Graphology.updateNode` throws error if `type` is set
compareNodes :: Record Node -> Record Node -> Boolean
compareNodes n1 n2 = n1.borderColor == n2.borderColor &&
compareNodes n1 n2 = n1.id == n2.id &&
n1.borderColor == n2.borderColor &&
n1.color == n2.color &&
n1.equilateral == n2.equilateral &&
n1.hidden == n2.hidden &&
n1.highlighted == n2.highlighted
-- TODO For edges, see `Sigmax.updateEdges` (`color` and `hidden`)
type HashableEdgeFields =
( id :: NodeId
, source :: NodeId
, target :: NodeId
, hidden :: Boolean )
hashEdge :: forall e. GT.Optional HashableEdgeFields e => {|e} -> Int
hashEdge e = hash rec
where
rec = { id : unsafeGet "id" e
, source : unsafeGet "source" e
, target : unsafeGet "target" e
, hidden : unsafeGet "hidden" e } :: Record HashableEdgeFields
emptyEdgeIds :: EdgeIds
emptyEdgeIds = Set.empty
......@@ -97,6 +144,7 @@ emptyNodeIds = Set.empty
type SGraph = Graph Node Edge
-- Diff graph structure
-- NOTE: "add" is NOT a graph. There can be edges which join nodes that are not
-- in the SigmaDiff nodes array.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment