Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
clustering-louvain
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
1
Issues
1
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
clustering-louvain
Commits
14159f5a
Commit
14159f5a
authored
Mar 21, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[flouvain] more static typing
parent
1851c3ee
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
47 additions
and
29 deletions
+47
-29
FLouvain.hs
src/Data/Graph/Clustering/FLouvain.hs
+47
-29
No files found.
src/Data/Graph/Clustering/FLouvain.hs
View file @
14159f5a
...
...
@@ -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
,
ma
p
(
makeMove
Into
)
ncs
)
,
ma
keMove
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
In
WeightSum
-- -
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
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment