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
80e7ae38
Commit
80e7ae38
authored
Apr 06, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[PHYLO][API] Get implemented.
parent
b04c334f
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
98 additions
and
34 deletions
+98
-34
Node.hs
src/Gargantext/API/Node.hs
+2
-2
Prelude.hs
src/Gargantext/Prelude.hs
+30
-2
CSV.hs
src/Gargantext/Text/Parsers/CSV.hs
+2
-3
Phylo.hs
src/Gargantext/Viz/Phylo.hs
+19
-20
API.hs
src/Gargantext/Viz/Phylo/API.hs
+45
-5
Cooc.hs
src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs
+0
-2
No files found.
src/Gargantext/API/Node.hs
View file @
80e7ae38
...
@@ -317,11 +317,11 @@ graphAPI nId = do
...
@@ -317,11 +317,11 @@ graphAPI nId = do
type
PhyloAPI
=
Summary
"Phylo API"
type
PhyloAPI
=
Summary
"Phylo API"
:>
QueryParam
"param"
PhyloQueryView
--
:> QueryParam "param" PhyloQueryView
:>
Get
'[
J
SON
]
PhyloView
:>
Get
'[
J
SON
]
PhyloView
phyloAPI
::
NodeId
->
GargServer
PhyloAPI
phyloAPI
::
NodeId
->
GargServer
PhyloAPI
phyloAPI
n
q
=
pure
$
getPhylo
n
q
phyloAPI
n
=
pure
$
getPhylo
n
...
...
src/Gargantext/Prelude.hs
View file @
80e7ae38
...
@@ -74,7 +74,7 @@ import qualified Data.Map as M
...
@@ -74,7 +74,7 @@ import qualified Data.Map as M
import
Data.Map.Strict
(
insertWith
)
import
Data.Map.Strict
(
insertWith
)
import
qualified
Data.Vector
as
V
import
qualified
Data.Vector
as
V
import
Safe
(
headMay
,
lastMay
)
import
Safe
(
headMay
,
lastMay
,
initMay
,
tailMay
)
import
Text.Show
(
Show
(),
show
)
import
Text.Show
(
Show
(),
show
)
import
Text.Read
(
Read
())
import
Text.Read
(
Read
())
import
Data.String.Conversions
(
cs
)
import
Data.String.Conversions
(
cs
)
...
@@ -270,5 +270,33 @@ maximumWith f = L.maximumBy (compare `on` f)
...
@@ -270,5 +270,33 @@ maximumWith f = L.maximumBy (compare `on` f)
listToCombi
::
forall
a
b
.
(
a
->
b
)
->
[
a
]
->
[(
b
,
b
)]
listToCombi
::
forall
a
b
.
(
a
->
b
)
->
[
a
]
->
[(
b
,
b
)]
listToCombi
f
l
=
[
(
f
x
,
f
y
)
|
(
x
:
rest
)
<-
L
.
tails
l
,
y
<-
rest
]
listToCombi
f
l
=
[
(
f
x
,
f
y
)
|
(
x
:
rest
)
<-
L
.
tails
l
,
y
<-
rest
]
------------------------------------------------------------------------
-- Empty List Sugar Error Handling
-- TODO add Garg Monad Errors
listSafe1
::
Text
->
([
a
]
->
Maybe
a
)
->
Text
->
[
a
]
->
a
listSafe1
s
f
e
xs
=
maybe
(
panic
$
h
<>
e
)
identity
(
f
xs
)
where
h
=
"[ERR][Gargantext] Empty list for "
<>
s
<>
" in "
head'
::
Text
->
[
a
]
->
a
head'
::
Text
->
[
a
]
->
a
head'
e
xs
=
maybe
(
panic
e
)
identity
(
head
xs
)
head'
=
listSafe1
"head"
headMay
last'
::
Text
->
[
a
]
->
a
last'
=
listSafe1
"last"
lastMay
------------------------------------------------------------------------
listSafeN
::
Text
->
([
a
]
->
Maybe
[
a
])
->
Text
->
[
a
]
->
[
a
]
listSafeN
s
f
e
xs
=
maybe
(
panic
$
h
<>
e
)
identity
(
f
xs
)
where
h
=
"[ERR][Gargantext] Empty list for "
<>
s
<>
" in "
tail'
::
Text
->
[
a
]
->
[
a
]
tail'
=
listSafeN
"tail"
tailMay
init'
::
Text
->
[
a
]
->
[
a
]
init'
=
listSafeN
"init"
initMay
src/Gargantext/Text/Parsers/CSV.hs
View file @
80e7ae38
...
@@ -122,12 +122,11 @@ splitDoc' :: SplitContext -> CsvDoc -> Vector CsvDoc
...
@@ -122,12 +122,11 @@ splitDoc' :: SplitContext -> CsvDoc -> Vector CsvDoc
splitDoc'
contextSize
(
CsvDoc
t
s
py
pm
pd
abst
auth
)
=
V
.
fromList
$
[
firstDoc
]
<>
nextDocs
splitDoc'
contextSize
(
CsvDoc
t
s
py
pm
pd
abst
auth
)
=
V
.
fromList
$
[
firstDoc
]
<>
nextDocs
where
where
firstDoc
=
CsvDoc
t
s
py
pm
pd
firstAbstract
auth
firstDoc
=
CsvDoc
t
s
py
pm
pd
firstAbstract
auth
firstAbstract
=
head'
abstracts
firstAbstract
=
head'
"splitDoc'1"
abstracts
nextDocs
=
map
(
\
txt
->
CsvDoc
(
head'
$
sentences
txt
)
s
py
pm
pd
(
unsentences
$
tail'
$
sentences
txt
)
auth
)
(
tail'
abstracts
)
nextDocs
=
map
(
\
txt
->
CsvDoc
(
head'
"splitDoc'2"
$
sentences
txt
)
s
py
pm
pd
(
unsentences
$
tail'
$
sentences
txt
)
auth
)
(
tail'
abstracts
)
abstracts
=
(
splitBy
$
contextSize
)
abst
abstracts
=
(
splitBy
$
contextSize
)
abst
head'
x
=
maybe
""
identity
(
head
x
)
tail'
x
=
maybe
[
""
]
identity
(
tailMay
x
)
tail'
x
=
maybe
[
""
]
identity
(
tailMay
x
)
---------------------------------------------------------------
---------------------------------------------------------------
...
...
src/Gargantext/Viz/Phylo.hs
View file @
80e7ae38
...
@@ -42,7 +42,6 @@ import GHC.Generics (Generic)
...
@@ -42,7 +42,6 @@ import GHC.Generics (Generic)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Prelude
import
Gargantext.Prelude
--------------------
--------------------
-- | PhyloParam | --
-- | PhyloParam | --
--------------------
--------------------
...
@@ -238,21 +237,21 @@ data PhyloError = LevelDoesNotExist
...
@@ -238,21 +237,21 @@ data PhyloError = LevelDoesNotExist
data
Cluster
=
Fis
FisParams
data
Cluster
=
Fis
FisParams
|
RelatedComponents
RCParams
|
RelatedComponents
RCParams
|
Louvain
LouvainParams
|
Louvain
LouvainParams
deriving
(
Show
,
Eq
)
deriving
(
Generic
,
Show
,
Eq
)
-- | Parameters for Fis clustering
-- | Parameters for Fis clustering
data
FisParams
=
FisParams
data
FisParams
=
FisParams
{
_fis_keepMinorFis
::
Bool
{
_fis_keepMinorFis
::
Bool
,
_fis_minSupport
::
Support
,
_fis_minSupport
::
Support
}
deriving
(
Show
,
Eq
)
}
deriving
(
Generic
,
Show
,
Eq
)
-- | Parameters for RelatedComponents clustering
-- | Parameters for RelatedComponents clustering
data
RCParams
=
RCParams
data
RCParams
=
RCParams
{
_rc_proximity
::
Proximity
}
deriving
(
Show
,
Eq
)
{
_rc_proximity
::
Proximity
}
deriving
(
Generic
,
Show
,
Eq
)
-- | Parameters for Louvain clustering
-- | Parameters for Louvain clustering
data
LouvainParams
=
LouvainParams
data
LouvainParams
=
LouvainParams
{
_louvain_proximity
::
Proximity
}
deriving
(
Show
,
Eq
)
{
_louvain_proximity
::
Proximity
}
deriving
(
Generic
,
Show
,
Eq
)
-------------------
-------------------
...
@@ -264,17 +263,17 @@ data LouvainParams = LouvainParams
...
@@ -264,17 +263,17 @@ data LouvainParams = LouvainParams
data
Proximity
=
WeightedLogJaccard
WLJParams
data
Proximity
=
WeightedLogJaccard
WLJParams
|
Hamming
HammingParams
|
Hamming
HammingParams
|
Filiation
|
Filiation
deriving
(
Show
,
Eq
)
deriving
(
Generic
,
Show
,
Eq
)
-- | Parameters for WeightedLogJaccard proximity
-- | Parameters for WeightedLogJaccard proximity
data
WLJParams
=
WLJParams
data
WLJParams
=
WLJParams
{
_wlj_threshold
::
Double
{
_wlj_threshold
::
Double
,
_wlj_sensibility
::
Double
,
_wlj_sensibility
::
Double
}
deriving
(
Show
,
Eq
)
}
deriving
(
Generic
,
Show
,
Eq
)
-- | Parameters for Hamming proximity
-- | Parameters for Hamming proximity
data
HammingParams
=
HammingParams
data
HammingParams
=
HammingParams
{
_hamming_threshold
::
Double
}
deriving
(
Show
,
Eq
)
{
_hamming_threshold
::
Double
}
deriving
(
Generic
,
Show
,
Eq
)
----------------
----------------
...
@@ -283,13 +282,13 @@ data HammingParams = HammingParams
...
@@ -283,13 +282,13 @@ data HammingParams = HammingParams
-- | Filter constructors
-- | Filter constructors
data
Filter
=
SmallBranch
SBParams
deriving
(
Show
,
Eq
)
data
Filter
=
SmallBranch
SBParams
deriving
(
Generic
,
Show
,
Eq
)
-- | Parameters for SmallBranch filter
-- | Parameters for SmallBranch filter
data
SBParams
=
SBParams
data
SBParams
=
SBParams
{
_sb_periodsInf
::
Int
{
_sb_periodsInf
::
Int
,
_sb_periodsSup
::
Int
,
_sb_periodsSup
::
Int
,
_sb_minNodes
::
Int
}
deriving
(
Show
,
Eq
)
,
_sb_minNodes
::
Int
}
deriving
(
Generic
,
Show
,
Eq
)
----------------
----------------
...
@@ -298,7 +297,7 @@ data SBParams = SBParams
...
@@ -298,7 +297,7 @@ data SBParams = SBParams
-- | Metric constructors
-- | Metric constructors
data
Metric
=
BranchAge
deriving
(
Show
,
Eq
)
data
Metric
=
BranchAge
deriving
(
Generic
,
Show
,
Eq
)
----------------
----------------
...
@@ -316,8 +315,8 @@ data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics deriving (Show)
...
@@ -316,8 +315,8 @@ data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics deriving (Show)
-- | Sort constructors
-- | Sort constructors
data
Sort
=
ByBranchAge
deriving
(
Show
)
data
Sort
=
ByBranchAge
deriving
(
Generic
,
Show
)
data
Order
=
Asc
|
Desc
deriving
(
Show
)
data
Order
=
Asc
|
Desc
deriving
(
Generic
,
Show
)
--------------------
--------------------
...
@@ -346,11 +345,11 @@ data PhyloQueryBuild = PhyloQueryBuild
...
@@ -346,11 +345,11 @@ data PhyloQueryBuild = PhyloQueryBuild
,
_q_nthLevel
::
Level
,
_q_nthLevel
::
Level
-- Clustering method used from level 1 to nthLevel
-- Clustering method used from level 1 to nthLevel
,
_q_nthCluster
::
Cluster
,
_q_nthCluster
::
Cluster
}
deriving
(
Show
,
Eq
)
}
deriving
(
Generic
,
Show
,
Eq
)
-- | To choose the Phylo edge you want to export : --> <-- <--> <=>
-- | To choose the Phylo edge you want to export : --> <-- <--> <=>
data
Filiation
=
Ascendant
|
Descendant
|
Merge
|
Complete
deriving
(
Show
)
data
Filiation
=
Ascendant
|
Descendant
|
Merge
|
Complete
deriving
(
Generic
,
Show
)
data
EdgeType
=
PeriodEdge
|
LevelEdge
deriving
(
Show
)
data
EdgeType
=
PeriodEdge
|
LevelEdge
deriving
(
Generic
,
Show
)
-------------------
-------------------
-- | PhyloView | --
-- | PhyloView | --
...
@@ -367,21 +366,21 @@ data PhyloView = PhyloView
...
@@ -367,21 +366,21 @@ data PhyloView = PhyloView
,
_pv_branches
::
[
PhyloBranch
]
,
_pv_branches
::
[
PhyloBranch
]
,
_pv_nodes
::
[
PhyloNode
]
,
_pv_nodes
::
[
PhyloNode
]
,
_pv_edges
::
[
PhyloEdge
]
,
_pv_edges
::
[
PhyloEdge
]
}
deriving
(
Show
)
}
deriving
(
Generic
,
Show
)
-- | A phyloview is made of PhyloBranches, edges and nodes
-- | A phyloview is made of PhyloBranches, edges and nodes
data
PhyloBranch
=
PhyloBranch
data
PhyloBranch
=
PhyloBranch
{
_pb_id
::
PhyloBranchId
{
_pb_id
::
PhyloBranchId
,
_pb_label
::
Text
,
_pb_label
::
Text
,
_pb_metrics
::
Map
Text
[
Double
]
,
_pb_metrics
::
Map
Text
[
Double
]
}
deriving
(
Show
)
}
deriving
(
Generic
,
Show
)
data
PhyloEdge
=
PhyloEdge
data
PhyloEdge
=
PhyloEdge
{
_pe_source
::
PhyloGroupId
{
_pe_source
::
PhyloGroupId
,
_pe_target
::
PhyloGroupId
,
_pe_target
::
PhyloGroupId
,
_pe_type
::
EdgeType
,
_pe_type
::
EdgeType
,
_pe_weight
::
Weight
,
_pe_weight
::
Weight
}
deriving
(
Show
)
}
deriving
(
Generic
,
Show
)
data
PhyloNode
=
PhyloNode
data
PhyloNode
=
PhyloNode
{
_pn_id
::
PhyloGroupId
{
_pn_id
::
PhyloGroupId
...
@@ -392,7 +391,7 @@ data PhyloNode = PhyloNode
...
@@ -392,7 +391,7 @@ data PhyloNode = PhyloNode
,
_pn_metrics
::
Map
Text
[
Double
]
,
_pn_metrics
::
Map
Text
[
Double
]
,
_pn_parents
::
Maybe
[
PhyloGroupId
]
,
_pn_parents
::
Maybe
[
PhyloGroupId
]
,
_pn_childs
::
[
PhyloNode
]
,
_pn_childs
::
[
PhyloNode
]
}
deriving
(
Show
)
}
deriving
(
Generic
,
Show
)
------------------------
------------------------
...
...
src/Gargantext/Viz/Phylo/API.hs
View file @
80e7ae38
...
@@ -9,20 +9,30 @@ Portability : POSIX
...
@@ -9,20 +9,30 @@ Portability : POSIX
-}
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
-- allows to write Text literals
{-# LANGUAGE OverloadedLists #-}
-- allows to write Map and HashMap as lists
module
Gargantext.Viz.Phylo.API
module
Gargantext.Viz.Phylo.API
where
where
--{-
import
Data.Swagger
import
Servant.Job.Utils
(
swaggerOptions
)
import
Gargantext.Database.Types.Node
(
PhyloId
,
ListId
,
CorpusId
)
import
Gargantext.Database.Types.Node
(
PhyloId
,
ListId
,
CorpusId
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Viz.Phylo
import
Gargantext.Viz.Phylo
import
Gargantext.Viz.Phylo.Example
import
Gargantext.Viz.Phylo.Example
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
getPhylo
::
PhyloId
->
Maybe
PhyloQueryView
->
PhyloView
getPhylo
_phyloId
_phyloQueryView
=
phyloView
getPhylo
::
PhyloId
->
PhyloView
getPhylo
_phyloId
=
phyloView
--getPhylo :: PhyloId -> Maybe PhyloQueryView -> PhyloView
--getPhylo _phyloId _phyloQueryView = phyloView
postPhylo
::
CorpusId
->
Maybe
ListId
->
PhyloQueryBuild
->
Phylo
postPhylo
::
CorpusId
->
Maybe
ListId
->
PhyloQueryBuild
->
Phylo
postPhylo
=
undefined
postPhylo
=
undefined
...
@@ -33,4 +43,34 @@ putPhylo = undefined
...
@@ -33,4 +43,34 @@ putPhylo = undefined
deletePhylo
::
PhyloId
->
IO
()
deletePhylo
::
PhyloId
->
IO
()
deletePhylo
=
undefined
deletePhylo
=
undefined
--}
-- | Instances
instance
ToSchema
Cluster
instance
ToSchema
EdgeType
instance
ToSchema
Filiation
instance
ToSchema
Filter
instance
ToSchema
FisParams
instance
ToSchema
HammingParams
instance
ToSchema
LouvainParams
instance
ToSchema
Metric
instance
ToSchema
PhyloBranch
instance
ToSchema
PhyloEdge
instance
ToSchema
PhyloNode
instance
ToSchema
PhyloParam
instance
ToSchema
PhyloQueryBuild
instance
ToSchema
PhyloView
instance
ToSchema
RCParams
instance
ToSchema
SBParams
instance
ToSchema
Software
instance
ToSchema
WLJParams
instance
ToSchema
Proximity
where
declareNamedSchema
=
genericDeclareNamedSchemaUnrestricted
$
swaggerOptions
""
instance
Arbitrary
PhyloView
where
arbitrary
=
elements
[
phyloView
]
src/Gargantext/Viz/Phylo/Aggregates/Cooc.hs
View file @
80e7ae38
...
@@ -19,7 +19,6 @@ module Gargantext.Viz.Phylo.Aggregates.Cooc
...
@@ -19,7 +19,6 @@ module Gargantext.Viz.Phylo.Aggregates.Cooc
import
Data.List
(
union
,
concat
)
import
Data.List
(
union
,
concat
)
import
Data.Map
(
Map
,
elems
,
adjust
)
import
Data.Map
(
Map
,
elems
,
adjust
)
import
Data.Maybe
(
maybe
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Viz.Phylo
import
Gargantext.Viz.Phylo
import
Gargantext.Viz.Phylo.Tools
import
Gargantext.Viz.Phylo.Tools
...
@@ -27,7 +26,6 @@ import qualified Data.Map as Map
...
@@ -27,7 +26,6 @@ import qualified Data.Map as Map
import
qualified
Data.Set
as
Set
import
qualified
Data.Set
as
Set
-- | To transform the Fis into a coocurency Matrix in a Phylo
-- | To transform the Fis into a coocurency Matrix in a Phylo
fisToCooc
::
Map
(
Date
,
Date
)
[
PhyloFis
]
->
Phylo
->
Map
(
Int
,
Int
)
Double
fisToCooc
::
Map
(
Date
,
Date
)
[
PhyloFis
]
->
Phylo
->
Map
(
Int
,
Int
)
Double
fisToCooc
m
p
=
map
(
/
docs
)
fisToCooc
m
p
=
map
(
/
docs
)
...
...
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