src/Gargantext/Core/Methods/Graph/MaxClique.hs

   1 {-| Module      : Gargantext.Core.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 - Result of the workshop, Pyremiel 2019
  10   - First written by Bruno Gaume in Python        (see below for details)
  11   - Then  written by Alexandre Delanoë in Haskell (see below for details)
  12
  13 # By Bruno Gaume:
  14 def fast_maximal_cliques(g):
  15
  16     def rec_maximal_cliques(g, subv):
  17         mc = []
  18         if subv == []: # stop condition
  19             return [[]]
  20         else :
  21             for i in range(len(subv)):
  22                 newsubv = [j for j in subv[i+1:len(subv)]
  23                                    if (j in g.neighbors(subv[i]))]
  24                 mci = rec_maximal_cliques(g, newsubv)
  25                 for x in mci:
  26                     x.append(subv[i])
  27                     mc.append(x)
  28             return mc
  29
  30     def purge(clust):
  31         clustset = [set(x) for x in clust]
  32         new_clust = []
  33         for i in range(len(clustset)):
  34             ok = True
  35             for j in range(len(clustset)):
  36                 if clustset[i].issubset(clustset[j]) and (not (len(clustset[i]) == len(clustset[j])) ):
  37                     ok = False
  38             if ok and (not (clustset[i] in new_clust)):
  39                 new_clust.append(clustset[i])
  40         return [list(x) for x in new_clust]
  41
  42     # to optimize : rank the vertices on the degrees
  43     subv = [(v.index, v.degree()) for v in g.vs()]
  44     subv.sort(key = lambda z:z[1])
  45     subv = [x for (x, y) in subv]
  46     return purge(rec_maximal_cliques(g, subv))
  47
  48 -}
  49
  50
  51
  52 module Gargantext.Core.Methods.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)
  60 import Data.Set (Set)
  61 import Data.Set (fromList, toList, isSubsetOf)
  62 import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
  63 import Gargantext.Core.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
  64 import Gargantext.Core.Viz.Graph.Tools (cooc2graph', Threshold)
  65 import Gargantext.Core.Methods.Distances (Distance)
  66 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex)
  67
  68 type Graph = Graph_Undirected
  69 type Neighbor = Node
  70
  71 -- | getMaxCliques
  72 -- TODO chose distance order
  73 getMaxCliques :: Ord a => Distance -> Threshold -> Map (a, a) Int -> [[a]]
  74 getMaxCliques d t m = map fromIndices $ getMaxCliques' t m'
  75   where
  76     m'          = toIndex to m
  77     (to,from)   = createIndices m
  78     fromIndices = catMaybes . map (\n -> Map.lookup n from)
  79
  80     getMaxCliques' :: Threshold -> Map (Int, Int) Int -> [[Int]]
  81     getMaxCliques' t' n = maxCliques graph
  82       where
  83         graph = mkGraphUfromEdges (Map.keys n')
  84         n'    = cooc2graph' d t' n
  85
  86 maxCliques :: Graph -> [[Node]]
  87 maxCliques g = map (\n -> subMaxCliques g (n:ns)) ns & concat & takeMax
  88   where
  89     ns :: [Node]
  90     ns = sortOn (degree g) $ nodes g
  91
  92     subMaxCliques :: Graph -> [Node] -> [[Node]]
  93     subMaxCliques _ []  = [[]]
  94     subMaxCliques g' (x:xs) = add x $ subMaxCliques g' ns'
  95       where
  96         ns' = [n | n <- xs, elem n $ neighborsOut g' x]
  97
  98         add :: Node -> [[Node]] -> [[Node]]
  99         add n [] = [[n]]
 100         add n (m:ms) = [n:m] <> add n ms
 101         -- | Note, it is same as :
 102         -- add n ns = map (\m -> n : m) ns
 103         -- -- (but using pattern matching and recursivity)
 104         -- -- (map is redefined in fact)
 105
 106         -- | To be sure self is not in neighbors of self
 107         -- (out to exclude the self)
 108         neighborsOut :: Graph -> Node -> [Node]
 109         neighborsOut g'' n = filter (/= n) $ neighbors g'' n
 110
 111
 112     takeMax :: [[Node]] -> [[Node]]
 113     takeMax = map toList
 114             . purge
 115             . map fromList
 116             . sortOn length
 117             . nub
 118       where
 119         purge :: [Set Node] -> [Set Node]
 120         purge [] = []
 121         purge (x:xs) = x' <> purge xs
 122           where
 123             x' = if all (== False) (map (isSubsetOf x) xs)
 124                     then [x]
 125                     else []
 126
 127
 128 ------------------------------------------------------------------------
 129 test_graph :: Graph
 130 -- test_graph = mkGraphUfromEdges [(1,1), (2,2), (3,3)]
 131 test_graph = mkGraphUfromEdges [(1,2), (3,3)]
 132
 133 test_graph' :: Graph
 134 test_graph' = mkGraphUfromEdges [(1,2), (3,3), (3,2)]
 135
 136 test_graph'' :: Graph
 137 test_graph'' = mkGraphUfromEdges [(1,2), (2,3), (1,3)]
 138
 139 test_graph''' :: Graph
 140 test_graph''' = mkGraphUfromEdges [ (4,1)
 141                                   , (4,2)
 142                                   , (3,1)
 143                                   , (3,2)
 144                                   , (2,1)
 145                                   ]