Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
haskell-gargantext
Commits
89d26230
Commit
89d26230
authored
Apr 11, 2019
by
Quentin Lobbé
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
just finalized the dot export
parent
e050b8b6
Changes
6
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
139 additions
and
93 deletions
+139
-93
Phylo.hs
src/Gargantext/Viz/Phylo.hs
+3
-0
Example.hs
src/Gargantext/Viz/Phylo/Example.hs
+6
-1
Tools.hs
src/Gargantext/Viz/Phylo/Tools.hs
+53
-4
Display.hs
src/Gargantext/Viz/Phylo/View/Display.hs
+9
-8
Export.hs
src/Gargantext/Viz/Phylo/View/Export.hs
+66
-78
ViewMaker.hs
src/Gargantext/Viz/Phylo/View/ViewMaker.hs
+2
-2
No files found.
src/Gargantext/Viz/Phylo.hs
View file @
89d26230
...
...
@@ -364,6 +364,7 @@ data PhyloView = PhyloView
,
_pv_title
::
Text
,
_pv_description
::
Text
,
_pv_filiation
::
Filiation
,
_pv_level
::
Level
,
_pv_metrics
::
Map
Text
[
Double
]
,
_pv_branches
::
[
PhyloBranch
]
,
_pv_nodes
::
[
PhyloNode
]
...
...
@@ -400,6 +401,7 @@ data PhyloNode = PhyloNode
------------------------
data
ExportMode
=
Json
|
Dot
|
Svg
data
DisplayMode
=
Flat
|
Nested
deriving
(
Generic
,
Show
,
Read
)
...
...
@@ -424,6 +426,7 @@ data PhyloQueryView = PhyloQueryView
,
_qv_sort
::
Maybe
(
Sort
,
Order
)
-- A display mode to apply to the PhyloGraph, ie: [Node[Node,Edge],Edge] or [[Node,Node],[Edge,Edge]]
,
_qv_export
::
ExportMode
,
_qv_display
::
DisplayMode
,
_qv_verbose
::
Bool
}
...
...
src/Gargantext/Viz/Phylo/Example.hs
View file @
89d26230
...
...
@@ -28,6 +28,7 @@ TODO:
module
Gargantext.Viz.Phylo.Example
where
import
Data.GraphViz.Types.Generalised
(
DotGraph
)
import
Data.Text
(
Text
)
import
Data.List
((
++
),
last
)
import
Data.Map
(
Map
)
...
...
@@ -44,6 +45,7 @@ import Gargantext.Viz.Phylo.LevelMaker
import
Gargantext.Viz.Phylo.LinkMaker
import
Gargantext.Viz.Phylo.Tools
import
Gargantext.Viz.Phylo.View.ViewMaker
import
Gargantext.Viz.Phylo.View.Export
import
qualified
Data.List
as
List
...
...
@@ -52,6 +54,9 @@ import qualified Data.List as List
------------------------------------------------------
phyloDot
::
DotGraph
DotId
phyloDot
=
viewToDot
phyloView
phyloView
::
PhyloView
phyloView
=
toPhyloView
(
queryParser'
queryViewEx
)
phyloFromQuery
...
...
@@ -69,7 +74,7 @@ queryViewEx = "level=3"
phyloQueryView
::
PhyloQueryView
phyloQueryView
=
PhyloQueryView
2
Merge
False
1
[
BranchAge
]
[
defaultSmallBranch
]
[
BranchLabelFreq
,
GroupLabelCooc
]
(
Just
(
ByBranchAge
,
Asc
))
Flat
True
phyloQueryView
=
PhyloQueryView
2
Merge
False
1
[
BranchAge
]
[
defaultSmallBranch
]
[
BranchLabelFreq
,
GroupLabelCooc
]
(
Just
(
ByBranchAge
,
Asc
))
Json
Flat
True
--------------------------------------------------
...
...
src/Gargantext/Viz/Phylo/Tools.hs
View file @
89d26230
...
...
@@ -588,6 +588,55 @@ getViewBranchIds v = map getBranchId $ v ^. pv_branches
-- | PhyloQuery & QueryView | --
--------------------------------
-- | To filter PhyloView's Branches by level
filterBranchesByLevel
::
Level
->
PhyloView
->
[
PhyloBranch
]
filterBranchesByLevel
lvl
pv
=
filter
(
\
pb
->
lvl
==
(
fst
$
pb
^.
pb_id
))
$
pv
^.
pv_branches
-- | To filter PhyloView's Edges by level
filterEdgesByLevel
::
Level
->
[
PhyloEdge
]
->
[
PhyloEdge
]
filterEdgesByLevel
lvl
pes
=
filter
(
\
pe
->
(
lvl
==
((
snd
.
fst
)
$
pe
^.
pe_source
))
&&
(
lvl
==
((
snd
.
fst
)
$
pe
^.
pe_target
)))
pes
-- | To filter PhyloView's Edges by type
filterEdgesByType
::
EdgeType
->
[
PhyloEdge
]
->
[
PhyloEdge
]
filterEdgesByType
t
pes
=
filter
(
\
pe
->
t
==
(
pe
^.
pe_type
))
pes
-- | To filter PhyloView's Nodes by the oldest Period
filterNodesByFirstPeriod
::
[
PhyloNode
]
->
[
PhyloNode
]
filterNodesByFirstPeriod
pns
=
filter
(
\
pn
->
fstPrd
==
((
fst
.
fst
)
$
pn
^.
pn_id
))
pns
where
--------------------------------------
fstPrd
::
(
Date
,
Date
)
fstPrd
=
(
head'
"filterNodesByFirstPeriod"
)
$
sortOn
fst
$
map
(
\
pn
->
(
fst
.
fst
)
$
pn
^.
pn_id
)
pns
--------------------------------------
-- | To filter PhyloView's Nodes by Branch
filterNodesByBranch
::
PhyloBranchId
->
[
PhyloNode
]
->
[
PhyloNode
]
filterNodesByBranch
bId
pns
=
filter
(
\
pn
->
if
isJust
$
pn
^.
pn_bid
then
if
bId
==
(
fromJust
$
pn
^.
pn_bid
)
then
True
else
False
else
False
)
pns
-- | To filter PhyloView's Nodes by level
filterNodesByLevel
::
Level
->
[
PhyloNode
]
->
[
PhyloNode
]
filterNodesByLevel
lvl
pns
=
filter
(
\
pn
->
lvl
==
((
snd
.
fst
)
$
pn
^.
pn_id
))
pns
-- | To filter PhyloView's Nodes by Period
filterNodesByPeriod
::
PhyloPeriodId
->
[
PhyloNode
]
->
[
PhyloNode
]
filterNodesByPeriod
prd
pns
=
filter
(
\
pn
->
prd
==
((
fst
.
fst
)
$
pn
^.
pn_id
))
pns
-- | To get the first clustering method to apply to get the contextual units of a Phylo
getContextualUnit
::
PhyloQueryBuild
->
Cluster
getContextualUnit
q
=
q
^.
q_contextualUnit
...
...
@@ -673,9 +722,9 @@ initPhyloQueryBuild name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis
-- | To initialize a PhyloQueryView default parameters
initPhyloQueryView
::
Maybe
Level
->
Maybe
Filiation
->
Maybe
Bool
->
Maybe
Level
->
Maybe
[
Metric
]
->
Maybe
[
Filter
]
->
Maybe
[
Tagger
]
->
Maybe
(
Sort
,
Order
)
->
Maybe
DisplayMode
->
Maybe
Bool
->
PhyloQueryView
initPhyloQueryView
(
def
2
->
lvl
)
(
def
Descendant
->
f
)
(
def
False
->
c
)
(
def
1
->
d
)
(
def
[]
->
ms
)
(
def
[]
->
fs
)
(
def
[]
->
ts
)
s
(
def
Flat
->
dm
)
(
def
True
->
v
)
=
PhyloQueryView
lvl
f
c
d
ms
fs
ts
s
dm
v
initPhyloQueryView
::
Maybe
Level
->
Maybe
Filiation
->
Maybe
Bool
->
Maybe
Level
->
Maybe
[
Metric
]
->
Maybe
[
Filter
]
->
Maybe
[
Tagger
]
->
Maybe
(
Sort
,
Order
)
->
Maybe
ExportMode
->
Maybe
DisplayMode
->
Maybe
Bool
->
PhyloQueryView
initPhyloQueryView
(
def
2
->
lvl
)
(
def
Descendant
->
f
)
(
def
False
->
c
)
(
def
1
->
d
)
(
def
[]
->
ms
)
(
def
[]
->
fs
)
(
def
[]
->
ts
)
s
(
def
Json
->
em
)
(
def
Flat
->
dm
)
(
def
True
->
v
)
=
PhyloQueryView
lvl
f
c
d
ms
fs
ts
s
em
dm
v
-- | To define some obvious boolean getters
...
...
@@ -725,7 +774,7 @@ defaultQueryBuild = initPhyloQueryBuild (Just "Cesar et Cleôpatre")
Nothing
Nothing
defaultQueryView
::
PhyloQueryView
defaultQueryView
=
initPhyloQueryView
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
defaultQueryView
=
initPhyloQueryView
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
-- Software
...
...
src/Gargantext/Viz/Phylo/View/Display.hs
View file @
89d26230
...
...
@@ -43,11 +43,12 @@ toNestedView ns ns'
-- | To process a DisplayMode to a PhyloView
processDisplay
::
DisplayMode
->
PhyloView
->
PhyloView
processDisplay
d
v
=
case
d
of
Flat
->
v
Nested
->
let
ns
=
sortOn
getNodeLevel
$
v
^.
pv_nodes
lvl
=
getNodeLevel
$
head'
"processDisplay"
ns
in
v
&
pv_nodes
.~
toNestedView
(
filter
(
\
n
->
lvl
==
getNodeLevel
n
)
ns
)
(
filter
(
\
n
->
lvl
<
getNodeLevel
n
)
ns
)
--
_
->
panic
"[ERR][Viz.Phylo.Example.processDisplay] display not found"
processDisplay
::
DisplayMode
->
ExportMode
->
PhyloView
->
PhyloView
processDisplay
d
e
v
=
case
e
of
Json
->
case
d
of
Flat
->
v
Nested
->
let
ns
=
sortOn
getNodeLevel
$
v
^.
pv_nodes
lvl
=
getNodeLevel
$
head'
"processDisplay"
ns
in
v
&
pv_nodes
.~
toNestedView
(
filter
(
\
n
->
lvl
==
getNodeLevel
n
)
ns
)
(
filter
(
\
n
->
lvl
<
getNodeLevel
n
)
ns
)
_
->
v
src/Gargantext/Viz/Phylo/View/Export.hs
View file @
89d26230
This diff is collapsed.
Click to expand it.
src/Gargantext/Viz/Phylo/View/ViewMaker.hs
View file @
89d26230
...
...
@@ -46,7 +46,7 @@ initPhyloEdge id pts et = map (\pt -> PhyloEdge id (fst pt) et (snd pt)) pts
-- | To init a PhyloView
initPhyloView
::
Level
->
Text
->
Text
->
Filiation
->
Bool
->
Phylo
->
PhyloView
initPhyloView
lvl
lbl
dsc
fl
vb
p
=
PhyloView
(
getPhyloParams
p
)
lbl
dsc
fl
empty
initPhyloView
lvl
lbl
dsc
fl
vb
p
=
PhyloView
(
getPhyloParams
p
)
lbl
dsc
fl
lvl
empty
(
[]
++
(
phyloToBranches
lvl
p
))
(
[]
++
(
groupsToNodes
True
vb
(
getPeaksLabels
p
)
gs
))
(
[]
++
(
groupsToEdges
fl
PeriodEdge
gs
))
...
...
@@ -148,7 +148,7 @@ toPhyloView' :: Maybe Level
toPhyloView'
=
initPhyloQueryView
toPhyloView
::
PhyloQueryView
->
Phylo
->
PhyloView
toPhyloView
q
p
=
processDisplay
(
q
^.
qv_display
)
toPhyloView
q
p
=
processDisplay
(
q
^.
qv_display
)
(
q
^.
qv_export
)
$
processSort
(
q
^.
qv_sort
)
p
$
processTaggers
(
q
^.
qv_taggers
)
p
$
processFilters
(
q
^.
qv_filters
)
p
...
...
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