Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
153
Issues
153
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
haskell-gargantext
Commits
d584aed7
Commit
d584aed7
authored
4 years ago
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEAT] bridgeness work
parent
3a533287
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
52 additions
and
25 deletions
+52
-25
Prelude.hs
src/Gargantext/Prelude.hs
+19
-1
Bridgeness.hs
src/Gargantext/Viz/Graph/Bridgeness.hs
+29
-21
Tools.hs
src/Gargantext/Viz/Graph/Tools.hs
+4
-3
No files found.
src/Gargantext/Prelude.hs
View file @
d584aed7
...
...
@@ -30,6 +30,7 @@ module Gargantext.Prelude
,
sortWith
,
module
Prelude
,
MonadBase
(
..
)
,
Map2
,
lookup2
)
where
...
...
@@ -37,6 +38,7 @@ import Control.Monad.Base (MonadBase(..))
import
GHC.Exts
(
sortWith
)
import
GHC.Err.Located
(
undefined
)
import
GHC.Real
(
round
)
import
Data.Map
(
Map
,
lookup
)
import
Data.Maybe
(
isJust
,
fromJust
,
maybe
)
import
Data.Text
(
Text
)
import
Protolude
(
Bool
(
True
,
False
),
Int
,
Int64
,
Double
,
Integer
...
...
@@ -298,9 +300,25 @@ movingAverage steps xs = map mean $ chunkAlong steps 1 xs
ma
::
[
Double
]
->
[
Double
]
ma
=
movingAverage
3
-----------------------------------------------------------------------
fib
::
Int
->
Int
fib
0
=
0
fib
1
=
1
fib
n
=
fib
(
n
-
1
)
+
fib
(
n
-
2
)
-----------------------------------------------------------------------
--- Map in Map = Map2
-- To avoid Map (a,a) b
type
Map2
a
b
=
Map
a
(
Map
a
b
)
lookup2
::
Ord
a
=>
a
->
a
->
Map2
a
b
->
Maybe
b
lookup2
a
b
m
=
do
m'
<-
lookup
a
m
lookup
b
m'
This diff is collapsed.
Click to expand it.
src/Gargantext/Viz/Graph/Bridgeness.hs
View file @
d584aed7
...
...
@@ -10,20 +10,26 @@ Portability : POSIX
Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
filters inter-communities links.
TODO rewrite Bridgeness with "equivalence structurale" metrics
TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence)
TODO use Map LouvainNodeId (Map LouvainNodeId)
-}
{-# LANGUAGE NoImplicitPrelude #-}
module
Gargantext.Viz.Graph.Bridgeness
(
bridgeness
)
where
--import GHC.Base (Semigroup)
import
Data.Ord
(
Down
(
..
))
import
Gargantext.Prelude
--import Data.Tuple.Extra (swap)
--import Gargantext.Viz.Graph
import
Data.Map
(
Map
,
fromListWith
,
lookup
,
fromList
,
delete
,
toList
,
mapKeys
,
mapWithKey
,
elems
)
import
Data.Map
(
Map
,
fromListWith
,
lookup
,
fromList
,
toList
,
mapWithKey
,
elems
)
import
qualified
Data.Map
as
DM
import
Data.Maybe
(
fromJust
)
import
Data.Maybe
(
catMaybes
)
import
Data.List
(
concat
,
sortOn
)
import
Data.Graph.Clustering.Louvain.Utils
(
LouvainNode
(
..
))
...
...
@@ -45,34 +51,36 @@ bridgeness b ns = DM.fromList
.
filterComs
b
.
groupEdges
(
nodeId2comId
ns
)
nodeId2comId
::
[
LouvainNode
]
->
Map
LouvainNodeId
CommunityId
nodeId2comId
ns
=
fromList
[
(
nId
,
cId
)
|
LouvainNode
nId
cId
<-
ns
]
groupEdges
::
Map
LouvainNodeId
CommunityId
->
Map
(
LouvainNodeId
,
LouvainNodeId
)
Double
->
Map
(
CommunityId
,
CommunityId
)
[((
LouvainNodeId
,
LouvainNodeId
),
Double
)]
groupEdges
m
=
mapKeys
fromJust
.
delete
Nothing
.
fromListWith
(
<>
)
groupEdges
m
=
fromListWith
(
<>
)
.
catMaybes
.
map
(
\
((
n1
,
n2
),
d
)
->
((,)
<$>
lookup
n1
m
<*>
lookup
n2
m
,
[((
n1
,
n2
),
d
)]
)
)
->
let
n1n2_m
=
(,)
<$>
lookup
n1
m
<*>
lookup
n2
m
n1n2_d
=
Just
[((
n1
,
n2
),
d
)]
in
(,)
<$>
n1n2_m
<*>
n1n2_d
)
.
toList
-- | TODO : sortOn Confluence
filterComs
::
Bridgeness
->
Map
(
CommunityId
,
CommunityId
)
[((
LouvainNodeId
,
LouvainNodeId
),
Double
)]
->
Map
(
CommunityId
,
CommunityId
)
[((
LouvainNodeId
,
LouvainNodeId
),
Double
)]
filterComs
b
m
=
mapWithKey
filter'
m
where
filter'
(
c1
,
c2
)
a
=
case
c1
==
c2
of
True
->
a
False
->
take
n
$
sortOn
snd
a
where
n
=
round
$
b
*
a'
/
t
a'
=
fromIntegral
$
length
a
t
=
fromIntegral
$
length
$
concat
$
elems
m
filter'
(
c1
,
c2
)
a
|
c1
==
c2
=
a
|
otherwise
=
take
n
$
sortOn
(
Down
.
snd
)
a
where
n
=
round
$
100
*
b
*
a'
/
t
a'
=
fromIntegral
$
length
a
t
=
fromIntegral
$
length
$
concat
$
elems
m
This diff is collapsed.
Click to expand it.
src/Gargantext/Viz/Graph/Tools.hs
View file @
d584aed7
...
...
@@ -15,6 +15,7 @@ Portability : POSIX
module
Gargantext.Viz.Graph.Tools
where
import
Debug.Trace
(
trace
)
import
Data.Graph.Clustering.Louvain.Utils
(
LouvainNode
(
..
))
-- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
import
Data.Graph.Clustering.Louvain.CplusPlus
(
cLouvain
)
...
...
@@ -71,14 +72,14 @@ cooc2graph threshold myCooc = do
partitions
<-
if
(
Map
.
size
distanceMap
>
0
)
--then iLouvainMap 100 10 distanceMap
--
then iLouvainMap 100 10 distanceMap
-- then hLouvain distanceMap
then
cLouvain
level
distanceMap
else
panic
"Text.Flow: DistanceMap is empty"
let
bridgeness'
=
distanceMap
_bridgeness'
=
bridgeness
rivers
partitions
distanceMap
--
bridgeness' = distanceMap
bridgeness'
=
trace
(
"Rivers: "
<>
show
rivers
)
$
bridgeness
rivers
partitions
distanceMap
confluence'
=
confluence
(
Map
.
keys
bridgeness'
)
3
True
False
pure
$
data2graph
(
Map
.
toList
ti
)
myCooc'
bridgeness'
confluence'
partitions
...
...
This diff is collapsed.
Click to expand it.
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