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 Data.Graph.Clustering.Louvain.Utils (LouvainNode(..))
  19 -- import Data.Graph.Clustering.Louvain (hLouvain, {-iLouvainMap-})
  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
  59     (ti, _) = createIndices myCooc
  60     myCooc' = toIndex ti myCooc
  61     matCooc = map2mat 0 (Map.size ti) $ Map.filter (> 1) myCooc'
  62     distanceMat = measureConditional matCooc
  63     distanceMap = Map.filter (> threshold) $ mat2map distanceMat
  64
  65     nodesApprox :: Int
  66     nodesApprox = n'
  67       where
  68         (as, bs) = List.unzip $ Map.keys distanceMap
  69         n' = Set.size $ Set.fromList $ as <> bs
  70     ClustersParams rivers level = clustersParams nodesApprox
  71
  72
  73   partitions <- if (Map.size distanceMap > 0)
  74       --then iLouvainMap 100 10 distanceMap
  75       -- then hLouvain distanceMap
  76       then cLouvain level distanceMap
  77       else panic "Text.Flow: DistanceMap is empty"
  78
  79   let
  80     bridgeness' = distanceMap
  81     _bridgeness' = bridgeness rivers partitions distanceMap
  82     confluence' = confluence (Map.keys bridgeness') 3 True False
  83
  84   pure $ data2graph (Map.toList ti) myCooc' bridgeness' confluence' partitions
  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            -> Graph
 110 data2graph labels coocs bridge conf partitions = Graph nodes edges Nothing
 111   where
 112
 113     community_id_by_node_id = Map.fromList [ (n, c) | LouvainNode n c <- partitions ]
 114
 115     nodes = map (setCoord ForceAtlas labels bridge)
 116           [ (n, Node { node_size = maybe 0 identity (Map.lookup (n,n) coocs)
 117                    , node_type = Terms -- or Unknown
 118                    , node_id    = cs (show n)
 119                    , node_label = l
 120                    , node_x_coord = 0
 121                    , node_y_coord = 0
 122                    , node_attributes =
 123                      Attributes { clust_default = maybe 0 identity
 124                                 (Map.lookup n community_id_by_node_id) } }
 125                )
 126             | (l, n) <- labels
 127             , Set.member n $ Set.fromList
 128                            $ List.concat
 129                            $ map (\((s,t),d) -> if d > 0 && s /=t then [s,t] else [])
 130                            $ Map.toList bridge
 131             ]
 132
 133     edges = [ Edge { edge_source = cs (show s)
 134                        , edge_target = cs (show t)
 135                        , edge_weight =  d
 136                        , edge_confluence = maybe 0 identity $ Map.lookup (s,t) conf
 137                    -- , edge_confluence = maybe (panic "E: data2graph edges") identity $ Map.lookup (s,t) conf
 138                    , edge_id     = cs (show i) }
 139                    | (i, ((s,t), d)) <- zip ([0..]::[Integer]) (Map.toList bridge), s /= t, d > 0
 140                    ]
 141
 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) -> Node
 156 setCoord l labels m (n,node) = node { node_x_coord = x
 157                                     , node_y_coord = y
 158                                     }
 159   where
 160     (x,y) = getCoord l labels m n
 161
 162
 163 getCoord :: Ord a
 164          => Layout
 165          -> [(a, Int)]
 166          -> Map (Int, Int) Double
 167          -> Int
 168          -> (Double, Double)
 169 getCoord KamadaKawai _ _m _n = undefined -- layout m n
 170
 171 getCoord ForceAtlas _ _ n = (sin d, cos d)
 172   where
 173     d = fromIntegral n
 174
 175 getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") identity
 176              $ Map.lookup n
 177              $ pcaReduceTo (Dimension 2)
 178              $ mapArray labels m
 179   where
 180     to2d :: Vec.Vector Double -> (Double, Double)
 181     to2d v  = (x',y')
 182       where
 183         ds = take 2 $ Vec.toList v
 184         x'  = head' "to2d" ds
 185         y'  = last' "to2d" ds
 186
 187     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 188     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 189       where
 190         ns = map snd items
 191
 192     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 193     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 194 ------------------------------------------------------------------------
 195
 196 -- | KamadaKawai Layout
 197 -- TODO TEST: check labels, nodeId and coordinates
 198 layout :: Map (Int, Int) Double -> Int -> IO (Double, Double)
 199 layout m n = maybe (panic "") identity <$> Map.lookup n <$> coord
 200   where
 201     coord :: IO (Map Int (Double,Double))
 202     coord = Map.fromList <$> List.zip (Igraph.nodes g) <$> (Layout.getLayout g p)
 203     --p = Layout.defaultLGL
 204     p = Layout.defaultKamadaKawai
 205     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
 206