Commit 23e00a61 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[FLouvain] TotWeightSum bug fix

Should have computed only links incident to C, not the ones inside C.
parent d05ffebf
...@@ -36,6 +36,7 @@ doi:10.1088/1742-5468/2008/10/P10008. ...@@ -36,6 +36,7 @@ doi:10.1088/1742-5468/2008/10/P10008.
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Graph.Clustering.FLouvain module Data.Graph.Clustering.FLouvain
where where
...@@ -138,9 +139,11 @@ newtype NodeComWeightSum = NodeComWeightSum { unNodeComWeightSum :: Double } ...@@ -138,9 +139,11 @@ newtype NodeComWeightSum = NodeComWeightSum { unNodeComWeightSum :: Double }
newtype GraphWeightSum = GraphWeightSum { unGraphWeightSum :: Double } newtype GraphWeightSum = GraphWeightSum { unGraphWeightSum :: Double }
deriving (Show, Eq, Ord) deriving (Show, Eq, Ord)
-- | This is the \Sum_in in formula (2) of the Louvain paper -- | 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 } newtype InWeightSum = InWeightSum { unInWeightSum :: Double }
deriving (Show, Eq, Ord) deriving (Show, Eq, Ord)
-- | This is the \Sum_tot in formula (2) of the Louvain paper -- | 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 } newtype TotWeightSum = TotWeightSum { unTotWeightSum :: Double }
deriving (Show, Eq, Ord) deriving (Show, Eq, Ord)
-- | Computed Delta_Q value in (2) -- | Computed Delta_Q value in (2)
...@@ -279,7 +282,7 @@ step gw ctx@(p, v, l, s) cgr = newCgr ...@@ -279,7 +282,7 @@ step gw ctx@(p, v, l, s) cgr = newCgr
-- k_i variable in formula (2) -- k_i variable in formula (2)
ki :: NodeWeightSum ki :: NodeWeightSum
ki = NodeWeightSum $ sum $ map (fedgeWeight . fst) $ p <> s ki = NodeWeightSum $ sumEdgeWeights $ p <> s
deltas :: [(LNode Community, DeltaQ)] deltas :: [(LNode Community, DeltaQ)]
deltas = map (\c -> (c, delta' c)) ncs deltas = map (\c -> (c, delta' c)) ncs
...@@ -302,7 +305,7 @@ step gw ctx@(p, v, l, s) cgr = newCgr ...@@ -302,7 +305,7 @@ step gw ctx@(p, v, l, s) cgr = newCgr
nodeComWeightSum :: Community -> Context a (FEdge b) -> NodeComWeightSum nodeComWeightSum :: Community -> Context a (FEdge b) -> NodeComWeightSum
nodeComWeightSum com (_, _, _, s) = nodeComWeightSum com (_, _, _, s) =
NodeComWeightSum $ sum $ map (fedgeWeight . fst) $ filter (\(_, n) -> n `elem` comNodes com) s NodeComWeightSum $ sumEdgeWeights $ filter (\(_, n) -> n `elem` comNodes com) s
-- COMMUNITY GRAPH FUNCTIONS -- COMMUNITY GRAPH FUNCTIONS
...@@ -339,41 +342,35 @@ moveNode gr n direction c = moveNodeWithNeighbours lnNeighbors n direction c ...@@ -339,41 +342,35 @@ moveNode gr n direction c = moveNodeWithNeighbours lnNeighbors n direction c
lnNeighbors = lneighbors gr n lnNeighbors = lneighbors gr n
-- | Same as 'moveNode' above but with only node neighbours, not whole graph -- | Same as 'moveNode' above but with only node neighbours, not whole graph
moveNodeWithNeighbours :: Adj (FEdge b) -> Node -> Direction -> Community -> Community moveNodeWithNeighbours :: forall b. Adj (FEdge b) -> Node -> Direction -> Community -> Community
moveNodeWithNeighbours lnNeighbors n direction (Community (ns, inwsum, totwsum)) = moveNodeWithNeighbours lnNeighbors n direction (Community (ns, inwsum, totwsum)) =
Community (newNs, newInWsum, newTotWsum) Community (newNs, InWeightSum newInWsum, TotWeightSum newTotWsum)
where where
newNs = case direction of newNs = case direction of
Into -> n:ns Into -> n:ns
OutOf -> DL.delete n ns OutOf -> DL.delete n ns
(newInWsum, newTotWsum) = computeWeights direction (inwsum, totwsum) sumN sumNonCom (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 -- Update InWeightSum with connections between node and the community
sumN :: Double sumN :: Double
sumN = sum $ map (fedgeWeight . fst) comNeighbors sumN = sumEdgeWeights comNeighbors
-- Update TotWeightSum, subtracting connections between node and community -- Update TotWeightSum, subtracting connections between node and community
-- and adding connections of node to non-community -- and adding connections of node to non-community
sumNonCom :: Double sumNonCom :: Double
sumNonCom = sum $ map (fedgeWeight . fst) nonComNeighbors sumNonCom = sumEdgeWeights nonComNeighbors
-- Node Adj Context -- Node Adj Context
--comNeighbors :: Adj (FEdge b) comNeighbors :: Adj (FEdge b)
comNeighbors = filter (\ln -> snd ln `elem` ns) lnNeighbors comNeighbors = filter (\ln -> snd ln `elem` ns) lnNeighbors
--nonComNeighbors :: Adj (FEdge b) nonComNeighbors :: Adj (FEdge b)
nonComNeighbors = filter (\ln -> snd ln `notElem` ns) lnNeighbors 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 -- | Moves 'Node' between two 'Community'ies, recomputing their weights
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment