[flouvain] more static typing

src/Data/Graph/Clustering/FLouvain.hs

@@ -43,7 +43,6 @@ module Data.Graph.Clustering.FLouvain
 import Protolude
 import Data.Graph.Inductive
 import qualified Data.List as DL
-import Data.Tuple.Extra (fst3)
 
 --  "glue" : function to gather/merge communities
 --  "klue" : function to split communities
@@ -83,14 +82,22 @@ xdfsFoldWith d f acc (v:vs) g =
 ------------------------------------------------------------------------
 
 -- Our basic graph. Nodes have custom labels. Edges have weight assigned to them.
-type FEdge = Double
-type FGraph a = Gr a FEdge
+newtype Weight = Weight { unWeight :: Double }
+type FEdge b = (Weight, b)
+fedgeWeight :: FEdge b -> Double
+fedgeWeight = unWeight . fst
+type FGraph a b = Gr a (FEdge b)
 
 -- | This is the \Sum_in in formula (2) of Louvain paper
-type InWeightSum = Double
+newtype InWeightSum = InWeightSum { unInWeightSum :: Double }
+instance Num InWeightSum where
+  (InWeightSum w1) + (InWeightSum w2) = InWeightSum (w1 + w2)
+  (InWeightSum w1) * (InWeightSum w2) = InWeightSum (w1 * w2)
 -- | This is the \Sum_tot in formula (2) of Louvain paper
-type TotWeightSum = Double
+newtype TotWeightSum = TotWeightSum { unTotWeightSum :: Double }
 newtype Community = Community { unCommunity ::  ([Node], InWeightSum, TotWeightSum) }
+comNodes :: Community -> [Node]
+comNodes (Community (ns, _, _)) = ns
 
 type CGrNode = Node
 type CGrEdge = (InWeightSum, TotWeightSum)
@@ -100,6 +107,10 @@ type CGr = Gr Community CGrEdge
 
 -- ALGORITHM
 
+-- | Q function from Louvain paper (1).
+modularity :: Gr a b -> CGr -> Double
+modularity gr cgr = 0.0
+
 type Delta a b = Gr a b -> Node -> Community -> Double
 -- | Delta Q function from Louvain paper (2).
 delta :: Delta a b
@@ -107,13 +118,16 @@ delta gr n (Community (ns, inWeightSum, totWeightSum)) = 0.0
 
 -- | One iteration step takes the graph and existing communities as a graph and
 -- computes new community graph
-iteration :: FGraph a -> CGr -> CGr
+iteration :: FGraph a b -> CGr -> CGr
 iteration gr cs = xdfsFoldWith suc' step cs (nodes gr) gr
+  where
+    --weightSum = ufold weightSum' 0 gr
+    --weightSum' (p, v, l, s) acc = acc + (sum )
 
 -- TODO Remember to filter out empty Communities
 -- | 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 :: CFunFold a FEdge CGr
+step :: CFunFold a (FEdge b) CGr
 step (p, v, l, s) cgr = cgr
   where
     mNc = nodeCommunity  v cgr
@@ -123,16 +137,18 @@ step (p, v, l, s) cgr = cgr
     moves = case mNc of
       Nothing -> Nothing
       Just nc -> Just ( makeMove OutOf nc
-                      , map (makeMove Into) ncs )
+                      , makeMove Into <$> ncs )
 
     makeMove :: Direction -> LNode Community -> LNode Community
     makeMove direction (cn, c) = (cn, moveNodeWithNeighbours (p <> s) v direction c)
 
+    --bestFit = maximumBy
+
     -- 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
+    -- - Community InWeightSum
+    -- - Community TotWeightSum
+    -- - sum of weights of links incident to node v (taken from 'p' and 's')
+    -- - sum of weights of links from node v to nodes in C (taken from 'p' and 's')
     -- - 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)
