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
158
Issues
158
List
Board
Labels
Milestones
Merge Requests
11
Merge Requests
11
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
f837207a
Commit
f837207a
authored
Dec 09, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Order 2
parent
24fc1aeb
Pipeline
#2250
passed with stage
in 62 minutes and 19 seconds
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
65 additions
and
60 deletions
+65
-60
Index.hs
src/Gargantext/Core/Viz/Graph/Index.hs
+24
-14
Tools.hs
src/Gargantext/Core/Viz/Graph/Tools.hs
+41
-46
No files found.
src/Gargantext/Core/Viz/Graph/Index.hs
View file @
f837207a
...
@@ -24,21 +24,16 @@ TODO:
...
@@ -24,21 +24,16 @@ TODO:
module
Gargantext.Core.Viz.Graph.Index
module
Gargantext.Core.Viz.Graph.Index
where
where
import
qualified
Data.Array.Accelerate
as
A
import
qualified
Data.Array.Accelerate.Interpreter
as
A
import
Data.Array.Accelerate
(
Matrix
,
Elt
,
Shape
,
(
:.
)(
..
),
Z
(
..
))
import
Data.Array.Accelerate
(
Matrix
,
Elt
,
Shape
,
(
:.
)(
..
),
Z
(
..
))
import
Data.Map
(
Map
)
import
Data.Maybe
(
fromMaybe
,
catMaybes
)
import
Data.Maybe
(
fromMaybe
,
catMaybes
)
import
Data.Set
(
Set
)
import
Data.Set
(
Set
)
import
qualified
Data.Set
as
S
import
Data.Map
(
Map
)
import
qualified
Data.Map.Strict
as
M
-- import Data.Vector (Vector)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
qualified
Data.Array.Accelerate
as
A
import
qualified
Data.Array.Accelerate.Interpreter
as
A
import
qualified
Data.Map.Strict
as
M
import
qualified
Data.Set
as
S
import
qualified
Data.List
as
L
type
Index
=
Int
type
Index
=
Int
...
@@ -98,13 +93,15 @@ indexConversion index ms = M.fromList
...
@@ -98,13 +93,15 @@ indexConversion index ms = M.fromList
<*>
Just
c
)
<*>
Just
c
)
)
)
$
M
.
toList
ms
$
M
.
toList
ms
---------------------------------------------------------------------------------
-------------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
--fromIndex' :: Ord t => Vector t -> Map (Index, Index) a -> Map (t,t) a
--fromIndex' :: Ord t => Vector t -> Map (Index, Index) a -> Map (t,t) a
--fromIndex' vi ns = undefined
--fromIndex' vi ns = undefined
-- TODO: returing a Vector should be faster than a Map
-- TODO: retur
n
ing a Vector should be faster than a Map
-- createIndices' :: Ord t => Map (t, t) b -> (Map t Index, Vector t)
-- createIndices' :: Ord t => Map (t, t) b -> (Map t Index, Vector t)
-- createIndices' = undefined
-- createIndices' = undefined
...
@@ -123,4 +120,17 @@ createIndices = set2indices . map2set
...
@@ -123,4 +120,17 @@ createIndices = set2indices . map2set
toIndex'
=
zip
xs
[
0
..
]
toIndex'
=
zip
xs
[
0
..
]
xs
=
S
.
toList
s
xs
=
S
.
toList
s
------------------------------------------------------------------------
------------------------------------------------------------------------
testIndices
::
Bool
testIndices
=
myMap
==
(
M
.
filter
(
>
0
)
myMap'
)
where
xy
=
L
.
zip
([
0
..
30
]
::
[
Int
])
([
0
..
30
]
::
[
Int
])
myMap
=
M
.
fromList
$
L
.
zip
xy
([
1
..
]
::
[
Int
])
(
ti
,
it
)
=
createIndices
myMap
matrix
=
mat2map
$
map2mat
Square
0
(
M
.
size
ti
)
$
toIndex
ti
myMap
myMap'
=
fromIndex
it
matrix
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @
f837207a
...
@@ -14,25 +14,22 @@ Portability : POSIX
...
@@ -14,25 +14,22 @@ Portability : POSIX
module
Gargantext.Core.Viz.Graph.Tools
module
Gargantext.Core.Viz.Graph.Tools
where
where
-- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
(
HashMap
)
import
Data.Map
(
Map
)
import
Data.Map
(
Map
)
import
Data.Text
(
Text
)
import
Data.Maybe
(
fromMaybe
)
-- import Debug.Trace (trace)
import
GHC.Float
(
sin
,
cos
)
import
GHC.Float
(
sin
,
cos
)
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.Core.Methods.Distances.Conditional
(
conditional
)
import
Gargantext.Core.Methods.Distances
(
Distance
(
..
),
measure
)
import
Gargantext.Core.Methods.Distances
(
Distance
(
..
),
measure
)
import
Gargantext.Core.Methods.Distances.Conditional
(
conditional
)
import
Gargantext.Core.Methods.Graph.BAC.Proxemy
(
confluence
)
import
Gargantext.Core.Methods.Graph.BAC.Proxemy
(
confluence
)
import
Gargantext.Core.Statistics
import
Gargantext.Core.Statistics
import
Gargantext.Core.Viz.Graph
import
Gargantext.Core.Viz.Graph
import
Gargantext.Core.Viz.Graph.Utils
(
edgesFilter
)
import
Gargantext.Core.Viz.Graph.Bridgeness
(
bridgeness
,
Partitions
,
ToComId
(
..
))
import
Gargantext.Core.Viz.Graph.Bridgeness
(
bridgeness
,
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.Types
(
ClusterNode
)
import
Gargantext.Core.Viz.Graph.Types
(
ClusterNode
)
import
Gargantext.Core.Viz.Graph.Utils
(
edgesFilter
)
import
Gargantext.Prelude
import
Gargantext.Prelude
-- import qualified Graph.BAC.ProxemyOptim as BAC
import
IGraph.Random
-- (Gen(..))
import
IGraph.Random
-- (Gen(..))
import
qualified
Data.HashMap.Strict
as
HashMap
import
qualified
Data.HashMap.Strict
as
HashMap
import
qualified
Data.List
as
List
import
qualified
Data.List
as
List
...
@@ -95,12 +92,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
...
@@ -95,12 +92,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
let
let
(
distanceMap
,
diag
,
ti
)
=
doDistanceMap
distance
threshold
myCooc
(
distanceMap
,
diag
,
ti
)
=
doDistanceMap
distance
threshold
myCooc
nodesApprox
::
Int
nodesApprox
=
n'
where
(
as
,
bs
)
=
List
.
unzip
$
Map
.
keys
distanceMap
n'
=
Set
.
size
$
Set
.
fromList
$
as
<>
bs
{- -- Debug
{- -- Debug
saveAsFileDebug "debug/distanceMap" distanceMap
saveAsFileDebug "debug/distanceMap" distanceMap
printDebug "similarities" similarities
printDebug "similarities" similarities
...
@@ -111,12 +102,15 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
...
@@ -111,12 +102,15 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
else
panic
"Text.Flow: DistanceMap is empty"
else
panic
"Text.Flow: DistanceMap is empty"
let
let
nodesApprox
::
Int
nodesApprox
=
n'
where
(
as
,
bs
)
=
List
.
unzip
$
Map
.
keys
distanceMap
n'
=
Set
.
size
$
Set
.
fromList
$
as
<>
bs
bridgeness'
=
bridgeness
(
fromIntegral
nodesApprox
)
partitions
distanceMap
bridgeness'
=
bridgeness
(
fromIntegral
nodesApprox
)
partitions
distanceMap
confluence'
=
confluence
(
Map
.
keys
bridgeness'
)
3
True
False
confluence'
=
confluence
(
Map
.
keys
bridgeness'
)
3
True
False
pure
$
data2graph
(
Map
.
toList
$
Map
.
mapKeys
unNgramsTerm
ti
)
pure
$
data2graph
ti
diag
bridgeness'
confluence'
partitions
diag
bridgeness'
confluence'
partitions
doDistanceMap
::
Distance
doDistanceMap
::
Distance
...
@@ -148,87 +142,88 @@ doDistanceMap Distributional threshold myCooc = (distanceMap, toIndex ti diag, t
...
@@ -148,87 +142,88 @@ doDistanceMap Distributional threshold myCooc = (distanceMap, toIndex ti diag, t
$
map2mat
Square
0
tiSize
$
map2mat
Square
0
tiSize
$
toIndex
ti
theMatrix
$
toIndex
ti
theMatrix
links
=
round
(
let
n
::
Double
=
fromIntegral
tiSize
in
n
*
log
n
)
links
=
round
(
let
n
::
Double
=
fromIntegral
tiSize
in
n
*
(
log
n
)
^
(
2
::
Int
)
)
distanceMap
=
Map
.
fromList
distanceMap
=
Map
.
fromList
$
List
.
take
links
$
List
.
take
links
$
List
.
reverse
$
List
.
sortOn
snd
$
List
.
sortOn
snd
$
Map
.
toList
$
Map
.
toList
$
edgesFilter
$
edgesFilter
$
Map
.
filter
(
>
threshold
)
$
Map
.
filter
(
>
threshold
)
$
mat2map
similarities
$
mat2map
similarities
doDistanceMap
Conditional
_
threshold
myCooc
=
(
distanceMap
,
toIndex
ti
myCooc'
,
ti
)
doDistanceMap
Conditional
threshold
myCooc
=
(
distanceMap
,
toIndex
ti
myCooc'
,
ti
)
where
where
myCooc'
=
Map
.
fromList
$
HashMap
.
toList
myCooc
myCooc'
=
Map
.
fromList
$
HashMap
.
toList
myCooc
(
ti
,
_it
)
=
createIndices
myCooc'
(
ti
,
_it
)
=
createIndices
myCooc'
--
tiSize = Map.size ti
tiSize
=
Map
.
size
ti
--
links = round (let n :: Double = fromIntegral tiSize in n * log n)
links
=
round
(
let
n
::
Double
=
fromIntegral
tiSize
in
n
*
log
n
)
distanceMap
=
toIndex
ti
distanceMap
=
toIndex
ti
$
Map
.
fromList
$
Map
.
fromList
--
List.take links
$
List
.
take
links
--
List.sortOn snd
$
List
.
sortOn
snd
$
HashMap
.
toList
$
HashMap
.
toList
--
HashMap.filter (> threshold)
$
HashMap
.
filter
(
>
threshold
)
$
conditional
myCooc
$
conditional
myCooc
----------------------------------------------------------
----------------------------------------------------------
-- | From data to Graph
-- | From data to Graph
type
Occurrences
=
Map
(
Int
,
Int
)
Int
type
Occurrences
=
Int
data2graph
::
ToComId
a
data2graph
::
ToComId
a
=>
[(
Text
,
Int
)]
=>
Map
NgramsTerm
Int
->
Occurrences
->
Map
(
Int
,
Int
)
Occurrences
->
Map
(
Int
,
Int
)
Double
->
Map
(
Int
,
Int
)
Double
->
Map
(
Int
,
Int
)
Double
->
Map
(
Int
,
Int
)
Double
->
[
a
]
->
[
a
]
->
Graph
->
Graph
data2graph
labels
occurences
bridge
conf
partitions
=
Graph
{
_graph_nodes
=
nodes
data2graph
labels
'
occurences
bridge
conf
partitions
=
Graph
{
_graph_nodes
=
nodes
,
_graph_edges
=
edges
,
_graph_edges
=
edges
,
_graph_metadata
=
Nothing
,
_graph_metadata
=
Nothing
}
}
where
where
community_id_by_node_id
=
Map
.
fromList
$
map
nodeId2comId
partitions
nodes
=
map
(
setCoord
ForceAtlas
labels
bridge
)
nodes
=
map
(
setCoord
ForceAtlas
labels
bridge
)
[
(
n
,
Node
{
node_size
=
maybe
0
identity
(
Map
.
lookup
(
n
,
n
)
occurences
)
[
(
n
,
Node
{
node_size
=
maybe
0
identity
(
Map
.
lookup
(
n
,
n
)
occurences
)
,
node_type
=
Terms
-- or Unknown
,
node_type
=
Terms
-- or Unknown
,
node_id
=
cs
(
show
n
)
,
node_id
=
cs
(
show
n
)
,
node_label
=
l
,
node_label
=
unNgramsTerm
l
,
node_x_coord
=
0
,
node_x_coord
=
0
,
node_y_coord
=
0
,
node_y_coord
=
0
,
node_attributes
=
,
node_attributes
=
Attributes
{
clust_default
=
fromMaybe
0
Attributes
{
clust_default
=
maybe
0
identity
(
Map
.
lookup
n
community_id_by_node_id
)
(
Map
.
lookup
n
community_id_by_node_id
)
}
}
,
node_children
=
[]
}
,
node_children
=
[]
}
)
)
|
(
l
,
n
)
<-
labels
|
(
l
,
n
)
<-
labels
,
Set
.
member
n
$
Set
.
fromList
,
Set
.
member
n
nodesWithScores
$
List
.
concat
$
map
(
\
((
s
,
t
),
d
)
->
if
d
>
0
&&
s
/=
t
then
[
s
,
t
]
else
[]
)
$
Map
.
toList
bridge
]
]
edges
=
[
Edge
{
edge_source
=
cs
(
show
s
)
edges
=
[
Edge
{
edge_source
=
cs
(
show
s
)
,
edge_target
=
cs
(
show
t
)
,
edge_target
=
cs
(
show
t
)
,
edge_weight
=
weight
,
edge_weight
=
weight
,
edge_confluence
=
maybe
0
identity
$
Map
.
lookup
(
s
,
t
)
conf
,
edge_confluence
=
maybe
0
identity
$
Map
.
lookup
(
s
,
t
)
conf
-- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
,
edge_id
=
cs
(
show
i
)
,
edge_id
=
cs
(
show
i
)
}
}
|
(
i
,
((
s
,
t
),
weight
))
<-
zip
([
0
..
]
::
[
Integer
]
)
|
(
i
,
((
s
,
t
),
weight
))
<-
zip
([
0
..
]
::
[
Integer
]
)
$
Map
.
toList
bridge
(
Map
.
toList
bridge
)
,
s
/=
t
,
s
/=
t
,
weight
>
0
,
weight
>
0
]
]
community_id_by_node_id
=
Map
.
fromList
$
map
nodeId2comId
partitions
labels
=
Map
.
toList
labels'
nodesWithScores
=
Set
.
fromList
$
List
.
concat
$
map
(
\
((
s
,
t
),
d
)
->
if
d
>
0
&&
s
/=
t
then
[
s
,
t
]
else
[]
)
$
Map
.
toList
bridge
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -305,7 +300,7 @@ cooc2graph'' distance threshold myCooc = neighbourMap
...
@@ -305,7 +300,7 @@ cooc2graph'' distance threshold myCooc = neighbourMap
(
ti
,
_
)
=
createIndices
myCooc
(
ti
,
_
)
=
createIndices
myCooc
myCooc'
=
toIndex
ti
myCooc
myCooc'
=
toIndex
ti
myCooc
matCooc
=
map2mat
Triangle
0
(
Map
.
size
ti
)
$
Map
.
filter
(
>
1
)
myCooc'
matCooc
=
map2mat
Triangle
0
(
Map
.
size
ti
)
$
Map
.
filter
(
>
1
)
myCooc'
distanceMat
=
measure
distance
matCooc
distanceMat
=
measure
distance
matCooc
neighbourMap
=
filterByNeighbours
threshold
neighbourMap
=
filterByNeighbours
threshold
$
mat2map
distanceMat
$
mat2map
distanceMat
...
...
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