]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Core/Viz/Graph/Index.hs
Merge branch '90-dev-hal-fixes' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell...
[gargantext.git] / src / Gargantext / Core / Viz / Graph / Index.hs
1 {-|
2 Module : Gargantext.Graph.Distances.Utils
3 Description : Tools to compute distances from Cooccurrences
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Basically @compute@ takes an accelerate function as first input, a Map
11 of coccurrences as second input and outputs a Map automatically using
12 indexes.
13
14 TODO:
15 --cooc2fgl :: Ord t, Integral n => Map (t, t) n -> Graph
16 --fgl2json
17
18 -}
19
20 {-# LANGUAGE BangPatterns #-}
21 {-# LANGUAGE TypeOperators #-}
22 {-# LANGUAGE MonoLocalBinds #-}
23
24 module Gargantext.Core.Viz.Graph.Index
25 where
26
27 import Data.Array.Accelerate (Matrix, Elt, Shape, (:.)(..), Z(..))
28 import Data.Map (Map)
29 import Data.Maybe (fromMaybe, catMaybes)
30 import Data.Set (Set)
31 import Gargantext.Prelude
32 import qualified Data.Array.Accelerate as A
33 import qualified Data.Array.Accelerate.Interpreter as A
34 import qualified Data.Map.Strict as M
35 import qualified Data.Set as S
36 import qualified Data.List as L
37
38 type Index = Int
39
40 -------------------------------------------------------------------------------
41 -------------------------------------------------------------------------------
42 score :: (Ord t) => MatrixShape
43 -> (A.Matrix Int -> A.Matrix Double)
44 -> Map (t, t) Int
45 -> Map (t, t) Double
46 score s f m = fromIndex fromI . mat2map . f $ cooc2mat s toI m
47 where
48 (toI, fromI) = createIndices m
49
50 -------------------------------------------------------------------------------
51 -------------------------------------------------------------------------------
52 cooc2mat :: Ord t => MatrixShape -> Map t Index -> Map (t, t) Int -> Matrix Int
53 cooc2mat sym ti m = map2mat sym 0 n idx
54 where
55 n = M.size ti
56 idx = toIndex ti m -- it is important to make sure that toIndex is ran only once.
57
58 data MatrixShape = Triangle | Square
59
60 map2mat :: Elt a => MatrixShape -> a -> Int -> Map (Index, Index) a -> Matrix a
61 map2mat sym def n m = A.fromFunction shape getData
62 where
63 getData = (\(Z :. x :. y) ->
64 case sym of
65 Triangle -> fromMaybe def (M.lookup (x,y) m)
66 Square -> fromMaybe (fromMaybe def $ M.lookup (y,x) m)
67 $ M.lookup (x,y) m
68 )
69 shape = (Z :. n :. n)
70
71 mat2map :: (Elt a, Shape (Z :. Index)) =>
72 A.Array (Z :. Index :. Index) a -> Map (Index, Index) a
73 mat2map m = M.fromList . map f . A.toList . A.run . A.indexed $ A.use m
74 where
75 -- Z :. _ :. n = A.arrayShape m
76 f ((Z :. i :. j), x) = ((i, j), x)
77
78 -------------------------------------------------------------------------------
79 -------------------------------------------------------------------------------
80 toIndex :: Ord t
81 => Map t Index
82 -> Map (t,t) a
83 -> Map (Index,Index) a
84 toIndex = indexConversion
85
86 fromIndex :: Ord t => Map Index t -> Map (Index, Index) a -> Map (t,t) a
87 fromIndex ni ns = indexConversion ni ns
88
89 indexConversion :: (Ord b, Ord k) => Map k b -> Map (k,k) a -> Map (b, b) a
90 indexConversion index ms = M.fromList
91 $ catMaybes
92 $ map (\((k1,k2),c) -> ((,) <$> ((,) <$> M.lookup k1 index <*> M.lookup k2 index)
93 <*> Just c)
94 )
95 $ M.toList ms
96
97
98 ------------------------------------------------------------------------
99 ------------------------------------------------------------------------
100
101 --fromIndex' :: Ord t => Vector t -> Map (Index, Index) a -> Map (t,t) a
102 --fromIndex' vi ns = undefined
103
104 -- TODO: returning a Vector should be faster than a Map
105 -- createIndices' :: Ord t => Map (t, t) b -> (Map t Index, Vector t)
106 -- createIndices' = undefined
107
108 createIndices :: Ord t => Map (t, t) b -> (Map t Index, Map Index t)
109 createIndices = set2indices . map2set
110 where
111 map2set :: Ord t => Map (t, t) a -> Set t
112 map2set cs' = foldl' (\s ((t1,t2),_) -> insert [t1,t2] s ) S.empty (M.toList cs')
113 where
114 insert as s = foldl' (\s' t -> S.insert t s') s as
115
116 set2indices :: Ord t => Set t -> (Map t Index, Map Index t)
117 set2indices s = (M.fromList toIndex', M.fromList fromIndex')
118 where
119 fromIndex' = zip [0..] xs
120 toIndex' = zip xs [0..]
121 xs = S.toList s
122
123 ------------------------------------------------------------------------
124 ------------------------------------------------------------------------
125
126 testIndices :: Bool
127 testIndices = myMap == ( M.filter (>0) myMap')
128 where
129 xy = L.zip ([0..30]:: [Int]) ([0..30]:: [Int])
130 myMap = M.fromList $ L.zip xy ([1..]:: [Int])
131 (ti,it) = createIndices myMap
132 matrix = mat2map $ map2mat Square 0 (M.size ti) $ toIndex ti myMap
133 myMap' = fromIndex it matrix
134
135
136