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
125
Issues
125
List
Board
Labels
Milestones
Merge Requests
8
Merge Requests
8
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
d5c72ed2
Commit
d5c72ed2
authored
Jul 01, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev-refact-graph' into dev
parents
d9f67d62
fb3674dc
Changes
16
Hide whitespace changes
Inline
Side-by-side
Showing
16 changed files
with
234 additions
and
96 deletions
+234
-96
package.yaml
package.yaml
+61
-38
Main.hs
src-doctest/Main.hs
+1
-0
Main.hs
src-test/Main.hs
+7
-5
Lang.hs
src-test/Ngrams/Lang.hs
+2
-1
En.hs
src-test/Ngrams/Lang/En.hs
+6
-2
Fr.hs
src-test/Ngrams/Lang/Fr.hs
+5
-2
Occurrences.hs
src-test/Ngrams/Lang/Occurrences.hs
+2
-1
Metrics.hs
src-test/Ngrams/Metrics.hs
+5
-1
Date.hs
src-test/Parsers/Date.hs
+1
-1
Update.hs
src/Gargantext/API/Node/Update.hs
+1
-1
API.hs
src/Gargantext/Viz/Graph/API.hs
+2
-1
Distances.hs
src/Gargantext/Viz/Graph/Distances.hs
+1
-0
Distributional.hs
src/Gargantext/Viz/Graph/Distances/Distributional.hs
+2
-6
Matrice.hs
src/Gargantext/Viz/Graph/Distances/Matrice.hs
+133
-36
Tools.hs
src/Gargantext/Viz/Graph/Tools.hs
+1
-0
stack.yaml
stack.yaml
+4
-1
No files found.
package.yaml
View file @
d5c72ed2
...
@@ -6,15 +6,15 @@ category: Data
...
@@ -6,15 +6,15 @@ category: Data
author
:
Gargantext Team
author
:
Gargantext Team
maintainer
:
team@gargantext.org
maintainer
:
team@gargantext.org
copyright
:
copyright
:
-
!
'
Copyright:
(c)
2017-
2018
:
see
git
logs
and
README'
-
!
'
Copyright:
(c)
2017-
Present
:
see
git
logs
and
README'
license
:
BSD
3
license
:
AGPL-
3
homepage
:
https://gargantext.org
homepage
:
https://gargantext.org
ghc-options
:
-Wall
ghc-options
:
-Wall
extra-libraries
:
extra-libraries
:
-
gfortran
-
gfortran
dependencies
:
dependencies
:
-
extra
-
extra
-
text
-
text
default-extensions
:
default-extensions
:
-
DataKinds
-
DataKinds
-
DeriveGeneric
-
DeriveGeneric
...
@@ -58,6 +58,7 @@ library:
...
@@ -58,6 +58,7 @@ library:
-
Gargantext.Text
-
Gargantext.Text
-
Gargantext.Text.Context
-
Gargantext.Text.Context
-
Gargantext.Text.Corpus.Parsers
-
Gargantext.Text.Corpus.Parsers
-
Gargantext.Text.Corpus.Parsers.Date.Parsec
-
Gargantext.Text.Corpus.API
-
Gargantext.Text.Corpus.API
-
Gargantext.Text.Corpus.Parsers.CSV
-
Gargantext.Text.Corpus.Parsers.CSV
-
Gargantext.Text.Examples
-
Gargantext.Text.Examples
...
@@ -363,36 +364,58 @@ executables:
...
@@ -363,36 +364,58 @@ executables:
tests
:
tests
:
# garg-test:
garg-test
:
# main: Main.hs
main
:
Main.hs
# source-dirs: src-test
source-dirs
:
src-test
# ghc-options:
default-extensions
:
# - -threaded
-
DataKinds
# - -rtsopts
-
DeriveGeneric
# - -with-rtsopts=-N
-
FlexibleContexts
# dependencies:
-
FlexibleInstances
# - base
-
GeneralizedNewtypeDeriving
# - gargantext
-
MultiParamTypeClasses
# - hspec
-
NoImplicitPrelude
# - QuickCheck
-
OverloadedStrings
# - quickcheck-instances
-
RankNTypes
# - time
ghc-options
:
# - parsec
-
-threaded
# - duckling
-
-rtsopts
# - text
-
-with-rtsopts=-N
garg-doctest
:
dependencies
:
main
:
Main.hs
-
base
source-dirs
:
src-doctest
-
gargantext
ghc-options
:
-
hspec
-
-O2
-
QuickCheck
-
-Wcompat
-
quickcheck-instances
-
-Wmissing-signatures
-
time
-
-rtsopts
-
parsec
-
-threaded
-
duckling
-
-with-rtsopts=-N
-
text
dependencies
:
# garg-doctest:
-
doctest
# main: Main.hs
-
Glob
# source-dirs: src-doctest
-
QuickCheck
# ghc-options:
-
base
# - -O2
-
gargantext
# - -Wcompat
# - -Wmissing-signatures
# - -rtsopts
# - -threaded
# - -with-rtsopts=-N
# dependencies:
# - doctest
# - Glob
# - QuickCheck
# - base
# - gargantext
# default-extensions:
# - DataKinds
# - DeriveGeneric
# - FlexibleContexts
# - FlexibleInstances
# - GeneralizedNewtypeDeriving
# - MultiParamTypeClasses
# - NoImplicitPrelude
# - OverloadedStrings
# - RankNTypes
#
src-doctest/Main.hs
View file @
d5c72ed2
import
System.FilePath.Glob
import
System.FilePath.Glob
import
Test.DocTest
import
Test.DocTest
import
Gargantext.Prelude
main
::
IO
()
main
::
IO
()
main
=
glob
"src/Gargantext/"
>>=
doctest
main
=
glob
"src/Gargantext/"
>>=
doctest
...
...
src-test/Main.hs
View file @
d5c72ed2
...
@@ -12,15 +12,17 @@ Portability : POSIX
...
@@ -12,15 +12,17 @@ Portability : POSIX
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
--import qualified Ngrams.Lang.Fr as Fr
--import qualified Ngrams.Lang.Fr as Fr
import
qualified
Ngrams.Lang
as
Lang
--
import qualified Ngrams.Lang as Lang
import
qualified
Ngrams.Lang.Occurrences
as
Occ
import
qualified
Ngrams.Lang.Occurrences
as
Occ
import
qualified
Ngrams.Metrics
as
Metrics
import
qualified
Ngrams.Metrics
as
Metrics
import
qualified
Parsers.Date
as
PD
import
qualified
Parsers.Date
as
PD
import
qualified
Graph.Distance
as
GD
main
::
IO
()
main
::
IO
()
main
=
do
main
=
do
Occ
.
parsersTest
--
Occ.parsersTest
Lang
.
ngramsExtractionTest
FR
--
Lang.ngramsExtractionTest FR
Lang
.
ngramsExtractionTest
EN
--
Lang.ngramsExtractionTest EN
Metrics
.
main
--
Metrics.main
PD
.
testFromRFC3339
PD
.
testFromRFC3339
GD
.
test
src-test/Ngrams/Lang.hs
View file @
d5c72ed2
...
@@ -15,6 +15,7 @@ commentary with @some markup@.
...
@@ -15,6 +15,7 @@ commentary with @some markup@.
module
Ngrams.Lang
where
module
Ngrams.Lang
where
{-
import Gargantext.Prelude (IO())
import Gargantext.Prelude (IO())
import Gargantext.Core (Lang(..))
import Gargantext.Core (Lang(..))
...
@@ -24,4 +25,4 @@ import qualified Ngrams.Lang.En as En
...
@@ -24,4 +25,4 @@ import qualified Ngrams.Lang.En as En
ngramsExtractionTest :: Lang -> IO ()
ngramsExtractionTest :: Lang -> IO ()
ngramsExtractionTest FR = Fr.ngramsExtractionTest
ngramsExtractionTest FR = Fr.ngramsExtractionTest
ngramsExtractionTest EN = En.ngramsExtractionTest
ngramsExtractionTest EN = En.ngramsExtractionTest
-}
src-test/Ngrams/Lang/En.hs
View file @
d5c72ed2
...
@@ -15,6 +15,7 @@ commentary with @some markup@.
...
@@ -15,6 +15,7 @@ commentary with @some markup@.
module
Ngrams.Lang.En
where
module
Ngrams.Lang.En
where
{-
import Data.List ((!!))
import Data.List ((!!))
import Data.Text (Text)
import Data.Text (Text)
...
@@ -22,8 +23,11 @@ import Test.Hspec
...
@@ -22,8 +23,11 @@ import Test.Hspec
import Gargantext.Prelude
import Gargantext.Prelude
import Gargantext.Core (Lang(..))
import Gargantext.Core (Lang(..))
import
Gargantext.Text.Ngrams.PosTagging.Parser
(
extractNgrams
,
selectNgrams
)
-- TODO this import is not used anymore
import Gargantext.Text.Ngrams.PosTagging.Parser (extractNgrams, selectNgrams)
-- use instead
-- import Gargantext.Text.Terms (extractNgramsT)
ngramsExtractionTest :: IO ()
ngramsExtractionTest :: IO ()
ngramsExtractionTest = hspec $ do
ngramsExtractionTest = hspec $ do
...
@@ -43,4 +47,4 @@ ngramsExtractionTest = hspec $ do
...
@@ -43,4 +47,4 @@ ngramsExtractionTest = hspec $ do
t2 <- map (selectNgrams EN) <$> extractNgrams EN t
t2 <- map (selectNgrams EN) <$> extractNgrams EN t
t2 `shouldBe` [[("Donald Trump","NNP","PERSON"),("president of the United-States of America","NN","LOCATION")]]
t2 `shouldBe` [[("Donald Trump","NNP","PERSON"),("president of the United-States of America","NN","LOCATION")]]
-}
src-test/Ngrams/Lang/Fr.hs
View file @
d5c72ed2
...
@@ -15,12 +15,15 @@ commentary with @some markup@.
...
@@ -15,12 +15,15 @@ commentary with @some markup@.
module
Ngrams.Lang.Fr
where
module
Ngrams.Lang.Fr
where
{-
import Test.Hspec
import Test.Hspec
import Gargantext.Prelude
import Gargantext.Prelude
import Gargantext.Core (Lang(..))
import Gargantext.Core (Lang(..))
-- TODO this import is not used anymore
import Gargantext.Text.Ngrams.PosTagging.Parser (extractNgrams, selectNgrams)
import Gargantext.Text.Ngrams.PosTagging.Parser (extractNgrams, selectNgrams)
-- use instead
-
ngramsExtractionTest :: IO ()
ngramsExtractionTest :: IO ()
ngramsExtractionTest = hspec $ do
ngramsExtractionTest = hspec $ do
describe "Behavioral tests: ngrams extraction in French Language" $ do
describe "Behavioral tests: ngrams extraction in French Language" $ do
...
@@ -61,4 +64,4 @@ ngramsExtractionTest = hspec $ do
...
@@ -61,4 +64,4 @@ ngramsExtractionTest = hspec $ do
let textFr1 = "L'heure d'arrivée des coureurs dépend de la météo du jour."
let textFr1 = "L'heure d'arrivée des coureurs dépend de la météo du jour."
testFr1 <- map (selectNgrams FR) <$> (extractNgrams FR) textFr1
testFr1 <- map (selectNgrams FR) <$> (extractNgrams FR) textFr1
testFr1 `shouldBe` [[("heure d' arrivée des coureurs","NC","O"),("météo du jour","NC","O")]]
testFr1 `shouldBe` [[("heure d' arrivée des coureurs","NC","O"),("météo du jour","NC","O")]]
-}
src-test/Ngrams/Lang/Occurrences.hs
View file @
d5c72ed2
...
@@ -15,6 +15,7 @@ commentary with @some markup@.
...
@@ -15,6 +15,7 @@ commentary with @some markup@.
module
Ngrams.Lang.Occurrences
where
module
Ngrams.Lang.Occurrences
where
{-
import Test.Hspec
import Test.Hspec
import Data.Either (Either(Right))
import Data.Either (Either(Right))
...
@@ -59,4 +60,4 @@ parsersTest = hspec $ do
...
@@ -59,4 +60,4 @@ parsersTest = hspec $ do
-- describe "Parser for nodes" $ do
-- describe "Parser for nodes" $ do
-- it "returns the result of one parsing after space" $ do
-- it "returns the result of one parsing after space" $ do
-- occOfCorpus 249509 "sciences" `shouldReturn` 7
-- occOfCorpus 249509 "sciences" `shouldReturn` 7
-}
src-test/Ngrams/Metrics.hs
View file @
d5c72ed2
...
@@ -15,8 +15,10 @@ commentary with @some markup@.
...
@@ -15,8 +15,10 @@ commentary with @some markup@.
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP #-}
module
Ngrams.Metrics
(
main
)
where
--module Ngrams.Metrics (main) where
module
Ngrams.Metrics
where
{-
import Data.Text (Text)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text as T
import Data.Ratio
import Data.Ratio
...
@@ -139,3 +141,5 @@ testPair :: (Eq a, Show a)
...
@@ -139,3 +141,5 @@ testPair :: (Eq a, Show a)
-> SpecWith ()
-> SpecWith ()
testPair f a b r = it ("‘" <> T.unpack a <> "’ and ‘" <> T.unpack b <> "’") $
testPair f a b r = it ("‘" <> T.unpack a <> "’ and ‘" <> T.unpack b <> "’") $
f a b `shouldBe` r
f a b `shouldBe` r
-}
src-test/Parsers/Date.hs
View file @
d5c72ed2
...
@@ -28,7 +28,7 @@ import Duckling.Time.Types (toRFC3339)
...
@@ -28,7 +28,7 @@ import Duckling.Time.Types (toRFC3339)
-----------------------------------------------------------
-----------------------------------------------------------
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Text.
Parsers.Date
(
fromRFC3339
)
import
Gargantext.Text.
Corpus.Parsers.Date.Parsec
(
fromRFC3339
)
import
Parsers.Types
import
Parsers.Types
-----------------------------------------------------------
-----------------------------------------------------------
...
...
src/Gargantext/API/Node/Update.hs
View file @
d5c72ed2
...
@@ -81,7 +81,7 @@ updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
...
@@ -81,7 +81,7 @@ updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
logStatus
JobLog
{
_scst_succeeded
=
Just
1
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
2
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
...
...
src/Gargantext/Viz/Graph/API.hs
View file @
d5c72ed2
...
@@ -147,8 +147,9 @@ computeGraph cId d nt repo = do
...
@@ -147,8 +147,9 @@ computeGraph cId d nt repo = do
lIds
<-
selectNodesWithUsername
NodeList
userMaster
lIds
<-
selectNodesWithUsername
NodeList
userMaster
let
ngs
=
filterListWithRoot
MapTerm
$
mapTermListRoot
[
lId
]
nt
repo
let
ngs
=
filterListWithRoot
MapTerm
$
mapTermListRoot
[
lId
]
nt
repo
-- TODO split diagonal
myCooc
<-
Map
.
filter
(
>
1
)
myCooc
<-
Map
.
filter
(
>
1
)
<$>
getCoocByNgrams
(
Diagonal
Tru
e
)
<$>
getCoocByNgrams
(
Diagonal
Fals
e
)
<$>
groupNodesByNgrams
ngs
<$>
groupNodesByNgrams
ngs
<$>
getNodesByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
Map
.
keys
ngs
)
<$>
getNodesByNgramsOnlyUser
cId
(
lIds
<>
[
lId
])
nt
(
Map
.
keys
ngs
)
...
...
src/Gargantext/Viz/Graph/Distances.hs
View file @
d5c72ed2
...
@@ -27,6 +27,7 @@ import Test.QuickCheck.Arbitrary
...
@@ -27,6 +27,7 @@ import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
------------------------------------------------------------------------
data
Distance
=
Conditional
|
Distributional
data
Distance
=
Conditional
|
Distributional
deriving
(
Show
)
measure
::
Distance
->
Matrix
Int
->
Matrix
Double
measure
::
Distance
->
Matrix
Int
->
Matrix
Double
measure
Conditional
=
measureConditional
measure
Conditional
=
measureConditional
...
...
src/Gargantext/Viz/Graph/Distances/Distributional.hs
View file @
d5c72ed2
...
@@ -18,18 +18,15 @@ module Gargantext.Viz.Graph.Distances.Distributional
...
@@ -18,18 +18,15 @@ module Gargantext.Viz.Graph.Distances.Distributional
where
where
import
Data.Matrix
hiding
(
identity
)
import
Data.Matrix
hiding
(
identity
)
import
qualified
Data.Map
as
M
import
qualified
Data.Map
as
M
import
Data.Vector
(
Vector
)
import
Data.Vector
(
Vector
)
import
qualified
Data.Vector
as
V
import
qualified
Data.Vector
as
V
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Viz.Graph.Utils
import
Gargantext.Viz.Graph.Utils
distributional
::
(
Floating
a
,
Ord
a
)
=>
Matrix
a
->
[((
Int
,
Int
),
a
)]
distributional
'
::
(
Floating
a
,
Ord
a
)
=>
Matrix
a
->
[((
Int
,
Int
),
a
)]
distributional
m
=
filter
(
\
((
x
,
y
),
d
)
->
foldl'
(
&&
)
True
(
conditions
x
y
d
)
)
distriList
distributional
'
m
=
filter
(
\
((
x
,
y
),
d
)
->
foldl'
(
&&
)
True
(
conditions
x
y
d
)
)
distriList
where
where
conditions
x
y
d
=
[
(
x
/=
y
)
conditions
x
y
d
=
[
(
x
/=
y
)
,
(
d
>
miniMax'
)
,
(
d
>
miniMax'
)
...
@@ -51,7 +48,6 @@ ri m = matrix c r doRi
...
@@ -51,7 +48,6 @@ ri m = matrix c r doRi
$
V
.
zip
(
ax
Col
x
y
mi'
)
(
ax
Row
x
y
mi'
)
$
V
.
zip
(
ax
Col
x
y
mi'
)
(
ax
Row
x
y
mi'
)
(
c
,
r
)
=
(
nOf
Col
m
,
nOf
Row
m
)
(
c
,
r
)
=
(
nOf
Col
m
,
nOf
Row
m
)
mi
::
(
Ord
a
,
Floating
a
)
=>
Matrix
a
->
Matrix
a
mi
::
(
Ord
a
,
Floating
a
)
=>
Matrix
a
->
Matrix
a
mi
m
=
matrix
c
r
createMat
mi
m
=
matrix
c
r
createMat
where
where
...
...
src/Gargantext/Viz/Graph/Distances/Matrice.hs
View file @
d5c72ed2
...
@@ -17,14 +17,6 @@ Implementation use Accelerate library which enables GPU and CPU computation:
...
@@ -17,14 +17,6 @@ Implementation use Accelerate library which enables GPU and CPU computation:
[Accelerating Haskell Array Codes with Multicore GPUs][CKLM+11].
[Accelerating Haskell Array Codes with Multicore GPUs][CKLM+11].
In _DAMP '11: Declarative Aspects of Multicore Programming_, ACM, 2011.
In _DAMP '11: Declarative Aspects of Multicore Programming_, ACM, 2011.
* Trevor L. McDonell, Manuel M. T. Chakravarty, Gabriele Keller, and Ben Lippmeier.
[Optimising Purely Functional GPU Programs][MCKL13].
In _ICFP '13: The 18th ACM SIGPLAN International Conference on Functional Programming_, ACM, 2013.
* Robert Clifton-Everest, Trevor L. McDonell, Manuel M. T. Chakravarty, and Gabriele Keller.
[Embedding Foreign Code][CMCK14].
In _PADL '14: The 16th International Symposium on Practical Aspects of Declarative Languages_, Springer-Verlag, LNCS, 2014.
* Trevor L. McDonell, Manuel M. T. Chakravarty, Vinod Grover, and Ryan R. Newton.
* Trevor L. McDonell, Manuel M. T. Chakravarty, Vinod Grover, and Ryan R. Newton.
[Type-safe Runtime Code Generation: Accelerate to LLVM][MCGN15].
[Type-safe Runtime Code Generation: Accelerate to LLVM][MCGN15].
In _Haskell '15: The 8th ACM SIGPLAN Symposium on Haskell_, ACM, 2015.
In _Haskell '15: The 8th ACM SIGPLAN Symposium on Haskell_, ACM, 2015.
...
@@ -34,13 +26,14 @@ Implementation use Accelerate library which enables GPU and CPU computation:
...
@@ -34,13 +26,14 @@ Implementation use Accelerate library which enables GPU and CPU computation:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module
Gargantext.Viz.Graph.Distances.Matrice
module
Gargantext.Viz.Graph.Distances.Matrice
where
where
import
Debug.Trace
(
trace
)
import
Data.Array.Accelerate
import
Data.Array.Accelerate
import
Data.Array.Accelerate.Interpreter
(
run
)
import
Data.Array.Accelerate.Interpreter
(
run
)
import
qualified
Gargantext.Prelude
as
P
import
qualified
Gargantext.Prelude
as
P
...
@@ -49,8 +42,8 @@ import qualified Gargantext.Prelude as P
...
@@ -49,8 +42,8 @@ import qualified Gargantext.Prelude as P
--
--
-- >>> vector 3
-- >>> vector 3
-- Vector (Z :. 3) [0,1,2]
-- Vector (Z :. 3) [0,1,2]
vector
::
Int
->
(
Array
(
Z
:.
Int
)
Int
)
vector
::
Elt
c
=>
Int
->
[
c
]
->
(
Array
(
Z
:.
Int
)
c
)
vector
n
=
fromList
(
Z
:.
n
)
[
0
..
n
]
vector
n
l
=
fromList
(
Z
:.
n
)
l
-- | Define a matrix
-- | Define a matrix
--
--
...
@@ -85,16 +78,26 @@ dim m = n
...
@@ -85,16 +78,26 @@ dim m = n
-- indexTail (arrayShape m)
-- indexTail (arrayShape m)
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-- TODO move to Utils
runExp
::
Elt
e
=>
Exp
e
->
e
runExp
e
=
indexArray
(
run
(
unit
e
))
Z
-----------------------------------------------------------------------
-- | Sum of a Matrix by Column
-- | Sum of a Matrix by Column
--
--
-- >>> run $ matSum 3 (use $ matrix 3 [1..])
-- >>> run $ matSum
Col
3 (use $ matrix 3 [1..])
-- Matrix (Z :. 3 :. 3)
-- Matrix (Z :. 3 :. 3)
-- [ 12.0, 15.0, 18.0,
-- [ 12.0, 15.0, 18.0,
-- 12.0, 15.0, 18.0,
-- 12.0, 15.0, 18.0,
-- 12.0, 15.0, 18.0]
-- 12.0, 15.0, 18.0]
matSum
::
Dim
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
matSumCol
::
Dim
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
matSum
r
mat
=
replicate
(
constant
(
Z
:.
(
r
::
Int
)
:.
All
))
$
sum
$
transpose
mat
matSumCol
r
mat
=
replicate
(
constant
(
Z
:.
(
r
::
Int
)
:.
All
))
$
sum
$
transpose
mat
matSumCol'
::
Matrix
Double
->
Matrix
Double
matSumCol'
m
=
run
$
matSumCol
n
m'
where
n
=
dim
m
m'
=
use
m
-- | Proba computes de probability matrix: all cells divided by thee sum of its column
-- | Proba computes de probability matrix: all cells divided by thee sum of its column
...
@@ -106,14 +109,16 @@ matSum r mat = replicate (constant (Z :. (r :: Int) :. All)) $ sum $ transpose m
...
@@ -106,14 +109,16 @@ matSum r mat = replicate (constant (Z :. (r :: Int) :. All)) $ sum $ transpose m
-- 0.3333333333333333, 0.3333333333333333, 0.3333333333333333,
-- 0.3333333333333333, 0.3333333333333333, 0.3333333333333333,
-- 0.5833333333333334, 0.5333333333333333, 0.5]
-- 0.5833333333333334, 0.5333333333333333, 0.5]
matProba
::
Dim
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
matProba
::
Dim
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
matProba
r
mat
=
zipWith
(
/
)
mat
(
matSum
r
mat
)
matProba
r
mat
=
zipWith
(
/
)
mat
(
matSum
Col
r
mat
)
-- | Diagonal of the matrix
-- | Diagonal of the matrix
--
--
-- >>> run $ diag (use $ matrix 3 ([1..] :: [Int]))
-- >>> run $ diag (use $ matrix 3 ([1..] :: [Int]))
-- Vector (Z :. 3) [1,5,9]
-- Vector (Z :. 3) [1,5,9]
diag
::
Elt
e
=>
Acc
(
Matrix
e
)
->
Acc
(
Vector
e
)
diag
::
Elt
e
=>
Acc
(
Matrix
e
)
->
Acc
(
Vector
e
)
diag
m
=
backpermute
(
indexTail
(
shape
m
))
(
lift1
(
\
(
Z
:.
x
)
->
(
Z
:.
x
:.
(
x
::
Exp
Int
))))
m
diag
m
=
backpermute
(
indexTail
(
shape
m
))
(
lift1
(
\
(
Z
:.
x
)
->
(
Z
:.
x
:.
(
x
::
Exp
Int
))))
m
-- | Divide by the Diagonal of the matrix
-- | Divide by the Diagonal of the matrix
--
--
...
@@ -145,8 +150,8 @@ matMiniMax m = map (\x -> ifThenElse (x > miniMax') x 0) (transpose m)
...
@@ -145,8 +150,8 @@ matMiniMax m = map (\x -> ifThenElse (x > miniMax') x 0) (transpose m)
-- [ 0.0, 0.0, 7.0,
-- [ 0.0, 0.0, 7.0,
-- 0.0, 0.0, 8.0,
-- 0.0, 0.0, 8.0,
-- 0.0, 6.0, 9.0]
-- 0.0, 6.0, 9.0]
matFilter
::
Double
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
filter'
::
Double
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
matFilter
t
m
=
map
(
\
x
->
ifThenElse
(
x
>
(
constant
t
))
x
0
)
(
transpose
m
)
filter'
t
m
=
map
(
\
x
->
ifThenElse
(
x
>
(
constant
t
))
x
0
)
(
transpose
m
)
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-- * Measures of proximity
-- * Measures of proximity
...
@@ -164,7 +169,9 @@ matFilter t m = map (\x -> ifThenElse (x > (constant t)) x 0) (transpose m)
...
@@ -164,7 +169,9 @@ matFilter t m = map (\x -> ifThenElse (x > (constant t)) x 0) (transpose m)
-- interactions of 2 terms in the corpus.
-- interactions of 2 terms in the corpus.
measureConditional
::
Matrix
Int
->
Matrix
Double
measureConditional
::
Matrix
Int
->
Matrix
Double
--measureConditional m = run (matMiniMax $ matProba (dim m) $ map fromIntegral $ use m)
--measureConditional m = run (matMiniMax $ matProba (dim m) $ map fromIntegral $ use m)
measureConditional
m
=
run
(
matProba
(
dim
m
)
$
map
fromIntegral
$
use
m
)
measureConditional
m
=
run
$
matProba
(
dim
m
)
$
map
fromIntegral
$
use
m
-- *** Conditional distance (advanced)
-- *** Conditional distance (advanced)
...
@@ -196,9 +203,9 @@ conditional' m = ( run $ ie $ map fromIntegral $ use m
...
@@ -196,9 +203,9 @@ conditional' m = ( run $ ie $ map fromIntegral $ use m
r
=
dim
m
r
=
dim
m
xs
::
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
xs
::
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
xs
mat
=
zipWith
(
-
)
(
matSum
r
$
matProba
r
mat
)
(
matProba
r
mat
)
xs
mat
=
zipWith
(
-
)
(
matSum
Col
r
$
matProba
r
mat
)
(
matProba
r
mat
)
ys
::
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
ys
::
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
ys
mat
=
zipWith
(
-
)
(
matSum
r
$
transpose
$
matProba
r
mat
)
(
matProba
r
mat
)
ys
mat
=
zipWith
(
-
)
(
matSum
Col
r
$
transpose
$
matProba
r
mat
)
(
matProba
r
mat
)
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-- ** Distributional Distance
-- ** Distributional Distance
...
@@ -206,11 +213,11 @@ conditional' m = ( run $ ie $ map fromIntegral $ use m
...
@@ -206,11 +213,11 @@ conditional' m = ( run $ ie $ map fromIntegral $ use m
-- | Distributional Distance Measure
-- | Distributional Distance Measure
--
--
-- Distributional measure is a relative measure which depends on the
-- Distributional measure is a relative measure which depends on the
-- selected list, it represents structural equivalence.
-- selected list, it represents structural equivalence
of mutual information
.
--
--
-- The distributional measure P(c) of @i@ and @j@ terms is: \[
-- The distributional measure P(c) of @i@ and @j@ terms is: \[
-- S_{MI} = \frac {\sum_{k \neq i,j ; MI_{ik} >0}^{} \min(MI_{ik},
-- S_{MI} = \frac {\sum_{k \neq i,j ; MI_{ik} >0}^{} \min(MI_{ik},
-- MI_{jk})}{\sum_{k \neq i,j ; MI_{ik}}^{}} \]
-- MI_{jk})}{\sum_{k \neq i,j ; MI_{ik}
>0
}^{}} \]
--
--
-- Mutual information
-- Mutual information
-- \[S_{MI}({i},{j}) = \log(\frac{C{ij}}{E{ij}})\]
-- \[S_{MI}({i},{j}) = \log(\frac{C{ij}}{E{ij}})\]
...
@@ -228,26 +235,116 @@ conditional' m = ( run $ ie $ map fromIntegral $ use m
...
@@ -228,26 +235,116 @@ conditional' m = ( run $ ie $ map fromIntegral $ use m
-- \[N_{m} = \sum_{i,i \neq i}^{m} \sum_{j, j \neq j}^{m} S_{ij}\]
-- \[N_{m} = \sum_{i,i \neq i}^{m} \sum_{j, j \neq j}^{m} S_{ij}\]
--
--
distributional
::
Matrix
Int
->
Matrix
Double
distributional
::
Matrix
Int
->
Matrix
Double
distributional
m
=
run
$
matMiniMax
$
ri
(
map
fromIntegral
$
use
m
)
distributional
m
=
run
-- $ matMiniMax
-- $ ri
-- $ myMin
$
filter'
0
$
s_mi
$
map
fromIntegral
-- ^ from Int to Double
$
use
m
-- ^ push matrix in Accelerate type
where
where
-- filter m = zipWith (\a b -> max a b) m (transpose m)
-- filter m = zipWith (\a b -> max a b) m (transpose m)
ri
mat
=
zipWith
(
/
)
mat1
mat2
ri
::
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
ri
mat
=
mat1
-- zipWith (/) mat1 mat2
where
where
mat1
=
matSum
n
$
zipWith
min
(
s_mi
mat
)
(
s_mi
$
transpose
mat
)
mat1
=
matSumCol
n
$
zipWith
min'
(
myMin
mat
)
(
myMin
$
transpose
mat
)
mat2
=
matSum
n
mat
mat2
=
total
mat
s_mi
m'
=
zipWith
(
\
a
b
->
log
(
a
/
b
))
m'
myMin
::
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
$
zipWith
(
/
)
(
crossProduct
m'
)
(
total
m'
)
myMin
=
replicate
(
constant
(
Z
:.
n
:.
All
))
.
minimum
-- TODO fix NaN
-- Quali TEST: OK
s_mi
::
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
s_mi
m'
=
zipWith
(
\
x
y
->
log
(
x
/
y
))
(
diagNull
n
m'
)
$
zipWith
(
/
)
(
crossProduct
n
m'
)
(
total
m'
)
-- crossProduct n m'
total
m''
=
replicate
(
constant
(
Z
:.
n
:.
n
))
$
fold
(
+
)
0
$
fold
(
+
)
0
m''
total
::
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
total
=
replicate
(
constant
(
Z
:.
n
:.
n
))
.
sum
.
sum
n
::
Dim
n
::
Dim
n
=
dim
m
n
=
dim
m
crossProduct
m'''
=
zipWith
(
*
)
(
cross
m'''
)
(
cross
(
transpose
m'''
))
-- run $ (identityMatrix (DAA.constant (10::Int)) :: DAA.Acc (DAA.Matrix Int)) Matrix (Z :. 10 :. 10)
cross
mat
=
zipWith
(
-
)
(
matSum
n
mat
)
(
mat
)
identityMatrix
::
Num
a
=>
Exp
Int
->
Acc
(
Matrix
a
)
identityMatrix
n
=
let
zeros
=
fill
(
index2
n
n
)
0
ones
=
fill
(
index1
n
)
1
in
permute
const
zeros
(
\
(
unindex1
->
i
)
->
index2
i
i
)
ones
eyeMatrix
::
Num
a
=>
Dim
->
Acc
(
Matrix
a
)
->
Acc
(
Matrix
a
)
eyeMatrix
n'
m
=
let
ones
=
fill
(
index2
n
n
)
1
zeros
=
fill
(
index1
n
)
0
n
=
constant
n'
in
permute
const
ones
(
\
(
unindex1
->
i
)
->
index2
i
i
)
zeros
selfMatrix
::
Num
a
=>
Dim
->
Acc
(
Matrix
a
)
->
Acc
(
Matrix
a
)
selfMatrix
n'
m
=
let
zeros
=
fill
(
index2
n
n
)
0
ones
=
fill
(
index2
n
n
)
1
n
=
constant
n'
in
permute
const
ones
(
lift1
(
\
(
Z
:.
(
i
::
Exp
Int
)
:.
(
j
::
Exp
Int
))
->
-- ifThenElse (i /= j)
-- (Z :. i :. j)
(
Z
:.
i
:.
i
)
))
zeros
selfMatrix'
m'
=
run
$
selfMatrix
n
m
where
n
=
dim
m'
m
=
use
m'
-------------------------------------------------
diagNull
::
Num
a
=>
Dim
->
Acc
(
Matrix
a
)
->
Acc
(
Matrix
a
)
diagNull
n
m
=
zipWith
(
*
)
m
eye
where
eye
=
eyeMatrix
n
m
-------------------------------------------------
crossProduct
::
Dim
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
crossProduct
n
m
=
trace
(
P
.
show
(
run
m'
,
run
m''
))
$
zipWith
(
*
)
m'
m''
where
m'
=
cross
n
m
m''
=
cross
n
(
transpose
m
)
crossT
::
Matrix
Double
->
Matrix
Double
crossT
=
run
.
transpose
.
use
crossProduct'
::
Matrix
Double
->
Matrix
Double
crossProduct'
m
=
run
$
crossProduct
n
m'
where
n
=
dim
m
m'
=
use
m
runWith
::
(
Arrays
c
,
Elt
a1
)
=>
(
Dim
->
Acc
(
Matrix
a1
)
->
a2
->
Acc
c
)
->
Matrix
a1
->
a2
->
c
runWith
f
m
=
run
.
f
(
dim
m
)
(
use
m
)
-- | cross
cross
::
Dim
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
cross
n
mat
=
diagNull
n
(
matSumCol
n
$
diagNull
n
mat
)
cross'
::
Matrix
Double
->
Matrix
Double
cross'
mat
=
run
$
cross
n
mat'
where
mat'
=
use
mat
n
=
dim
mat
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-----------------------------------------------------------------------
...
...
src/Gargantext/Viz/Graph/Tools.hs
View file @
d5c72ed2
...
@@ -56,6 +56,7 @@ cooc2graph :: Distance
...
@@ -56,6 +56,7 @@ cooc2graph :: Distance
->
(
Map
(
Text
,
Text
)
Int
)
->
(
Map
(
Text
,
Text
)
Int
)
->
IO
Graph
->
IO
Graph
cooc2graph
distance
threshold
myCooc
=
do
cooc2graph
distance
threshold
myCooc
=
do
printDebug
"cooc2graph"
distance
let
let
(
ti
,
_
)
=
createIndices
myCooc
(
ti
,
_
)
=
createIndices
myCooc
myCooc'
=
toIndex
ti
myCooc
myCooc'
=
toIndex
ti
myCooc
...
...
stack.yaml
View file @
d5c72ed2
...
@@ -58,7 +58,6 @@ extra-deps:
...
@@ -58,7 +58,6 @@ extra-deps:
commit
:
308c74b71a1abb0a91546fa57d353131248e3a7f
commit
:
308c74b71a1abb0a91546fa57d353131248e3a7f
-
Unique-0.4.7.6@sha256:a1ff411f4d68c756e01e8d532fbe8e57f1ac77f2cc0ee8a999770be2bca185c5,2723
-
Unique-0.4.7.6@sha256:a1ff411f4d68c756e01e8d532fbe8e57f1ac77f2cc0ee8a999770be2bca185c5,2723
-
KMP-0.1.0.2
-
KMP-0.1.0.2
-
accelerate-1.2.0.1
-
aeson-lens-0.5.0.0
-
aeson-lens-0.5.0.0
-
deepseq-th-0.1.0.4
-
deepseq-th-0.1.0.4
-
duckling-0.1.3.0
-
duckling-0.1.3.0
...
@@ -84,3 +83,7 @@ extra-deps:
...
@@ -84,3 +83,7 @@ extra-deps:
-
password-2.0.1.1
-
password-2.0.1.1
-
base64-0.4.2@sha256:e9523e18bdadc3cab9dc32dfe3ac09c718fe792076326d6d353437b8b255cb5b,2888
-
base64-0.4.2@sha256:e9523e18bdadc3cab9dc32dfe3ac09c718fe792076326d6d353437b8b255cb5b,2888
-
ghc-byteorder-4.11.0.0.10@sha256:5ee4a907279bfec27b0f9de7b8fba4cecfd34395a0235a7784494de70ad4e98f,1535
-
ghc-byteorder-4.11.0.0.10@sha256:5ee4a907279bfec27b0f9de7b8fba4cecfd34395a0235a7784494de70ad4e98f,1535
# Matrix Computation
-
accelerate-1.2.0.1
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