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