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
e11beb6a
Commit
e11beb6a
authored
Jul 28, 2016
by
delanoe
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEAT] InducedGraph.
parent
66def5aa
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
138 additions
and
100 deletions
+138
-100
louvain.cabal
louvain.cabal
+4
-1
Example.hs
src/Data/Example.hs
+83
-0
Louvain.hs
src/Data/Louvain.hs
+22
-99
Utils.hs
src/Data/Utils.hs
+29
-0
No files found.
louvain.cabal
View file @
e11beb6a
...
...
@@ -15,7 +15,10 @@ cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: Data.Louvain, Data.GexfParser
exposed-modules: Data.Louvain
, Data.Utils
, Data.Example
, Data.GexfParser
build-depends: base >= 4.7 && < 5
, fgl
, hxt
...
...
src/Data/Example.hs
0 → 100644
View file @
e11beb6a
module
Data.Example
where
import
Data.Utils
import
Data.GexfParser
import
Data.Graph.Inductive
karate
::
IO
(
Gr
()
Double
)
karate
=
mkGraph'
<$>
importGraphFromGexf
"Data/karate.gexf"
eU
::
[
LEdge
Double
]
eU
=
[
(
2
,
1
,
1
)
,(
1
,
2
,
1
)
,(
1
,
4
,
1
)
,(
4
,
1
,
1
)
,(
2
,
3
,
1
)
,(
3
,
2
,
1
)
,(
3
,
4
,
1
)
,(
4
,
3
,
1
)
,(
4
,
5
,
1
)
,(
5
,
4
,
1
)
]
eD
::
[
LEdge
Double
]
eD
=
[
(
2
,
1
,
1
)
,(
1
,
4
,
1
)
,(
2
,
3
,
1
)
,(
3
,
4
,
1
)
,(
4
,
5
,
1
)
]
gU
::
Gr
()
Double
gU
=
mkGraph'
eU
-- > prettyPrint gU
-- 1:()->[(1,2),(1,4)]
-- 2:()->[(1,1),(1,3)]
-- 3:()->[(1,2),(1,4)]
-- 4:()->[(1,1),(1,3),(1,5)]
-- 5:()->[(1,4)]
-- Visual representation:
--
-- 2
-- / \
-- 1 3
-- \ /
-- 4
-- |
-- 5
--
--
gD
::
Gr
()
Double
gD
=
mkGraph'
eD
eD'
::
[
LEdge
Double
]
eD'
=
[
(
2
,
1
,
1
)
,(
1
,
4
,
1
)
,(
2
,
3
,
1
)
,(
3
,
4
,
1
)
,(
4
,
5
,
1
)
,(
5
,
6
,
1
)
,(
5
,
7
,
1
)
,(
6
,
7
,
1
)
]
gD'
::
Gr
()
Double
gD'
=
mkGraph'
eD'
src/Data/Louvain.hs
View file @
e11beb6a
module
Data.Louvain
where
import
Data.Utils
import
Data.List
(
maximumBy
)
import
Data.Graph.Inductive
import
qualified
Data.Set
as
S
type
Modularity
=
Double
label'
::
(
Graph
gr
)
=>
gr
a
b
->
Edge
->
Maybe
b
label'
gr
(
u
,
v
)
=
lookup
v
(
lsuc
gr
u
)
-- | group nodes and produce a new graph
inducedGraph
::
(
Eq
b
,
Ord
b
,
DynGraph
gr
)
=>
gr
a
b
->
(
Node
,
[
Node
])
->
gr
a
b
inducedGraph
gr
(
a
,
b
)
=
delNodes
b
(
insEdges
newEdges
gr'
)
where
gr'
=
undir
gr
newEdges
=
Prelude
.
map
(
\
(
n
,
l
)
->
(
a
,
n
,
l
))
(
uniq
$
concat
$
Prelude
.
map
(
lsuc
gr'
)
b
)
shortest_path
::
(
Real
b
,
Graph
gr
)
=>
gr
a
b
->
Node
->
Node
->
Path
shortest_path
graph
node_1
node_2
=
sp
node_1
node_2
graph
inducedGraph'
::
(
Ord
b
,
DynGraph
gr
)
=>
gr
a
b
->
[(
Node
,
[
Node
])]
->
gr
a
b
inducedGraph'
gr
ns
=
Prelude
.
foldl
(
\
gr'
n
->
inducedGraph
gr'
n
)
gr
ns
neighbors''
::
DynGraph
gr
=>
gr
a
b
->
[
Node
]
->
[
Node
]
neighbors''
gr
ns
=
uniq
$
concat
(
Prelude
.
map
(
neighbors
gr
)
ns
)
mkGraph'
::
[
LEdge
b
]
->
Gr
()
b
mkGraph'
es
=
mkGraph
ns
es
where
ns
::
[
LNode
()
]
ns
=
zip
[
1
..
(
fromIntegral
.
length
)
ns'
]
(
repeat
()
)
where
ns'
=
S
.
toList
.
S
.
fromList
$
concat
(
Prelude
.
map
edge2nodes
es
)
edge2nodes
::
LEdge
b
->
[
Node
]
edge2nodes
(
a
,
b
,
_
)
=
[
a
,
b
]
eU
::
[
LEdge
Double
]
eU
=
[
(
2
,
1
,
1
)
,(
1
,
2
,
1
)
,(
1
,
4
,
1
)
,(
4
,
1
,
1
)
,(
2
,
3
,
1
)
,(
3
,
2
,
1
)
,(
3
,
4
,
1
)
,(
4
,
3
,
1
)
,(
4
,
5
,
1
)
,(
5
,
4
,
1
)
]
eD
::
[
LEdge
Double
]
eD
=
[
(
2
,
1
,
1
)
,(
1
,
4
,
1
)
,(
2
,
3
,
1
)
,(
3
,
4
,
1
)
,(
4
,
5
,
1
)
]
gU
::
Gr
()
Double
gU
=
mkGraph'
eU
-- > prettyPrint gU
-- 1:()->[(1,2),(1,4)]
-- 2:()->[(1,1),(1,3)]
-- 3:()->[(1,2),(1,4)]
-- 4:()->[(1,1),(1,3),(1,5)]
-- 5:()->[(1,4)]
-- Visual representation:
--
-- 2
-- / \
-- 1 3
-- \ /
-- 4
-- |
-- 5
--
--
gD
::
Gr
()
Double
gD
=
mkGraph'
eD
eD'
::
[
LEdge
Double
]
eD'
=
[
(
2
,
1
,
1
)
,(
1
,
4
,
1
)
,(
2
,
3
,
1
)
,(
3
,
4
,
1
)
,(
4
,
5
,
1
)
,(
5
,
6
,
1
)
,(
5
,
7
,
1
)
,(
6
,
7
,
1
)
]
gD'
::
Gr
()
Double
gD'
=
mkGraph'
eD'
neighcom
::
DynGraph
gr
=>
gr
a
b
->
Node
->
[[
Node
]]
neighcom
gr
n
=
scanl
(
\
x
y
->
take
1
x
++
[
y
])
[
n
]
(
neighbors
gr
n
)
type
Modularity
=
Double
neighcom'
::
DynGraph
gr
=>
gr
a
b
->
[
Node
]
->
[[
Node
]]
neighcom'
gr
ns
=
scanl
(
\
x
y
->
take
1
x
++
[
y
])
ns
(
neighbors''
gr
ns
)
rotate
::
Int
->
[
a
]
->
[
a
]
rotate
_
[]
=
[]
...
...
@@ -120,6 +44,8 @@ separate (x:xs) = let recur = separate xs
return
$
(
x
:
y
)
:
ys
in
split
++
noSplit
separate'
::
forall
a
.
[
a
]
->
[[[
a
]]]
separate'
xs
=
[
takeDrop
t
(
rotate
r
xs
)
|
t
<-
[
1
..
fromIntegral
(
length
xs
)
-
1
]
,
r
<-
[
0
..
fromIntegral
(
length
xs
)
]
...
...
@@ -127,22 +53,19 @@ separate' xs = [ takeDrop t (rotate r xs)
gpartition
::
DynGraph
gr
=>
gr
a
b
->
[[[
Node
]]]
gpartition
gr
=
separate
'
(
nodes
gr
)
gpartition
gr
=
separate
(
nodes
gr
)
modularities
::
DynGraph
gr
=>
gr
a
b
->
[[
Node
]]
->
Double
modularities
gr
xs
=
sum
$
Prelude
.
map
(
\
y
->
modularity
gr
y
)
xs
compareModularity
::
DynGraph
gr
=>
gr
a
b
->
[[
Node
]]
->
[[
Node
]]
->
Ordering
compareModularity
gr
xs
ys
compareModularities
::
DynGraph
gr
=>
gr
a
b
->
[[
Node
]]
->
[[
Node
]]
->
Ordering
compareModularities
gr
xs
ys
|
modularities
gr
xs
<
modularities
gr
ys
=
LT
|
modularities
gr
xs
>
modularities
gr
ys
=
GT
|
otherwise
=
EQ
bestPartition
::
DynGraph
gr
=>
gr
a
b
->
[[
Node
]]
bestPartition
gr
=
maximumBy
(
compareModularity
gr
)
$
gpartition
gr
bestPartition
gr
=
maximumBy
(
compareModularities
gr
)
$
gpartition
gr
modularity
::
DynGraph
gr
=>
gr
a
b
->
[
Node
]
->
Double
modularity
gr
ns
=
coverage
-
edgeDensity
...
...
src/Data/Utils.hs
0 → 100644
View file @
e11beb6a
module
Data.Utils
where
import
Data.Graph.Inductive
import
Data.Set
as
S
(
toList
,
fromList
)
uniq
::
Ord
a
=>
[
a
]
->
[
a
]
uniq
=
toList
.
fromList
label'
::
(
Graph
gr
)
=>
gr
a
b
->
Edge
->
Maybe
b
label'
gr
(
u
,
v
)
=
lookup
v
(
lsuc
gr
u
)
shortest_path
::
(
Real
b
,
Graph
gr
)
=>
gr
a
b
->
Node
->
Node
->
Path
shortest_path
graph
node_1
node_2
=
sp
node_1
node_2
graph
mkGraph'
::
[
LEdge
b
]
->
Gr
()
b
mkGraph'
es
=
mkGraph
ns
es
where
ns
::
[
LNode
()
]
ns
=
zip
[
1
..
(
fromIntegral
.
length
)
ns'
]
(
repeat
()
)
where
ns'
=
uniq
$
concat
(
Prelude
.
map
edge2nodes
es
)
edge2nodes
::
LEdge
b
->
[
Node
]
edge2nodes
(
a
,
b
,
_
)
=
[
a
,
b
]
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