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
147
Issues
147
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
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
71e39d6a
Commit
71e39d6a
authored
Feb 27, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[PHYLO] Code Review + Tools start.
parent
5741fc28
Pipeline
#230
failed with stage
Changes
4
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
51 additions
and
33 deletions
+51
-33
package.yaml
package.yaml
+3
-0
Phylo.hs
src/Gargantext/Viz/Phylo.hs
+6
-3
Example.hs
src/Gargantext/Viz/Phylo/Example.hs
+13
-30
Tools.hs
src/Gargantext/Viz/Phylo/Tools.hs
+29
-0
No files found.
package.yaml
View file @
71e39d6a
...
...
@@ -71,6 +71,9 @@ library:
-
Gargantext.Viz.Graph
-
Gargantext.Viz.Graph.Distances.Matrice
-
Gargantext.Viz.Graph.Index
-
Gargantext.Viz.Phylo
-
Gargantext.Viz.Phylo.Tools
-
Gargantext.Viz.Phylo.Example
dependencies
:
-
QuickCheck
-
accelerate
...
...
src/Gargantext/Viz/Phylo.hs
View file @
71e39d6a
...
...
@@ -75,12 +75,15 @@ data Phylo =
}
deriving
(
Generic
,
Show
)
-- | Date : a simple Integer
type
Date
=
Int
-- | UTCTime in seconds since UNIX epoch
-- type Start = POSIXTime
-- type End = POSIXTime
type
Start
=
Int
type
End
=
Int
type
Start
=
Date
type
End
=
Date
-- | PhyloStep : steps of phylomemy on temporal axis
-- Period: tuple (start date, end date) of the step of the phylomemy
...
...
src/Gargantext/Viz/Phylo/Example.hs
View file @
71e39d6a
...
...
@@ -61,8 +61,6 @@ import Gargantext.Viz.Phylo.Tools
-- | Types | --
-- | Date : a simple Integer
type
Date
=
Int
-- | Document : a piece of Text linked to a Date
data
Document
=
Document
{
date
::
Date
...
...
@@ -133,8 +131,11 @@ getKeyPair (x,y) m = case findPair (x,y) m of
|
otherwise
=
Nothing
--------------------------------------
listToCombi
::
(
a
->
b
)
->
[
a
]
->
[(
b
,
b
)]
listToCombi
f
l
=
[(
f
x
,
f
y
)
|
(
x
:
rest
)
<-
tails
l
,
y
<-
rest
]
-- |
listToCombi
::
forall
a
b
.
(
a
->
b
)
->
[
a
]
->
[(
b
,
b
)]
listToCombi
f
l
=
[
(
f
x
,
f
y
)
|
(
x
:
rest
)
<-
tails
l
,
y
<-
rest
]
fisToCooc
::
Map
(
Date
,
Date
)
Fis
->
Map
(
Int
,
Int
)
Double
fisToCooc
m
=
map
(
/
docs
)
...
...
@@ -182,7 +183,10 @@ phyloWithGroups1 = updatePhyloByLevel Level_1 phyloLinked_m1_0
cliqueToGroup
::
PhyloPeriodId
->
Int
->
Int
->
Ngrams
->
(
Clique
,
Support
)
->
PhyloGroup
cliqueToGroup
period
lvl
idx
label
fis
=
PhyloGroup
((
period
,
lvl
),
idx
)
label
(
sort
$
map
(
\
x
->
findIdx
x
)
$
Set
.
toList
$
fst
fis
)
(
sort
$
map
findIdx
$
Set
.
toList
$
fst
fis
)
(
singleton
"support"
(
fromIntegral
$
snd
fis
))
[]
[]
[]
[]
...
...
@@ -278,27 +282,6 @@ addPointer :: Semigroup field
addPointer
field
targetPointer
current
=
set
field
(
<>
targetPointer
)
current
getNgrams
::
PhyloGroup
->
[
Int
]
getNgrams
=
_phylo_groupNgrams
getGroups
::
Phylo
->
[
PhyloGroup
]
getGroups
=
view
(
phylo_periods
.
traverse
.
phylo_periodLevels
.
traverse
.
phylo_levelGroups
)
getGroupId
::
PhyloGroup
->
PhyloGroupId
getGroupId
=
view
(
phylo_groupId
)
getGroupLvl
::
PhyloGroup
->
Int
getGroupLvl
=
snd
.
fst
.
getGroupId
getGroupPeriod
::
PhyloGroup
->
(
Date
,
Date
)
getGroupPeriod
=
fst
.
fst
.
getGroupId
getGroupsByLevelAndPeriod
::
Int
->
(
Date
,
Date
)
->
Phylo
->
[
PhyloGroup
]
getGroupsByLevelAndPeriod
lvl
period
p
=
List
.
filter
testGroup
(
getGroups
p
)
where
testGroup
group
=
(
getGroupLvl
group
==
lvl
)
&&
(
getGroupPeriod
group
==
period
)
containsIdx
::
[
Int
]
->
[
Int
]
->
Bool
containsIdx
l
l'
|
null
l'
=
False
...
...
src/Gargantext/Viz/Phylo/Tools.hs
View file @
71e39d6a
...
...
@@ -17,5 +17,34 @@ Portability : POSIX
module
Gargantext.Viz.Phylo.Tools
where
import
Control.Lens
hiding
(
both
)
import
Data.Tuple.Extra
import
Gargantext.Prelude
hiding
(
head
)
import
Gargantext.Viz.Phylo
import
qualified
Data.List
as
List
-- | To get Ngrams out of a Gargantext.Viz.Phylo.PhyloGroup
getNgrams
::
PhyloGroup
->
[
Int
]
getNgrams
=
_phylo_groupNgrams
getGroups
::
Phylo
->
[
PhyloGroup
]
getGroups
=
view
(
phylo_periods
.
traverse
.
phylo_periodLevels
.
traverse
.
phylo_levelGroups
)
getGroupId
::
PhyloGroup
->
PhyloGroupId
getGroupId
=
view
(
phylo_groupId
)
getGroupLvl
::
PhyloGroup
->
Int
getGroupLvl
=
snd
.
fst
.
getGroupId
getGroupPeriod
::
PhyloGroup
->
(
Date
,
Date
)
getGroupPeriod
=
fst
.
fst
.
getGroupId
getGroupsByLevelAndPeriod
::
Int
->
(
Date
,
Date
)
->
Phylo
->
[
PhyloGroup
]
getGroupsByLevelAndPeriod
lvl
period
p
=
List
.
filter
testGroup
(
getGroups
p
)
where
testGroup
group
=
(
getGroupLvl
group
==
lvl
)
&&
(
getGroupPeriod
group
==
period
)
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