[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
Pipeline #3636 failed with stage
in 0 seconds
......@@ -5,6 +5,8 @@ import Gargantext.Prelude hiding (max, min)
import DOM.Simple.Types (Element)
import Data.Array as A
import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Hashable as Hashable
import Data.HashSet as HashSet
import Data.Int (floor, toNumber)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
......@@ -292,6 +294,8 @@ graphViewCpt = R.memo' $ here.component "graphView" cpt where
-- here.log2 "[graphView] transformedGraph edges" $ A.fromFoldable e
-- here.log2 "[graphView] hidden edges" $ A.filter(_.hidden) $ A.fromFoldable e
hooksTransformGraph
-- | Render
-- |
pure $
......@@ -385,6 +389,42 @@ type LiveProps = (
, 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 graph { edgeConfluence'
, edgeWeight'
......
......@@ -180,7 +180,7 @@ docListCpt = here.component "main" cpt where
-- (on fetch success, extract existing docs)
useUpdateEffect1' state' do
here.log2 "[docList] state'" state'
-- here.log2 "[docList] state'" state'
case state' of
Nothing -> T.write_ (Just Seq.empty) rows
Just r -> case r of
......
......@@ -16,8 +16,10 @@ import Data.Array as A
import Data.Either (Either(..))
import Data.Foldable (intercalate)
import Data.Formatter.DateTime as DFDT
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
......@@ -182,6 +184,10 @@ louvainButtonCpt = here.component "louvainButton" cpt
newGraph <- Louvain.assignVisible (Sigma.graph sigma) {}
let cluster = Louvain.cluster newGraph :: DLouvain.LouvainCluster
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
pure unit
......
......@@ -104,7 +104,7 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
R.useEffect' $ Sigmax.handleForceAtlas2Pause fa2Ref forceAtlasState mFAPauseRef Graph.forceAtlas2Settings
R.useEffect' do
here.log2 "[controls] noverlapState'" noverlapState'
-- here.log2 "[controls] noverlapState'" noverlapState'
case R.readRef noverlapRef of
Nothing -> pure unit
Just noverlap -> do
......
......@@ -4,7 +4,7 @@ import DOM.Simple.Types (Element)
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Hashable (hash)
import Data.Hashable (class Hashable, hash)
import Data.Show.Generic (genericShow)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
......@@ -15,7 +15,7 @@ import Data.Tuple (Tuple(..))
import Effect (Effect)
import Partial.Unsafe (unsafePartial)
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.GraphExplorer.GraphTypes as GEGT
......@@ -52,11 +52,12 @@ type NodeId = String
type EdgeId = String
type Label = String
type Color = String
type Node = (
borderColor :: String
borderColor :: Color
, children :: Array String
, color :: String
, color :: Color
, community :: Int -- this is filled in by the communities-louvain graphology plugin
, equilateral :: { numPoints :: Int }
, gargType :: GT.Mode
......@@ -72,7 +73,7 @@ type Node = (
)
type Edge = (
color :: String
color :: Color
, confluence :: Number
, id :: EdgeId
, hidden :: Boolean
......@@ -93,11 +94,12 @@ type NodesMap = Map.Map String (Record Node)
type HashableNodeFields =
( id :: NodeId
, borderColor :: String
, color :: String
, borderColor :: Color
, color :: Color
, equilateral :: { numPoints :: Int }
, hidden :: Boolean
, highlighted :: Boolean )
, highlighted :: Boolean
, type :: String )
hashNode :: forall n. GT.Optional HashableNodeFields n => {|n} -> Int
hashNode n = hash rec
......@@ -107,18 +109,14 @@ hashNode n = hash rec
, color : unsafeGet "color" n
, equilateral : unsafeGet "equilateral" 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
-- | some are relevant (when updating sigma graph).
-- NOTE For some reason, `Graphology.updateNode` throws error if `type` is set
compareNodes :: Record Node -> Record Node -> Boolean
compareNodes n1 n2 = n1.id == n2.id &&
n1.borderColor == n2.borderColor &&
n1.color == n2.color &&
n1.equilateral == n2.equilateral &&
n1.hidden == n2.hidden &&
n1.highlighted == n2.highlighted
compareNodes :: forall n. GT.Optional HashableNodeFields n => {|n} -> {|n} -> Boolean
compareNodes n1 n2 = hashNode n1 == hashNode n2
-- TODO For edges, see `Sigmax.updateEdges` (`color` and `hidden`)
type HashableEdgeFields =
......@@ -144,6 +142,18 @@ emptyNodeIds = Set.empty
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
-- NOTE: "add" is NOT a graph. There can be edges which join nodes that are not
......@@ -258,6 +268,10 @@ instance Eq ShowEdgesState where
eq = genericEq
instance Show ShowEdgesState where
show = genericShow
instance Hashable ShowEdgesState where
hash EShow = 0
hash EHide = 1
hash ETempHiddenThenShow = 2
-- | Whether the edges are hidden now (temp or "stable").
edgeStateHidden :: ShowEdgesState -> Boolean
......
module Gargantext.Utils.Range where
import Prelude hiding (clamp)
import Data.Hashable (class Hashable, hash)
import Data.Newtype (class Newtype)
import Prelude hiding (clamp)
class Range r v where
clamp :: r -> v -> v
......@@ -9,15 +10,14 @@ class Range r v where
-- | A Closed Interval, in math speak
newtype Closed t = Closed { min :: t, max :: t }
derive instance Newtype (Closed t) _
instance Ord t => Range (Closed t) t where
clamp (Closed r) = max r.min <<< min r.max
within (Closed r) v = (r.min <= v) && (v <= r.max)
instance Eq t => Eq (Closed t) where
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
......
module Gargantext.Utils.Set where
import Data.Array as A
import Data.Hashable (class Hashable, hash)
import Data.Ord (class Ord)
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
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
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