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. Please advise if this bug has been previously reported, whether the 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}]]

**Follow-Ups**:**Re: Bug Report for DiscreteMath`Combinatorica`Contract***From:*Murray Eisenberg <murray@math.umass.edu>