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
160
Issues
160
List
Board
Labels
Milestones
Merge Requests
14
Merge Requests
14
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
80a0e2ef
Commit
80a0e2ef
authored
Jan 30, 2024
by
Alfredo Di Napoli
Committed by
Alfredo Di Napoli
Feb 22, 2024
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Silence phylo logs in bench
parent
7937819c
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
26 additions
and
17 deletions
+26
-17
PhyloExport.hs
src/Gargantext/Core/Viz/Phylo/PhyloExport.hs
+4
-4
PhyloTools.hs
src/Gargantext/Core/Viz/Phylo/PhyloTools.hs
+21
-12
TemporalMatching.hs
src/Gargantext/Core/Viz/Phylo/TemporalMatching.hs
+1
-1
No files found.
src/Gargantext/Core/Viz/Phylo/PhyloExport.hs
View file @
80a0e2ef
...
...
@@ -702,17 +702,17 @@ toPhyloExport phylo = exportToDot phylo
traceExportBranches
::
[
PhyloBranch
]
->
[
PhyloBranch
]
traceExportBranches
branches
=
trace
(
"
\n
"
trace
Phylo
(
"
\n
"
<>
"-- | Export "
<>
show
(
length
branches
)
<>
" branches"
::
Text
)
branches
tracePhyloAncestors
::
[[
PhyloGroup
]]
->
[[
PhyloGroup
]]
tracePhyloAncestors
groups
=
trace
(
"-- | Found "
<>
show
(
length
$
concat
$
map
_phylo_groupAncestors
$
concat
groups
)
trace
Phylo
(
"-- | Found "
<>
show
(
length
$
concat
$
map
_phylo_groupAncestors
$
concat
groups
)
<>
" ancestors"
::
Text
)
groups
tracePhyloInfo
::
Phylo
->
Phylo
tracePhyloInfo
phylo
=
trace
(
"
\n
"
<>
"##########################"
<>
"
\n\n
"
<>
"-- | Phylo with level = "
trace
Phylo
(
"
\n
"
<>
"##########################"
<>
"
\n\n
"
<>
"-- | Phylo with level = "
<>
show
(
getLevel
phylo
)
<>
" applied to "
<>
show
(
length
$
Vector
.
toList
$
getRoots
phylo
)
<>
" foundations"
::
Text
)
phylo
...
...
@@ -720,7 +720,7 @@ tracePhyloInfo phylo =
traceExportGroups
::
[
PhyloGroup
]
->
[
PhyloGroup
]
traceExportGroups
groups
=
trace
(
"
\n
"
<>
"-- | Export "
trace
Phylo
(
"
\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"
::
Text
...
...
src/Gargantext/Core/Viz/Phylo/PhyloTools.hs
View file @
80a0e2ef
...
...
@@ -10,7 +10,8 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
module
Gargantext.Core.Viz.Phylo.PhyloTools
where
...
...
@@ -232,6 +233,14 @@ keepFilled f thr l = if (null $ f thr l) && (not $ null l)
then
keepFilled
f
(
thr
-
1
)
l
else
f
thr
l
-- | General workhorse to use in lieu of /trace/. It decides at compile
-- time whether or not debug logs are enabled.
tracePhylo
::
(
Print
s
,
IsString
s
)
=>
s
->
a
->
a
#
if
NO_PHYLO_DEBUG_LOGS
tracePhylo
_
p
=
p
#
else
tracePhylo
msg
p
=
trace
msg
p
#
endif
traceClique
::
Map
(
Date
,
Date
)
[
Clustering
]
->
String
traceClique
mFis
=
foldl
(
\
msg
cpt
->
msg
<>
show
(
countSup
cpt
cliques
)
<>
" (>"
<>
show
(
cpt
)
<>
") "
)
""
[
1
..
6
]
...
...
@@ -252,7 +261,7 @@ traceSupport mFis = foldl (\msg cpt -> msg <> show (countSup cpt supports) <> "
traceFis
::
[
Char
]
->
Map
(
Date
,
Date
)
[
Clustering
]
->
Map
(
Date
,
Date
)
[
Clustering
]
traceFis
msg
mFis
=
trace
(
"
\n
"
<>
"-- | "
<>
msg
<>
" : "
<>
show
(
sum
$
map
length
$
elems
mFis
)
<>
"
\n
"
traceFis
msg
mFis
=
trace
Phylo
(
"
\n
"
<>
"-- | "
<>
msg
<>
" : "
<>
show
(
sum
$
map
length
$
elems
mFis
)
<>
"
\n
"
<>
"Support : "
<>
traceSupport
mFis
<>
"
\n
"
<>
"Nb Ngrams : "
<>
traceClique
mFis
<>
"
\n
"
)
mFis
...
...
@@ -636,7 +645,7 @@ updateLevel level phylo = phylo { _phylo_level = level }
traceToPhylo
::
Scale
->
Phylo
->
Phylo
traceToPhylo
lvl
phylo
=
trace
(
"
\n
"
<>
"-- | End of phylo making at scale "
<>
show
(
lvl
)
<>
" with "
trace
Phylo
(
"
\n
"
<>
"-- | End of phylo making at scale "
<>
show
(
lvl
)
<>
" with "
<>
show
(
length
$
getGroupsFromScale
lvl
phylo
)
<>
" groups and "
<>
show
(
length
$
nub
$
map
_phylo_groupBranchId
$
getGroupsFromScale
lvl
phylo
)
<>
" branches"
<>
"
\n
"
::
Text
...
...
@@ -702,7 +711,7 @@ toRelatedComponents nodes edges =
traceSynchronyEnd
::
Phylo
->
Phylo
traceSynchronyEnd
phylo
=
trace
(
"-- | End synchronic clustering at scale "
<>
show
(
getLastLevel
phylo
)
trace
Phylo
(
"-- | End synchronic clustering at scale "
<>
show
(
getLastLevel
phylo
)
<>
" with "
<>
show
(
length
$
getGroupsFromScale
(
getLastLevel
phylo
)
phylo
)
<>
" groups"
<>
" and "
<>
show
(
length
$
nub
$
map
_phylo_groupBranchId
$
getGroupsFromScale
(
getLastLevel
phylo
)
phylo
)
<>
" branches"
<>
"
\n
"
::
Text
...
...
@@ -710,7 +719,7 @@ traceSynchronyEnd phylo =
traceSynchronyStart
::
Phylo
->
Phylo
traceSynchronyStart
phylo
=
trace
(
"
\n
"
<>
"-- | Start synchronic clustering at scale "
<>
show
(
getLastLevel
phylo
)
trace
Phylo
(
"
\n
"
<>
"-- | Start synchronic clustering at scale "
<>
show
(
getLastLevel
phylo
)
<>
" with "
<>
show
(
length
$
getGroupsFromScale
(
getLastLevel
phylo
)
phylo
)
<>
" groups"
<>
" and "
<>
show
(
length
$
nub
$
map
_phylo_groupBranchId
$
getGroupsFromScale
(
getLastLevel
phylo
)
phylo
)
<>
" branches"
<>
"
\n
"
::
Text
...
...
@@ -754,7 +763,7 @@ ngramsInBranches branches = nub $ foldl (\acc g -> acc ++ (g ^. phylo_groupNgram
traceMatchSuccess
::
Double
->
Double
->
Double
->
[[[
PhyloGroup
]]]
->
[[[
PhyloGroup
]]]
traceMatchSuccess
thr
qua
qua'
nextBranches
=
trace
(
"
\n
"
<>
"-- local branches : "
trace
Phylo
(
"
\n
"
<>
"-- local branches : "
<>
(
Text
.
pack
$
init
$
show
((
init
.
init
.
snd
)
$
(
head'
"trace"
$
head'
"trace"
$
head'
"trace"
nextBranches
)
^.
phylo_groupBranchId
))
<>
",(1.."
<>
show
(
length
nextBranches
)
<>
")]"
...
...
@@ -767,7 +776,7 @@ traceMatchSuccess thr qua qua' nextBranches =
traceMatchFailure
::
Double
->
Double
->
Double
->
[[
PhyloGroup
]]
->
[[
PhyloGroup
]]
traceMatchFailure
thr
qua
qua'
branches
=
trace
(
"
\n
"
<>
"-- local branches : "
trace
Phylo
(
"
\n
"
<>
"-- local branches : "
<>
(
Text
.
pack
$
init
$
show
((
init
.
snd
)
$
(
head'
"trace"
$
head'
"trace"
branches
)
^.
phylo_groupBranchId
))
<>
",(1.."
<>
show
(
length
branches
)
<>
")]"
<>
" | "
<>
show
(
length
$
concat
branches
)
<>
" groups"
<>
"
\n
"
...
...
@@ -778,7 +787,7 @@ traceMatchFailure thr qua qua' branches =
traceMatchNoSplit
::
[[
PhyloGroup
]]
->
[[
PhyloGroup
]]
traceMatchNoSplit
branches
=
trace
(
"
\n
"
<>
"-- local branches : "
trace
Phylo
(
"
\n
"
<>
"-- local branches : "
<>
(
Text
.
pack
$
init
$
show
((
init
.
snd
)
$
(
head'
"trace"
$
head'
"trace"
branches
)
^.
phylo_groupBranchId
))
<>
",(1.."
<>
show
(
length
branches
)
<>
")]"
<>
" | "
<>
show
(
length
$
concat
branches
)
<>
" groups"
<>
"
\n
"
...
...
@@ -788,7 +797,7 @@ traceMatchNoSplit branches =
traceMatchLimit
::
[[
PhyloGroup
]]
->
[[
PhyloGroup
]]
traceMatchLimit
branches
=
trace
(
"
\n
"
<>
"-- local branches : "
trace
Phylo
(
"
\n
"
<>
"-- local branches : "
<>
(
Text
.
pack
$
init
$
show
((
init
.
snd
)
$
(
head'
"trace"
$
head'
"trace"
branches
)
^.
phylo_groupBranchId
))
<>
",(1.."
<>
show
(
length
branches
)
<>
")]"
<>
" | "
<>
show
(
length
$
concat
branches
)
<>
" groups"
<>
"
\n
"
...
...
@@ -798,15 +807,15 @@ traceMatchLimit branches =
traceMatchEnd
::
[
PhyloGroup
]
->
[
PhyloGroup
]
traceMatchEnd
groups
=
trace
(
"
\n
"
<>
"-- | End temporal matching with "
<>
show
(
length
$
nub
$
map
(
\
g
->
g
^.
phylo_groupBranchId
)
groups
)
trace
Phylo
(
"
\n
"
<>
"-- | End temporal matching with "
<>
show
(
length
$
nub
$
map
(
\
g
->
g
^.
phylo_groupBranchId
)
groups
)
<>
" branches and "
<>
show
(
length
groups
)
<>
" groups"
<>
"
\n
"
::
Text
)
groups
traceTemporalMatching
::
[
PhyloGroup
]
->
[
PhyloGroup
]
traceTemporalMatching
groups
=
trace
(
"
\n
"
<>
"-- | Start temporal matching for "
<>
show
(
length
groups
)
<>
" groups"
<>
"
\n
"
::
Text
)
groups
trace
Phylo
(
"
\n
"
<>
"-- | Start temporal matching for "
<>
show
(
length
groups
)
<>
" groups"
<>
"
\n
"
::
Text
)
groups
traceGroupsProxi
::
[
Double
]
->
[
Double
]
traceGroupsProxi
l
=
trace
(
"
\n
"
<>
"-- | "
<>
show
(
List
.
length
l
)
<>
" computed pairs of groups Similarity"
<>
"
\n
"
::
Text
)
l
trace
Phylo
(
"
\n
"
<>
"-- | "
<>
show
(
List
.
length
l
)
<>
" computed pairs of groups Similarity"
<>
"
\n
"
::
Text
)
l
src/Gargantext/Core/Viz/Phylo/TemporalMatching.hs
View file @
80a0e2ef
...
...
@@ -662,7 +662,7 @@ seaLevelRise fdt similarity lambda minBranch frequency ladder rise frame periods
else
-- start breaking up all the possible branches for the current similarity threshold
let
thr
=
List
.
head
ladder
branches'
=
trace
(
"threshold = "
<>
(
T
.
pack
$
printf
"%.3f"
thr
)
branches'
=
trace
Phylo
(
"threshold = "
<>
(
T
.
pack
$
printf
"%.3f"
thr
)
<>
" F(λ) = "
<>
(
T
.
pack
$
printf
"%.5f"
(
toPhyloQuality
fdt
lambda
frequency
(
map
fst
branches
)))
<>
" ξ = "
<>
(
T
.
pack
$
printf
"%.5f"
(
globalAccuracy
frequency
(
map
fst
branches
)))
<>
" ρ = "
<>
(
T
.
pack
$
printf
"%.5f"
(
globalRecall
frequency
(
map
fst
branches
)))
...
...
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