Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
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
Przemyslaw Kaminski
haskell-gargantext
Commits
2e5deaad
Commit
2e5deaad
authored
Apr 01, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Graph] Haskell version removing the c++ one (tech+legal issue mainly).
parent
0c8ff7c1
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
44 additions
and
40 deletions
+44
-40
API.hs
src/Gargantext/Viz/Graph/API.hs
+3
-0
Tools.hs
src/Gargantext/Viz/Graph/Tools.hs
+40
-39
stack.yaml
stack.yaml
+1
-1
No files found.
src/Gargantext/Viz/Graph/API.hs
View file @
2e5deaad
...
...
@@ -181,3 +181,6 @@ graphAsync' u n logStatus = do
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
src/Gargantext/Viz/Graph/Tools.hs
View file @
2e5deaad
...
...
@@ -15,9 +15,9 @@ Portability : POSIX
module
Gargantext.Viz.Graph.Tools
where
import
Debug.Trace
(
trace
)
import
Data.Graph.Clustering.Louvain.Utils
(
LouvainNode
(
..
))
import
Data.Graph.Clustering.Louvain.CplusPlus
(
cLouvain
)
import
Data.Graph.Clustering.Louvain
(
hLouvain
,
{-iLouvainMap-}
)
-- import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
import
Data.Map
(
Map
)
import
qualified
Data.Set
as
Set
import
Data.Text
(
Text
)
...
...
@@ -53,33 +53,33 @@ cooc2graph' threshold myCooc = distanceMap
cooc2graph
::
Threshold
->
(
Map
(
Text
,
Text
)
Int
)
->
IO
Graph
cooc2graph
threshold
myCooc
=
do
let
(
ti
,
_
)
=
createIndices
myCooc
myCooc'
=
toIndex
ti
myCooc
matCooc
=
map2mat
0
(
Map
.
size
ti
)
$
Map
.
filter
(
>
1
)
myCooc'
distanceMat
=
measureConditional
matCooc
distanceMap
=
Map
.
filter
(
>
threshold
)
$
mat2map
distanceMat
->
Graph
cooc2graph
threshold
myCooc
=
data2graph
(
Map
.
toList
ti
)
myCooc'
bridgeness'
confluence'
partitions
where
(
ti
,
_
)
=
createIndices
myCooc
myCooc'
=
toIndex
ti
myCooc
matCooc
=
map2mat
0
(
Map
.
size
ti
)
$
Map
.
filter
(
>
1
)
myCooc'
distanceMat
=
measureConditional
matCooc
distanceMap
=
Map
.
filter
(
>
threshold
)
$
mat2map
distanceMat
let
nodesApprox
::
Int
nodesApprox
=
n'
where
(
as
,
bs
)
=
List
.
unzip
$
Map
.
keys
distanceMap
n'
=
Set
.
size
$
Set
.
fromList
$
as
<>
bs
ClustersParams
rivers
level
=
{-trace ("nodesApprox: " <> show nodesApprox) $-}
clustersParams
nodesApprox
nodesApprox
::
Int
nodesApprox
=
n'
where
(
as
,
bs
)
=
List
.
unzip
$
Map
.
keys
distanceMap
n'
=
Set
.
size
$
Set
.
fromList
$
as
<>
bs
ClustersParams
rivers
_level
=
clustersParams
nodesApprox
partitions
<-
inMVarIO
$
case
Map
.
size
distanceMap
>
0
of
True
->
trace
(
"level"
<>
show
level
)
$
cLouvain
level
distanceMap
False
->
panic
"Text.Flow: DistanceMap is empty"
partitions
=
if
(
Map
.
size
distanceMap
>
0
)
--then iLouvainMap 100 10 distanceMap
then
hLouvain
distanceMap
else
panic
"Text.Flow: DistanceMap is empty"
-- True -> trace ("level" <> show level) $ cLouvain level distanceMap
bridgeness'
<-
trace
"bridgeness"
$
inMVar
$
{-trace ("rivers: " <> show rivers) $-}
bridgeness
rivers
partitions
distanceMap
bridgeness'
=
bridgeness
rivers
partitions
distanceMap
confluence'
<-
trace
"confluence"
$
inMVar
$
confluence
(
Map
.
keys
bridgeness'
)
3
True
False
confluence'
=
confluence
(
Map
.
keys
bridgeness'
)
3
True
False
r
<-
trace
"data2graph"
$
inMVarIO
$
data2graph
(
Map
.
toList
ti
)
myCooc'
bridgeness'
confluence'
partitions
pure
r
...
...
@@ -106,12 +106,13 @@ data2graph :: [(Text, Int)]
->
Map
(
Int
,
Int
)
Double
->
Map
(
Int
,
Int
)
Double
->
[
LouvainNode
]
->
IO
Graph
data2graph
labels
coocs
bridge
conf
partitions
=
do
let
community_id_by_node_id
=
Map
.
fromList
[
(
n
,
c
)
|
LouvainNode
n
c
<-
partitions
]
->
Graph
data2graph
labels
coocs
bridge
conf
partitions
=
Graph
nodes
edges
Nothing
where
nodes
<-
mapM
(
setCoord
ForceAtlas
labels
bridge
)
community_id_by_node_id
=
Map
.
fromList
[
(
n
,
c
)
|
LouvainNode
n
c
<-
partitions
]
nodes
=
map
(
setCoord
ForceAtlas
labels
bridge
)
[
(
n
,
Node
{
node_size
=
maybe
0
identity
(
Map
.
lookup
(
n
,
n
)
coocs
)
,
node_type
=
Terms
-- or Unknown
,
node_id
=
cs
(
show
n
)
...
...
@@ -129,7 +130,7 @@ data2graph labels coocs bridge conf partitions = do
$
Map
.
toList
bridge
]
let
edges
=
[
Edge
{
edge_source
=
cs
(
show
s
)
edges
=
[
Edge
{
edge_source
=
cs
(
show
s
)
,
edge_target
=
cs
(
show
t
)
,
edge_weight
=
d
,
edge_confluence
=
maybe
0
identity
$
Map
.
lookup
(
s
,
t
)
conf
...
...
@@ -138,7 +139,6 @@ data2graph labels coocs bridge conf partitions = do
|
(
i
,
((
s
,
t
),
d
))
<-
zip
([
0
..
]
::
[
Integer
])
(
Map
.
toList
bridge
),
s
/=
t
,
d
>
0
]
pure
$
Graph
nodes
edges
Nothing
------------------------------------------------------------------------
...
...
@@ -152,22 +152,23 @@ setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
-- | ACP
setCoord
::
Ord
a
=>
Layout
->
[(
a
,
Int
)]
->
Map
(
Int
,
Int
)
Double
->
(
Int
,
Node
)
->
IO
Node
setCoord
l
labels
m
(
n
,
node
)
=
getCoord
l
labels
m
n
>>=
\
(
x
,
y
)
->
pure
$
node
{
node_x_coord
=
x
,
node_y_coord
=
y
}
setCoord
::
Ord
a
=>
Layout
->
[(
a
,
Int
)]
->
Map
(
Int
,
Int
)
Double
->
(
Int
,
Node
)
->
Node
setCoord
l
labels
m
(
n
,
node
)
=
node
{
node_x_coord
=
x
,
node_y_coord
=
y
}
where
(
x
,
y
)
=
getCoord
l
labels
m
n
getCoord
::
Ord
a
=>
Layout
->
[(
a
,
Int
)]
->
Map
(
Int
,
Int
)
Double
->
Int
->
IO
(
Double
,
Double
)
getCoord
KamadaKawai
_
m
n
=
layout
m
n
->
[(
a
,
Int
)]
->
Map
(
Int
,
Int
)
Double
->
Int
->
(
Double
,
Double
)
getCoord
KamadaKawai
_
_m
_n
=
undefined
--
layout m n
getCoord
ForceAtlas
_
_
n
=
pure
(
sin
d
,
cos
d
)
getCoord
ForceAtlas
_
_
n
=
(
sin
d
,
cos
d
)
where
d
=
fromIntegral
n
getCoord
ACP
labels
m
n
=
pure
$
to2d
$
maybe
(
panic
"Graph.Tools no coordinate"
)
identity
getCoord
ACP
labels
m
n
=
to2d
$
maybe
(
panic
"Graph.Tools no coordinate"
)
identity
$
Map
.
lookup
n
$
pcaReduceTo
(
Dimension
2
)
$
mapArray
labels
m
...
...
stack.yaml
View file @
2e5deaad
...
...
@@ -49,7 +49,7 @@ extra-deps:
-
git
:
https://github.com/np/servant-job.git
commit
:
4016c76398a56e1a352a45b3ee9d698dd0dd2597
-
git
:
https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
commit
:
f8fd33e4e9639730d47cd02b223a0f8fbbbfe975
commit
:
7d74f96dfea8e51fbab1793cc0429b2fe741f73d
-
git
:
https://github.com/np/patches-map
commit
:
8c6f38c4844ead53e664cf9c82ba461715dbe445
-
git
:
https://github.com/delanoe/haskell-opaleye.git
#- opaleye-0.6.7002.0
...
...
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