[louvain] experimental graphology louvain plugin usage

parent 8d73c0c4
......@@ -362,7 +362,7 @@ nodeSpanCpt = here.component "nodeSpan" cpt
R2.when isSelected $
H.div
{ class: "mainleaf-selection-indicator" }
{ className: "mainleaf-selection-indicator" }
[]
]
......
......@@ -11,6 +11,7 @@ import Data.Maybe (Maybe(..), fromJust)
import Data.Nullable (null, Nullable)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Gargantext.Components.App.Store as AppStore
......@@ -26,11 +27,14 @@ import Gargantext.Components.GraphExplorer.Types (GraphSideDoc)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Config (defaultFrontends)
import Gargantext.Data.Louvain as Louvain
import Gargantext.Data.Louvain as DLouvain
import Gargantext.Hooks.Session (useSession)
import Gargantext.Hooks.Sigmax.ForceAtlas2 as ForceAtlas
import Gargantext.Hooks.Sigmax.Graphology as Graphology
import Gargantext.Hooks.Sigmax.Louvain as Louvain
import Gargantext.Hooks.Sigmax.Noverlap as Noverlap
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as SigmaxS
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Types as GT
import Gargantext.Types as Types
......@@ -241,7 +245,6 @@ graphViewCpt = R.memo' $ here.component "graphView" cpt where
, removedNodeIds
, selectedNodeIds
, showEdges
, showLouvain
, graph
} <- GraphStore.use
......@@ -251,27 +254,39 @@ graphViewCpt = R.memo' $ here.component "graphView" cpt where
removedNodeIds' <- R2.useLive' removedNodeIds
selectedNodeIds' <- R2.useLive' selectedNodeIds
showEdges' <- R2.useLive' showEdges
showLouvain' <- R2.useLive' showLouvain
graph' <- R2.useLive' graph
-- | Computed
-- |
-- TODO Cache this?
let louvainGraph =
if showLouvain' then
let louvain = Louvain.louvain unit in
let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph') (SigmaxT.louvainEdges graph') in
SigmaxT.louvainGraph graph' cluster
else
graph'
let transformedGraph = transformGraph louvainGraph { edgeConfluence'
, edgeWeight'
, nodeSize'
, removedNodeIds'
, selectedNodeIds'
, showEdges' }
let transformParams = { edgeConfluence'
, edgeWeight'
, nodeSize'
, removedNodeIds'
, selectedNodeIds'
, showEdges' }
-- let transformedGraph = transformGraph graph' transformParams
transformedGraphS <- T.useBox $ transformGraph graph' transformParams
-- todo Cache this?
R.useEffect' $ do
--let louvain = Louvain.louvain unit in
--let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph') (SigmaxT.louvainEdges graph') in
--SigmaxT.louvainGraph graph' cluster
Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphView (louvainGraph)] no sigma" $ \sigma -> do
newGraph <- Louvain.assignVisible (SigmaxS.graph sigma) {}
-- here.log2 "[graphView] newGraph" newGraph
-- here.log2 "[graphView] nodes" $ A.fromFoldable $ Graphology.nodes newGraph
let cluster = Louvain.cluster newGraph :: DLouvain.LouvainCluster
let lgraph = SigmaxT.louvainGraph graph' cluster :: SigmaxT.SGraph
--T.write_ (transformGraph lgraph transformParams) transformedGraphS
-- apply colors
-- traverse_ (\{ id, color } ->
-- Graphology.mergeNodeAttributes (SigmaxS.graph sigma) id { color }
-- ) (SigmaxT.graphNodes lgraph)
T.write_ lgraph transformedGraphS
transformedGraph <- R2.useLive' transformedGraphS
-- R.useEffect' $ do
-- let (SigmaxT.Graph { edges: e }) = transformedGraph
......@@ -303,10 +318,12 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
nodes = foldMapWithIndex nodeFn normalizedNodes
nodeFn :: Int -> GEGT.Node -> Seq.Seq (Record SigmaxT.Node)
nodeFn _i nn@(GEGT.Node n) =
let (GEGT.Cluster { clustDefault }) = n.attributes in
Seq.singleton {
borderColor: color
, children: n.children
, color : color
, community : clustDefault -- for the communities-louvain graphology plugin
, equilateral: { numPoints: 3 }
, gargType
, hidden : false
......
......@@ -50,7 +50,7 @@ type Store =
, nodeSize :: T.Box Range.NumberRange
, nodeSizeRange :: T.Box Range.NumberRange
, showEdges :: T.Box SigmaxT.ShowEdgesState
, showLouvain :: T.Box Boolean
--, showLouvain :: T.Box Boolean
, labelSize :: T.Box Number
, labelRenderedSizeThreshold :: T.Box Number
, mouseSelectorSize :: T.Box Number
......@@ -84,7 +84,7 @@ type State =
, nodeSize :: Range.NumberRange
, nodeSizeRange :: Range.NumberRange
, showEdges :: SigmaxT.ShowEdgesState
, showLouvain :: Boolean
--, showLouvain :: Boolean
, labelSize :: Number
, labelRenderedSizeThreshold :: Number
, mouseSelectorSize :: Number
......@@ -110,7 +110,7 @@ options ::
, edgeConfluence :: Range.NumberRange
, graphStage :: GET.Stage
, nodeSize :: Range.NumberRange
, showLouvain :: Boolean
--, showLouvain :: Boolean
, showEdges :: SigmaxT.ShowEdgesState
-- Terms update
, removedNodeIds :: SigmaxT.NodeIds
......@@ -132,7 +132,7 @@ options =
, edgeConfluence : Range.Closed { min: 0.0, max: 1.0 }
, graphStage : GET.Init
, nodeSize : Range.Closed { min: 0.0, max: 100.0 }
, showLouvain : false
--, showLouvain : false
, showEdges : SigmaxT.EShow
-- Terms update
, removedNodeIds : Set.empty
......
......@@ -2,7 +2,7 @@ module Gargantext.Components.GraphExplorer.Toolbar.Buttons
( centerButton
, cameraButton
, edgesToggleButton
, louvainToggleButton
, louvainButton
, pauseForceAtlasButton
, pauseNoverlapButton
, resetForceAtlasButton
......@@ -157,27 +157,28 @@ edgesToggleButtonCpt = here.component "edgesToggleButton" cpt
------------------------------------------------------
type LouvainToggleButtonProps =
type LouvainButtonProps =
( forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
, state :: T.Box Boolean
, graph :: T.Box SigmaxTypes.SGraph
, sigmaRef :: R.Ref Sigmax.Sigma
)
louvainToggleButton :: R2.Leaf LouvainToggleButtonProps
louvainToggleButton = R2.leaf louvainToggleButtonCpt
louvainToggleButtonCpt :: R.Component LouvainToggleButtonProps
louvainToggleButtonCpt = here.component "louvainToggleButton" cpt
louvainButton :: R2.Leaf LouvainButtonProps
louvainButton = R2.leaf louvainButtonCpt
louvainButtonCpt :: R.Component LouvainButtonProps
louvainButtonCpt = here.component "louvainButton" cpt
where
cpt { forceAtlasState, state } _ = do
state' <- R2.useLive' state
cpt { forceAtlasState, graph, sigmaRef } _ = do
graph' <- R2.useLive' graph
forceAtlasState' <- R2.useLive' forceAtlasState
pure $
B.button
{ callback: \_ -> T.modify_ (not) state
{ callback: \_ -> do
pure unit
, status: SigmaxTypes.forceAtlasComponentStatus forceAtlasState'
, variant: state' ?
ButtonVariant Secondary $
OutlinedButtonVariant Secondary
, variant: OutlinedButtonVariant Secondary
}
[ H.text "Louvain" ]
......
......@@ -11,7 +11,7 @@ import Effect.Timer (setTimeout)
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.GraphExplorer.Resources as Graph
import Gargantext.Components.GraphExplorer.Store as GraphStore
import Gargantext.Components.GraphExplorer.Toolbar.Buttons (centerButton, edgesToggleButton, louvainToggleButton, pauseForceAtlasButton, pauseNoverlapButton, multiSelectEnabledButton)
import Gargantext.Components.GraphExplorer.Toolbar.Buttons (centerButton, edgesToggleButton, louvainButton, pauseForceAtlasButton, pauseNoverlapButton, multiSelectEnabledButton)
import Gargantext.Components.GraphExplorer.Toolbar.RangeControl (edgeConfluenceControl, nodeSizeControl)
import Gargantext.Components.GraphExplorer.Toolbar.SlideButton (labelSizeButton, labelRenderedSizeThresholdButton, mouseSelectorSizeSlider)
import Gargantext.Components.GraphExplorer.Types as GET
......@@ -63,7 +63,6 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
, nodeSizeRange
, selectedNodeIds
, showEdges
, showLouvain
, showSidebar
, sideTab
} <- GraphStore.use
......@@ -200,8 +199,9 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
,
gap
,
louvainToggleButton { forceAtlasState
, state: showLouvain }
louvainButton { forceAtlasState
, graph
, sigmaRef }
]
]
,
......
......@@ -74,3 +74,7 @@ export function _filterEdges(g, fn) {
return fn(attrs);
})
}
export function _copy(g) {
return g.copy();
}
......@@ -37,15 +37,17 @@ foreign import _updateEachEdgeAttributes :: EffectFn2 Graph (Record Types.Edge -
foreign import _mapEdges :: forall a. Fn2 Graph (Record Types.Edge -> a) (Array a)
foreign import _filterEdges :: Fn2 Graph (Record Types.Edge -> Boolean) (Array Types.EdgeId)
foreign import _copy :: EffectFn1 Graph Graph
newGraph :: Unit -> Effect Graph
newGraph = runEffectFn1 _newGraph
graphFromSigmaxGraph :: Types.Graph Types.Node Types.Edge -> Effect Graph
graphFromSigmaxGraph (Types.Graph g) = do
graphFromSigmaxGraph :: Types.SGraph -> Effect Graph
graphFromSigmaxGraph g = do
graph <- newGraph unit
_ <- traverse (addNode graph) g.nodes
_ <- traverse (addEdge graph) g.edges
_ <- traverse (addNode graph) $ Types.graphNodes g
_ <- traverse (addEdge graph) $ Types.graphEdges g
pure graph
addNode :: Graph -> Record Types.Node -> Effect String
......@@ -86,6 +88,9 @@ updateEachEdgeAttributes = runEffectFn2 _updateEachEdgeAttributes
filterEdges :: Graph -> (Record Types.Edge -> Boolean) -> Array Types.EdgeId
filterEdges = runFn2 _filterEdges
copy :: Graph -> Effect Graph
copy = runEffectFn1 _copy
-- TODO Maybe our use of this function (`updateWithGraph`) in code is
-- too much. We convert Types.Graph into Graphology.Graph and then
-- update Sigma.graph with this.
......
'use strict';
// https://graphology.github.io/standard-library/communities-louvain
import louvain from 'graphology-communities-louvain';
export function _assign(graph, options) {
louvain.assign(graph, {
getEdgeWeight: 'weight',
resolution: 2
});
return graph;
}
module Gargantext.Hooks.Sigmax.Louvain where
-- FFI for communities-louvain: https://graphology.github.io/standard-library/communities-louvain
import Prelude
import Data.Array as A
import Data.Map as Map
import Data.Sequence as Seq
import Data.Set as Set
import Data.Traversable (traverse)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4)
import FFI.Simple ((..), (...), (.=))
import Gargantext.Data.Louvain as DLouvain
import Gargantext.Hooks.Sigmax.Graphology as Graphology
import Gargantext.Hooks.Sigmax.Types as Types
import Record as Record
-- | Type representing the web worker.
foreign import data LouvainLayout :: Type
graph :: LouvainLayout -> Graphology.Graph
graph s = s .. "graph" :: Graphology.Graph
foreign import _assign :: forall settings. EffectFn2 Graphology.Graph settings Graphology.Graph
assign :: forall settings. Graphology.Graph -> settings -> Effect Graphology.Graph
assign = runEffectFn2 _assign
assignVisible :: forall settings. Graphology.Graph -> settings -> Effect Graphology.Graph
assignVisible g s = do
n <- Graphology.copy g
Graphology.updateGraphOnlyVisible n
assign n s
-- \[{ id, community }] -> { id: community }
cluster :: Graphology.Graph -> DLouvain.LouvainCluster
cluster g = Map.fromFoldable $ (\{ id, community } -> Tuple id community) <$> (Graphology.nodes g)
......@@ -42,6 +42,7 @@ type Node = (
borderColor :: String
, children :: Array String
, color :: String
, community :: Int -- this is filled in by the communities-louvain graphology plugin
, equilateral :: { numPoints :: Int }
, gargType :: GT.Mode
, hidden :: Boolean
......@@ -255,16 +256,14 @@ louvainNodes :: SGraph -> Array Louvain.Node
louvainNodes g = Seq.toUnfoldable $ Seq.map _.id (graphNodes g)
louvainGraph :: SGraph -> Louvain.LouvainCluster -> SGraph
louvainGraph g cluster = Graph {nodes: newNodes, edges: newEdges}
louvainGraph g cluster = Graph {nodes: newNodes, edges: graphEdges g}
where
nodes = graphNodes g
edges = graphEdges g
newNodes = (nodeClusterColor cluster) <$> nodes
newNodes = (nodeClusterColor cluster) <$> (graphNodes g)
nm = nodesMap newNodes
newEdges = (edgeClusterColor cluster nm) <$> edges
newEdges = (edgeClusterColor cluster nm) <$> (graphEdges g)
edgeClusterColor cluster nm e = e { color = sourceNode.color, sourceNode = sourceNode, targetNode = targetNode }
--edgeClusterColor _cluster nm e = e { color = sourceNode.color, sourceNode = sourceNode, targetNode = targetNode }
edgeClusterColor _cluster nm e = e { color = sourceNode.color }
where
sourceNode = case Map.lookup e.source nm of
Just sn -> sn
......
......@@ -5388,6 +5388,24 @@ graceful-fs@^4.1.2:
resolved "https://registry.yarnpkg.com/graceful-fs/-/graceful-fs-4.2.6.tgz#ff040b2b0853b23c3d31027523706f1885d76bee"
integrity sha512-nTnJ528pbqxYanhpDYsi4Rd8MAeaBA67+RZ10CM1m3bTAVFEDcd5AuA4a6W5YkGZ1iNXHzZz8T6TBKLeBuNriQ==
graphology-communities-louvain@^2.0.1:
version "2.0.1"
resolved "https://registry.yarnpkg.com/graphology-communities-louvain/-/graphology-communities-louvain-2.0.1.tgz#56636700912b75d25c6906e5162743792f5f0893"
integrity sha512-JxEH8uxao6FcWp3UXNDJIRjU3pamzp9aqIWgpfAqWE66aPwHeBIB39YnqTgbe4baUJRdpbcp1u8jJiYvojHGIQ==
dependencies:
graphology-indices "^0.17.0"
graphology-utils "^2.4.4"
mnemonist "^0.39.0"
pandemonium "^2.3.0"
graphology-indices@^0.17.0:
version "0.17.0"
resolved "https://registry.yarnpkg.com/graphology-indices/-/graphology-indices-0.17.0.tgz#b93ad32162ff8b09814547aedb101248f0fcbd2e"
integrity sha512-A7RXuKQvdqSWOpn7ZVQo4S33O0vCfPBnUSf7FwE0zNCasqwZVUaCXePuWo5HBpWw68KJcwObZDHpFk6HKH6MYQ==
dependencies:
graphology-utils "^2.4.2"
mnemonist "^0.39.0"
graphology-layout-forceatlas2@^0.9.2:
version "0.9.2"
resolved "https://registry.yarnpkg.com/graphology-layout-forceatlas2/-/graphology-layout-forceatlas2-0.9.2.tgz#0f5986f55ef0d72162f23edd1837aa8dac69f20e"
......@@ -5409,7 +5427,7 @@ graphology-operators@^1.6.0:
dependencies:
graphology-utils "^2.0.0"
graphology-utils@^2.0.0, graphology-utils@^2.1.0, graphology-utils@^2.3.0, graphology-utils@^2.5.0:
graphology-utils@^2.0.0, graphology-utils@^2.1.0, graphology-utils@^2.3.0, graphology-utils@^2.4.2, graphology-utils@^2.4.4, graphology-utils@^2.5.0:
version "2.5.2"
resolved "https://registry.yarnpkg.com/graphology-utils/-/graphology-utils-2.5.2.tgz#4d30d6e567d27c01f105e1494af816742e8d2440"
integrity sha512-ckHg8MXrXJkOARk56ZaSCM1g1Wihe2d6iTmz1enGOz4W/l831MBCKSayeFQfowgF8wd+PQ4rlch/56Vs/VZLDQ==
......@@ -7280,6 +7298,13 @@ mkdirp@^1.0.3, mkdirp@^1.0.4:
resolved "https://registry.yarnpkg.com/mkdirp/-/mkdirp-1.0.4.tgz#3eb5ed62622756d79a5f0e2a221dfebad75c2f7e"
integrity sha512-vVqVZQyf3WLx2Shd0qJ9xuvqgAyKPLAiqITEtqW0oIUjzo3PePDd6fW9iFz30ef7Ysp/oiWqbhszeGWW2T6Gzw==
mnemonist@^0.39.0, mnemonist@^0.39.2:
version "0.39.5"
resolved "https://registry.yarnpkg.com/mnemonist/-/mnemonist-0.39.5.tgz#5850d9b30d1b2bc57cc8787e5caa40f6c3420477"
integrity sha512-FPUtkhtJ0efmEFGpU14x7jGbTB+s18LrzRL2KgoWz9YvcY3cPomz8tih01GbHwnGk/OmkOKfqd/RAQoc8Lm7DQ==
dependencies:
obliterator "^2.0.1"
modify-values@^1.0.0:
version "1.0.1"
resolved "https://registry.yarnpkg.com/modify-values/-/modify-values-1.0.1.tgz#b3939fa605546474e3e3e3c63d64bd43b4ee6022"
......@@ -7570,7 +7595,7 @@ object.pick@^1.3.0:
dependencies:
isobject "^3.0.1"
obliterator@^2.0.2:
obliterator@^2.0.1, obliterator@^2.0.2:
version "2.0.4"
resolved "https://registry.yarnpkg.com/obliterator/-/obliterator-2.0.4.tgz#fa650e019b2d075d745e44f1effeb13a2adbe816"
integrity sha512-lgHwxlxV1qIg1Eap7LgIeoBWIMFibOjbrYPIPJZcI1mmGAI2m3lNYpK12Y+GBdPQ0U1hRwSord7GIaawz962qQ==
......@@ -7769,6 +7794,13 @@ pako@~1.0.5:
resolved "https://registry.yarnpkg.com/pako/-/pako-1.0.11.tgz#6c9599d340d54dfd3946380252a35705a6b992bf"
integrity sha512-4hLB8Py4zZce5s4yd9XzopqwVv/yGNhV1Bl8NTmCq1763HeK2+EwVTv+leGeL13Dnh2wfbqowVPXCIO0z4taYw==
pandemonium@^2.3.0:
version "2.4.1"
resolved "https://registry.yarnpkg.com/pandemonium/-/pandemonium-2.4.1.tgz#bd51ca72184c6ae135f9049a33c8605bfdb9574d"
integrity sha512-wRqjisUyiUfXowgm7MFH2rwJzKIr20rca5FsHXCMNm1W5YPP1hCtrZfgmQ62kP7OZ7Xt+cR858aB28lu5NX55g==
dependencies:
mnemonist "^0.39.2"
parcel@^2.0.0-rc.0:
version "2.0.0-rc.0"
resolved "https://registry.yarnpkg.com/parcel/-/parcel-2.0.0-rc.0.tgz#862d5568f13ed4b7d762f792b23d4445f6fddaf2"
......
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