]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Viz/Graph/MaxClique.hs
Merge branch 'dev' into dev-list-charts
[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
51 module Gargantext.Viz.Graph.MaxClique
52 where
53
54 import Data.Maybe (catMaybes)
55 import Gargantext.Prelude
56 import Data.Map (Map)
57 import qualified Data.Map as Map
58 import Data.List (sortOn, nub, concat, length)
59 import Data.Set (Set)
60 import Data.Set (fromList, toList, isSubsetOf)
61 import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
62 import Gargantext.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
63 import Gargantext.Viz.Graph.Tools (cooc2graph', Threshold)
64 import Gargantext.Viz.Graph.Index (createIndices, toIndex)
65 type Graph = Graph_Undirected
66 type Neighbor = Node
67
68
69 -- | getMaxCliques
70 -- TODO chose distance order
71 getMaxCliques :: Ord a => Threshold -> Map (a, a) Int -> [[a]]
72 getMaxCliques t m = map fromIndices $ getMaxCliques' t m'
73 where
74 m' = toIndex to m
75 (to,from) = createIndices m
76 fromIndices = catMaybes . map (\n -> Map.lookup n from)
77
78 getMaxCliques' :: Threshold -> Map (Int, Int) Int -> [[Int]]
79 getMaxCliques' t' n = maxCliques graph
80 where
81 graph = mkGraphUfromEdges (Map.keys n')
82 n' = cooc2graph' t' n
83
84 maxCliques :: Graph -> [[Node]]
85 maxCliques g = map (\n -> subMaxCliques g (n:ns)) ns & concat & takeMax
86 where
87 ns :: [Node]
88 ns = sortOn (degree g) $ nodes g
89
90 subMaxCliques :: Graph -> [Node] -> [[Node]]
91 subMaxCliques _ [] = [[]]
92 subMaxCliques g' (x:xs) = add x $ subMaxCliques g' ns'
93 where
94 ns' = [n | n <- xs, elem n $ neighborsOut g' x]
95
96 add :: Node -> [[Node]] -> [[Node]]
97 add n [] = [[n]]
98 add n (m:ms) = [n:m] <> add n ms
99 -- | Note, it is same as :
100 -- add n ns = map (\m -> n : m) ns
101 -- -- (but using pattern matching and recursivity)
102 -- -- (map is redefined in fact)
103
104 -- | To be sure self is not in neighbors of self
105 -- (out to exclude the self)
106 neighborsOut :: Graph -> Node -> [Node]
107 neighborsOut g'' n = filter (/= n) $ neighbors g'' n
108
109
110 takeMax :: [[Node]] -> [[Node]]
111 takeMax = map toList
112 . purge
113 . map fromList
114 . sortOn length
115 . nub
116 where
117 purge :: [Set Node] -> [Set Node]
118 purge [] = []
119 purge (x:xs) = x' <> purge xs
120 where
121 x' = if all (== False) (map (isSubsetOf x) xs)
122 then [x]
123 else []
124
125
126 ------------------------------------------------------------------------
127 test_graph :: Graph
128 -- test_graph = mkGraphUfromEdges [(1,1), (2,2), (3,3)]
129 test_graph = mkGraphUfromEdges [(1,2), (3,3)]
130
131 test_graph' :: Graph
132 test_graph' = mkGraphUfromEdges [(1,2), (3,3), (3,2)]
133
134 test_graph'' :: Graph
135 test_graph'' = mkGraphUfromEdges [(1,2), (2,3), (1,3)]
136
137 test_graph''' :: Graph
138 test_graph''' = mkGraphUfromEdges [ (4,1)
139 , (4,2)
140 , (3,1)
141 , (3,2)
142 , (2,1)
143 ]