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 = sortOn (degree g) $ nodes g
  70
  71     subMaxCliques :: Graph -> [Node] -> [[Node]]
  72     subMaxCliques _ []  = [[]]
  73     subMaxCliques g' (x:xs) = add x $ subMaxCliques g' ns'
  74       where
  75         ns' = [n | n <- xs, elem n $ neighborsOut g' x]
  76
  77         add :: Node -> [[Node]] -> [[Node]]
  78         add n [] = [[n]]
  79         add n (m:ms) = [n:m] <> add n ms
  80         -- | Note, it is same as :
  81         -- add n ns = map (\m -> n : m) ns
  82         -- -- (but using pattern matching and recursivity)
  83         -- -- (map is redefined in fact)
  84
  85         -- | To be sure self is not in neighbors of self
  86         -- (out to exclude the self)
  87         neighborsOut :: Graph -> Node -> [Node]
  88         neighborsOut g'' n = filter (/= n) $ neighbors g'' n
  89
  90
  91     takeMax :: [[Node]] -> [[Node]]
  92     takeMax =  map toList . purge . map fromList . sortOn length . nub
  93       where
  94         purge :: [Set Node] -> [Set Node]
  95         purge [] = []
  96         purge (x:xs) = x' <> purge xs
  97           where
  98             x' = if all (== False) (map (isSubsetOf x) xs)
  99                     then [x]
 100                     else []
 101
 102
 103 ------------------------------------------------------------------------
 104 test_graph :: Graph
 105 -- test_graph = mkGraphUfromEdges [(1,1), (2,2), (3,3)]
 106 test_graph = mkGraphUfromEdges [(1,2), (3,3)]
 107
 108 test_graph' :: Graph
 109 test_graph' = mkGraphUfromEdges [(1,2), (3,3), (3,2)]
 110
 111 test_graph'' :: Graph
 112 test_graph'' = mkGraphUfromEdges [(1,2), (2,3), (1,3)]
 113
 114 test_graph''' :: Graph
 115 test_graph''' = mkGraphUfromEdges [ (4,1)
 116                                   , (4,2)
 117                                   , (3,1)
 118                                   , (3,2)
 119                                   , (2,1)
 120                                   ]