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
0
Issues
0
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
Christian Merten
haskell-gargantext
Commits
d721d97d
Commit
d721d97d
authored
Oct 14, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[WIP] bridgeness optim
parent
a4b448de
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
23 additions
and
39 deletions
+23
-39
Bridgeness.hs
src/Gargantext/Core/Viz/Graph/Bridgeness.hs
+21
-37
Tools.hs
src/Gargantext/Core/Viz/Graph/Tools.hs
+2
-2
No files found.
src/Gargantext/Core/Viz/Graph/Bridgeness.hs
View file @
d721d97d
...
@@ -19,10 +19,9 @@ TODO use Map LouvainNodeId (Map LouvainNodeId)
...
@@ -19,10 +19,9 @@ TODO use Map LouvainNodeId (Map LouvainNodeId)
module
Gargantext.Core.Viz.Graph.Bridgeness
-- (bridgeness)
module
Gargantext.Core.Viz.Graph.Bridgeness
-- (bridgeness)
where
where
import
D
ata.List
(
concat
,
sortOn
)
import
D
ebug.Trace
(
trace
)
import
Data.Map
(
Map
,
fromListWith
,
lookup
,
toList
,
mapWithKey
,
elems
)
import
Data.Map
(
Map
,
fromListWith
,
lookup
,
toList
,
mapWithKey
,
elems
)
import
Data.Maybe
(
catMaybes
,
fromMaybe
)
import
Data.Maybe
(
catMaybes
)
import
Data.Set
(
Set
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Graph.Types
(
ClusterNode
(
..
))
import
Graph.Types
(
ClusterNode
(
..
))
import
Data.Ord
(
Down
(
..
))
import
Data.Ord
(
Down
(
..
))
...
@@ -30,7 +29,6 @@ import Data.IntMap (IntMap)
...
@@ -30,7 +29,6 @@ import Data.IntMap (IntMap)
import
qualified
Data.IntMap
as
IntMap
import
qualified
Data.IntMap
as
IntMap
import
qualified
Data.List
as
List
import
qualified
Data.List
as
List
import
qualified
Data.Map
as
Map
import
qualified
Data.Map
as
Map
import
qualified
Data.Set
as
Set
----------------------------------------------------------------------
----------------------------------------------------------------------
type
Partitions
a
=
Map
(
Int
,
Int
)
Double
->
IO
[
a
]
type
Partitions
a
=
Map
(
Int
,
Int
)
Double
->
IO
[
a
]
...
@@ -50,10 +48,24 @@ instance ToComId ClusterNode where
...
@@ -50,10 +48,24 @@ instance ToComId ClusterNode where
type
Bridgeness
=
Double
type
Bridgeness
=
Double
type
Confluence
=
Map
(
NodeId
,
NodeId
)
Double
type
Confluence
=
Map
(
NodeId
,
NodeId
)
Double
bridgeness3
::
Confluence
bridgeness3
::
Confluence
->
Map
(
NodeId
,
NodeId
)
Double
->
Map
(
NodeId
,
NodeId
)
Double
->
Map
(
NodeId
,
NodeId
)
Double
->
Map
(
NodeId
,
NodeId
)
Double
bridgeness3
_
m
=
m
bridgeness3
c
m
=
Map
.
fromList
$
map
fst
$
List
.
take
n
$
List
.
sortOn
(
Down
.
snd
)
$
catMaybes
$
map
(
\
(
ks
,
v
)
->
(,)
<$>
Just
(
ks
,
v
)
<*>
look
ks
c'
)
$
Map
.
toList
m
where
!
c'
=
map2intMap
c
!
m'
=
Map
.
toList
m
n
::
Int
!
n
=
trace
(
"bridgeness m size: "
<>
(
show
$
List
.
length
m'
))
$
round
$
(
fromIntegral
$
List
.
length
m'
)
/
(
10
::
Double
)
map2intMap
::
Map
(
Int
,
Int
)
a
->
IntMap
(
IntMap
a
)
map2intMap
::
Map
(
Int
,
Int
)
a
->
IntMap
(
IntMap
a
)
map2intMap
m
=
IntMap
.
fromListWith
(
<>
)
map2intMap
m
=
IntMap
.
fromListWith
(
<>
)
...
@@ -64,41 +76,13 @@ map2intMap m = IntMap.fromListWith (<>)
...
@@ -64,41 +76,13 @@ map2intMap m = IntMap.fromListWith (<>)
$
Map
.
toList
m
$
Map
.
toList
m
look
::
(
Int
,
Int
)
->
IntMap
(
IntMap
a
)
->
Maybe
a
look
::
(
Int
,
Int
)
->
IntMap
(
IntMap
a
)
->
Maybe
a
look
(
k1
,
k2
)
m
=
if
k1
>
k2
look
(
k1
,
k2
)
m
=
if
k1
<
k2
then
case
(
IntMap
.
lookup
k1
m
)
of
then
case
(
IntMap
.
lookup
k1
m
)
of
Just
m'
->
IntMap
.
lookup
k2
m'
Just
m'
->
IntMap
.
lookup
k2
m'
_
->
Nothing
_
->
Nothing
else
look
(
k2
,
k1
)
m
else
look
(
k2
,
k1
)
m
bridgeness2
::
Confluence
->
Map
(
NodeId
,
NodeId
)
Double
->
Map
(
NodeId
,
NodeId
)
Double
bridgeness2
c
m
=
Map
.
fromList
$
List
.
filter
(
\
((
k1
,
k2
),
_v
)
->
if
k1
<
k2
then
fromMaybe
False
(
Set
.
member
k2
<$>
IntMap
.
lookup
k1
toKeep
)
else
fromMaybe
False
(
Set
.
member
k1
<$>
IntMap
.
lookup
k2
toKeep
)
)
$
m'
where
toKeep
::
IntMap
(
Set
NodeId
)
!
toKeep
=
IntMap
.
fromListWith
(
<>
)
$
map
(
\
((
k1
,
k2
),
_v
)
->
if
k1
<
k2
then
(
k1
,
Set
.
singleton
k2
)
else
(
k2
,
Set
.
singleton
k1
)
)
$
List
.
take
n
$
List
.
sortOn
(
Down
.
snd
)
$
catMaybes
$
map
(
\
ks
->
(,)
<$>
Just
ks
<*>
look
ks
c'
)
$
Map
.
keys
m
c'
=
map2intMap
c
!
m'
=
Map
.
toList
m
n
::
Int
!
n
=
round
$
(
fromIntegral
$
List
.
length
m'
)
/
(
2
::
Double
)
{-
{-
n :: Int
n :: Int
n = Set.size $ Set.fromList $ as <> bs
n = Set.size $ Set.fromList $ as <> bs
...
@@ -119,7 +103,7 @@ bridgeness = bridgenessWith nodeId2comId
...
@@ -119,7 +103,7 @@ bridgeness = bridgenessWith nodeId2comId
->
Map
(
Int
,
Int
)
Double
->
Map
(
Int
,
Int
)
Double
->
Map
(
Int
,
Int
)
Double
->
Map
(
Int
,
Int
)
Double
bridgenessWith
f
b
ns
=
Map
.
fromList
bridgenessWith
f
b
ns
=
Map
.
fromList
.
concat
.
List
.
concat
.
Map
.
elems
.
Map
.
elems
.
filterComs
b
.
filterComs
b
.
groupEdges
(
Map
.
fromList
$
map
f
ns
)
.
groupEdges
(
Map
.
fromList
$
map
f
ns
)
...
@@ -149,13 +133,13 @@ filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
...
@@ -149,13 +133,13 @@ filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
filter'
(
c1
,
c2
)
a
filter'
(
c1
,
c2
)
a
|
c1
==
c2
=
a
|
c1
==
c2
=
a
-- TODO use n here
-- TODO use n here
|
otherwise
=
take
1
$
sortOn
(
Down
.
snd
)
a
|
otherwise
=
take
1
$
List
.
sortOn
(
Down
.
snd
)
a
where
where
_n
::
Int
_n
::
Int
_n
=
round
$
100
*
a'
/
t
_n
=
round
$
100
*
a'
/
t
a'
=
fromIntegral
$
length
a
a'
=
fromIntegral
$
length
a
t
::
Double
t
::
Double
t
=
fromIntegral
$
length
$
concat
$
elems
m
t
=
fromIntegral
$
length
$
List
.
concat
$
elems
m
--------------------------------------------------------------
--------------------------------------------------------------
...
...
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @
d721d97d
...
@@ -26,7 +26,7 @@ import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
...
@@ -26,7 +26,7 @@ import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
import
Gargantext.Core.Methods.Similarities.Conditional
(
conditional
)
import
Gargantext.Core.Methods.Similarities.Conditional
(
conditional
)
import
Gargantext.Core.Statistics
import
Gargantext.Core.Statistics
import
Gargantext.Core.Viz.Graph
import
Gargantext.Core.Viz.Graph
import
Gargantext.Core.Viz.Graph.Bridgeness
(
bridgeness
2
,
Partitions
,
ToComId
(
..
))
import
Gargantext.Core.Viz.Graph.Bridgeness
(
bridgeness
3
,
Partitions
,
ToComId
(
..
))
import
Gargantext.Core.Viz.Graph.Index
(
createIndices
,
toIndex
,
map2mat
,
mat2map
,
Index
,
MatrixShape
(
..
))
import
Gargantext.Core.Viz.Graph.Index
(
createIndices
,
toIndex
,
map2mat
,
mat2map
,
Index
,
MatrixShape
(
..
))
import
Gargantext.Core.Viz.Graph.Tools.IGraph
(
mkGraphUfromEdges
,
spinglass
)
import
Gargantext.Core.Viz.Graph.Tools.IGraph
(
mkGraphUfromEdges
,
spinglass
)
import
Gargantext.Core.Viz.Graph.Tools.Infomap
(
infomap
)
import
Gargantext.Core.Viz.Graph.Tools.Infomap
(
infomap
)
...
@@ -130,7 +130,7 @@ cooc2graphWith' doPartitions multi similarity threshold strength myCooc = do
...
@@ -130,7 +130,7 @@ cooc2graphWith' doPartitions multi similarity threshold strength myCooc = do
let
let
!
confluence'
=
BAC
.
computeConfluences
3
(
Map
.
keys
bridgeness'
)
True
!
confluence'
=
BAC
.
computeConfluences
3
(
Map
.
keys
bridgeness'
)
True
!
bridgeness'
=
bridgeness
2
confluence'
distanceMap
!
bridgeness'
=
bridgeness
3
confluence'
distanceMap
pure
$
data2graph
multi
ti
diag
bridgeness'
confluence'
partitions
pure
$
data2graph
multi
ti
diag
bridgeness'
confluence'
partitions
type
Reverse
=
Bool
type
Reverse
=
Bool
...
...
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