I have a bipartite graph given as:

n = 3;
ed = Flatten[
  Table[{Subscript[a, i] \[DirectedEdge] Subscript[b, j]}, {i, 1, n}, {j, 1, n}], 2];

vCor = Flatten[{#1 -> #2} & @@@ 
      Table[{Subscript[a, i], Subscript[b, i]}, {i, 1, n}]], 
     Flatten[Table[{{0, i}, {1, i}}, {i, 0, n - 1}], 1]}]];

edgeWeights = RandomInteger[{1, 20}, {n, n}]

rules = Flatten[{#1 -> #2} & @@@ 
    Transpose[{ed, Flatten[edgeWeights]}]];

g = Graph[ed, VertexCoordinates -> vCor, 
   EdgeWeight -> Flatten[-edgeWeights], VertexLabels -> Automatic];

I wish to find the assignment from one set of vertex to the other such that the maximum value of edge is minimum for the assignment (also, known as bottleneck problem).

I could solve for minimization of the overall cost, that is the sum of the edge weights:

res = FindIndependentEdgeSet[g];
HighlightGraph[g, res];
Total[res /. rules]

Is there a standard funtion to solve the bottleneck problem in Mathematica, or is there a way I could define a function for finding the independent edge set such that it solves the bottleneck problem?


Your Answer

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

Browse other questions tagged or ask your own question.