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