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