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