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 where
  53
  54 import Gargantext.Prelude
  55 import Data.List (sortOn, nub, concat, length)
  56 import Data.Set (Set)
  57 import Data.Set (fromList, toList, isSubsetOf)
  58 import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
  59 import Gargantext.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
  60
  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 . purge . map fromList . sortOn length . nub
  94       where
  95         purge :: [Set Node] -> [Set Node]
  96         purge [] = []
  97         purge (x:xs) = x' <> purge xs
  98           where
  99             x' = if all (== False) (map (isSubsetOf x) xs)
 100                     then [x]
 101                     else []
 102
 103
 104 ------------------------------------------------------------------------
 105 test_graph :: Graph
 106 -- test_graph = mkGraphUfromEdges [(1,1), (2,2), (3,3)]
 107 test_graph = mkGraphUfromEdges [(1,2), (3,3)]
 108
 109 test_graph' :: Graph
 110 test_graph' = mkGraphUfromEdges [(1,2), (3,3), (3,2)]
 111
 112 test_graph'' :: Graph
 113 test_graph'' = mkGraphUfromEdges [(1,2), (2,3), (1,3)]
 114
 115 test_graph''' :: Graph
 116 test_graph''' = mkGraphUfromEdges [ (4,1)
 117                                   , (4,2)
 118                                   , (3,1)
 119                                   , (3,2)
 120                                   , (2,1)
 121                                   ]