]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Graph/Distances/Matrice.hs
[Types] Phylo
[gargantext.git] / 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 miniMax m = map (\x -> ifThenElse (x > (the $ minimum $ maximum m)) x 0) m
118
119 filter m = zipWith (\a b -> max a b) m (transpose 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