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