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 Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
  19 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
  20 import Data.Map (Map)
  21 import qualified Data.Set as Set
  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 (> 1) 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             , Set.member n $ Set.fromList
  85                            $ List.concat
  86                            $ map (\((s,t),d) -> if d > 0 && s /=t then [s,t] else [])
  87                            $ Map.toList bridge
  88             ]
  89
  90     let edges = [ Edge { edge_source = cs (show s)
  91                        , edge_target = cs (show t)
  92                        , edge_weight =  d
  93                        , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
  94                    -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
  95                    , edge_id     = cs (show i) }
  96                    | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
  97                    ]
  98
  99     pure $ Graph nodes edges Nothing
 100
 101 ------------------------------------------------------------------------
 102
 103 data Layout = KamadaKawai | ACP | ForceAtlas
 104
 105
 106 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
 107 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
 108   where
 109     (x,y) = f i
 110
 111
 112 -- | ACP
 113 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> IO Node
 114 setCoord l labels m (n,node) = getCoord l labels m n
 115                            >>= \(x,y) -> pure $ node { node_x_coord = x
 116                                                      , node_y_coord = y
 117                                                      }
 118
 119
 120 getCoord :: Ord a => Layout
 121                   -> [(a, Int)] -> Map (Int, Int) Double -> Int -> IO (Double, Double)
 122 getCoord KamadaKawai _ m n = layout m n
 123
 124 getCoord ForceAtlas _ _ n = pure (sin d, cos d)
 125   where
 126     d = fromIntegral n
 127
 128 getCoord ACP labels m n = pure $ to2d $ maybe (panic "Graph.Tools no coordinate") identity
 129              $ Map.lookup n
 130              $ pcaReduceTo (Dimension 2)
 131              $ mapArray labels m
 132   where
 133     to2d :: Vec.Vector Double -> (Double, Double)
 134     to2d v  = (x',y')
 135       where
 136         ds = take 2 $ Vec.toList v
 137         x'  = head' "to2d" ds
 138         y'  = last' "to2d" ds
 139
 140     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 141     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 142       where
 143         ns = map snd items
 144
 145     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 146     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 147 ------------------------------------------------------------------------
 148
 149 -- | KamadaKawai Layout
 150 -- TODO TEST: check labels, nodeId and coordinates
 151 layout :: Map (Int, Int) Double -> Int -> IO (Double, Double)
 152 layout m n = maybe (panic "") identity <$> Map.lookup n <$> coord
 153   where
 154     coord :: IO (Map Int (Double,Double))
 155     coord = Map.fromList <$> List.zip (Igraph.nodes g) <$> (Layout.getLayout g p)
 156     --p = Layout.defaultLGL
 157     p = Layout.defaultKamadaKawai
 158     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
 159