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
158
Issues
158
List
Board
Labels
Milestones
Merge Requests
11
Merge Requests
11
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
c489d91b
Commit
c489d91b
authored
Sep 14, 2020
by
qlobbe
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
change export
parent
a837cc44
Pipeline
#1063
canceled with stage
Changes
5
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
37 additions
and
13 deletions
+37
-13
AdaptativePhylo.hs
src/Gargantext/Viz/AdaptativePhylo.hs
+9
-8
Tools.hs
src/Gargantext/Viz/Graph/Tools.hs
+1
-1
PhyloExport.hs
src/Gargantext/Viz/Phylo/PhyloExport.hs
+6
-1
PhyloMaker.hs
src/Gargantext/Viz/Phylo/PhyloMaker.hs
+13
-1
PhyloTools.hs
src/Gargantext/Viz/Phylo/PhyloTools.hs
+8
-2
No files found.
src/Gargantext/Viz/AdaptativePhylo.hs
View file @
c489d91b
...
...
@@ -262,14 +262,15 @@ type Cooc = Map (Int,Int) Double
-- param : the parameters of the phylomemy (with the user's configuration)
-- periods : the temporal steps of a phylomemy
data
Phylo
=
Phylo
{
_phylo_foundations
::
PhyloFoundations
,
_phylo_timeCooc
::
!
(
Map
Date
Cooc
)
,
_phylo_timeDocs
::
!
(
Map
Date
Double
)
,
_phylo_termFreq
::
!
(
Map
Int
Double
)
,
_phylo_horizon
::
!
(
Map
(
PhyloGroupId
,
PhyloGroupId
)
Double
)
,
_phylo_groupsProxi
::
!
(
Map
(
PhyloGroupId
,
PhyloGroupId
)
Double
)
,
_phylo_param
::
PhyloParam
,
_phylo_periods
::
Map
PhyloPeriodId
PhyloPeriod
Phylo
{
_phylo_foundations
::
PhyloFoundations
,
_phylo_timeCooc
::
!
(
Map
Date
Cooc
)
,
_phylo_timeDocs
::
!
(
Map
Date
Double
)
,
_phylo_termFreq
::
!
(
Map
Int
Double
)
,
_phylo_lastTermFreq
::
!
(
Map
Int
Double
)
,
_phylo_horizon
::
!
(
Map
(
PhyloGroupId
,
PhyloGroupId
)
Double
)
,
_phylo_groupsProxi
::
!
(
Map
(
PhyloGroupId
,
PhyloGroupId
)
Double
)
,
_phylo_param
::
PhyloParam
,
_phylo_periods
::
Map
PhyloPeriodId
PhyloPeriod
}
deriving
(
Generic
,
Show
,
Eq
)
...
...
src/Gargantext/Viz/Graph/Tools.hs
View file @
c489d91b
...
...
@@ -46,7 +46,7 @@ cooc2graph' distance threshold myCooc = distanceMap
where
(
ti
,
_
)
=
createIndices
myCooc
myCooc'
=
toIndex
ti
myCooc
matCooc
=
map2mat
0
(
Map
.
size
ti
)
$
Map
.
filter
(
>
1
)
myCooc'
matCooc
=
map2mat
0
(
Map
.
size
ti
)
$
Map
.
filter
(
>
0
)
myCooc'
distanceMat
=
measure
distance
matCooc
distanceMap
=
Map
.
filter
(
>
threshold
)
$
mat2map
distanceMat
...
...
src/Gargantext/Viz/Phylo/PhyloExport.hs
View file @
c489d91b
...
...
@@ -138,7 +138,11 @@ groupToDotNode fdt g bId =
,
toAttr
"to"
(
pack
$
show
(
snd
$
g
^.
phylo_groupPeriod
))
,
toAttr
"branchId"
(
pack
$
unwords
(
init
$
map
show
$
snd
$
g
^.
phylo_groupBranchId
))
,
toAttr
"bId"
(
pack
$
show
bId
)
,
toAttr
"support"
(
pack
$
show
(
g
^.
phylo_groupSupport
))])
,
toAttr
"support"
(
pack
$
show
(
g
^.
phylo_groupSupport
))
,
toAttr
"label"
(
pack
$
show
(
ngramsToLabel
fdt
(
g
^.
phylo_groupNgrams
)))
,
toAttr
"foundation"
(
pack
$
show
(
idxToLabel
(
g
^.
phylo_groupNgrams
)))
,
toAttr
"role"
(
pack
$
show
(
idxToLabel'
((
g
^.
phylo_groupMeta
)
!
"dynamics"
)))
])
toDotEdge
::
DotId
->
DotId
->
Text
.
Text
->
EdgeType
->
Dot
DotId
...
...
@@ -192,6 +196,7 @@ exportToDot phylo export =
,(
toAttr
(
fromStrict
"phyloPeriods"
)
$
pack
$
show
(
length
$
elems
$
phylo
^.
phylo_periods
))
,(
toAttr
(
fromStrict
"phyloBranches"
)
$
pack
$
show
(
length
$
export
^.
export_branches
))
,(
toAttr
(
fromStrict
"phyloGroups"
)
$
pack
$
show
(
length
$
export
^.
export_groups
))
,(
toAttr
(
fromStrict
"phyloTermsFreq"
)
$
pack
$
show
(
toList
$
_phylo_lastTermFreq
phylo
))
])
{-
...
...
src/Gargantext/Viz/Phylo/PhyloMaker.hs
View file @
c489d91b
...
...
@@ -202,7 +202,7 @@ toPhyloClique phylo phyloDocs = case (clique $ getConfig phylo) of
$
foldl
sumCooc
empty
$
map
listToMatrix
$
map
(
\
d
->
ngramsToIdx
(
text
d
)
(
getRoots
phylo
))
docs
in
(
prd
,
map
(
\
cl
->
PhyloClique
cl
0
prd
)
$
getMaxCliques
Conditional
0
.001
cooc
))
in
(
prd
,
map
(
\
cl
->
PhyloClique
cl
0
prd
)
$
getMaxCliques
Conditional
0
cooc
))
$
toList
phyloDocs
mcl'
=
mcl
`
using
`
parList
rdeepseq
in
fromList
mcl'
...
...
@@ -286,6 +286,17 @@ docsToTermFreq docs fdt =
sumFreqs
=
sum
$
elems
freqs
in
map
(
/
sumFreqs
)
freqs
docsToLastTermFreq
::
Int
->
[
Document
]
->
Vector
Ngrams
->
Map
Int
Double
docsToLastTermFreq
n
docs
fdt
=
let
last
=
take
n
$
reverse
$
sort
$
map
date
docs
nbDocs
=
fromIntegral
$
length
$
filter
(
\
d
->
elem
(
date
d
)
last
)
docs
freqs
=
map
(
/
(
nbDocs
))
$
fromList
$
map
(
\
lst
->
(
head'
"docsToLastTermFreq"
lst
,
fromIntegral
$
length
lst
))
$
group
$
sort
$
concat
$
map
(
\
d
->
nub
$
ngramsToIdx
(
text
d
)
fdt
)
$
filter
(
\
d
->
elem
(
date
d
)
last
)
docs
sumFreqs
=
sum
$
elems
freqs
in
map
(
/
sumFreqs
)
freqs
-- To count the number of docs by unit of time
docsToTimeScaleNb
::
[
Document
]
->
Map
Date
Double
...
...
@@ -312,6 +323,7 @@ toPhyloBase docs lst conf =
(
docsToTimeScaleCooc
docs
(
foundations
^.
foundations_roots
))
(
docsToTimeScaleNb
docs
)
(
docsToTermFreq
docs
(
foundations
^.
foundations_roots
))
(
docsToLastTermFreq
(
getTimePeriod
$
timeUnit
conf
)
docs
(
foundations
^.
foundations_roots
))
empty
empty
params
...
...
src/Gargantext/Viz/Phylo/PhyloTools.hs
View file @
c489d91b
...
...
@@ -17,7 +17,7 @@ import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tai
import
Data.Set
(
Set
,
disjoint
)
import
Data.Map
(
Map
,
elems
,
fromList
,
unionWith
,
keys
,
member
,
(
!
),
filterWithKey
,
fromListWith
,
empty
,
restrictKeys
)
import
Data.String
(
String
)
import
Data.Text
(
Text
,
unwords
)
import
Data.Text
(
Text
)
import
Gargantext.Prelude
import
Gargantext.Viz.AdaptativePhylo
...
...
@@ -31,6 +31,7 @@ import qualified Data.Vector as Vector
import
qualified
Data.List
as
List
import
qualified
Data.Set
as
Set
import
qualified
Data.Map
as
Map
import
qualified
Data.Text
as
Text
------------
-- | Io | --
...
...
@@ -98,8 +99,13 @@ ngramsToIdx ns fdt = map (\n -> fromJust $ elemIndex n fdt) ns
-- | To transform a list of Ngrams Indexes into a Label
ngramsToLabel
::
Vector
Ngrams
->
[
Int
]
->
Text
ngramsToLabel
ngrams
l
=
unwords
$
tail'
"ngramsToLabel"
$
concat
$
map
(
\
n
->
[
"|"
,
n
])
$
ngramsToText
ngrams
l
ngramsToLabel
ngrams
l
=
Text
.
unwords
$
tail'
"ngramsToLabel"
$
concat
$
map
(
\
n
->
[
"|"
,
n
])
$
ngramsToText
ngrams
l
idxToLabel
::
[
Int
]
->
String
idxToLabel
l
=
List
.
unwords
$
tail'
"idxToLabel"
$
concat
$
map
(
\
n
->
[
"|"
,
show
n
])
l
idxToLabel'
::
[
Double
]
->
String
idxToLabel'
l
=
List
.
unwords
$
tail'
"idxToLabel"
$
concat
$
map
(
\
n
->
[
"|"
,
show
n
])
l
-- | To transform a list of Ngrams Indexes into a list of Text
ngramsToText
::
Vector
Ngrams
->
[
Int
]
->
[
Text
]
...
...
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