s-t min-cut in a graph

Question

I want to find a minimum s-t cut in a graph. According to the max-flow-min-cut theorem, from a maximum flow, I can find min cut. I didn't find built-in function to calculate the min-cut, only built-in function to calculate a max flow.

I have implemented the s-t min-cut in a directed graph(using the explanation from this site). The code is below

Graph creation:

 checkGrap = 
   Graph[{1 \[DirectedEdge] 2, 1 \[DirectedEdge] 3, 
   3 \[DirectedEdge] 1, 2 \[DirectedEdge] 3, 4 \[DirectedEdge] 2, 
   3 \[DirectedEdge] 4, 5 \[DirectedEdge] 1, 5 \[DirectedEdge] 3, 
   2 \[DirectedEdge] 6, 4 \[DirectedEdge] 6}, VertexLabels -> "Name"];
   weighsToEdgesVT = {12, 10, 4, 9, 7, 14, 16, 13, 20, 4};

  testGrapWe = 
  Graph[VertexList[checkGrap], EdgeList[checkGrap], 
   EdgeWeight -> weighsToEdgesVT, VertexLabels -> "Name"]

Residual graph calculation:

flowData = FindMaximumFlow[checkGrap, 5, 6, "OptimumFlowData", EdgeCapacity -> weithsToEdgesVT];
flowMAtrix = flowData["FlowMatrix"];
originalMatrix = WeightedAdjacencyMatrix[testGrapWe];
residualMatrix = (N[originalMatrix - flowMAtrix]);
mc = SparseArray[ ArrayRules[residualMatrix] /. {0. -> Infinity}, 
Dimensions[residualMatrix]];

Nodes reachable from source:

residualGraph = WeightedAdjacencyGraph[mc, VertexLabels -> "Name"];
nodes = Reap[BreadthFirstScan[residualGraph,5, {"DiscoverVertex" -> 
(Sow[#1] &)}]][[2, 1]]

The cut

 cut = EdgeList[checkGrap, 
  DirectedEdge[Alternatives @@ nodes, 
   Alternatives @@ 
    Complement[VertexOutComponent[checkGrap, nodes], nodes]]]

Any suggestion how to speed up the code( I want to run it on a graph with ~30000 nodes and ~100000 edges)

Answer 1

To find a minimum s-t edge cut, it should be possible to use FindEdgeCut. It is explicitly stated in the documentation that it supports edge weights:

For weighted graphs, FindEdgeCut gives an edge cut with the smallest sum of edge weights.

However, it is buggy.

This is your graph:

Graph[testGrapWe, EdgeLabels -> "EdgeWeight"]

EdgeConnectivity gives a correct result:

EdgeConnectivity[testGrapWe, 5, 6]

(* 23 *)

But not FindEdgeCut:

FindEdgeCut[testGrapWe, 5, 6]
(* {5 \[DirectedEdge] 1, 5 \[DirectedEdge] 3} *)

These two edges have a total weight of 29, not 23.

Let's see if the issue gets fixed for the next version ...

---

In the meantime, you can use the latest version of IGraph/M to find a minimum cut. IGraph/M has separate functions for edge connectivity (i.e. unweighted edge cut) and minimum cut (i.e. weighted).

The connectivity is 2 because these vertices can be disconnected by the removal of only 2 edges.

IGEdgeConnectivity[testGrapWe, 5, 6]
(* 2 *)

But if we go for the minimum total weight cut, we need to remove 3 edges:

IGMinimumCut[testGrapWe, 5, 6]
(* {1 \[DirectedEdge] 2, 4 \[DirectedEdge] 2, 4 \[DirectedEdge] 6} *)

IGMinimumCutValue[testGrapWe, 5, 6]
(* 23. *)

The performance is reasonable on large graphs:

bigGraph = 
  ExampleData[{"NetworkGraph", "CondensedMatterCollaborations2005"}];

{VertexCount[bigGraph], EdgeCount[bigGraph]}
(* {40421, 175692} *)

IGEdgeWeightedQ[bigGraph]
(* True *)

IGMinimumCutValue[bigGraph, 10, 1000] // RepeatedTiming
(* {0.13, 13.6} *)

IGMinimumCut[bigGraph, 10, 1000] // RepeatedTiming
(* {0.17, {1000 \[UndirectedEdge] 999, 
  1000 \[UndirectedEdge] 485, 1000 \[UndirectedEdge] 484, 
  1000 \[UndirectedEdge] 200, 3797 \[UndirectedEdge] 485, 
  3797 \[UndirectedEdge] 484, 1442 \[UndirectedEdge] 1000, 
  2742 \[UndirectedEdge] 1000, 3032 \[UndirectedEdge] 1000, 
  7601 \[UndirectedEdge] 1000, 7601 \[UndirectedEdge] 3797, 
  12371 \[UndirectedEdge] 1000, 12371 \[UndirectedEdge] 3797, 
  17309 \[UndirectedEdge] 1000, 17741 \[UndirectedEdge] 1000, 
  24536 \[UndirectedEdge] 1000, 34123 \[UndirectedEdge] 1000}} *)

Note that in principle a built-in function can always be faster than an IGraph/M function because IGraph/M needs to convert the graph to igraph's internet representation. This can be slow, especially considering that Mathematica provides to fast API to convert graphs to a form amenable to processing in C code. A significant amount of time is spent in converting the graph.

In this specific case, I believe this to be the reason why EdgeConnecvitiy is more than twice faster.

EdgeConnectivity[bigGraph, 10, 1000] // RepeatedTiming
(* {0.054, 13.6} *)

Let us thus hope that the bug in FindEdgeCut will be fixed in the next version of Mathematica! Note that I exposed this functionality in IGraph/M specifically because of this bug—I usually avoid duplicating existing functionality without good reason.