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