[graph] fixes to the transformGraph logic

We need to recompute transformGraph, I try to do this intelligently
depending on params change only.

Also, I added preservation of louvain colouring.
parent c78b238e
...@@ -5,6 +5,8 @@ import Gargantext.Prelude hiding (max, min) ...@@ -5,6 +5,8 @@ import Gargantext.Prelude hiding (max, min)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import Data.Array as A import Data.Array as A
import Data.FoldableWithIndex (foldMapWithIndex) import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Hashable as Hashable
import Data.HashSet as HashSet
import Data.Int (floor, toNumber) import Data.Int (floor, toNumber)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
...@@ -292,6 +294,8 @@ graphViewCpt = R.memo' $ here.component "graphView" cpt where ...@@ -292,6 +294,8 @@ graphViewCpt = R.memo' $ here.component "graphView" cpt where
-- here.log2 "[graphView] transformedGraph edges" $ A.fromFoldable e -- here.log2 "[graphView] transformedGraph edges" $ A.fromFoldable e
-- here.log2 "[graphView] hidden edges" $ A.filter(_.hidden) $ A.fromFoldable e -- here.log2 "[graphView] hidden edges" $ A.filter(_.hidden) $ A.fromFoldable e
hooksTransformGraph
-- | Render -- | Render
-- | -- |
pure $ pure $
...@@ -385,6 +389,42 @@ type LiveProps = ( ...@@ -385,6 +389,42 @@ type LiveProps = (
, showEdges' :: SigmaxT.ShowEdgesState , showEdges' :: SigmaxT.ShowEdgesState
) )
hashLiveProps :: Record LiveProps -> Int
hashLiveProps p = Hashable.hash { edgeConfluence': p.edgeConfluence'
, edgeWeight': p.edgeWeight'
, nodeSize: p.nodeSize'
, removedNodeIds': HashSet.fromFoldable p.removedNodeIds'
, selectedNodeIds': HashSet.fromFoldable p.selectedNodeIds'
, showEdges': p.showEdges' }
transformGraphStoreParams :: R.Hooks (Record LiveProps)
transformGraphStoreParams = do
store <- GraphStore.use
edgeConfluence' <- R2.useLive' store.edgeConfluence
edgeWeight' <- R2.useLive' store.edgeWeight
nodeSize' <- R2.useLive' store.nodeSize
removedNodeIds' <- R2.useLive' store.removedNodeIds
selectedNodeIds' <- R2.useLive' store.selectedNodeIds
showEdges' <- R2.useLive' store.showEdges
pure { edgeConfluence'
, edgeWeight'
, nodeSize'
, removedNodeIds'
, selectedNodeIds'
, showEdges' }
hooksTransformGraph :: R.Hooks Unit
hooksTransformGraph = do
store <- GraphStore.use
params <- transformGraphStoreParams
graph' <- R2.useLive' store.graph
R.useEffect2' (hashLiveProps params) graph' $ do
T.write_ (transformGraph graph' params) store.transformedGraph
transformGraph :: SigmaxT.SGraph -> Record LiveProps -> SigmaxT.SGraph transformGraph :: SigmaxT.SGraph -> Record LiveProps -> SigmaxT.SGraph
transformGraph graph { edgeConfluence' transformGraph graph { edgeConfluence'
, edgeWeight' , edgeWeight'
......
...@@ -180,7 +180,7 @@ docListCpt = here.component "main" cpt where ...@@ -180,7 +180,7 @@ docListCpt = here.component "main" cpt where
-- (on fetch success, extract existing docs) -- (on fetch success, extract existing docs)
useUpdateEffect1' state' do useUpdateEffect1' state' do
here.log2 "[docList] state'" state' -- here.log2 "[docList] state'" state'
case state' of case state' of
Nothing -> T.write_ (Just Seq.empty) rows Nothing -> T.write_ (Just Seq.empty) rows
Just r -> case r of Just r -> case r of
......
...@@ -16,8 +16,10 @@ import Data.Array as A ...@@ -16,8 +16,10 @@ import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Foldable (intercalate) import Data.Foldable (intercalate)
import Data.Formatter.DateTime as DFDT import Data.Formatter.DateTime as DFDT
import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Tuple (Tuple(..))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
...@@ -182,6 +184,10 @@ louvainButtonCpt = here.component "louvainButton" cpt ...@@ -182,6 +184,10 @@ louvainButtonCpt = here.component "louvainButton" cpt
newGraph <- Louvain.assignVisible (Sigma.graph sigma) {} newGraph <- Louvain.assignVisible (Sigma.graph sigma) {}
let cluster = Louvain.cluster newGraph :: DLouvain.LouvainCluster let cluster = Louvain.cluster newGraph :: DLouvain.LouvainCluster
let lgraph = SigmaxTypes.louvainGraph graph' cluster :: SigmaxTypes.SGraph let lgraph = SigmaxTypes.louvainGraph graph' cluster :: SigmaxTypes.SGraph
T.modify_ (SigmaxTypes.updateColors
(Map.fromFoldable $ (\{ id, color } -> Tuple id color) <$> SigmaxTypes.graphNodes
lgraph))
graph
T.write_ lgraph transformedGraph T.write_ lgraph transformedGraph
pure unit pure unit
......
...@@ -104,7 +104,7 @@ controlsCpt = R.memo' $ here.component "controls" cpt where ...@@ -104,7 +104,7 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
R.useEffect' $ Sigmax.handleForceAtlas2Pause fa2Ref forceAtlasState mFAPauseRef Graph.forceAtlas2Settings R.useEffect' $ Sigmax.handleForceAtlas2Pause fa2Ref forceAtlasState mFAPauseRef Graph.forceAtlas2Settings
R.useEffect' do R.useEffect' do
here.log2 "[controls] noverlapState'" noverlapState' -- here.log2 "[controls] noverlapState'" noverlapState'
case R.readRef noverlapRef of case R.readRef noverlapRef of
Nothing -> pure unit Nothing -> pure unit
Just noverlap -> do Just noverlap -> do
......
...@@ -4,7 +4,7 @@ import DOM.Simple.Types (Element) ...@@ -4,7 +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.Hashable (class 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)
...@@ -15,7 +15,7 @@ import Data.Tuple (Tuple(..)) ...@@ -15,7 +15,7 @@ import Data.Tuple (Tuple(..))
import Effect (Effect) import Effect (Effect)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), (<), mod, not, pure) import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), (<), mod, not, pure)
import Record.Unsafe (unsafeGet) import Record.Unsafe (unsafeGet, unsafeSet)
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
...@@ -52,11 +52,12 @@ type NodeId = String ...@@ -52,11 +52,12 @@ type NodeId = String
type EdgeId = String type EdgeId = String
type Label = String type Label = String
type Color = String
type Node = ( type Node = (
borderColor :: String borderColor :: Color
, children :: Array String , children :: Array String
, color :: String , color :: Color
, community :: Int -- this is filled in by the communities-louvain graphology plugin , community :: Int -- this is filled in by the communities-louvain graphology plugin
, equilateral :: { numPoints :: Int } , equilateral :: { numPoints :: Int }
, gargType :: GT.Mode , gargType :: GT.Mode
...@@ -72,7 +73,7 @@ type Node = ( ...@@ -72,7 +73,7 @@ type Node = (
) )
type Edge = ( type Edge = (
color :: String color :: Color
, confluence :: Number , confluence :: Number
, id :: EdgeId , id :: EdgeId
, hidden :: Boolean , hidden :: Boolean
...@@ -93,11 +94,12 @@ type NodesMap = Map.Map String (Record Node) ...@@ -93,11 +94,12 @@ type NodesMap = Map.Map String (Record Node)
type HashableNodeFields = type HashableNodeFields =
( id :: NodeId ( id :: NodeId
, borderColor :: String , borderColor :: Color
, color :: String , color :: Color
, equilateral :: { numPoints :: Int } , equilateral :: { numPoints :: Int }
, hidden :: Boolean , hidden :: Boolean
, highlighted :: Boolean ) , highlighted :: Boolean
, type :: String )
hashNode :: forall n. GT.Optional HashableNodeFields n => {|n} -> Int hashNode :: forall n. GT.Optional HashableNodeFields n => {|n} -> Int
hashNode n = hash rec hashNode n = hash rec
...@@ -107,18 +109,14 @@ hashNode n = hash rec ...@@ -107,18 +109,14 @@ hashNode n = hash rec
, color : unsafeGet "color" n , color : unsafeGet "color" n
, equilateral : unsafeGet "equilateral" n , equilateral : unsafeGet "equilateral" n
, hidden : unsafeGet "hidden" n , hidden : unsafeGet "hidden" n
, highlighted : unsafeGet "highlighted" n } :: Record HashableNodeFields , highlighted : unsafeGet "highlighted" n
, type : unsafeGet "type" 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 :: forall n. GT.Optional HashableNodeFields n => {|n} -> {|n} -> Boolean
compareNodes n1 n2 = n1.id == n2.id && compareNodes n1 n2 = hashNode n1 == hashNode n2
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`) -- TODO For edges, see `Sigmax.updateEdges` (`color` and `hidden`)
type HashableEdgeFields = type HashableEdgeFields =
...@@ -144,6 +142,18 @@ emptyNodeIds = Set.empty ...@@ -144,6 +142,18 @@ emptyNodeIds = Set.empty
type SGraph = Graph Node Edge type SGraph = Graph Node Edge
type NodeWithColor =
( color :: String
, id :: NodeId )
-- | Return a graph where node colors are taken from the first one and
-- | the rest is taken from second graph.
updateColors :: forall n e. GT.Optional NodeWithColor n => Map.Map NodeId Color -> Graph n e -> Graph n e
updateColors colorMap (Graph { nodes, edges }) = Graph { nodes: Seq.map updateColor nodes, edges }
where
updateColor n = case Map.lookup (unsafeGet "id" n) colorMap of
Nothing -> n
Just c -> unsafeSet "color" c n
-- 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
...@@ -258,6 +268,10 @@ instance Eq ShowEdgesState where ...@@ -258,6 +268,10 @@ instance Eq ShowEdgesState where
eq = genericEq eq = genericEq
instance Show ShowEdgesState where instance Show ShowEdgesState where
show = genericShow show = genericShow
instance Hashable ShowEdgesState where
hash EShow = 0
hash EHide = 1
hash ETempHiddenThenShow = 2
-- | Whether the edges are hidden now (temp or "stable"). -- | Whether the edges are hidden now (temp or "stable").
edgeStateHidden :: ShowEdgesState -> Boolean edgeStateHidden :: ShowEdgesState -> Boolean
......
module Gargantext.Utils.Range where module Gargantext.Utils.Range where
import Prelude hiding (clamp) import Data.Hashable (class Hashable, hash)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Prelude hiding (clamp)
class Range r v where class Range r v where
clamp :: r -> v -> v clamp :: r -> v -> v
...@@ -9,15 +10,14 @@ class Range r v where ...@@ -9,15 +10,14 @@ class Range r v where
-- | A Closed Interval, in math speak -- | A Closed Interval, in math speak
newtype Closed t = Closed { min :: t, max :: t } newtype Closed t = Closed { min :: t, max :: t }
derive instance Newtype (Closed t) _ derive instance Newtype (Closed t) _
instance Ord t => Range (Closed t) t where instance Ord t => Range (Closed t) t where
clamp (Closed r) = max r.min <<< min r.max clamp (Closed r) = max r.min <<< min r.max
within (Closed r) v = (r.min <= v) && (v <= r.max) within (Closed r) v = (r.min <= v) && (v <= r.max)
instance Eq t => Eq (Closed t) where instance Eq t => Eq (Closed t) where
eq (Closed r1) (Closed r2) = (r1.min == r2.min) && (r1.max == r2.max) eq (Closed r1) (Closed r2) = (r1.min == r2.min) && (r1.max == r2.max)
instance Hashable t => Hashable (Closed t) where
hash (Closed { min, max }) = hash { min, max }
type NumberRange = Closed Number type NumberRange = Closed Number
......
module Gargantext.Utils.Set where module Gargantext.Utils.Set where
import Data.Array as A
import Data.Hashable (class Hashable, hash)
import Data.Ord (class Ord) import Data.Ord (class Ord)
import Data.Set as Set import Data.Set as Set
import Prelude (($))
-- instance (Hashable a, Ord a) => Hashable (Set.Set a) where
-- hash s = hash $ A.sort $ A.fromFoldable s
-- | If `a` is in Set, remove it, otherwise add it -- | If `a` is in Set, remove it, otherwise add it
toggle :: forall a. Ord a => Set.Set a -> a -> Set.Set a toggle :: forall a. Ord a => Set.Set a -> a -> Set.Set a
toggle s x = if Set.member x s then Set.delete x s else Set.insert x s toggle s x = if Set.member x s then Set.delete x s else Set.insert x s
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