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
149
Issues
149
List
Board
Labels
Milestones
Merge Requests
4
Merge Requests
4
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
3676c91f
Commit
3676c91f
authored
Oct 13, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[WIP] bridgeness2 needs optim
parent
3b5169dd
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
63 additions
and
19 deletions
+63
-19
Bridgeness.hs
src/Gargantext/Core/Viz/Graph/Bridgeness.hs
+53
-11
Tools.hs
src/Gargantext/Core/Viz/Graph/Tools.hs
+4
-8
Ngrams.hs
src/Gargantext/Database/Schema/Ngrams.hs
+6
-0
No files found.
src/Gargantext/Core/Viz/Graph/Bridgeness.hs
View file @
3676c91f
...
...
@@ -14,17 +14,21 @@ TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence)
TODO use Map LouvainNodeId (Map LouvainNodeId)
-}
{-# LANGUAGE BangPatterns #-}
module
Gargantext.Core.Viz.Graph.Bridgeness
-- (bridgeness)
where
import
Data.List
(
concat
,
sortOn
)
import
Data.Map
(
Map
,
fromListWith
,
lookup
,
toList
,
mapWithKey
,
elems
)
import
Data.Maybe
(
catMaybes
)
import
Data.
Ord
(
Down
(
..
)
)
import
Data.Maybe
(
catMaybes
,
fromMaybe
)
import
Data.
Set
(
Set
)
import
Gargantext.Prelude
import
Graph.Types
(
ClusterNode
(
..
))
import
qualified
Data.Map
as
DM
import
Data.Ord
(
Down
(
..
))
import
qualified
Data.List
as
List
import
qualified
Data.Map
as
Map
import
qualified
Data.Set
as
Set
----------------------------------------------------------------------
type
Partitions
a
=
Map
(
Int
,
Int
)
Double
->
IO
[
a
]
...
...
@@ -42,24 +46,62 @@ instance ToComId ClusterNode where
----------------------------------------------------------------------
----------------------------------------------------------------------
type
Bridgeness
=
Double
type
Confluence
=
Map
(
NodeId
,
NodeId
)
Double
bridgeness3
::
Confluence
->
Map
(
NodeId
,
NodeId
)
Double
->
Map
(
NodeId
,
NodeId
)
Double
bridgeness3
_
m
=
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
<$>
Map
.
lookup
k1
toKeep
)
else
fromMaybe
False
(
Set
.
member
k1
<$>
Map
.
lookup
k2
toKeep
)
)
$
m'
where
toKeep
::
Map
NodeId
(
Set
NodeId
)
!
toKeep
=
Map
.
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
)
$
Map
.
toList
c
!
m'
=
Map
.
toList
m
n
::
Int
!
n
=
round
$
(
fromIntegral
$
List
.
length
m'
)
/
(
2
::
Double
)
{-
n :: Int
n = Set.size $ Set.fromList $ as <> bs
where
(as, bs) = List.unzip $ Map.keys m
-}
bridgeness
::
ToComId
a
=>
Bridgeness
=>
Confluence
->
[
a
]
->
Map
(
NodeId
,
NodeId
)
Double
->
Map
(
NodeId
,
NodeId
)
Double
bridgeness
=
bridgenessWith
nodeId2comId
where
bridgenessWith
::
(
a
->
(
Int
,
Int
))
->
Bridgeness
->
Confluence
->
[
a
]
->
Map
(
Int
,
Int
)
Double
->
Map
(
Int
,
Int
)
Double
bridgenessWith
f
b
ns
=
DM
.
fromList
.
concat
.
DM
.
elems
.
filterComs
b
.
groupEdges
(
DM
.
fromList
$
map
f
ns
)
bridgenessWith
f
b
ns
=
Map
.
fromList
.
concat
.
Map
.
elems
.
filterComs
b
.
groupEdges
(
Map
.
fromList
$
map
f
ns
)
groupEdges
::
(
Ord
a
,
Ord
b1
)
...
...
@@ -81,7 +123,7 @@ filterComs :: (Ord n1, Eq n2)
=>
p
->
Map
(
n2
,
n2
)
[(
a3
,
n1
)]
->
Map
(
n2
,
n2
)
[(
a3
,
n1
)]
filterComs
_b
m
=
DM
.
filter
(
\
n
->
length
n
>
0
)
$
mapWithKey
filter'
m
filterComs
_b
m
=
Map
.
filter
(
\
n
->
length
n
>
0
)
$
mapWithKey
filter'
m
where
filter'
(
c1
,
c2
)
a
|
c1
==
c2
=
a
...
...
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @
3676c91f
...
...
@@ -26,7 +26,7 @@ import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
import
Gargantext.Core.Methods.Similarities.Conditional
(
conditional
)
import
Gargantext.Core.Statistics
import
Gargantext.Core.Viz.Graph
import
Gargantext.Core.Viz.Graph.Bridgeness
(
bridgeness
,
Partitions
,
ToComId
(
..
))
import
Gargantext.Core.Viz.Graph.Bridgeness
(
bridgeness
2
,
Partitions
,
ToComId
(
..
))
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.Infomap
(
infomap
)
...
...
@@ -127,14 +127,10 @@ cooc2graphWith' doPartitions multi similarity threshold strength myCooc = do
,
"Tutorial: link todo"
]
length
partitions
`
seq
`
return
()
let
nodesApprox
::
Int
nodesApprox
=
n'
where
(
as
,
bs
)
=
List
.
unzip
$
Map
.
keys
distanceMap
n'
=
Set
.
size
$
Set
.
fromList
$
as
<>
bs
!
confluence'
=
BAC
.
computeConfluences
3
(
Map
.
keys
bridgeness'
)
True
!
bridgeness'
=
bridgeness
(
fromIntegral
nodesApprox
)
partitions
distanceMap
!
bridgeness'
=
bridgeness
2
confluence'
distanceMap
pure
$
data2graph
multi
ti
diag
bridgeness'
confluence'
partitions
type
Reverse
=
Bool
...
...
@@ -177,7 +173,7 @@ doSimilarityMap Conditional threshold strength myCooc = (distanceMap, toIndex ti
where
myCooc'
=
Map
.
fromList
$
HashMap
.
toList
myCooc
(
ti
,
_it
)
=
createIndices
myCooc'
links
=
round
(
let
n
::
Double
=
fromIntegral
(
Map
.
size
ti
)
in
n
*
log
n
)
links
=
round
(
let
n
::
Double
=
fromIntegral
(
Map
.
size
ti
)
in
n
*
(
log
n
)
^
(
2
::
Int
)
)
distanceMap
=
toIndex
ti
$
Map
.
fromList
$
List
.
take
links
...
...
src/Gargantext/Database/Schema/Ngrams.hs
View file @
3676c91f
...
...
@@ -99,6 +99,12 @@ instance FromJSONKey NgramsType where
fromJSONKey
=
FromJSONKeyTextParser
(
parseJSON
.
String
)
instance
ToJSON
NgramsType
where
toJSON
Authors
=
String
"Authors"
toJSON
Institutes
=
String
"Institutes"
toJSON
Sources
=
String
"Sources"
toJSON
NgramsTerms
=
String
"Terms"
instance
ToJSONKey
NgramsType
where
toJSONKey
=
toJSONKeyText
(
pack
.
show
)
instance
FromHttpApiData
NgramsType
where
...
...
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