Commit 03e4cf67 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[Graph] no graph reloading after node removal

Instead, add it to removed node ids and hide them via transformed graph
functionality.
parent 532e2cd0
......@@ -29,7 +29,7 @@ type Props sigma forceatlas2 =
, forceAtlas2Settings :: forceatlas2
, graph :: SigmaxTypes.SGraph
, multiSelectEnabledRef :: R.Ref Boolean
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, selectedNodeIds :: R.State SigmaxTypes.NodeIds
, showEdges :: R.State SigmaxTypes.ShowEdgesState
, sigmaRef :: R.Ref Sigmax.Sigma
, sigmaSettings :: sigma
......
......@@ -29,7 +29,7 @@ import Gargantext.Data.Louvain as Louvain
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
import Gargantext.Sessions (Session, Sessions, get)
import Gargantext.Types as Types
......@@ -48,7 +48,7 @@ type LayoutProps =
)
type Props = (
graph :: SigmaxTypes.SGraph
graph :: SigmaxT.SGraph
, graphVersion :: R.State Int
, mMetaData :: Maybe GET.MetaData
| LayoutProps
......@@ -102,7 +102,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
R.useEffect' $ do
let readData = R.readRef dataRef
let gv = R.readRef graphVersionRef
if (SigmaxTypes.eqGraph readData graph) || (gv == fst graphVersion) then
if SigmaxT.eqGraph readData graph then
pure unit
else do
-- Graph data changed, reinitialize sigma.
......@@ -111,9 +111,10 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
R.setRef dataRef graph
R.setRef graphVersionRef (fst graphVersion)
-- Reinitialize bunch of state as well.
snd controls.selectedNodeIds $ const Set.empty
snd controls.showEdges $ const SigmaxTypes.EShow
snd controls.forceAtlasState $ const SigmaxTypes.InitialRunning
snd controls.removedNodeIds $ const SigmaxT.emptyNodeIds
snd controls.selectedNodeIds $ const SigmaxT.emptyNodeIds
snd controls.showEdges $ const SigmaxT.EShow
snd controls.forceAtlasState $ const SigmaxT.InitialRunning
snd controls.graphStage $ const Graph.Init
snd controls.showSidePanel $ const GET.InitialClosed
......@@ -141,6 +142,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
, mSidebar mMetaData { frontends
, graph
, graphVersion
, removedNodeIds: controls.removedNodeIds
, session
, selectedNodeIds: controls.selectedNodeIds
, showSidePanel: fst controls.showSidePanel
......@@ -169,18 +171,20 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
mSidebar :: Maybe GET.MetaData
-> { frontends :: Frontends
, graph :: SigmaxTypes.SGraph
, graph :: SigmaxT.SGraph
, graphVersion :: R.State Int
, removedNodeIds :: R.State SigmaxT.NodeIds
, showSidePanel :: GET.SidePanelState
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session }
-> R.Element
mSidebar Nothing _ = RH.div {} []
mSidebar (Just metaData) {frontends, graph, graphVersion, session, selectedNodeIds, showSidePanel} =
mSidebar (Just metaData) {frontends, graph, graphVersion, removedNodeIds, session, selectedNodeIds, showSidePanel} =
Sidebar.sidebar { frontends
, graph
, graphVersion
, metaData
, removedNodeIds
, session
, selectedNodeIds
, showSidePanel
......@@ -190,7 +194,7 @@ type GraphProps = (
controls :: Record Controls.Controls
, elRef :: R.Ref (Nullable Element)
, graphId :: GraphId
, graph :: SigmaxTypes.SGraph
, graph :: SigmaxT.SGraph
, multiSelectEnabledRef :: R.Ref Boolean
)
......@@ -206,8 +210,8 @@ graphViewCpt = R.hooksComponent "GraphView" cpt
let louvainGraph =
if (fst controls.showLouvain) then
let louvain = Louvain.louvain unit in
let cluster = Louvain.init louvain (SigmaxTypes.louvainNodes graph) (SigmaxTypes.louvainEdges graph) in
SigmaxTypes.louvainGraph graph cluster
let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph) (SigmaxT.louvainEdges graph) in
SigmaxT.louvainGraph graph cluster
else
graph
let transformedGraph = transformGraph controls louvainGraph
......@@ -228,8 +232,8 @@ graphViewCpt = R.hooksComponent "GraphView" cpt
, transformedGraph
}
convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxTypes.SGraph
convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges}
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 (GET.Node n) =
......@@ -250,7 +254,7 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges}
cDef (GET.Cluster {clustDefault}) = clustDefault
color = GET.intColor (cDef n.attributes)
gargType = unsafePartial $ fromJust $ Types.modeFromString n.type_
nodesMap = SigmaxTypes.nodesMap nodes
nodesMap = SigmaxT.nodesMap nodes
edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges
edgeFn i (GET.Edge e) = Seq.singleton { id : e.id_
, color
......@@ -281,15 +285,15 @@ getNodes :: Session -> R.State Int -> GraphId -> Aff GET.GraphData
getNodes session (graphVersion /\ _) graphId = get session $ NodeAPI Types.Graph (Just graphId) ("?version=" <> show graphVersion)
transformGraph :: Record Controls.Controls -> SigmaxTypes.SGraph -> SigmaxTypes.SGraph
transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEdges}
transformGraph :: Record Controls.Controls -> SigmaxT.SGraph -> SigmaxT.SGraph
transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
where
edges = SigmaxTypes.graphEdges graph
nodes = SigmaxTypes.graphNodes graph
edges = SigmaxT.graphEdges graph
nodes = SigmaxT.graphNodes graph
selectedEdgeIds =
Set.fromFoldable
$ Seq.map _.id
$ SigmaxTypes.neighbouringEdges graph (fst controls.selectedNodeIds)
$ SigmaxT.neighbouringEdges graph (fst controls.selectedNodeIds)
hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds)
--newNodes = Seq.map (nodeSizeFilter <<< nodeMarked) nodes
......@@ -301,7 +305,8 @@ transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEd
edgeFilter e = edgeConfluenceFilter e &&
edgeWeightFilter e
--edgeShowFilter e
nodeFilter n = nodeSizeFilter n
nodeFilter n = nodeSizeFilter n &&
nodeRemovedFilter n
--nodeSizeFilter node@{ size } =
-- if Range.within (fst controls.nodeSize) size then
......@@ -310,6 +315,8 @@ transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEd
-- node { hidden = true }
nodeSizeFilter node@{ size } = Range.within (fst controls.nodeSize) size
nodeRemovedFilter node@{ id } = not $ Set.member id $ fst controls.removedNodeIds
--edgeConfluenceFilter edge@{ confluence } =
-- if Range.within (fst controls.edgeConfluence) confluence then
-- edge
......@@ -317,7 +324,7 @@ transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEd
-- edge { hidden = true }
edgeConfluenceFilter edge@{ confluence } = Range.within (fst controls.edgeConfluence) confluence
edgeShowFilter edge =
if (SigmaxTypes.edgeStateHidden $ fst controls.showEdges) then
if (SigmaxT.edgeStateHidden $ fst controls.showEdges) then
edge { hidden = true }
else
edge
......@@ -326,10 +333,10 @@ transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEd
-- edge
-- else
-- edge { hidden = true }
edgeWeightFilter :: Record SigmaxTypes.Edge -> Boolean
edgeWeightFilter :: Record SigmaxT.Edge -> Boolean
edgeWeightFilter edge@{ weightIdx } = Range.within (fst controls.edgeWeight) $ toNumber weightIdx
edgeInGraph :: SigmaxTypes.SelectedNodeIds -> Record SigmaxTypes.Edge -> Boolean
edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
edgeMarked edge@{ id, sourceNode } = do
......
......@@ -28,21 +28,22 @@ import Gargantext.Components.GraphExplorer.SlideButton (labelSizeButton, mouseSe
import Gargantext.Components.GraphExplorer.ToggleButton (multiSelectEnabledButton, edgesToggleButton, louvainToggleButton, pauseForceAtlasButton)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
type Controls =
( edgeConfluence :: R.State Range.NumberRange
, edgeWeight :: R.State Range.NumberRange
, forceAtlasState :: R.State SigmaxTypes.ForceAtlasState
, graph :: SigmaxTypes.SGraph
, forceAtlasState :: R.State SigmaxT.ForceAtlasState
, graph :: SigmaxT.SGraph
, graphStage :: R.State Graph.Stage
, multiSelectEnabled :: R.State Boolean
, nodeSize :: R.State Range.NumberRange
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, removedNodeIds :: R.State SigmaxT.NodeIds
, selectedNodeIds :: R.State SigmaxT.NodeIds
, showControls :: R.State Boolean
, showEdges :: R.State SigmaxTypes.ShowEdgesState
, showEdges :: R.State SigmaxT.ShowEdgesState
, showLouvain :: R.State Boolean
, showSidePanel :: R.State GET.SidePanelState
, showTree :: R.State Boolean
......@@ -88,7 +89,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
-- Handle automatic edge hiding when FA is running (to prevent flickering).
R.useEffect2' props.sigmaRef props.forceAtlasState $
snd props.showEdges $ SigmaxTypes.forceAtlasEdgeState (fst props.forceAtlasState)
snd props.showEdges $ SigmaxT.forceAtlasEdgeState (fst props.forceAtlasState)
-- Automatic opening of sidebar when a node is selected (but only first time).
R.useEffect' $ do
......@@ -100,11 +101,11 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
-- Timer to turn off the initial FA. This is because FA eats up lot of
-- CPU, has memory leaks etc.
R.useEffect1' (fst props.forceAtlasState) $ do
if (fst props.forceAtlasState) == SigmaxTypes.InitialRunning then do
if (fst props.forceAtlasState) == SigmaxT.InitialRunning then do
timeoutId <- setTimeout 2000 $ do
let (toggled /\ setToggled) = props.forceAtlasState
case toggled of
SigmaxTypes.InitialRunning -> setToggled $ const SigmaxTypes.Paused
SigmaxT.InitialRunning -> setToggled $ const SigmaxT.Paused
_ -> pure unit
R.setRef mFAPauseRef Nothing
R.setRef mFAPauseRef $ Just timeoutId
......@@ -112,21 +113,21 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
else
pure unit
let edgesConfluenceSorted = A.sortWith (_.confluence) $ Seq.toUnfoldable $ SigmaxTypes.graphEdges props.graph
let edgesConfluenceSorted = A.sortWith (_.confluence) $ Seq.toUnfoldable $ SigmaxT.graphEdges props.graph
let edgeConfluenceMin = maybe 0.0 _.confluence $ A.head edgesConfluenceSorted
let edgeConfluenceMax = maybe 100.0 _.confluence $ A.last edgesConfluenceSorted
let edgeConfluenceRange = Range.Closed { min: edgeConfluenceMin, max: edgeConfluenceMax }
--let edgesWeightSorted = A.sortWith (_.weight) $ Seq.toUnfoldable $ SigmaxTypes.graphEdges props.graph
--let edgesWeightSorted = A.sortWith (_.weight) $ Seq.toUnfoldable $ SigmaxT.graphEdges props.graph
--let edgeWeightMin = maybe 0.0 _.weight $ A.head edgesWeightSorted
--let edgeWeightMax = maybe 100.0 _.weight $ A.last edgesWeightSorted
--let edgeWeightRange = Range.Closed { min: edgeWeightMin, max: edgeWeightMax }
let edgeWeightRange = Range.Closed {
min: 0.0
, max: I.toNumber $ Seq.length $ SigmaxTypes.graphEdges props.graph
, max: I.toNumber $ Seq.length $ SigmaxT.graphEdges props.graph
}
let nodesSorted = A.sortWith (_.size) $ Seq.toUnfoldable $ SigmaxTypes.graphNodes props.graph
let nodesSorted = A.sortWith (_.size) $ Seq.toUnfoldable $ SigmaxT.graphNodes props.graph
let nodeSizeMin = maybe 0.0 _.size $ A.head nodesSorted
let nodeSizeMax = maybe 100.0 _.size $ A.last nodesSorted
let nodeSizeRange = Range.Closed { min: nodeSizeMin, max: nodeSizeMax }
......@@ -161,20 +162,21 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
]
]
useGraphControls :: SigmaxTypes.SGraph -> R.Hooks (Record Controls)
useGraphControls :: SigmaxT.SGraph -> R.Hooks (Record Controls)
useGraphControls graph = do
edgeConfluence <- R.useState' $ Range.Closed { min: 0.0, max: 1.0 }
edgeWeight <- R.useState' $ Range.Closed {
min: 0.0
, max: I.toNumber $ Seq.length $ SigmaxTypes.graphEdges graph
, max: I.toNumber $ Seq.length $ SigmaxT.graphEdges graph
}
forceAtlasState <- R.useState' SigmaxTypes.InitialRunning
forceAtlasState <- R.useState' SigmaxT.InitialRunning
graphStage <- R.useState' Graph.Init
multiSelectEnabled <- R.useState' false
nodeSize <- R.useState' $ Range.Closed { min: 0.0, max: 100.0 }
selectedNodeIds <- R.useState' $ Set.empty
removedNodeIds <- R.useState' SigmaxT.emptyNodeIds
selectedNodeIds <- R.useState' SigmaxT.emptyNodeIds
showControls <- R.useState' false
showEdges <- R.useState' SigmaxTypes.EShow
showEdges <- R.useState' SigmaxT.EShow
showLouvain <- R.useState' false
showSidePanel <- R.useState' GET.InitialClosed
showTree <- R.useState' false
......@@ -188,6 +190,7 @@ useGraphControls graph = do
, graphStage
, multiSelectEnabled
, nodeSize
, removedNodeIds
, selectedNodeIds
, showControls
, showEdges
......
......@@ -14,21 +14,21 @@ import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.InputWithAutocomplete (inputWithAutocomplete)
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Hooks.Sigmax.Types as SigmaxT
type Props = (
graph :: SigmaxTypes.SGraph
graph :: SigmaxT.SGraph
, multiSelectEnabled :: R.State Boolean
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, selectedNodeIds :: R.State SigmaxT.NodeIds
)
-- | Whether a node matches a search string
nodeMatchesSearch :: String -> Record SigmaxTypes.Node -> Boolean
nodeMatchesSearch :: String -> Record SigmaxT.Node -> Boolean
nodeMatchesSearch s n = S.contains (S.Pattern $ normalize s) (normalize n.label)
where
normalize = S.toLower
searchNodes :: String -> Seq.Seq (Record SigmaxTypes.Node) -> Seq.Seq (Record SigmaxTypes.Node)
searchNodes :: String -> Seq.Seq (Record SigmaxT.Node) -> Seq.Seq (Record SigmaxT.Node)
searchNodes "" _ = Seq.empty
searchNodes s nodes = Seq.filter (nodeMatchesSearch s) nodes
......@@ -55,21 +55,21 @@ sizeButtonCpt = R.hooksComponent "NodeSearchControl" cpt
]
]
autocompleteSearch :: SigmaxTypes.SGraph -> String -> Array String
autocompleteSearch :: SigmaxT.SGraph -> String -> Array String
autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s nodes
where
nodes = SigmaxTypes.graphNodes graph
nodes = SigmaxT.graphNodes graph
triggerSearch :: SigmaxTypes.SGraph
triggerSearch :: SigmaxT.SGraph
-> String
-> R.State Boolean
-> R.State SigmaxTypes.SelectedNodeIds
-> R.State SigmaxT.NodeIds
-> Effect Unit
triggerSearch graph search (multiSelectEnabled /\ _) (_ /\ setSelectedNodeIds) = do
let graphNodes = SigmaxTypes.graphNodes graph
triggerSearch graph search (multiSelectEnabled /\ _) (_ /\ setNodeIds) = do
let graphNodes = SigmaxT.graphNodes graph
let matching = Set.fromFoldable $ (_.id) <$> searchNodes search graphNodes
log2 "[triggerSearch] search" search
setSelectedNodeIds $ \nodes ->
Set.union matching $ if multiSelectEnabled then nodes else Set.empty
setNodeIds $ \nodes ->
Set.union matching $ if multiSelectEnabled then nodes else SigmaxT.emptyNodeIds
......@@ -11,6 +11,7 @@ import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
......@@ -25,17 +26,18 @@ import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
import Gargantext.Components.RandomText (words)
import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, TabSubType(..), TabType(..), TermList(..), modeTabType)
import Gargantext.Utils.Reactix as R2
type Props =
( frontends :: Frontends
, graph :: SigmaxTypes.SGraph
, graph :: SigmaxT.SGraph
, graphVersion :: R.State Int
, metaData :: GET.MetaData
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, removedNodeIds :: R.State SigmaxT.NodeIds
, selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session
, showSidePanel :: GET.SidePanelState
)
......@@ -51,7 +53,7 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
cpt {showSidePanel: GET.InitialClosed} _children = do
pure $ RH.div {} []
cpt props _children = do
let nodesMap = SigmaxTypes.nodesGraphMap props.graph
let nodesMap = SigmaxT.nodesGraphMap props.graph
pure $
RH.div { id: "sp-container" }
......@@ -65,12 +67,8 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
]
, RH.div { className: "tab-content" }
[
RH.button { className: "btn btn-danger"
, on: { click: onClickRemove CandidateTerm props.session props.metaData nodesMap props.selectedNodeIds props.graphVersion }}
[ RH.text "Remove candidate" ]
, RH.button { className: "btn btn-danger"
, on: { click: onClickRemove StopTerm props.session props.metaData nodesMap props.selectedNodeIds props.graphVersion }}
[ RH.text "Remove stop" ]
removeButton "Remove candidate" CandidateTerm props nodesMap
, removeButton "Remove stop" StopTerm props nodesMap
]
, RH.li { className: "nav-item" }
[ RH.a { id: "home-tab"
......@@ -112,39 +110,49 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, checked: true
, title: "Mark as completed" } ]
onClickRemove rType session metaData nodesMap (selectedNodeIds /\ _) graphVersion e = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap) $ Set.toUnfoldable selectedNodeIds
deleteNodes rType session metaData graphVersion nodes
removeButton text rType props nodesMap =
if Set.isEmpty $ fst props.selectedNodeIds then
RH.div {} []
else
RH.button { className: "btn btn-danger"
, on: { click: onClickRemove rType props nodesMap }}
[ RH.text text ]
onClickRemove rType props nodesMap e = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap) $ Set.toUnfoldable $ fst props.selectedNodeIds
deleteNodes rType props.session props.metaData props.graphVersion nodes
snd props.removedNodeIds $ const $ fst props.selectedNodeIds
snd props.selectedNodeIds $ const SigmaxT.emptyNodeIds
badge :: R.State SigmaxTypes.SelectedNodeIds -> Record SigmaxTypes.Node -> R.Element
badge (_ /\ setSelectedNodeIds) {id, label} =
badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
badge (_ /\ setNodeIds) {id, label} =
RH.a { className: "badge badge-light"
, on: { click: onClick }
} [ RH.text label ]
where
onClick e = do
setSelectedNodeIds $ const $ Set.singleton id
setNodeIds $ const $ Set.singleton id
badges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
badges graph (selectedNodeIds /\ _) = SigmaxTypes.graphNodes $ SigmaxTypes.nodesById graph selectedNodeIds
badges :: SigmaxT.SGraph -> R.State SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
badges graph (selectedNodeIds /\ _) = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
neighbourBadges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
neighbourBadges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph selectedNodes
neighbourBadges :: SigmaxT.SGraph -> R.State SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selectedNodes
where
selectedNodes = SigmaxTypes.graphNodes $ SigmaxTypes.nodesById graph selectedNodeIds
selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
deleteNodes :: TermList -> Session -> GET.MetaData -> R.State Int -> Array (Record SigmaxTypes.Node) -> Effect Unit
deleteNodes :: TermList -> Session -> GET.MetaData -> R.State Int -> Array (Record SigmaxT.Node) -> Effect Unit
deleteNodes termList session metaData (_ /\ setGraphVersion) nodes = do
launchAff_ do
patches <- (parTraverse (deleteNode termList session metaData) nodes) :: Aff (Array NTC.VersionedNgramsPatches)
let mPatch = last patches
case mPatch of
Nothing -> pure unit
Just (NTC.Versioned patch) -> liftEffect do
setGraphVersion $ const $ patch.version
Just (NTC.Versioned patch) -> pure unit --liftEffect do
--setGraphVersion $ const $ patch.version
deleteNode :: TermList -> Session -> GET.MetaData -> Record SigmaxTypes.Node -> Aff NTC.VersionedNgramsPatches
deleteNode :: TermList -> Session -> GET.MetaData -> Record SigmaxT.Node -> Aff NTC.VersionedNgramsPatches
deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches coreParams versioned
where
nodeId :: Int
......@@ -167,7 +175,7 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches
patch_list = NTC.Replace { new: termList, old: GraphTerm }
query :: Frontends -> GET.MetaData -> Session -> SigmaxTypes.NodesMap -> R.State SigmaxTypes.SelectedNodeIds -> R.Element
query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element
query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
query' (head metaData.corpusId)
......
......@@ -178,7 +178,7 @@ updateNodes sigma nodesMap = do
-- | Toggles item visibility in the selected set
multiSelectUpdate :: ST.SelectedNodeIds -> ST.SelectedNodeIds -> ST.SelectedNodeIds
multiSelectUpdate :: ST.NodeIds -> ST.NodeIds -> ST.NodeIds
multiSelectUpdate new selected = foldl fld selected new
where
fld selectedAcc item =
......@@ -188,21 +188,21 @@ multiSelectUpdate new selected = foldl fld selected new
Set.insert item selectedAcc
bindSelectedNodesClick :: Sigma.Sigma -> R.State ST.SelectedNodeIds -> R.Ref Boolean -> Effect Unit
bindSelectedNodesClick sigma (_ /\ setSelectedNodeIds) multiSelectEnabledRef =
bindSelectedNodesClick :: Sigma.Sigma -> R.State ST.NodeIds -> R.Ref Boolean -> Effect Unit
bindSelectedNodesClick sigma (_ /\ setNodeIds) multiSelectEnabledRef =
Sigma.bindClickNodes sigma $ \nodes -> do
let multiSelectEnabled = R.readRef multiSelectEnabledRef
let nodeIds = Set.fromFoldable $ map _.id nodes
if multiSelectEnabled then
setSelectedNodeIds $ multiSelectUpdate nodeIds
setNodeIds $ multiSelectUpdate nodeIds
else
setSelectedNodeIds $ const nodeIds
setNodeIds $ const nodeIds
bindSelectedEdgesClick :: R.Ref Sigma -> R.State ST.SelectedEdgeIds -> Effect Unit
bindSelectedEdgesClick sigmaRef (_ /\ setSelectedEdgeIds) =
bindSelectedEdgesClick :: R.Ref Sigma -> R.State ST.EdgeIds -> Effect Unit
bindSelectedEdgesClick sigmaRef (_ /\ setEdgeIds) =
dependOnSigma (R.readRef sigmaRef) "[graphCpt] no sigma" $ \sigma -> do
Sigma.bindClickEdge sigma $ \edge -> do
setSelectedEdgeIds \eids ->
setEdgeIds \eids ->
if Set.member edge.id eids then
Set.delete edge.id eids
else
......@@ -230,7 +230,7 @@ performDiff sigma g = do
{add: Tuple addEdges addNodes, remove: Tuple removeEdges removeNodes} = ST.sigmaDiff sigmaEdgeIds sigmaNodeIds g
-- DEPRECATED
markSelectedEdges :: Sigma.Sigma -> ST.SelectedEdgeIds -> ST.EdgesMap -> Effect Unit
markSelectedEdges :: Sigma.Sigma -> ST.EdgeIds -> ST.EdgesMap -> Effect Unit
markSelectedEdges sigma selectedEdgeIds graphEdges = do
Sigma.forEachEdge (Sigma.graph sigma) \e -> do
case Map.lookup e.id graphEdges of
......@@ -245,7 +245,7 @@ markSelectedEdges sigma selectedEdgeIds graphEdges = do
pure unit
Sigma.refresh sigma
markSelectedNodes :: Sigma.Sigma -> ST.SelectedNodeIds -> ST.NodesMap -> Effect Unit
markSelectedNodes :: Sigma.Sigma -> ST.NodeIds -> ST.NodesMap -> Effect Unit
markSelectedNodes sigma selectedNodeIds graphNodes = do
Sigma.forEachNode (Sigma.graph sigma) \n -> do
case Map.lookup n.id graphNodes of
......
......@@ -142,13 +142,13 @@ nodes :: SigmaGraph -> Seq.Seq (Record Types.Node)
nodes = Seq.fromFoldable <<< nodes_
-- | Fetch ids of graph edges in a sigmajs instance.
sigmaEdgeIds :: SigmaGraph -> Types.SelectedEdgeIds
sigmaEdgeIds :: SigmaGraph -> Types.EdgeIds
sigmaEdgeIds sg = Set.fromFoldable edgeIds
where
edgeIds = _.id <$> edges sg
-- | Fetch ids of graph nodes in a sigmajs instance.
sigmaNodeIds :: SigmaGraph -> Types.SelectedNodeIds
sigmaNodeIds :: SigmaGraph -> Types.NodeIds
sigmaNodeIds sg = Set.fromFoldable nodeIds
where
nodeIds = _.id <$> nodes sg
......
......@@ -57,11 +57,16 @@ type Edge =
, weightIdx :: Int
)
type SelectedNodeIds = Set.Set NodeId
type SelectedEdgeIds = Set.Set EdgeId
type NodeIds = Set.Set NodeId
type EdgeIds = Set.Set EdgeId
type EdgesMap = Map.Map String (Record Edge)
type NodesMap = Map.Map String (Record Node)
emptyEdgeIds :: EdgeIds
emptyEdgeIds = Set.empty
emptyNodeIds :: NodeIds
emptyNodeIds = Set.empty
type SGraph = Graph Node Edge
-- Diff graph structure
......@@ -70,7 +75,7 @@ type SGraph = Graph Node Edge
type SigmaDiff =
(
add :: Tuple (Seq.Seq (Record Edge)) (Seq.Seq (Record Node))
, remove :: Tuple SelectedEdgeIds SelectedNodeIds
, remove :: Tuple EdgeIds NodeIds
)
graphEdges :: SGraph -> Seq.Seq (Record Edge)
......@@ -96,7 +101,7 @@ nodesGraphMap graph =
nodesFilter :: (Record Node -> Boolean) -> SGraph -> SGraph
nodesFilter f (Graph {edges, nodes}) = Graph { edges, nodes: Seq.filter f nodes }
nodesById :: SGraph -> SelectedNodeIds -> SGraph
nodesById :: SGraph -> NodeIds -> 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)
......@@ -112,7 +117,7 @@ sub graph (Graph {nodes, edges}) = newGraph
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 :: EdgeIds -> NodeIds -> SGraph -> Record SigmaDiff
sigmaDiff sigmaEdges sigmaNodes g@(Graph {nodes, edges}) = {add, remove}
where
add = Tuple addEdges addNodes
......@@ -133,7 +138,7 @@ neighbours g nodes = Seq.fromFoldable $ Set.unions [Set.fromFoldable nodes, sour
sources = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.source selectedEdges
targets = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.target selectedEdges
neighbouringEdges :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Edge)
neighbouringEdges :: SGraph -> NodeIds -> Seq.Seq (Record Edge)
neighbouringEdges g nodeIds = Seq.filter condition $ graphEdges g
where
condition {source, target} = (Set.member source nodeIds) || (Set.member target nodeIds)
......
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