3
$\begingroup$

An edge cut of a graph g is a set of edges whose deletion from g disconnects g. In Mathematica, we can use the function FindEdgeCut to find a minimum edge cut of a graph, but not all. For example.

g=Graph[{1, 2, 3, 4, 5, 6}, {UndirectedEdge[1, 2], UndirectedEdge[2, 3], UndirectedEdge[3, 4], UndirectedEdge[1, 5], UndirectedEdge[5, 6], UndirectedEdge[6, 4], UndirectedEdge[2, 5], 
UndirectedEdge[3, 6]}, {FormatType -> TraditionalForm, GraphHighlightStyle -> {"Thick"}, GridLinesStyle -> Directive[GrayLevel[0.5, 0.4]], ImagePadding -> 0, VertexLabels -> 
{Placed["Name", Center]}, VertexSize -> {0.4}, VertexStyle -> {GrayLevel[1]}}]

FindEdgeCut[g]
HighlightGraph[g, %]

enter image description here

Clearly, $\{(12),(15)\}$, $\{(34),(46)\}$ are also minimum edge cuts, respectively.


Edits: my graph is as following.

ImportString["O~tIID@wL~j`PbOqgLJ@p", "Graph6"]

enter image description here

$\endgroup$

1 Answer 1

4
$\begingroup$
Clear["Global`*"]

g = Graph[{1, 2, 3, 4, 5, 6}, {UndirectedEdge[1, 2], 
    UndirectedEdge[2, 3], UndirectedEdge[3, 4], UndirectedEdge[1, 5], 
    UndirectedEdge[5, 6], UndirectedEdge[6, 4], UndirectedEdge[2, 5], 
    UndirectedEdge[3, 6]}, {FormatType -> TraditionalForm, 
    GraphHighlightStyle -> {"Thick"}, 
    GridLinesStyle -> Directive[GrayLevel[0.5, 0.4]], 
    ImagePadding -> 0, VertexLabels -> {Placed["Name", Center]}, 
    VertexSize -> {0.4}, VertexStyle -> {GrayLevel[1]}}];

ec = FindEdgeCut[g, ##] & @@@ {{1, 5}, {5, 6}, {4, 6}};

Column[HighlightGraph[g, #] & /@ ec]

enter image description here

EDIT: To avoid specifically identifying the nodes

ec = GatherBy[
     DeleteDuplicates[
      FindEdgeCut[g, ##] & @@@ 
       Subsets[VertexList[g], {2}]], 
     Length][[1]];

Column[HighlightGraph[g, #] & /@ ec]

< same graphs >

EDIT 2: For more complicated graphs

g = CycleGraph[8, VertexLabels -> Automatic];

Partition[
  HighlightGraph[g, #,
     GraphHighlightStyle -> "Dashed"] & /@
   Select[
    Subsets[EdgeList[g],
     {EdgeConnectivity@g} (* min # edges to cut *)
      (* all combos of req'd # edges *)],
    ! ConnectedGraphQ@EdgeDelete[g, #] & 
    (* eliminate any still connected graphs *)],
  UpTo[5]] //
 Grid

enter image description here

$\endgroup$
4
  • $\begingroup$ An interesting question is: The function FindEdgeCut(g,a,b) also only finds a smallest (a,b)-edge cut of g.(not all), how to prove that the above codes found all the minimum cuts of g. Is there an smallest edge cut of g missing? $\endgroup$
    – licheng
    Commented Oct 18, 2022 at 13:48
  • $\begingroup$ For example, g = CycleGraph[8, VertexLabels -> Automatic]; ec = GatherBy[ DeleteDuplicates[FindEdgeCut[g, ##] & @@@ Subsets[VertexList[g], {2}]], Length][[1]]. Clearly, the edge set $\{ (45) , (78)\}$ is a minimum edge cut, but your codes have missed it. $\endgroup$
    – licheng
    Commented Oct 18, 2022 at 14:05
  • $\begingroup$ See Edit 2 for more complicated graphs $\endgroup$
    – Bob Hanlon
    Commented Oct 18, 2022 at 15:21
  • $\begingroup$ Thank you very much. However, due to memory constraints, could we not generate the selected subset of a graph at once? I have the graph in the end of post. Its edge connectivity is 6, we shall first use Subsets to store 32468436 edge-subsets (every subset has 6 members) . The memory's cost seems high. (By the way, it looks like it took a lot of time.) $\endgroup$
    – licheng
    Commented Oct 19, 2022 at 1:34

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.