Counting the size of the minimum cut produced by MinCut of GraphUtilities`

Question

I want to use the MinCut function of the GraphUtilities` package to find minimum cuts for a few graphs. I'm completely new to Mathematica, so I took a look at the documentation of the function and the tutorial. Here's what I did:

Needs["GraphUtilities`"]
g = {1 -> 2, 2 -> 3, 3 -> 1, 2 -> 4, 4 -> 5, 5 -> 6, 6 -> 4};
c = MinCut[g,2]

After the second line, I'm getting an output representing the cut sets, such as

{{1,2,3}, {4,5,6}} 

If I plot the output, I can determine from the figure the size of the cut. With a bigger graph, that is not feasible. Hence the question:

How can I easily count the size of cut, that is the number of edges between the two sets, i.e. the number of crossing edges?

Answer 1

Several built-in functions can be used in combination to get the result you need.

Starting with your code:

Needs["GraphUtilities`"]
g = {1 -> 2, 2 -> 3, 3 -> 1, 2 -> 4, 4 -> 5, 5 -> 6, 6 -> 4};
c = MinCut[g, 2];

First, make a graph object using your edge list:

grph = Graph[g, VertexLabels -> "Name", ImagePadding -> 20]

From the list of edges:

EdgeList[grph]

the edges that are "cut" by c can be obtained using:

EdgeList[GraphDifference[grph, GraphUnion[Subgraph[grph, c[[1]]], Subgraph[grph, c[[2]]]]]]

or using:

Complement[EdgeList[grph], EdgeList[GraphUnion[Subgraph[grph, c[[1]]], Subgraph[grph, c[[2]]]]]]

Both give:

Here are the steps to get to the result above (illustrating several Graph functions along the way):

HighlightGraph[grph, GraphUnion[Subgraph[grph, c[[1]]], Subgraph[grph, c[[2]]],   VertexShapeFunction -> "Name"]]

HighlightGraph[grph, EdgeList[GraphDifference[grph, 
GraphUnion[Subgraph[grph, c[[1]]], Subgraph[grph, c[[2]]], 
VertexShapeFunction -> "Name"]]]]

EDIT: One can use the two methods above to define functions that accept a graph or an edge list where the edge list can be a list of rules or a list of lists:

Needs["GraphUtilities`"]
ClearAll[cutEdges];
cutEdges[gr_Graph,cut_Integer] := With[{erules = Rule @@ # & /@ EdgeList[gr]}, 
  EdgeList[GraphDifference[gr, 
  GraphUnion[Sequence @@ (Subgraph[gr, #] & /@ MinCut[erules, cut])]]]];
cutEdges[erules:{_Rule ..}, cut_Integer] :=cutEdges[Graph[erules], cut];
cutEdges[elist:{_List ..}, cut_Integer] :=cutEdges[Graph[Rule @@ # & /@ elist],cut]

Similarly, using the second method:

Needs["GraphUtilities`"]
ClearAll[cutEdges2];
cutEdges2[gr_Graph, cut_Integer] := With[{erules = Rule @@ # & /@ EdgeList[gr]}, 
 Complement[EdgeList[gr], DeleteDuplicates@
 Flatten[EdgeList@Subgraph[gr, #] & /@ (MinCut[erules,cut])]]];
cutEdges2[erules: {_Rule ..}, cut_Integer] := cutEdges2[Graph[erules], cut];
cutEdges2[elist: {_List ..}, cut_Integer] :=cutEdges2[Graph[Rule @@ # & /@ elist], cut]

Usage:

cutEdges[GraphData[{"Antiprism", 3}], 2]
cutEdges[{1->2,1->3,1->4,1->5,2->3,2->4,2->6,3->5,3->6,4->5,4->6,5->6}, 2]
cutEdges[{{1,2},{1,3},{1,4},{1,5},{2,3},{2,4},{2,6},{3,5},{3,6},{4,5},{4, 6},{5, 6}},2]

all return:

Similarly for cutEdges2.

EDIT 2: Further examples:

displayCuts[grph_Graph, cuts:{__Integer}] := Grid[{{SetProperty[grph, {VertexLabels -> "Name", VertexSize -> Medium,ImagePadding -> 20, ImageSize -> 300}]},
{Column[(With[{clrlst =Thread[{MinCut[Rule @@ # & /@ EdgeList[grph],
 cuts[[#]]], ColorData[1, "ColorList"][[2 ;; cuts[[#]] + 1]]}]},
 Row[{Grid[{{Style["minCut[" ~~ ToString[cuts[[#]]] ~~ "]", Bold, 16],
 Style["edges cut", Bold, 16]}, {Column[Style[#[[1]], #[[2]], Bold, 16] & /@ clrlst],
Column@cutEdges[grph, cuts[[#]]]}}, Frame -> All], 
 HighlightGraph[grph, {Style[cutEdges[grph, cuts[[#]]], Thick, Red],
 Style[#[[1]], #[[2]]] & /@ clrlst}, VertexLabels -> "Name",
 VertexSize -> Medium, ImagePadding -> 20, ImageSize -> 300]}]] & /@ 
 Range[Length[cuts]]), Frame -> All]}}]

PetersenGraph[5,3] with 2 and 3 cuts:

displayCuts[PetersenGraph[5, 3], {2, 3}]

GraphData[{"Antiprism", 6}] with 3 and 4 cuts: