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
150
Issues
150
List
Board
Labels
Milestones
Merge Requests
5
Merge Requests
5
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
c35221a6
Commit
c35221a6
authored
Mar 28, 2019
by
Quentin Lobbé
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add a toPhylo function and the foundation of the Rest routes
parent
e23cae57
Pipeline
#311
failed with stage
Changes
8
Pipelines
1
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
255 additions
and
74 deletions
+255
-74
Phylo.hs
src/Gargantext/Viz/Phylo.hs
+43
-10
Cluster.hs
src/Gargantext/Viz/Phylo/Aggregates/Cluster.hs
+12
-10
BranchMaker.hs
src/Gargantext/Viz/Phylo/BranchMaker.hs
+9
-9
Example.hs
src/Gargantext/Viz/Phylo/Example.hs
+43
-13
LevelMaker.hs
src/Gargantext/Viz/Phylo/LevelMaker.hs
+66
-6
LinkMaker.hs
src/Gargantext/Viz/Phylo/LinkMaker.hs
+22
-22
Tools.hs
src/Gargantext/Viz/Phylo/Tools.hs
+58
-2
ViewMaker.hs
src/Gargantext/Viz/Phylo/View/ViewMaker.hs
+2
-2
No files found.
src/Gargantext/Viz/Phylo.hs
View file @
c35221a6
...
...
@@ -43,6 +43,21 @@ import Gargantext.Core.Utils.Prefix (unPrefix)
import
Gargantext.Prelude
------------------------------------------------------------------------
data
PhyloQuery
=
PhyloQuery
{
_phyloQuery_phyloName
::
Text
,
_phyloQuery_phyloDescription
::
Text
,
_phyloQuery_timeGrain
::
Int
,
_phyloQuery_timeSteps
::
Int
,
_phyloQuery_fstCluster
::
Clustering
,
_phyloQuery_timeMatching
::
Proximity
,
_phyloQuery_nthLevel
::
Level
,
_phyloQuery_nthCluster
::
Clustering
}
deriving
(
Show
)
data
PhyloExport
=
PhyloExport
{
_phyloExport_param
::
PhyloParam
,
_phyloExport_data
::
Phylo
...
...
@@ -53,6 +68,7 @@ data PhyloParam =
PhyloParam
{
_phyloParam_version
::
Text
-- Double ?
,
_phyloParam_software
::
Software
,
_phyloParam_params
::
Hash
,
_phyloParam_query
::
Maybe
PhyloQuery
}
deriving
(
Generic
,
Show
)
type
Hash
=
Text
...
...
@@ -185,12 +201,21 @@ data PhyloError = LevelDoesNotExist
deriving
(
Show
)
-- | A List of Proximity mesures or strategies
data
Proximity
=
WeightedLogJaccard
|
Hamming
|
FromPairs
-- | A List of Clustering methods
data
Clustering
=
Louvain
|
RelatedComponents
data
PairTo
=
Childs
|
Parents
-- | A List of Proximity methods names
data
ProximityName
=
WeightedLogJaccard
|
Hamming
|
Filiation
deriving
(
Show
)
-- | A List of Clustering methods names
data
ClusteringName
=
Louvain
|
RelatedComponents
|
FrequentItemSet
deriving
(
Show
)
-- | A constructor for Proximities
data
Proximity
=
Proximity
{
_proximity_name
::
ProximityName
,
_proximity_params
::
Map
Text
Double
,
_proximity_threshold
::
Maybe
Double
}
deriving
(
Show
)
-- | A constructor for Clustering
data
Clustering
=
Clustering
{
_clustering_name
::
ClusteringName
,
_clustering_params
::
Map
Text
Double
,
_clustering_paramsBool
::
Map
Text
Bool
,
_clustering_proximity
::
Maybe
Proximity
}
deriving
(
Show
)
------------------------------------------------------------------------
-- | To export a Phylo | --
...
...
@@ -261,8 +286,8 @@ data QueryFilter = QueryFilter
}
-- | A PhyloQuery is the structured representation of a user query to be applied to a Phylo
data
PhyloQuery
=
PhyloQuery
-- | A PhyloQuery
View
is the structured representation of a user query to be applied to a Phylo
data
PhyloQuery
View
=
PhyloQueryView
{
_query_lvl
::
Level
-- Does the PhyloGraph contain ascendant, descendant or a complete Filiation ?
...
...
@@ -300,13 +325,16 @@ makeLenses ''PhyloGroup
makeLenses
''
P
hyloLevel
makeLenses
''
P
hyloPeriod
makeLenses
''
P
hyloView
makeLenses
''
P
hyloQuery
makeLenses
''
P
hyloQuery
View
makeLenses
''
P
hyloBranch
makeLenses
''
P
hyloNode
makeLenses
''
P
hyloEdge
makeLenses
''
P
roximity
makeLenses
''
C
lustering
makeLenses
''
Q
ueryFilter
makeLenses
''
P
hyloQuery
-- | JSON instances
-- | JSON instances
$
(
deriveJSON
(
unPrefix
"_phylo_"
)
''
P
hylo
)
$
(
deriveJSON
(
unPrefix
"_phylo_period"
)
''
P
hyloPeriod
)
$
(
deriveJSON
(
unPrefix
"_phylo_level"
)
''
P
hyloLevel
)
...
...
@@ -314,6 +342,11 @@ $(deriveJSON (unPrefix "_phylo_group" ) ''PhyloGroup )
--
$
(
deriveJSON
(
unPrefix
"_software_"
)
''
S
oftware
)
$
(
deriveJSON
(
unPrefix
"_phyloParam_"
)
''
P
hyloParam
)
$
(
deriveJSON
(
unPrefix
"_clustering_"
)
''
C
lustering
)
$
(
deriveJSON
(
unPrefix
"_proximity_"
)
''
P
roximity
)
$
(
deriveJSON
(
unPrefix
""
)
''
P
roximityName
)
$
(
deriveJSON
(
unPrefix
""
)
''
C
lusteringName
)
$
(
deriveJSON
(
unPrefix
"_phyloQuery_"
)
''
P
hyloQuery
)
$
(
deriveJSON
(
unPrefix
"_phyloExport_"
)
''
P
hyloExport
)
-- | TODO XML instances
...
...
src/Gargantext/Viz/Phylo/Aggregates/Cluster.hs
View file @
c35221a6
...
...
@@ -17,6 +17,8 @@ Portability : POSIX
module
Gargantext.Viz.Phylo.Aggregates.Cluster
where
import
Control.Lens
hiding
(
makeLenses
,
both
,
Level
)
import
Data.List
(
last
,
head
,
union
,
concat
,
null
,
nub
,(
++
),
init
,
tail
,(
!!
))
import
Data.Map
(
Map
,
elems
,
adjust
,
unionWith
,
intersectionWith
)
import
Data.Set
(
Set
)
...
...
@@ -35,18 +37,18 @@ import qualified Data.Set as Set
-- | To apply a Clustering method to a PhyloGraph
graphToClusters
::
(
Clustering
,[
Double
])
->
GroupGraph
->
[
Cluster
]
graphToClusters
(
clust
,
param
)
(
nodes
,
edges
)
=
case
clust
of
graphToClusters
::
Clustering
->
GroupGraph
->
[
Cluster
]
graphToClusters
clust
(
nodes
,
edges
)
=
case
clust
^.
clustering_name
of
Louvain
->
undefined
-- louvain (nodes,edges)
RelatedComponents
->
relatedComp
0
(
head
nodes
)
(
tail
nodes
,
edges
)
[]
[]
-- | To transform a Phylo into Clusters of PhyloGroups at a given level
phyloToClusters
::
Level
->
(
Proximity
,[
Double
])
->
(
Clustering
,[
Double
])
->
Phylo
->
Map
(
Date
,
Date
)
[
Cluster
]
phyloToClusters
lvl
(
prox
,
param
)
(
clus
,
param'
)
p
=
Map
.
fromList
$
zip
(
getPhyloPeriods
p
)
(
map
(
\
prd
->
let
graph
=
groupsToGraph
(
prox
,
param
)
(
getGroupsWithFilters
lvl
prd
p
)
p
in
if
null
(
fst
graph
)
then
[]
else
graphToClusters
(
clus
,
param'
)
graph
)
(
getPhyloPeriods
p
))
phyloToClusters
::
Level
->
Proximity
->
Clustering
->
Phylo
->
Map
(
Date
,
Date
)
[
Cluster
]
phyloToClusters
lvl
prox
clus
p
=
Map
.
fromList
$
zip
(
getPhyloPeriods
p
)
(
map
(
\
prd
->
let
graph
=
groupsToGraph
prox
(
getGroupsWithFilters
lvl
prd
p
)
p
in
if
null
(
fst
graph
)
then
[]
else
graphToClusters
clus
graph
)
(
getPhyloPeriods
p
))
src/Gargantext/Viz/Phylo/BranchMaker.hs
View file @
c35221a6
...
...
@@ -20,7 +20,7 @@ module Gargantext.Viz.Phylo.BranchMaker
import
Control.Lens
hiding
(
both
,
Level
)
import
Data.List
(
last
,
head
,
union
,
concat
,
null
,
nub
,(
++
),
init
,
tail
,(
!!
))
import
Data.Map
(
Map
,
elems
,
adjust
,
unionWith
,
intersectionWith
)
import
Data.Map
(
Map
,
elems
,
adjust
,
unionWith
,
intersectionWith
,
empty
,(
!
)
)
import
Data.Set
(
Set
)
import
Data.Tuple
(
fst
,
snd
)
...
...
@@ -44,19 +44,19 @@ graphToBranches lvl (nodes,edges) p = concat
-- | To transform a list of PhyloGroups into a PhyloGraph by using a given Proximity mesure
groupsToGraph
::
(
Proximity
,[
Double
])
->
[
PhyloGroup
]
->
Phylo
->
GroupGraph
groupsToGraph
(
prox
,
param
)
groups
p
=
(
groups
,
edges
)
groupsToGraph
::
Proximity
->
[
PhyloGroup
]
->
Phylo
->
GroupGraph
groupsToGraph
prox
groups
p
=
(
groups
,
edges
)
where
edges
::
GroupEdges
edges
=
case
prox
of
F
romPairs
->
(
nub
.
concat
)
$
map
(
\
g
->
(
map
(
\
g'
->
((
g'
,
g
),
1
))
$
getGroupParents
g
p
)
edges
=
case
prox
^.
proximity_name
of
F
iliation
->
(
nub
.
concat
)
$
map
(
\
g
->
(
map
(
\
g'
->
((
g'
,
g
),
1
))
$
getGroupParents
g
p
)
++
(
map
(
\
g'
->
((
g
,
g'
),
1
))
$
getGroupChilds
g
p
))
groups
WeightedLogJaccard
->
filter
(
\
edge
->
snd
edge
>=
(
param
!!
0
))
WeightedLogJaccard
->
filter
(
\
edge
->
snd
edge
>=
(
fromJust
(
prox
^.
proximity_threshold
)
))
$
map
(
\
(
x
,
y
)
->
((
x
,
y
),
weightedLogJaccard
(
param
!!
1
)
(
getGroupCooc
x
)
(
getSensibility
prox
)
(
getGroupCooc
x
)
(
unifySharedKeys
(
getGroupCooc
x
)
(
getGroupCooc
y
))))
$
listToDirectedCombi
groups
Hamming
->
filter
(
\
edge
->
snd
edge
<=
(
param
!!
0
))
Hamming
->
filter
(
\
edge
->
snd
edge
<=
(
fromJust
(
prox
^.
proximity_threshold
)
))
$
map
(
\
(
x
,
y
)
->
((
x
,
y
),
hamming
(
getGroupCooc
x
)
(
unifySharedKeys
(
getGroupCooc
x
)
(
getGroupCooc
y
))))
$
listToDirectedCombi
groups
_
->
undefined
...
...
@@ -72,5 +72,5 @@ setPhyloBranches lvl p = alterGroupWithLevel (\g -> let bIdx = (fst . head) $ fi
bs
=
graphToBranches
lvl
graph
p
--------------------------------------
graph
::
GroupGraph
graph
=
groupsToGraph
(
FromPairs
,
[]
)
(
getGroupsWithLevel
lvl
p
)
p
graph
=
groupsToGraph
(
Proximity
Filiation
empty
Nothing
)
(
getGroupsWithLevel
lvl
p
)
p
--------------------------------------
\ No newline at end of file
src/Gargantext/Viz/Phylo/Example.hs
View file @
c35221a6
This diff is collapsed.
Click to expand it.
src/Gargantext/Viz/Phylo/LevelMaker.hs
View file @
c35221a6
...
...
@@ -23,11 +23,13 @@ import Data.Map (Map, (!), empty, restrictKeys, filterWithKe
import
Data.Set
(
Set
)
import
Data.Text
(
Text
,
words
)
import
Data.Tuple.Extra
import
Data.Vector
(
Vector
)
import
Gargantext.Prelude
hiding
(
head
)
import
Gargantext.Viz.Phylo.Aggregates.Cluster
import
Gargantext.Viz.Phylo.Aggregates.Cooc
import
Gargantext.Viz.Phylo.Aggregates.Document
import
Gargantext.Viz.Phylo.Aggregates.Fis
import
Gargantext.Viz.Phylo
import
Gargantext.Viz.Phylo.Tools
import
Gargantext.Viz.Phylo.LinkMaker
...
...
@@ -37,6 +39,7 @@ import qualified Data.List as List
import
qualified
Data.Map
as
Map
import
qualified
Data.Set
as
Set
import
qualified
Data.Text
as
Text
import
qualified
Data.Vector
as
Vector
-- | A typeClass for polymorphic PhyloLevel functions
...
...
@@ -141,6 +144,7 @@ toPhyloLevel lvl m p = alterPhyloPeriods
)
period
)
p
-- | To init a Phylo
initPhylo
::
Grain
->
Step
->
[(
Date
,
Text
)]
->
[
Ngrams
]
->
(
Ngrams
->
Ngrams
)
->
Phylo
initPhylo
g
s
c
a
f
=
addPhyloLevel
0
(
corpusToDocs
f
c
base
)
base
where
...
...
@@ -151,18 +155,74 @@ initPhylo g s c a f = addPhyloLevel 0 (corpusToDocs f c base) base
-- | To incrementally add new Levels to a Phylo by making all the linking and aggregation tasks
toNthLevel
::
Level
->
(
Proximity
,[
Double
])
->
(
Clustering
,[
Double
])
->
(
Proximity
,[
Double
])
->
Phylo
->
Phylo
toNthLevel
lvlMax
(
prox
,
param1
)
(
clus
,
param2
)
(
prox'
,
param3
)
p
toNthLevel
::
Level
->
Proximity
->
Clustering
->
Phylo
->
Phylo
toNthLevel
lvlMax
prox
clus
p
|
lvl
>=
lvlMax
=
p
|
otherwise
=
toNthLevel
lvlMax
(
prox
,
param1
)
(
clus
,
param2
)
(
prox'
,
param3
)
|
otherwise
=
toNthLevel
lvlMax
prox
clus
$
setPhyloBranches
(
lvl
+
1
)
$
interTempoMatching
Childs
(
lvl
+
1
)
(
prox'
,
param3
)
$
interTempoMatching
Parents
(
lvl
+
1
)
(
prox'
,
param3
)
$
interTempoMatching
Descendant
(
lvl
+
1
)
prox
$
interTempoMatching
Ascendant
(
lvl
+
1
)
prox
$
setLevelLinks
(
lvl
,
lvl
+
1
)
$
addPhyloLevel
(
lvl
+
1
)
(
phyloToClusters
lvl
(
prox
,
param1
)
(
clus
,
param2
)
p
)
p
(
phyloToClusters
lvl
(
fromJust
$
clus
^.
clustering_proximity
)
clus
p
)
p
where
--------------------------------------
lvl
::
Level
lvl
=
getLastLevel
p
--------------------------------------
-- | To reconstruct the Level 1 of a Phylo based on a Clustering Methods
toPhylo1
::
Clustering
->
Proximity
->
Map
(
Date
,
Date
)
[
Document
]
->
Phylo
->
Phylo
toPhylo1
clst
proxy
d
p
=
case
getClusterName
clst
of
FrequentItemSet
->
setPhyloBranches
1
$
interTempoMatching
Descendant
1
proxy
$
interTempoMatching
Ascendant
1
proxy
$
setLevelLinks
(
0
,
1
)
$
setLevelLinks
(
1
,
0
)
$
addPhyloLevel
1
phyloFis
p
where
--------------------------------------
phyloFis
::
Map
(
Date
,
Date
)
[
Fis
]
phyloFis
=
filterFisBySupport
(
getClusterParamBool
clst
"emptyFis"
)
(
round
$
getClusterParam
clst
"supportInf"
)
(
filterFisByNested
(
docsToFis
d
))
--------------------------------------
_
->
panic
"[ERR][Viz.Phylo.PhyloMaker.toPhylo1] fst clustering not recognized"
-- | To reconstruct the Level 0 of a Phylo
toPhylo0
::
Map
(
Date
,
Date
)
[
Document
]
->
Phylo
->
Phylo
toPhylo0
d
p
=
addPhyloLevel
0
d
p
-- | To reconstruct the Base of a Phylo
toPhyloBase
::
PhyloQuery
->
[(
Date
,
Text
)]
->
[
Ngrams
]
->
Phylo
toPhyloBase
q
c
a
=
initPhyloBase
periods
foundations
where
--------------------------------------
periods
::
[(
Date
,
Date
)]
periods
=
initPeriods
(
getTimeGrain
q
)
(
getTimeSteps
q
)
$
both
fst
(
head
c
,
last
c
)
--------------------------------------
foundations
::
Vector
Ngrams
foundations
=
initFoundations
a
--------------------------------------
-- | To reconstruct a Phylomemy from a PhyloQuery, a Corpus and a list of actants
toPhylo
::
PhyloQuery
->
[(
Date
,
Text
)]
->
[
Ngrams
]
->
Phylo
toPhylo
q
c
a
=
toNthLevel
(
getNthLevel
q
)
(
getTimeMatching
q
)
(
getNthCluster
q
)
phylo1
where
--------------------------------------
phylo1
::
Phylo
phylo1
=
toPhylo1
(
getFstCluster
q
)
(
getTimeMatching
q
)
phyloDocs
phylo0
--------------------------------------
phylo0
::
Phylo
phylo0
=
toPhylo0
phyloDocs
phyloBase
--------------------------------------
phyloDocs
::
Map
(
Date
,
Date
)
[
Document
]
phyloDocs
=
corpusToDocs
groupNgramsWithTrees
c
phyloBase
--------------------------------------
phyloBase
::
Phylo
phyloBase
=
toPhyloBase
q
c
a
--------------------------------------
\ No newline at end of file
src/Gargantext/Viz/Phylo/LinkMaker.hs
View file @
c35221a6
...
...
@@ -19,7 +19,7 @@ module Gargantext.Viz.Phylo.LinkMaker
import
Control.Lens
hiding
(
both
,
Level
)
import
Data.List
((
++
),
sort
,
concat
,
nub
,
words
,
zip
,
sortOn
,
head
,
null
,
tail
,
splitAt
,
(
!!
),
elem
)
import
Data.Map
(
Map
)
import
Data.Map
(
Map
,(
!
)
)
import
Data.Set
(
Set
)
import
Data.Tuple.Extra
...
...
@@ -85,19 +85,19 @@ setLevelLinks (lvl,lvl') p = alterPhyloGroups (linkGroupsByLevel (lvl,lvl') p) p
-- | To apply the corresponding proximity function based on a given Proximity
getProximity
::
(
Proximity
,[
Double
])
->
PhyloGroup
->
PhyloGroup
->
(
PhyloGroupId
,
Double
)
getProximity
(
prox
,
param
)
g1
g2
=
case
prox
of
WeightedLogJaccard
->
((
getGroupId
g2
),
weightedLogJaccard
(
param
!!
1
)
(
getGroupCooc
g1
)
(
unifySharedKeys
(
getGroupCooc
g2
)
(
getGroupCooc
g1
)))
getProximity
::
Proximity
->
PhyloGroup
->
PhyloGroup
->
(
PhyloGroupId
,
Double
)
getProximity
prox
g1
g2
=
case
(
prox
^.
proximity_name
)
of
WeightedLogJaccard
->
((
getGroupId
g2
),
weightedLogJaccard
(
getSensibility
prox
)
(
getGroupCooc
g1
)
(
unifySharedKeys
(
getGroupCooc
g2
)
(
getGroupCooc
g1
)))
Hamming
->
((
getGroupId
g2
),
hamming
(
getGroupCooc
g1
)
(
unifySharedKeys
(
getGroupCooc
g2
)
(
getGroupCooc
g1
)))
_
->
panic
(
"[ERR][Viz.Phylo.Example.getProximity] Proximity function not defined"
)
-- | To get the next or previous PhyloPeriod based on a given PhyloPeriodId
getNextPeriods
::
PairTo
->
PhyloPeriodId
->
[
PhyloPeriodId
]
->
[
PhyloPeriodId
]
getNextPeriods
::
Filiation
->
PhyloPeriodId
->
[
PhyloPeriodId
]
->
[
PhyloPeriodId
]
getNextPeriods
to
id
l
=
case
to
of
Childs
->
unNested
id
((
tail
.
snd
)
next
)
Parents
->
unNested
id
((
reverse
.
fst
)
next
)
_
->
panic
(
"[ERR][Viz.Phylo.Example.getNextPeriods] PairTo
type not defined"
)
Descendant
->
unNested
id
((
tail
.
snd
)
next
)
Ascendant
->
unNested
id
((
reverse
.
fst
)
next
)
_
->
panic
(
"[ERR][Viz.Phylo.Example.getNextPeriods] Filiation
type not defined"
)
where
--------------------------------------
next
::
([
PhyloPeriodId
],
[
PhyloPeriodId
])
...
...
@@ -122,11 +122,11 @@ getNextPeriods to id l = case to of
-- | To find the best set (max = 2) of Childs/Parents candidates based on a given Proximity mesure until a maximum depth (max = Period + 5 units )
findBestCandidates
::
PairTo
->
Int
->
Int
->
(
Proximity
,[
Double
])
->
PhyloGroup
->
Phylo
->
[(
PhyloGroupId
,
Double
)]
findBestCandidates
to
depth
max
(
prox
,
param
)
group
p
findBestCandidates
::
Filiation
->
Int
->
Int
->
Proximity
->
PhyloGroup
->
Phylo
->
[(
PhyloGroupId
,
Double
)]
findBestCandidates
to
depth
max
prox
group
p
|
depth
>
max
||
null
next
=
[]
|
(
not
.
null
)
best
=
take
2
best
|
otherwise
=
findBestCandidates
to
(
depth
+
1
)
max
(
prox
,
param
)
group
p
|
otherwise
=
findBestCandidates
to
(
depth
+
1
)
max
prox
group
p
where
--------------------------------------
next
::
[
PhyloPeriodId
]
...
...
@@ -136,23 +136,23 @@ findBestCandidates to depth max (prox,param) group p
candidates
=
getGroupsWithFilters
(
getGroupLevel
group
)
(
head
next
)
p
--------------------------------------
scores
::
[(
PhyloGroupId
,
Double
)]
scores
=
map
(
\
group'
->
getProximity
(
prox
,
param
)
group
group'
)
candidates
scores
=
map
(
\
group'
->
getProximity
prox
group
group'
)
candidates
--------------------------------------
best
::
[(
PhyloGroupId
,
Double
)]
best
=
reverse
$
sortOn
snd
$
filter
(
\
(
id
,
score
)
->
case
prox
of
WeightedLogJaccard
->
score
>=
(
param
!!
0
)
Hamming
->
score
<=
(
param
!!
0
))
scores
$
filter
(
\
(
id
,
score
)
->
case
(
prox
^.
proximity_name
)
of
WeightedLogJaccard
->
score
>=
fromJust
(
prox
^.
proximity_threshold
)
Hamming
->
score
<=
fromJust
(
prox
^.
proximity_threshold
))
scores
--------------------------------------
-- | To add a new list of Pointers into an existing Childs/Parents list of Pointers
makePair
::
PairTo
->
PhyloGroup
->
[(
PhyloGroupId
,
Double
)]
->
PhyloGroup
makePair
::
Filiation
->
PhyloGroup
->
[(
PhyloGroupId
,
Double
)]
->
PhyloGroup
makePair
to
group
ids
=
case
to
of
Childs
->
over
(
phylo_groupPeriodChilds
)
addPointers
group
Parents
->
over
(
phylo_groupPeriodParents
)
addPointers
group
_
->
panic
(
"[ERR][Viz.Phylo.Example.makePair] PairTo
type not defined"
)
Descendant
->
over
(
phylo_groupPeriodChilds
)
addPointers
group
Ascendant
->
over
(
phylo_groupPeriodParents
)
addPointers
group
_
->
panic
(
"[ERR][Viz.Phylo.Example.makePair] Filiation
type not defined"
)
where
--------------------------------------
addPointers
::
[
Pointer
]
->
[
Pointer
]
...
...
@@ -161,8 +161,8 @@ makePair to group ids = case to of
-- | To pair all the Phylogroups of given PhyloLevel to their best Parents or Childs
interTempoMatching
::
PairTo
->
Level
->
(
Proximity
,[
Double
])
->
Phylo
->
Phylo
interTempoMatching
to
lvl
(
prox
,
param
)
p
=
alterPhyloGroups
interTempoMatching
::
Filiation
->
Level
->
Proximity
->
Phylo
->
Phylo
interTempoMatching
to
lvl
prox
p
=
alterPhyloGroups
(
\
groups
->
map
(
\
group
->
if
(
getGroupLevel
group
)
==
lvl
...
...
@@ -170,7 +170,7 @@ interTempoMatching to lvl (prox,param) p = alterPhyloGroups
let
--------------------------------------
candidates
::
[(
PhyloGroupId
,
Double
)]
candidates
=
findBestCandidates
to
1
5
(
prox
,
param
)
group
p
candidates
=
findBestCandidates
to
1
5
prox
group
p
--------------------------------------
in
makePair
to
group
candidates
...
...
src/Gargantext/Viz/Phylo/Tools.hs
View file @
c35221a6
...
...
@@ -20,7 +20,7 @@ module Gargantext.Viz.Phylo.Tools
import
Control.Lens
hiding
(
both
,
Level
)
import
Data.List
(
filter
,
intersect
,
(
++
),
sort
,
null
,
head
,
tail
,
last
,
tails
,
delete
,
nub
,
concat
,
union
,
sortOn
)
import
Data.Maybe
(
mapMaybe
)
import
Data.Map
(
Map
,
mapKeys
,
member
,
elems
,
adjust
)
import
Data.Map
(
Map
,
mapKeys
,
member
,
elems
,
adjust
,
(
!
)
)
import
Data.Set
(
Set
)
import
Data.Text
(
Text
,
toLower
)
import
Data.Tuple.Extra
...
...
@@ -136,7 +136,31 @@ getBranchIdsWith lvl p = sortOn snd
-- | To get the Meta value of a PhyloBranch
getBranchMeta
::
Text
->
PhyloBranch
->
Double
getBranchMeta
k
b
=
(
b
^.
phylo_branchMeta
)
Map
.!
k
getBranchMeta
k
b
=
(
b
^.
phylo_branchMeta
)
!
k
-- | To get the Name of a Clustering Methods
getClusterName
::
Clustering
->
ClusteringName
getClusterName
c
=
_clustering_name
c
-- | To get the params of a Clustering Methods
getClusterParam
::
Clustering
->
Text
->
Double
getClusterParam
c
k
=
if
(
member
k
$
_clustering_params
c
)
then
(
_clustering_params
c
)
Map
.!
k
else
panic
"[ERR][Viz.Phylo.Tools.getClusterParam] the key is not in params"
-- | To get the boolean params of a Clustering Methods
getClusterParamBool
::
Clustering
->
Text
->
Bool
getClusterParamBool
c
k
=
if
(
member
k
$
_clustering_paramsBool
c
)
then
(
_clustering_paramsBool
c
)
Map
.!
k
else
panic
"[ERR][Viz.Phylo.Tools.getClusterParamBool] the key is not in paramsBool"
-- | To get the first clustering method to apply to get the level 1 of a Phylo
getFstCluster
::
PhyloQuery
->
Clustering
getFstCluster
q
=
q
^.
phyloQuery_fstCluster
-- | To get the foundations of a Phylo
...
...
@@ -355,6 +379,16 @@ getNodesInBranches v = filter (\n -> isJust $ n ^. phylo_nodeBranchId)
$
v
^.
phylo_viewNodes
-- | To get the cluster methods to apply to the Nths levels of a Phylo
getNthCluster
::
PhyloQuery
->
Clustering
getNthCluster
q
=
q
^.
phyloQuery_nthCluster
-- | To get the Sup Level of a reconstruction of a Phylo from a PhyloQuery
getNthLevel
::
PhyloQuery
->
Level
getNthLevel
q
=
q
^.
phyloQuery_nthLevel
-- | To get the PhylolevelId of a given PhyloLevel
getPhyloLevelId
::
PhyloLevel
->
PhyloLevelId
getPhyloLevelId
=
_phylo_levelId
...
...
@@ -376,6 +410,13 @@ getPhyloPeriodId :: PhyloPeriod -> PhyloPeriodId
getPhyloPeriodId
prd
=
_phylo_periodId
prd
-- | To get the sensibility of a Proximity if it exists
getSensibility
::
Proximity
->
Double
getSensibility
prox
=
if
(
member
"sensibility"
$
prox
^.
proximity_params
)
then
(
prox
^.
proximity_params
)
!
"sensibility"
else
panic
"[ERR][Viz.Phylo.Tools.getSensibility] sensibility not in params"
-- | To get the PhyloGroupId of the Source of a PhyloEdge
getSourceId
::
PhyloEdge
->
PhyloGroupId
getSourceId
e
=
e
^.
phylo_edgeSource
...
...
@@ -386,6 +427,21 @@ getTargetId :: PhyloEdge -> PhyloGroupId
getTargetId
e
=
e
^.
phylo_edgeTarget
-- | To get the Grain of the PhyloPeriods from a PhyloQuery
getTimeGrain
::
PhyloQuery
->
Int
getTimeGrain
q
=
q
^.
phyloQuery_timeGrain
-- | To get the intertemporal matching strategy to apply to a Phylo from a PhyloQuery
getTimeMatching
::
PhyloQuery
->
Proximity
getTimeMatching
q
=
q
^.
phyloQuery_timeMatching
-- | To get the Steps of the PhyloPeriods from a PhyloQuery
getTimeSteps
::
PhyloQuery
->
Int
getTimeSteps
q
=
q
^.
phyloQuery_timeSteps
-- | To get all the PhyloBranchIds of a PhyloView
getViewBranchIds
::
PhyloView
->
[
PhyloBranchId
]
getViewBranchIds
v
=
map
getBranchId
$
v
^.
phylo_viewBranches
...
...
src/Gargantext/Viz/Phylo/View/ViewMaker.hs
View file @
c35221a6
...
...
@@ -125,7 +125,7 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
-- | To transform a PhyloQuery into a PhyloView
queryToView
::
PhyloQuery
->
Phylo
->
PhyloView
queryToView
::
PhyloQuery
View
->
Phylo
->
PhyloView
queryToView
q
p
=
processDisplay
(
q
^.
query_display
)
$
processSort
(
q
^.
query_sort
)
p
$
processTaggers
(
q
^.
query_taggers
)
p
...
...
@@ -137,7 +137,7 @@ queryToView q p = processDisplay (q ^. query_display)
-- | dirty params
phyloParams
::
PhyloParam
phyloParams
=
PhyloParam
"v0.1"
(
Software
"Gargantext"
"v4"
)
""
phyloParams
=
PhyloParam
"v0.1"
(
Software
"Gargantext"
"v4"
)
""
Nothing
-- | To do : effectively get the PhyloParams of a 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