[FLouvain] some fixes to the code

src/Data/Graph/Clustering/Example.hs

@@ -45,7 +45,14 @@ runIterations n gr = do
   putStrLn "Initial modularity: "
   putStrLn $ T.unpack $ show $ modularity fgr initCgr fgrWeight
 
-  foldM_ (runIteration fgr fgrWeight) initCgr [0..n]
+  lastCgr <- foldM (runIteration fgr fgrWeight) initCgr [0..n]
+
+  -- at the end, just pretty-print communities
+  let coms = filter (not . null . comNodes . llab) (labNodes lastCgr)
+
+  putStrLn "-------------"
+  putStrLn "Non-empty communities: "
+  mapM_ (putStrLn . T.pack . show) coms
 
   where
     runIteration fgr fgrWeight iterCgr i = do
@@ -73,8 +80,7 @@ readPythonGraph src = do
     Left err -> do
       return $ Left err
     Right edges -> do
-      let nodes =  map (, ()) $ nub $ map (\(s, _, _) -> s) edges
-      return $ Right $ mkGraph nodes edges
+      return $ Right $ mkGraph' edges
   where
     lexer = PT.makeTokenParser haskellStyle
     edgeParser :: P.GenParser Char st [(Node, Node, Double)]

src/Data/Graph/Clustering/FLouvain.hs

@@ -123,12 +123,21 @@ sumEdgeWeights :: Adj (FEdge b) -> Double
 sumEdgeWeights es = sum $ map (fedgeWeight . fst) es
 type FGraph a b = Gr a (FEdge b)
 
--- Used for k_i in formula (2)
+-- | 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)
--- Used for k_i,in in formula (2)
+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 -> Context a (FEdge b) -> NodeComWeightSum
+nodeComWeightSum com (p, _, _, s) =
+  NodeComWeightSum $ sumEdgeWeights $ filter (\(_, n) -> n `elem` 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)
@@ -168,7 +177,7 @@ type CGrEdge = (InWeightSum, TotWeightSum)
 type CGr = Gr Community ()
 
 graphWeight :: FGraph a b -> GraphWeightSum
-graphWeight gr = GraphWeightSum $ ufold weight' 0 gr
+graphWeight gr = GraphWeightSum $ 0.5 * ufold weight' 0 gr
   where
     weight' (p, _, _, s) acc = acc + (sumEdgeWeights $ p <> s)
 
@@ -189,7 +198,8 @@ initialCGr gr = gmap singletonCom gr
         edges = lneighbors gr v
         -- no internal links
         iws = InWeightSum 0.0
-        -- just sum over the edges coming into/out of node v
+        -- Just sum over the edges coming into/out of node v.  This is because
+        -- there are no inner links, all other nodes are external.
         tws = TotWeightSum $ sumEdgeWeights edges
 
 -- ALGORITHM
@@ -198,20 +208,21 @@ initialCGr gr = gmap singletonCom gr
 -- We just fold over the communities (this is because of the delta(c_i, c_j)
 -- param)
 modularity :: FGraph a b -> CGr -> GraphWeightSum -> Modularity
-modularity gr cgr m = Modularity $ 0.5 * ( ufold modularity' 0.0 cgr ) / (unGraphWeightSum m)
+modularity gr cgr m = Modularity $ coeff * ( ufold modularity' 0.0 cgr )
   where
-    -- sum over nodes in community
-    -- \Sum A_ij is just the InWeightSum
+    coeff = 0.5 / (unGraphWeightSum m)
+    -- Sum over nodes in community
+    -- \Sum A_ij is just the InWeightSum (in formula (1) it is sum of weights
+    -- between nodes i and j both in the same community, as enforced by the
+    -- \delta(c_i, c_j) symbol)
     modularity' (_, _, com, _) acc = acc + component
       where
         component = (unInWeightSum $ comInWeightSum com) - weightsMul
-        weightsMul = 0.5 * ( sum $ map weightsMul' $ comNodes com ) / (unGraphWeightSum m)
+        weightsMul = coeff * ( sum $ map weightsMul' $ comNodes com )
         weightsMul' n = (ki n) * (sum $ map ki $ comNodes com)
         -- k_i variable in formula (1)
         ki :: Node -> Double
-        ki n = sumEdgeWeights $ p <> s
-          where
-            (p, _, _, s) = context gr n
+        ki n = unNodeWeightSum $ nodeWeightSum $ context gr n
 
 type Delta = Community -> NodeWeightSum -> NodeComWeightSum -> GraphWeightSum -> DeltaQ
 -- | Delta Q function from Louvain paper (2).
@@ -249,7 +260,7 @@ iteration gr cs = xdfsFoldWith suc' (\(_, v, _, _)
 -- | Step for one node. We try re-assign it to a neighbouring community, where
 -- the increase of modularity for graph will be the largest
 step :: GraphWeightSum -> CFunFold a (FEdge b) CGr
-step gw ctx@(p, v, l, s) cgr = newCgr
+step gw ctx@(_, v, _, _) cgr = newCgr
   where
     newCgr = case mNc of
       Nothing -> cgr
@@ -278,11 +289,11 @@ step gw ctx@(p, v, l, s) cgr = newCgr
     --                   , map (makeMove Into) ncs )
 
     makeMove :: Direction -> LNode Community -> LNode Community
-    makeMove direction (cn, c) = (cn, moveNodeWithNeighbours (p <> s) v direction c)
+    makeMove direction (cn, c) = (cn, moveNodeWithContext ctx direction c)
 
     -- k_i variable in formula (2)
     ki :: NodeWeightSum
-    ki = NodeWeightSum $ sumEdgeWeights $ p <> s
+    ki = nodeWeightSum ctx
 
     deltas :: [(LNode Community, DeltaQ)]
     deltas = map (\c -> (c, delta' c)) ncs
@@ -303,10 +314,6 @@ step gw ctx@(p, v, l, s) cgr = newCgr
     -- So the Delta function takes as parameters:
     -- C, (edges from C in cgr), (edges from v in gr), (edges from v to C), (edges in gr)
 
-nodeComWeightSum :: Community -> Context a (FEdge b) -> NodeComWeightSum
-nodeComWeightSum com (_, _, _, s) =
-  NodeComWeightSum $ sumEdgeWeights $ filter (\(_, n) -> n `elem` comNodes com) s
-
 -- COMMUNITY GRAPH FUNCTIONS
 
 -- | 'Direction' when moving node 'Into'/'OutOf' community
@@ -325,7 +332,7 @@ nodeNeighbours :: Node -> CGr -> [LNode Community]
 nodeNeighbours n cgr =
   case nodeCommunity n cgr of
     Nothing        -> []
-    Just (cn, _) -> mapMaybe (lnode cgr) (neighbors cgr cn)
+    Just (cn, _)  -> mapMaybe (lnode cgr) (neighbors cgr cn)
 
 -- | Find 'Ajd CGrEdge's of 'Community' graph neighbouring a given node
 -- nodeLNeighbours :: Node -> CGr -> Adj CGrEdge
@@ -335,15 +342,15 @@ nodeNeighbours n cgr =
 --     Just (cn, _) -> lneighbors cgr cn
 
 -- | Moves 'Node' in the 'Direction' of 'Community' and recomputes 'Community''s weights
-moveNode :: FGraph a b -> Node -> Direction -> Community -> Community
-moveNode gr n direction c = moveNodeWithNeighbours lnNeighbors n direction c
+moveNode :: forall a b. FGraph a b -> Node -> Direction -> Community -> Community
+moveNode gr n direction c = moveNodeWithContext ctx direction c
   where
-    --lnNeighbors :: Adj (FEdge b)
-    lnNeighbors = lneighbors gr n
+    ctx :: Context a (FEdge b)
+    ctx = context gr n
 
--- | Same as 'moveNode' above but with only node neighbours, not whole graph
-moveNodeWithNeighbours :: forall b. Adj (FEdge b) -> Node -> Direction -> Community -> Community
-moveNodeWithNeighbours lnNeighbors n direction (Community (ns, inwsum, totwsum)) =
+-- | Same as 'moveNode' above but with only node context, not whole graph
+moveNodeWithContext :: forall a b. Context a (FEdge b) -> Direction -> Community -> Community
+moveNodeWithContext ctx@(_, n, _, _) direction com@(Community (ns, inwsum, totwsum)) =
   Community (newNs, InWeightSum newInWsum, TotWeightSum newTotWsum)
     where
       newNs = case direction of
@@ -352,24 +359,20 @@ moveNodeWithNeighbours lnNeighbors n direction (Community (ns, inwsum, totwsum))
 
       (newInWsum, newTotWsum) =
         case direction of
-          Into  -> (unInWeightSum inwsum + sumN, unTotWeightSum totwsum - sumNonCom)
-          OutOf -> (unInWeightSum inwsum - sumN, unTotWeightSum totwsum + sumNonCom)
-
-      -- Update InWeightSum with connections between node and the community
-      sumN :: Double
-      sumN = sumEdgeWeights comNeighbors
+          Into  -> (unInWeightSum inwsum + unNodeComWeightSum cws, unTotWeightSum totwsum - sumNonCom)
+          OutOf -> (unInWeightSum inwsum - unNodeComWeightSum cws, unTotWeightSum totwsum + sumNonCom)
 
-      -- Update TotWeightSum, subtracting connections between node and community
-      -- and adding connections of node to non-community
-      sumNonCom :: Double
-      sumNonCom = sumEdgeWeights nonComNeighbors
+      -- k_i
+      nws :: NodeWeightSum
+      nws = nodeWeightSum ctx
 
-      -- Node Adj Context
-      comNeighbors    :: Adj (FEdge b)
-      comNeighbors    = filter (\ln -> snd ln `elem`    ns) lnNeighbors
+      -- sum of edge weights inside community
+      cws :: NodeComWeightSum
+      cws = nodeComWeightSum com ctx
 
-      nonComNeighbors :: Adj (FEdge b)
-      nonComNeighbors = filter (\ln -> snd ln `notElem` ns) lnNeighbors
+      -- sum of weights of node outside of community
+      sumNonCom :: Double
+      sumNonCom = unNodeWeightSum nws - unNodeComWeightSum cws
 
 
 {-