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
  51 module Gargantext.Viz.Graph.MaxClique
  52   where
  53
  54 import Data.Maybe (catMaybes)
  55 import Gargantext.Prelude
  56 import Data.Map (Map)
  57 import qualified Data.Map as Map
  58 import Data.List (sortOn, nub, concat, length)
  59 import Data.Set (Set)
  60 import Data.Set (fromList, toList, isSubsetOf)
  61 import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
  62 import Gargantext.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
  63 import Gargantext.Viz.Graph.Tools (cooc2graph', Threshold)
  64 import Gargantext.Viz.Graph.Index (createIndices, toIndex)
  65 type Graph = Graph_Undirected
  66 type Neighbor = Node
  67
  68
  69 -- | getMaxCliques
  70 -- TODO chose distance order
  71 getMaxCliques :: Ord a => Threshold -> Map (a, a) Int -> [[a]]
  72 getMaxCliques t m = map fromIndices $ getMaxCliques' t m'
  73   where
  74     m'          = toIndex to m
  75     (to,from)   = createIndices m
  76     fromIndices = catMaybes . map (\n -> Map.lookup n from)
  77
  78     getMaxCliques' :: Threshold -> Map (Int, Int) Int -> [[Int]]
  79     getMaxCliques' t' n = maxCliques graph
  80       where
  81         graph = mkGraphUfromEdges (Map.keys n')
  82         n'    = cooc2graph' t' n
  83
  84 maxCliques :: Graph -> [[Node]]
  85 maxCliques g = map (\n -> subMaxCliques g (n:ns)) ns & concat & takeMax
  86   where
  87     ns :: [Node]
  88     ns = sortOn (degree g) $ nodes g
  89
  90     subMaxCliques :: Graph -> [Node] -> [[Node]]
  91     subMaxCliques _ []  = [[]]
  92     subMaxCliques g' (x:xs) = add x $ subMaxCliques g' ns'
  93       where
  94         ns' = [n | n <- xs, elem n $ neighborsOut g' x]
  95
  96         add :: Node -> [[Node]] -> [[Node]]
  97         add n [] = [[n]]
  98         add n (m:ms) = [n:m] <> add n ms
  99         -- | Note, it is same as :
 100         -- add n ns = map (\m -> n : m) ns
 101         -- -- (but using pattern matching and recursivity)
 102         -- -- (map is redefined in fact)
 103
 104         -- | To be sure self is not in neighbors of self
 105         -- (out to exclude the self)
 106         neighborsOut :: Graph -> Node -> [Node]
 107         neighborsOut g'' n = filter (/= n) $ neighbors g'' n
 108
 109
 110     takeMax :: [[Node]] -> [[Node]]
 111     takeMax = map toList
 112             . purge
 113             . map fromList
 114             . sortOn length
 115             . nub
 116       where
 117         purge :: [Set Node] -> [Set Node]
 118         purge [] = []
 119         purge (x:xs) = x' <> purge xs
 120           where
 121             x' = if all (== False) (map (isSubsetOf x) xs)
 122                     then [x]
 123                     else []
 124
 125
 126 ------------------------------------------------------------------------
 127 test_graph :: Graph
 128 -- test_graph = mkGraphUfromEdges [(1,1), (2,2), (3,3)]
 129 test_graph = mkGraphUfromEdges [(1,2), (3,3)]
 130
 131 test_graph' :: Graph
 132 test_graph' = mkGraphUfromEdges [(1,2), (3,3), (3,2)]
 133
 134 test_graph'' :: Graph
 135 test_graph'' = mkGraphUfromEdges [(1,2), (2,3), (1,3)]
 136
 137 test_graph''' :: Graph
 138 test_graph''' = mkGraphUfromEdges [ (4,1)
 139                                   , (4,2)
 140                                   , (3,1)
 141                                   , (3,2)
 142                                   , (2,1)
 143                                   ]