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
32783b34
Commit
32783b34
authored
May 31, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[REFACT] Graph coordinates.
parent
46aefabe
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
56 additions
and
20 deletions
+56
-20
Bridgeness.hs
src/Gargantext/Viz/Graph/Bridgeness.hs
+1
-0
Proxemy.hs
src/Gargantext/Viz/Graph/Proxemy.hs
+1
-0
Tools.hs
src/Gargantext/Viz/Graph/Tools.hs
+54
-20
No files found.
src/Gargantext/Viz/Graph/Bridgeness.hs
View file @
32783b34
...
@@ -10,6 +10,7 @@ Portability : POSIX
...
@@ -10,6 +10,7 @@ Portability : POSIX
Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
filters inter-communities links.
filters inter-communities links.
TODO rewrite Bridgeness with "equivalence structurale" metrics
-}
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
...
...
src/Gargantext/Viz/Graph/Proxemy.hs
View file @
32783b34
...
@@ -15,6 +15,7 @@ Références:
...
@@ -15,6 +15,7 @@ Références:
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module
Gargantext.Viz.Graph.Proxemy
module
Gargantext.Viz.Graph.Proxemy
where
where
...
...
src/Gargantext/Viz/Graph/Tools.hs
View file @
32783b34
...
@@ -7,7 +7,6 @@ Maintainer : team@gargantext.org
...
@@ -7,7 +7,6 @@ Maintainer : team@gargantext.org
Stability : experimental
Stability : experimental
Portability : POSIX
Portability : POSIX
-}
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
...
@@ -16,17 +15,18 @@ Portability : POSIX
...
@@ -16,17 +15,18 @@ Portability : POSIX
module
Gargantext.Viz.Graph.Tools
module
Gargantext.Viz.Graph.Tools
where
where
import
Debug.Trace
(
trace
)
import
Data.Graph.Clustering.Louvain.CplusPlus
(
LouvainNode
(
..
))
import
Data.Graph.Clustering.Louvain.CplusPlus
(
LouvainNode
(
..
))
import
Data.Graph.Clustering.Louvain.CplusPlus
(
cLouvain
)
import
Data.Graph.Clustering.Louvain.CplusPlus
(
cLouvain
)
import
Data.Map
(
Map
)
import
Data.Map
(
Map
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Core.Statistics
import
Gargantext.Core.Statistics
import
Gargantext.Viz.Graph
(
Graph
(
..
))
import
Gargantext.Viz.Graph
import
Gargantext.Viz.Graph
-- (Graph(..))
--import Gargantext.Viz.Graph.Bridgeness (bridgeness)
import
Gargantext.Viz.Graph.Bridgeness
(
bridgeness
)
import
Gargantext.Viz.Graph.Distances.Matrice
(
measureConditional
)
import
Gargantext.Viz.Graph.Distances.Matrice
(
measureConditional
)
import
Gargantext.Viz.Graph.Index
(
createIndices
,
toIndex
,
map2mat
,
mat2map
)
import
Gargantext.Viz.Graph.Index
(
createIndices
,
toIndex
,
map2mat
,
mat2map
)
import
GHC.Float
(
sin
,
cos
)
import
qualified
Data.Vector.Storable
as
Vec
import
qualified
Data.Vector.Storable
as
Vec
import
qualified
Data.Map
as
Map
import
qualified
Data.Map
as
Map
...
@@ -42,7 +42,7 @@ cooc2graph myCooc = do
...
@@ -42,7 +42,7 @@ cooc2graph myCooc = do
True
->
cLouvain
distanceMap
True
->
cLouvain
distanceMap
False
->
panic
"Text.Flow: DistanceMap is empty"
False
->
panic
"Text.Flow: DistanceMap is empty"
let
distanceMap'
=
bridgeness
300
partitions
distanceMap
let
distanceMap'
=
distanceMap
--
bridgeness 300 partitions distanceMap
pure
$
data2graph
(
Map
.
toList
ti
)
myCooc4
distanceMap'
partitions
pure
$
data2graph
(
Map
.
toList
ti
)
myCooc4
distanceMap'
partitions
...
@@ -57,8 +57,8 @@ data2graph :: [(Text, Int)] -> Map (Int, Int) Int
...
@@ -57,8 +57,8 @@ data2graph :: [(Text, Int)] -> Map (Int, Int) Int
data2graph
labels
coocs
distance
partitions
=
Graph
nodes
edges
Nothing
data2graph
labels
coocs
distance
partitions
=
Graph
nodes
edges
Nothing
where
where
community_id_by_node_id
=
Map
.
fromList
[
(
n
,
c
)
|
LouvainNode
n
c
<-
partitions
]
community_id_by_node_id
=
Map
.
fromList
[
(
n
,
c
)
|
LouvainNode
n
c
<-
partitions
]
nodes
=
map
(
setCoord
mapCoord
)
nodes
=
map
(
setCoord
ForceAtlas
labels
distance
)
[
(
n
,
Node
{
node_size
=
maybe
0
identity
(
Map
.
lookup
(
n
,
n
)
coocs
)
[
(
n
,
Node
{
node_size
=
maybe
0
identity
(
Map
.
lookup
(
n
,
n
)
coocs
)
,
node_type
=
Terms
-- or Unknown
,
node_type
=
Terms
-- or Unknown
,
node_id
=
cs
(
show
n
)
,
node_id
=
cs
(
show
n
)
...
@@ -72,32 +72,66 @@ data2graph labels coocs distance partitions = Graph nodes edges Nothing
...
@@ -72,32 +72,66 @@ data2graph labels coocs distance partitions = Graph nodes edges Nothing
|
(
l
,
n
)
<-
labels
|
(
l
,
n
)
<-
labels
]
]
edges
=
[
Edge
{
edge_source
=
cs
(
show
s
)
edges
=
trace
(
show
distance
)
[
Edge
{
edge_source
=
cs
(
show
s
)
,
edge_target
=
cs
(
show
t
)
,
edge_target
=
cs
(
show
t
)
,
edge_weight
=
w
,
edge_weight
=
w
,
edge_id
=
cs
(
show
i
)
}
,
edge_id
=
cs
(
show
i
)
}
|
(
i
,
((
s
,
t
),
w
))
<-
zip
([
0
..
]
::
[
Integer
])
(
Map
.
toList
distance
)
]
|
(
i
,
((
s
,
t
),
w
))
<-
zip
([
0
..
]
::
[
Integer
])
(
Map
.
toList
distance
)
]
mapCoord
=
pcaReduceTo
(
Dimension
2
)
$
mapArray
labels
distance
setCoord
::
Map
Int
(
Vec
.
Vector
Double
)
->
(
Int
,
Node
)
->
Node
setCoord
m
(
n
,
node
)
=
node
{
node_x_coord
=
x
,
node_y_coord
=
y
}
------------------------------------------------------------------------
data
Layout
=
KamadaKawai
|
ACP
|
ForceAtlas
setCoord''
::
Layout
->
(
Int
,
Node
)
->
Node
setCoord''
ForceAtlas
=
setCoord'
(
\
i
->
(
sin
$
fromIntegral
i
,
cos
$
fromIntegral
i
))
setCoord''
ACP
=
undefined
setCoord''
KamadaKawai
=
undefined
setCoord'
::
(
Int
->
(
Double
,
Double
))
->
(
Int
,
Node
)
->
Node
setCoord'
f
(
i
,
n
)
=
n
{
node_x_coord
=
x
,
node_y_coord
=
y
}
where
where
(
x
,
y
)
=
to2d
$
maybe
(
panic
"Graph.Tools no coordinate"
)
identity
$
Map
.
lookup
n
m
(
x
,
y
)
=
f
i
to2d
::
Vec
.
Vector
Double
->
(
Double
,
Double
)
-- | ACP
to2d
v
=
(
x
,
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
where
ds
=
take
2
$
Vec
.
toList
v
(
x
,
y
)
=
getCoord
l
labels
m
n
x
=
head'
"to2d"
ds
y
=
last'
"to2d"
ds
mapArray
::
Ord
a
=>
[(
a
,
Int
)]
->
Map
(
Int
,
Int
)
Double
->
Map
Int
(
Vec
.
Vector
Double
)
getCoord
::
Ord
a
=>
Layout
mapArray
items
m
=
Map
.
fromList
[
toVec
n
ns
m
|
n
<-
ns
]
->
[(
a
,
Int
)]
->
Map
(
Int
,
Int
)
Double
->
Int
->
(
Double
,
Double
)
getCoord
KamadaKawai
_
_
_
=
undefined
getCoord
ForceAtlas
_
_
n
=
(
sin
d
,
cos
d
)
where
where
ns
=
map
snd
items
d
=
fromIntegral
n
getCoord
ACP
labels
m
n
=
to2d
$
maybe
(
panic
"Graph.Tools no coordinate"
)
identity
$
Map
.
lookup
n
$
pcaReduceTo
(
Dimension
2
)
$
mapArray
labels
m
where
to2d
::
Vec
.
Vector
Double
->
(
Double
,
Double
)
to2d
v
=
(
x'
,
y'
)
where
ds
=
take
2
$
Vec
.
toList
v
x'
=
head'
"to2d"
ds
y'
=
last'
"to2d"
ds
mapArray
::
Ord
a
=>
[(
a
,
Int
)]
->
Map
(
Int
,
Int
)
Double
->
Map
Int
(
Vec
.
Vector
Double
)
mapArray
items
m'
=
Map
.
fromList
[
toVec
n'
ns
m'
|
n'
<-
ns
]
where
ns
=
map
snd
items
toVec
::
Int
->
[
Int
]
->
Map
(
Int
,
Int
)
Double
->
(
Int
,
Vec
.
Vector
Double
)
toVec
::
Int
->
[
Int
]
->
Map
(
Int
,
Int
)
Double
->
(
Int
,
Vec
.
Vector
Double
)
toVec
n'
ns'
m'
=
(
n'
,
Vec
.
fromList
$
map
(
\
n''
->
maybe
0
identity
$
Map
.
lookup
(
n'
,
n''
)
m'
)
ns'
)
toVec
n'
ns'
m'
=
(
n'
,
Vec
.
fromList
$
map
(
\
n''
->
maybe
0
identity
$
Map
.
lookup
(
n'
,
n''
)
m'
)
ns'
)
------------------------------------------------------------------------
-- | KamadaKawai Layout
layout
::
Map
(
Int
,
Int
)
Double
->
IO
(
Map
Int
(
Double
,
Double
))
layout
=
undefined
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