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
148
Issues
148
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
1167c256
Commit
1167c256
authored
Oct 25, 2019
by
qlobbe
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
new logs
parent
881d5bab
Pipeline
#599
canceled with stage
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
40 additions
and
25 deletions
+40
-25
Main.hs
bin/gargantext-adaptative-phylo/Main.hs
+1
-3
PhyloExport.hs
src/Gargantext/Viz/Phylo/PhyloExport.hs
+16
-4
PhyloMaker.hs
src/Gargantext/Viz/Phylo/PhyloMaker.hs
+7
-5
TemporalMatching.hs
src/Gargantext/Viz/Phylo/TemporalMatching.hs
+16
-13
No files found.
bin/gargantext-adaptative-phylo/Main.hs
View file @
1167c256
...
...
@@ -167,9 +167,7 @@ main = do
printIOMsg
"End of reconstruction, start the export"
let
dot
=
toPhyloExport
phylo
printIOMsg
"##########################"
let
dot
=
toPhyloExport
phylo
let
output
=
(
outputPath
config
)
<>
(
unpack
$
phyloName
config
)
...
...
src/Gargantext/Viz/Phylo/PhyloExport.hs
View file @
1167c256
...
...
@@ -36,6 +36,7 @@ import System.FilePath
import
Debug.Trace
(
trace
)
import
qualified
Data.Text
as
Text
import
qualified
Data.Vector
as
Vector
import
qualified
Data.Text.Lazy
as
Lazy
import
qualified
Data.GraphViz.Attributes.HTML
as
H
...
...
@@ -159,7 +160,8 @@ exportToDot :: Phylo -> PhyloExport -> DotGraph DotId
exportToDot
phylo
export
=
trace
(
"
\n
-- | Convert "
<>
show
(
length
$
export
^.
export_branches
)
<>
" branches and "
<>
show
(
length
$
export
^.
export_groups
)
<>
" groups "
<>
show
(
length
$
nub
$
concat
$
map
(
\
g
->
g
^.
phylo_groupNgrams
)
$
export
^.
export_groups
)
<>
" terms to a dot file
\n
"
)
$
<>
show
(
length
$
nub
$
concat
$
map
(
\
g
->
g
^.
phylo_groupNgrams
)
$
export
^.
export_groups
)
<>
" terms to a dot file
\n\n
"
<>
"##########################"
)
$
digraph
((
Str
.
fromStrict
)
$
(
phyloName
$
getConfig
phylo
))
$
do
-- | 1) init the dot graph
...
...
@@ -463,20 +465,30 @@ toPhyloExport phylo = exportToDot phylo
export
=
PhyloExport
groups
branches
--------------------------------------
branches
::
[
PhyloBranch
]
branches
=
traceExportBranches
$
map
(
\
bId
->
PhyloBranch
bId
""
empty
)
$
nub
$
map
_phylo_groupBranchId
groups
branches
=
map
(
\
bId
->
PhyloBranch
bId
""
empty
)
$
nub
$
map
_phylo_groupBranchId
groups
--------------------------------------
groups
::
[
PhyloGroup
]
groups
=
traceExportGroups
$
processDynamics
$
getGroupsFromLevel
(
phyloLevel
$
getConfig
phylo
)
phylo
$
getGroupsFromLevel
(
phyloLevel
$
getConfig
phylo
)
$
tracePhyloInfo
phylo
traceExportBranches
::
[
PhyloBranch
]
->
[
PhyloBranch
]
traceExportBranches
branches
=
trace
(
"
\n
"
<>
"-- | Export "
<>
show
(
length
branches
)
<>
" branches"
)
branches
tracePhyloInfo
::
Phylo
->
Phylo
tracePhyloInfo
phylo
=
trace
(
"
\n
"
<>
"##########################"
<>
"
\n\n
"
<>
"-- | Phylo with β = "
<>
show
(
_qua_granularity
$
phyloQuality
$
getConfig
phylo
)
<>
" applied to "
<>
show
(
length
$
Vector
.
toList
$
getRoots
phylo
)
<>
" foundations"
)
phylo
traceExportGroups
::
[
PhyloGroup
]
->
[
PhyloGroup
]
traceExportGroups
groups
=
trace
(
"
\n
"
<>
"##########################"
<>
"
\n\n
"
<>
"-- | Export "
<>
show
(
length
groups
)
<>
" groups and "
traceExportGroups
groups
=
trace
(
"
\n
"
<>
"-- | Export "
<>
show
(
length
$
nub
$
map
(
\
g
->
g
^.
phylo_groupBranchId
)
groups
)
<>
" branches, "
<>
show
(
length
groups
)
<>
" groups and "
<>
show
(
length
$
nub
$
concat
$
map
(
\
g
->
g
^.
phylo_groupNgrams
)
groups
)
<>
" terms"
)
groups
src/Gargantext/Viz/Phylo/PhyloMaker.hs
View file @
1167c256
...
...
@@ -149,13 +149,15 @@ filterFisByNested m =
-- | To transform a time map of docs innto a time map of Fis with some filters
toPhyloFis
::
Map
(
Date
,
Date
)
[
Document
]
->
Int
->
Int
->
Map
(
Date
,
Date
)
[
PhyloCUnit
]
toPhyloFis
phyloDocs
support
clique
=
traceFis
"Filtered Fis"
$
filterFisByNested
$
traceFis
"Filtered by clique size"
toPhyloFis
phyloDocs
support
clique
=
-- traceFis "Filtered Fis"
filterFisByNested
-- $ traceFis "Filtered by clique size"
$
filterFis
True
clique
(
filterFisByClique
)
$
traceFis
"Filtered by support"
--
$ traceFis "Filtered by support"
$
filterFis
True
support
(
filterFisBySupport
)
$
traceFis
"Unfiltered Fis"
phyloFis
-- $ traceFis "Unfiltered Fis"
phyloFis
where
--------------------------------------
phyloFis
::
Map
(
Date
,
Date
)
[
PhyloCUnit
]
...
...
src/Gargantext/Viz/Phylo/TemporalMatching.hs
View file @
1167c256
...
...
@@ -25,7 +25,7 @@ import Gargantext.Viz.Phylo.PhyloTools
-- import Prelude (logBase)
import
Control.Lens
hiding
(
Level
)
import
Control.Parallel.Strategies
(
parList
,
rdeepseq
,
using
)
import
Debug.Trace
(
trace
)
--
import Debug.Trace (trace)
import
qualified
Data.Set
as
Set
...
...
@@ -209,8 +209,9 @@ getCandidates fil ego targets =
phyloBranchMatching
::
Int
->
[
PhyloPeriodId
]
->
Proximity
->
Double
->
Map
Date
Double
->
[
PhyloGroup
]
->
[
PhyloGroup
]
phyloBranchMatching
frame
periods
proximity
thr
docs
branch
=
traceBranchMatching
proximity
thr
$
matchByPeriods
phyloBranchMatching
frame
periods
proximity
thr
docs
branch
=
-- traceBranchMatching proximity thr
matchByPeriods
$
groupByField
_phylo_groupPeriod
branch
where
--------------------------------------
...
...
@@ -298,16 +299,18 @@ seqMatching proximity beta frequency minBranch egoThr frame docs periods done eg
-- | 1) keep or not the new division of ego
let
done'
=
done
++
(
if
snd
ego
then
(
if
((
null
(
fst
ego'
))
||
(
quality
>
quality'
))
then
trace
(
" ✗ F(β) = "
<>
show
(
quality
)
<>
" (vs) "
<>
show
(
quality'
)
<>
" | "
<>
show
(
length
$
fst
ego
)
<>
" groups : "
<>
" |✓ "
<>
show
(
length
$
fst
ego'
)
<>
show
(
map
length
$
fst
ego'
)
<>
" |✗ "
<>
show
(
length
$
snd
ego'
)
<>
"["
<>
show
(
length
$
concat
$
snd
ego'
)
<>
"]"
)
$
[(
fst
ego
,
False
)]
else
trace
(
" ✓ F(β) = "
<>
show
(
quality
)
<>
" (vs) "
<>
show
(
quality'
)
<>
" | "
<>
show
(
length
$
fst
ego
)
<>
" groups : "
<>
" |✓ "
<>
show
(
length
$
fst
ego'
)
<>
show
(
map
length
$
fst
ego'
)
<>
" |✗ "
<>
show
(
length
$
snd
ego'
)
<>
"["
<>
show
(
length
$
concat
$
snd
ego'
)
<>
"]"
)
$
((
map
(
\
e
->
(
e
,
True
))
(
fst
ego'
))
++
(
map
(
\
e
->
(
e
,
False
))
(
snd
ego'
))))
then
-- trace (" ✗ F(β) = " <> show(quality) <> " (vs) " <> show(quality')
-- <> " | " <> show(length $ fst ego) <> " groups : "
-- <> " |✓ " <> show(length $ fst ego') <> show(map length $ fst ego')
-- <> " |✗ " <> show(length $ snd ego') <> "[" <> show(length $ concat $ snd ego') <> "]")
[(
fst
ego
,
False
)]
else
-- trace (" ✓ F(β) = " <> show(quality) <> " (vs) " <> show(quality')
-- <> " | " <> show(length $ fst ego) <> " groups : "
-- <> " |✓ " <> show(length $ fst ego') <> show(map length $ fst ego')
-- <> " |✗ " <> show(length $ snd ego') <> "[" <> show(length $ concat $ snd ego') <> "]")
((
map
(
\
e
->
(
e
,
True
))
(
fst
ego'
))
++
(
map
(
\
e
->
(
e
,
False
))
(
snd
ego'
))))
else
[
ego
])
in
-- | 2) if there is no more branches in rest then return else continue
...
...
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