Commit d02b8c48 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[Graph] node/edge removal with filters

This affects forceatlas etc -- nodes/edges are not hidden anymore but
really removed from the graph.
parent c1b03f41
...@@ -101,6 +101,7 @@ graphCpt = R.hooksComponent "G.C.Graph" cpt ...@@ -101,6 +101,7 @@ graphCpt = R.hooksComponent "G.C.Graph" cpt
-- TODO Probably this can be optimized to re-mark selected nodes only when they changed -- TODO Probably this can be optimized to re-mark selected nodes only when they changed
R.useEffect' $ do R.useEffect' $ do
Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do
Sigmax.performDiff sigma transformedGraph
Sigmax.updateEdges sigma tEdgesMap Sigmax.updateEdges sigma tEdgesMap
Sigmax.updateNodes sigma tNodesMap Sigmax.updateNodes sigma tNodesMap
Sigmax.setEdges sigma (not $ SigmaxTypes.edgeStateHidden showEdges) Sigmax.setEdges sigma (not $ SigmaxTypes.edgeStateHidden showEdges)
......
...@@ -377,30 +377,45 @@ transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEd ...@@ -377,30 +377,45 @@ transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEd
$ SigmaxTypes.neighbouringEdges graph (fst controls.selectedNodeIds) $ SigmaxTypes.neighbouringEdges graph (fst controls.selectedNodeIds)
hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds) hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds)
newNodes = Seq.map (nodeSizeFilter <<< nodeMarked) nodes --newNodes = Seq.map (nodeSizeFilter <<< nodeMarked) nodes
newEdges = Seq.map (edgeConfluenceFilter <<< edgeWeightFilter <<< edgeShowFilter <<< edgeMarked) edges --newEdges = Seq.map (edgeConfluenceFilter <<< edgeWeightFilter <<< edgeShowFilter <<< edgeMarked) edges
newEdges' = Seq.filter edgeFilter $ Seq.map (edgeShowFilter <<< edgeMarked) edges
nodeSizeFilter node@{ size } = newNodes = Seq.filter nodeFilter $ Seq.map (nodeMarked) nodes
if Range.within (fst controls.nodeSize) size then newEdges = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'
node
else edgeFilter e = edgeConfluenceFilter e &&
node { hidden = true } edgeWeightFilter e
--edgeShowFilter e
edgeConfluenceFilter edge@{ confluence } = nodeFilter n = nodeSizeFilter n
if Range.within (fst controls.edgeConfluence) confluence then
edge --nodeSizeFilter node@{ size } =
else -- if Range.within (fst controls.nodeSize) size then
edge { hidden = true } -- node
-- else
-- node { hidden = true }
nodeSizeFilter node@{ size } = Range.within (fst controls.nodeSize) size
--edgeConfluenceFilter edge@{ confluence } =
-- if Range.within (fst controls.edgeConfluence) confluence then
-- edge
-- else
-- edge { hidden = true }
edgeConfluenceFilter edge@{ confluence } = Range.within (fst controls.edgeConfluence) confluence
edgeShowFilter edge = edgeShowFilter edge =
if (SigmaxTypes.edgeStateHidden $ fst controls.showEdges) then if (SigmaxTypes.edgeStateHidden $ fst controls.showEdges) then
edge { hidden = true } edge { hidden = true }
else else
edge edge
edgeWeightFilter edge@{ weight } = --edgeWeightFilter edge@{ weight } =
if Range.within (fst controls.edgeWeight) weight then -- if Range.within (fst controls.edgeWeight) weight then
edge -- edge
else -- else
edge { hidden = true } -- edge { hidden = true }
edgeWeightFilter :: Record SigmaxTypes.Edge -> Boolean
edgeWeightFilter edge@{ weight } = Range.within (fst controls.edgeWeight) weight
edgeInGraph :: SigmaxTypes.SelectedNodeIds -> Record SigmaxTypes.Edge -> Boolean
edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
edgeMarked edge@{ id, sourceNode } = do edgeMarked edge@{ id, sourceNode } = do
let isSelected = Set.member id selectedEdgeIds let isSelected = Set.member id selectedEdgeIds
......
...@@ -126,12 +126,12 @@ badge (_ /\ setSelectedNodeIds) {id, label} = ...@@ -126,12 +126,12 @@ badge (_ /\ setSelectedNodeIds) {id, label} =
setSelectedNodeIds $ const $ Set.singleton id setSelectedNodeIds $ const $ Set.singleton id
badges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node) badges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
badges graph (selectedNodeIds /\ _) = SigmaxTypes.nodesById graph selectedNodeIds badges graph (selectedNodeIds /\ _) = SigmaxTypes.graphNodes $ SigmaxTypes.nodesById graph selectedNodeIds
neighbourBadges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node) neighbourBadges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
neighbourBadges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph selectedNodes neighbourBadges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph selectedNodes
where where
selectedNodes = SigmaxTypes.nodesById graph selectedNodeIds selectedNodes = SigmaxTypes.graphNodes $ SigmaxTypes.nodesById graph selectedNodeIds
deleteNodes :: TermList -> Session -> Array Int -> Effect Unit deleteNodes :: TermList -> Session -> Array Int -> Effect Unit
deleteNodes termList session nodeIds = do deleteNodes termList session nodeIds = do
......
...@@ -83,8 +83,8 @@ louvainToggleButton :: R.State Boolean -> R.Element ...@@ -83,8 +83,8 @@ louvainToggleButton :: R.State Boolean -> R.Element
louvainToggleButton state = louvainToggleButton state =
toggleButton { toggleButton {
state: state state: state
, onMessage: "Louvain on" , onMessage: "Louvain off"
, offMessage: "Louvain off" , offMessage: "Louvain on"
, onClick: \_ -> snd state not , onClick: \_ -> snd state not
} }
......
module Gargantext.Hooks.Sigmax module Gargantext.Hooks.Sigmax
where where
import Prelude (Unit, bind, discard, flip, pure, unit, ($), (*>), (<<<), (<>), (>>=), not, const, map) import Prelude (Unit, bind, discard, flip, pure, unit, ($), (*>), (<<<), (<>), (>>=), (&&), not, const, map)
import Data.Array as A import Data.Array as A
import Data.Either (either) import Data.Either (either)
...@@ -209,6 +209,21 @@ selectorWithSize :: Sigma.Sigma -> Int -> Effect Unit ...@@ -209,6 +209,21 @@ selectorWithSize :: Sigma.Sigma -> Int -> Effect Unit
selectorWithSize sigma size = do selectorWithSize sigma size = do
pure unit pure unit
performDiff :: Sigma.Sigma -> ST.SGraph -> Effect Unit
performDiff sigma g = do
sigmaEdgeIds <- Sigma.sigmaEdgeIds sigma
sigmaNodeIds <- Sigma.sigmaNodeIds sigma
let {add: Tuple addEdges addNodes, remove: Tuple removeEdges removeNodes} = ST.sigmaDiff sigmaEdgeIds sigmaNodeIds g
traverse_ (Sigma.addNode sigma) addNodes
traverse_ (Sigma.addEdge sigma) addEdges
traverse_ (Sigma.removeEdge sigma) removeEdges
traverse_ (Sigma.removeNode sigma) removeNodes
if (Seq.null addEdges) && (Seq.null addNodes) && (Set.isEmpty removeEdges) && (Set.isEmpty removeNodes) then
pure unit
else do
Sigma.refresh sigma
Sigma.killForceAtlas2 sigma
-- DEPRECATED -- DEPRECATED
markSelectedEdges :: Sigma.Sigma -> ST.SelectedEdgeIds -> ST.EdgesMap -> Effect Unit markSelectedEdges :: Sigma.Sigma -> ST.SelectedEdgeIds -> ST.EdgesMap -> Effect Unit
......
...@@ -203,6 +203,12 @@ function startForceAtlas2(sigma, settings) { sigma.startForceAtlas2(settings); } ...@@ -203,6 +203,12 @@ function startForceAtlas2(sigma, settings) { sigma.startForceAtlas2(settings); }
function stopForceAtlas2(sigma) { sigma.stopForceAtlas2(); } function stopForceAtlas2(sigma) { sigma.stopForceAtlas2(); }
function killForceAtlas2(sigma) { sigma.killForceAtlas2(); } function killForceAtlas2(sigma) { sigma.killForceAtlas2(); }
function isForceAtlas2Running(sigma) { return sigma.isForceAtlas2Running(); } function isForceAtlas2Running(sigma) { return sigma.isForceAtlas2Running(); }
function edgeIds(sigma) { return sigma.graph.edges().map(function(e) { return e.id; }); }
function nodeIds(sigma) { return sigma.graph.nodes().map(function(n) { return n.id; }); }
function addEdge(sigma, e) { return sigma.graph.addEdge(e); }
function removeEdge(sigma, e) { return sigma.graph.dropEdge(e); }
function addNode(sigma, n) { return sigma.graph.addNode(n); }
function removeNode(sigma, n) { return sigma.graph.dropNode(n); }
function getCameras(sigma) { function getCameras(sigma) {
// For some reason, sigma.cameras is an object with integer keys // For some reason, sigma.cameras is an object with integer keys
...@@ -234,3 +240,9 @@ exports._killForceAtlas2 = killForceAtlas2; ...@@ -234,3 +240,9 @@ exports._killForceAtlas2 = killForceAtlas2;
exports._isForceAtlas2Running = isForceAtlas2Running; exports._isForceAtlas2Running = isForceAtlas2Running;
exports._getCameras = getCameras; exports._getCameras = getCameras;
exports._goTo = goTo; exports._goTo = goTo;
exports._edgeIds = edgeIds;
exports._nodeIds = nodeIds;
exports._addEdge = addEdge;
exports._removeEdge = removeEdge;
exports._addNode = addNode;
exports._removeNode = removeNode;
...@@ -3,6 +3,7 @@ module Gargantext.Hooks.Sigmax.Sigma where ...@@ -3,6 +3,7 @@ module Gargantext.Hooks.Sigmax.Sigma where
import Prelude import Prelude
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Nullable (notNull, null, Nullable) import Data.Nullable (notNull, null, Nullable)
import Data.Set as Set
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import FFI.Simple ((..)) import FFI.Simple ((..))
...@@ -33,18 +34,14 @@ instance edgeProps ...@@ -33,18 +34,14 @@ instance edgeProps
type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} } type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} }
type SigmaOpts s = { settings :: s } type SigmaOpts s = { settings :: s }
sigma :: forall opts err. SigmaOpts opts -> Effect (Either err Sigma)
sigma = runEffectFn3 _sigma Left Right
foreign import _sigma :: foreign import _sigma ::
forall a b opts err. forall a b opts err.
EffectFn3 (a -> Either a b) EffectFn3 (a -> Either a b)
(b -> Either a b) (b -> Either a b)
(SigmaOpts opts) (SigmaOpts opts)
(Either err Sigma) (Either err Sigma)
sigma :: forall opts err. SigmaOpts opts -> Effect (Either err Sigma)
graphRead :: forall node edge err. Sigma -> Graph node edge -> Effect (Either err Unit) sigma = runEffectFn3 _sigma Left Right
graphRead = runEffectFn4 _graphRead Left Right
foreign import _graphRead :: foreign import _graphRead ::
forall a b data_ err. forall a b data_ err.
...@@ -53,25 +50,22 @@ foreign import _graphRead :: ...@@ -53,25 +50,22 @@ foreign import _graphRead ::
Sigma Sigma
data_ data_
(Either err Unit) (Either err Unit)
graphRead :: forall node edge err. Sigma -> Graph node edge -> Effect (Either err Unit)
graphRead = runEffectFn4 _graphRead Left Right
foreign import _refresh :: EffectFn1 Sigma Unit
refresh :: Sigma -> Effect Unit refresh :: Sigma -> Effect Unit
refresh = runEffectFn1 _refresh refresh = runEffectFn1 _refresh
foreign import _refresh :: EffectFn1 Sigma Unit
addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
addRenderer = runEffectFn4 _addRenderer Left Right
foreign import _addRenderer foreign import _addRenderer
:: forall a b r err. :: forall a b r err.
EffectFn4 (a -> Either a b) EffectFn4 (a -> Either a b)
(b -> Either a b) (b -> Either a b)
Sigma Sigma
r r
(Either err Unit) (Either err Unit)
addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
bindMouseSelectorPlugin :: forall err. Sigma -> Effect (Either err Unit) addRenderer = runEffectFn4 _addRenderer Left Right
bindMouseSelectorPlugin = runEffectFn3 _bindMouseSelectorPlugin Left Right
foreign import _bindMouseSelectorPlugin foreign import _bindMouseSelectorPlugin
:: forall a b err. :: forall a b err.
...@@ -79,23 +73,23 @@ foreign import _bindMouseSelectorPlugin ...@@ -79,23 +73,23 @@ foreign import _bindMouseSelectorPlugin
(b -> Either a b) (b -> Either a b)
Sigma Sigma
(Either err Unit) (Either err Unit)
bindMouseSelectorPlugin :: forall err. Sigma -> Effect (Either err Unit)
killRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit) bindMouseSelectorPlugin = runEffectFn3 _bindMouseSelectorPlugin Left Right
killRenderer = runEffectFn4 _killRenderer Left Right
foreign import _killRenderer foreign import _killRenderer
:: forall a b r err. :: forall a b r err.
EffectFn4 (a -> Either a b) EffectFn4 (a -> Either a b)
(b -> Either a b) (b -> Either a b)
Sigma Sigma
r r
(Either err Unit) (Either err Unit)
killRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
getRendererContainer :: Sigma -> Effect Element killRenderer = runEffectFn4 _killRenderer Left Right
getRendererContainer = runEffectFn1 _getRendererContainer
foreign import _getRendererContainer foreign import _getRendererContainer
:: EffectFn1 Sigma Element :: EffectFn1 Sigma Element
getRendererContainer :: Sigma -> Effect Element
getRendererContainer = runEffectFn1 _getRendererContainer
swapRendererContainer :: R.Ref (Nullable Element) -> Sigma -> Effect Unit swapRendererContainer :: R.Ref (Nullable Element) -> Sigma -> Effect Unit
swapRendererContainer ref s = do swapRendererContainer ref s = do
...@@ -103,47 +97,66 @@ swapRendererContainer ref s = do ...@@ -103,47 +97,66 @@ swapRendererContainer ref s = do
log2 "[swapRendererContainer] el" el log2 "[swapRendererContainer] el" el
R.setRef ref $ notNull el R.setRef ref $ notNull el
setRendererContainer :: Sigma -> Element -> Effect Unit
setRendererContainer = runEffectFn2 _setRendererContainer
foreign import _setRendererContainer foreign import _setRendererContainer
:: EffectFn2 Sigma Element Unit :: EffectFn2 Sigma Element Unit
setRendererContainer :: Sigma -> Element -> Effect Unit
killSigma :: forall err. Sigma -> Effect (Either err Unit) setRendererContainer = runEffectFn2 _setRendererContainer
killSigma = runEffectFn3 _killSigma Left Right
clear :: Sigma -> Effect Unit
clear = runEffectFn1 _clear
foreign import _clear :: EffectFn1 Sigma Unit
foreign import _killSigma foreign import _killSigma
:: forall a b err. :: forall a b err.
EffectFn3 (a -> Either a b) EffectFn3 (a -> Either a b)
(b -> Either a b) (b -> Either a b)
Sigma Sigma
(Either err Unit) (Either err Unit)
killSigma :: forall err. Sigma -> Effect (Either err Unit)
killSigma = runEffectFn3 _killSigma Left Right
bind_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit foreign import _clear :: EffectFn1 Sigma Unit
bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h) clear :: Sigma -> Effect Unit
clear = runEffectFn1 _clear
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
bind_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit
bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)
foreign import _unbind :: EffectFn2 Sigma String Unit
unbind_ :: Sigma -> String -> Effect Unit unbind_ :: Sigma -> String -> Effect Unit
unbind_ s e = runEffectFn2 _unbind s e unbind_ s e = runEffectFn2 _unbind s e
foreign import _unbind :: EffectFn2 Sigma String Unit foreign import _edgeIds :: EffectFn1 Sigma (Array String)
sigmaEdgeIds :: Sigma -> Effect Types.SelectedEdgeIds
sigmaEdgeIds s = do
edgeIds <- runEffectFn1 _edgeIds s
pure $ Set.fromFoldable edgeIds
foreign import _nodeIds :: EffectFn1 Sigma (Array String)
sigmaNodeIds :: Sigma -> Effect Types.SelectedNodeIds
sigmaNodeIds s = do
nodeIds <- runEffectFn1 _nodeIds s
pure $ Set.fromFoldable nodeIds
foreign import _addEdge :: EffectFn2 Sigma (Record Types.Edge) Unit
addEdge :: Sigma -> Record Types.Edge -> Effect Unit
addEdge s e = runEffectFn2 _addEdge s e
foreign import _removeEdge :: EffectFn2 Sigma String Unit
removeEdge :: Sigma -> String -> Effect Unit
removeEdge s eId = runEffectFn2 _removeEdge s eId
foreign import _addNode :: EffectFn2 Sigma (Record Types.Node) Unit
addNode :: Sigma -> Record Types.Node -> Effect Unit
addNode s n = runEffectFn2 _addNode s n
foreign import _removeNode :: EffectFn2 Sigma String Unit
removeNode :: Sigma -> String -> Effect Unit
removeNode s nId = runEffectFn2 _removeNode s nId
foreign import _forEachNode :: EffectFn2 Sigma (EffectFn1 (Record Types.Node) Unit) Unit
forEachNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit forEachNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
forEachNode s f = runEffectFn2 _forEachNode s (mkEffectFn1 f) forEachNode s f = runEffectFn2 _forEachNode s (mkEffectFn1 f)
foreign import _forEachNode :: EffectFn2 Sigma (EffectFn1 (Record Types.Node) Unit) Unit foreign import _forEachEdge :: EffectFn2 Sigma (EffectFn1 (Record Types.Edge) Unit) Unit
forEachEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit forEachEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
forEachEdge s f = runEffectFn2 _forEachEdge s (mkEffectFn1 f) forEachEdge s f = runEffectFn2 _forEachEdge s (mkEffectFn1 f)
foreign import _forEachEdge :: EffectFn2 Sigma (EffectFn1 (Record Types.Edge) Unit) Unit
bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindClickNode s f = bind_ s "clickNode" $ \e -> do bindClickNode s f = bind_ s "clickNode" $ \e -> do
let node = e .. "data" .. "node" :: Record Types.Node let node = e .. "data" .. "node" :: Record Types.Node
...@@ -178,13 +191,12 @@ bindOverEdge s f = bind_ s "overEdge" $ \e -> do ...@@ -178,13 +191,12 @@ bindOverEdge s f = bind_ s "overEdge" $ \e -> do
let edge = e .. "data" .. "edge" :: Record Types.Edge let edge = e .. "data" .. "edge" :: Record Types.Edge
f edge f edge
foreign import _setSettings :: forall settings. EffectFn2 Sigma settings Unit
setSettings :: forall settings. Sigma -> settings -> Effect Unit setSettings :: forall settings. Sigma -> settings -> Effect Unit
setSettings s settings = do setSettings s settings = do
runEffectFn2 _setSettings s settings runEffectFn2 _setSettings s settings
refresh s refresh s
foreign import _setSettings :: forall settings. EffectFn2 Sigma settings Unit
startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
startForceAtlas2 = runEffectFn2 _startForceAtlas2 startForceAtlas2 = runEffectFn2 _startForceAtlas2
......
...@@ -12,9 +12,9 @@ import Data.Set as Set ...@@ -12,9 +12,9 @@ import Data.Set as Set
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Data.Louvain as Louvain import Gargantext.Data.Louvain as Louvain
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), mod) import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), mod, not)
newtype Graph n e = Graph { nodes :: Seq.Seq {|n}, edges :: Seq.Seq {|e} } newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} }
--derive instance eqGraph :: Eq Graph --derive instance eqGraph :: Eq Graph
...@@ -56,6 +56,15 @@ type NodesMap = Map.Map String (Record Node) ...@@ -56,6 +56,15 @@ type NodesMap = Map.Map String (Record Node)
type SGraph = Graph Node Edge 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.
type SigmaDiff =
(
add :: Tuple (Seq.Seq (Record Edge)) (Seq.Seq (Record Node))
, remove :: Tuple SelectedEdgeIds SelectedNodeIds
)
graphEdges :: SGraph -> Seq.Seq (Record Edge) graphEdges :: SGraph -> Seq.Seq (Record Edge)
graphEdges (Graph {edges}) = edges graphEdges (Graph {edges}) = edges
...@@ -66,8 +75,8 @@ edgesGraphMap :: SGraph -> EdgesMap ...@@ -66,8 +75,8 @@ edgesGraphMap :: SGraph -> EdgesMap
edgesGraphMap graph = edgesGraphMap graph =
Map.fromFoldable $ map (\e -> Tuple e.id e) $ graphEdges graph Map.fromFoldable $ map (\e -> Tuple e.id e) $ graphEdges graph
edgesById :: SGraph -> SelectedEdgeIds -> Seq.Seq (Record Edge) edgesFilter :: (Record Edge -> Boolean) -> SGraph -> SGraph
edgesById g edgeIds = Seq.filter (\e -> Set.member e.id edgeIds) $ graphEdges g edgesFilter f (Graph {edges, nodes}) = Graph { edges: Seq.filter f edges, nodes }
nodesMap :: Seq.Seq (Record Node) -> NodesMap nodesMap :: Seq.Seq (Record Node) -> NodesMap
nodesMap nodes = Map.fromFoldable $ map (\n -> Tuple n.id n) nodes nodesMap nodes = Map.fromFoldable $ map (\n -> Tuple n.id n) nodes
...@@ -76,16 +85,45 @@ nodesGraphMap :: SGraph -> NodesMap ...@@ -76,16 +85,45 @@ nodesGraphMap :: SGraph -> NodesMap
nodesGraphMap graph = nodesGraphMap graph =
nodesMap $ graphNodes graph nodesMap $ graphNodes graph
nodesById :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Node) nodesFilter :: (Record Node -> Boolean) -> SGraph -> SGraph
nodesById g nodeIds = Seq.filter (\n -> Set.member n.id nodeIds) $ graphNodes g nodesFilter f (Graph {edges, nodes}) = Graph { edges, nodes: Seq.filter f nodes }
nodesById :: SGraph -> SelectedNodeIds -> SGraph
nodesById g nodeIds = nodesFilter (\n -> Set.member n.id nodeIds) g
-- | "Subtract" second graph from first one (only node/edge id's are compared, not other props)
sub :: SGraph -> SGraph -> SGraph
sub graph (Graph {nodes, edges}) = newGraph
where
edgeIds = Set.fromFoldable $ Seq.map _.id edges
nodeIds = Set.fromFoldable $ Seq.map _.id nodes
edgeFilterFunc e = (not $ Set.member e.id edgeIds)
&& (not $ Set.member e.source nodeIds)
&& (not $ Set.member e.target nodeIds)
filteredEdges = edgesFilter edgeFilterFunc graph
newGraph = nodesFilter (\n -> not (Set.member n.id nodeIds)) filteredEdges
-- | Compute a diff between current sigma graph and whatever is set via customer controls
sigmaDiff :: SelectedEdgeIds -> SelectedNodeIds -> SGraph -> Record SigmaDiff
sigmaDiff sigmaEdges sigmaNodes g@(Graph {nodes, edges}) = {add, remove}
where
add = Tuple addEdges addNodes
remove = Tuple removeEdges removeNodes
addG = edgesFilter (\e -> not (Set.member e.id sigmaEdges)) $ nodesFilter (\n -> not (Set.member n.id sigmaNodes)) g
addEdges = graphEdges addG
addNodes = graphNodes addG
removeEdges = Set.difference sigmaEdges (Set.fromFoldable $ Seq.map _.id edges)
removeNodes = Set.difference sigmaNodes (Set.fromFoldable $ Seq.map _.id nodes)
neighbours :: SGraph -> Seq.Seq (Record Node) -> Seq.Seq (Record Node) neighbours :: SGraph -> Seq.Seq (Record Node) -> Seq.Seq (Record Node)
neighbours g nodes = Seq.fromFoldable $ Set.unions [Set.fromFoldable nodes, sources, targets] neighbours g nodes = Seq.fromFoldable $ Set.unions [Set.fromFoldable nodes, sources, targets]
where where
nodeIds = Set.fromFoldable $ Seq.map _.id nodes nodeIds = Set.fromFoldable $ Seq.map _.id nodes
selectedEdges = neighbouringEdges g nodeIds selectedEdges = neighbouringEdges g nodeIds
sources = Set.fromFoldable $ nodesById g $ Set.fromFoldable $ Seq.map _.source selectedEdges sources = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.source selectedEdges
targets = Set.fromFoldable $ nodesById g $ Set.fromFoldable $ Seq.map _.target selectedEdges targets = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.target selectedEdges
neighbouringEdges :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Edge) neighbouringEdges :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Edge)
neighbouringEdges g nodeIds = Seq.filter condition $ graphEdges g neighbouringEdges g nodeIds = Seq.filter condition $ graphEdges g
......
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