src/Gargantext/Graph/Utils.hs

   1 {-|
   2 Module      : Gargantext.Graph.Distances.Utils
   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 -}
  11
  12 {-# LANGUAGE BangPatterns      #-}
  13 {-# LANGUAGE NoImplicitPrelude #-}
  14 {-# LANGUAGE FlexibleContexts  #-}
  15 {-# LANGUAGE Strict            #-}
  16
  17 module Gargantext.Graph.Utils
  18   where
  19
  20 import Data.Matrix hiding (identity)
  21
  22 import Data.Map (Map)
  23 import qualified Data.Map    as M
  24
  25 import Data.Set (Set)
  26 import qualified Data.Set    as S
  27
  28 import Data.Vector (Vector)
  29 import qualified Data.Vector as V
  30
  31 import qualified Data.List   as L
  32 import Gargantext.Prelude
  33
  34 ------------------------------------------------------------------------
  35
  36 type Distance = Double
  37 type Cooc     = Int
  38 type NgramId  = Int
  39 type Index    = Int
  40
  41 -- Type Families
  42 --type Matrix' Index a
  43 --type Matrix' NgramId a
  44
  45 data Matrice a = Matrice { matrice_fromIndex :: !(Map Index NgramId)
  46                          , matrice_toIndex   :: !(Map NgramId Index)
  47                          , matrice           :: !(Matrix a)
  48                          } deriving (Show)
  49
  50 --fromMatrice :: Matrice Double -> [(NgramId, NgramId, Double)]
  51 --fromMatrice m = undefined
  52
  53
  54 toMatrice :: [(NgramId, NgramId, Int)] -> Matrice Double
  55 toMatrice ns = Matrice fromIndx toIndx m
  56   where
  57     s   = cooc2set ns
  58     (fromIndx, toIndx) = set2indexes s
  59     n   = (length (S.toList s))
  60     idx = toIndex toIndx ns
  61     m   = matrix n n (\x -> maybe 0 identity (fromIntegral <$> M.lookup x idx))
  62
  63 -------------------------------------------------------------------------------
  64 -------------------------------------------------------------------------------
  65 toIndex :: Map NgramId Index -> [(NgramId, NgramId, a)] -> Map (Index,Index) a
  66 toIndex ni ns = to ni ns
  67
  68 fromIndex :: Map Index NgramId -> [(Index, Index, a)] -> Map (NgramId,NgramId) a
  69 fromIndex ni ns = to ni ns
  70 -------------------------------------------------------------------------------
  71 to :: (Ord b, Ord k) => Map k b -> [(k, k, a)] -> Map (b, b) a
  72 to index ns = M.fromList $ map (\(a1,a2,c) -> ( ( (M.!) index a1
  73                                                 , (M.!) index a2
  74                                                 )
  75                                               , c
  76                                               )
  77                                  ) ns
  78
  79 -------------------------------------------------------------------------------
  80 cooc2set :: [(NgramId, NgramId, a)] -> Set NgramId
  81 cooc2set cs' = foldl' (\s (a1,a2,_) -> insert [a1,a2] s ) S.empty cs'
  82   where
  83     insert as s = foldl' (\s' a -> S.insert a s') s as
  84
  85
  86 set2indexes :: Set NgramId -> (Map Index NgramId, Map NgramId Index)
  87 set2indexes s = (M.fromList fromIndex', M.fromList toIndex')
  88   where
  89     s' = S.toList s
  90     fromIndex' = zip [1..] s'
  91     toIndex'   = zip  s'  [1..]
  92
  93
  94 ------------------------------------------------------------------------
  95 -- Data.Vector.Additions
  96 dropAt :: Int -> Vector a -> Vector a
  97 dropAt n v = debut <> (V.tail fin)
  98   where
  99     debut = V.take n v
 100     fin   = V.drop n v
 101
 102 ------------------------------------------------------------------------
 103 data Axis = Col | Row
 104 ---- | Matrix Algebra
 105 --data Algebra a = Point a | Vector a | Matrix a
 106 --
 107 --multiply :: Algebra a -> Matrix a -> Matrix a
 108 --multiply (Point  a) = undefined
 109 --multiply (Vector a) = undefined
 110 --multiply (Matrix a) = undefined
 111 --
 112 --div :: Fractional a => Matrix a -> Matrix a
 113 --div m = foldl' (\m c -> divCol c m) m [1.. (ncols m)]
 114 --  where
 115 --    divCol c m = mapCol (\_ x -> 1/x) c m
 116 --
 117 --divide :: Fractional a => Matrix a -> Matrix a -> Matrix a
 118 --divide a b = a `multStd` (div b)
 119
 120 total :: Num a => Matrix a -> a
 121 total m = V.sum $ V.map (\c -> V.sum (getCol c m)) (V.enumFromTo 1 (nOf Col m))
 122
 123 ------------------------------------------------------------------------
 124 -- | Matrix functions
 125
 126 type AxisId = Int
 127
 128 nOf :: Axis -> Matrix a -> Int
 129 nOf Row = nrows
 130 nOf Col = ncols
 131
 132 axis :: Axis -> AxisId -> Matrix a -> Vector a
 133 axis Col = getCol
 134 axis Row = getRow
 135
 136 --mapOn' :: Axis -> (a -> a) -> Matrix a -> Matrix a
 137 --mapOn' a f m = foldl' (\m' aId -> mapOn a (aId f) m') m [1.. (nOf a m)]
 138
 139 mapOn :: Axis -> (AxisId -> a -> a) -> Matrix a -> Matrix a
 140 mapOn a f m = V.foldl' f'  m (V.enumFromTo 1 (nOf a m))
 141   where
 142     f' m' c = mapOnly a f c m'
 143
 144 mapOnly :: Axis -> (AxisId -> a -> a) -> AxisId -> Matrix a -> Matrix a
 145 mapOnly Col = mapCol
 146 mapOnly Row = mapRow
 147
 148 mapAll :: (a -> a) -> Matrix a -> Matrix a
 149 mapAll f m = mapOn Col (\_ -> f) m
 150
 151
 152 toListsWithIndex :: Matrix a ->  [((Int, Int), a)]
 153 toListsWithIndex m = concat' $ zip [1..] $ map (\c -> zip [1..] c) $ toLists m
 154   where
 155     concat' :: [(Int, [(Int, a)])] -> [((Int, Int), a)]
 156     concat' xs = L.concat $ map (\(x, ys) -> map (\(y, a) -> ((x,y), a)) ys ) xs
 157
 158
 159
 160 -- | For tests only, to be removed
 161 m1 :: Matrix Double
 162 m1 = fromList 300 300 [1..]
 163