Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2008

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

Search the Archive

FYI, Tally is still broken.

  • To: mathgroup at smc.vnet.net
  • Subject: [mg89571] FYI, Tally is still broken.
  • From: DrMajorBob <drmajorbob at att.net>
  • Date: Fri, 13 Jun 2008 06:10:25 -0400 (EDT)
  • References: <JNEIICAJLELPIHHIMDJDOEIMCEAA.michael.weyrauch@gmx.de>
  • Reply-to: drmajorbob at longhorns.com

For any who might be curious, the Tally failure detailed below (in  
December 2007) is unchanged in version 6.0.3.

$Version

"6.0 for Mac OS X x86 (64-bit) (May 21, 2008)"

(Here's a repeat of the same code, without all those >> interruptions.)

Needs["Combinatorica`"];

diagrams::usage = "Calculate diagrams";
basicedges::usage;
wick[a_, b_] := pair[a, b];
wick[a_, b__] :=

   Sum[Expand[pair[a, {b}[[i]]] Delete[Unevaluated[wick[b]], i]], {i,
     Length[{b}]}];
ham[n_Integer] := (ns = 4*n - 3; {c[ns], c[ns + 1], d[ns + 2], d[ns + 3]});
basicedges[n_] :=

   Flatten[Table[{{{i, i + 1}, EdgeColor -> Red}}, {i, 1, 2*n, 2}], 1];
hamserie[n_Integer] := Flatten[Table[ham[i], {i, n}]];
cvertices[n_Integer] := {{n, 1}, {n, 0}};
cvertexserie[n_Integer] := Flatten[Table[cvertices[i], {i, n}], 1];
pair[c[_], c[_]] := 0;
pair[d[_], d[_]] := 0;
pair[a_Integer, b_Integer] /; (a > b) := pair[b, a];
diagrams[n_] :=

  Module[{wickli, rep, i, cgraph, cvertices, congraph, le, un, ta},
   wickli = wick[Sequence @@ hamserie[n]] /. Plus -> List;
   le = Length[wickli[[1]]];
   wickli = wickli /. {pair[c[i_], d[j_]] -> pair[i, j],
      pair[d[i_], c[j_]] -> pair[i, j]};
   graph = {}; While[wickli =!= {},
    wickli =
     rempar[First[wickli], wickli, n,
      le]];(*edge reduction and edgelist construction for use by> >
   Combinatorica*)

   rep = Dispatch[Flatten[Table[{Rule[2*i - 1, i], Rule[2*i, i]}, {i, 
2*n}]]];
   graph = (Take[#, -le] /. rep /. pair[a__]^_ -> pair[a]) & /@ graph;
   be = basicedges[n];
   cgraph = Map[List, (graph /. {pair -> List, Times -> List}), {2}];
   cvertices = List /@ cvertexserie[n]; cgraph = Join[be, #] & /@ cgraph;
   cgraph = Graph[#, cvertices] & /@ cgraph;(*Now I compare Union and 
Tally*)

    saved = cgraph; un = Union[cgraph, SameTest -> IsomorphicQ];
   Print["Union: number of elements: ", Length[un]]; Print[GraphicsGrid[
     Partition[ShowGraph[#] & /@ un, 3, 3, {1, 1}, {}]]];
   ta = Sort@Tally[cgraph, IsomorphicQ][[All, 1]];
   Print["Tally: Number of Elements: ", Length[ta]];
   Print[GraphicsGrid[Partition[ShowGraph /@ ta, 3, 3, {1, 1}, {}]]];
   Print[GraphicsGrid[
     Partition[ShowGraph /@ ta[[{2, 4}]], 3, 3, {1, 1}, {}]]];
   Print["Are 2 and 4 isomorphic? ", IsomorphicQ[ta[[2]], ta[[4]]]];
   Print["Are 4 and 2 isomorphic? ", IsomorphicQ[ta[[4]], ta[[2]]]];
   ]
rempar[li_, wickli_List, n_Integer, le_] :=
  Module[{lis, mult, gem, pre, i}, lis = {Take[li, -le]}; pre = Drop[li,  
-le];
   Do[lis = Join[lis, lis /. {i -> i + 1, i + 1 -> i}], {i, 1, 4*n - 1, 2}];
   lis = Union[lis]; mult = Length[lis];
   graph = Join[graph, {li*mult}];
   Complement[wickli, pre*lis]]
diagrams[3]

Union: number of elements: 8

Tally: Number of Elements: 11

Are 2 and 4 isomorphic? True

Are 4 and 2 isomorphic? True

saved // Length
index = Thread[saved -> Range@Length@saved];
(u = Union[saved, SameTest -> IsomorphicQ]) // Length
(t = Sort@Tally[saved, IsomorphicQ][[All, 1]]) // Length

21

8

11


These are the cgraph indices returned by Union and Tally :

u /. index
t /. index

{1, 11, 4, 21, 8, 18, 15, 6}

{1, 11, 4, 2, 8, 14, 3, 18, 15, 7, 6}


Comparing cgraph[[5]] and cgraph[[10]] is irrelevant, as you can see.

(boo = Boole@Outer[IsomorphicQ, t, t, 1]) // MatrixForm;
boo == Transpose@boo
Cases[Position[boo, 1], {a_, b_} /; a < b, 1]

True

{{2, 4}, {5, 7}, {8, 10}}

Bobby

On Fri, 07 Dec 2007 12:27:32 -0600, Michael Weyrauch  
<michael.weyrauch at gmx.de> wrote:

> Dear Bobby,
>
>     thanks for asking.
>
> Yes, indeed, I reported this problem to WRI using official support
> channels (thanks to a service contract of my company).
>
> I got the answer from some WRI support engineer that Tally[] is indeed
> broken,
> and does not function correctly in more complicated cases. However,  
> appyling
> it
> repeatedly until nothing changes any more does give the correct result.
> (The last bit I did not yet check for myself.)
>
> In practice I wrote my own Tally[], which works but  is probably much 
> much
> slower
> than a (correctly working) built-in Tally[].
>
> I hope that in a future version Tally will work correctly, because I  
> find it
> very useful in principle.
>
>
> Regards   Michael
>
> "DrMajorBob" <drmajorbob at bigfoot.com> schrieb im Newsbeitrag
> news:<fjav9f$rjb$1 at smc.vnet.net>...
>> Did we get an answer on whether this is a bug in Tally?
>>
>> Bobby
>>
>> On Sun, 18 Nov 2007 16:09:01 -0600, DrMajorBob <drmajorbob at bigfoot.com>
>> wrote:
>>
>> > There is, apparently, something wrong with Tally, but your test wasn't
>> > the right one, since cgraph's 5th and 10th elements were not returned  
>> in
> 
>>
>> > the Tally results. Here's a modification of your code and some tests:
>> >
>> > Needs["Combinatorica`"];
>> > diagrams::usage = "Calculate diagrams";
>> > basicedges::usage;
>> >
>> > wick[a_, b_] := pair[a, b];
>> > wick[a_, b__] :=
>> >    Sum[Expand[pair[a, {b}[[i]]] Delete[Unevaluated[wick[b]], i]], {i,
>> >      Length[{b}]}];
>> > ham[n_Integer] := (ns = 4*n - 3; {c[ns], c[ns + 1], d[ns + 2],
>> >      d[ns + 3]});
>> > basicedges[n_] :=
>> >    Flatten[Table[{{{i, i + 1}, EdgeColor -> Red}}, {i, 1, 2*n, 2}],
>> >     1];
>> > hamserie[n_Integer] := Flatten[Table[ham[i], {i, n}]];
>> > cvertices[n_Integer] := {{n, 1}, {n, 0}};
>> > cvertexserie[n_Integer] := Flatten[Table[cvertices[i], {i, n}], 1];
>> > pair[c[_], c[_]] := 0;
>> > pair[d[_], d[_]] := 0;
>> > pair[a_Integer, b_Integer] /; (a > b) := pair[b, a];
>> >
>> > diagrams[n_] :=
>> >    Module[{wickli, rep, i, cgraph, cvertices, congraph, le, un, ta} ,
>> >     wickli = wick[Sequence @@ hamserie[n]] /. Plus -> List;
>> >     le = Length[wickli[[1]]];
>> >     wickli =
>> >      wickli /. {pair[c[i_], d[j_]] -> pair[i, j],
>> >        pair[d[i_], c[j_]] -> pair[i, j]};
>> >     graph = {};
>> >     While[wickli =!= {},
>> >      wickli = rempar[First[wickli], wickli, n, le]];
>> >     (*edge reduction and edgelist construction for use by \
>> > Combinatorica*)
>> >     rep = Dispatch[
>> >       Flatten[Table[{Rule[2*i - 1, i], Rule[2*i, i]}, {i, 2*n}]]];
>> >     graph = (Take[#, -le] /. rep /. pair[a__]^_ -> pair[a]) & /@
>> >       graph;
>> >     be = basicedges[n];
>> >     cgraph = Map[List, (graph /. {pair -> List, Times -> List}), {2} >> ];
>> >     cvertices = List /@ cvertexserie[n];
>> >     cgraph = Join[be, #] & /@ cgraph;
>> >     cgraph = Graph[#, cvertices] & /@ cgraph;
>> >     (*Now I compare Union and Tally*)
>> >     saved = cgraph;
>> >     un = Union[cgraph, SameTest -> IsomorphicQ];
>> >     Print["Union: number of elements: ", Length[un]];
>> >     Print[GraphicsGrid[
>> >       Partition[ShowGraph[#] & /@ un, 3, 3, {1, 1}, {}]]];
>> >     ta = Sort@Tally[cgraph, IsomorphicQ][[All, 1]];
>> >     Print["Tally: Number of Elements: ", Length[ta]];
>> >     Print[GraphicsGrid[Partition[ShowGraph /@ ta, 3, 3, {1, 1},  

>> {}]]];=
>>
>> >     Print[GraphicsGrid[
>> >       Partition[ShowGraph /@ ta[[{2, 4}]], 3, 3, {1, 1}, {}]]];
>> >     Print["Are 2 and 4 isomorphic? ", IsomorphicQ[ta[[2]], ta[[4]]]];
>> >     Print["Are 4 and 2 isomorphic? ", IsomorphicQ[ta[[4]], ta[[2]]]];
>> >     ];
>> >
>> > rempar[li_, wickli_List, n_Integer, le_] :=
>> >    Module[{lis, mult, gem, pre, i}, lis = {Take[li, -le]};
>> >     pre = Drop[li, -le];
>> >     Do[lis = Join[lis, lis /. {i -> i + 1, i + 1 -> i}], {i, 1,
>> >       4*n - 1, 2}];
>> >     lis = Union[lis];
>> >     mult = Length[lis];
>> >     graph = Join[graph, {li*mult}];
>> >     Complement[wickli, pre*lis]];
>> >
>> > diagrams[3]
>> > Union: number of elements: 8
>> > Tally: Number of Elements: 11
>> > Are 2 and 4 isomorphic? True
>> > Are 4 and 2 isomorphic? True
>> >
>> > saved // Length
>> > index = Thread[saved -> Range@Length@saved];
>> > (u = Union[saved, SameTest -> IsomorphicQ]) // Length
>> > (t = Sort@Tally[saved, IsomorphicQ][[All, 1]]) // Length
>> >
>> > 21
>> >
>> > 8
>> >
>> > 11
>> >
>> > These are the cgraph indices returned by Union and Tally:
>> >
>> > u /. index
>> > t /. index
>> >
>> > {1, 11, 4, 21, 8, 18, 15, 6}
>> >
>> > {1, 11, 4, 2, 8, 14, 3, 18, 15, 7, 6}
>> >
>> > Comparing cgraph[[5]] and cgraph[[10]] is irrelevant, as you can see.
>> >
>> > (boo = Boole@Outer[IsomorphicQ, t, t, 1]) // MatrixForm;
>> > boo == Transpose@boo
>> > Cases[Position[boo, 1], {a_, b_} /; a < b, 1]
>> >
>> > True
>> >
>> > {{2, 4}, {5, 7}, {8, 10}}
>> >
>> > boo is NOT an identity matrix, so Tally did something very odd.
>> >
>> > Bobby
>> >
>> > On Sun, 18 Nov 2007 03:53:16 -0600, Michael Weyrauch  >>
>> > <michael.weyrauch at gmx.de> wrote:
>> >
>> >> Hello,
>> >>
>> >> in the  Mathematica 6.0 documentation it says in the entry for  
>> Tally:=
>>   =
>>
>> >> Properties and Relations:
>> >>
>> >> "A sorted  Tally is equivalent to a list of counts for the  Union: "
>> >>
>> >> This is what I indeed expect of Tally and Union, in particular then  
>> i=
>> t  =
>>
>> >> holds for any list:
>> >> Length[Tally[list]]    is equal to     Length[Union[list]].
>> >>
>> >> Now, I have an example, where Mathematica 6.0 produces a result  

>> where=
>>
>> >> Tally[list] and Union[list] are different in length, which surpris=
es  =

>> =
>> me.
>> >> And in fact,  the result of Tally[ ] seems wrong to me.
>> >>
>> >> You can reproduce this result using the small Mathematica package =
  =
>>
>> >> enclosed, which
>> >> uses Combinatorica.  (Sorry for the somewhat complicated example, =
 =

>> but=
>>  I  =
>>
>> >> did not find
>> >> a simpler case showing the effect.)
>> >>
>> >> If you load this package into a notebook and then execute
>> >>
>> >> diagrams[2]
>> >>
>> >> Tally and Union produce the expected result: both lists have equal=
  =
>>
>> >> length.
>> >> (The list elements are diagrams.)
>> >>
>> >> However, if you execute
>> >>
>> >> diagrams[3]
>> >>
>> >> Tally and Union produce lists of different length.
>> >>
>> >> To my opinion,  it really should never happen that Tally and Union=

>> >> produce lists of different length. I just expect of Tally to tell =
me  =

>> =
>>  =
>>
>> >> the multpilicities in the equivalence classes, in addition to
>> >> the information produced by Union.  (The two list to be compared a=
re  =

>> =
>>  =
>>
>> >> called "ta" and "un" in the package  enclosed.)
>> >>
>> >> Strangely enough, the program compares list elements 5 and 10  ==

>>
>> >> explicitly, and comes to the
>> >> conclusion that element 5 and 10 belong to the same equivalence  =

>> class=
>> ,  =
>>
>> >> nevertheless they are
>> >> both listed seperately in the Tally, but - correctly - lumped up  =
in  =

>> =
>>  =
>>
>> >> the Union.
>> >>
>> >> Do I misinterpret something here or is there a bug in Tally?  (Tal=
ly  =

>> =
>> is  =
>>
>> >> new in Mathematica 6, and I
>> >> would find it extremely useful, if it would do what I expect it to=
  =

>> do=
>> .)
>> >>
>> >> Michael
>> >>
>> >> Here comes my little package in order to reproduce the effect....
>> >>
>> >> BeginPackage["wick`"]
>> >>
>> >> Needs["Combinatorica`"];
>> >> diagrams::usage="Calculate diagrams";
>> >> basicedges::usage;
>> >>
>> >> Begin["`Private`"]
>> >>
>> >> wick[a_, b_] := pair[a, b];
>> >> wick[a_, b__]:= Sum[Expand[pair[a, {b}[[i]]]  =
>>
>> >> Delete[Unevaluated[wick[b]], i]], {i, Length[{b}]}];
>> >> ham[n_Integer]:=(ns=4*n-3;{c[ns],c[ns+1],d[ns+2],d[ns+3]});
>> >> basicedges[n_]:=Flatten[Table[{{{i,i+1},  EdgeColor->Red}},  ==

>>
>> >> {i,1,2*n,2}],1];
>> >> hamserie[n_Integer]:=Flatten[Table[ham[i],{i,n}]];
>> >> cvertices[n_Integer]:={{n,1},{n,0}};
>> >> cvertexserie[n_Integer]:=Flatten[Table[cvertices[i],{i,n}],1];
>> >> pair[c[_],c[_]]:=0;
>> >> pair[d[_],d[_]]:=0;
>> >> pair[a_Integer,b_Integer]/;(a>b):=pair[b,a];
>> >>
>> >> diagrams[n_]:=Module[{wickli, rep, i, cgraph, cvertices, congrap=
h, =
>> le,  =
>>
>> >> un, ta},
>> >>
>> >>   wickli=wick[Sequence@@hamserie[n]]/.Plus->List;
>> >>   le=Length[wickli[[1]]];
>> >>   wickli=wickli/.{pair[c[i_],d[j_]]->pair[i,j],
>> >>                   pair[d[i_],c[j_]]->pair[i,j]};
>> >>   graph={};
>> >>   While[wickli=!={},
>> >>         wickli=rempar[First[wickli],wickli,n, le]];
>> >>
>> >>   (*edge reduction and edgelist construction for use by  =

>> Combinatorica=
>> *)
>> >>   rep=Dispatch[Flatten[Table[{Rule[2*i-1,i],Rule[2*i,i]},{i,2*n}=
]]]=
>> ;
>> >>   graph=(Take[#,-le]/.rep/.pair[a__]^_->pair[a])&/@graph;
>> >>
>> >>   be=basicedges[n];
>> >>   cgraph=Map[List,(graph/.{pair->List, Times->List}),{2}];
>> >>   cvertices=List/@cvertexserie[n];
>> >>   cgraph=Join[be,#]&/@cgraph;
>> >>   cgraph=Graph[#,cvertices]&/@cgraph;
>> >>
>> >>   (* Now I compare Union and Tally *)
>> >>   un=Union[cgraph,SameTest->IsomorphicQ];
>> >>   Print["Union: number of elements: ", Length[un]];
>> >>   Print[GraphicsGrid[Partition[ShowGraph[#]&/@un, 3,3,{1,1},{}]]];=

>> >>
>> >>   ta=Tally[cgraph,IsomorphicQ];
>> >>   ta=Sort[ta];
>> >>   Print["Tally: Number of Elements: ", Length[ta]];
>> >>   Print[GraphicsGrid[Partition[ShowGraph[#]&/@(First/@ta),  =
>>
>> >> 3,3,{1,1},{}]]];
>> >>
>> >>   Print["Are 5 and 10 isomorphic? ", IsomorphicQ[cgraph[[5]],  ==

>>
>> >> cgraph[[10]]]];
>> >>
>> >>   ];
>> >>
>> >> rempar[li_,wickli_List,n_Integer,le_]:=Module[{lis, mult, gem,  =
pre=
>> , i},
>> >>   lis={Take[li,-le]}; pre=Drop[li,-le];
>> >>   Do[lis=Join[lis,lis /. {i->i+1, i+1->i}], {i,1,4*n-1,2}];
>> >>   lis =Union[lis];
>> >>   mult=Length[lis];
>> >>   graph=Join[graph,{li*mult}];
>> >>   Complement[wickli,pre*lis]
>> >> ];
>> >>
>> >> End[];
>> >> EndPackage[];
>> >>
>> >>
>> >>
>> >>
>> >>
>> >>
>> >>
>> >
>> >
>> >
>>
>>
>>
>> -- =
>>
>> DrMajorBob at bigfoot.com
>>
>
>



-- =

DrMajorBob at longhorns.com


  • Prev by Date: Re: Don't understand replacement rule for some functions
  • Next by Date: Re: Different cases in Solve
  • Previous by thread: Re: export pdf font question
  • Next by thread: FYI, Tally is still broken. So are some symbolic eigenvalues