1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
{-| Module : Gargantext.Core.Viz.Graph.MaxClique
Description : MaxCliques function
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
- Result of the workshop, Pyremiel 2019
- First written by Bruno Gaume in Python (see below for details)
- Then written by Alexandre Delanoë in Haskell (see below for details)
# By Bruno Gaume:
def fast_maximal_cliques(g):
def rec_maximal_cliques(g, subv):
mc = []
if subv == []: # stop condition
return [[]]
else :
for i in range(len(subv)):
newsubv = [j for j in subv[i+1:len(subv)]
if (j in g.neighbors(subv[i]))]
mci = rec_maximal_cliques(g, newsubv)
for x in mci:
x.append(subv[i])
mc.append(x)
return mc
def purge(clust):
clustset = [set(x) for x in clust]
new_clust = []
for i in range(len(clustset)):
ok = True
for j in range(len(clustset)):
if clustset[i].issubset(clustset[j]) and (not (len(clustset[i]) == len(clustset[j])) ):
ok = False
if ok and (not (clustset[i] in new_clust)):
new_clust.append(clustset[i])
return [list(x) for x in new_clust]
# to optimize : rank the vertices on the degrees
subv = [(v.index, v.degree()) for v in g.vs()]
subv.sort(key = lambda z:z[1])
subv = [x for (x, y) in subv]
return purge(rec_maximal_cliques(g, subv))
-}
module Gargantext.Core.Methods.Graph.MaxClique
where
import Data.Maybe (catMaybes)
import Gargantext.Prelude
import Data.Map (Map)
import qualified Data.Map as Map
import Data.List (sortOn, nub, concat)
import Data.Set (Set)
import Data.Set (fromList, toList, isSubsetOf)
import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
import Gargantext.Core.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
import Gargantext.Core.Viz.Graph.Tools (cooc2graph',cooc2graph'', Threshold)
import Gargantext.Core.Methods.Distances (Distance)
import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex)
import Gargantext.Core.Viz.Phylo
-- import Debug.Trace (trace)
type Graph = Graph_Undirected
type Neighbor = Node
-- | getMaxCliques
-- TODO chose distance order
getMaxCliques :: Ord a => CliqueFilter -> Distance -> Threshold -> Map (a, a) Int -> [[a]]
getMaxCliques f d t m = map fromIndices $ getMaxCliques' t m'
where
m' = toIndex to m
(to,from) = createIndices m
fromIndices = catMaybes . map (\n -> Map.lookup n from)
getMaxCliques' :: Threshold -> Map (Int, Int) Int -> [[Int]]
getMaxCliques' t' n = maxCliques graph
where
graph = mkGraphUfromEdges (Map.keys n')
-- n' = cooc2graph' d t' n
n' = case f of ByThreshold -> cooc2graph' d t' n
ByNeighbours -> cooc2graph'' d t' n
maxCliques :: Graph -> [[Node]]
maxCliques g = map (\n -> subMaxCliques g (n:ns)) ns & concat & takeMax
where
ns :: [Node]
ns = sortOn (degree g) $ nodes g
subMaxCliques :: Graph -> [Node] -> [[Node]]
subMaxCliques _ [] = [[]]
subMaxCliques g' (x:xs) = add x $ subMaxCliques g' ns'
where
ns' = [n | n <- xs, elem n $ neighborsOut g' x]
add :: Node -> [[Node]] -> [[Node]]
add n [] = [[n]]
add n (m:ms) = [n:m] <> add n ms
-- | Note, it is same as :
-- add n ns = map (\m -> n : m) ns
-- -- (but using pattern matching and recursivity)
-- -- (map is redefined in fact)
-- | To be sure self is not in neighbors of self
-- (out to exclude the self)
neighborsOut :: Graph -> Node -> [Node]
neighborsOut g'' n = filter (/= n) $ neighbors g'' n
takeMax :: [[Node]] -> [[Node]]
takeMax = map toList
. purge
. map fromList
. sortOn length
. nub
where
purge :: [Set Node] -> [Set Node]
purge [] = []
purge (x:xs) = x' <> purge xs
where
x' = if all (== False) (map (isSubsetOf x) xs)
then [x]
else []
------------------------------------------------------------------------
test_graph :: Graph
-- test_graph = mkGraphUfromEdges [(1,1), (2,2), (3,3)]
test_graph = mkGraphUfromEdges [(1,2), (3,3)]
test_graph' :: Graph
test_graph' = mkGraphUfromEdges [(1,2), (3,3), (3,2)]
test_graph'' :: Graph
test_graph'' = mkGraphUfromEdges [(1,2), (2,3), (1,3)]
test_graph''' :: Graph
test_graph''' = mkGraphUfromEdges [ (4,1)
, (4,2)
, (3,1)
, (3,2)
, (2,1)
]