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