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.CplusPlus (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
  72   partitions <- case Map.size distanceMap > 0 of
  73     True  -> trace ("level" <> show level) $ cLouvain level distanceMap
  74     False -> panic "Text.Flow: DistanceMap is empty"
  75
  76   let bridgeness' = {-trace ("rivers: " <> show rivers) $-}
  77                     bridgeness rivers partitions distanceMap
  78
  79   let confluence' = confluence (Map.keys bridgeness') 3 True False
  80
  81   data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
  82
  83
  84 data ClustersParams = ClustersParams { bridgness :: Double
  85                                      , louvain   :: Text
  86                                      } deriving (Show)
  87
  88 clustersParams :: Int -> ClustersParams
  89 clustersParams x = ClustersParams (fromIntegral x) "0.00000001" -- y
  90   {- where
  91     y | x < 100  = "0.000001"
  92       | x < 350  = "0.000001"
  93       | x < 500  = "0.000001"
  94       | x < 1000 = "0.000001"
  95       | otherwise = "1"
  96  -}
  97
  98 ----------------------------------------------------------
  99 -- | From data to Graph
 100 data2graph :: [(Text, Int)]
 101            -> Map (Int, Int) Int
 102            -> Map (Int, Int) Double
 103            -> Map (Int, Int) Double
 104            -> [LouvainNode]
 105            -> IO Graph
 106 data2graph labels coocs bridge conf partitions = do
 107
 108     let community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
 109
 110     nodes <- mapM (setCoord ForceAtlas labels bridge)
 111           [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
 112                    , node_type = Terms -- or Unknown
 113                    , node_id    = cs (show n)
 114                    , node_label = l
 115                    , node_x_coord = 0
 116                    , node_y_coord = 0
 117                    , node_attributes =
 118                      Attributes { clust_default = maybe 0 identity
 119                                 (Map.lookup n community_id_by_node_id) } }
 120                )
 121             | (l, n) <- labels
 122             , Set.member n $ Set.fromList
 123                            $ List.concat
 124                            $ map (\((s,t),d) -> if d > 0 && s /=t then [s,t] else [])
 125                            $ Map.toList bridge
 126             ]
 127
 128     let edges = [ Edge { edge_source = cs (show s)
 129                        , edge_target = cs (show t)
 130                        , edge_weight =  d
 131                        , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
 132                    -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
 133                    , edge_id     = cs (show i) }
 134                    | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
 135                    ]
 136
 137     pure $ Graph nodes edges Nothing
 138
 139 ------------------------------------------------------------------------
 140
 141 data Layout = KamadaKawai | ACP | ForceAtlas
 142
 143
 144 setCoord' :: (Int -> (Double, Double)) -> (Int, Node) -> Node
 145 setCoord' f (i,n) = n { node_x_coord = x, node_y_coord = y }
 146   where
 147     (x,y) = f i
 148
 149
 150 -- | ACP
 151 setCoord :: Ord a => Layout -> [(a, Int)] -> Map (Int, Int) Double -> (Int, Node) -> IO Node
 152 setCoord l labels m (n,node) = getCoord l labels m n
 153                            >>= \(x,y) -> pure $ node { node_x_coord = x
 154                                                      , node_y_coord = y
 155                                                      }
 156
 157
 158 getCoord :: Ord a => Layout
 159                   -> [(a, Int)] -> Map (Int, Int) Double -> Int -> IO (Double, Double)
 160 getCoord KamadaKawai _ m n = layout m n
 161
 162 getCoord ForceAtlas _ _ n = pure (sin d, cos d)
 163   where
 164     d = fromIntegral n
 165
 166 getCoord ACP labels m n = pure $ to2d $ maybe (panic "Graph.Tools no coordinate") identity
 167              $ Map.lookup n
 168              $ pcaReduceTo (Dimension 2)
 169              $ mapArray labels m
 170   where
 171     to2d :: Vec.Vector Double -> (Double, Double)
 172     to2d v  = (x',y')
 173       where
 174         ds = take 2 $ Vec.toList v
 175         x'  = head' "to2d" ds
 176         y'  = last' "to2d" ds
 177
 178     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 179     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 180       where
 181         ns = map snd items
 182
 183     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 184     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 185 ------------------------------------------------------------------------
 186
 187 -- | KamadaKawai Layout
 188 -- TODO TEST: check labels, nodeId and coordinates
 189 layout :: Map (Int, Int) Double -> Int -> IO (Double, Double)
 190 layout m n = maybe (panic "") identity <$> Map.lookup n <$> coord
 191   where
 192     coord :: IO (Map Int (Double,Double))
 193     coord = Map.fromList <$> List.zip (Igraph.nodes g) <$> (Layout.getLayout g p)
 194     --p = Layout.defaultLGL
 195     p = Layout.defaultKamadaKawai
 196     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
 197