]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Graph/MaxClique.hs
[DEV] -> [STABLE]
[gargantext.git] / src / Gargantext / Viz / Graph / MaxClique.hs
1 {-| Module : Gargantext.Viz.Graph.MaxClique
2 Description : MaxCliques function
3 Copyright : (c) CNRS, 2017-Present
4 License : AGPL + CECILL v3
5 Maintainer : team@gargantext.org
6 Stability : experimental
7 Portability : POSIX
8
9 - First written by Bruno Gaume in Python (see below for details)
10 - Then written by Alexandre Delanoë in Haskell (see below for details)
11
12 # By Bruno Gaume:
13 def fast_maximal_cliques(g):
14
15 def rec_maximal_cliques(g, subv):
16 mc = []
17 if subv == []: # stop condition
18 return [[]]
19 else :
20 for i in range(len(subv)):
21 newsubv = [j for j in subv[i+1:len(subv)]
22 if (j in g.neighbors(subv[i]))]
23 mci = rec_maximal_cliques(g, newsubv)
24 for x in mci:
25 x.append(subv[i])
26 mc.append(x)
27 return mc
28
29 def purge(clust):
30 clustset = [set(x) for x in clust]
31 new_clust = []
32 for i in range(len(clustset)):
33 ok = True
34 for j in range(len(clustset)):
35 if clustset[i].issubset(clustset[j]) and (not (len(clustset[i]) == len(clustset[j])) ):
36 ok = False
37 if ok and (not (clustset[i] in new_clust)):
38 new_clust.append(clustset[i])
39 return [list(x) for x in new_clust]
40
41 # to optimize : rank the vertices on the degrees
42 subv = [(v.index, v.degree()) for v in g.vs()]
43 subv.sort(key = lambda z:z[1])
44 subv = [x for (x, y) in subv]
45 return purge(rec_maximal_cliques(g, subv))
46
47 -}
48
49
50 {-# LANGUAGE NoImplicitPrelude #-}
51
52 module Gargantext.Viz.Graph.MaxClique
53 where
54
55 import Gargantext.Prelude
56 import Data.List (sortOn, nub, concat, length)
57 import Data.Set (Set)
58 import Data.Set (fromList, toList, isSubsetOf)
59 import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
60 import Gargantext.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
61
62
63 type Graph = Graph_Undirected
64 type Neighbor = Node
65
66 maxCliques :: Graph -> [[Node]]
67 maxCliques g = map (\n -> subMaxCliques g (n:ns)) ns & concat & takeMax
68 where
69 ns :: [Node]
70 ns = sortOn (degree g) $ nodes g
71
72 subMaxCliques :: Graph -> [Node] -> [[Node]]
73 subMaxCliques _ [] = [[]]
74 subMaxCliques g' (x:xs) = add x $ subMaxCliques g' ns'
75 where
76 ns' = [n | n <- xs, elem n $ neighborsOut g' x]
77
78 add :: Node -> [[Node]] -> [[Node]]
79 add n [] = [[n]]
80 add n (m:ms) = [n:m] <> add n ms
81 -- | Note, it is same as :
82 -- add n ns = map (\m -> n : m) ns
83 -- -- (but using pattern matching and recursivity)
84 -- -- (map is redefined in fact)
85
86 -- | To be sure self is not in neighbors of self
87 -- (out to exclude the self)
88 neighborsOut :: Graph -> Node -> [Node]
89 neighborsOut g'' n = filter (/= n) $ neighbors g'' n
90
91
92 takeMax :: [[Node]] -> [[Node]]
93 takeMax = map toList
94 . purge
95 . map fromList
96 . sortOn length
97 . nub
98 where
99 purge :: [Set Node] -> [Set Node]
100 purge [] = []
101 purge (x:xs) = x' <> purge xs
102 where
103 x' = if all (== False) (map (isSubsetOf x) xs)
104 then [x]
105 else []
106
107
108 ------------------------------------------------------------------------
109 test_graph :: Graph
110 -- test_graph = mkGraphUfromEdges [(1,1), (2,2), (3,3)]
111 test_graph = mkGraphUfromEdges [(1,2), (3,3)]
112
113 test_graph' :: Graph
114 test_graph' = mkGraphUfromEdges [(1,2), (3,3), (3,2)]
115
116 test_graph'' :: Graph
117 test_graph'' = mkGraphUfromEdges [(1,2), (2,3), (1,3)]
118
119 test_graph''' :: Graph
120 test_graph''' = mkGraphUfromEdges [ (4,1)
121 , (4,2)
122 , (3,1)
123 , (3,2)
124 , (2,1)
125 ]