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