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