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