]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Graph/Distances/Distributional.hs
Merge branch 'dev-list-charts' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell...
[gargantext.git] / src / Gargantext / Viz / Graph / Distances / Distributional.hs
1 {-|
2 Module : Gargantext.Graph.Distances.Distributional
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 @Distributional@ distance.
11 -}
12
13 {-# LANGUAGE BangPatterns #-}
14 {-# LANGUAGE Strict #-}
15
16
17 module Gargantext.Viz.Graph.Distances.Distributional
18 where
19
20 import Data.Matrix hiding (identity)
21
22 import qualified Data.Map as M
23
24 import Data.Vector (Vector)
25 import qualified Data.Vector as V
26
27 import Gargantext.Prelude
28 import Gargantext.Viz.Graph.Utils
29
30
31 distributional :: (Floating a, Ord a) => Matrix a -> [((Int, Int), a)]
32 distributional m = filter (\((x,y), d) -> foldl' (&&) True (conditions x y d) ) distriList
33 where
34 conditions x y d = [ (x /= y)
35 , (d > miniMax')
36 , ((M.lookup (x,y) distriMap) > (M.lookup (y,x) distriMap))
37 ]
38 distriList = toListsWithIndex distriMatrix
39 distriMatrix = ri (mi m)
40
41 distriMap = M.fromList $ distriList
42 miniMax' = miniMax distriMatrix
43
44 ri :: (Ord a, Fractional a) => Matrix a -> Matrix a
45 ri m = matrix c r doRi
46 where
47 doRi (x,y) = doRi' x y m
48 doRi' x y mi'' = sumMin x y mi'' / (V.sum $ ax Col x y mi'')
49
50 sumMin x y mi' = V.sum $ V.map (\(a,b) -> min a b )
51 $ V.zip (ax Col x y mi') (ax Row x y mi')
52 (c,r) = (nOf Col m, nOf Row m)
53
54
55 mi :: (Ord a, Floating a) => Matrix a -> Matrix a
56 mi m = matrix c r createMat
57 where
58 (c,r) = (nOf Col m, nOf Row m)
59 createMat (x,y) = doMi x y m
60 doMi x y m' = if x == y then 0 else (max (log (doMi' x y m')) 0 )
61
62 doMi' x y m' = (getElem x y m) / ( cross x y m / total m' )
63
64 cross x y m' = (V.sum $ ax Col x y m) * (V.sum $ ax Row x y m')
65
66
67
68 ax :: Axis -> Int -> Int -> Matrix a -> Vector a
69 ax a i j m = dropAt j' $ axis a i' m
70 where
71 i' = div i c + 1
72 j' = mod r j + 1
73 (c,r) = (nOf Col m, nOf Row m)
74
75 miniMax :: (Ord a) => Matrix a -> a
76 miniMax m = V.minimum $ V.map (\c -> V.maximum $ getCol c m) (V.enumFromTo 1 (nOf Col m))
77
78