2
$\begingroup$

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} & @@@ 
   Transpose[{Flatten[
      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?

$\endgroup$

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.