src/Gargantext/Core/Viz/Graph/Tools.hs

   1 {-|
   2 Module      : Gargantext.Core.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
  13 module Gargantext.Core.Viz.Graph.Tools
  14   where
  15
  16 import Debug.Trace (trace)
  17 import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
  18 -- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
  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.Core.Viz.Graph
  26 import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness)
  27 import Gargantext.Core.Viz.Graph.Distances (Distance(..), measure)
  28 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
  29 import Gargantext.Core.Viz.Graph.IGraph (mkGraphUfromEdges)
  30 import Gargantext.Core.Viz.Graph.Proxemy (confluence)
  31 import GHC.Float (sin, cos)
  32 import qualified IGraph as Igraph
  33 import IGraph.Random -- (Gen(..))
  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 -- import Debug.Trace (trace)
  39
  40 type Threshold = Double
  41
  42
  43 cooc2graph' :: Ord t => Distance
  44                      -> Double
  45                      -> Map (t, t) Int
  46                      -> Map (Index, Index) Double
  47 cooc2graph' distance threshold myCooc = distanceMap
  48   where
  49     (ti, _) = createIndices myCooc
  50     myCooc' = toIndex ti myCooc
  51     matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
  52     distanceMat = measure distance matCooc
  53     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
  54
  55
  56 cooc2graph'' :: Ord t => Distance
  57                       -> Double
  58                       -> Map (t, t) Int
  59                       -> Map (Index, Index) Double
  60 cooc2graph'' distance threshold myCooc = neighbouMap
  61   where
  62     (ti, _) = createIndices myCooc
  63     myCooc' = toIndex ti myCooc
  64     matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
  65     distanceMat = measure distance matCooc
  66     neighbouMap = filterByNeighbours threshold
  67                 $ mat2map distanceMat
  68
  69
  70 -- Quentin
  71 filterByNeighbours :: Double -> Map (Index, Index) Double -> Map (Index, Index) Double
  72 filterByNeighbours threshold distanceMap = filteredMap
  73   where
  74     indexes :: [Index]
  75     indexes = List.nub $ List.concat $ map (\(idx,idx') -> [idx,idx'] ) $ Map.keys distanceMap
  76     filteredMap :: Map (Index, Index) Double
  77     filteredMap = Map.fromList
  78                 $ List.concat
  79                 $ map (\idx ->
  80                           let selected = List.reverse
  81                                        $ List.sortOn snd
  82                                        $ Map.toList
  83                                        $ Map.filter (> 0)
  84                                        $ Map.filterWithKey (\(from,_) _ -> idx == from) distanceMap
  85                            in List.take (round threshold) selected
  86                       ) indexes
  87
  88
  89 cooc2graph :: Distance
  90            -> Threshold
  91            -> (Map (Text, Text) Int)
  92            -> IO Graph
  93 cooc2graph distance threshold myCooc = do
  94   printDebug "cooc2graph" distance
  95   let
  96     (ti, _) = createIndices myCooc
  97     myCooc' = toIndex ti myCooc
  98     matCooc = map2mat 0 (Map.size ti)
  99             $ Map.filterWithKey (\(a,b) _ -> a /= b)
 100             $ Map.filter (> 1) myCooc'
 101     distanceMat = measure distance matCooc
 102     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
 103
 104     nodesApprox :: Int
 105     nodesApprox = n'
 106       where
 107         (as, bs) = List.unzip $ Map.keys distanceMap
 108         n' = Set.size $ Set.fromList $ as <> bs
 109     ClustersParams rivers level = clustersParams nodesApprox
 110
 111
 112   partitions <- if (Map.size distanceMap > 0)
 113       -- then iLouvainMap 100 10 distanceMap
 114       -- then hLouvain distanceMap
 115       then cLouvain level distanceMap
 116       else panic "Text.Flow: DistanceMap is empty"
 117
 118   let
 119     -- bridgeness' = distanceMap
 120     bridgeness' = trace ("Rivers: " <> show rivers)
 121                 $ bridgeness rivers partitions distanceMap
 122     confluence' = confluence (Map.keys bridgeness') 3 True False
 123
 124   pure $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
 125
 126
 127
 128 data ClustersParams = ClustersParams { bridgness :: Double
 129                                      , louvain   :: Text
 130                                      } deriving (Show)
 131
 132 clustersParams :: Int -> ClustersParams
 133 clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
 134   {- where
 135     y | x < 100  = "0.000001"
 136       | x < 350  = "0.000001"
 137       | x < 500  = "0.000001"
 138       | x < 1000 = "0.000001"
 139       | otherwise = "1"
 140  -}
 141
 142 ----------------------------------------------------------
 143 -- | From data to Graph
 144 data2graph :: [(Text, Int)]
 145            -> Map (Int, Int) Int
 146            -> Map (Int, Int) Double
 147            -> Map (Int, Int) Double
 148            -> [LouvainNode]
 149            -> Graph
 150 data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
 151   where
 152
 153     community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
 154
 155     nodes = map (setCoord ForceAtlas labels bridge)
 156           [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
 157                    , node_type = Terms -- or Unknown
 158                    , node_id    = cs (show n)
 159                    , node_label = l
 160                    , node_x_coord = 0
 161                    , node_y_coord = 0
 162                    , node_attributes =
 163                      Attributes { clust_default = maybe 0 identity
 164                                 (Map.lookup n community_id_by_node_id) } }
 165                )
 166             | (l, n) <- labels
 167             , Set.member n $ Set.fromList
 168                            $ List.concat
 169                            $ map (\((s,t),d) -> if d > 0 && s /=t then [s,t] else [])
 170                            $ Map.toList bridge
 171             ]
 172
 173     edges = [ Edge { edge_source = cs (show s)
 174                        , edge_target = cs (show t)
 175                        , edge_weight =  d
 176                        , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
 177                    -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
 178                    , edge_id     = cs (show i) }
 179                    | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
 180                    ]
 181
 182
 183 ------------------------------------------------------------------------
 184
 185 data Layout = KamadaKawai | ACP | ForceAtlas
 186
 187
 188 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
 189 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
 190   where
 191     (x,y) = f i
 192
 193
 194 -- | ACP
 195 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
 196 setCoord l labels m (n,node) = node { node_x_coord = x
 197                                     , node_y_coord = y
 198                                     }
 199   where
 200     (x,y) = getCoord l labels m n
 201
 202
 203 getCoord :: Ord a
 204          => Layout
 205          -> [(a, Int)]
 206          -> Map (Int, Int) Double
 207          -> Int
 208          -> (Double, Double)
 209 getCoord KamadaKawai _ _m _n = undefined -- layout m n
 210
 211 getCoord ForceAtlas _ _ n = (sin d, cos d)
 212   where
 213     d = fromIntegral n
 214
 215 getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") identity
 216              $ Map.lookup n
 217              $ pcaReduceTo (Dimension 2)
 218              $ mapArray labels m
 219   where
 220     to2d :: Vec.Vector Double -> (Double, Double)
 221     to2d v  = (x',y')
 222       where
 223         ds = take 2 $ Vec.toList v
 224         x'  = head' "to2d" ds
 225         y'  = last' "to2d" ds
 226
 227     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 228     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 229       where
 230         ns = map snd items
 231
 232     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 233     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 234 ------------------------------------------------------------------------
 235
 236 -- | KamadaKawai Layout
 237 -- TODO TEST: check labels, nodeId and coordinates
 238 layout :: Map (Int, Int) Double -> Int -> Gen -> (Double, Double)
 239 layout m n gen = maybe (panic "") identity $ Map.lookup n $ coord
 240   where
 241     coord :: (Map Int (Double,Double))
 242     coord = Map.fromList $ List.zip (Igraph.nodes g) $ (Layout.layout g p gen)
 243     --p = Layout.defaultLGL
 244     p = Layout.kamadaKawai
 245     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
 246