IGraph.hs 3.97 KB
Newer Older
1 2 3
{-|
Module      : Gargantext.Core.Viz.Graph.Tools.IGraph
Description : Tools to build Graph
4 5 6 7 8 9
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Alexandre Delanoë's avatar
Alexandre Delanoë committed
10 11 12
Reference:
* Gábor Csárdi, Tamás Nepusz: The igraph software package for complex network research. InterJournal Complex Systems, 1695, 2006.

13 14
-}

15 16
module Gargantext.Core.Viz.Graph.Tools.IGraph
  where
17

18
import Data.Serialize
19
import Data.Singletons (SingI)
20 21
import Gargantext.Core.Viz.Graph.Index
import Graph.Types (ClusterNode(..))
22
import IGraph hiding (mkGraph, neighbors, edges, nodes, Node, Graph)
23
import Protolude
24
import Gargantext.Prelude (saveAsFileDebug)
25
import qualified Data.List                   as List
26
import qualified Data.Map.Strict             as Map
27 28 29
import qualified IGraph                      as IG
import qualified IGraph.Algorithms.Clique    as IG
import qualified IGraph.Algorithms.Community as IG
30
import qualified IGraph.Algorithms.Structure as IG
31
import qualified IGraph.Random               as IG
32
import qualified Data.Set                    as Set
33 34 35 36 37 38

------------------------------------------------------------------
-- | Main Types
type Graph_Undirected = IG.Graph 'U () ()
type Graph_Directed   = IG.Graph 'D () ()

39
type Node  = IG.Node
40 41 42
type Graph = IG.Graph

------------------------------------------------------------------
43 44
-- | Main Graph management Functions
neighbors :: IG.Graph d v e -> IG.Node -> [IG.Node]
45 46 47 48 49
neighbors = IG.neighbors

edges :: IG.Graph d v e -> [Edge]
edges = IG.edges

50
nodes :: IG.Graph d v e -> [IG.Node]
51
nodes = IG.nodes
52

53 54
------------------------------------------------------------------
-- | Partitions
55
maximalCliques :: IG.Graph d v e -> [[Int]]
56
maximalCliques g = IG.maximalCliques g (min',max')
57
  where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
58 59
    min' = 0
    max' = 0
60 61

------------------------------------------------------------------
62 63
type Seed = Int

64 65 66 67
spinglass :: Seed -> Map (Int, Int) Double -> IO [ClusterNode]
spinglass s g = toClusterNode
             <$> map catMaybes
             <$> map (map (\n -> Map.lookup n fromI))
68 69
             <$> List.concat
             <$> mapM (partitions_spinglass' s) g'
70
  where
71 72 73 74
    -- Not connected components of the graph make crash spinglass
    g' = IG.decompose $ mkGraphUfromEdges
                      $ Map.keys
                      $ toIndex toI g
75

76 77
    (toI, fromI) = createIndices g

78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
spinglass' :: Seed -> Map (Int, Int) Double -> IO [Set Int]
spinglass' s g = map Set.fromList
             <$> map catMaybes
             <$> map (map (\n -> Map.lookup n fromI))
             <$> List.concat
             <$> mapM (partitions_spinglass' s) g'
  where
    -- Not connected components of the graph make crash spinglass
    g' = IG.decompose $ mkGraphUfromEdges
                      $ Map.keys
                      $ toIndex toI g

    (toI, fromI) = createIndices g




95

96
-- | Tools to analyze graphs
97
partitions_spinglass' :: (Serialize v, Serialize e)
98
                         => Seed -> IG.Graph 'U v e -> IO [[Int]]
99
partitions_spinglass' s g = do
100
  gen <- IG.withSeed s pure
101 102 103 104 105
  res <- IG.findCommunity g Nothing Nothing IG.spinglass gen
  -- res <- IG.findCommunity g Nothing Nothing IG.leiden gen
  -- res <- IG.findCommunity g Nothing Nothing IG.infomap  gen
  saveAsFileDebug "/tmp/res" res
  pure res
106 107


108 109 110 111 112 113
toClusterNode :: [[Int]] -> [ClusterNode]
toClusterNode ns = List.concat
                 $ map (\(cId, ns') -> map (\n -> ClusterNode n cId) ns')
                 $ List.zip [1..] ns

------------------------------------------------------------------
114 115 116 117 118 119
mkGraph :: (SingI d, Ord v,
             Serialize v, Serialize e) =>
     [v] -> [LEdge e] -> IG.Graph d v e
mkGraph = IG.mkGraph

------------------------------------------------------------------
120 121 122 123 124 125
mkGraphUfromEdges :: [(Int, Int)] -> Graph_Undirected
mkGraphUfromEdges es = mkGraph (List.replicate n ()) $ zip es $ repeat ()
  where
    (a,b) = List.unzip es
    n = List.length (List.nub $ a <> b)

Alexandre Delanoë's avatar
Alexandre Delanoë committed
126
{-
127 128
mkGraphDfromEdges :: [(Int, Int)] -> Graph_Directed
mkGraphDfromEdges = undefined
Alexandre Delanoë's avatar
Alexandre Delanoë committed
129
-}