src/Gargantext/Core/Viz/Graph/Distances/Conditional.hs

   1 {-|
   2 Module      : Gargantext.Graph.Distances.Conditional
   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
  13 {-# LANGUAGE BangPatterns      #-}
  14 {-# LANGUAGE Strict            #-}
  15 module Gargantext.Core.Viz.Graph.Distances.Conditional
  16   where
  17
  18 import Data.Matrix hiding (identity)
  19
  20 import Data.List (sortOn)
  21
  22 import Data.Map (Map)
  23 import qualified Data.Map as M
  24
  25 import qualified Data.Set as S
  26
  27 import qualified Data.Vector as V
  28
  29 import Gargantext.Prelude
  30 import Gargantext.Core.Viz.Graph.Utils
  31
  32 ------------------------------------------------------------------------
  33 ------------------------------------------------------------------------
  34 -- | Optimisation issue
  35
  36 toBeOptimized :: (Num a, Fractional a, Ord a) => Matrix a -> Matrix a
  37 toBeOptimized m = proba Col m
  38
  39 ------------------------------------------------------------------------
  40 -- | Main Functions
  41 -- Compute the probability from axis
  42 -- x' = x / (sum Col x)
  43 proba :: (Num a, Fractional a) => Axis -> Matrix a -> Matrix a
  44 proba a m = mapOn a (\c x -> x / V.sum (axis a c m)) m
  45
  46
  47 mapOn :: Axis -> (AxisId -> a -> a) -> Matrix a -> Matrix a
  48 mapOn a f m = V.foldl' f'  m (V.enumFromTo 1 (nOf a m))
  49   where
  50     f' m' c = mapOnly a f c m'
  51
  52 mapOnly :: Axis -> (AxisId -> a -> a) -> AxisId -> Matrix a -> Matrix a
  53 mapOnly Col = mapCol
  54 mapOnly Row = mapRow
  55
  56 mapAll :: (a -> a) -> Matrix a -> Matrix a
  57 mapAll f m = mapOn Col (\_ -> f) m
  58
  59
  60 ---------------------------------------------------------------
  61 -- | Compute a distance from axis
  62 -- xs = (sum Col x') - x'
  63 distFromSum :: (Num a, Fractional a)
  64          => Axis -> Matrix a -> Matrix a
  65 distFromSum  a m = mapOn a (\c x -> V.sum (axis a c m) - x) m
  66 ---------------------------------------------------------------
  67 ---------------------------------------------------------------
  68 -- | To compute included/excluded or specific/generic scores
  69 opWith  :: (Fractional a1, Num a1)
  70          => (Matrix a2 -> t -> Matrix a1) -> Matrix a2 -> t -> Matrix a1
  71 opWith op xs ys = mapAll (\x -> x / (2*n -1)) (xs `op` ys)
  72   where
  73     n = fromIntegral $ nOf Col xs
  74 ---------------------------------------------------------------
  75
  76
  77 -------------------------------------------------------
  78 conditional :: (Num a, Fractional a, Ord a) => Matrix a -> Matrix a
  79 conditional m = filterMat (threshold m') m'
  80   where
  81 ------------------------------------------------------------------------
  82     -- | Main Operations
  83     -- x' = x / (sum Col x)
  84     x' = proba Col m
  85
  86 ------------------------------------------------------------------------
  87     -- xs = (sum Col x') - x'
  88     xs = distFromSum Col x'
  89     -- ys = (sum Row x') - x'
  90     ys = distFromSum Row x'
  91
  92 ------------------------------------------------------------------------
  93 --  | Top included or excluded
  94     ie = opWith (+) xs ys
  95 --  ie = ( xs + ys) / (2 * (x.shape[0] - 1))
  96
  97 --  | Top specific or generic
  98     sg = opWith (-) xs ys
  99 --  sg = ( xs - ys) / (2 * (x.shape[0] - 1))
 100
 101     nodes_kept :: [Int]
 102     nodes_kept = take k' $ S.toList
 103                          $ foldl' (\s (n1,n2) -> insert [n1,n2] s) S.empty
 104                          $ map fst
 105                          $ nodes_included k <> nodes_specific k
 106
 107     nodes_included n = take n $ sortOn snd $ toListsWithIndex ie
 108     nodes_specific n = take n $ sortOn snd $ toListsWithIndex sg
 109     insert as s = foldl' (\s' a -> S.insert a s') s as
 110     k' = 2*k
 111     k = 10
 112
 113     dico_nodes :: Map Int Int
 114     dico_nodes     = M.fromList $ zip ([1..] :: [Int]) nodes_kept
 115     --dico_nodes_rev = M.fromList $ zip nodes_kept [1..]
 116
 117     m' = matrix (length nodes_kept)
 118                 (length nodes_kept)
 119                 (\(i,j) -> getElem ((M.!) dico_nodes i) ((M.!) dico_nodes j) x')
 120
 121     threshold m'' = V.minimum
 122                   $ V.map (\cId -> V.maximum $ getCol cId m'')
 123                           (V.enumFromTo 1 (nOf Col m'')      )
 124
 125     filterMat t m''  = mapAll (\x -> filter' t x) m''
 126       where
 127         filter' t' x = case (x >= t') of
 128                         True  -> x
 129                         False -> 0
 130 ------------------------------------------------------------------------