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
d5ae1fc2
Commit
d5ae1fc2
authored
Oct 22, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Phylo] Clean
parent
e1d48283
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
26 additions
and
11 deletions
+26
-11
LevelMaker.hs
src/Gargantext/Core/Viz/Phylo/LevelMaker.hs
+26
-7
Main.hs
src/Gargantext/Core/Viz/Phylo/Main.hs
+0
-4
No files found.
src/Gargantext/Core/Viz/Phylo/LevelMaker.hs
View file @
d5ae1fc2
...
@@ -44,7 +44,6 @@ import Numeric.Statistics (percentile)
...
@@ -44,7 +44,6 @@ import Numeric.Statistics (percentile)
-- | PhyloLevelMaker | --
-- | PhyloLevelMaker | --
-------------------------
-------------------------
-- | A typeClass for polymorphic PhyloLevel functions
-- | A typeClass for polymorphic PhyloLevel functions
class
PhyloLevelMaker
aggregate
class
PhyloLevelMaker
aggregate
where
where
...
@@ -105,11 +104,15 @@ instance PhyloLevelMaker Document
...
@@ -105,11 +104,15 @@ instance PhyloLevelMaker Document
addPhyloLevel'
::
PhyloLevelMaker
a
=>
Level
->
Map
(
Date
,
Date
)
[
a
]
->
Phylo
->
Phylo
addPhyloLevel'
::
PhyloLevelMaker
a
=>
Level
->
Map
(
Date
,
Date
)
[
a
]
->
Phylo
->
Phylo
addPhyloLevel'
lvl
m
p
=
alterPhyloPeriods
addPhyloLevel'
lvl
m
p
=
alterPhyloPeriods
(
\
period
->
let
pId
=
_phylo_periodId
period
(
\
period
->
let
pId
=
_phylo_periodId
period
in
over
(
phylo_periodLevels
)
in
over
phylo_periodLevels
(
\
phyloLevels
->
(
\
phyloLevels
->
let
groups
=
toPhyloGroups
lvl
pId
(
m
!
pId
)
m
p
let
groups
=
toPhyloGroups
lvl
pId
(
m
!
pId
)
m
p
in
trace
(
show
(
length
groups
)
<>
" groups for "
<>
show
(
pId
)
)
$
phyloLevels
++
[
PhyloLevel
(
pId
,
lvl
)
groups
]
in
trace
(
show
(
length
groups
)
)
period
)
p
<>
" groups for "
<>
show
(
pId
)
)
$
phyloLevels
++
[
PhyloLevel
(
pId
,
lvl
)
groups
]
)
period
)
p
----------------------
----------------------
...
@@ -118,7 +121,14 @@ addPhyloLevel' lvl m p = alterPhyloPeriods
...
@@ -118,7 +121,14 @@ addPhyloLevel' lvl m p = alterPhyloPeriods
-- | To transform a Clique into a PhyloGroup
-- | To transform a Clique into a PhyloGroup
cliqueToGroup
::
PhyloPeriodId
->
Level
->
Int
->
Text
->
PhyloFis
->
Map
Date
(
Map
(
Int
,
Int
)
Double
)
->
Vector
Ngrams
->
PhyloGroup
cliqueToGroup
::
PhyloPeriodId
->
Level
->
Int
->
Text
->
PhyloFis
->
Map
Date
(
Map
(
Int
,
Int
)
Double
)
->
Vector
Ngrams
->
PhyloGroup
cliqueToGroup
prd
lvl
idx
lbl
fis
cooc'
root
=
PhyloGroup
((
prd
,
lvl
),
idx
)
lbl
ngrams
cliqueToGroup
prd
lvl
idx
lbl
fis
cooc'
root
=
PhyloGroup
((
prd
,
lvl
),
idx
)
lbl
ngrams
(
getNgramsMeta
cooc
ngrams
)
(
getNgramsMeta
cooc
ngrams
)
-- empty
-- empty
...
@@ -142,7 +152,14 @@ cliqueToGroup prd lvl idx lbl fis cooc' root = PhyloGroup ((prd, lvl), idx) lbl
...
@@ -142,7 +152,14 @@ cliqueToGroup prd lvl idx lbl fis cooc' root = PhyloGroup ((prd, lvl), idx) lbl
-- | To transform a Cluster into a Phylogroup
-- | To transform a Cluster into a Phylogroup
clusterToGroup
::
PhyloPeriodId
->
Level
->
Int
->
Text
->
PhyloCluster
->
Map
(
Date
,
Date
)
[
PhyloCluster
]
->
Phylo
->
PhyloGroup
clusterToGroup
::
PhyloPeriodId
->
Level
->
Int
->
Text
->
PhyloCluster
->
Map
(
Date
,
Date
)
[
PhyloCluster
]
->
Phylo
->
PhyloGroup
clusterToGroup
prd
lvl
idx
lbl
groups
_m
p
=
clusterToGroup
prd
lvl
idx
lbl
groups
_m
p
=
PhyloGroup
((
prd
,
lvl
),
idx
)
lbl
ngrams
PhyloGroup
((
prd
,
lvl
),
idx
)
lbl
ngrams
(
getNgramsMeta
cooc
ngrams
)
(
getNgramsMeta
cooc
ngrams
)
...
@@ -154,7 +171,9 @@ clusterToGroup prd lvl idx lbl groups _m p =
...
@@ -154,7 +171,9 @@ clusterToGroup prd lvl idx lbl groups _m p =
where
where
--------------------------------------
--------------------------------------
cooc
::
Map
(
Int
,
Int
)
Double
cooc
::
Map
(
Int
,
Int
)
Double
cooc
=
getMiniCooc
(
listToFullCombi
ngrams
)
(
periodsToYears
[
prd
])
(
getPhyloCooc
p
)
cooc
=
getMiniCooc
(
listToFullCombi
ngrams
)
(
periodsToYears
[
prd
]
)
(
getPhyloCooc
p
)
--------------------------------------
--------------------------------------
childs
::
[
Pointer
]
childs
::
[
Pointer
]
childs
=
map
(
\
g
->
(
getGroupId
g
,
1
))
groups
childs
=
map
(
\
g
->
(
getGroupId
g
,
1
))
groups
...
...
src/Gargantext/Core/Viz/Phylo/Main.hs
View file @
d5ae1fc2
...
@@ -121,7 +121,3 @@ writePhylo fp phview = runGraphviz (viewToDot phview) Svg fp
...
@@ -121,7 +121,3 @@ writePhylo fp phview = runGraphviz (viewToDot phview) Svg fp
viewPhylo2Svg
::
PhyloView
->
IO
DB
.
ByteString
viewPhylo2Svg
::
PhyloView
->
IO
DB
.
ByteString
viewPhylo2Svg
p
=
graphvizWithHandle
Dot
(
viewToDot
p
)
Svg
DB
.
hGetContents
viewPhylo2Svg
p
=
graphvizWithHandle
Dot
(
viewToDot
p
)
Svg
DB
.
hGetContents
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