# Finding a complete subgraph efficiently

I'm working on some experimental algorithms which would benefit from methods to find an instance of complete subgraphs with N vertices in an undirected graph. This far I've tried these methods:

• FindClique: apparently this doesn't work because Mathematica returns only maximal cliques. Try FindClique[CompleteGraph@5, {3}], for instance.

EDIT: Inspired by belisarius' comment, this does work:

findCompleteSubgraph[graph_Graph, size_Integer] :=
Subgraph[graph,
Take[Flatten@FindClique[graph, {size, VertexCount@graph}],
UpTo@size]];


... but isn't really faster than my naive algorithm below. The problem is that it finds the largest, not the the first (sub)clique of size size, and this can take quite a bit of time on an almost complete graph.

• Simplistic method trying to find exactly N vertices which have edge between each of them, using SatisfiabilityInstances, BooleanCountingFunction and regular Boolean expressions. Although this seems like an elegant solution, it's too slow and doesn't scale.
• Search using adjacency matrix converted to a list of bit-vectors, traversing the graph for a candidate using BitAnd instead of Intersection and population count function instead of Length. Essentially a harder-to-understand variation of the last method, but with the same run-time complexity.
• My best attempt, a very naive recursive graph traversal algorithm outlined here (with a benchmark for much smaller graphs than which I plan to use in real life):

Module[
{traverseStep, findCompleteSubgraph},

traverseStep[graph_Graph, size_Integer, visited_List,
traverseStep[graph_Graph, size_Integer, visited_List,
sharedadj_List] /; Length@visited == size := Throw@visited;
traverseStep[graph_Graph, size_Integer, visited_List,
(traverseStep[graph, size, Append[visited, #],
Throw@{});

findCompleteSubgraph[graph_Graph, size_Integer] :=
Subgraph[graph,
Catch[traverseStep[graph, size, {#},
VertexList[graph]]];

{Mean@#, Histogram@#} &@(First@Timing@findCompleteSubgraph[#, 5] & /@
Table[RandomGraph[{3000, Floor[3000^2/3]}], {50}])]


Can you think of a more efficient, preferably concise algorithm? Have I possibly missed an internal method for this task?

• A clique of size m>nis also a clique of size n by just removing the surplus vertices. So you can use FindClique[g] and check if the result is a list of length greater than 5. This looks faster. – Dr. belisarius Oct 23 '15 at 23:26
• Perhaps more to the point: FindClique[CompleteGraph[7], {5}] doesn't work, but FindClique[CompleteGraph[7]] does – Dr. belisarius Oct 23 '15 at 23:32
• Thinking again, not sure if this is much faster. But at least it is easier :) – Dr. belisarius Oct 24 '15 at 23:46
• I could add this to IGraph/M, but it wouldn't help: there is not way to quickly extract the internal representation of a Mathematica graph (even though I know it's there), so just transferring g = RandomGraph[{3000, Floor[3000^2/3]}]; to igraph ends up taking a full second. That's partly because EdgeList[g]; // AbsoluteTiming --> 0.4 s. AdjacencyMatrix[g]["NonzeroPositions"]; // AbsoluteTiming is 0.06 s, but that method is not general enough to support everything ... – Szabolcs Oct 26 '15 at 11:39
• @kirma I'm in the process of updating the igraph implementation to the the Cliquer library. But I don't know how the algorithm works. If you're looking for a library, Cliquer can do this, it has a function exactly for finding just one not-necessarily-maximal clique. You could write a LibraryLink interface to Cliquer. To make it fast, use the AdjacencyMatrix[g]["NonzeroPositions"] method to extract the edge list and send it as an MTensor with "Constant" passing, then convert to Cliquer format on the C side. – Szabolcs Oct 26 '15 at 12:28

This is a trivial implementation that searches all possible size-length paths in subgraphs that are complete during the search. Intersections of vertex lists are used to decide traversal path. Once sufficiently long path is found, Throw is used to exit recursive calls.

Module[{traverseStep, findCompleteSubgraph},
traverseStep[graph_Graph, found_List, size_Integer,
vertexlist_List] :=
(If[size <= 0, Throw@found];
Do[
traverseStep[graph, Append[found, vertexlist[[pos]]], size - 1,
Intersection[Drop[vertexlist, pos],
{pos, Length@vertexlist}]);

findCompleteSubgraph[graph_Graph, size_Integer] :=
Subgraph[graph,
Catch@(traverseStep[graph, {}, size, VertexList@graph];
Throw@{})];

{Mean@#, Histogram@#} &@(First@Timing@findCompleteSubgraph[#, 5] & /@
Table[RandomGraph[{3000, Floor[3000^2/3]}], {200}])]


This also works reasonably on sparse graphs:

{Mean@#, Histogram@#} &@(First@Timing@findCompleteSubgraph[#, 5] & /@
Table[RandomGraph[{3000, Floor[3000^2/50]}], {200}])


A highlighted example:

HighlightGraph[#, findCompleteSubgraph[#, 6]] &@RandomGraph[{12, 50}]