[Fix] merge

.gitignore

 .DS_Store
 .stack-work
+.stack-work-profile
 .idea
 *.log
 tmp/
 
-
+__pycache__

.gitmodules

+[submodule "python-louvain"]
+	path = python-louvain
+	url = https://github.com/taynaud/python-louvain
+[submodule "src/Data/Graph/Clustering/python/python-louvain"]
+	path = src/Data/Graph/Clustering/python/python-louvain
+	url = https://github.com/taynaud/python-louvain

clustering-louvain.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 34278ee95f4de4f41ad7ba7e08818b4a24fad95acd67aa0a682a260b2db2832e
+-- hash: e6499237b0dc8ea9c12e2947a7c59bbd3dcc7a327e44c0d2d4ee5fff351e6ac6
 
 name:           clustering-louvain
 version:        0.1.0.0
@@ -23,6 +23,7 @@ library
       Data.Graph.Clustering.FLouvain
       Data.Graph.Clustering.Louvain
       Data.Graph.Clustering.Louvain.Utils
+      Data.Graph.Clustering.Louvain.Types
       Data.Graph.Clustering.Louvain.IO.Gexf
       Data.Graph.Clustering.Louvain.CplusPlus
       Data.Graph.FGL

package.yaml

@@ -39,6 +39,7 @@ library:
   - Data.Graph.Clustering.FLouvain
   - Data.Graph.Clustering.Louvain
   - Data.Graph.Clustering.Louvain.Utils
+  - Data.Graph.Clustering.Louvain.Types
   - Data.Graph.Clustering.Louvain.IO.Gexf
   - Data.Graph.Clustering.Louvain.CplusPlus
   - Data.Graph.FGL

python-louvain @ 381b7db8

+Subproject commit 381b7db8196f43de98d5279746173b50fbb2bea9

src/Data/Graph/Clustering/Example.hs

@@ -4,28 +4,42 @@ import Protolude
 
 import Control.Monad (foldM_)
 import Data.List (nub, sort)
-import Data.Graph.Clustering.Louvain.Utils
 import Data.Graph.FGL
 import Data.Graph.Inductive
-import Data.Graph.Clustering.FLouvain
 import qualified Data.Text as T
 import qualified Text.ParserCombinators.Parsec as P
 import Text.Parsec.Language (haskellStyle)
 import qualified Text.Parsec.Token as PT
 
+import Data.Graph.Clustering.Louvain.Utils
+import Data.Graph.Clustering.Louvain.Types
+import Data.Graph.Clustering.FLouvain
+
 -- | Run FLouvain.iterate on an example graph
 -- Example call:
 -- putStrLn $ prettify $ iterateOnce cuiller
 -- Prelude.map (fst3 . unCommunity . snd) $ labNodes $ iterateOnce karate
-iterateOnce :: Gr () Double -> CGr
+iterateOnce :: Gr a Double -> CGr a
 iterateOnce gr = iteration fgr cgr
   where
     fgr = toFGraph    gr
     cgr = initialCGr fgr
 
-runIterations :: Int -> Gr () Double -> IO ()
-runIterations n gr = do
-  let fgr       = toFGraph gr
+runFLouvain :: (Show a, Eq a) => Int -> Int -> FGraph a () -> IO ()
+runFLouvain 0 _ fgr = return ()
+runFLouvain cycles n fgr = do
+  cgr <- runFIterations n fgr
+  let fgrNext = louvainSecondStep fgr cgr
+  putStrLn ("-----------------" :: Text)
+  putStrLn ("New FGraph:" :: Text)
+  putStrLn $ prettify fgrNext
+  runFLouvain (cycles - 1) n fgrNext
+
+runIterations :: Show a => Int -> Gr a Double -> IO (CGr a)
+runIterations n gr = runFIterations n $ toFGraph gr
+
+runFIterations :: Show a => Int -> FGraph a () -> IO (CGr a)
+runFIterations n fgr = do
   let fgrWeight = graphWeight fgr
   let initCgr   = initialCGr fgr
 
@@ -41,6 +55,8 @@ runIterations n gr = do
   putStrLn ("Non-empty communities: " :: Text)
   mapM_ (\c -> putStrLn (show c :: Text)) coms
 
