]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Core/Viz/Graph/Index.hs
Merge branch 'dev-phylo-merge' of https://gitlab.iscpif.fr/gargantext/haskell-gargant...
[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 qualified Data.Array.Accelerate as A
28 import qualified Data.Array.Accelerate.Interpreter as A
29 import Data.Array.Accelerate (Matrix, Elt, Shape, (:.)(..), Z(..))
30
31 import Data.Maybe (fromMaybe)
32
33 import Data.Set (Set)
34 import qualified Data.Set as S
35
36 import Data.Map (Map)
37 import qualified Data.Map.Strict as M
38
39 -- import Data.Vector (Vector)
40
41 import Gargantext.Prelude
42
43 type Index = Int
44
45 -------------------------------------------------------------------------------
46 -------------------------------------------------------------------------------
47 score :: (Ord t) => (A.Matrix Int -> A.Matrix Double)
48 -> Map (t, t) Int
49 -> Map (t, t) Double
50 score f m = fromIndex fromI . mat2map . f $ cooc2mat toI m
51 where
52 (toI, fromI) = createIndices m
53
54 -------------------------------------------------------------------------------
55 -------------------------------------------------------------------------------
56 cooc2mat :: Ord t => Map t Index -> Map (t, t) Int -> Matrix Int
57 cooc2mat ti m = map2mat 0 n idx
58 where
59 n = M.size ti
60 idx = toIndex ti m -- it is important to make sure that toIndex is ran only once.
61
62 map2mat :: Elt a => a -> Int -> Map (Index, Index) a -> Matrix a
63 map2mat def n m = A.fromFunction shape (\(Z :. x :. y) -> fromMaybe def $ M.lookup (x, y) m)
64 where
65 shape = (Z :. n :. n)
66
67 mat2map :: (Elt a, Shape (Z :. Index)) =>
68 A.Array (Z :. Index :. Index) a -> Map (Index, Index) a
69 mat2map m = M.fromList . map f . A.toList . A.run . A.indexed $ A.use m
70 where
71 -- Z :. _ :. n = A.arrayShape m
72 f ((Z :. i :. j), x) = ((i, j), x)
73
74 -------------------------------------------------------------------------------
75 -------------------------------------------------------------------------------
76 toIndex :: Ord t => Map t Index -> Map (t,t) a -> Map (Index,Index) a
77 toIndex ni ns = indexConversion ni ns
78
79 fromIndex :: Ord t => Map Index t -> Map (Index, Index) a -> Map (t,t) a
80 fromIndex ni ns = indexConversion ni ns
81
82 indexConversion :: (Ord b, Ord k) => Map k b -> Map (k,k) a -> Map (b, b) a
83 indexConversion index ms = M.fromList $ map (\((k1,k2),c) -> ( ((M.!) index k1, (M.!) index k2), c)) (M.toList ms)
84 ---------------------------------------------------------------------------------
85
86 -------------------------------------------------------------------------------
87 --fromIndex' :: Ord t => Vector t -> Map (Index, Index) a -> Map (t,t) a
88 --fromIndex' vi ns = undefined
89
90 -- TODO: returing a Vector should be faster than a Map
91 -- createIndices' :: Ord t => Map (t, t) b -> (Map t Index, Vector t)
92 -- createIndices' = undefined
93
94 createIndices :: Ord t => Map (t, t) b -> (Map t Index, Map Index t)
95 createIndices = set2indices . map2set
96 where
97 map2set :: Ord t => Map (t, t) a -> Set t
98 map2set cs' = foldl' (\s ((t1,t2),_) -> insert [t1,t2] s ) S.empty (M.toList cs')
99 where
100 insert as s = foldl' (\s' t -> S.insert t s') s as
101
102 set2indices :: Ord t => Set t -> (Map t Index, Map Index t)
103 set2indices s = (M.fromList toIndex', M.fromList fromIndex')
104 where
105 fromIndex' = zip [0..] xs
106 toIndex' = zip xs [0..]
107 xs = S.toList s
108
109