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