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
160
Issues
160
List
Board
Labels
Milestones
Merge Requests
14
Merge Requests
14
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
e7c244d8
Commit
e7c244d8
authored
Jun 21, 2023
by
qlobbe
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
maybe fix the phylo issue
parent
e93416f8
Pipeline
#4264
failed with stage
in 68 minutes and 59 seconds
Changes
5
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
65 additions
and
49 deletions
+65
-49
Update.hs
src/Gargantext/API/Node/Update.hs
+3
-3
Phylo.hs
src/Gargantext/Core/Viz/Phylo.hs
+33
-27
PhyloExport.hs
src/Gargantext/Core/Viz/Phylo/PhyloExport.hs
+1
-1
PhyloMaker.hs
src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs
+25
-15
PhyloTools.hs
src/Gargantext/Core/Viz/Phylo/PhyloTools.hs
+3
-3
No files found.
src/Gargantext/API/Node/Update.hs
View file @
e7c244d8
...
...
@@ -32,7 +32,7 @@ import Gargantext.Core.Types.Main (ListType(..))
import
Gargantext.Core.Viz.Graph.API
(
recomputeGraph
)
import
Gargantext.Core.Viz.Graph.Tools
(
PartitionMethod
(
..
),
BridgenessMethod
(
..
))
import
Gargantext.Core.Viz.Graph.Types
(
Strength
)
import
Gargantext.Core.Viz.Phylo
(
PhyloSubConfig
(
..
),
subConfig
2config
)
import
Gargantext.Core.Viz.Phylo
(
PhyloSubConfig
API
(
..
),
subConfigAPI
2config
)
import
Gargantext.Core.Viz.Phylo.API.Tools
(
flowPhyloAPI
)
import
Gargantext.Database.Action.Flow.Pairing
(
pairing
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
...
...
@@ -76,7 +76,7 @@ data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
|
LinkNodeReq
{
nodeType
::
!
NodeType
,
id
::
!
NodeId
}
|
UpdateNodePhylo
{
config
::
!
PhyloSubConfig
}
|
UpdateNodePhylo
{
config
::
!
PhyloSubConfig
API
}
deriving
(
Generic
)
----------------------------------------------------------------------
...
...
@@ -209,7 +209,7 @@ updateNode _userId phyloId (UpdateNodePhylo config) logStatus = do
let
corpusId
=
fromMaybe
(
panic
""
)
corpusId'
phy
<-
flowPhyloAPI
(
subConfig2config
config
)
corpusId
phy
<-
flowPhyloAPI
(
subConfig
API
2config
config
)
corpusId
logStatus
JobLog
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
0
...
...
src/Gargantext/Core/Viz/Phylo.hs
View file @
e7c244d8
...
...
@@ -41,9 +41,9 @@ import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import
Gargantext.Prelude
import
qualified
Data.Text.Lazy
as
TextLazy
----------------
----------------
-----
-- | PhyloConfig | --
----------------
----------------
-----
data
CorpusParser
=
Wos
{
_wos_limit
::
Int
}
...
...
@@ -193,45 +193,51 @@ data PhyloConfig =
}
deriving
(
Show
,
Generic
,
Eq
)
------------------------------------------------------------------------
data
PhyloSubConfig
=
PhyloSubConfig
{
_sc_phyloProximity
::
Double
,
_sc_phyloSynchrony
::
Double
,
_sc_phyloQuality
::
Double
,
_sc_timeUnit
::
TimeUnit
,
_sc_clique
::
Cluster
,
_sc_exportFilter
::
Double
}
deriving
(
Show
,
Generic
,
Eq
)
--------------------------------
-- | SubConfig API & 1Click | --
--------------------------------
data
PhyloSubConfigAPI
=
PhyloSubConfigAPI
{
_sc_phyloProximity
::
Double
,
_sc_phyloSynchrony
::
Double
,
_sc_phyloQuality
::
Double
,
_sc_timeUnit
::
TimeUnit
,
_sc_clique
::
Cluster
,
_sc_exportFilter
::
Double
}
deriving
(
Show
,
Generic
,
Eq
)
subConfig2config
::
PhyloSubConfig
->
PhyloConfig
subConfig2config
subConfig
=
defaultConfig
{
similarity
=
WeightedLogJaccard
(
_sc_phyloProximity
subConfig
)
1
subConfigAPI2config
::
PhyloSubConfigAPI
->
PhyloConfig
subConfigAPI2config
subConfig
=
defaultConfig
{
similarity
=
WeightedLogJaccard
(
_sc_phyloProximity
subConfig
)
2
,
phyloSynchrony
=
ByProximityThreshold
(
_sc_phyloSynchrony
subConfig
)
0
AllBranches
MergeAllGroups
,
phyloQuality
=
Quality
(
_sc_phyloQuality
subConfig
)
1
,
phyloQuality
=
Quality
(
_sc_phyloQuality
subConfig
)
3
,
timeUnit
=
_sc_timeUnit
subConfig
,
clique
=
_sc_clique
subConfig
,
exportFilter
=
[
ByBranchSize
$
_sc_exportFilter
subConfig
]
}
------------------------------------------------------------------------
--------------------------
-- | SubConfig 1Click | --
--------------------------
defaultConfig
::
PhyloConfig
defaultConfig
=
PhyloConfig
{
corpusPath
=
"corpus.csv"
-- useful for commandline only
,
listPath
=
"list.csv"
-- useful for commandline only
,
outputPath
=
"data/"
,
corpusParser
=
Csv
1
0
0000
,
corpusParser
=
Csv
1
5
0000
,
listParser
=
V4
,
phyloName
=
pack
"Phylo Name"
,
phyloScale
=
2
,
similarity
=
WeightedLogJaccard
0.5
1
,
similarity
=
WeightedLogJaccard
0.5
2
,
seaElevation
=
Constante
0.1
0.1
,
defaultMode
=
Tru
e
,
findAncestors
=
Fals
e
,
phyloSynchrony
=
ByProximityThreshold
0.
5
0
AllBranches
MergeAllGroups
,
phyloQuality
=
Quality
0.5
1
,
defaultMode
=
Fals
e
,
findAncestors
=
Tru
e
,
phyloSynchrony
=
ByProximityThreshold
0.
6
0
AllBranches
MergeAllGroups
,
phyloQuality
=
Quality
0.5
3
,
timeUnit
=
Year
3
1
5
,
clique
=
MaxClique
5
0.0001
ByThreshold
,
clique
=
Fis
2
3
,
exportLabel
=
[
BranchLabel
MostEmergentTfIdf
2
,
GroupLabel
MostEmergentInclusive
2
]
,
exportSort
=
ByHierarchy
Desc
,
exportFilter
=
[
ByBranchSize
3
]
...
...
@@ -239,13 +245,13 @@ defaultConfig =
-- Main Instances
instance
ToSchema
PhyloConfig
instance
ToSchema
PhyloSubConfig
instance
ToSchema
PhyloSubConfig
API
instance
FromJSON
PhyloConfig
instance
ToJSON
PhyloConfig
instance
FromJSON
PhyloSubConfig
instance
ToJSON
PhyloSubConfig
instance
FromJSON
PhyloSubConfig
API
instance
ToJSON
PhyloSubConfig
API
instance
FromJSON
CorpusParser
instance
ToJSON
CorpusParser
...
...
@@ -604,7 +610,7 @@ instance ToSchema PhyloExport where
----------------
makeLenses
''
P
hyloConfig
makeLenses
''
P
hyloSubConfig
makeLenses
''
P
hyloSubConfig
API
makeLenses
''
P
hyloSimilarity
makeLenses
''
S
eaElevation
makeLenses
''
Q
uality
...
...
src/Gargantext/Core/Viz/Phylo/PhyloExport.hs
View file @
e7c244d8
...
...
@@ -716,7 +716,7 @@ tracePhyloAncestors :: [[PhyloGroup]] -> [[PhyloGroup]]
tracePhyloAncestors
groups
=
trace
(
"-- | Found "
<>
show
(
length
$
concat
$
map
_phylo_groupAncestors
$
concat
groups
)
<>
" ancestors"
)
groups
tracePhyloInfo
::
Phylo
->
Phylo
tracePhyloInfo
phylo
=
trace
(
"
\n
"
<>
"##########################"
<>
"
\n\n
"
<>
"-- | Phylo with
λ
= "
tracePhyloInfo
phylo
=
trace
(
"
\n
"
<>
"##########################"
<>
"
\n\n
"
<>
"-- | Phylo with
level
= "
<>
show
(
getLevel
phylo
)
<>
" applied to "
<>
show
(
length
$
Vector
.
toList
$
getRoots
phylo
)
<>
" foundations"
)
phylo
...
...
src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs
View file @
e7c244d8
...
...
@@ -193,7 +193,7 @@ findSeaLadder phylo = case getSeaElevation phylo of
)
[]
$
keys
$
phylo
^.
phylo_periods
appendGroups
::
(
a
->
Period
->
(
Text
,
Text
)
->
Scale
->
Int
->
[
Cooc
]
->
Map
Int
Double
->
PhyloGroup
)
->
Scale
->
Map
(
Date
,
Date
)
[
a
]
->
Phylo
->
Phylo
appendGroups
f
lvl
m
phylo
=
trace
(
"
\n
"
<>
"-- | Append "
<>
show
(
length
$
concat
$
elems
m
)
<>
" groups to
Level
"
<>
show
(
lvl
)
<>
"
\n
"
)
appendGroups
f
lvl
m
phylo
=
trace
(
"
\n
"
<>
"-- | Append "
<>
show
(
length
$
concat
$
elems
m
)
<>
" groups to
scale
"
<>
show
(
lvl
)
<>
"
\n
"
)
$
over
(
phylo_periods
.
traverse
.
phylo_periodScales
...
...
@@ -489,19 +489,29 @@ initPhyloScales lvlMax pId =
fromList
$
map
(
\
lvl
->
((
pId
,
lvl
),
PhyloScale
pId
(
""
,
""
)
lvl
empty
))
[
1
..
lvlMax
]
setDefault
::
PhyloConfig
->
TimeUnit
->
PhyloConfig
setDefault
conf
timeScale
=
conf
{
phyloScale
=
2
,
similarity
=
WeightedLogJaccard
0.5
2
,
findAncestors
=
True
,
phyloSynchrony
=
ByProximityThreshold
0.6
0
SiblingBranches
MergeAllGroups
,
phyloQuality
=
Quality
0.5
3
,
timeUnit
=
timeScale
,
clique
=
Fis
3
5
,
exportLabel
=
[
BranchLabel
MostEmergentTfIdf
2
,
GroupLabel
MostEmergentInclusive
2
],
exportSort
=
ByHierarchy
Desc
,
exportFilter
=
[
ByBranchSize
3
]
}
setDefault
::
PhyloConfig
->
TimeUnit
->
Int
->
PhyloConfig
setDefault
conf
timeScale
nbDocs
=
defaultConfig
{
corpusPath
=
(
corpusPath
conf
)
,
listPath
=
(
listPath
conf
)
,
outputPath
=
(
outputPath
conf
)
,
corpusParser
=
(
corpusParser
conf
)
,
listParser
=
(
listParser
conf
)
,
phyloName
=
(
phyloName
conf
)
,
defaultMode
=
True
,
timeUnit
=
timeScale
,
clique
=
Fis
(
toSupport
nbDocs
)
3
}
where
--------------------------------------
toSupport
::
Int
->
Support
toSupport
n
|
n
<
500
=
1
|
n
<
1000
=
2
|
n
<
2000
=
3
|
n
<
3000
=
4
|
n
<
5000
=
5
|
otherwise
=
6
--------------------------------------
-- Init the basic elements of a Phylo
...
...
@@ -519,7 +529,7 @@ initPhylo docs conf =
(
docsToTermFreq
docs
(
foundations
^.
foundations_roots
))
(
docsToLastTermFreq
(
getTimePeriod
timeScale
)
docs
(
foundations
^.
foundations_roots
))
params
=
if
(
defaultMode
conf
)
then
defaultPhyloParam
{
_phyloParam_config
=
setDefault
conf
timeScale
}
then
defaultPhyloParam
{
_phyloParam_config
=
setDefault
conf
timeScale
(
length
docs
)
}
else
defaultPhyloParam
{
_phyloParam_config
=
conf
}
periods
=
toPeriods
(
sort
$
nub
$
map
date
docs
)
(
getTimePeriod
timeScale
)
(
getTimeStep
timeScale
)
in
trace
(
"
\n
"
<>
"-- | Init a phylo out of "
<>
show
(
length
docs
)
<>
" docs
\n
"
)
...
...
src/Gargantext/Core/Viz/Phylo/PhyloTools.hs
View file @
e7c244d8
...
...
@@ -633,7 +633,7 @@ updateLevel level phylo = phylo { _phylo_level = level }
traceToPhylo
::
Scale
->
Phylo
->
Phylo
traceToPhylo
lvl
phylo
=
trace
(
"
\n
"
<>
"-- | End of phylo making at
level
"
<>
show
(
lvl
)
<>
" with "
trace
(
"
\n
"
<>
"-- | End of phylo making at
scale
"
<>
show
(
lvl
)
<>
" with "
<>
show
(
length
$
getGroupsFromScale
lvl
phylo
)
<>
" groups and "
<>
show
(
length
$
nub
$
map
_phylo_groupBranchId
$
getGroupsFromScale
lvl
phylo
)
<>
" branches"
<>
"
\n
"
)
phylo
...
...
@@ -697,14 +697,14 @@ toRelatedComponents nodes edges =
traceSynchronyEnd
::
Phylo
->
Phylo
traceSynchronyEnd
phylo
=
trace
(
"-- | End synchronic clustering at
level
"
<>
show
(
getLastLevel
phylo
)
trace
(
"-- | End synchronic clustering at
scale
"
<>
show
(
getLastLevel
phylo
)
<>
" with "
<>
show
(
length
$
getGroupsFromScale
(
getLastLevel
phylo
)
phylo
)
<>
" groups"
<>
" and "
<>
show
(
length
$
nub
$
map
_phylo_groupBranchId
$
getGroupsFromScale
(
getLastLevel
phylo
)
phylo
)
<>
" branches"
<>
"
\n
"
)
phylo
traceSynchronyStart
::
Phylo
->
Phylo
traceSynchronyStart
phylo
=
trace
(
"
\n
"
<>
"-- | Start synchronic clustering at
level
"
<>
show
(
getLastLevel
phylo
)
trace
(
"
\n
"
<>
"-- | Start synchronic clustering at
scale
"
<>
show
(
getLastLevel
phylo
)
<>
" with "
<>
show
(
length
$
getGroupsFromScale
(
getLastLevel
phylo
)
phylo
)
<>
" groups"
<>
" and "
<>
show
(
length
$
nub
$
map
_phylo_groupBranchId
$
getGroupsFromScale
(
getLastLevel
phylo
)
phylo
)
<>
" branches"
<>
"
\n
"
)
phylo
...
...
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