@@ -149,7 +165,7 @@ nodeCommunity :: Node -> CGr -> Maybe (LNode Community)
 nodeCommunity n cgr = head (filter f $ labNodes cgr)
   where
     f :: (a, Community) -> Bool
-    f (_, Community com) = n `elem` fst3 com
+    f (_, com) = n `elem` comNodes com
 
 -- | Find 'LNode's of 'Community' graph neighbouring a given node
 nodeNeighbours :: Node -> CGr -> [LNode Community]
@@ -166,14 +182,14 @@ nodeLNeighbours n cgr =
     Just (cn, _) -> lneighbors cgr cn
 
 -- | Moves 'Node' in the 'Direction' of 'Community' and recomputes 'Community''s weights
-moveNode :: FGraph a -> Node -> Direction -> Community -> Community
+moveNode :: FGraph a b -> Node -> Direction -> Community -> Community
 moveNode gr n direction c = moveNodeWithNeighbours lnNeighbors n direction c
   where
-    lnNeighbors :: Adj FEdge
+    --lnNeighbors :: Adj (FEdge b)
     lnNeighbors = lneighbors gr n
 
 -- | Same as 'moveNode' above but with only node neighbours, not whole graph
-moveNodeWithNeighbours :: Adj FEdge -> Node -> Direction -> Community -> Community
+moveNodeWithNeighbours :: Adj (FEdge b) -> Node -> Direction -> Community -> Community
 moveNodeWithNeighbours lnNeighbors n direction (Community (ns, inwsum, totwsum)) =
   Community (newNs, newInWsum, newTotWsum)
     where
@@ -182,30 +198,32 @@ moveNodeWithNeighbours lnNeighbors n direction (Community (ns, inwsum, totwsum))
         Into  -> n:ns
         OutOf -> DL.delete n ns
 
-      newInWsum  = inwsum  + directionN * sumN
-      newTotWsum = totwsum + directionN * (sumN - sumNonCom)
-
-      directionN :: Double
-      directionN = case direction of
-        Into  ->  1
-        OutOf -> -1
+      (newInWsum, newTotWsum) = computeWeights direction (inwsum, totwsum) sumN sumNonCom
 
       -- Update InWeightSum with connections between node and the community
-      sumN :: InWeightSum
-      sumN = sum $ map fst comNeighbors
+      sumN :: Double
+      sumN = sum $ map (fedgeWeight . fst) comNeighbors
 
       -- Update TotWeightSum, subtracting connections between node and community
       -- and adding connections of node to non-community
-      sumNonCom :: TotWeightSum
-      sumNonCom = sum $ map fst nonComNeighbors
+      sumNonCom :: Double
+      sumNonCom = sum $ map (fedgeWeight . fst) nonComNeighbors
 
       -- Node Adj Context
-      comNeighbors    :: Adj FEdge
+      --comNeighbors    :: Adj (FEdge b)
       comNeighbors    = filter (\ln -> snd ln `elem`    ns) lnNeighbors
 
-      nonComNeighbors :: Adj FEdge
+      --nonComNeighbors :: Adj (FEdge b)
       nonComNeighbors = filter (\ln -> snd ln `notElem` ns) lnNeighbors
 
+-- | Recomputes 'InWeightSum' when node is moved in the 'Direciton' of
+-- 'Community'. Given parameters are:
+computeWeights :: Direction -> (InWeightSum, TotWeightSum) -> Double -> Double -> (InWeightSum, TotWeightSum)
+computeWeights Into (InWeightSum inwsum, TotWeightSum totwsum) sumN sumNonCom =
+  (InWeightSum $ inwsum  + sumN, TotWeightSum $ totwsum + sumN - sumNonCom)
+computeWeights OutOf (InWeightSum inwsum, TotWeightSum totwsum) sumN sumNonCom =
+  (InWeightSum $ inwsum  - sumN, TotWeightSum $ totwsum - sumN + sumNonCom)
+
 
 {-
 -- | Moves 'Node' between two 'Community'ies, recomputing their weights