{-| 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)
]