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 import Gargantext.Text.Metrics.Occurrences
  52
  53
  54 -----------------------------------------------------------------------
  55 -- Test perf.
  56 distriTest = distributional $ myMat 100
  57 -----------------------------------------------------------------------
  58
  59 vector :: Int -> (Array (Z :. Int) Int)
  60 vector n = fromList (Z :. n) [0..n]
  61
  62 matrix :: Elt c => Int -> [c] -> Matrix c
  63 matrix n l = fromList (Z :. n :. n) l
  64
  65 myMat :: Int -> Matrix Int
  66 myMat n = matrix n [1..]
  67
  68 -- | Two ways to get the rank (as documentation)
  69 rank :: (Matrix a) -> Int
  70 rank m = arrayRank $ arrayShape m
  71
  72 rank' :: (Matrix a) -> Int
  73 rank' m = n
  74   where
  75     Z :. _ :. n = arrayShape m
  76
  77 -----------------------------------------------------------------------
  78 -- | Conditional Distance
  79
  80 type Rank = Int
  81
  82 proba :: Rank -> Acc (Matrix Double) -> Acc (Matrix Double)
  83 proba r mat = zipWith (/) mat (mkSum r mat)
  84
  85 mkSum :: Rank -> Acc (Matrix Double) -> Acc (Matrix Double)
  86 mkSum r mat = replicate (constant (Z :. (r :: Int) :. All))
  87             $ fold (+) 0 mat
  88
  89
  90 type Matrix' a = Acc (Matrix a)
  91 type InclusionExclusion    = Double
  92 type SpecificityGenericity = Double
  93
  94 conditional :: Matrix Double -> (Matrix InclusionExclusion, Matrix SpecificityGenericity)
  95 conditional m = (run $ ie (use m), run $ sg (use m))
  96   where
  97     r :: Rank
  98     r = rank' m
  99
 100     xs :: Matrix' Double -> Matrix' Double
 101     xs mat = zipWith (-) (proba r mat) (mkSum r $ proba r mat)
 102     ys :: Acc (Matrix Double) -> Acc (Matrix Double)
 103     ys mat = zipWith (-) (proba r mat) (mkSum r $ transpose $ proba r mat)
 104
 105     ie :: Matrix' Double -> Matrix' Double
 106     ie mat = map (\x -> x / (2*n-1)) $ zipWith (+) (xs mat) (ys mat)
 107     sg :: Acc (Matrix Double) -> Acc (Matrix Double)
 108     sg mat = map (\x -> x / (2*n-1)) $ zipWith (-) (xs mat) (ys mat)
 109
 110     n :: Exp Double
 111     n = P.fromIntegral r
 112
 113
 114 -- filter with threshold
 115 -----------------------------------------------------------------------
 116
 117 -- | Distributional Distance
 118
 119 distributional :: Matrix Int -> Matrix Double
 120 distributional m = run $ filter $ ri (map fromIntegral $ use m)
 121   where
 122     n    = rank' m
 123
 124     miniMax m = map (\x -> ifThenElse (x > (the $ minimum $ maximum m)) x 0) m
 125
 126     filter  m = zipWith (\a b -> max a b) m (transpose m)
 127
 128     ri mat = zipWith (/) mat1 mat2
 129       where
 130         mat1 = mkSum n $ zipWith min (mi mat) (mi $ transpose mat)
 131         mat2 = mkSum n mat
 132
 133     mi    m'  = zipWith (\a b -> max (log $ a/b) 0)  m'
 134               $ zipWith (/) (crossProduct m') (total m')
 135
 136     total m'' = replicate (constant (Z :. n :. n)) $ fold (+) 0 $ fold (+) 0 m''
 137
 138     crossProduct m = zipWith (*) (cross m  ) (cross (transpose m))
 139     cross mat      = zipWith (-) (mkSum n mat) (mat)
 140
 141
 142 int2double :: Matrix Int -> Matrix Double
 143 int2double m = run (map fromIntegral $ use m)
 144