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' = 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 => Layout
 163                   -> [(a, Int)] -> Map (Int, Int) Double -> Int -> (Double, Double)
 164 getCoord KamadaKawai _ _m _n = undefined -- layout m n
 165
 166 getCoord ForceAtlas _ _ n = (sin d, cos d)
 167   where
 168     d = fromIntegral n
 169
 170 getCoord ACP labels m n = to2d $ maybe (panic "Graph.Tools no coordinate") identity
 171              $ Map.lookup n
 172              $ pcaReduceTo (Dimension 2)
 173              $ mapArray labels m
 174   where
 175     to2d :: Vec.Vector Double -> (Double, Double)
 176     to2d v  = (x',y')
 177       where
 178         ds = take 2 $ Vec.toList v
 179         x'  = head' "to2d" ds
 180         y'  = last' "to2d" ds
 181
 182     mapArray :: Ord a => [(a, Int)] -> Map (Int, Int) Double -> Map Int (Vec.Vector Double)
 183     mapArray items m' = Map.fromList [ toVec n' ns m' | n' <- ns ]
 184       where
 185         ns = map snd items
 186
 187     toVec :: Int -> [Int] -> Map (Int,Int) Double -> (Int, Vec.Vector Double)
 188     toVec n' ns' m' = (n', Vec.fromList $ map (\n'' -> maybe 0 identity $ Map.lookup (n',n'') m') ns')
 189 ------------------------------------------------------------------------
 190
 191 -- | KamadaKawai Layout
 192 -- TODO TEST: check labels, nodeId and coordinates
 193 layout :: Map (Int, Int) Double -> Int -> IO (Double, Double)
 194 layout m n = maybe (panic "") identity <$> Map.lookup n <$> coord
 195   where
 196     coord :: IO (Map Int (Double,Double))
 197     coord = Map.fromList <$> List.zip (Igraph.nodes g) <$> (Layout.getLayout g p)
 198     --p = Layout.defaultLGL
 199     p = Layout.defaultKamadaKawai
 200     g = mkGraphUfromEdges $ map fst $ List.filter (\e -> snd e > 0) $ Map.toList m
 201