[Graph] add Louvain clustering

.psc-package/local/.set/packages.json

@@ -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

@@ -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

@@ -33,6 +33,7 @@
     "string-parsers",
     "strings",
     "thermite",
+    "tuples-native",
     "uint",
     "uri",
     "web-html"

src/Gargantext/Components/Graph.purs

@@ -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

@@ -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

@@ -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

@@ -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.purs

+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

 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"
+                 ]