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 {-# LANGUAGE NoImplicitPrelude           #-}
  13 {-# LANGUAGE OverloadedStrings           #-}
  14
  15 module Gargantext.Viz.Graph.Tools
  16   where
  17
  18 --import Debug.Trace (trace)
  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.Core.Statistics
  25 import Gargantext.Viz.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 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 cooc2graph :: Threshold
  41            -> (Map (Text, Text) Int)
  42            -> IO Graph
  43 cooc2graph threshold myCooc = do
  44   let (ti, _) = createIndices myCooc
  45       myCooc' = toIndex ti myCooc
  46       matCooc = map2mat 0 (Map.size ti) $ Map.filter (> (round threshold)) myCooc'
  47       distanceMat = measureConditional matCooc
  48       distanceMap = Map.filter (> threshold) $ mat2map distanceMat
  49
  50   partitions <- case Map.size distanceMap > 0 of
  51     True  -> cLouvain distanceMap
  52     False -> panic "Text.Flow: DistanceMap is empty"
  53
  54   let bridgeness' = bridgeness 300 partitions distanceMap
  55   let confluence' = confluence (Map.keys bridgeness') 3 True False
  56
  57   data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
  58
  59
  60 ----------------------------------------------------------
  61 -- | From data to Graph
  62 data2graph :: [(Text, Int)]
  63            -> Map (Int, Int) Int
  64            -> Map (Int, Int) Double
  65            -> Map (Int, Int) Double
  66            -> [LouvainNode]
  67            -> IO Graph
  68 data2graph labels coocs bridge conf partitions = do
  69
  70     let community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
  71
  72     nodes <- mapM (setCoord ForceAtlas labels bridge)
  73           [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
  74                    , node_type = Terms -- or Unknown
  75                    , node_id    = cs (show n)
  76                    , node_label = l
  77                    , node_x_coord = 0
  78                    , node_y_coord = 0
  79                    , node_attributes =
  80                      Attributes { clust_default = maybe 0 identity
  81                                 (Map.lookup n community_id_by_node_id) } }
  82                )
  83             | (l, n) <- labels
  84             ]
  85
  86     let edges = [ Edge { edge_source = cs (show s)
  87                    , edge_target = cs (show t)
  88                    , edge_weight = d
  89                    , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
  90                    -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
  91                    , edge_id     = cs (show i) }
  92                    | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t
  93                    ]
  94
  95     pure $ Graph nodes edges Nothing
  96
  97 ------------------------------------------------------------------------
  98
  99 data Layout = KamadaKawai | ACP | ForceAtlas
 100
 101
 102 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
 103 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
 104   where
 105     (x,y) = f i
 106
 107
 108 -- | ACP
 109 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> IO Node
 110 setCoord l labels m (n,node) = getCoord l labels m n
 111                            >>= \(x,y) -> pure $ node { node_x_coord = x
 112                                                      , node_y_coord = y
 113                                                      }
 114
 115
 116 getCoord :: Ord a => Layout
 117                   -> [(a, Int)] -> Map (Int, Int) Double -> Int -> IO (Double, Double)
 118 getCoord KamadaKawai _ m n = layout m n
 119
 120 getCoord ForceAtlas _ _ n = pure (sin d, cos d)
 121   where
 122     d = fromIntegral n
 123
 124 getCoord ACP labels m n = pure $ to2d $ maybe (panic "Graph.Tools no coordinate") identity
 125              $ Map.lookup n
 126              $ pcaReduceTo (Dimension 2)
 127              $ mapArray labels m
 128   where
 129     to2d :: Vec.Vector Double -> (Double, Double)
 130     to2d v  = (x',y')
 131       where
 132         ds = take 2 $ Vec.toList v
 133         x'  = head' "to2d" ds
 134         y'  = last' "to2d" ds
 135
 136     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 137     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 138       where
 139         ns = map snd items
 140
 141     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 142     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 143 ------------------------------------------------------------------------
 144
 145 -- | KamadaKawai Layout
 146 -- TODO TEST: check labels, nodeId and coordinates
 147 layout :: Map (Int, Int) Double -> Int -> IO (Double, Double)
 148 layout m n = maybe (panic "") identity <$> Map.lookup n <$> coord
 149   where
 150     coord :: IO (Map Int (Double,Double))
 151     coord = Map.fromList <$> List.zip (Igraph.nodes g) <$> (Layout.getLayout g p)
 152     --p = Layout.defaultLGL
 153     p = Layout.defaultKamadaKawai
 154     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
 155