9
$\begingroup$

I have found the Perfect Matching's definition in Wiki.

A perfect matching (a.k.a. 1-factor) is a matching which matches all vertices of the graph. That is, every vertex of the graph is incident to exactly one edge of the matching.

Or another samilar definition, Near-Perfect Matching, as follows:

A near-perfect matching is one in which exactly one vertex is unmatched. This can only occur when the graph has an odd number of vertices, and such a matching must be maximum.

I can give some example to illustrate it. In a simple graph

Graph[{1 <-> 4, 1 <-> 5, 1 <-> 6, 2 <-> 4, 2 <-> 5, 2 <-> 6, 3 <-> 6},
  VertexLabels -> "Name", GraphLayout -> "BipartiteEmbedding"]

Mathematica graphics

We can judge it by eye, such as the 3-6, 2-5, 1-4 or 3-6, 2-4, 1-5 is the Perfect Matching. But in some complicated case it will be harder to judge. For example:

Graph[{1 <-> 16, 1 <-> 17, 1 <-> 18, 1 <-> 19, 1 <-> 20, 1 <-> 21, 
  2 <-> 16, 2 <-> 17, 2 <-> 18, 2 <-> 22, 2 <-> 23, 2 <-> 24, 
  3 <-> 16, 3 <-> 19, 3 <-> 20, 3 <-> 22, 3 <-> 23, 3 <-> 25, 
  4 <-> 17, 4 <-> 19, 4 <-> 21, 4 <-> 22, 4 <-> 24, 4 <-> 25, 
  5 <-> 18, 5 <-> 20, 5 <-> 21, 5 <-> 23, 5 <-> 24, 5 <-> 25, 
  6 <-> 16, 6 <-> 17, 6 <-> 18, 6 <-> 26, 6 <-> 27, 6 <-> 28, 
  7 <-> 16, 7 <-> 19, 7 <-> 20, 7 <-> 26, 7 <-> 27, 7 <-> 29, 
  8 <-> 17, 8 <-> 19, 8 <-> 21, 8 <-> 26, 8 <-> 28, 8 <-> 29, 
  9 <-> 18, 9 <-> 20, 9 <-> 21, 9 <-> 27, 9 <-> 28, 9 <-> 29, 
  10 <-> 16, 10 <-> 22, 10 <-> 23, 10 <-> 26, 10 <-> 27, 10 <-> 30, 
  11 <-> 17, 11 <-> 22, 11 <-> 24, 11 <-> 26, 11 <-> 28, 11 <-> 30, 
  12 <-> 18, 12 <-> 23, 12 <-> 24, 12 <-> 27, 12 <-> 28, 12 <-> 30, 
  13 <-> 19, 13 <-> 22, 13 <-> 25, 13 <-> 26, 13 <-> 29, 13 <-> 30, 
  14 <-> 20, 14 <-> 23, 14 <-> 25, 14 <-> 27, 14 <-> 29, 14 <-> 30, 
  15 <-> 21, 15 <-> 24, 15 <-> 25, 15 <-> 28, 15 <-> 29, 15 <-> 30}, 
 GraphLayout -> "BipartiteEmbedding"]

Mathematica graphics

I'm dizzy now. We can use GraphData["PerfectMatching"] to produce some graph with PerfectMatching to give it a try.

Question:

How to get all possible Perfect Matching or Near-Perfect Matching using Mathematica?

$\endgroup$
  • $\begingroup$ See FindIndependentEdgeSet[ ] ...it finds ONE $\endgroup$ – Dr. belisarius Apr 1 '16 at 5:56
  • $\begingroup$ @Dr.belisarius Good point out.If we can find all mach,then we can select that minimal or maximal perfect maching in a weight graph.So if we can do it.I wish find all of it. $\endgroup$ – yode Apr 1 '16 at 6:48
13
$\begingroup$

There's (almost certainly) no way to do this efficiently, except for small graphs. According to Wikipedia:

The number of matchings in a graph is known as the Hosoya index of the graph. It is #P-complete to compute this quantity, even for bipartite graphs.[13] It is also #P-complete to count perfect matchings, even in bipartite graphs [...]

Where "#P-complete" basically means there is no (known) efficient algorithm. So your chances of enumerating all perfect matchings for anything but a tiny graph aren't high.

But from your comment, that's not really what you want:

If we can find all mach,then we can select that minimal or maximal perfect maching in a weight graph.So if we can do it.I wish find all of it.

That's a bit like sorting a list by enumerating all permutations until you find one that's sorted. Certainly possible for small lists, but not how you would do it in practice.

There are efficient algorithms to find a maximal weighted matching. The easiest way to do it in Mathematica is probably to use linear programming, as I've done here, or to use FindMinimumCostFlow, like this:

g = Graph[
   {1 -> 4, 1 -> 5, 1 -> 6, 2 -> 4, 2 -> 5, 2 -> 6, 3 -> 6}, 
   VertexLabels -> "Name", GraphLayout -> "BipartiteEmbedding"];
