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