Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

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>