Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
136
Issues
136
List
Board
Labels
Milestones
Merge Requests
2
Merge Requests
2
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
33609eac
Commit
33609eac
authored
Dec 24, 2019
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Graph] add Louvain clustering
parent
6109c49c
Changes
10
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
501 additions
and
16 deletions
+501
-16
packages.json
.psc-package/local/.set/packages.json
+10
-0
packages.dhall
packages.dhall
+5
-0
psc-package.json
psc-package.json
+1
-0
Graph.purs
src/Gargantext/Components/Graph.purs
+2
-2
GraphExplorer.purs
src/Gargantext/Components/GraphExplorer.purs
+9
-10
Controls.purs
src/Gargantext/Components/GraphExplorer/Controls.purs
+6
-2
ToggleButton.purs
src/Gargantext/Components/GraphExplorer/ToggleButton.purs
+11
-1
Louvain.js
src/Gargantext/Data/Louvain.js
+384
-0
Louvain.purs
src/Gargantext/Data/Louvain.purs
+36
-0
Types.purs
src/Gargantext/Hooks/Sigmax/Types.purs
+37
-1
No files found.
.psc-package/local/.set/packages.json
View file @
33609eac
...
...
@@ -3069,6 +3069,16 @@
"repo"
:
"https://github.com/purescript/purescript-tuples.git"
,
"version"
:
"v5.1.0"
},
"tuples-native"
:
{
"dependencies"
:
[
"generics-rep"
,
"prelude"
,
"typelevel"
,
"unsafe-coerce"
],
"repo"
:
"https://github.com/athanclark/purescript-tuples-native"
,
"version"
:
"v2.0.1"
},
"type-equality"
:
{
"dependencies"
:
[],
"repo"
:
"https://github.com/purescript/purescript-type-equality.git"
,
...
...
packages.dhall
View file @
33609eac
...
...
@@ -204,6 +204,11 @@ let additions =
]
"https://github.com/irresponsible/purescript-reactix"
"v0.4.2"
, tuples-native =
mkPackage
[ "generics-rep", "prelude", "typelevel", "unsafe-coerce" ]
"https://github.com/athanclark/purescript-tuples-native"
"v2.0.1"
, uint =
mkPackage
[ "maybe", "math", "generics-rep" ]
...
...
psc-package.json
View file @
33609eac
...
...
@@ -33,6 +33,7 @@
"string-parsers"
,
"strings"
,
"thermite"
,
"tuples-native"
,
"uint"
,
"uri"
,
"web-html"
...
...
src/Gargantext/Components/Graph.purs
View file @
33609eac
...
...
@@ -9,6 +9,7 @@ import Prelude (bind, const, discard, not, pure, unit, ($))
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.Sequence as Seq
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element)
...
...
@@ -85,8 +86,7 @@ graphCpt = R.hooksComponent "G.C.Graph" cpt
Sigmax.setEdges sig false
Sigma.startForceAtlas2 sig props.forceAtlas2Settings
louvain <- Louvain.init unit
log2 "[graphCpt] louvain" louvain
pure unit
Just sig -> do
pure unit
...
...
src/Gargantext/Components/GraphExplorer.purs
View file @
33609eac
...
...
@@ -18,6 +18,7 @@ import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Data.Louvain as Louvain
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
...
...
@@ -178,7 +179,14 @@ graphViewCpt = R.hooksComponent "GraphView" cpt
where
cpt {controls, elRef, graphId, graph, multiSelectEnabledRef} _children = do
-- TODO Cache this?
let transformedGraph = transformGraph controls graph
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
else
graph
let transformedGraph = transformGraph controls louvainGraph
R.useEffect1' (fst controls.multiSelectEnabled) $ do
R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled
...
...
@@ -232,15 +240,6 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges}
targetNode = unsafePartial $ fromJust $ Map.lookup e.target nodesMap
color = sourceNode.color
defaultPalette :: Array String
defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff"
,"#b399df","#ffdfed","#33c8f3","#739e9a"
,"#caeca3","#f6f7e5","#f9bcca","#ccb069"
,"#c9ffde","#c58683","#6c9eb0","#ffd3cf"
,"#ccffc7","#52a1b0","#d2ecff","#99fffe"
,"#9295ae","#5ea38b","#fff0b3","#d99e68"
]
-- clusterColor :: Cluster -> Color
-- clusterColor (Cluster {clustDefault}) = unsafePartial $ fromJust $ defaultPalette !! (clustDefault `molength defrultPalette)
...
...
src/Gargantext/Components/GraphExplorer/Controls.purs
View file @
33609eac
...
...
@@ -24,7 +24,7 @@ import Gargantext.Components.GraphExplorer.Button (centerButton)
import Gargantext.Components.GraphExplorer.RangeControl (edgeConfluenceControl, edgeWeightControl, nodeSizeControl)
import Gargantext.Components.GraphExplorer.Search (nodeSearchControl)
import Gargantext.Components.GraphExplorer.SlideButton (labelSizeButton, mouseSelectorSizeButton)
import Gargantext.Components.GraphExplorer.ToggleButton (multiSelectEnabledButton, edgesToggleButton, pauseForceAtlasButton)
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
...
...
@@ -42,6 +42,7 @@ type Controls =
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, showControls :: R.State Boolean
, showEdges :: R.State SigmaxTypes.ShowEdgesState
, showLouvain :: R.State Boolean
, showSidePanel :: R.State GET.SidePanelState
, showTree :: R.State Boolean
, sigmaRef :: R.Ref Sigmax.Sigma
...
...
@@ -134,6 +135,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
RH.li {} [ centerButton props.sigmaRef ]
, RH.li {} [ pauseForceAtlasButton {state: props.forceAtlasState} ]
, RH.li {} [ edgesToggleButton {state: props.showEdges} ]
, RH.li {} [ louvainToggleButton props.showLouvain ]
, RH.li {} [ edgeConfluenceControl edgeConfluenceRange props.edgeConfluence ]
, RH.li {} [ edgeWeightControl edgeWeightRange props.edgeWeight ]
-- change level
...
...
@@ -161,11 +163,12 @@ useGraphControls graph = do
graphStage <- R.useState' Graph.Init
multiSelectEnabled <- R.useState' false
nodeSize <- R.useState' $ Range.Closed { min: 0.0, max: 100.0 }
showTree <- R.useState' false
selectedNodeIds <- R.useState' $ Set.empty
showControls <- R.useState' false
showEdges <- R.useState' SigmaxTypes.EShow
showLouvain <- R.useState' false
showSidePanel <- R.useState' GET.InitialClosed
showTree <- R.useState' false
sigma <- Sigmax.initSigma
sigmaRef <- R.useRef sigma
...
...
@@ -179,6 +182,7 @@ useGraphControls graph = do
, selectedNodeIds
, showControls
, showEdges
, showLouvain
, showSidePanel
, showTree
, sigmaRef
...
...
src/Gargantext/Components/GraphExplorer/ToggleButton.purs
View file @
33609eac
...
...
@@ -2,9 +2,10 @@ module Gargantext.Components.GraphExplorer.ToggleButton
( Props
, toggleButton
, toggleButtonCpt
, multiSelectEnabledButton
, controlsToggleButton
, edgesToggleButton
, louvainToggleButton
, multiSelectEnabledButton
, sidebarToggleButton
, pauseForceAtlasButton
, treeToggleButton
...
...
@@ -78,6 +79,15 @@ edgesToggleButtonCpt = R.hooksComponent "EdgesToggleButton" cpt
-- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges
onClick setState _ = setState SigmaxTypes.toggleShowEdgesState
louvainToggleButton :: R.State Boolean -> R.Element
louvainToggleButton state =
toggleButton {
state: state
, onMessage: "Louvain on"
, offMessage: "Louvain off"
, onClick: \_ -> snd state not
}
multiSelectEnabledButton :: R.State Boolean -> R.Element
multiSelectEnabledButton state =
toggleButton {
...
...
src/Gargantext/Data/Louvain.js
0 → 100755
View file @
33609eac
This diff is collapsed.
Click to expand it.
src/Gargantext/Data/Louvain.purs
0 → 100644
View file @
33609eac
module Gargantext.Data.Louvain where
import Prelude (Unit, unit, ($), (<$>))
import Data.Function.Uncurried (Fn1, runFn1, Fn3, runFn3)
import Data.Map as Map
import Data.Tuple (Tuple(..))
import Data.Tuple.Native (T2, prj)
import Data.Typelevel.Num (d0, d1)
foreign import data Louvain :: Type
type Node = String
type Edge =
(
source :: Node
, target :: Node
, weight :: Number
)
type Cluster = Int
type LouvainCluster_ = T2 Node Cluster
type LouvainCluster = Map.Map Node Cluster
foreign import _jLouvain :: Fn1 Unit Louvain
louvain :: Unit -> Louvain
louvain unit = runFn1 _jLouvain unit
foreign import _init :: Fn3 Louvain (Array Node) (Array (Record Edge)) (Array LouvainCluster_)
init :: Louvain -> Array Node -> Array (Record Edge) -> LouvainCluster
init l nds edgs = Map.fromFoldable clusterTuples
where
clusterArr = runFn3 _init l nds edgs
clusterTuples = (\t2 -> Tuple (prj d0 t2) (prj d1 t2)) <$> clusterArr
src/Gargantext/Hooks/Sigmax/Types.purs
View file @
33609eac
module Gargantext.Hooks.Sigmax.Types where
import DOM.Simple.Types (Element)
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (Tuple(..))
import Prelude (class Eq, class Show, map, ($), (&&), (==), (||))
import Gargantext.Data.Louvain as Louvain
import Partial.Unsafe (unsafePartial)
import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), mod)
newtype Graph n e = Graph { nodes :: Seq.Seq {|n}, edges :: Seq.Seq {|e} }
...
...
@@ -155,3 +159,35 @@ forceAtlasEdgeState Running EShow = ETempHiddenThenShow
forceAtlasEdgeState Running es = es
forceAtlasEdgeState Paused ETempHiddenThenShow = EShow
forceAtlasEdgeState Paused es = es
louvainEdges :: SGraph -> Array (Record Louvain.Edge)
louvainEdges g = Seq.toUnfoldable $ Seq.map (\{source, target, weight} -> {source, target, weight}) (graphEdges g)
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}
where
nodes = graphNodes g
edges = graphEdges g
newNodes = (nodeClusterColor cluster) <$> nodes
newEdges = edges
nodeClusterColor cluster n = n { color = newColor }
where
newColor = case Map.lookup n.id cluster of
Nothing -> n.color
Just c -> do
let idx = c `mod` (A.length defaultPalette)
unsafePartial $ fromJust $ defaultPalette A.!! idx
defaultPalette :: Array String
defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff"
,"#b399df","#ffdfed","#33c8f3","#739e9a"
,"#caeca3","#f6f7e5","#f9bcca","#ccb069"
,"#c9ffde","#c58683","#6c9eb0","#ffd3cf"
,"#ccffc7","#52a1b0","#d2ecff","#99fffe"
,"#9295ae","#5ea38b","#fff0b3","#d99e68"
]
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment