[FLouvain] some work on fold, types, comments, main algorithm

clustering-louvain.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 0eb2bbc80a3d9343540c4d5c0c2ff6adee085a9a75364b8f5344890891c5b781
+-- hash: 94042062aa43112f36f9b8d21fcddf66dd7d8201d0e3d64a23cc48a34878a1de
 
 name:           clustering-louvain
 version:        0.1.0.0
@@ -42,5 +42,6 @@ library
       Data.Graph.Clustering.Example
       Data.Graph.Clustering.FLouvain
       Data.Graph.Clustering.HLouvain
+      Data.Graph.Clustering.HyperGraph
       Paths_clustering_louvain
   default-language: Haskell2010

src/Data/Graph/Clustering/FLouvain.hs

@@ -17,6 +17,95 @@ Portability : POSIX
 module Data.Graph.Clustering.FLouvain
   where
 
-import Data.Graph.Inductive (DynGraph, Node, Graph)
+import Protolude
+import Data.Graph.Inductive
 
 
+
+-- Our algorithm is divided into two phases that are repeated
+-- iteratively. Assume that we start with a weighted network of N nodes. First,
+-- we assign a different community to each node of the network. So, in this
+-- initial partition there are as many communities as there are nodes. Then, for
+-- each node i we consider the neighbours j of i and we evaluate the gain of
+-- modularity that would take place by removing i from its community and by
+-- placing it in the community of j. The node i is then placed in the community
+-- for which this gain is maximum (in the case of a tie we use a breaking rule),
+-- but only if this gain is positive. If no positive gain is possible, i stays
+-- in its original community. This process is applied repeatedly and
+-- sequentially for all nodes until no further improvement can be achieved and
+-- the first phase is then complete.
+
+
+-- | 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
+  Nothing -> Nothing
+  Just l  -> Just (n, l)
+
+-- We need to implement a fold over graph
+
+type CFoldFun a b c = c -> Context a b -> c
+
+xdfsFoldWith :: (Graph gr)
+    => CFun a b [Node]
+    -> CFoldFun a b c
+    -> c
+    -> [Node]
+    -> gr a b
+    -> c
+xdfsFoldWith _ _ acc [] _            = acc
+xdfsFoldWith _ _ acc _ g | isEmpty g = acc
+xdfsFoldWith d f acc (v:vs) g = case match v g of
+                                 (Just c, g')  -> xdfsFoldWith d f (f acc c) (d c++vs) g'
+                                 (Nothing, g') -> xdfsFoldWith d f acc vs g'
+
+
+-- This is the \Sum_in in formula (2) of Louvain paper
+type WeightSum = Double
+newtype Community = Community { unCommunity ::  ([Node], WeightSum) }
+
+type CGrNode = Node
+type CGrEdge = Double
+
+type CGr = Gr Community CGrEdge
+
+
+-- ALGORITHM
+
+-- | One iteration step takes the graph and existing communities as a graph and
+-- computes new community graph
+iteration :: (Graph gr) => gr a b -> CGr -> CGr
+iteration gr cs = xdfsFoldWith suc' step cs (nodes gr) gr
+
+-- TODO Remember to filter out empty Communities
+step :: CFoldFun a b CGr
+step cgr (p, v, l, s) = cgr
+  where
+    nc = nodeCommunity v cgr
+    ncs = nodeNeighbours v cgr
+    -- TODO Compute \Delta Q (gain of moving node v into Community C) which consists of:
+    -- - Community WeightSum
+    -- - sum of weights of links incident to nodes in C
+    -- - sum of weights of links incident to node v
+    -- - sum of weights of links from node v to nodes in C
+    -- - sum of weights of all the links in the network
+    -- 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)
+
+
+-- COMMUNITY GRAPH FUNCTIONS
+
+-- | Given 'Node' and 'Community' graph, find the 'LNode' of 'Community' which
+-- contains the node
+nodeCommunity :: Node -> CGr -> Maybe (LNode Community)
+nodeCommunity n cgr = head (filter f $ labNodes cgr)
+  where
+    f :: (a, Community) -> Bool
+    f (_, Community ns) = n `elem` fst ns
+
+-- | Find 'LNodes' of 'Community' graph neighbouring a given node
+nodeNeighbours :: Node -> CGr -> [LNode Community]
+nodeNeighbours n cgr =
+  case nodeCommunity n cgr of
+    Nothing        -> []
+    Just c@(cn, _) -> [c] <> mapMaybe (lnode cgr) (neighbors cgr cn)