]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Graph/Tools.hs
fix the diagonal issue
[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 {-# LANGUAGE NoImplicitPrelude #-}
14 {-# LANGUAGE OverloadedStrings #-}
15
16 module Gargantext.Viz.Graph.Tools
17 where
18
19 import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
20 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
21 import Data.Map (Map)
22 import Data.Text (Text)
23 import Gargantext.Prelude
24 import Gargantext.Viz.Graph (Graph(..))
25 import Gargantext.Viz.Graph -- (Graph(..))
26 import Gargantext.Viz.Graph.Bridgeness (bridgeness)
27 import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
28 import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map)
29 import qualified Data.Map as Map
30
31 cooc2graph :: (Map (Text, Text) Int) -> IO Graph
32 cooc2graph myCooc = do
33 let (ti, _) = createIndices myCooc
34 myCooc4 = toIndex ti myCooc
35 matCooc = map2mat (0) (Map.size ti) myCooc4
36 distanceMat = measureConditional matCooc
37 distanceMap = Map.map (\_ -> 1) $ Map.filter (>0) $ mat2map distanceMat
38
39 partitions <- case Map.size distanceMap > 0 of
40 True -> cLouvain distanceMap
41 False -> panic "Text.Flow: DistanceMap is empty"
42
43 let distanceMap' = bridgeness 300 partitions distanceMap
44
45 pure $ data2graph (Map.toList ti) myCooc4 distanceMap' partitions
46
47
48 ----------------------------------------------------------
49 -- | From data to Graph
50 -- FIXME: distance should not be a map since we just "toList" it (same as cLouvain)
51 data2graph :: [(Text, Int)] -> Map (Int, Int) Int
52 -> Map (Int, Int) Double
53 -> [LouvainNode]
54 -> Graph
55 data2graph labels coocs distance partitions = Graph nodes edges Nothing
56 where
57 community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
58 nodes = [ Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
59 , node_type = Terms -- or Unknown
60 , node_id = cs (show n)
61 , node_label = l
62 , node_attributes =
63 Attributes { clust_default = maybe 0 identity
64 (Map.lookup n community_id_by_node_id) } }
65 | (l, n) <- labels ]
66 edges = [ Edge { edge_source = cs (show s)
67 , edge_target = cs (show t)
68 , edge_weight = w
69 , edge_id = cs (show i) }
70 | (i, ((s,t), w)) <- zip ([0..]::[Integer]) (Map.toList distance) ]
71
72