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
195
Issues
195
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
f7b1528f
Commit
f7b1528f
authored
Dec 02, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Order 1 improved, to test
parent
377f8b5a
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
82 additions
and
38 deletions
+82
-38
Conditional.hs
src/Gargantext/Core/Methods/Distances/Conditional.hs
+44
-0
Tools.hs
src/Gargantext/Core/Viz/Graph/Tools.hs
+38
-38
No files found.
src/Gargantext/Core/Methods/Distances/Conditional.hs
View file @
f7b1528f
...
@@ -15,6 +15,48 @@ Motivation and definition of the @Conditional@ distance.
...
@@ -15,6 +15,48 @@ Motivation and definition of the @Conditional@ distance.
module
Gargantext.Core.Methods.Distances.Conditional
module
Gargantext.Core.Methods.Distances.Conditional
where
where
import
Data.List
(
unzip
)
import
Data.Maybe
(
catMaybes
)
import
Gargantext.Prelude
import
qualified
Data.HashMap.Strict
as
Map
import
qualified
Data.Set
as
Set
import
Data.Hashable
(
Hashable
)
type
HashMap
=
Map
.
HashMap
------------------------------------------------------------------------
-- First version as first implementation
-- - unoptimized but qualitatively verified
getMax
::
(
a
,
a
)
->
Maybe
Double
->
Maybe
Double
->
Maybe
((
a
,
a
),
Double
)
getMax
(
i
,
j
)
(
Just
d
)
Nothing
=
Just
((
i
,
j
),
d
)
getMax
(
i
,
j
)
Nothing
(
Just
d
)
=
Just
((
j
,
i
),
d
)
getMax
ij
(
Just
di
)
(
Just
dj
)
=
if
di
>=
dj
then
getMax
ij
(
Just
di
)
Nothing
else
getMax
ij
Nothing
(
Just
dj
)
getMax
_
_
_
=
Nothing
conditional
::
(
Ord
a
,
Hashable
a
)
=>
HashMap
(
a
,
a
)
Int
->
HashMap
(
a
,
a
)
Double
conditional
m'
=
Map
.
fromList
$
catMaybes
results
where
results
=
[
let
ij
=
(
/
)
<$>
Map
.
lookup
(
i
,
j
)
m
<*>
Map
.
lookup
(
i
,
i
)
m
ji
=
(
/
)
<$>
Map
.
lookup
(
j
,
i
)
m
<*>
Map
.
lookup
(
j
,
j
)
m
in
getMax
(
i
,
j
)
ij
ji
|
i
<-
keys
,
j
<-
keys
,
i
<
j
]
-- Converting from Int to Double
m
=
Map
.
map
fromIntegral
m'
-- Get the matrix coordinates, removing duplicates
keys
=
Set
.
toList
$
Set
.
fromList
(
x
<>
y
)
(
x
,
y
)
=
unzip
$
Map
.
keys
m
{-
import Data.List (sortOn)
import Data.List (sortOn)
import Data.Map (Map)
import Data.Map (Map)
import Data.Matrix hiding (identity)
import Data.Matrix hiding (identity)
...
@@ -120,3 +162,5 @@ conditional m = filterMat (threshold m') m'
...
@@ -120,3 +162,5 @@ conditional m = filterMat (threshold m') m'
True -> x
True -> x
False -> 0
False -> 0
------------------------------------------------------------------------
------------------------------------------------------------------------
-}
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @
f7b1528f
...
@@ -18,9 +18,10 @@ module Gargantext.Core.Viz.Graph.Tools
...
@@ -18,9 +18,10 @@ module Gargantext.Core.Viz.Graph.Tools
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
(
HashMap
)
import
Data.Map
(
Map
)
import
Data.Map
(
Map
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
Debug.Trace
(
trace
)
--
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.Graph.BAC.Proxemy
(
confluence
)
import
Gargantext.Core.Methods.Graph.BAC.Proxemy
(
confluence
)
import
Gargantext.Core.Statistics
import
Gargantext.Core.Statistics
...
@@ -96,7 +97,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
...
@@ -96,7 +97,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
where
where
(
as
,
bs
)
=
List
.
unzip
$
Map
.
keys
distanceMap
(
as
,
bs
)
=
List
.
unzip
$
Map
.
keys
distanceMap
n'
=
Set
.
size
$
Set
.
fromList
$
as
<>
bs
n'
=
Set
.
size
$
Set
.
fromList
$
as
<>
bs
ClustersParams
rivers
_level
=
clustersParams
nodesApprox
{- -- Debug
{- -- Debug
saveAsFileDebug "debug/distanceMap" distanceMap
saveAsFileDebug "debug/distanceMap" distanceMap
...
@@ -108,9 +108,7 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
...
@@ -108,9 +108,7 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
else
panic
"Text.Flow: DistanceMap is empty"
else
panic
"Text.Flow: DistanceMap is empty"
let
let
-- bridgeness' = distanceMap
bridgeness'
=
bridgeness
(
fromIntegral
nodesApprox
)
partitions
distanceMap
bridgeness'
=
trace
(
"Rivers: "
<>
show
rivers
)
$
bridgeness
rivers
partitions
distanceMap
confluence'
=
confluence
(
Map
.
keys
bridgeness'
)
3
True
False
confluence'
=
confluence
(
Map
.
keys
bridgeness'
)
3
True
False
...
@@ -118,7 +116,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
...
@@ -118,7 +116,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
diag
bridgeness'
confluence'
partitions
diag
bridgeness'
confluence'
partitions
doDistanceMap
::
Distance
doDistanceMap
::
Distance
->
Threshold
->
Threshold
->
HashMap
(
NgramsTerm
,
NgramsTerm
)
Int
->
HashMap
(
NgramsTerm
,
NgramsTerm
)
Int
...
@@ -126,7 +123,7 @@ doDistanceMap :: Distance
...
@@ -126,7 +123,7 @@ doDistanceMap :: Distance
,
Map
(
Index
,
Index
)
Int
,
Map
(
Index
,
Index
)
Int
,
Map
NgramsTerm
Index
,
Map
NgramsTerm
Index
)
)
doDistanceMap
distance
threshold
myCooc
=
(
distanceMap
,
toIndex
ti
diag
,
ti
)
doDistanceMap
Distributional
threshold
myCooc
=
(
distanceMap
,
toIndex
ti
diag
,
ti
)
where
where
-- TODO remove below
-- TODO remove below
(
diag
,
theMatrix
)
=
Map
.
partitionWithKey
(
\
(
x
,
y
)
_
->
x
==
y
)
(
diag
,
theMatrix
)
=
Map
.
partitionWithKey
(
\
(
x
,
y
)
_
->
x
==
y
)
...
@@ -136,16 +133,18 @@ doDistanceMap distance threshold myCooc = (distanceMap, toIndex ti diag, ti)
...
@@ -136,16 +133,18 @@ doDistanceMap distance threshold myCooc = (distanceMap, toIndex ti diag, ti)
(
ti
,
_it
)
=
createIndices
theMatrix
(
ti
,
_it
)
=
createIndices
theMatrix
tiSize
=
Map
.
size
ti
tiSize
=
Map
.
size
ti
{-
matCooc = case distance of -- Shape of the Matrix
matCooc = case distance of -- Shape of the Matrix
Conditional -> map2mat Triangle 0 tiSize
Conditional -> map2mat Triangle 0 tiSize
Distributional -> map2mat Square 0 tiSize
Distributional -> map2mat Square 0 tiSize
{-$ case distance of -- Removing the Diagonal ?
Conditional -> Map.filterWithKey (\(a,b) _ -> a /= b)
Distributional -> Map.filterWithKey (\(a,b) _ -> a /= b)
-}
$ toIndex ti theMatrix
$ toIndex ti theMatrix
similarities = measure distance matCooc
similarities = measure distance matCooc
-}
similarities
=
measure
Distributional
$
map2mat
Square
0
tiSize
$
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
)
distanceMap
=
Map
.
fromList
distanceMap
=
Map
.
fromList
...
@@ -155,24 +154,23 @@ doDistanceMap distance threshold myCooc = (distanceMap, toIndex ti diag, ti)
...
@@ -155,24 +154,23 @@ doDistanceMap distance threshold myCooc = (distanceMap, toIndex ti diag, ti)
$
Map
.
filter
(
>
threshold
)
$
Map
.
filter
(
>
threshold
)
$
mat2map
similarities
$
mat2map
similarities
doDistanceMap
Conditional
_threshold
myCooc
=
(
distanceMap
,
toIndex
ti
myCooc'
,
ti
)
where
myCooc'
=
Map
.
fromList
$
HashMap
.
toList
myCooc
(
ti
,
_it
)
=
createIndices
myCooc'
-- tiSize = Map.size ti
-- links = round (let n :: Double = fromIntegral tiSize in n * log n)
distanceMap
=
toIndex
ti
$
Map
.
fromList
-- $ List.take links
-- $ List.sortOn snd
$
HashMap
.
toList
-- $ HashMap.filter (> threshold)
$
conditional
myCooc
------------------------------------------------------------------------
------------------------------------------------------------------------
data
ClustersParams
=
ClustersParams
{
bridgness
::
Double
,
louvain
::
Text
}
deriving
(
Show
)
clustersParams
::
Int
->
ClustersParams
clustersParams
x
=
ClustersParams
(
fromIntegral
x
)
"0.00000001"
-- y
{- where
y | x < 100 = "0.000001"
| x < 350 = "0.000001"
| x < 500 = "0.000001"
| x < 1000 = "0.000001"
| otherwise = "1"
-}
----------------------------------------------------------
----------------------------------------------------------
-- | From data to Graph
-- | From data to Graph
...
@@ -187,18 +185,19 @@ data2graph :: ToComId a
...
@@ -187,18 +185,19 @@ data2graph :: ToComId a
->
[
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
community_id_by_node_id
=
Map
.
fromList
$
map
nodeId2comId
partitions
$
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
=
l
,
node_x_coord
=
0
,
node_x_coord
=
0
,
node_y_coord
=
0
,
node_y_coord
=
0
,
node_attributes
=
,
node_attributes
=
...
@@ -215,15 +214,16 @@ data2graph labels occurences bridge conf partitions = Graph { _graph_nodes = nod
...
@@ -215,15 +214,16 @@ data2graph labels occurences bridge conf partitions = Graph { _graph_nodes = nod
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
=
d
,
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_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
),
d
))
<-
zip
([
0
..
]
::
[
Integer
]
)
|
(
i
,
((
s
,
t
),
weight
))
<-
zip
([
0
..
]
::
[
Integer
]
)
(
Map
.
toList
bridge
)
(
Map
.
toList
bridge
)
,
s
/=
t
,
d
>
0
,
s
/=
t
]
,
weight
>
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