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
12 {-# LANGUAGE NoImplicitPrelude #-}
13 {-# LANGUAGE OverloadedStrings #-}
15 module Gargantext.Viz.Graph.Tools
18 import Debug.Trace (trace)
19 import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
20 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
22 import qualified Data.Set as Set
23 import Data.Text (Text)
24 import Gargantext.Prelude
25 import Gargantext.Core.Statistics
26 import Gargantext.Viz.Graph
27 import Gargantext.Viz.Graph.Bridgeness (bridgeness)
28 import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
29 import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
30 import Gargantext.Viz.Graph.IGraph (mkGraphUfromEdges)
31 import Gargantext.Viz.Graph.Proxemy (confluence)
32 import GHC.Float (sin, cos)
33 import qualified IGraph as Igraph
34 import qualified IGraph.Algorithms.Layout as Layout
35 import qualified Data.Vector.Storable as Vec
36 import qualified Data.Map as Map
37 import qualified Data.List as List
39 type Threshold = Double
42 cooc2graph' :: Ord t => Double
44 -> Map (Index, Index) Double
45 cooc2graph' threshold myCooc = distanceMap
47 (ti, _) = createIndices myCooc
48 myCooc' = toIndex ti myCooc
49 matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
50 distanceMat = measureConditional matCooc
51 distanceMap = Map.filter (> threshold) $ mat2map distanceMat
54 cooc2graph :: Threshold
55 -> (Map (Text, Text) Int)
57 cooc2graph threshold myCooc = do
58 let (ti, _) = createIndices myCooc
59 myCooc' = toIndex ti myCooc
60 matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
61 distanceMat = measureConditional matCooc
62 distanceMap = Map.filter (> threshold) $ mat2map distanceMat
64 let nodesApprox :: Int
67 (as, bs) = List.unzip $ Map.keys distanceMap
68 n' = Set.size $ Set.fromList $ as <> bs
69 ClustersParams rivers level = {-trace ("nodesApprox: " <> show nodesApprox) $-} clustersParams nodesApprox
72 partitions <- case Map.size distanceMap > 0 of
73 True -> trace ("level" <> show level) $ cLouvain level distanceMap
74 False -> panic "Text.Flow: DistanceMap is empty"
76 let bridgeness' = {-trace ("rivers: " <> show rivers) $-}
77 bridgeness rivers partitions distanceMap
79 let confluence' = confluence (Map.keys bridgeness') 3 True False
81 data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
84 data ClustersParams = ClustersParams { bridgness :: Double
88 clustersParams :: Int -> ClustersParams
89 clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
91 y | x < 100 = "0.000001"
92 | x < 350 = "0.000001"
93 | x < 500 = "0.000001"
94 | x < 1000 = "0.000001"
98 ----------------------------------------------------------
99 -- | From data to Graph
100 data2graph :: [(Text, Int)]
101 -> Map (Int, Int) Int
102 -> Map (Int, Int) Double
103 -> Map (Int, Int) Double
106 data2graph labels coocs bridge conf partitions = do
108 let community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
110 nodes <- mapM (setCoord ForceAtlas labels bridge)
111 [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
112 , node_type = Terms -- or Unknown
113 , node_id = cs (show n)
118 Attributes { clust_default = maybe 0 identity
119 (Map.lookup n community_id_by_node_id) } }
122 , Set.member n $ Set.fromList
124 $ map (\((s,t),d) -> if d > 0 && s /=t then [s,t] else [])
128 let edges = [ Edge { edge_source = cs (show s)
129 , edge_target = cs (show t)
131 , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
132 -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
133 , edge_id = cs (show i) }
134 | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
137 pure $ Graph nodes edges Nothing
139 ------------------------------------------------------------------------
141 data Layout = KamadaKawai | ACP | ForceAtlas
144 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
145 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
151 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> IO Node
152 setCoord l labels m (n,node) = getCoord l labels m n
153 >>= \(x,y) -> pure $ node { node_x_coord = x
158 getCoord :: Ord a => Layout
159 -> [(a, Int)] -> Map (Int, Int) Double -> Int -> IO (Double, Double)
160 getCoord KamadaKawai _ m n = layout m n
162 getCoord ForceAtlas _ _ n = pure (sin d, cos d)
166 getCoord ACP labels m n = pure $ to2d $ maybe (panic "Graph.Tools no coordinate") identity
168 $ pcaReduceTo (Dimension 2)
171 to2d :: Vec.Vector Double -> (Double, Double)
174 ds = take 2 $ Vec.toList v
178 mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
179 mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
183 toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
184 toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
185 ------------------------------------------------------------------------
187 -- | KamadaKawai Layout
188 -- TODO TEST: check labels, nodeId and coordinates
189 layout :: Map (Int, Int) Double -> Int -> IO (Double, Double)
190 layout m n = maybe (panic "") identity <$> Map.lookup n <$> coord
192 coord :: IO (Map Int (Double,Double))
193 coord = Map.fromList <$> List.zip (Igraph.nodes g) <$> (Layout.getLayout g p)
194 --p = Layout.defaultLGL
195 p = Layout.defaultKamadaKawai
196 g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m