Commit d5c72ed2 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-refact-graph' into dev

parents d9f67d62 fb3674dc
...@@ -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: BSD3 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
#
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
......
...@@ -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
...@@ -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
-}
...@@ -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")]]
-}
...@@ -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")]]
-}
...@@ -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
-}
...@@ -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
-}
...@@ -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
----------------------------------------------------------- -----------------------------------------------------------
......
...@@ -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 []
} }
......
...@@ -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 True) <$> getCoocByNgrams (Diagonal False)
<$> groupNodesByNgrams ngs <$> groupNodesByNgrams ngs
<$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs) <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
......
...@@ -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
......
...@@ -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
......
...@@ -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 $ matSumCol 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 (matSumCol 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 (-) (matSumCol 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 (-) (matSumCol 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
----------------------------------------------------------------------- -----------------------------------------------------------------------
----------------------------------------------------------------------- -----------------------------------------------------------------------
......
...@@ -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
......
...@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment