src/Gargantext/Viz/Graph/Tools.hs

   1 {-|
   2 Module      : Gargantext.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 NoImplicitPrelude           #-}
  13 {-# LANGUAGE OverloadedStrings           #-}
  14
  15 module Gargantext.Viz.Graph.Tools
  16   where
  17
  18 import Debug.Trace (trace)
  19 import Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
  20 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
  21 import Data.Map (Map)
  22 import qualified Data.Set as Set
  23 import Data.Text (Text)
  24 import Gargantext.Prelude
  25 import Gargantext.Core.Statistics
  26 import Gargantext.Viz.Graph
  27 import Gargantext.Viz.Graph.Bridgeness (bridgeness)
  28 import Gargantext.Viz.Graph.Distances.Matrice (measureConditional)
  29 import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
  30 import Gargantext.Viz.Graph.IGraph (mkGraphUfromEdges)
  31 import Gargantext.Viz.Graph.Proxemy (confluence)
  32 import GHC.Float (sin, cos)
  33 import qualified IGraph as Igraph
  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 => Double
  43                      -> Map (t, t) Int
  44                      -> Map (Index, Index) Double
  45 cooc2graph' threshold myCooc = distanceMap
  46   where
  47     (ti, _) = createIndices myCooc
  48     myCooc' = toIndex ti myCooc
  49     matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
  50     distanceMat = measureConditional matCooc
  51     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
  52
  53
  54 cooc2graph :: Threshold
  55            -> (Map (Text, Text) Int)
  56            -> IO Graph
  57 cooc2graph threshold myCooc = do
  58   let (ti, _) = createIndices myCooc
  59       myCooc' = toIndex ti myCooc
  60       matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
  61       distanceMat = measureConditional matCooc
  62       distanceMap = Map.filter (> threshold) $ mat2map distanceMat
  63
  64   let nodesApprox :: Int
  65       nodesApprox = n'
  66         where
  67           (as, bs) = List.unzip $ Map.keys distanceMap
  68           n' = Set.size $ Set.fromList $ as <> bs
  69       ClustersParams rivers level = {-trace ("nodesApprox: " <> show nodesApprox) $-} clustersParams nodesApprox
  70
  71   partitions <- inMVarIO $ case Map.size distanceMap > 0 of
  72     True  -> trace ("level" <> show level) $ cLouvain level distanceMap
  73     False -> panic "Text.Flow: DistanceMap is empty"
  74
  75   bridgeness' <- trace "bridgeness" $ inMVar $ {-trace ("rivers: " <> show rivers) $-}
  76                     bridgeness rivers partitions distanceMap
  77
  78   confluence' <- trace "confluence" $ inMVar $ confluence (Map.keys bridgeness') 3 True False
  79
  80   r <- trace "data2graph" $ inMVarIO $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
  81
  82   pure r
  83
  84
  85
  86
  87
  88 data ClustersParams = ClustersParams { bridgness :: Double
  89                                      , louvain   :: Text
  90                                      } deriving (Show)
  91
  92 clustersParams :: Int -> ClustersParams
  93 clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
  94   {- where
  95     y | x < 100  = "0.000001"
  96       | x < 350  = "0.000001"
  97       | x < 500  = "0.000001"
  98       | x < 1000 = "0.000001"
  99       | otherwise = "1"
 100  -}
 101
 102 ----------------------------------------------------------
 103 -- | From data to Graph
 104 data2graph :: [(Text, Int)]
 105            -> Map (Int, Int) Int
 106            -> Map (Int, Int) Double
 107            -> Map (Int, Int) Double
 108            -> [LouvainNode]
 109            -> IO Graph
 110 data2graph labels coocs bridge conf partitions = do
 111
 112     let community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
 113
 114     nodes <- mapM (setCoord ForceAtlas labels bridge)
 115           [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
 116                    , node_type = Terms -- or Unknown
 117                    , node_id    = cs (show n)
 118                    , node_label = l
 119                    , node_x_coord = 0
 120                    , node_y_coord = 0
 121                    , node_attributes =
 122                      Attributes { clust_default = maybe 0 identity
 123                                 (Map.lookup n community_id_by_node_id) } }
 124                )
 125             | (l, n) <- labels
 126             , Set.member n $ Set.fromList
 127                            $ List.concat
 128                            $ map (\((s,t),d) -> if d > 0 && s /=t then [s,t] else [])
 129                            $ Map.toList bridge
 130             ]
 131
 132     let edges = [ Edge { edge_source = cs (show s)
 133                        , edge_target = cs (show t)
 134                        , edge_weight =  d
 135                        , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
 136                    -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
 137                    , edge_id     = cs (show i) }
 138                    | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
 139                    ]
 140
 141     pure $ Graph nodes edges Nothing
 142
 143 ------------------------------------------------------------------------
 144
 145 data Layout = KamadaKawai | ACP | ForceAtlas
 146
 147
 148 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
 149 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
 150   where
 151     (x,y) = f i
 152
 153
 154 -- | ACP
 155 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> IO Node
 156 setCoord l labels m (n,node) = getCoord l labels m n
 157                            >>= \(x,y) -> pure $ node { node_x_coord = x
 158                                                      , node_y_coord = y
 159                                                      }
 160
 161
 162 getCoord :: Ord a => Layout
 163                   -> [(a, Int)] -> Map (Int, Int) Double -> Int -> IO (Double, Double)
 164 getCoord KamadaKawai _ m n = layout m n
 165
 166 getCoord ForceAtlas _ _ n = pure (sin d, cos d)
 167   where
 168     d = fromIntegral n
 169
 170 getCoord ACP labels m n = pure $ to2d $ maybe (panic "Graph.Tools no coordinate") identity
 171              $ Map.lookup n
 172              $ pcaReduceTo (Dimension 2)
 173              $ mapArray labels m
 174   where
 175     to2d :: Vec.Vector Double -> (Double, Double)
 176     to2d v  = (x',y')
 177       where
 178         ds = take 2 $ Vec.toList v
 179         x'  = head' "to2d" ds
 180         y'  = last' "to2d" ds
 181
 182     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 183     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 184       where
 185         ns = map snd items
 186
 187     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 188     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 189 ------------------------------------------------------------------------
 190
 191 -- | KamadaKawai Layout
 192 -- TODO TEST: check labels, nodeId and coordinates
 193 layout :: Map (Int, Int) Double -> Int -> IO (Double, Double)
 194 layout m n = maybe (panic "") identity <$> Map.lookup n <$> coord
 195   where
 196     coord :: IO (Map Int (Double,Double))
 197     coord = Map.fromList <$> List.zip (Igraph.nodes g) <$> (Layout.getLayout g p)
 198     --p = Layout.defaultLGL
 199     p = Layout.defaultKamadaKawai
 200     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
 201