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
145
Issues
145
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
7fef621e
Commit
7fef621e
authored
Oct 24, 2019
by
qlobbe
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add the maxClique (in progress)
parent
4f17f5dd
Pipeline
#596
failed with stage
Changes
6
Pipelines
1
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
51 additions
and
206 deletions
+51
-206
AdaptativePhylo.hs
src/Gargantext/Viz/AdaptativePhylo.hs
+10
-12
PhyloExample.hs
src/Gargantext/Viz/Phylo/PhyloExample.hs
+2
-2
PhyloExport.hs
src/Gargantext/Viz/Phylo/PhyloExport.hs
+1
-1
PhyloMaker.hs
src/Gargantext/Viz/Phylo/PhyloMaker.hs
+23
-21
PhyloTools.hs
src/Gargantext/Viz/Phylo/PhyloTools.hs
+12
-12
TemporalMatching.hs
src/Gargantext/Viz/Phylo/TemporalMatching.hs
+3
-158
No files found.
src/Gargantext/Viz/AdaptativePhylo.hs
View file @
7fef621e
...
...
@@ -88,12 +88,14 @@ data ContextualUnit =
Fis
{
_fis_support
::
Int
,
_fis_size
::
Int
}
|
MaxClique
{
_clique_size
::
Int
}
deriving
(
Show
,
Generic
,
Eq
)
data
Quality
=
Quality
{
_qua_
relevance
::
Double
,
_qua_minBranch
::
Int
}
Quality
{
_qua_
granularity
::
Double
,
_qua_minBranch
::
Int
}
deriving
(
Show
,
Generic
,
Eq
)
...
...
@@ -125,7 +127,7 @@ defaultConfig =
,
phyloLevel
=
2
,
phyloProximity
=
WeightedLogJaccard
10
0
0.1
,
phyloSynchrony
=
ByProximityDistribution
0
,
phyloQuality
=
Quality
1
0
3
,
phyloQuality
=
Quality
0
3
,
timeUnit
=
Year
3
1
5
,
contextualUnit
=
Fis
1
5
,
exportLabel
=
[
BranchLabel
MostInclusive
2
,
GroupLabel
MostEmergentInclusive
2
]
...
...
@@ -315,17 +317,13 @@ data PointerType = TemporalPointer | LevelPointer deriving (Generic, Show)
-- | Frequent Item Set | --
---------------------------
-- | Clique : Set of ngrams cooccurring in the same Document
type
Clique
=
Set
Ngrams
-- | Support : Number of Documents where a Clique occurs
type
Support
=
Int
-- | Fis : Frequent Items Set (ie: the association between a Clique and a Support)
data
PhyloFis
=
PhyloFis
{
_phyloFis_clique
::
Clique
,
_phyloFis_support
::
Support
,
_phyloFis_period
::
(
Date
,
Date
)
data
PhyloCUnit
=
PhyloCUnit
{
_phyloCUnit_nodes
::
Set
Ngrams
,
_phyloCUnit_support
::
Support
,
_phyloCUnit_period
::
(
Date
,
Date
)
}
deriving
(
Generic
,
NFData
,
Show
,
Eq
)
...
...
@@ -378,7 +376,7 @@ makeLenses ''ContextualUnit
makeLenses
''
P
hyloLabel
makeLenses
''
T
imeUnit
makeLenses
''
P
hyloFoundations
makeLenses
''
P
hylo
Fis
makeLenses
''
P
hylo
CUnit
makeLenses
''
P
hylo
makeLenses
''
P
hyloPeriod
makeLenses
''
P
hyloLevel
...
...
src/Gargantext/Viz/Phylo/PhyloExample.hs
View file @
7fef621e
...
...
@@ -62,8 +62,8 @@ phylo1 = temporalMatching
---------------------------------------------
phyloFis
::
Map
(
Date
,
Date
)
[
Phylo
Fis
]
phyloFis
=
toPhyloFis
docsByPeriods
(
get
FisSupport
$
contextualUnit
config
)
(
getFis
Size
$
contextualUnit
config
)
phyloFis
::
Map
(
Date
,
Date
)
[
Phylo
CUnit
]
phyloFis
=
toPhyloFis
docsByPeriods
(
get
ContextualUnitSupport
$
contextualUnit
config
)
(
getContextualUnit
Size
$
contextualUnit
config
)
docsByPeriods
::
Map
(
Date
,
Date
)
[
Document
]
...
...
src/Gargantext/Viz/Phylo/PhyloExport.hs
View file @
7fef621e
...
...
@@ -171,7 +171,7 @@ exportToDot phylo export =
,(
toAttr
(
fromStrict
"proxiName"
)
$
pack
$
show
(
getProximityName
$
phyloProximity
$
getConfig
phylo
))
,(
toAttr
(
fromStrict
"proxiInit"
)
$
pack
$
show
(
getProximityInit
$
phyloProximity
$
getConfig
phylo
))
,(
toAttr
(
fromStrict
"proxiStep"
)
$
pack
$
show
(
getProximityStep
$
phyloProximity
$
getConfig
phylo
))
,(
toAttr
(
fromStrict
"quaFactor"
)
$
pack
$
show
(
_qua_
relevance
$
phyloQuality
$
getConfig
phylo
))
,(
toAttr
(
fromStrict
"quaFactor"
)
$
pack
$
show
(
_qua_
granularity
$
phyloQuality
$
getConfig
phylo
))
])
...
...
src/Gargantext/Viz/Phylo/PhyloMaker.hs
View file @
7fef621e
...
...
@@ -72,23 +72,23 @@ appendGroups f lvl m phylo = trace ("\n" <> "-- | Append " <> show (length $ co
(
\
phyloLvl
->
if
lvl
==
(
phyloLvl
^.
phylo_levelLevel
)
then
let
pId
=
phyloLvl
^.
phylo_levelPeriod
phylo
Fis
=
m
!
pId
phylo
CUnit
=
m
!
pId
in
phyloLvl
&
phylo_levelGroups
.~
(
fromList
$
foldl
(
\
groups
obj
->
groups
++
[
(((
pId
,
lvl
),
length
groups
)
,
f
obj
pId
lvl
(
length
groups
)
(
getRoots
phylo
)
(
elems
$
restrictKeys
(
phylo
^.
phylo_timeCooc
)
$
periodsToYears
[
pId
]))
]
)
[]
phylo
Fis
)
]
)
[]
phylo
CUnit
)
else
phyloLvl
)
phylo
fisToGroup
::
Phylo
Fis
->
PhyloPeriodId
->
Level
->
Int
->
Vector
Ngrams
->
[
Cooc
]
->
PhyloGroup
fisToGroup
::
Phylo
CUnit
->
PhyloPeriodId
->
Level
->
Int
->
Vector
Ngrams
->
[
Cooc
]
->
PhyloGroup
fisToGroup
fis
pId
lvl
idx
fdt
coocs
=
let
ngrams
=
ngramsToIdx
(
Set
.
toList
$
fis
^.
phylo
Fis_clique
)
fdt
let
ngrams
=
ngramsToIdx
(
Set
.
toList
$
fis
^.
phylo
CUnit_nodes
)
fdt
in
PhyloGroup
pId
lvl
idx
""
(
fis
^.
phylo
Fis
_support
)
(
fis
^.
phylo
CUnit
_support
)
ngrams
(
ngramsToCooc
ngrams
coocs
)
(
1
,[
0
])
...
...
@@ -98,11 +98,13 @@ fisToGroup fis pId lvl idx fdt coocs =
toPhylo1
::
[
Document
]
->
Phylo
->
Phylo
toPhylo1
docs
phyloBase
=
temporalMatching
$
appendGroups
fisToGroup
1
phylo
Fis
phyloBase
$
appendGroups
fisToGroup
1
phylo
CUnit
phyloBase
where
--------------------------------------
phyloFis
::
Map
(
Date
,
Date
)
[
PhyloFis
]
phyloFis
=
toPhyloFis
docs'
(
getFisSupport
$
contextualUnit
$
getConfig
phyloBase
)
(
getFisSize
$
contextualUnit
$
getConfig
phyloBase
)
phyloCUnit
::
Map
(
Date
,
Date
)
[
PhyloCUnit
]
phyloCUnit
=
case
(
contextualUnit
$
getConfig
phyloBase
)
of
Fis
s
s'
->
toPhyloFis
docs'
s
s'
MaxClique
_
->
undefined
--------------------------------------
docs'
::
Map
(
Date
,
Date
)
[
Document
]
docs'
=
groupDocsByPeriod
date
(
getPeriodIds
phyloBase
)
docs
...
...
@@ -115,30 +117,30 @@ toPhylo1 docs phyloBase = temporalMatching
-- | To apply a filter with the possibility of keeping some periods non empty (keep : True|False)
filterFis
::
Bool
->
Int
->
(
Int
->
[
Phylo
Fis
]
->
[
PhyloFis
])
->
Map
(
Date
,
Date
)
[
PhyloFis
]
->
Map
(
Date
,
Date
)
[
PhyloFis
]
filterFis
::
Bool
->
Int
->
(
Int
->
[
Phylo
CUnit
]
->
[
PhyloCUnit
])
->
Map
(
Date
,
Date
)
[
PhyloCUnit
]
->
Map
(
Date
,
Date
)
[
PhyloCUnit
]
filterFis
keep
thr
f
m
=
case
keep
of
False
->
map
(
\
l
->
f
thr
l
)
m
True
->
map
(
\
l
->
keepFilled
(
f
)
thr
l
)
m
-- | To filter Fis with small Support
filterFisBySupport
::
Int
->
[
Phylo
Fis
]
->
[
PhyloFis
]
filterFisBySupport
thr
l
=
filter
(
\
fis
->
(
fis
^.
phylo
Fis
_support
)
>=
thr
)
l
filterFisBySupport
::
Int
->
[
Phylo
CUnit
]
->
[
PhyloCUnit
]
filterFisBySupport
thr
l
=
filter
(
\
fis
->
(
fis
^.
phylo
CUnit
_support
)
>=
thr
)
l
-- | To filter Fis with small Clique size
filterFisByClique
::
Int
->
[
Phylo
Fis
]
->
[
PhyloFis
]
filterFisByClique
thr
l
=
filter
(
\
fis
->
(
size
$
fis
^.
phylo
Fis_clique
)
>=
thr
)
l
filterFisByClique
::
Int
->
[
Phylo
CUnit
]
->
[
PhyloCUnit
]
filterFisByClique
thr
l
=
filter
(
\
fis
->
(
size
$
fis
^.
phylo
CUnit_nodes
)
>=
thr
)
l
-- | To filter nested Fis
filterFisByNested
::
Map
(
Date
,
Date
)
[
Phylo
Fis
]
->
Map
(
Date
,
Date
)
[
PhyloFis
]
filterFisByNested
::
Map
(
Date
,
Date
)
[
Phylo
CUnit
]
->
Map
(
Date
,
Date
)
[
PhyloCUnit
]
filterFisByNested
m
=
let
fis
=
map
(
\
l
->
foldl
(
\
mem
f
->
if
(
any
(
\
f'
->
isNested
(
Set
.
toList
$
f'
^.
phylo
Fis_clique
)
(
Set
.
toList
$
f
^.
phyloFis_clique
))
mem
)
foldl
(
\
mem
f
->
if
(
any
(
\
f'
->
isNested
(
Set
.
toList
$
f'
^.
phylo
CUnit_nodes
)
(
Set
.
toList
$
f
^.
phyloCUnit_nodes
))
mem
)
then
mem
else
let
fMax
=
filter
(
\
f'
->
not
$
isNested
(
Set
.
toList
$
f
^.
phylo
Fis_clique
)
(
Set
.
toList
$
f'
^.
phyloFis_clique
))
mem
let
fMax
=
filter
(
\
f'
->
not
$
isNested
(
Set
.
toList
$
f
^.
phylo
CUnit_nodes
)
(
Set
.
toList
$
f'
^.
phyloCUnit_nodes
))
mem
in
fMax
++
[
f
]
)
[]
l
)
$
elems
m
fis'
=
fis
`
using
`
parList
rdeepseq
...
...
@@ -146,7 +148,7 @@ 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
)
[
Phylo
Fis
]
toPhyloFis
::
Map
(
Date
,
Date
)
[
Document
]
->
Int
->
Int
->
Map
(
Date
,
Date
)
[
Phylo
CUnit
]
toPhyloFis
phyloDocs
support
clique
=
traceFis
"Filtered Fis"
$
filterFisByNested
$
traceFis
"Filtered by clique size"
...
...
@@ -156,10 +158,10 @@ toPhyloFis phyloDocs support clique = traceFis "Filtered Fis"
$
traceFis
"Unfiltered Fis"
phyloFis
where
--------------------------------------
phyloFis
::
Map
(
Date
,
Date
)
[
Phylo
Fis
]
phyloFis
::
Map
(
Date
,
Date
)
[
Phylo
CUnit
]
phyloFis
=
let
fis
=
map
(
\
(
prd
,
docs
)
->
let
lst
=
toList
$
fisWithSizePolyMap
(
Segment
1
20
)
1
(
map
text
docs
)
in
(
prd
,
map
(
\
f
->
Phylo
Fis
(
fst
f
)
(
snd
f
)
prd
)
lst
))
in
(
prd
,
map
(
\
f
->
Phylo
CUnit
(
fst
f
)
(
snd
f
)
prd
)
lst
))
$
toList
phyloDocs
fis'
=
fis
`
using
`
parList
rdeepseq
in
fromList
fis'
...
...
@@ -209,9 +211,9 @@ groupDocsByPeriod f pds es =
docsToTermFreq
::
[
Document
]
->
Vector
Ngrams
->
Map
Int
Double
docsToTermFreq
docs
fdt
=
let
nbDocs
=
fromIntegral
$
length
docs
freqs
=
map
(
/
nbDocs
)
freqs
=
map
(
/
(
log
nbDocs
)
)
$
fromList
$
map
(
\
lst
->
(
head'
"docsToTermFreq"
lst
,
fromIntegral
$
length
lst
))
$
map
(
\
lst
->
(
head'
"docsToTermFreq"
lst
,
log
$
fromIntegral
$
length
lst
))
$
group
$
sort
$
concat
$
map
(
\
d
->
nub
$
ngramsToIdx
(
text
d
)
fdt
)
docs
sumFreqs
=
sum
$
elems
freqs
in
map
(
/
sumFreqs
)
freqs
...
...
src/Gargantext/Viz/Phylo/PhyloTools.hs
View file @
7fef621e
...
...
@@ -162,28 +162,28 @@ keepFilled f thr l = if (null $ f thr l) && (not $ null l)
else
f
thr
l
traceClique
::
Map
(
Date
,
Date
)
[
Phylo
Fis
]
->
String
traceClique
::
Map
(
Date
,
Date
)
[
Phylo
CUnit
]
->
String
traceClique
mFis
=
foldl
(
\
msg
cpt
->
msg
<>
show
(
countSup
cpt
cliques
)
<>
" (>"
<>
show
(
cpt
)
<>
") "
)
""
[
1
..
6
]
where
--------------------------------------
cliques
::
[
Double
]
cliques
=
sort
$
map
(
fromIntegral
.
size
.
_phylo
Fis_clique
)
$
concat
$
elems
mFis
cliques
=
sort
$
map
(
fromIntegral
.
size
.
_phylo
CUnit_nodes
)
$
concat
$
elems
mFis
--------------------------------------
traceSupport
::
Map
(
Date
,
Date
)
[
Phylo
Fis
]
->
String
traceSupport
::
Map
(
Date
,
Date
)
[
Phylo
CUnit
]
->
String
traceSupport
mFis
=
foldl
(
\
msg
cpt
->
msg
<>
show
(
countSup
cpt
supports
)
<>
" (>"
<>
show
(
cpt
)
<>
") "
)
""
[
1
..
6
]
where
--------------------------------------
supports
::
[
Double
]
supports
=
sort
$
map
(
fromIntegral
.
_phylo
Fis
_support
)
$
concat
$
elems
mFis
supports
=
sort
$
map
(
fromIntegral
.
_phylo
CUnit
_support
)
$
concat
$
elems
mFis
--------------------------------------
traceFis
::
[
Char
]
->
Map
(
Date
,
Date
)
[
Phylo
Fis
]
->
Map
(
Date
,
Date
)
[
PhyloFis
]
traceFis
::
[
Char
]
->
Map
(
Date
,
Date
)
[
Phylo
CUnit
]
->
Map
(
Date
,
Date
)
[
PhyloCUnit
]
traceFis
msg
mFis
=
trace
(
"
\n
"
<>
"-- | "
<>
msg
<>
" : "
<>
show
(
sum
$
map
length
$
elems
mFis
)
<>
"
\n
"
<>
"Support : "
<>
(
traceSupport
mFis
)
<>
"
\n
"
<>
"
Clique
: "
<>
(
traceClique
mFis
)
<>
"
\n
"
)
mFis
<>
"
Nb Ngrams
: "
<>
(
traceClique
mFis
)
<>
"
\n
"
)
mFis
-------------------------
...
...
@@ -191,15 +191,15 @@ traceFis msg mFis = trace ( "\n" <> "-- | " <> msg <> " : " <> show (sum $ map l
-------------------------
get
Fis
Support
::
ContextualUnit
->
Int
get
Fis
Support
unit
=
case
unit
of
get
ContextualUnit
Support
::
ContextualUnit
->
Int
get
ContextualUnit
Support
unit
=
case
unit
of
Fis
s
_
->
s
-- _ -> panic ("[ERR][Viz.Phylo.PhyloTools.getFisSupport] Only Fis has a support")
MaxClique
_
->
0
get
Fis
Size
::
ContextualUnit
->
Int
get
Fis
Size
unit
=
case
unit
of
get
ContextualUnit
Size
::
ContextualUnit
->
Int
get
ContextualUnit
Size
unit
=
case
unit
of
Fis
_
s
->
s
-- _ -> panic ("[ERR][Viz.Phylo.PhyloTools.getFisSupport] Only Fis has a clique size")
MaxClique
s
->
s
--------------
...
...
src/Gargantext/Viz/Phylo/TemporalMatching.hs
View file @
7fef621e
This diff is collapsed.
Click to expand it.
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