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
  13 module Gargantext.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.Viz.Graph
  26 import Gargantext.Viz.Graph.Bridgeness (bridgeness)
  27 import Gargantext.Viz.Graph.Distances (Distance(..), measure)
  28 import Gargantext.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index)
  29 import Gargantext.Viz.Graph.IGraph (mkGraphUfromEdges)
  30 import Gargantext.Viz.Graph.Proxemy (confluence)
  31 import GHC.Float (sin, cos)
  32 import qualified IGraph as Igraph
  33 import qualified IGraph.Algorithms.Layout as Layout
  34 import qualified Data.Vector.Storable as Vec
  35 import qualified Data.Map  as Map
  36 import qualified Data.List as List
  37
  38 type Threshold = Double
  39
  40
  41 cooc2graph' :: Ord t => Double
  42                      -> Map (t, t) Int
  43                      -> Map (Index, Index) Double
  44 cooc2graph' threshold myCooc = distanceMap
  45   where
  46     (ti, _) = createIndices myCooc
  47     myCooc' = toIndex ti myCooc
  48     matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
  49     distanceMat = measure Conditional matCooc
  50     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
  51
  52
  53 cooc2graph :: Threshold
  54            -> (Map (Text, Text) Int)
  55            -> IO Graph
  56 cooc2graph threshold myCooc = do
  57   let
  58     (ti, _) = createIndices myCooc
  59     myCooc' = toIndex ti myCooc
  60     matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
  61     distanceMat = measure Conditional matCooc
  62     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
  63
  64     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 = clustersParams nodesApprox
  70
  71
  72   partitions <- if (Map.size distanceMap > 0)
  73       -- then iLouvainMap 100 10 distanceMap
  74       -- then hLouvain distanceMap
  75       then cLouvain level distanceMap
  76       else panic "Text.Flow: DistanceMap is empty"
  77
  78   let
  79     -- bridgeness' = distanceMap
  80     bridgeness' = trace ("Rivers: " <> show rivers) $ bridgeness rivers partitions distanceMap
  81     confluence' = confluence (Map.keys bridgeness') 3 True False
  82
  83   pure $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
  84
  85
  86
  87 data ClustersParams = ClustersParams { bridgness :: Double
  88                                      , louvain   :: Text
  89                                      } deriving (Show)
  90
  91 clustersParams :: Int -> ClustersParams
  92 clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
  93   {- where
  94     y | x < 100  = "0.000001"
  95       | x < 350  = "0.000001"
  96       | x < 500  = "0.000001"
  97       | x < 1000 = "0.000001"
  98       | otherwise = "1"
  99  -}
 100
 101 ----------------------------------------------------------
 102 -- | From data to Graph
 103 data2graph :: [(Text, Int)]
 104            -> Map (Int, Int) Int
 105            -> Map (Int, Int) Double
 106            -> Map (Int, Int) Double
 107            -> [LouvainNode]
 108            -> Graph
 109 data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
 110   where
 111
 112     community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
 113
 114     nodes = map (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     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
 142 ------------------------------------------------------------------------
 143
 144 data Layout = KamadaKawai | ACP | ForceAtlas
 145
 146
 147 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
 148 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
 149   where
 150     (x,y) = f i
 151
 152
 153 -- | ACP
 154 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> Node
 155 setCoord l labels m (n,node) = node { node_x_coord = x
 156                                     , node_y_coord = y
 157                                     }
 158   where
 159     (x,y) = getCoord l labels m n
 160
 161
 162 getCoord :: Ord a
 163          => Layout
 164          -> [(a, Int)]
 165          -> Map (Int, Int) Double
 166          -> Int
 167          -> (Double, Double)
 168 getCoord KamadaKawai _ _m _n = undefined -- layout m n
 169
 170 getCoord ForceAtlas _ _ n = (sin d, cos d)
 171   where
 172     d = fromIntegral n
 173
 174 getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") identity
 175              $ Map.lookup n
 176              $ pcaReduceTo (Dimension 2)
 177              $ mapArray labels m
 178   where
 179     to2d :: Vec.Vector Double -> (Double, Double)
 180     to2d v  = (x',y')
 181       where
 182         ds = take 2 $ Vec.toList v
 183         x'  = head' "to2d" ds
 184         y'  = last' "to2d" ds
 185
 186     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 187     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 188       where
 189         ns = map snd items
 190
 191     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 192     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 193 ------------------------------------------------------------------------
 194
 195 -- | KamadaKawai Layout
 196 -- TODO TEST: check labels, nodeId and coordinates
 197 layout :: Map (Int, Int) Double -> Int -> IO (Double, Double)
 198 layout m n = maybe (panic "") identity <$> Map.lookup n <$> coord
 199   where
 200     coord :: IO (Map Int (Double,Double))
 201     coord = Map.fromList <$> List.zip (Igraph.nodes g) <$> (Layout.getLayout g p)
 202     --p = Layout.defaultLGL
 203     p = Layout.defaultKamadaKawai
 204     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
 205