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
6
Merge Requests
6
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
e4d30996
Commit
e4d30996
authored
Apr 16, 2019
by
Quentin Lobbé
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
fix
parent
7ff3a503
Pipeline
#355
canceled with stage
Changes
5
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
21 additions
and
34 deletions
+21
-34
Main.hs
bin/gargantext-phylo/Main.hs
+6
-6
Phylo.hs
src/Gargantext/Viz/Phylo.hs
+3
-7
API.hs
src/Gargantext/Viz/Phylo/API.hs
+10
-3
Tools.hs
src/Gargantext/Viz/Phylo/Tools.hs
+2
-5
ViewMaker.hs
src/Gargantext/Viz/Phylo/View/ViewMaker.hs
+0
-13
No files found.
bin/gargantext-phylo/Main.hs
View file @
e4d30996
...
@@ -89,7 +89,7 @@ main = do
...
@@ -89,7 +89,7 @@ main = do
let
patterns
=
buildPatterns
termList
let
patterns
=
buildPatterns
termList
let
corpusParsed
=
map
(
(
\
(
y
,
t
)
->
Document
y
(
filter
(
\
e
->
e
/=
""
)
t
)
)
.
filterTerms
patterns
)
corpus
let
corpusParsed
=
map
(
(
\
(
y
,
t
)
->
Document
y
t
)
.
filterTerms
patterns
)
corpus
let
query
=
PhyloQueryBuild
"cultural_evolution"
"Test"
5
3
defaultFis
[]
[]
defaultWeightedLogJaccard
3
defaultRelatedComponents
let
query
=
PhyloQueryBuild
"cultural_evolution"
"Test"
5
3
defaultFis
[]
[]
defaultWeightedLogJaccard
3
defaultRelatedComponents
...
@@ -97,15 +97,15 @@ main = do
...
@@ -97,15 +97,15 @@ main = do
let
foundations
=
DL
.
nub
$
DL
.
concat
$
map
_pat_terms
patterns
let
foundations
=
DL
.
nub
$
DL
.
concat
$
map
_pat_terms
patterns
let
phylo
=
toPhylo
query
corpusParsed
foundations
tree
--
let phylo = toPhylo query corpusParsed foundations tree
let
queryView
=
PhyloQueryView
2
Merge
False
1
[
BranchAge
]
[
defaultSmallBranch
]
[
BranchPeakFreq
,
GroupLabelCooc
]
(
Just
(
ByBranchAge
,
Asc
))
Json
Flat
True
--
let queryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchPeakFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True
let
view
=
toPhyloView
queryView
phylo
--
let view = toPhyloView queryView phylo
-- TODO Phylo here
-- TODO Phylo here
P
.
writeFile
outputPath
$
dotToString
$
viewToDot
view
--
P.writeFile outputPath $ dotToString $ viewToDot view
--
L.writeFile outputPath $ encode corpusParsed
L
.
writeFile
outputPath
$
encode
corpusParsed
src/Gargantext/Viz/Phylo.hs
View file @
e4d30996
...
@@ -307,12 +307,7 @@ data Metric = BranchAge deriving (Generic, Show, Eq, Read)
...
@@ -307,12 +307,7 @@ data Metric = BranchAge deriving (Generic, Show, Eq, Read)
-- | Tagger constructors
-- | Tagger constructors
<<<<<<<
HEAD
data
Tagger
=
BranchPeakFreq
|
GroupLabelCooc
|
GroupDynamics
deriving
(
Show
,
Generic
,
Read
)
data
Tagger
=
BranchPeakFreq
|
GroupLabelCooc
|
GroupDynamics
deriving
(
Show
)
=======
data
Tagger
=
BranchLabelFreq
|
GroupLabelCooc
|
GroupDynamics
deriving
(
Generic
,
Show
,
Read
)
>>>>>>>
dev
--------------
--------------
...
@@ -354,7 +349,7 @@ data PhyloQueryBuild = PhyloQueryBuild
...
@@ -354,7 +349,7 @@ data PhyloQueryBuild = PhyloQueryBuild
}
deriving
(
Generic
,
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
(
Generic
,
Show
)
data
Filiation
=
Ascendant
|
Descendant
|
Merge
|
Complete
deriving
(
Generic
,
Show
,
Read
)
data
EdgeType
=
PeriodEdge
|
LevelEdge
deriving
(
Generic
,
Show
,
Eq
)
data
EdgeType
=
PeriodEdge
|
LevelEdge
deriving
(
Generic
,
Show
,
Eq
)
-------------------
-------------------
...
@@ -407,6 +402,7 @@ data PhyloNode = PhyloNode
...
@@ -407,6 +402,7 @@ data PhyloNode = PhyloNode
data
ExportMode
=
Json
|
Dot
|
Svg
data
ExportMode
=
Json
|
Dot
|
Svg
deriving
(
Generic
,
Show
,
Read
)
data
DisplayMode
=
Flat
|
Nested
data
DisplayMode
=
Flat
|
Nested
deriving
(
Generic
,
Show
,
Read
)
deriving
(
Generic
,
Show
,
Read
)
...
...
src/Gargantext/Viz/Phylo/API.hs
View file @
e4d30996
...
@@ -66,6 +66,7 @@ type GetPhylo = QueryParam "listId" ListId
...
@@ -66,6 +66,7 @@ type GetPhylo = QueryParam "listId" ListId
:>
QueryParam
"taggers"
[
Tagger
]
:>
QueryParam
"taggers"
[
Tagger
]
:>
QueryParam
"sort"
Sort
:>
QueryParam
"sort"
Sort
:>
QueryParam
"order"
Order
:>
QueryParam
"order"
Order
:>
QueryParam
"export"
ExportMode
:>
QueryParam
"display"
DisplayMode
:>
QueryParam
"display"
DisplayMode
:>
QueryParam
"verbose"
Bool
:>
QueryParam
"verbose"
Bool
:>
Get
'[
J
SON
]
PhyloView
:>
Get
'[
J
SON
]
PhyloView
...
@@ -74,11 +75,11 @@ type GetPhylo = QueryParam "listId" ListId
...
@@ -74,11 +75,11 @@ type GetPhylo = QueryParam "listId" ListId
-- Add real text processing
-- Add real text processing
-- Fix Filter parameters
-- Fix Filter parameters
getPhylo
::
PhyloId
->
GargServer
GetPhylo
getPhylo
::
PhyloId
->
GargServer
GetPhylo
getPhylo
_phyloId
_lId
l
f
b
l'
ms
x
y
z
ts
s
o
d
b'
=
do
getPhylo
_phyloId
_lId
l
f
b
l'
ms
x
y
z
ts
s
o
e
d
b'
=
do
let
let
fs'
=
maybe
(
Just
[]
)
(
\
p
->
Just
[
p
])
$
SmallBranch
<$>
(
SBParams
<$>
x
<*>
y
<*>
z
)
fs'
=
maybe
(
Just
[]
)
(
\
p
->
Just
[
p
])
$
SmallBranch
<$>
(
SBParams
<$>
x
<*>
y
<*>
z
)
so
=
(,)
<$>
s
<*>
o
so
=
(,)
<$>
s
<*>
o
q
=
initPhyloQueryView
l
f
b
l'
ms
fs'
ts
so
d
b'
q
=
initPhyloQueryView
l
f
b
l'
ms
fs'
ts
so
e
d
b'
-- | TODO remove phylo for real data here
-- | TODO remove phylo for real data here
pure
(
toPhyloView
q
phylo
)
pure
(
toPhyloView
q
phylo
)
...
@@ -143,7 +144,7 @@ instance ToSchema PhyloGroup
...
@@ -143,7 +144,7 @@ instance ToSchema PhyloGroup
instance
ToSchema
PhyloLevel
instance
ToSchema
PhyloLevel
instance
ToSchema
PhyloNode
instance
ToSchema
PhyloNode
instance
ToSchema
PhyloParam
instance
ToSchema
PhyloParam
instance
ToSchema
Phylo
Peak
s
instance
ToSchema
Phylo
Root
s
instance
ToSchema
PhyloPeriod
instance
ToSchema
PhyloPeriod
instance
ToSchema
PhyloQueryBuild
instance
ToSchema
PhyloQueryBuild
instance
ToSchema
PhyloView
instance
ToSchema
PhyloView
...
@@ -174,6 +175,12 @@ instance FromHttpApiData DisplayMode
...
@@ -174,6 +175,12 @@ instance FromHttpApiData DisplayMode
parseUrlPiece
=
readTextData
parseUrlPiece
=
readTextData
instance
ToParamSchema
ExportMode
instance
FromHttpApiData
ExportMode
where
parseUrlPiece
=
readTextData
instance
FromHttpApiData
Sort
instance
FromHttpApiData
Sort
where
where
parseUrlPiece
=
readTextData
parseUrlPiece
=
readTextData
...
...
src/Gargantext/Viz/Phylo/Tools.hs
View file @
e4d30996
...
@@ -713,11 +713,8 @@ initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
...
@@ -713,11 +713,8 @@ initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
-- | To initialize a PhyloQueryBuild from given and default parameters
-- | To initialize a PhyloQueryBuild from given and default parameters
initPhyloQueryBuild
::
Text
->
Text
->
Maybe
Int
->
Maybe
Int
->
Maybe
Cluster
->
Maybe
[
Metric
]
->
Maybe
[
Filter
]
->
Maybe
Proximity
->
Maybe
Level
->
Maybe
Cluster
->
PhyloQueryBuild
initPhyloQueryBuild
::
Text
->
Text
->
Maybe
Int
->
Maybe
Int
->
Maybe
Cluster
->
Maybe
[
Metric
]
->
Maybe
[
Filter
]
->
Maybe
Proximity
->
Maybe
Level
->
Maybe
Cluster
->
PhyloQueryBuild
initPhyloQueryBuild
name
desc
(
def
5
->
grain
)
(
def
3
->
steps
)
(
def
defaultFis
->
cluster
)
(
def
[]
->
metrics
)
(
def
[]
->
filters
)
initPhyloQueryBuild
name
desc
(
def
5
->
grain
)
(
def
3
->
steps
)
(
def
defaultFis
->
cluster
)
(
def
[]
->
metrics
)
(
def
[]
->
filters
)
(
def
defaultWeightedLogJaccard
->
matching'
)
(
def
2
->
nthLevel
)
(
def
defaultRelatedComponents
->
nthCluster
)
=
(
def
defaultWeightedLogJaccard
->
matching
)
(
def
2
->
nthLevel
)
(
def
defaultRelatedComponents
->
nthCluster
)
=
PhyloQueryBuild
name'
desc'
grain
steps
cluster
metrics
filters
matching'
nthLevel
nthCluster
PhyloQueryBuild
name
desc
grain
steps
cluster
metrics
filters
matching
nthLevel
nthCluster
where
name'
=
maybe
"Phylo Title"
identity
name
desc'
=
maybe
"Phylo Desc"
identity
desc
...
...
src/Gargantext/Viz/Phylo/View/ViewMaker.hs
View file @
e4d30996
...
@@ -138,19 +138,6 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
...
@@ -138,19 +138,6 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
-- | To transform a PhyloQuery into a PhyloView
-- | To transform a PhyloQuery into a PhyloView
toPhyloView'
::
Maybe
Level
->
Maybe
Filiation
->
Maybe
Bool
->
Maybe
Level
->
Maybe
[
Metric
]
->
Maybe
[
Filter
]
->
Maybe
[
Tagger
]
->
Maybe
(
Sort
,
Order
)
->
Maybe
DisplayMode
->
Maybe
Bool
->
PhyloQueryView
toPhyloView'
=
initPhyloQueryView
toPhyloView
::
PhyloQueryView
->
Phylo
->
PhyloView
toPhyloView
::
PhyloQueryView
->
Phylo
->
PhyloView
toPhyloView
q
p
=
processDisplay
(
q
^.
qv_display
)
(
q
^.
qv_export
)
toPhyloView
q
p
=
processDisplay
(
q
^.
qv_display
)
(
q
^.
qv_export
)
$
processSort
(
q
^.
qv_sort
)
p
$
processSort
(
q
^.
qv_sort
)
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