       Bug Report for DiscreteMath`Combinatorica`Contract

• To: mathgroup at smc.vnet.net
• Subject: [mg85420] Bug Report for DiscreteMath`Combinatorica`Contract
• From: "Hunter Monroe" <hmonroe.to.support-at-wolfram.com at huntermonroe.com>
• Date: Sun, 10 Feb 2008 05:12:39 -0500 (EST)

```The series of commands below describe a bug in
DiscreteMath`Combinatorica`Contract. Contracting vertices 1 and 2 in a
directed graph with edges {1,3} and {3,2} should give a graph with two
vertices and two edges {1,2} and {2,1}. Instead, it gives a graph with edges
{1,2} and {1,2}. The error in the existing version is the Sort command,
which for directed graphs leads to erroneous output. A corrected version of
the Contract function is included below.

existence of the bug and the proposed fix is confirmed, and where such
information is posted.

Hunter Monroe

<<DiscreteMath`Combinatorica`

ShowGraphArray[{g=FromOrderedPairs[{{1,3},{3,2}}],Contract[g,{1,2}]},VertexN
umber*True,TextStyle*{FontSize*18}
VertexNumberPosition*Center,VertexStyle*Disk[0.05]]

Contract2[g_Graph,l_List]:=Module[{v=Vertices[g,All],t=Table[0,{V[g]}],cnt=0
,last=V[g]-Length[l]+1},Do[If[MemberQ[l,k],cnt++;t[[k]]=last,t[[k]]=k-cnt],{
k,V[g]}];

Graph[DeleteCases[Edges[g,All]/.{{x_Integer,y_Integer},opts___?OptionQ}*{{t[
[x]],t[[y]]},opts},{{last,last},opts___?OptionQ}],Append[v[[Complement[Range
[Length[v]],l]]],{Apply[Plus,Map[First,v[[l]]]]/Length[l],Apply[Sequence,App
ly[Intersection,Map[Drop[#,1]&,v[[l]]]]]}],Apply[Sequence,GraphOptions[g]]]]

ShowGraph[Contract2[g,{1,2}]]

```