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