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
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
Grégoire Locqueville
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
author
:
Gargantext Team
maintainer
:
team@gargantext.org
copyright
:
-
!
'
Copyright:
(c)
2017-
2018
:
see
git
logs
and
README'
license
:
BSD
3
-
!
'
Copyright:
(c)
2017-
Present
:
see
git
logs
and
README'
license
:
AGPL-
3
homepage
:
https://gargantext.org
ghc-options
:
-Wall
extra-libraries
:
-
gfortran
-
gfortran
dependencies
:
-
extra
-
text
-
extra
-
text
default-extensions
:
-
DataKinds
-
DeriveGeneric
...
...
@@ -58,6 +58,7 @@ library:
-
Gargantext.Text
-
Gargantext.Text.Context
-
Gargantext.Text.Corpus.Parsers
-
Gargantext.Text.Corpus.Parsers.Date.Parsec
-
Gargantext.Text.Corpus.API
-
Gargantext.Text.Corpus.Parsers.CSV
-
Gargantext.Text.Examples
...
...
@@ -363,36 +364,58 @@ executables:
tests
:
# garg-test:
# main: Main.hs
# source-dirs: src-test
# ghc-options:
# - -threaded
# - -rtsopts
# - -with-rtsopts=-N
# dependencies:
# - base
# - gargantext
# - hspec
# - QuickCheck
# - quickcheck-instances
# - time
# - parsec
# - duckling
# - text
garg-doctest
:
main
:
Main.hs
source-dirs
:
src-doctest
ghc-options
:
-
-O2
-
-Wcompat
-
-Wmissing-signatures
-
-rtsopts
-
-threaded
-
-with-rtsopts=-N
dependencies
:
-
doctest
-
Glob
-
QuickCheck
-
base
-
gargantext
garg-test
:
main
:
Main.hs
source-dirs
:
src-test
default-extensions
:
-
DataKinds
-
DeriveGeneric
-
FlexibleContexts
-
FlexibleInstances
-
GeneralizedNewtypeDeriving
-
MultiParamTypeClasses
-
NoImplicitPrelude
-
OverloadedStrings
-
RankNTypes
ghc-options
:
-
-threaded
-
-rtsopts
-
-with-rtsopts=-N
dependencies
:
-
base
-
gargantext
-
hspec
-
QuickCheck
-
quickcheck-instances
-
time
-
parsec
-
duckling
-
text
# garg-doctest:
# main: Main.hs
# source-dirs: src-doctest
# ghc-options:
# - -O2
# - -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
Test.DocTest
import
Gargantext.Prelude
main
::
IO
()
main
=
glob
"src/Gargantext/"
>>=
doctest
...
...
src-test/Main.hs
View file @
d5c72ed2
...
...
@@ -12,15 +12,17 @@ Portability : POSIX
import
Gargantext.Prelude
import
Gargantext.Core
(
Lang
(
..
))
--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.Metrics
as
Metrics
import
qualified
Parsers.Date
as
PD
import
qualified
Graph.Distance
as
GD
main
::
IO
()
main
=
do
Occ
.
parsersTest
Lang
.
ngramsExtractionTest
FR
Lang
.
ngramsExtractionTest
EN
Metrics
.
main
--
Occ.parsersTest
--
Lang.ngramsExtractionTest FR
--
Lang.ngramsExtractionTest EN
--
Metrics.main
PD
.
testFromRFC3339
GD
.
test
src-test/Ngrams/Lang.hs
View file @
d5c72ed2
...
...
@@ -15,6 +15,7 @@ commentary with @some markup@.
module
Ngrams.Lang
where
{-
import Gargantext.Prelude (IO())
import Gargantext.Core (Lang(..))
...
...
@@ -24,4 +25,4 @@ import qualified Ngrams.Lang.En as En
ngramsExtractionTest :: Lang -> IO ()
ngramsExtractionTest FR = Fr.ngramsExtractionTest
ngramsExtractionTest EN = En.ngramsExtractionTest
-}
src-test/Ngrams/Lang/En.hs
View file @
d5c72ed2
...
...
@@ -15,6 +15,7 @@ commentary with @some markup@.
module
Ngrams.Lang.En
where
{-
import Data.List ((!!))
import Data.Text (Text)
...
...
@@ -22,8 +23,11 @@ import Test.Hspec
import Gargantext.Prelude
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 = hspec $ do
...
...
@@ -43,4 +47,4 @@ ngramsExtractionTest = hspec $ do
t2 <- map (selectNgrams EN) <$> extractNgrams EN t
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@.
module
Ngrams.Lang.Fr
where
{-
import Test.Hspec
import Gargantext.Prelude
import Gargantext.Core (Lang(..))
-- TODO this import is not used anymore
import Gargantext.Text.Ngrams.PosTagging.Parser (extractNgrams, selectNgrams)
-- use instead
-
ngramsExtractionTest :: IO ()
ngramsExtractionTest = hspec $ do
describe "Behavioral tests: ngrams extraction in French Language" $ 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."
testFr1 <- map (selectNgrams FR) <$> (extractNgrams FR) textFr1
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@.
module
Ngrams.Lang.Occurrences
where
{-
import Test.Hspec
import Data.Either (Either(Right))
...
...
@@ -59,4 +60,4 @@ parsersTest = hspec $ do
-- describe "Parser for nodes" $ do
-- it "returns the result of one parsing after space" $ do
-- occOfCorpus 249509 "sciences" `shouldReturn` 7
-}
src-test/Ngrams/Metrics.hs
View file @
d5c72ed2
...
...
@@ -15,8 +15,10 @@ commentary with @some markup@.
{-# LANGUAGE CPP #-}
module
Ngrams.Metrics
(
main
)
where
--module Ngrams.Metrics (main) where
module
Ngrams.Metrics
where
{-
import Data.Text (Text)
import qualified Data.Text as T
import Data.Ratio
...
...
@@ -139,3 +141,5 @@ testPair :: (Eq a, Show a)
-> SpecWith ()
testPair f a b r = it ("‘" <> T.unpack a <> "’ and ‘" <> T.unpack b <> "’") $
f a b `shouldBe` r
-}
src-test/Parsers/Date.hs
View file @
d5c72ed2
...
...
@@ -28,7 +28,7 @@ import Duckling.Time.Types (toRFC3339)
-----------------------------------------------------------
import
Gargantext.Prelude
import
Gargantext.Text.
Parsers.Date
(
fromRFC3339
)
import
Gargantext.Text.
Corpus.Parsers.Date.Parsec
(
fromRFC3339
)
import
Parsers.Types
-----------------------------------------------------------
...
...
src/Gargantext/API/Node/Update.hs
View file @
d5c72ed2
...
...
@@ -81,7 +81,7 @@ updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
2
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
...
...
src/Gargantext/Viz/Graph/API.hs
View file @
d5c72ed2
...
...
@@ -147,8 +147,9 @@ computeGraph cId d nt repo = do
lIds
<-
selectNodesWithUsername
NodeList
userMaster
let
ngs
=
filterListWithRoot
MapTerm
$
mapTermListRoot
[
lId
]
nt
repo
-- TODO split diagonal
myCooc
<-
Map
.
filter
(
>
1
)
<$>
getCoocByNgrams
(
Diagonal
Tru
e
)
<$>
getCoocByNgrams
(
Diagonal
Fals
e
)
<$>
groupNodesByNgrams
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
------------------------------------------------------------------------
data
Distance
=
Conditional
|
Distributional
deriving
(
Show
)
measure
::
Distance
->
Matrix
Int
->
Matrix
Double
measure
Conditional
=
measureConditional
...
...
src/Gargantext/Viz/Graph/Distances/Distributional.hs
View file @
d5c72ed2
...
...
@@ -18,18 +18,15 @@ module Gargantext.Viz.Graph.Distances.Distributional
where
import
Data.Matrix
hiding
(
identity
)
import
qualified
Data.Map
as
M
import
Data.Vector
(
Vector
)
import
qualified
Data.Vector
as
V
import
Gargantext.Prelude
import
Gargantext.Viz.Graph.Utils
distributional
::
(
Floating
a
,
Ord
a
)
=>
Matrix
a
->
[((
Int
,
Int
),
a
)]
distributional
m
=
filter
(
\
((
x
,
y
),
d
)
->
foldl'
(
&&
)
True
(
conditions
x
y
d
)
)
distriList
distributional
'
::
(
Floating
a
,
Ord
a
)
=>
Matrix
a
->
[((
Int
,
Int
),
a
)]
distributional
'
m
=
filter
(
\
((
x
,
y
),
d
)
->
foldl'
(
&&
)
True
(
conditions
x
y
d
)
)
distriList
where
conditions
x
y
d
=
[
(
x
/=
y
)
,
(
d
>
miniMax'
)
...
...
@@ -51,7 +48,6 @@ ri m = matrix c r doRi
$
V
.
zip
(
ax
Col
x
y
mi'
)
(
ax
Row
x
y
mi'
)
(
c
,
r
)
=
(
nOf
Col
m
,
nOf
Row
m
)
mi
::
(
Ord
a
,
Floating
a
)
=>
Matrix
a
->
Matrix
a
mi
m
=
matrix
c
r
createMat
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:
[Accelerating Haskell Array Codes with Multicore GPUs][CKLM+11].
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.
[Type-safe Runtime Code Generation: Accelerate to LLVM][MCGN15].
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:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module
Gargantext.Viz.Graph.Distances.Matrice
where
import
Debug.Trace
(
trace
)
import
Data.Array.Accelerate
import
Data.Array.Accelerate.Interpreter
(
run
)
import
qualified
Gargantext.Prelude
as
P
...
...
@@ -49,8 +42,8 @@ import qualified Gargantext.Prelude as P
--
-- >>> vector 3
-- Vector (Z :. 3) [0,1,2]
vector
::
Int
->
(
Array
(
Z
:.
Int
)
Int
)
vector
n
=
fromList
(
Z
:.
n
)
[
0
..
n
]
vector
::
Elt
c
=>
Int
->
[
c
]
->
(
Array
(
Z
:.
Int
)
c
)
vector
n
l
=
fromList
(
Z
:.
n
)
l
-- | Define a matrix
--
...
...
@@ -85,16 +78,26 @@ dim m = n
-- 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
--
-- >>> run $ matSum 3 (use $ matrix 3 [1..])
-- >>> run $ matSum
Col
3 (use $ matrix 3 [1..])
-- Matrix (Z :. 3 :. 3)
-- [ 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
)
matSum
r
mat
=
replicate
(
constant
(
Z
:.
(
r
::
Int
)
:.
All
))
$
sum
$
transpose
mat
matSumCol
::
Dim
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
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
...
...
@@ -106,14 +109,16 @@ matSum r mat = replicate (constant (Z :. (r :: Int) :. All)) $ sum $ transpose m
-- 0.3333333333333333, 0.3333333333333333, 0.3333333333333333,
-- 0.5833333333333334, 0.5333333333333333, 0.5]
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
--
-- >>> run $ diag (use $ matrix 3 ([1..] :: [Int]))
-- Vector (Z :. 3) [1,5,9]
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
--
...
...
@@ -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, 8.0,
-- 0.0, 6.0, 9.0]
matFilter
::
Double
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
matFilter
t
m
=
map
(
\
x
->
ifThenElse
(
x
>
(
constant
t
))
x
0
)
(
transpose
m
)
filter'
::
Double
->
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
filter'
t
m
=
map
(
\
x
->
ifThenElse
(
x
>
(
constant
t
))
x
0
)
(
transpose
m
)
-----------------------------------------------------------------------
-- * Measures of proximity
...
...
@@ -164,7 +169,9 @@ matFilter t m = map (\x -> ifThenElse (x > (constant t)) x 0) (transpose m)
-- interactions of 2 terms in the corpus.
measureConditional
::
Matrix
Int
->
Matrix
Double
--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)
...
...
@@ -196,9 +203,9 @@ conditional' m = ( run $ ie $ map fromIntegral $ use m
r
=
dim
m
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
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
...
...
@@ -206,11 +213,11 @@ conditional' m = ( run $ ie $ map fromIntegral $ use m
-- | Distributional Distance Measure
--
-- 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: \[
-- 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
-- \[S_{MI}({i},{j}) = \log(\frac{C{ij}}{E{ij}})\]
...
...
@@ -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}\]
--
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
-- 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
mat1
=
matSum
n
$
zipWith
min
(
s_mi
mat
)
(
s_mi
$
transpose
mat
)
mat2
=
matSum
n
mat
s_mi
m'
=
zipWith
(
\
a
b
->
log
(
a
/
b
))
m'
$
zipWith
(
/
)
(
crossProduct
m'
)
(
total
m'
)
mat1
=
matSumCol
n
$
zipWith
min'
(
myMin
mat
)
(
myMin
$
transpose
mat
)
mat2
=
total
mat
myMin
::
Acc
(
Matrix
Double
)
->
Acc
(
Matrix
Double
)
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
m
crossProduct
m'''
=
zipWith
(
*
)
(
cross
m'''
)
(
cross
(
transpose
m'''
))
cross
mat
=
zipWith
(
-
)
(
matSum
n
mat
)
(
mat
)
-- run $ (identityMatrix (DAA.constant (10::Int)) :: DAA.Acc (DAA.Matrix Int)) Matrix (Z :. 10 :. 10)
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
->
(
Map
(
Text
,
Text
)
Int
)
->
IO
Graph
cooc2graph
distance
threshold
myCooc
=
do
printDebug
"cooc2graph"
distance
let
(
ti
,
_
)
=
createIndices
myCooc
myCooc'
=
toIndex
ti
myCooc
...
...
stack.yaml
View file @
d5c72ed2
...
...
@@ -58,7 +58,6 @@ extra-deps:
commit
:
308c74b71a1abb0a91546fa57d353131248e3a7f
-
Unique-0.4.7.6@sha256:a1ff411f4d68c756e01e8d532fbe8e57f1ac77f2cc0ee8a999770be2bca185c5,2723
-
KMP-0.1.0.2
-
accelerate-1.2.0.1
-
aeson-lens-0.5.0.0
-
deepseq-th-0.1.0.4
-
duckling-0.1.3.0
...
...
@@ -84,3 +83,7 @@ extra-deps:
-
password-2.0.1.1
-
base64-0.4.2@sha256:e9523e18bdadc3cab9dc32dfe3ac09c718fe792076326d6d353437b8b255cb5b,2888
-
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