Commit 20e560a7 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[sigma] highlighting of nodes works now

parent 3b72b59b
Pipeline #3226 failed with stage
in 0 seconds
......@@ -265,10 +265,10 @@ graphViewCpt = R.memo' $ here.component "graphView" cpt where
, selectedNodeIds'
, showEdges' }
R.useEffect' $ do
here.log2 "[graphView] selectedNodeIds'" $ A.fromFoldable selectedNodeIds'
let (SigmaxT.Graph { nodes: n }) = transformedGraph
here.log2 "[graphView] transformedGraph nodes" $ A.fromFoldable n
-- R.useEffect' $ do
-- here.log2 "[graphView] selectedNodeIds'" $ A.fromFoldable selectedNodeIds'
-- let (SigmaxT.Graph { nodes: n }) = transformedGraph
-- here.log2 "[graphView] transformedGraph nodes" $ A.fromFoldable n
-- | Render
-- |
......
......@@ -120,8 +120,8 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
}
pure unit
newGraph <- Graphology.graphFromSigmaxGraph graph'
Sigmax.refreshData sig newGraph
--newGraph <- Graphology.graphFromSigmaxGraph graph'
--gmax.refreshData sig newGraph
Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do
-- bind the click event only initially, when ref was empty
......@@ -156,9 +156,10 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
Sigma.updateCamera sig { ratio: 1.1, x: 0.0, y: 0.0 }
-- Reload Sigma on Theme changes
_ <- flip T.listen boxes.theme \{ old, new } ->
if (eq old new) then pure unit
else Sigma.proxySetSettings window sig $ sigmaSettings new
-- TODO
-- _ <- flip T.listen boxes.theme \{ old, new } ->
-- if (eq old new) then pure unit
-- else Sigma.proxySetSettings window sig $ sigmaSettings new
pure unit
Just _sig -> do
......
......@@ -10,14 +10,16 @@ module Gargantext.Components.GraphExplorer.Toolbar.Buttons
import Prelude
import DOM.Simple.Console (log2)
import Data.Array as A
import Data.DateTime as DDT
import Data.DateTime.Instant as DDI
import Data.Either (Either(..))
import Data.Enum (fromEnum)
import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.String as DS
import DOM.Simple.Console (log2)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Effect.Now as EN
......@@ -30,6 +32,7 @@ import Gargantext.Components.GraphExplorer.Resources as Graph
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Graphology as Graphology
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Sessions (Session)
......@@ -88,10 +91,11 @@ cameraButton { id
, show $ fromEnum $ DDT.hour nowt
, show $ fromEnum $ DDT.minute nowt
, show $ fromEnum $ DDT.second nowt ]
edges <- Sigma.getEdges s
nodes <- Sigma.getNodes s
let graphData = GET.GraphData $ hyperdataGraph { edges = map GEU.stEdgeToGET edges
, nodes = GEU.normalizeNodes $ map GEU.stNodeToGET nodes }
let graph = Sigma.graph s
edges = Graphology.edges graph
nodes = Graphology.nodes graph
graphData = GET.GraphData $ hyperdataGraph { edges = A.fromFoldable $ Seq.map GEU.stEdgeToGET edges
, nodes = A.fromFoldable $ GEU.normalizeNodes $ Seq.map GEU.stNodeToGET nodes }
let cameras = map Sigma.toCamera $ Sigma.cameras s
let camera = case cameras of
[c] -> GET.Camera { ratio: c.ratio, x: c.x, y: c.y }
......
......@@ -7,12 +7,14 @@ module Gargantext.Components.GraphExplorer.Utils
import Gargantext.Prelude
import Data.Array as A
import Data.Foldable (maximum, minimum)
import Data.Maybe (Maybe(..))
import Data.Newtype (wrap)
import Data.Sequence as Seq
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils (getter)
import Gargantext.Utils.Array as GUA
import Gargantext.Utils.Seq as GUS
stEdgeToGET :: Record ST.Edge -> GET.Edge
stEdgeToGET { _original } = _original
......@@ -31,15 +33,15 @@ stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } }
-----------------------------------------------------------------------
normalizeNodes :: Array GET.Node -> Array GET.Node
normalizeNodes ns = map normalizeNode ns
normalizeNodes :: Seq.Seq GET.Node -> Seq.Seq GET.Node
normalizeNodes ns = Seq.map normalizeNode ns
where
xs = map (\(GET.Node { x }) -> x) ns
ys = map (\(GET.Node { y }) -> y) ns
mMinx = GUA.min xs
mMaxx = GUA.max xs
mMiny = GUA.min ys
mMaxy = GUA.max ys
mMinx = minimum xs
mMaxx = maximum xs
mMiny = minimum ys
mMaxy = maximum ys
mXrange = do
minx <- mMinx
maxx <- mMaxx
......
......@@ -25,7 +25,7 @@ import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils.Console as C
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Set as GSet
import Prelude (Unit, bind, discard, flip, map, not, pure, unit, ($), (&&), (*>), (<<<), (<>), (>>=), (+), (>), negate)
import Prelude (Unit, bind, discard, flip, map, not, pure, unit, ($), (&&), (*>), (<<<), (<>), (>>=), (+), (>), negate, (/=), (==), (<$>))
import Reactix as R
import Toestand as T
......@@ -229,64 +229,87 @@ performDiff sigma g = do
traverse_ (Graphology.addEdge sigmaGraph) addEdges
traverse_ (Graphology.removeEdge sigmaGraph) removeEdges
traverse_ (Graphology.removeNode sigmaGraph) removeNodes
Sigma.refresh sigma
traverse_ (Graphology.updateEdge sigmaGraph) updateEdges
traverse_ (Graphology.updateNode sigmaGraph) updateNodes
--Sigma.refresh sigma
-- TODO Use FA2Layout here
--Sigma.killForceAtlas2 sigma
where
sigmaGraph = Sigma.graph sigma
{add: Tuple addEdges addNodes, remove: Tuple removeEdges removeNodes} = sigmaDiff sigmaGraph g
{ add: Tuple addEdges addNodes
, remove: Tuple removeEdges removeNodes
, update: Tuple updateEdges updateNodes } = sigmaDiff sigmaGraph g
-- | Compute a diff between current sigma graph and whatever is set via custom controls
sigmaDiff :: Graphology.Graph -> ST.Graph -> Record ST.SigmaDiff
sigmaDiff graph g@(ST.Graph {nodes, edges}) = {add, remove, update}
sigmaDiff :: Graphology.Graph -> ST.SGraph -> Record ST.SigmaDiff
sigmaDiff sigmaGraph gControls = { add, remove, update }
where
add = Tuple addEdges addNodes
remove = Tuple removeEdges removeNodes
-- TODO
update = Tuple Seq.empty Seq.empty
update = Tuple updateEdges updateNodes
addG = ST.edgesFilter (\e -> not (Set.member e.id sigmaEdgeIds)) $
ST.nodesFilter (\n -> not (Set.member n.id sigmaNodeIds)) g
addEdges = ST.graphEdges addG
addNodes = ST.graphNodes addG
sigmaNodes = Graphology.nodes sigmaGraph
sigmaEdges = Graphology.edges sigmaGraph
sigmaNodeIds = Set.fromFoldable $ Seq.map _.id sigmaNodes
sigmaEdgeIds = Set.fromFoldable $ Seq.map _.id sigmaEdges
removeEdges = Set.difference sigmaEdgeIds (Set.fromFoldable $ Seq.map _.id edges)
removeNodes = Set.difference sigmaNodeIds (Set.fromFoldable $ Seq.map _.id nodes)
gcNodes = ST.graphNodes gControls
gcEdges = ST.graphEdges gControls
gcNodeIds = Seq.map _.id gcNodes
gcEdgeIds = Seq.map _.id gcEdges
sigmaNodeIds = Graphology.nodeIds graph
sigmaEdgeIds = Graphology.edgeIds graph
-- Add nodes/edges which aren't present in `sigmaGraph`, but are
-- in `gControls`
addGC = ST.edgesFilter (\e -> not (Set.member e.id sigmaEdgeIds)) $
ST.nodesFilter (\n -> not (Set.member n.id sigmaNodeIds)) gControls
addEdges = ST.graphEdges addGC
addNodes = ST.graphNodes addGC
-- DEPRECATED
-- Remove nodes/edges from `sigmaGraph` which aren't in
-- `gControls`
removeEdges = Set.difference sigmaEdgeIds (Set.fromFoldable gcEdgeIds)
removeNodes = Set.difference sigmaNodeIds (Set.fromFoldable gcNodeIds)
markSelectedEdges :: Sigma.Sigma -> ST.EdgeIds -> ST.EdgesMap -> Effect Unit
markSelectedEdges sigma selectedEdgeIds graphEdges = do
Graphology.forEachEdge (Sigma.graph sigma) \e -> do
case Map.lookup e.id graphEdges of
Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map"
Just {color} -> do
let newColor =
if Set.member e.id selectedEdgeIds then
"#ff0000"
else
color
_ <- pure $ (e .= "color") newColor
pure unit
Sigma.refresh sigma
commonNodeIds = Set.intersection sigmaNodeIds $ Set.fromFoldable gcNodeIds
commonEdgeIds = Set.intersection sigmaEdgeIds $ Set.fromFoldable gcEdgeIds
sigmaNodeIdsMap = Map.fromFoldable $ Seq.map (\n -> Tuple n.id n) sigmaNodes
sigmaEdgeIdsMap = Map.fromFoldable $ Seq.map (\e -> Tuple e.id e) sigmaEdges
updateEdges = Seq.filter (\e -> Just e /= Map.lookup e.id sigmaEdgeIdsMap) gcEdges
-- Find nodes for which `ST.compareNodes` returns `false`, i.e. nodes differ
updateNodes = Seq.filter (\n -> (ST.compareNodes n <$> (Map.lookup n.id sigmaNodeIdsMap)) == Just false) gcNodes
markSelectedNodes :: Sigma.Sigma -> ST.NodeIds -> ST.NodesMap -> Effect Unit
markSelectedNodes sigma selectedNodeIds graphNodes = do
Graphology.forEachNode (Sigma.graph sigma) \n -> do
case Map.lookup n.id graphNodes of
Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map"
Just {color} -> do
let newColor =
if Set.member n.id selectedNodeIds then
"#ff0000"
else
color
_ <- pure $ (n .= "color") newColor
pure unit
Sigma.refresh sigma
-- DEPRECATED
-- markSelectedEdges :: Sigma.Sigma -> ST.EdgeIds -> ST.EdgesMap -> Effect Unit
-- markSelectedEdges sigma selectedEdgeIds graphEdges = do
-- Graphology.forEachEdge (Sigma.graph sigma) \e -> do
-- case Map.lookup e.id graphEdges of
-- Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map"
-- Just {color} -> do
-- let newColor =
-- if Set.member e.id selectedEdgeIds then
-- "#ff0000"
-- else
-- color
-- _ <- pure $ (e .= "color") newColor
-- pure unit
-- Sigma.refresh sigma
-- markSelectedNodes :: Sigma.Sigma -> ST.NodeIds -> ST.NodesMap -> Effect Unit
-- markSelectedNodes sigma selectedNodeIds graphNodes = do
-- Graphology.forEachNode (Sigma.graph sigma) \n -> do
-- case Map.lookup n.id graphNodes of
-- Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map"
-- Just {color} -> do
-- let newColor =
-- if Set.member n.id selectedNodeIds then
-- "#ff0000"
-- else
-- color
-- _ <- pure $ (n .= "color") newColor
-- pure unit
-- Sigma.refresh sigma
......@@ -10,6 +10,10 @@ export function _addNode(g, name, n) {
return g.addNode(name, n);
}
export function _updateNode(g, name, updater) {
return g.updateNode(name, updater);
}
export function _addEdge(g, source, target, e) {
return g.addEdge(source, target, e);
}
......
......@@ -23,7 +23,9 @@ foreign import data Graph :: Type
foreign import _newGraph :: EffectFn1 Unit Graph
foreign import _addNode :: EffectFn3 Graph String (Record Types.Node) String
foreign import _updateNode :: EffectFn3 Graph String (Record Types.Node -> Record Types.Node) Unit
foreign import _addEdge :: EffectFn4 Graph String String (Record Types.Edge) String
--foreign import _updateEdge :: EffectFn4 Graph String String (Record Types.Edge) String
foreign import _mapNodes :: forall a. Fn2 Graph (Record Types.Node -> a) (Array a)
foreign import _forEachEdge :: EffectFn2 Graph (Record Types.Edge -> Effect Unit) Unit
foreign import _mapEdges :: forall a. Fn2 Graph (Record Types.Edge -> a) (Array a)
......@@ -45,6 +47,11 @@ addNode :: Graph -> Record Types.Node -> Effect String
addNode g node@{ id } = runEffectFn3 _addNode g id node
removeNode :: Graph -> String -> Effect Unit
removeNode g nId = pure $ g ... "dropNode" $ [nId]
updateNode :: Graph -> Record Types.Node -> Effect Unit
-- | See Types.compareNodes
updateNode g node@{ id, hidden, highlighted } =
runEffectFn3 _updateNode g id (\n -> n { hidden = hidden
, highlighted = highlighted })
forEachNode :: Graph -> (Record Types.Node -> Effect Unit) -> Effect Unit
-- TODO Check this: how does FFI translate function of two arguments
-- into PS \x y ?
......@@ -56,6 +63,9 @@ addEdge :: Graph -> Record Types.Edge -> Effect String
addEdge g edge@{ source, target } = runEffectFn4 _addEdge g source target edge
removeEdge :: Graph -> String -> Effect Unit
removeEdge g eId = pure $ g ... "dropEdge" $ [eId]
updateEdge :: Graph -> Record Types.Edge -> Effect Unit
updateEdge _ _ = pure unit -- TODO
--updateEdge g edge@{ source, target } = runEffectFn4 _updateEdge g source target edge
forEachEdge :: Graph -> (Record Types.Edge -> Effect Unit) -> Effect Unit
forEachEdge = runEffectFn2 _forEachEdge
--forEachEdge g fn = pure $ g ... "forEachEdge" $ [\_ e -> fn e]
......
......@@ -203,14 +203,6 @@ function _takeScreenshot(sigma) {
return edges.toDataURL('image/png');
}
function _getEdges(sigma) {
return sigma.graph.edges();
}
function _getNodes(sigma) {
return sigma.graph.nodes();
}
function _proxySetSettings(window, sigma, settings) {
var id = sigma.id;
......@@ -235,8 +227,6 @@ export { _sigma,
dummy as _bindMouseSelectorPlugin,
_on,
_takeScreenshot,
_getEdges,
_getNodes,
_proxySetSettings,
_setSettings,
_refresh };
......@@ -5,6 +5,7 @@ import Prelude
import DOM.Simple.Types (Element, Window)
import Data.Array as A
import Data.Either (Either(..))
import Data.Function.Uncurried (Fn1, runFn1)
import Data.Maybe (Maybe)
import Data.Traversable (traverse_)
import Effect (Effect)
......@@ -232,12 +233,6 @@ goToAllCameras s props = traverse_ (goTo props) $ cameras s
takeScreenshot :: Sigma -> Effect String
takeScreenshot = runEffectFn1 _takeScreenshot
getEdges :: Sigma -> Effect (Array (Record Types.Edge))
getEdges = runEffectFn1 _getEdges
getNodes :: Sigma -> Effect (Array (Record Types.Node))
getNodes = runEffectFn1 _getNodes
-- | FFI
foreign import _sigma ::
forall a b opts err.
......@@ -261,8 +256,6 @@ foreign import _bindMouseSelectorPlugin
(Either err Unit)
foreign import _on :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
foreign import _takeScreenshot :: EffectFn1 Sigma String
foreign import _getEdges :: EffectFn1 Sigma (Array (Record Types.Edge))
foreign import _getNodes :: EffectFn1 Sigma (Array (Record Types.Node))
foreign import _proxySetSettings
:: forall settings.
EffectFn3 Window
......
......@@ -70,6 +70,12 @@ type EdgeIds = Set.Set EdgeId
type EdgesMap = Map.Map String (Record Edge)
type NodesMap = Map.Map String (Record Node)
-- | When comparing nodes, we don't want to compare all fields. Only
-- | some are relevant (when updating sigma graph).
compareNodes :: Record Node -> Record Node -> Boolean
compareNodes n1 n2 = n1.hidden == n2.hidden &&
n1.highlighted == n2.highlighted
emptyEdgeIds :: EdgeIds
emptyEdgeIds = Set.empty
emptyNodeIds :: NodeIds
......
module Gargantext.Utils.Array (
max
, min
, push
push
, range) where
import Data.Array as A
import Data.Foldable (foldr)
import Data.Int as DI
import Data.Maybe (Maybe(..))
import Data.Ord as Ord
import Effect (Effect)
import Effect.Uncurried (EffectFn2, runEffectFn2)
......@@ -20,18 +15,6 @@ push :: forall a. Array a -> a -> Effect Unit
push = runEffectFn2 _push
max :: forall a. Ord a => Array a -> Maybe a
max xs = foldr reducer (A.head xs) xs
where
reducer _ Nothing = Nothing
reducer v (Just acc) = Just $ Ord.max acc v
min :: forall a. Ord a => Array a -> Maybe a
min xs = foldr reducer (A.head xs) xs
where
reducer _ Nothing = Nothing
reducer v (Just acc) = Just $ Ord.min acc v
-- | Create an array containing a range of integers, with given step
range :: Int -> Int -> Int -> Array Int
range start end step = map (\i -> start + i*step) $ A.range 0 end'
......
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