]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Graph/Tools.hs
[FIX name] GraphTerm -> MapTerm
[gargantext.git] / src / Gargantext / Viz / Graph / Tools.hs
1 {-|
2 Module : Gargantext.Viz.Graph.Tools
3 Description : Tools to build Graph
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
13 module Gargantext.Viz.Graph.Tools
14 where
15
16 import Debug.Trace (trace)
17 import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
18 -- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
19 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
20 import Data.Map (Map)
21 import qualified Data.Set as Set
22 import Data.Text (Text)
23 import Gargantext.Prelude
24 import Gargantext.Core.Statistics
25 import Gargantext.Viz.Graph
26 import Gargantext.Viz.Graph.Bridgeness (bridgeness)
27 import Gargantext.Viz.Graph.Distances (Distance(..), measure)
28 import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
29 import Gargantext.Viz.Graph.IGraph (mkGraphUfromEdges)
30 import Gargantext.Viz.Graph.Proxemy (confluence)
31 import GHC.Float (sin, cos)
32 import qualified IGraph as Igraph
33 import qualified IGraph.Algorithms.Layout as Layout
34 import qualified Data.Vector.Storable as Vec
35 import qualified Data.Map as Map
36 import qualified Data.List as List
37
38 type Threshold = Double
39
40
41 cooc2graph' :: Ord t => Distance
42 -> Double
43 -> Map (t, t) Int
44 -> Map (Index, Index) Double
45 cooc2graph' distance threshold myCooc = distanceMap
46 where
47 (ti, _) = createIndices myCooc
48 myCooc' = toIndex ti myCooc
49 matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
50 distanceMat = measure distance matCooc
51 distanceMap = Map.filter (> threshold) $ mat2map distanceMat
52
53
54 cooc2graph :: Distance
55 -> Threshold
56 -> (Map (Text, Text) Int)
57 -> IO Graph
58 cooc2graph distance threshold myCooc = do
59 let
60 (ti, _) = createIndices myCooc
61 myCooc' = toIndex ti myCooc
62 matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
63 distanceMat = measure distance matCooc
64 distanceMap = Map.filter (> threshold) $ mat2map distanceMat
65
66 nodesApprox :: Int
67 nodesApprox = n'
68 where
69 (as, bs) = List.unzip $ Map.keys distanceMap
70 n' = Set.size $ Set.fromList $ as <> bs
71 ClustersParams rivers level = clustersParams nodesApprox
72
73
74 partitions <- if (Map.size distanceMap > 0)
75 -- then iLouvainMap 100 10 distanceMap
76 -- then hLouvain distanceMap
77 then cLouvain level distanceMap
78 else panic "Text.Flow: DistanceMap is empty"
79
80 let
81 -- bridgeness' = distanceMap
82 bridgeness' = trace ("Rivers: " <> show rivers) $ bridgeness rivers partitions distanceMap
83 confluence' = confluence (Map.keys bridgeness') 3 True False
84
85 pure $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
86
87
88
89 data ClustersParams = ClustersParams { bridgness :: Double
90 , louvain :: Text
91 } deriving (Show)
92
93 clustersParams :: Int -> ClustersParams
94 clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
95 {- where
96 y | x < 100 = "0.000001"
97 | x < 350 = "0.000001"
98 | x < 500 = "0.000001"
99 | x < 1000 = "0.000001"
100 | otherwise = "1"
101 -}
102
103 ----------------------------------------------------------
104 -- | From data to Graph
105 data2graph :: [(Text, Int)]
106 -> Map (Int, Int) Int
107 -> Map (Int, Int) Double
108 -> Map (Int, Int) Double
109 -> [LouvainNode]
110 -> Graph
111 data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
112 where
113
114 community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
115
116 nodes = map (setCoord ForceAtlas labels bridge)
117 [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
118 , node_type = Terms -- or Unknown
119 , node_id = cs (show n)
120 , node_label = l
121 , node_x_coord = 0
122 , node_y_coord = 0
123 , node_attributes =
124 Attributes { clust_default = maybe 0 identity
125 (Map.lookup n community_id_by_node_id) } }
126 )
127 | (l, n) <- labels
128 , Set.member n $ Set.fromList
129 $ List.concat
130 $ map (\((s,t),d) -> if d > 0 && s /=t then [s,t] else [])
131 $ Map.toList bridge
132 ]
133
134 edges = [ Edge { edge_source = cs (show s)
135 , edge_target = cs (show t)
136 , edge_weight = d
137 , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
138 -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
139 , edge_id = cs (show i) }
140 | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
141 ]
142
143
144 ------------------------------------------------------------------------
145
146 data Layout = KamadaKawai | ACP | ForceAtlas
147
148
149 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
150 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
151 where
152 (x,y) = f i
153
154
155 -- | ACP
156 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
157 setCoord l labels m (n,node) = node { node_x_coord = x
158 , node_y_coord = y
159 }
160 where
161 (x,y) = getCoord l labels m n
162
163
164 getCoord :: Ord a
165 => Layout
166 -> [(a, Int)]
167 -> Map (Int, Int) Double
168 -> Int
169 -> (Double, Double)
170 getCoord KamadaKawai _ _m _n = undefined -- layout m n
171
172 getCoord ForceAtlas _ _ n = (sin d, cos d)
173 where
174 d = fromIntegral n
175
176 getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") identity
177 $ Map.lookup n
178 $ pcaReduceTo (Dimension 2)
179 $ mapArray labels m
180 where
181 to2d :: Vec.Vector Double -> (Double, Double)
182 to2d v = (x',y')
183 where
184 ds = take 2 $ Vec.toList v
185 x' = head' "to2d" ds
186 y' = last' "to2d" ds
187
188 mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
189 mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
190 where
191 ns = map snd items
192
193 toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
194 toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
195 ------------------------------------------------------------------------
196
197 -- | KamadaKawai Layout
198 -- TODO TEST: check labels, nodeId and coordinates
199 layout :: Map (Int, Int) Double -> Int -> IO (Double, Double)
200 layout m n = maybe (panic "") identity <$> Map.lookup n <$> coord
201 where
202 coord :: IO (Map Int (Double,Double))
203 coord = Map.fromList <$> List.zip (Igraph.nodes g) <$> (Layout.getLayout g p)
204 --p = Layout.defaultLGL
205 p = Layout.defaultKamadaKawai
206 g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
207