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
153
Issues
153
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
942c1cd0
Commit
942c1cd0
authored
2 years ago
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEA] Graph options with Links Strength
parent
2e46942f
Changes
5
Show whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
72 additions
and
43 deletions
+72
-43
gargantext.cabal
gargantext.cabal
+1
-1
Update.hs
src/Gargantext/API/Node/Update.hs
+7
-5
Graph.hs
src/Gargantext/Core/Viz/Graph.hs
+16
-2
API.hs
src/Gargantext/Core/Viz/Graph/API.hs
+33
-23
Tools.hs
src/Gargantext/Core/Viz/Graph/Tools.hs
+15
-12
No files found.
gargantext.cabal
View file @
942c1cd0
This diff is collapsed.
Click to expand it.
src/Gargantext/API/Node/Update.hs
View file @
942c1cd0
...
...
@@ -28,6 +28,7 @@ import Gargantext.API.Ngrams.List (reIndexWith)
import
Gargantext.API.Prelude
(
GargServer
,
simuLogs
)
import
Gargantext.Core.Methods.Distances
(
GraphMetric
(
..
))
import
Gargantext.Core.Types.Main
(
ListType
(
..
))
import
Gargantext.Core.Viz.Graph
(
Strength
)
import
Gargantext.Core.Viz.Graph.API
(
recomputeGraph
)
import
Gargantext.Core.Viz.Graph.Tools
(
PartitionMethod
(
..
))
import
Gargantext.Core.Viz.Phylo
(
PhyloSubConfig
(
..
),
subConfig2config
)
...
...
@@ -61,6 +62,7 @@ data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
|
UpdateNodeParamsGraph
{
methodGraphMetric
::
!
GraphMetric
,
methodGraphClustering
::
!
PartitionMethod
,
methodGraphEdgesStrength
::
!
Strength
}
|
UpdateNodeParamsTexts
{
methodTexts
::
!
Granularity
}
...
...
@@ -103,7 +105,7 @@ updateNode :: (HasSettings env, FlowCmdM env err m)
->
UpdateNodeParams
->
(
JobLog
->
m
()
)
->
m
JobLog
updateNode
uId
nId
(
UpdateNodeParamsGraph
metric
method
)
logStatus
=
do
updateNode
uId
nId
(
UpdateNodeParamsGraph
metric
method
strength
)
logStatus
=
do
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
...
...
@@ -111,7 +113,7 @@ updateNode uId nId (UpdateNodeParamsGraph metric method) logStatus = do
,
_scst_events
=
Just
[]
}
printDebug
"Computing graph: "
method
_
<-
recomputeGraph
uId
nId
method
(
Just
metric
)
True
_
<-
recomputeGraph
uId
nId
method
(
Just
metric
)
(
Just
strength
)
True
printDebug
"Graph computed: "
method
pure
JobLog
{
_scst_succeeded
=
Just
2
...
...
@@ -272,7 +274,7 @@ instance ToSchema UpdateNodeParams
instance
Arbitrary
UpdateNodeParams
where
arbitrary
=
do
l
<-
UpdateNodeParamsList
<$>
arbitrary
g
<-
UpdateNodeParamsGraph
<$>
arbitrary
<*>
arbitrary
g
<-
UpdateNodeParamsGraph
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
t
<-
UpdateNodeParamsTexts
<$>
arbitrary
b
<-
UpdateNodeParamsBoard
<$>
arbitrary
elements
[
l
,
g
,
t
,
b
]
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Core/Viz/Graph.hs
View file @
942c1cd0
...
...
@@ -76,7 +76,8 @@ instance ToSchema Edge where
data
LegendField
=
LegendField
{
_lf_id
::
Int
,
_lf_color
::
Text
,
_lf_label
::
Text
}
deriving
(
Show
,
Generic
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"_lf_"
)
''
L
egendField
)
instance
ToSchema
LegendField
where
...
...
@@ -96,10 +97,22 @@ instance ToSchema ListForGraph where
makeLenses
''
L
istForGraph
--
data
Strength
=
Strong
|
Weak
deriving
(
Generic
,
Eq
,
Ord
,
Enum
,
Bounded
,
Show
)
$
(
deriveJSON
(
unPrefix
""
)
''
S
trength
)
instance
ToSchema
Strength
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
""
)
instance
Arbitrary
Strength
where
arbitrary
=
elements
$
[
Strong
,
Weak
]
data
GraphMetadata
=
GraphMetadata
{
_gm_title
::
Text
-- title of the graph
,
_gm_metric
::
GraphMetric
,
_gm_edgesStrength
::
Maybe
Strength
,
_gm_corpusId
::
[
NodeId
]
-- we can map with different corpus
,
_gm_legend
::
[
LegendField
]
-- legend of the Graph
,
_gm_list
::
ListForGraph
...
...
@@ -113,6 +126,7 @@ instance ToSchema GraphMetadata where
makeLenses
''
G
raphMetadata
data
Graph
=
Graph
{
_graph_nodes
::
[
Node
]
,
_graph_edges
::
[
Edge
]
,
_graph_metadata
::
Maybe
GraphMetadata
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Core/Viz/Graph/API.hs
View file @
942c1cd0
...
...
@@ -104,8 +104,9 @@ getGraph _uId nId = do
Nothing
->
do
let
defaultMetric
=
Order1
let
defaultPartitionMethod
=
Spinglass
graph'
<-
computeGraph
cId
defaultPartitionMethod
(
withMetric
defaultMetric
)
NgramsTerms
repo
mt
<-
defaultGraphMetadata
cId
"Title"
repo
defaultMetric
let
defaultEdgesStrength
=
Strong
graph'
<-
computeGraph
cId
defaultPartitionMethod
(
withMetric
defaultMetric
)
defaultEdgesStrength
NgramsTerms
repo
mt
<-
defaultGraphMetadata
cId
"Title"
repo
defaultMetric
defaultEdgesStrength
let
graph''
=
set
graph_metadata
(
Just
mt
)
graph'
hg
=
HyperdataGraphAPI
graph''
camera
...
...
@@ -123,9 +124,10 @@ recomputeGraph :: FlowCmdM env err m
->
NodeId
->
PartitionMethod
->
Maybe
GraphMetric
->
Maybe
Strength
->
Bool
->
m
Graph
recomputeGraph
_uId
nId
method
maybeDistance
force
=
do
recomputeGraph
_uId
nId
method
maybeDistance
maybeStrength
force
=
do
printDebug
"recomputeGraph begins"
(
nId
,
method
)
nodeGraph
<-
getNodeWith
nId
(
Proxy
::
Proxy
HyperdataGraph
)
let
...
...
@@ -140,6 +142,12 @@ recomputeGraph _uId nId method maybeDistance force = do
Nothing
->
withMetric
Order1
Just
m
->
withMetric
m
strength
=
case
maybeStrength
of
Nothing
->
case
graph
^?
_Just
.
graph_metadata
.
_Just
.
gm_edgesStrength
of
Nothing
->
Strong
Just
mr
->
fromMaybe
Strong
mr
Just
r
->
r
mcId
<-
getClosestParentIdByType
nId
NodeCorpus
let
cId
=
maybe
(
panic
"[G.V.G.API] Node has no parent"
)
identity
mcId
printDebug
"recomputeGraph corpus"
cId
...
...
@@ -152,7 +160,7 @@ recomputeGraph _uId nId method maybeDistance force = do
let
computeG
mt
=
do
printDebug
"about to run computeGraph"
()
g
<-
computeGraph
cId
method
similarity
NgramsTerms
repo
g
<-
computeGraph
cId
method
similarity
strength
NgramsTerms
repo
seq
g
$
printDebug
"graph computed"
()
let
g'
=
set
graph_metadata
mt
g
seq
g'
$
printDebug
"computed graph with new metadata"
()
...
...
@@ -162,7 +170,7 @@ recomputeGraph _uId nId method maybeDistance force = do
case
graph
of
Nothing
->
do
mt
<-
defaultGraphMetadata
cId
"Title"
repo
(
fromMaybe
Order1
maybeDistance
)
mt
<-
defaultGraphMetadata
cId
"Title"
repo
(
fromMaybe
Order1
maybeDistance
)
strength
g
<-
computeG
$
Just
mt
pure
$
trace
"[G.V.G.API.recomputeGraph] Graph empty, computed"
g
Just
graph'
->
if
(
listVersion
==
Just
v
)
&&
(
not
force
)
...
...
@@ -176,10 +184,11 @@ computeGraph :: FlowCmdM env err m
=>
CorpusId
->
PartitionMethod
->
Distance
->
Strength
->
NgramsType
->
NodeListStory
->
m
Graph
computeGraph
cId
method
d
nt
repo
=
do
computeGraph
cId
method
d
strength
nt
repo
=
do
printDebug
"computeGraph"
(
cId
,
method
,
nt
)
lId
<-
defaultList
cId
printDebug
"computeGraph got list id: "
lId
...
...
@@ -194,7 +203,7 @@ computeGraph cId method d nt repo = do
<$>
getContextsByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
HashMap
.
keys
ngs
)
printDebug
"computeGraph got coocs"
(
HashMap
.
size
myCooc
)
graph
<-
liftBase
$
cooc2graphWith
method
d
0
myCooc
graph
<-
liftBase
$
cooc2graphWith
method
d
0
strength
myCooc
printDebug
"computeGraph got graph"
()
--listNgrams <- getListNgrams [lId] nt
...
...
@@ -209,13 +218,14 @@ defaultGraphMetadata :: HasNodeError err
->
Text
->
NodeListStory
->
GraphMetric
->
Strength
->
Cmd
err
GraphMetadata
defaultGraphMetadata
cId
t
repo
gm
=
do
defaultGraphMetadata
cId
t
repo
gm
str
=
do
lId
<-
defaultList
cId
pure
$
GraphMetadata
{
_gm_title
=
t
pure
$
GraphMetadata
{
_gm_title
=
t
,
_gm_metric
=
gm
,
_gm_edgesStrength
=
Just
str
,
_gm_corpusId
=
[
cId
]
,
_gm_legend
=
[
LegendField
1
"#FFF"
"Cluster1"
...
...
@@ -255,7 +265,7 @@ graphRecompute u n logStatus = do
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
_g
<-
trace
(
show
u
)
$
recomputeGraph
u
n
Spinglass
Nothing
False
_g
<-
trace
(
show
u
)
$
recomputeGraph
u
n
Spinglass
Nothing
Nothing
False
pure
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
...
...
@@ -310,7 +320,7 @@ recomputeVersions :: FlowCmdM env err m
=>
UserId
->
NodeId
->
m
Graph
recomputeVersions
uId
nId
=
recomputeGraph
uId
nId
Spinglass
Nothing
False
recomputeVersions
uId
nId
=
recomputeGraph
uId
nId
Spinglass
Nothing
Nothing
False
------------------------------------------------------------
graphClone
::
UserId
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @
942c1cd0
...
...
@@ -92,6 +92,7 @@ cooc2graph' distance threshold myCooc
cooc2graphWith
::
PartitionMethod
->
Distance
->
Threshold
->
Strength
->
HashMap
(
NgramsTerm
,
NgramsTerm
)
Int
->
IO
Graph
cooc2graphWith
Spinglass
=
cooc2graphWith'
(
spinglass
1
)
...
...
@@ -104,10 +105,11 @@ cooc2graphWith' :: ToComId a
=>
Partitions
a
->
Distance
->
Threshold
->
Strength
->
HashMap
(
NgramsTerm
,
NgramsTerm
)
Int
->
IO
Graph
cooc2graphWith'
doPartitions
distance
threshold
myCooc
=
do
let
(
distanceMap
,
diag
,
ti
)
=
doDistanceMap
distance
threshold
myCooc
cooc2graphWith'
doPartitions
distance
threshold
strength
myCooc
=
do
let
(
distanceMap
,
diag
,
ti
)
=
doDistanceMap
distance
threshold
strength
myCooc
distanceMap
`
seq
`
trace
"distanceMap OK"
diag
`
seq
`
trace
"diag OK"
ti
`
seq
`
printDebug
"ti done"
()
--{- -- Debug
...
...
@@ -136,17 +138,20 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
--seq confluence' $ printDebug "confluence OK" ()
--saveAsFileDebug "/tmp/confluence" confluence'
let
g
=
data2graph
ti
diag
bridgeness'
confluence'
partitions
saveAsFileDebug
"/tmp/graph"
g
--
saveAsFileDebug "/tmp/graph" g
pure
g
type
Reverse
=
Bool
doDistanceMap
::
Distance
->
Threshold
->
Strength
->
HashMap
(
NgramsTerm
,
NgramsTerm
)
Int
->
(
Map
(
Int
,
Int
)
Double
,
Map
(
Index
,
Index
)
Int
,
Map
NgramsTerm
Index
)
doDistanceMap
Distributional
threshold
myCooc
=
(
distanceMap
,
toIndex
ti
diag
,
ti
)
doDistanceMap
Distributional
threshold
strength
myCooc
=
(
distanceMap
,
toIndex
ti
diag
,
ti
)
where
-- TODO remove below
(
diag
,
theMatrix
)
=
Map
.
partitionWithKey
(
\
(
x
,
y
)
_
->
x
==
y
)
...
...
@@ -165,14 +170,14 @@ doDistanceMap Distributional threshold myCooc = (distanceMap, toIndex ti diag, t
distanceMap
=
Map
.
fromList
.
trace
"fromList"
identity
$
List
.
take
links
$
List
.
reverse
$
(
if
strength
==
Weak
then
List
.
reverse
else
identity
)
$
List
.
sortOn
snd
$
Map
.
toList
$
edgesFilter
$
(
\
m
->
m
`
seq
`
trace
"map2map done"
(
Map
.
filter
(
>
threshold
)
m
))
$
similarities
`
seq
`
mat2map
(
trace
"similarities done"
similarities
)
doDistanceMap
Conditional
threshold
myCooc
=
(
distanceMap
,
toIndex
ti
myCooc'
,
ti
)
doDistanceMap
Conditional
threshold
strength
myCooc
=
(
distanceMap
,
toIndex
ti
myCooc'
,
ti
)
where
myCooc'
=
Map
.
fromList
$
HashMap
.
toList
myCooc
(
ti
,
_it
)
=
createIndices
myCooc'
...
...
@@ -182,7 +187,7 @@ doDistanceMap Conditional threshold myCooc = (distanceMap, toIndex ti myCooc', t
distanceMap
=
toIndex
ti
$
Map
.
fromList
$
List
.
take
links
$
List
.
reverse
$
(
if
strength
==
Weak
then
List
.
reverse
else
identity
)
$
List
.
sortOn
snd
$
HashMap
.
toList
$
HashMap
.
filter
(
>
threshold
)
...
...
@@ -344,5 +349,3 @@ filterByNeighbours threshold distanceMap = filteredMap
This diff is collapsed.
Click to expand it.
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