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