Re: Bug Report for DiscreteMath`Combinatorica`Contract

*To*: mathgroup at smc.vnet.net*Subject*: [mg85535] Re: [mg85420] Bug Report for DiscreteMath`Combinatorica`Contract*From*: Murray Eisenberg <murray at math.umass.edu>*Date*: Wed, 13 Feb 2008 04:24:04 -0500 (EST)*Organization*: Mathematics & Statistics, Univ. of Mass./Amherst*References*: <200802101012.FAA17687@smc.vnet.net>*Reply-to*: murray at math.umass.edu

It does NOT seem to have been corrected in Mathematica 6: << Combinatorica` g = FromOrderedPairs[{{1, 3}, {3, 2}}]; gc = Contract[g, {1, 2}]; Directed graph g has an edge from 1 to 3 and an edge from 3 to 2, of course. But gc has two edges from 1 to 2, both directed from 1 to 2. Unfortunately, your Contract2 does not seem to work with the Mathematica 6 Combinatorica package -- it generates a whole bunch of error messages. Hunter Monroe wrote: > 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}]] > > -- Murray Eisenberg murray at math.umass.edu Mathematics & Statistics Dept. Lederle Graduate Research Tower phone 413 549-1020 (H) University of Massachusetts 413 545-2859 (W) 710 North Pleasant Street fax 413 545-1801 Amherst, MA 01003-9305

**References**:**Bug Report for DiscreteMath`Combinatorica`Contract***From:*"Hunter Monroe" <hmonroe.to.support-at-wolfram.com@huntermonroe.com>