[FLouvain] delta Q formula using newtypes

.gitignore

+.DS_Store
+.stack-work
+.idea
+*.log
+tmp/
+
+

src/Data/Graph/Clustering/FLouvain.hs

@@ -98,6 +98,10 @@ newtype TotWeightSum = TotWeightSum { unTotWeightSum :: Double }
 newtype Community = Community { unCommunity ::  ([Node], InWeightSum, TotWeightSum) }
 comNodes :: Community -> [Node]
 comNodes (Community (ns, _, _)) = ns
+comInWeightSum :: Community -> InWeightSum
+comInWeightSum (Community (_, inWeightSum, _)) = inWeightSum
+comTotWeightSum :: Community -> TotWeightSum
+comTotWeightSum (Community (_, _, totWeightSum)) = totWeightSum
 
 type CGrNode = Node
 type CGrEdge = (InWeightSum, TotWeightSum)
@@ -111,10 +115,20 @@ type CGr = Gr Community CGrEdge
 modularity :: Gr a b -> CGr -> Double
 modularity gr cgr = 0.0
 
-type Delta a b = Gr a b -> Node -> Community -> Double
+type Delta = Community -> Weight -> Weight -> Weight -> Double
 -- | Delta Q function from Louvain paper (2).
-delta :: Delta a b
-delta gr n (Community (ns, inWeightSum, totWeightSum)) = 0.0
+delta :: Delta
+delta com ki kin m = acc - dec
+  where
+    inWeightSum = comInWeightSum com
+    totWeightSum = comTotWeightSum com
+    acc = accL - accR*accR
+    accL = 0.5*(unInWeightSum inWeightSum + 2.0*(unWeight kin)) / (unWeight m)
+    accR = 0.5*(unTotWeightSum totWeightSum + unWeight ki) / (unWeight m)
+    dec = decL - decM*decM - decR*decR
+    decL = 0.5*(unInWeightSum inWeightSum) / (unWeight m)
+    decM = 0.5*(unTotWeightSum totWeightSum) / (unWeight m)
+    decR = 0.5*(unWeight ki) / (unWeight m)
 
 -- | One iteration step takes the graph and existing communities as a graph and
 -- computes new community graph
@@ -137,7 +151,7 @@ step (p, v, l, s) cgr = cgr
     moves = case mNc of
       Nothing -> Nothing
       Just nc -> Just ( makeMove OutOf nc
-                      , makeMove Into <$> ncs )
+                      , map (makeMove Into) ncs )
 
     makeMove :: Direction -> LNode Community -> LNode Community
     makeMove direction (cn, c) = (cn, moveNodeWithNeighbours (p <> s) v direction c)

stack.yaml

@@ -18,7 +18,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-11.10
+resolver: lts-14.27
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -62,4 +62,4 @@ packages:
 # extra-lib-dirs: [/path/to/dir]
 #
 # Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
\ No newline at end of file
+# compiler-check: newer-minor