Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2008

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

Search the Archive

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


  • Prev by Date: RE: Re: How should I start with mathematica?
  • Next by Date: Re: Re: How should I start with mathematica?
  • Previous by thread: Bug Report for DiscreteMath`Combinatorica`Contract
  • Next by thread: Re: Part or Partition or Split or Extract or ...... ????