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.Utils (LouvainNode(..))
  19 import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
  20 -- import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
  21 import Data.Map (Map)
  22 import qualified Data.Set as Set
  23 import Data.Text (Text)
  24 import Gargantext.Prelude
  25 import Gargantext.Core.Statistics
  26 import Gargantext.Viz.Graph
  27 import Gargantext.Viz.Graph.Bridgeness (bridgeness)
  28 import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
  29 import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
  30 import Gargantext.Viz.Graph.IGraph (mkGraphUfromEdges)
  31 import Gargantext.Viz.Graph.Proxemy (confluence)
  32 import GHC.Float (sin, cos)
  33 import qualified IGraph as Igraph
  34 import qualified IGraph.Algorithms.Layout as Layout
  35 import qualified Data.Vector.Storable as Vec
  36 import qualified Data.Map  as Map
  37 import qualified Data.List as List
  38
  39 type Threshold = Double
  40
  41
  42 cooc2graph' :: Ord t => Double
  43                      -> Map (t, t) Int
  44                      -> Map (Index, Index) Double
  45 cooc2graph' threshold myCooc = distanceMap
  46   where
  47     (ti, _) = createIndices myCooc
  48     myCooc' = toIndex ti myCooc
  49     matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
  50     distanceMat = measureConditional matCooc
  51     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
  52
  53
  54 cooc2graph :: Threshold
  55            -> (Map (Text, Text) Int)
  56            -> Graph
  57 cooc2graph threshold myCooc = data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
  58   where
  59     (ti, _) = createIndices myCooc
  60     myCooc' = toIndex ti myCooc
  61     matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
  62     distanceMat = measureConditional matCooc
  63     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
  64
  65     nodesApprox :: Int
  66     nodesApprox = n'
  67       where
  68         (as, bs) = List.unzip $ Map.keys distanceMap
  69         n' = Set.size $ Set.fromList $ as <> bs
  70     ClustersParams rivers _level = clustersParams nodesApprox
  71
  72     partitions = if (Map.size distanceMap > 0)
  73         --then iLouvainMap 100 10 distanceMap
  74         then hLouvain distanceMap
  75         else panic "Text.Flow: DistanceMap is empty"
  76         -- True  -> trace ("level" <> show level) $ cLouvain level distanceMap
  77
  78     bridgeness' = bridgeness rivers partitions distanceMap
  79
  80     confluence' = confluence (Map.keys bridgeness') 3 True False
  81
  82
  83
  84
  85
  86
  87
  88 data ClustersParams = ClustersParams { bridgness :: Double
  89                                      , louvain   :: Text
  90                                      } deriving (Show)
  91
  92 clustersParams :: Int -> ClustersParams
  93 clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
  94   {- where
  95     y | x < 100  = "0.000001"
  96       | x < 350  = "0.000001"
  97       | x < 500  = "0.000001"
  98       | x < 1000 = "0.000001"
  99       | otherwise = "1"
 100  -}
 101
 102 ----------------------------------------------------------
 103 -- | From data to Graph
 104 data2graph :: [(Text, Int)]
 105            -> Map (Int, Int) Int
 106            -> Map (Int, Int) Double
 107            -> Map (Int, Int) Double
 108            -> [LouvainNode]
 109            -> Graph
 110 data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
 111   where
 112
 113     community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
 114
 115     nodes = map (setCoord ForceAtlas labels bridge)
 116           [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
 117                    , node_type = Terms -- or Unknown
 118                    , node_id    = cs (show n)
 119                    , node_label = l
 120                    , node_x_coord = 0
 121                    , node_y_coord = 0
 122                    , node_attributes =
 123                      Attributes { clust_default = maybe 0 identity
 124                                 (Map.lookup n community_id_by_node_id) } }
 125                )
 126             | (l, n) <- labels
 127             , Set.member n $ Set.fromList
 128                            $ List.concat
 129                            $ map (\((s,t),d) -> if d > 0 && s /=t then [s,t] else [])
 130                            $ Map.toList bridge
 131             ]
 132
 133     edges = [ Edge { edge_source = cs (show s)
 134                        , edge_target = cs (show t)
 135                        , edge_weight =  d
 136                        , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
 137                    -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
 138                    , edge_id     = cs (show i) }
 139                    | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
 140                    ]
 141
 142
 143 ------------------------------------------------------------------------
 144
 145 data Layout = KamadaKawai | ACP | ForceAtlas
 146
 147
 148 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
 149 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
 150   where
 151     (x,y) = f i
 152
 153
 154 -- | ACP
 155 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
 156 setCoord l labels m (n,node) = node { node_x_coord = x
 157                                     , node_y_coord = y
 158                                     }
 159   where
 160     (x,y) = getCoord l labels m n
 161
 162
 163 getCoord :: Ord a => Layout
 164                   -> [(a, Int)] -> Map (Int, Int) Double -> Int -> (Double, Double)
 165 getCoord KamadaKawai _ _m _n = undefined -- layout m n
 166
 167 getCoord ForceAtlas _ _ n = (sin d, cos d)
 168   where
 169     d = fromIntegral n
 170
 171 getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") identity
 172              $ Map.lookup n
 173              $ pcaReduceTo (Dimension 2)
 174              $ mapArray labels m
 175   where
 176     to2d :: Vec.Vector Double -> (Double, Double)
 177     to2d v  = (x',y')
 178       where
 179         ds = take 2 $ Vec.toList v
 180         x'  = head' "to2d" ds
 181         y'  = last' "to2d" ds
 182
 183     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 184     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 185       where
 186         ns = map snd items
 187
 188     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 189     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 190 ------------------------------------------------------------------------
 191
 192 -- | KamadaKawai Layout
 193 -- TODO TEST: check labels, nodeId and coordinates
 194 layout :: Map (Int, Int) Double -> Int -> IO (Double, Double)
 195 layout m n = maybe (panic "") identity <$> Map.lookup n <$> coord
 196   where
 197     coord :: IO (Map Int (Double,Double))
 198     coord = Map.fromList <$> List.zip (Igraph.nodes g) <$> (Layout.getLayout g p)
 199     --p = Layout.defaultLGL
 200     p = Layout.defaultKamadaKawai
 201     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
 202