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