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