[FLouvain] more tests and fixes

clustering-louvain.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 77a387aa4e98e27142bd5c5045e96b48f1108c72aefe2509cb74c5e47f5674cc
+-- hash: e1e53adbd24148d990b70f078530a01370effd8531413470ea9947aa095bf247
 
 name:           clustering-louvain
 version:        0.1.0.0
@@ -60,7 +60,8 @@ test-suite louvain-test
   default-extensions: ConstrainedClassMethods FlexibleInstances InstanceSigs NoImplicitPrelude OverloadedStrings ScopedTypeVariables TupleSections
   ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base
+      HUnit-approx
+    , base
     , clustering-louvain
     , containers
     , extra

package.yaml

@@ -63,6 +63,7 @@ tests:
     - fgl
     - hspec
     - hspec-discover
+    - HUnit-approx
     - protolude
 
 #  louvain-doctest:

src/Data/Graph/Clustering/FLouvain.hs

@@ -97,6 +97,12 @@ nodeComWeightSum :: Community -> 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 -> 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)
@@ -313,25 +319,20 @@ moveNodeWithContext ctx@(_, n, _, _) direction com@(Community (ns, inwsum, totws
   Community (newNs, InWeightSum newInWsum, TotWeightSum newTotWsum)
     where
       newNs = case direction of
-        Into  -> n:ns
+        Into  -> sort (n:ns)
         OutOf -> DL.delete n ns
 
       (newInWsum, newTotWsum) =
         case direction of
-          Into  -> (unInWeightSum inwsum + unNodeComWeightSum cws, unTotWeightSum totwsum - sumNonCom)
-          OutOf -> (unInWeightSum inwsum - unNodeComWeightSum cws, unTotWeightSum totwsum + sumNonCom)
-
-      -- k_i
-      nws :: NodeWeightSum
-      nws = nodeWeightSum ctx
+          Into  -> (unInWeightSum inwsum + unNodeComWeightSum cws, unTotWeightSum totwsum - unNodeComWeightSum cws + unNodeNonComWeightSum nws)
+          OutOf -> (unInWeightSum inwsum - unNodeComWeightSum cws, unTotWeightSum totwsum + unNodeComWeightSum cws - unNodeNonComWeightSum nws)
 
       -- sum of edge weights inside community
       cws :: NodeComWeightSum
       cws = nodeComWeightSum com ctx
 
-      -- sum of weights of node outside of community
-      sumNonCom :: Double
-      sumNonCom = unNodeWeightSum nws - unNodeComWeightSum cws
+      nws :: NodeNonComWeightSum
+      nws = nodeNonComWeightSum com ctx
 
 
 {-

test/FLouvainSpec.hs

 module FLouvainSpec where
 
 import Test.Hspec
+import Test.HUnit.Approx (assertApproxEqual)
 
 import Protolude
 
 -- FGL
 import Data.Graph.Inductive
+import qualified Data.Graph.Inductive as DGI
+import Data.List ((!!))
 
 import Data.Graph.Clustering.FLouvain
 import Data.Graph.Clustering.Louvain.Utils (mkFGraph, mkFGraph')
@@ -15,7 +18,7 @@ import Data.Graph.FGL
 
 simpleGraph :: FGraph () ()
 simpleGraph = mkFGraph' [ (1, 2, 1.0)
-                        , (2, 3, 1.0)
+                        , (2, 3, 2.0)
                         ]
 
 simpleLGraph :: FGraph Text ()
@@ -29,17 +32,95 @@ spec :: Spec
 spec = do
   describe "FLouvain tests" $ do
     it "graphWeight computes correctly" $ do
-      graphWeight simpleGraph `shouldBe` GraphWeightSum 2.0
+      graphWeight simpleGraph `shouldBe` GraphWeightSum 3.0
+
+    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
+
+    it "replaceLNode works correctly" $ do
+      let replaced = replaceLNode simpleLGraph (1, "ONE")
+      nodes replaced `shouldBe` [1, 2, 3]
+      lnodes replaced `shouldBe` ["ONE", "two", "three"]
 
     it "initialCgr computes correctly" $ do
       let cgr = initialCGr simpleGraph
           communities = lnodes cgr
+          iws0 = InWeightSum 0.0
       nodes cgr `shouldBe` [1, 2, 3]
       edges cgr `shouldBe` [ (1, 2)
                            , (2, 3) ]
-      map comNodes communities `shouldBe` [[1], [2], [3]]
+      Protolude.map comNodes communities `shouldBe` [[1], [2], [3]]
+      Protolude.map comInWeightSum communities `shouldBe` [iws0, iws0, iws0]
+      Protolude.map comTotWeightSum communities `shouldBe`
+        [ TotWeightSum 1.0
+        , TotWeightSum 3.0
+        , TotWeightSum 2.0 ]
 
-    it "replaceLNode works correctly" $ do
-      let replaced = replaceLNode simpleLGraph (1, "ONE")
-      nodes replaced `shouldBe` [1, 2, 3]
-      lnodes replaced `shouldBe` ["ONE", "two", "three"]
+    it "nodeComWeightSum computes correctly" $ do
+      let cgr = initialCGr simpleGraph
+          communities = lnodes cgr
+          fstCom = communities !! 0
+          sndCom = communities !! 1
+          trdCom = communities !! 2
+      nodeComWeightSum fstCom (DGI.context simpleGraph 1) `shouldBe` NodeComWeightSum 0.0
+      nodeComWeightSum fstCom (DGI.context simpleGraph 2) `shouldBe` NodeComWeightSum 1.0
+      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 trdCom (DGI.context simpleGraph 1) `shouldBe` NodeComWeightSum 0.0
+      nodeComWeightSum trdCom (DGI.context simpleGraph 2) `shouldBe` NodeComWeightSum 2.0
+      nodeComWeightSum trdCom (DGI.context simpleGraph 3) `shouldBe` NodeComWeightSum 0.0
+
+    it "modularity computes correctly" $ do
+      let cgr = initialCGr simpleGraph
+          m = graphWeight simpleGraph
+          mod = modularity simpleGraph cgr m
+          c1 = 0.0 - (1.0 * 1.0) / (2.0 * 3.0)
+          c2 = 0.0 - (3.0 * 3.0) / (2.0 * 3.0)
+          c3 = 0.0 - (2.0 * 2.0) / (2.0 * 3.0)
+          mMod = (c1 + c2 + c3) / (2.0 * 3.0)
+      assertApproxEqual "modularities don't match"
+                        0.000001
+                        mMod
+                        (unModularity mod)
+
+    it "nodeCommunity works correctly" $ do
+      let cgr = initialCGr simpleGraph
+          communities = lnodes cgr
+      (nodeCommunity 1 cgr) `shouldBe` Just (1, communities !! 0)
+      (nodeCommunity 2 cgr) `shouldBe` Just (2, communities !! 1)
+      (nodeCommunity 3 cgr) `shouldBe` Just (3, communities !! 2)
+
+    it "nodeNeighbours works correctly" $ do
+      let cgr = initialCGr simpleGraph
+          communities = lnodes cgr
+      (nodeNeighbours 1 cgr) `shouldBe` [(2, communities !! 1)]
+      (nodeNeighbours 2 cgr) `shouldBe` [(1, communities !! 0), (3, communities !! 2)]
+      (nodeNeighbours 3 cgr) `shouldBe` [(2, communities !! 1)]
+
+    it "moveNodeWithContext works correctly" $ do
+      let cgr = initialCGr simpleGraph
+          communities = lnodes cgr
+          ctx1 = DGI.context simpleGraph 1
+          ctx2 = DGI.context simpleGraph 2
+          ctx3 = DGI.context simpleGraph 3
+          com1 = communities !! 0
+          com2 = communities !! 1
+          newCom1 = moveNodeWithContext ctx1 OutOf com1
+          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)
+
+      -- TODO moveNodeWithContext ctx Into (moveNodeWithContext ctx OutOf) is an
+      -- identity, this can be used in QuickCheck testing
+      -- Same thing the other way (OutOf . Into)
+      intoOutOf ctx1 com2 `shouldBe` com2
+      outOfInto ctx1 com1 `shouldBe` com1
+
+      intoOutOf ctx3 newCom2 `shouldBe` newCom2
+      outOfInto ctx2 newCom2 `shouldBe` newCom2