Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question
add comment

1 Answer

up vote 5 down vote accepted

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]

enter image description here

From the list of edges:

EdgeList[grph]

enter image description here

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:

enter image description here

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"]]

enter image description here

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

enter image description here

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:

enter image description here

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}]

enter image description here

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

enter image description here

share|improve this answer
    
Thanks! Running the first line grph = Graph[g, VertexLabels -> "Name", ImagePadding -> 20] does not give me a figure, but instead the output is Graph[{1 -> 2, 2 -> 3, 3 -> 1, 2 -> 4, 4 -> 5, 5 -> 6, 6 -> 4}, VertexLabels -> "Name", ImagePadding -> 20]. After that EdgeList[grph] gives an error. I'm probably missing something basic here, any ideas? I shouldn't be missing any packages, I got Combinatorica and GraphUtilities loaded. –  mrm Jul 5 '12 at 11:33
    
Okay, my problem did indeed seem to be that there were both Combinatorica-style graphs and some new built-in graphs (new in V8) in use. I removed Combinatorica from the context-path with the help of this SO question. –  mrm Jul 5 '12 at 17:03
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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