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