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