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 {-
  67 -- prefiltre
  68 -- Texte -> Ngrams
  69 -- Map Terms
  70 -- pré-filtre: spécifiques
  71 -- soit conditionnelle, matrice spécifiques
  72 -- combien de voisins maximum avant le calcul de cliques (les génériques)
  73 -- calcul maxcliques
  74 -- calcul de densité/inclusion si graph gros
  75 --
  76 -- FIS: ensemble de termes un niveau du document
  77 -- maxclique: ensemble de termes au niveau de l'ensemble du document
  78
  79 type Density = Double
  80 maxCliques' :: [[Text]] -> Map (Set Ngrams) Density
  81 maxCliques' = undefined
  82 -}
  83
  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                                   ]