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

   1 {-|
   2 Module      : Gargantext.Graph.Distances.Matrix
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Motivation and definition of the @Conditional@ distance.
  11
  12 Implementation use Accelerate library :
  13   * Manuel M. T. Chakravarty, Gabriele Keller, Sean Lee, Trevor L. McDonell, and Vinod Grover.
  14     [Accelerating Haskell Array Codes with Multicore GPUs][CKLM+11].
  15     In _DAMP '11: Declarative Aspects of Multicore Programming_, ACM, 2011.
  16
  17   * Trevor L. McDonell, Manuel M. T. Chakravarty, Gabriele Keller, and Ben Lippmeier.
  18     [Optimising Purely Functional GPU Programs][MCKL13].
  19     In _ICFP '13: The 18th ACM SIGPLAN International Conference on Functional Programming_, ACM, 2013.
  20
  21   * Robert Clifton-Everest, Trevor L. McDonell, Manuel M. T. Chakravarty, and Gabriele Keller.
  22     [Embedding Foreign Code][CMCK14].
  23     In _PADL '14: The 16th International Symposium on Practical Aspects of Declarative Languages_, Springer-Verlag, LNCS, 2014.
  24
  25   * Trevor L. McDonell, Manuel M. T. Chakravarty, Vinod Grover, and Ryan R. Newton.
  26     [Type-safe Runtime Code Generation: Accelerate to LLVM][MCGN15].
  27     In _Haskell '15: The 8th ACM SIGPLAN Symposium on Haskell_, ACM, 2015.
  28
  29 -}
  30
  31 {-# LANGUAGE NoImplicitPrelude #-}
  32 {-# LANGUAGE FlexibleContexts  #-}
  33 {-# LANGUAGE TypeFamilies      #-}
  34 {-# LANGUAGE TypeOperators     #-}
  35
  36 module Gargantext.Viz.Graph.Distances.Matrice
  37   where
  38
  39 --import Data.Array.Accelerate.Data.Bits
  40 import Data.Array.Accelerate.Interpreter (run)
  41
  42 import Data.Array.Accelerate
  43 import Data.Array.Accelerate.Smart
  44 import Data.Array.Accelerate.Type
  45 import Data.Array.Accelerate.Array.Sugar (fromArr, Array, Z)
  46
  47 import Data.Maybe (Maybe(Just))
  48 import qualified Gargantext.Prelude as P
  49 import qualified Data.Array.Accelerate.Array.Representation     as Repr
  50
  51
  52 vector :: Int -> (Array (Z :. Int) Int)
  53 vector n = fromList (Z :. n) [0..n]
  54
  55 matrix :: Elt c => Int -> [c] -> Matrix c
  56 matrix n l = fromList (Z :. n :. n) l
  57
  58 myMat :: Int -> Matrix Double
  59 myMat n = matrix n [1..]
  60
  61 -- | Two ways to get the rank (as documentation)
  62 rank :: (Matrix Double) -> Int
  63 rank m = arrayRank $ arrayShape m
  64
  65 rank' :: (Matrix Double) -> Int
  66 rank' m = n
  67   where
  68     Z :. _ :. n = arrayShape m
  69
  70 -----------------------------------------------------------------------
  71 -- | Conditional Distance
  72
  73 type Rank = Int
  74
  75 proba :: Rank -> Acc (Matrix Double) -> Acc (Matrix Double)
  76 proba r mat = zipWith (/) mat (mkSum r mat)
  77
  78 mkSum :: Rank -> Acc (Matrix Double) -> Acc (Matrix Double)
  79 mkSum r mat = replicate (constant (Z :. (r :: Int) :. All))
  80             $ fold (+) 0 mat
  81
  82
  83 type Matrix' a = Acc (Matrix a)
  84 type InclusionExclusion    = Double
  85 type SpecificityGenericity = Double
  86
  87 conditional :: Matrix Double -> (Matrix InclusionExclusion, Matrix SpecificityGenericity)
  88 conditional m = (run $ ie (use m), run $ sg (use m))
  89   where
  90     r :: Rank
  91     r = rank' m
  92
  93     xs :: Matrix' Double -> Matrix' Double
  94     xs mat = zipWith (-) (proba r mat) (mkSum r $ proba r mat)
  95     ys :: Acc (Matrix Double) -> Acc (Matrix Double)
  96     ys mat = zipWith (-) (proba r mat) (mkSum r $ transpose $ proba r mat)
  97
  98     ie :: Matrix' Double -> Matrix' Double
  99     ie mat = map (\x -> x / (2*n-1)) $ zipWith (+) (xs mat) (ys mat)
 100     sg :: Acc (Matrix Double) -> Acc (Matrix Double)
 101     sg mat = map (\x -> x / (2*n-1)) $ zipWith (-) (xs mat) (ys mat)
 102
 103     n :: Exp Double
 104     n = P.fromIntegral r
 105
 106
 107 -- filter with threshold
 108 -----------------------------------------------------------------------
 109
 110 -- | Distributional Distance
 111
 112 distributional :: Matrix Double -> Matrix Double
 113 distributional m = run $ filter $ ri (use m)
 114   where
 115     n    = rank m
 116
 117     filter  m = zipWith (\a b -> max a b) m (transpose m)
 118
 119     --miniMax m = map (\x -> if unlift ( x > (unlift $ minimum $ maximum m)) then x else 0) m
 120
 121     ri mat = zipWith (/) mat1 mat2
 122       where
 123         mat1 = mkSum n $ zipWith min (mi mat) (mi $ transpose mat)
 124         mat2 = mkSum n mat
 125
 126     mi    m'  = zipWith (\a b -> max (log $ a/b) 0)  m'
 127               $ zipWith (/) (crossProduct m') (total m')
 128
 129     total m'' = replicate (constant (Z :. n :. n)) $ fold (+) 0 $ fold (+) 0 m''
 130
 131     crossProduct m = zipWith (*) (cross m  ) (cross (transpose m))
 132     cross mat      = zipWith (-) (mkSum n mat) (mat)
 133