+  return lastCgr
+
   where
     runIteration fgr fgrWeight iterCgr i = do
       let iterNextCgr = iteration fgr iterCgr
@@ -50,7 +66,7 @@ runIterations n gr = do
       putStrLn $ T.unpack $ show $ modularity fgr iterNextCgr fgrWeight
       return iterNextCgr
 
-runLouvainFirstStepIterate :: Int -> Gr () Double -> (Modularity, CGr)
+runLouvainFirstStepIterate :: Int -> Gr a Double -> (Modularity, CGr a)
 runLouvainFirstStepIterate n gr = (modularity fgr cgr m, cgr)
   where
     fgr = toFGraph gr

src/Data/Graph/Clustering/Louvain.hs

@@ -19,11 +19,11 @@ References:
 module Data.Graph.Clustering.Louvain 
   where
 
-import Data.Tuple.Extra (fst3)
 import Data.List (maximumBy, nub, intersect, foldl', zipWith, concat)
 import Data.Graph.Inductive
 import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..), toFGraph)
-import Data.Graph.Clustering.FLouvain (louvainFirstStepIterate, Community(..), initialCGr)
+import Data.Graph.Clustering.FLouvain (louvainFirstStepIterate, initialCGr)
+import Data.Graph.Clustering.Louvain.Types (Community(..), comNodes)
 ------------------------------------------------------------------------
 -- | Definitions
 ------------------------------------------------------------------------
@@ -35,7 +35,7 @@ type Reverse = Bool
 
 ------------------------------------------------------------------------
 flouvain :: Int -> Gr () Double -> [[Node]]
-flouvain n g = map (fst3 . unCommunity . snd) $ labNodes g'
+flouvain n g = map (comNodes . snd) $ labNodes g'
   where
     g' = louvainFirstStepIterate n (toFGraph g)
 ------------------------------------------------------------------------

src/Data/Graph/Clustering/Louvain/Types.hs

+module Data.Graph.Clustering.Louvain.Types where
+
+import Protolude
+
+import Data.Graph.Inductive
+
+
+--  "glue" : function to gather/merge communities
+--  "klue" : function to split communities
+data ClusteringMethod = Glue | Klue
+  deriving (Eq)
+
+newtype Weight = Weight { unWeight :: Double }
+  deriving (Show, Eq, Ord)
+type FEdge b = (Weight, b)
+fedgeWeight :: FEdge b -> Double
+fedgeWeight = unWeight . fst
+sumEdgeWeights :: Adj (FEdge b) -> Double
+sumEdgeWeights es = sum $ map (fedgeWeight . fst) es
+
+-- Our basic graph. Nodes have custom labels. Edges have weight assigned to them.
+type FGraph a b = Gr a (FEdge b)
+
+-- | Used for k_i in formula (2)
+-- (sum of the weights of the links incident to node i)
+newtype NodeWeightSum = NodeWeightSum { unNodeWeightSum :: Double }
+  deriving (Show, Eq, Ord)
+nodeWeightSum :: Context a (FEdge b) -> NodeWeightSum
+nodeWeightSum (p, _, _, s) = NodeWeightSum $ sumEdgeWeights $ p <> s
+
+-- | Used for k_i,in in formula (2)
+-- (Sum of weights of links from a given 'Node' to nodes in a given 'Community')
+newtype NodeComWeightSum = NodeComWeightSum { unNodeComWeightSum :: Double }
+  deriving (Show, Eq, Ord)
+nodeComWeightSum :: Community c -> Context a (FEdge b) -> NodeComWeightSum
+nodeComWeightSum com (p, _, _, s) =
+  NodeComWeightSum $ sumEdgeWeights $ filter (\(_, n) -> n `elem` comNodes com) $ p <> s
+
+newtype NodeNonComWeightSum = NodeNonComWeightSum { unNodeNonComWeightSum :: Double }
+  deriving (Show, Eq, Ord)
+nodeNonComWeightSum :: Community c -> Context a (FEdge b) -> NodeNonComWeightSum
+nodeNonComWeightSum com (p, _, _, s) =
+  NodeNonComWeightSum $ sumEdgeWeights $ filter (\(_, n) -> n `notElem` comNodes com) $ p <> s
+
+-- Probably this structure is better to reduce the number of computations
+-- (precompute sum of node weights, which is the k_i variable in formula (2)).
+-- type FNode a = (NodeWeightSum, a)
+-- fnodeWeightSum :: FNode a -> Double
+-- fnodeWeightSum = unNodeWeightSum . fst
+
+-- | This is the m variable in formula (2) of the Louvain paper
+newtype GraphWeightSum = GraphWeightSum { unGraphWeightSum :: Double }
+  deriving (Show, Eq, Ord)
+-- | This is the \Sum_in in formula (2) of the Louvain paper
+-- (sum of the weights of the links inside C)
+newtype InWeightSum = InWeightSum { unInWeightSum :: Double }
+  deriving (Show, Eq, Ord)
+-- | This is the \Sum_tot in formula (2) of the Louvain paper
+-- (sum of the weights of the links incident to nodes in C)
+newtype TotWeightSum = TotWeightSum { unTotWeightSum :: Double }
+  deriving (Show, Eq, Ord)
+-- | Computed Delta_Q value in (2)
+newtype DeltaQ = DeltaQ { unDeltaQ :: Double }
+  deriving (Show, Eq, Ord)
+-- | Computed modularity in (1)
+newtype Modularity = Modularity { unModularity :: Double }
+  deriving (Show, Eq, Ord)
+
+-- | Type for the clusters we will be creating.
+newtype Community a = Community { unCommunity ::  ([Node], InWeightSum, TotWeightSum, a) }
+  deriving (Show, Eq, Ord)
+comNodes :: Community c -> [Node]
+comNodes (Community (ns, _, _, _)) = ns
+comInWeightSum :: Community c -> InWeightSum
+comInWeightSum (Community (_, inWeightSum, _, _)) = inWeightSum
+comTotWeightSum :: Community c -> TotWeightSum
+comTotWeightSum (Community (_, _, totWeightSum, _)) = totWeightSum
+comLabel :: Community c -> c
+comLabel (Community (_, _, _, c)) = c
+
+type CGrNode = Node
+type CGrEdge = (InWeightSum, TotWeightSum)
+
+type CGr a = Gr (Community a) ()
+
+graphWeight :: FGraph a b -> GraphWeightSum
+graphWeight gr = GraphWeightSum $ 0.5 * ufold (\(_, n, _, _) -> weight' $ context gr n) 0 gr
+  where
+    weight' (p, _, _, s) acc = acc + (sumEdgeWeights $ p <> s)

src/Data/Graph/Clustering/Louvain/Utils.hs

@@ -19,7 +19,7 @@ import Data.Graph.Inductive
 import Data.List (lookup, nub)
 import qualified Data.Map.Strict as Map
 
-import Data.Graph.Clustering.FLouvain (FGraph, Weight(..))
+import Data.Graph.Clustering.Louvain.Types
 
 data LouvainNode = LouvainNode { l_node_id :: Int
                                , l_community_id :: Int
@@ -63,3 +63,17 @@ toFGraph gr = gmap remap gr
       edgeMap (w, n) = ((Weight w, ()), n)
       p' = map edgeMap p
       s' = map edgeMap s
+
+-- | Fixed point with at most n iterations
+-- 'Int' argument is the maximal number of iterations to make
+-- 'a -> a' is the iterator function
+-- 'a -> Bool' is the condition checking function ('True' continues looping, 'False' breaks it)
+-- 'a' is the initial value
+fixPt :: Int -> (a -> a) -> (a -> Bool) -> a -> a
+fixPt 0 iterator _ init = iterator init
+fixPt n iterator cond init =
+  if cond next
+     then fixPt (n - 1) iterator cond init
+     else next
+  where
+    next = iterator init

python-louvain @ 381b7db8

+Subproject commit 381b7db8196f43de98d5279746173b50fbb2bea9

src/Data/Graph/Clustering/python/test_community_louvain.py

+#!/usr/bin/env python3
+
+import os
+import sys
+sys.path.append(os.path.join(os.environ['PWD'], 'python', 'python-louvain'))
+
+import networkx as nx
+
+from community.community_louvain import generate_dendrogram, partition_at_level, __one_level, __modularity, best_partition
+from community.community_status import Status
+
+
+def communities(parted):
+    ret = {}
+    for n, c in parted.items():
+        ret.setdefault(c, [])
+        ret[c].append(n)
+
+    return ret
+
+
+simpleGraph = nx.Graph()
+simpleGraph.add_edges_from([
+    (1, 2, {'weight': 1.0}),
+    (2, 3, {'weight': 2.0}),
+])
+
+dendo = generate_dendrogram(simpleGraph)
+part = partition_at_level(dendo, len(dendo) - 1)
+print((simpleGraph.nodes, simpleGraph.edges))
+print(dendo)
+print(part)
+
+status = Status()
+status.init(simpleGraph, 'weight', None)
+__one_level(simpleGraph, status, 'weight', 1.0)
+new_mod = __modularity(status)
+print(new_mod)
+
+print(best_partition(simpleGraph))
+
+
+cuiller = nx.Graph()
+cuiller.add_edges_from([
+    (2, 1, {'weight': 1}),
+    (1, 2, {'weight': 1}),
+
+    (1, 4, {'weight': 1}),
+    (4, 1, {'weight': 1}),
+
+    (2, 3, {'weight': 1}),
+    (3, 2, {'weight': 1}),
+
+    (3, 4, {'weight': 1}),
+    (4, 3, {'weight': 1}),
+
+    (4, 5, {'weight': 1}),
+    (5, 4, {'weight': 1}),
+])
+
+print(best_partition(cuiller))
+
+karateEdges = [(1,2,1.0),(1,3,1.0),(1,4,1.0),(1,5,1.0),(1,6,1.0),(1,7,1.0),(1,8,1.0),(1,9,1.0),(1,11,1.0),(1,12,1.0),(1,13,1.0),(1,14,1.0),(1,18,1.0),(1,20,1.0),(1,22,1.0),(1,32,1.0),(2,3,1.0),(2,4,1.0),(2,8,1.0),(2,14,1.0),(2,18,1.0),(2,20,1.0),(2,22,1.0),(2,31,1.0),(3,4,1.0),(3,8,1.0),(3,9,1.0),(3,10,1.0),(3,14,1.0),(3,28,1.0),(3,29,1.0),(3,33,1.0),(4,8,1.0),(4,13,1.0),(4,14,1.0),(5,7,1.0),(5,11,1.0),(6,7,1.0),(6,11,1.0),(6,17,1.0),(7,17,1.0),(9,31,1.0),(9,33,1.0),(9,34,1.0),(10,34,1.0),(14,34,1.0),(15,33,1.0),(15,34,1.0),(16,33,1.0),(16,34,1.0),(19,33,1.0),(19,34,1.0),(20,34,1.0),(21,33,1.0),(21,34,1.0),(23,33,1.0),(23,34,1.0),(24,26,1.0),(24,28,1.0),(24,30,1.0),(24,33,1.0),(24,34,1.0),(25,26,1.0),(25,28,1.0),(25,32,1.0),(26,32,1.0),(27,30,1.0),(27,34,1.0),(28,34,1.0),(29,32,1.0),(29,34,1.0),(30,33,1.0),(30,34,1.0),(31,33,1.0),(31,34,1.0),(32,33,1.0),(32,34,1.0),(33,34,1.0)]
+
+karate = nx.Graph()
+karate.add_edges_from([(s, t, {'weight': w}) for (s, t, w) in karateEdges])
+
+karate_bp = best_partition(karate)
+print(karate_bp)
+print(communities(karate_bp))

src/Data/Graph/FGL.hs

@@ -22,7 +22,7 @@ replaceLNode gr (n, ln) = gmap replacer gr
 
 -- | Find LNode of a node (i.e. a node with label)
 lnode :: (Graph gr) => gr a b -> Node -> Maybe (LNode a)
-lnode cgr n = case lab cgr n of
+lnode gr n = case lab gr n of
   Nothing -> Nothing
   Just l  -> Just (n, l)
 

test/FLouvainSpec.hs

@@ -12,13 +12,14 @@ import Data.List ((!!))
 
 import Data.Graph.Clustering.FLouvain
 import Data.Graph.Clustering.Louvain.Utils (mkFGraph, mkFGraph')
+import Data.Graph.Clustering.Louvain.Types
 import Data.Graph.FGL
 
 -- 1 -> 2 -> 3
 
 simpleGraph :: FGraph () ()
 simpleGraph = mkFGraph' [ (1, 2, 1.0)
-                        , (2, 3, 2.0)
+                        , (2, 3, 0.5)
                         ]
 
 simpleLGraph :: FGraph Text ()
@@ -26,18 +27,21 @@ simpleLGraph = mkFGraph [ (1, "one")
                         , (2, "two")
                         , (3, "three")]
                         [ (1, 2, 1.0)
-                        , (2, 3, 1.0) ]
+                        , (2, 3, 0.5) ]
 
 spec :: Spec
 spec = do
   describe "FLouvain tests" $ do
     it "graphWeight computes correctly" $ do
-      graphWeight simpleGraph `shouldBe` GraphWeightSum 3.0
+      assertApproxEqual "graphWeights don't match"
+                        0.00001
+                        1.5
+                        (unGraphWeightSum $ graphWeight simpleGraph)
 
     it "nodeWeightSum computes correctly" $ do
       nodeWeightSum (DGI.context simpleGraph 1) `shouldBe` NodeWeightSum 1.0
-      nodeWeightSum (DGI.context simpleGraph 2) `shouldBe` NodeWeightSum 3.0
-      nodeWeightSum (DGI.context simpleGraph 3) `shouldBe` NodeWeightSum 2.0
+      nodeWeightSum (DGI.context simpleGraph 2) `shouldBe` NodeWeightSum 1.5
+      nodeWeightSum (DGI.context simpleGraph 3) `shouldBe` NodeWeightSum 0.5
 
     it "replaceLNode works correctly" $ do
       let replaced = replaceLNode simpleLGraph (1, "ONE")
@@ -55,8 +59,8 @@ spec = do
       Protolude.map comInWeightSum communities `shouldBe` [iws0, iws0, iws0]
       Protolude.map comTotWeightSum communities `shouldBe`
         [ TotWeightSum 1.0
-        , TotWeightSum 3.0
-        , TotWeightSum 2.0 ]
+        , TotWeightSum 1.5
+        , TotWeightSum 0.5 ]
 
     it "nodeComWeightSum computes correctly" $ do
       let cgr = initialCGr simpleGraph
@@ -69,9 +73,9 @@ spec = do
       nodeComWeightSum fstCom (DGI.context simpleGraph 3) `shouldBe` NodeComWeightSum 0.0
       nodeComWeightSum sndCom (DGI.context simpleGraph 1) `shouldBe` NodeComWeightSum 1.0
       nodeComWeightSum sndCom (DGI.context simpleGraph 2) `shouldBe` NodeComWeightSum 0.0
-      nodeComWeightSum sndCom (DGI.context simpleGraph 3) `shouldBe` NodeComWeightSum 2.0
+      nodeComWeightSum sndCom (DGI.context simpleGraph 3) `shouldBe` NodeComWeightSum 0.5
       nodeComWeightSum trdCom (DGI.context simpleGraph 1) `shouldBe` NodeComWeightSum 0.0
-      nodeComWeightSum trdCom (DGI.context simpleGraph 2) `shouldBe` NodeComWeightSum 2.0
+      nodeComWeightSum trdCom (DGI.context simpleGraph 2) `shouldBe` NodeComWeightSum 0.5
       nodeComWeightSum trdCom (DGI.context simpleGraph 3) `shouldBe` NodeComWeightSum 0.0
 
     it "modularity computes correctly" $ do
@@ -113,8 +117,8 @@ spec = do
           newCom2 = moveNodeWithContext ctx1 Into com2
           intoOutOf ctx com = moveNodeWithContext ctx OutOf $ moveNodeWithContext ctx Into com
           outOfInto ctx com = moveNodeWithContext ctx Into $ moveNodeWithContext ctx OutOf com
-      newCom1 `shouldBe` Community ([], InWeightSum 0.0, TotWeightSum 0.0)
-      newCom2 `shouldBe` Community ([1, 2], InWeightSum 1.0, TotWeightSum 2.0)
+      newCom1 `shouldBe` Community ([], InWeightSum 0.0, TotWeightSum 0.0, comLabel newCom1)
+      newCom2 `shouldBe` Community ([1, 2], InWeightSum 1.0, TotWeightSum 0.5, comLabel newCom1)
 
       -- TODO moveNodeWithContext ctx Into (moveNodeWithContext ctx OutOf) is an
       -- identity, this can be used in QuickCheck testing