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