[GRAPH] Distances work with Accelerate (WIP)

src-test/Main.hs

@@ -16,6 +16,7 @@ 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
 
 main :: IO ()
 main = do
@@ -24,3 +25,4 @@ main = do
 --    Lang.ngramsExtractionTest EN
 --    Metrics.main
     PD.testFromRFC3339
+    GD.test

src/Gargantext/Viz/Graph/Distances/Distributional.hs

@@ -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

@@ -34,13 +34,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
 
 
@@ -85,6 +86,10 @@ 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
 --
@@ -119,7 +124,9 @@ matProba r mat = zipWith (/) mat (matSumCol r mat)
 -- >>> 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
 --
@@ -151,8 +158,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
@@ -236,42 +243,96 @@ 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
+distributional m = run -- $ matMiniMax
+                       -- $ ri
+                       -- $ myMin 
+                       $ filter' 0
+                       $ s_mi
+--                       $ diag2null
                        $ 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 :: Acc (Matrix Double) -> Acc (Matrix Double)
-    ri mat = zipWith (/) mat1 mat2
+    ri mat = mat1 -- zipWith (/) mat1 mat2
       where
-        mat1 = matSumCol n $ zipWith min (s_mi mat) (s_mi $ transpose mat)
-        mat2 = matSumCol n mat
+        mat1 = matSumCol n $ zipWith min'  (myMin mat) (myMin $ transpose mat)
+        mat2 = total mat
 
     s_mi :: Acc (Matrix Double) -> Acc (Matrix Double)
     s_mi m' = zipWith (\a b -> log (a/b))  m'
-            $ zipWith (/) (crossProduct m') (total m')
+            $ zipWith (/) (crossProduct n m') (total m')
 
     total :: Acc (Matrix Double) -> Acc (Matrix Double)
     total = replicate (constant (Z :. n :. n)) . sum . sum
+    
+    min' x y
+      | runExp (x > y && x /= 0) = x
+      | P.otherwise              = y
+
+    myMin :: Acc (Matrix Double) -> Acc (Matrix Double)
+    myMin = replicate (constant (Z :. n :. All)) . minimum
 
     n :: Dim
     n = dim m
 
-    crossProduct :: Acc (Matrix Double) -> Acc (Matrix Double)
-    crossProduct m''' = zipWith (*) (cross m'''  ) (cross (transpose m'''))
-    cross :: Acc (Matrix Double) -> Acc (Matrix Double)
-    cross mat         = zipWith (-) (matSumCol 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 => (Matrix a) -> Acc (Matrix a)
+eyeMatrix m =
+        let zeros = fill (index2 n n) 1
+            ones  = fill (index1 n)   0
+            n     = constant $ dim m
+        in
+        permute const zeros (\(unindex1 -> i) -> index2 i i) ones
+
+diag2null :: Num a => (Matrix a) -> Acc (Matrix a)
+diag2null m' = zipWith (*) m eye
+  where
+    m   = use m'
+    eye = eyeMatrix 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 :: Matrix Double -> Matrix Double
-cross mat = run $ zipWith (-) (matSumCol n mat') (mat')
+cross :: Dim -> Acc (Matrix Double) -> Acc (Matrix Double)
+cross n mat = zipWith (-) (matSumCol n mat) (mat)
+
+cross' :: Matrix Double -> Matrix Double
+cross' mat = run $ cross n mat'
   where
     mat' = use mat
     n = dim mat
--}
 
 
 -----------------------------------------------------------------------

stack.yaml

@@ -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
+
+