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
195
Issues
195
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
74d2038a
Commit
74d2038a
authored
May 21, 2021
by
qlobbe
Committed by
Alexandre Delanoë
Feb 14, 2022
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add a list parser param
parent
878907d0
Changes
4
Expand all
Show whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
312 additions
and
203 deletions
+312
-203
Main.hs
bin/gargantext-phylo/Main.hs
+72
-96
package.yaml
package.yaml
+2
-0
Phylo.hs
src/Gargantext/Core/Viz/Phylo.hs
+128
-21
PhyloTools.hs
src/Gargantext/Core/Viz/Phylo/PhyloTools.hs
+110
-86
No files found.
bin/gargantext-phylo/Main.hs
View file @
74d2038a
This diff is collapsed.
Click to expand it.
package.yaml
View file @
74d2038a
...
@@ -54,6 +54,7 @@ library:
...
@@ -54,6 +54,7 @@ library:
-
Gargantext.API.Ngrams
-
Gargantext.API.Ngrams
-
Gargantext.API.Ngrams.Tools
-
Gargantext.API.Ngrams.Tools
-
Gargantext.API.Ngrams.Types
-
Gargantext.API.Ngrams.Types
-
Gargantext.API.Ngrams.Prelude
-
Gargantext.API.Admin.Settings
-
Gargantext.API.Admin.Settings
-
Gargantext.API.Admin.EnvTypes
-
Gargantext.API.Admin.EnvTypes
-
Gargantext.API.Admin.Types
-
Gargantext.API.Admin.Types
...
@@ -73,6 +74,7 @@ library:
...
@@ -73,6 +74,7 @@ library:
-
Gargantext.Database.Query.Table.Node
-
Gargantext.Database.Query.Table.Node
-
Gargantext.Database.Query.Table.Node.UpdateOpaleye
-
Gargantext.Database.Query.Table.Node.UpdateOpaleye
-
Gargantext.Database.Query.Table.NgramsPostag
-
Gargantext.Database.Query.Table.NgramsPostag
-
Gargantext.Database.Schema.Ngrams
-
Gargantext.Database.Prelude
-
Gargantext.Database.Prelude
-
Gargantext.Database.Admin.Trigger.Init
-
Gargantext.Database.Admin.Trigger.Init
-
Gargantext.Database.Admin.Config
-
Gargantext.Database.Admin.Config
...
...
src/Gargantext/Core/Viz/Phylo.hs
View file @
74d2038a
This diff is collapsed.
Click to expand it.
src/Gargantext/Core/Viz/Phylo/PhyloTools.hs
View file @
74d2038a
...
@@ -13,7 +13,7 @@ Portability : POSIX
...
@@ -13,7 +13,7 @@ Portability : POSIX
module
Gargantext.Core.Viz.Phylo.PhyloTools
where
module
Gargantext.Core.Viz.Phylo.PhyloTools
where
import
Control.Lens
hiding
(
Level
)
import
Control.Lens
hiding
(
Level
)
import
Data.List
(
sort
,
concat
,
null
,
union
,
(
++
),
tails
,
sortOn
,
nub
,
init
,
tail
,
partition
,
tails
,
nubBy
,
group
)
import
Data.List
(
sort
,
concat
,
null
,
union
,
(
++
),
tails
,
sortOn
,
nub
,
init
,
tail
,
partition
,
tails
,
nubBy
,
group
,
notElem
)
import
Data.Map
(
Map
,
elems
,
fromList
,
unionWith
,
keys
,
member
,
(
!
),
filterWithKey
,
fromListWith
,
empty
,
restrictKeys
)
import
Data.Map
(
Map
,
elems
,
fromList
,
unionWith
,
keys
,
member
,
(
!
),
filterWithKey
,
fromListWith
,
empty
,
restrictKeys
)
import
Data.Set
(
Set
,
disjoint
)
import
Data.Set
(
Set
,
disjoint
)
import
Data.String
(
String
)
import
Data.String
(
String
)
...
@@ -157,7 +157,7 @@ toFstDate ds = snd
...
@@ -157,7 +157,7 @@ toFstDate ds = snd
$
head'
"firstDate"
$
head'
"firstDate"
$
sortOn
fst
$
sortOn
fst
$
map
(
\
d
->
$
map
(
\
d
->
let
d'
=
read
(
filter
(
\
c
->
c
/=
'-'
)
$
unpack
d
)
::
Int
let
d'
=
read
(
filter
(
\
c
->
notElem
c
[
'U'
,
'T'
,
'C'
,
' '
,
':'
,
'-'
]
)
$
unpack
d
)
::
Int
in
(
d'
,
d
))
ds
in
(
d'
,
d
))
ds
toLstDate
::
[
Text
]
->
Text
toLstDate
::
[
Text
]
->
Text
...
@@ -166,12 +166,13 @@ toLstDate ds = snd
...
@@ -166,12 +166,13 @@ toLstDate ds = snd
$
reverse
$
reverse
$
sortOn
fst
$
sortOn
fst
$
map
(
\
d
->
$
map
(
\
d
->
let
d'
=
read
(
filter
(
\
c
->
c
/=
'-'
)
$
unpack
d
)
::
Int
let
d'
=
read
(
filter
(
\
c
->
notElem
c
[
'U'
,
'T'
,
'C'
,
' '
,
':'
,
'-'
]
)
$
unpack
d
)
::
Int
in
(
d'
,
d
))
ds
in
(
d'
,
d
))
ds
getTimeScale
::
Phylo
->
[
Char
]
getTimeScale
::
Phylo
->
[
Char
]
getTimeScale
p
=
case
(
timeUnit
$
getConfig
p
)
of
getTimeScale
p
=
case
(
timeUnit
$
getConfig
p
)
of
Epoch
_
_
_
->
"epoch"
Year
_
_
_
->
"year"
Year
_
_
_
->
"year"
Month
_
_
_
->
"month"
Month
_
_
_
->
"month"
Week
_
_
_
->
"week"
Week
_
_
_
->
"week"
...
@@ -187,6 +188,7 @@ toTimeScale dates step =
...
@@ -187,6 +188,7 @@ toTimeScale dates step =
getTimeStep
::
TimeUnit
->
Int
getTimeStep
::
TimeUnit
->
Int
getTimeStep
time
=
case
time
of
getTimeStep
time
=
case
time
of
Epoch
_
s
_
->
s
Year
_
s
_
->
s
Year
_
s
_
->
s
Month
_
s
_
->
s
Month
_
s
_
->
s
Week
_
s
_
->
s
Week
_
s
_
->
s
...
@@ -194,6 +196,7 @@ getTimeStep time = case time of
...
@@ -194,6 +196,7 @@ getTimeStep time = case time of
getTimePeriod
::
TimeUnit
->
Int
getTimePeriod
::
TimeUnit
->
Int
getTimePeriod
time
=
case
time
of
getTimePeriod
time
=
case
time
of
Epoch
p
_
_
->
p
Year
p
_
_
->
p
Year
p
_
_
->
p
Month
p
_
_
->
p
Month
p
_
_
->
p
Week
p
_
_
->
p
Week
p
_
_
->
p
...
@@ -201,6 +204,7 @@ getTimePeriod time = case time of
...
@@ -201,6 +204,7 @@ getTimePeriod time = case time of
getTimeFrame
::
TimeUnit
->
Int
getTimeFrame
::
TimeUnit
->
Int
getTimeFrame
time
=
case
time
of
getTimeFrame
time
=
case
time
of
Epoch
_
_
f
->
f
Year
_
_
f
->
f
Year
_
_
f
->
f
Month
_
_
f
->
f
Month
_
_
f
->
f
Week
_
_
f
->
f
Week
_
_
f
->
f
...
@@ -324,20 +328,22 @@ getPeriodPointers fil g =
...
@@ -324,20 +328,22 @@ getPeriodPointers fil g =
case
fil
of
case
fil
of
ToChilds
->
g
^.
phylo_groupPeriodChilds
ToChilds
->
g
^.
phylo_groupPeriodChilds
ToParents
->
g
^.
phylo_groupPeriodParents
ToParents
->
g
^.
phylo_groupPeriodParents
ToChildsMemory
->
undefined
ToParentsMemory
->
undefined
filterProximity
::
Proximity
->
Double
->
Double
->
Bool
filterProximity
::
Proximity
->
Double
->
Double
->
Bool
filterProximity
proximity
thr
local
=
filterProximity
proximity
thr
local
=
case
proximity
of
case
proximity
of
WeightedLogJaccard
_
->
local
>=
thr
WeightedLogJaccard
_
->
local
>=
thr
WeightedLogSim
_
->
local
>=
thr
WeightedLogSim
_
->
local
>=
thr
Hamming
->
undefined
Hamming
_
->
undefined
getProximityName
::
Proximity
->
String
getProximityName
::
Proximity
->
String
getProximityName
proximity
=
getProximityName
proximity
=
case
proximity
of
case
proximity
of
WeightedLogJaccard
_
->
"WLJaccard"
WeightedLogJaccard
_
->
"WLJaccard"
WeightedLogSim
_
->
"WeightedLogSim"
WeightedLogSim
_
->
"WeightedLogSim"
Hamming
->
"Hamming"
Hamming
_
->
"Hamming"
---------------
---------------
-- | Phylo | --
-- | Phylo | --
...
@@ -349,9 +355,27 @@ addPointers fil pty pointers g =
...
@@ -349,9 +355,27 @@ addPointers fil pty pointers g =
TemporalPointer
->
case
fil
of
TemporalPointer
->
case
fil
of
ToChilds
->
g
&
phylo_groupPeriodChilds
.~
pointers
ToChilds
->
g
&
phylo_groupPeriodChilds
.~
pointers
ToParents
->
g
&
phylo_groupPeriodParents
.~
pointers
ToParents
->
g
&
phylo_groupPeriodParents
.~
pointers
ToChildsMemory
->
undefined
ToParentsMemory
->
undefined
LevelPointer
->
case
fil
of
LevelPointer
->
case
fil
of
ToChilds
->
g
&
phylo_groupLevelChilds
.~
pointers
ToChilds
->
g
&
phylo_groupLevelChilds
.~
pointers
ToParents
->
g
&
phylo_groupLevelParents
.~
pointers
ToParents
->
g
&
phylo_groupLevelParents
.~
pointers
ToChildsMemory
->
undefined
ToParentsMemory
->
undefined
toPointer'
::
Double
->
Pointer
->
Pointer'
toPointer'
thr
pt
=
(
fst
pt
,(
thr
,
snd
pt
))
addMemoryPointers
::
Filiation
->
PointerType
->
Double
->
[
Pointer
]
->
PhyloGroup
->
PhyloGroup
addMemoryPointers
fil
pty
thr
pointers
g
=
case
pty
of
TemporalPointer
->
case
fil
of
ToChilds
->
undefined
ToParents
->
undefined
ToChildsMemory
->
g
&
phylo_groupPeriodMemoryChilds
.~
(
concat
[(
g
^.
phylo_groupPeriodMemoryChilds
),(
map
(
\
pt
->
toPointer'
thr
pt
)
pointers
)])
ToParentsMemory
->
g
&
phylo_groupPeriodMemoryParents
.~
(
concat
[(
g
^.
phylo_groupPeriodMemoryParents
),(
map
(
\
pt
->
toPointer'
thr
pt
)
pointers
)])
LevelPointer
->
undefined
getPeriodIds
::
Phylo
->
[(
Date
,
Date
)]
getPeriodIds
::
Phylo
->
[(
Date
,
Date
)]
...
@@ -544,7 +568,7 @@ getSensibility :: Proximity -> Double
...
@@ -544,7 +568,7 @@ getSensibility :: Proximity -> Double
getSensibility
proxi
=
case
proxi
of
getSensibility
proxi
=
case
proxi
of
WeightedLogJaccard
s
->
s
WeightedLogJaccard
s
->
s
WeightedLogSim
s
->
s
WeightedLogSim
s
->
s
Hamming
->
undefined
Hamming
_
->
undefined
----------------
----------------
-- | Branch | --
-- | Branch | --
...
...
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