6
$\begingroup$

I'm trying to find all perfect matchings for some bipartite graphs. For example

    Graph[{1, 2, 4, 6, 3, 8, 5, 7}, {1 <-> 2, 1 <-> 4, 1 <-> 6, 3 <-> 4, 
    3 <-> 6, 3 <-> 8, 5 <-> 6, 5 <-> 8, 5 <-> 2, 7 <-> 8, 7 <-> 2, 
    7 <-> 4}]

Now I can use

    FindIndependentEdgeSet[%]

which indeed gives me a perfect matching, but it does not give me all. Is there a way to easily find all perfect matchings?

$\endgroup$
  • 1
    $\begingroup$ Counting perfect matchings of a bipartite graph is equivalent to computing the permanent of a 01-matrix, which is #P-complete (thus there is no easy way in this sense). $\endgroup$ – Juho Mar 16 '15 at 13:23
4
$\begingroup$

A quick way to program this is through finding all maximum independent vertex sets of the line graph:

lg = LineGraph[g];
EdgeList[g][[#]] & /@ 
 FindIndependentVertexSet[lg, Length /@ FindIndependentVertexSet[lg], All]
HighlightGraph[g, #] & /@ %

enter image description here

$\endgroup$
  • $\begingroup$ What if you want to include the non-perfect ones as well? You can take subsets? $\endgroup$ – Alexander Kartun-Giles Feb 14 at 14:51
  • $\begingroup$ I used Flatten[Subsets[#] & /@ edges, 1] where edges=EdgeList[g][[#]] & /@ FindIndependentVertexSet[lg, Length /@ FindIndependentVertexSet[lg], All], then HighlightGraph[g,%] $\endgroup$ – Alexander Kartun-Giles Feb 14 at 15:04
4
$\begingroup$

I've implemented the algorithm given in the paper

Algorithms for Enumerating All Perfect, Maximum and Maximal Matchings in Bipartite Graphs.

This algorithm takes as input a directed bipartite graph and should give a list of all perfect matchings as output.

EnumPerfectMatchings[G_] := 
 EnumPerfectMatchingsIter[G, FindIndependentEdgeSet[G]]

EnumPerfectMatchingsIter[G_, M_] := If[
  Length[EdgeList[G]] == 0,
  {M},
  Module[{DGM, DM, DG, NewM, c, e, Gp, Gm, p},
   DM = M;
   DG = DirectedEdge @@@ 
     Reverse /@ List @@@ Complement[EdgeList[G], M];
   DGM = Graph[VertexList[G], Join[DM, DG]];
   c = FindCycle[DGM];
   If[Length[c] != 0, c = Flatten[c], Return[{M}]];
   c = Transpose@Partition[c, 2];
   If[MemberQ[DG, c[[1, 1]]], c = Reverse[c]];
   c = {c[[1]], DirectedEdge @@@ Reverse /@ List @@@ c[[2]]};
   NewM = Join[Complement[M, c[[1]]], c[[2]]];
   e = c[[1, 1]];
   p = List @@ e;
   Gp = Graph[Complement[VertexList[G], p], 
     Select[EdgeList[G], Intersection[List @@ #, p] == {} &]];
   Gm = Graph[VertexList[G], Complement[EdgeList[G], {e}]];
   Join[EnumPerfectMatchingsIter[Gm, NewM], 
    Map[Append[#, e] &, 
     EnumPerfectMatchingsIter[Gp, Complement[M, {e}]]]]
   ]
  ]

For the graph given in the question it returns the correct result 0.007 sec on my machine.

$\endgroup$
  • $\begingroup$ Trying to run this in M11.3 will blow up my session irreparably $\endgroup$ – Szabolcs Dec 4 '18 at 17:37
  • $\begingroup$ @Szabolcs Yes, it does the same for me now too. I seem to remember it working quite well at the time. I do not think it will be very useful to find out what has changed in the meantime, since your posted answer is much more concise anyway. $\endgroup$ – Pjotr5 Dec 4 '18 at 17:41
2
$\begingroup$

You can do this with the following code:

points = {1, 2, 4, 6, 3, 8, 5, 7};
edges = {1 <-> 2, 1 <-> 4, 1 <-> 6, 3 <-> 4, 3 <-> 6, 3 <-> 8, 
          5 <-> 6, 5 <-> 8, 5 <-> 2, 7 <-> 8, 7 <-> 2, 7 <-> 4};

tmp=Table[FindIndependentEdgeSet[Graph[i, edges]], {i,Permutations[points]}]// DeleteDuplicates;
tmp=tmp/.UndirectedEdge[x_, y_] /; x > y :> UndirectedEdge[y, x];
Table[Sort[i, #1[[1]] < #2[[1]] &], {i, tmp}] // DeleteDuplicates

which will try all vertex permutations, whose order in turn is used by FindIndependentEdgeSet to produce its result.

{{1 <-> 2, 3 <-> 6, 4 <-> 7, 5 <-> 8}, {1 <-> 2, 3 <-> 4, 5 <-> 6, 
  7 <-> 8}, {1 <-> 2, 3 <-> 8, 4 <-> 7, 5 <-> 6}, {1 <-> 4, 2 <-> 5, 
  3 <-> 6, 7 <-> 8}, {1 <-> 4, 2 <-> 7, 3 <-> 6, 5 <-> 8}, {1 <-> 4, 
  2 <-> 7, 3 <-> 8, 5 <-> 6}, {1 <-> 6, 2 <-> 5, 3 <-> 4, 
  7 <-> 8}, {1 <-> 6, 2 <-> 7, 3 <-> 4, 5 <-> 8}, {1 <-> 6, 2 <-> 5, 
  3 <-> 8, 4 <-> 7}}
$\endgroup$
  • $\begingroup$ @Pjotr5: Did my answer work out for you? $\endgroup$ – Jinxed Mar 21 '15 at 16:20
  • $\begingroup$ Thank you for your answer. I'm sorry I took so long to respond. Your code was helpful and I did use it on that day, but because it has to calculate all vertex permutations it is really only usable for relatively small graphs. I've implemented another algorithm which I found online. This algorithm goes about it in a slightly more efficient way. I've posted the code as an answer to the question. $\endgroup$ – Pjotr5 May 8 '15 at 8:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.