Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
haskell-gargantext
Commits
7fdba0d9
Commit
7fdba0d9
authored
Jun 01, 2021
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev' into dev-test
parents
8abc41f1
9a5c6eee
Pipeline
#1500
failed with stage
in 5 minutes and 18 seconds
Changes
7
Pipelines
1
Expand all
Show whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
92 additions
and
66 deletions
+92
-66
package.yaml
package.yaml
+6
-0
Clustering.hs
src-test/Graph/Clustering.hs
+44
-0
Distance.hs
src-test/Graph/Distance.hs
+2
-1
Main.hs
src-test/Main.hs
+8
-6
API.hs
src/Gargantext/Core/Viz/Graph/API.hs
+7
-0
Tools.hs
src/Gargantext/Core/Viz/Graph/Tools.hs
+19
-57
Prelude.hs
src/Gargantext/Prelude.hs
+6
-2
No files found.
package.yaml
View file @
7fdba0d9
...
...
@@ -49,6 +49,7 @@ library:
-
Gargantext.API.Admin.Types
-
Gargantext.API.Prelude
-
Gargantext.Core
-
Gargantext.Core.Methods.Distances
-
Gargantext.Core.Types
-
Gargantext.Core.Types.Individu
-
Gargantext.Core.Types.Main
...
...
@@ -67,6 +68,8 @@ library:
-
Gargantext.Prelude
-
Gargantext.Prelude.Crypto.Pass.User
-
Gargantext.Prelude.GargDB
-
Gargantext.Prelude.Crypto.Hash
-
Gargantext.Prelude.Utils
-
Gargantext.Core.Text
-
Gargantext.Core.Text.Context
-
Gargantext.Core.Text.Corpus.Parsers
...
...
@@ -88,6 +91,8 @@ library:
-
Gargantext.Core.Text.Terms.WithList
-
Gargantext.Core.Text.Flow
-
Gargantext.Core.Viz.Graph
-
Gargantext.Core.Viz.Graph.Tools
-
Gargantext.Core.Viz.Graph.Tools.IGraph
-
Gargantext.Core.Viz.Graph.Index
-
Gargantext.Core.Viz.AdaptativePhylo
-
Gargantext.Core.Viz.Phylo.PhyloMaker
...
...
@@ -431,6 +436,7 @@ tests:
-
parsec
-
duckling
-
text
-
unordered-containers
# garg-doctest:
# main: Main.hs
# source-dirs: src-doctest
...
...
src-test/Graph/Clustering.hs
0 → 100644
View file @
7fdba0d9
This diff is collapsed.
Click to expand it.
src-test/Graph/Distance.hs
View file @
7fdba0d9
...
...
@@ -17,6 +17,7 @@ module Graph.Distance where
import
Test.Hspec
{-
import Gargantext.Core.Methods.Matrix.Accelerate.Utils (cross', matrix)
import Gargantext.Prelude
...
...
@@ -26,4 +27,4 @@ test = hspec $ do
let result = cross' $ matrix 3 ([1,1..] :: [Double])
it "compare" $ do
shouldBe result (matrix 3 ([2,2..] :: [Double]))
-}
src-test/Main.hs
View file @
7fdba0d9
...
...
@@ -16,7 +16,8 @@ import Gargantext.Core (Lang(..))
import
qualified
Ngrams.Lang.Occurrences
as
Occ
import
qualified
Ngrams.Metrics
as
Metrics
import
qualified
Parsers.Date
as
PD
import
qualified
Graph.Distance
as
GD
-- import qualified Graph.Distance as GD
import
qualified
Graph.Clustering
as
Graph
import
qualified
Utils.Crypto
as
Crypto
main
::
IO
()
...
...
@@ -25,6 +26,7 @@ main = do
-- Lang.ngramsExtractionTest FR
-- Lang.ngramsExtractionTest EN
-- Metrics.main
Graph
.
test
PD
.
testFromRFC3339
-- GD.test
Crypto
.
test
src/Gargantext/Core/Viz/Graph/API.hs
View file @
7fdba0d9
...
...
@@ -168,6 +168,7 @@ computeGraph cId d nt repo = do
saveAsFileDebug
"debug/my-cooc"
myCooc
graph
<-
liftBase
$
cooc2graphWith
Spinglass
d
0
myCooc
saveAsFileDebug
"debug/graph"
graph
pure
graph
...
...
@@ -289,3 +290,9 @@ getGraphGexf :: UserId
getGraphGexf
uId
nId
=
do
HyperdataGraphAPI
{
_hyperdataAPIGraph
=
graph
}
<-
getGraph
uId
nId
pure
$
addHeader
"attachment; filename=graph.gexf"
graph
src/Gargantext/Core/Viz/Graph/Tools.hs
View file @
7fdba0d9
...
...
@@ -110,14 +110,13 @@ filterByNeighbours threshold distanceMap = filteredMap
in
List
.
take
(
round
threshold
)
selected
)
indexes
cooc2graphWith'
::
ToComId
a
=>
Partitions
a
->
Distance
doDistanceMap
::
Distance
->
Threshold
->
HashMap
(
NgramsTerm
,
NgramsTerm
)
Int
->
IO
Graph
cooc2graphWith'
doPartitions
distance
threshold
myCooc
=
do
let
->
(
Map
(
Int
,
Int
)
Double
,
Map
(
Index
,
Index
)
Int
,
Map
NgramsTerm
Index
)
doDistanceMap
distance
threshold
myCooc
=
(
distanceMap
,
myCooc'
,
ti
)
where
-- TODO remove below
theMatrix
=
Map
.
fromList
$
HashMap
.
toList
myCooc
...
...
@@ -135,8 +134,8 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
similarities
=
measure
distance
matCooc
links
=
round
(
let
n
::
Double
=
fromIntegral
tiSize
in
n
*
log
n
)
distanceMap
=
Map
.
fromList
$
List
.
take
links
distanceMap
=
Map
.
fromList
$
List
.
take
links
$
List
.
sortOn
snd
$
Map
.
toList
$
case
distance
of
...
...
@@ -144,6 +143,16 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
Distributional
->
Map
.
filter
(
>
0
)
$
mat2map
similarities
cooc2graphWith'
::
ToComId
a
=>
Partitions
a
->
Distance
->
Threshold
->
HashMap
(
NgramsTerm
,
NgramsTerm
)
Int
->
IO
Graph
cooc2graphWith'
doPartitions
distance
threshold
myCooc
=
do
let
(
distanceMap
,
myCooc'
,
ti
)
=
doDistanceMap
distance
threshold
myCooc
nodesApprox
::
Int
nodesApprox
=
n'
where
...
...
@@ -151,15 +160,10 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
n'
=
Set
.
size
$
Set
.
fromList
$
as
<>
bs
ClustersParams
rivers
_level
=
clustersParams
nodesApprox
saveAsFileDebug
"debug/the-matrix"
theMatrix
saveAsFileDebug
"debug/my-cooc-prime"
myCooc'
saveAsFileDebug
"debug/mat-cooc"
matCooc
saveAsFileDebug
"debug/similarities"
similarities
saveAsFileDebug
"debug/links"
links
{- | Debug
saveAsFileDebug "debug/distanceMap" distanceMap
saveAsFileDebug
"debug/nodesApprox"
nodesApprox
printDebug "similarities" similarities
-}
-- partitions <- if (Map.size distanceMap > 0)
-- then doPartitions distanceMap
...
...
@@ -177,48 +181,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
myCooc'
bridgeness'
confluence'
partitions
-- cooc2graph :: Distance
-- -> Threshold
-- -> (Map (Text, Text) Int)
-- -> IO Graph
-- cooc2graph distance threshold myCooc = do
-- printDebug "cooc2graph" distance
-- let
-- -- TODO remove below
-- theMatrix = Map.fromList $ HashMap.toList myCooc
-- (ti, _) = createIndices theMatrix
-- myCooc' = toIndex ti theMatrix
-- matCooc = map2mat 0 (Map.size ti)
-- $ Map.filterWithKey (\(a,b) _ -> a /= b)
-- $ Map.filter (> 1) myCooc'
-- distanceMat = measure distance matCooc
-- distanceMap = Map.filter (> threshold) $ mat2map distanceMat
-- nodesApprox :: Int
-- nodesApprox = n'
-- where
-- (as, bs) = List.unzip $ Map.keys distanceMap
-- n' = Set.size $ Set.fromList $ as <> bs
-- ClustersParams rivers _level = clustersParams nodesApprox
-- printDebug "Start" ("partitions" :: Text)
-- partitions <- if (Map.size distanceMap > 0)
-- -- then iLouvainMap 100 10 distanceMap
-- -- then hLouvain distanceMap
-- then doPartitions distanceMap
-- else panic "Text.Flow: DistanceMap is empty"
-- printDebug "End" ("partitions" :: Text)
-- let
-- -- bridgeness' = distanceMap
-- bridgeness' = trace ("Rivers: " <> show rivers)
-- $ bridgeness rivers partitions distanceMap
-- confluence' = confluence (Map.keys bridgeness') 3 True False
-- pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti)
-- myCooc' bridgeness' confluence' partitions
------------------------------------------------------------------------
------------------------------------------------------------------------
data
ClustersParams
=
ClustersParams
{
bridgness
::
Double
...
...
src/Gargantext/Prelude.hs
View file @
7fdba0d9
...
...
@@ -82,14 +82,18 @@ import qualified Data.List as L hiding (head, sum)
import
qualified
Data.Map
as
M
import
qualified
Data.Set
as
Set
import
qualified
Data.Vector
as
V
import
System.FilePath.Posix
(
takeDirectory
)
import
System.Directory
(
createDirectoryIfMissing
)
printDebug
::
(
Show
a
,
MonadBase
IO
m
)
=>
[
Char
]
->
a
->
m
()
printDebug
msg
x
=
liftBase
.
putStrLn
$
msg
<>
" "
<>
show
x
-- printDebug _ _ = pure ()
saveAsFileDebug
::
(
Show
a
,
MonadBase
IO
m
)
=>
[
Char
]
->
a
->
m
()
saveAsFileDebug
fname
x
=
liftBase
.
Protolude
.
writeFile
fname
$
pack
$
show
x
saveAsFileDebug
fname
x
=
do
let
dir
=
takeDirectory
fname
_
<-
liftBase
$
createDirectoryIfMissing
True
dir
liftBase
.
Protolude
.
writeFile
fname
$
pack
$
show
x
-- | splitEvery n == chunkAlong n n
...
...
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