1 {-| Module : Gargantext.Viz.Graph.IGraph
2 Description : IGraph main functions used in Garg
3 Copyright : (c) CNRS, 2017-Present
4 License : AGPL + CECILL v3
5 Maintainer : team@gargantext.org
6 Stability : experimental
9 Main IGraph funs/types to ease portability with FGL.
12 * Gábor Csárdi, Tamás Nepusz: The igraph software package for complex network research. InterJournal Complex Systems, 1695, 2006.
16 {-# LANGUAGE NoImplicitPrelude #-}
17 {-# LANGUAGE DataKinds #-}
19 module Gargantext.Viz.Graph.IGraph where
21 import Data.Serialize (Serialize)
22 import Data.Singletons (SingI)
23 import Gargantext.Prelude
24 import IGraph hiding (mkGraph, neighbors, edges, nodes, Node, Graph)
25 import IGraph.Algorithms.Clique as IAC
26 import qualified IGraph as IG
27 import qualified Data.List as List
29 ------------------------------------------------------------------
31 type Graph_Undirected = IG.Graph 'U () ()
32 type Graph_Directed = IG.Graph 'D () ()
37 ------------------------------------------------------------------
40 mkGraph :: (SingI d, Ord v,
41 Serialize v, Serialize e) =>
42 [v] -> [LEdge e] -> IG.Graph d v e
45 neighbors :: IG.Graph d v e -> IG.Node -> [Node]
46 neighbors = IG.neighbors
48 edges :: IG.Graph d v e -> [Edge]
51 nodes :: IG.Graph d v e -> [Node]
53 ------------------------------------------------------------------
56 maximalCliques :: IG.Graph d v e -> [[Int]]
57 maximalCliques g = IAC.maximalCliques g (min',max')
62 ------------------------------------------------------------------
63 -- | Main sugared functions
64 mkGraphUfromEdges :: [(Int, Int)] -> Graph_Undirected
65 mkGraphUfromEdges es = mkGraph (List.replicate n ()) $ zip es $ repeat ()
68 n = List.length (List.nub $ a <> b)
70 mkGraphDfromEdges :: [(Int, Int)] -> Graph_Directed
71 mkGraphDfromEdges = undefined