supplyDemand=If[# <= 3, 1, -1] & /@ VertexList[g];
f = FindMinimumCostFlow[g,
   supplyDemand,
   "OptimumFlowData", EdgeCost -> {1, 2, 3, 4, 5, 6, 7}];

f["CostValue"]

13

f["FlowGraph"]

enter image description here

The intuitive explanation is that you have a road network, linking nodes that "supply" some quantity and nodes that "demand" some quantity. We give the nodes on the "left" side of the bipartite graph a supply of 1, and the nodes on the "right" side a demand of 1 (i.e. a supply of -1). Then we let FindMinimumCostFlow find the lowest-cost flow given some edge weights. And that's your min-weight maximal matching. For a max-weight matching, simply flip the sign of the edge costs.

$\endgroup$
  • $\begingroup$ Hello,nikie.I have read your answer this period of time many times.It is very useful to me .Thanks very very much.And I posted a stupid method to implement it just now. $\endgroup$ – yode Jun 12 '16 at 4:44
  • $\begingroup$ Have you ever seen SparseArray`MaximalBipartiteMatching, SparseArray`MaximalIndependentVertexSet, SparseArray`MaximalMatching?You wil like it. :) $\endgroup$ – yode Dec 17 '16 at 19:29
3
$\begingroup$

Since the @nikie say this is #P-complete.So I enumerate it to get all of the minimal or maximal perfect maching.Of course,we can get the all possible Perfect Matching or Near-Perfect Matching as this topic by the same method.But the maximal and minimum match is more useful to us.So I post it as a example.Maybe more pretty solution can do this.I'll glad to know that.

Suppose we have a reduced adjacency matrix of a bipartite graph like

list={{3,5,8,10,11},{6,6,5,7,4},{7,5,12,9,6},{5,6,13,10,7},{3,5,7,9,8}};

Custom a function to restore it to be graph

ReducedAdjacencyGraph[list_] := 
 WeightedAdjacencyGraph[
  ArrayFlatten[{{0, list}, {Transpose@list, 0}}] /. 0 -> Infinity, 
  VertexLabels -> "Name", 
  GraphLayout -> {"BipartiteEmbedding", "Rotation" -> 3 Pi/2, 
    "AspectRatio" -> 2}, EdgeLabels -> Placed["EdgeWeight", 0.15], 
  EdgeLabelStyle -> Directive[Red, Italic, 10]]

Get the graph of g

g = ReducedAdjacencyGraph[list]

Enumerating to get all of the maximal perfect maching(Of course the minximal maching can be get with the same method.)

pos = MinimalBy[
  Permanent@Array[tem[#1, #2] &, {5, 5}] /. {Times -> List, 
    tem -> List, Plus -> List}, Total[Extract[list, #]] &]

{{{1,2},{2,3},{3,5},{4,4},{5,1}},{{1,2},{2,3},{3,4},{4,5},{5,1}},{{1,1},{2,3},{3,5},{4,4},{5,2}},{{1,1},{2,3},{3,4},{4,5},{5,2}},{{1,1},{2,5},{3,4},{4,2},{5,3}},{{1,1},{2,4},{3,5},{4,2},{5,3}},{{1,1},{2,5},{3,2},{4,4},{5,3}},{{1,1},{2,4},{3,2},{4,5},{5,3}},{{1,1},{2,3},{3,5},{4,2},{5,4}},{{1,1},{2,3},{3,2},{4,5},{5,4}}}

Use frame to show the position we get

MatrixForm /@ (MapAt[Framed, list, #] & /@ pos)

And we can see these all combination is maximum

Total/@(Extract[list,#]&/@pos)

{29, 29, 29, 29, 29, 29, 29, 29, 29, 29}

Hightlight all combination we get

allCombination = 
  Normal[SparseArray[# -> 1, Dimensions[list]]] & /@ pos;
HighlightGraph[g, ReducedAdjacencyGraph[#], 
   GraphHighlightStyle -> "Thick"] & /@ allCombination

$\endgroup$
  • $\begingroup$ Try this for a graph with e.g. 2x20 nodes instead of 2x5. FindMinimumCostFlow finds a minimal perfect matching for a 2x20 graph in under a second... $\endgroup$ – Niki Estner Jun 12 '16 at 6:45
  • $\begingroup$ @nikie I'll speed up it in some time.And I'll replace the Permanent $\endgroup$ – yode Jun 12 '16 at 6:47
  • 1
    $\begingroup$ If you manage to speed it up so that it finishes for e.g. n=25 before the universe ends, you'll probably get a Nobel prize, and a few others. There are 15511210043330985984000000 possible matchings for n=25, you can't try them all. $\endgroup$ – Niki Estner Jun 12 '16 at 6:54
  • $\begingroup$ @nikie It seem I cannot get that prize.So pity. :) $\endgroup$ – yode Jun 12 '16 at 6:57
  • $\begingroup$ To ease the difficulty of Permanent[], I gave in this answer a slightly more efficient method for computing it. $\endgroup$ – J. M. will be back soon Jun 13 '16 at 4:35
3
$\begingroup$

The IGLargestIndependentVertexSets is what I after,which from Szabolcs's package IGraphM,when the point is less 15 or much less.I mean,the effeciency it very very poor.

g = Graph[{1 <-> 4, 1 <-> 5, 1 <-> 6, 2 <-> 4, 2 <-> 5, 2 <-> 6, 
   3 <-> 6}, VertexLabels -> "Name", 
  GraphLayout -> "BipartiteEmbedding"]

Mathematica graphics

iden = EdgeList[g][[#]] & /@ 
  IGLargestIndependentVertexSets[LineGraph[g]]
HighlightGraph[g, #] & /@ iden

Mathematica graphics

$\endgroup$

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.