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>
- Bug Report for DiscreteMath`Combinatorica`Contract