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

MathGroup Archive 2007

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

Search the Archive

Tally[ ] and Union[ ]

  • To: mathgroup at smc.vnet.net
  • Subject: [mg83367] Tally[ ] and Union[ ]
  • From: "Michael Weyrauch" <michael.weyrauch at gmx.de>
  • Date: Sun, 18 Nov 2007 04:53:16 -0500 (EST)

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 it 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 surprises 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 are 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?  (Tally 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, 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 *)
  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[];







  • Prev by Date: Re: Floor doesn't compute in some cases
  • Next by Date: Re: Memory problem using NDSolve in For Loop
  • Previous by thread: Physical Simulations with DSolve
  • Next by thread: Re: Tally[ ] and Union[ ]