How to get all Perfect or Near-Perfect Matchings of a graph
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"]
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.
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
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"]
iden = EdgeList[g][[#]] & /@
IGLargestIndependentVertexSets[LineGraph[g]]
HighlightGraph[g, #] & /@ iden