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

MathGroup Archive 2007

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

Search the Archive

Re: Tally[ ] and Union[ ]

  • To: mathgroup at smc.vnet.net
  • Subject: [mg84034] Re: [mg83367] Tally[ ] and Union[ ]
  • From: DrMajorBob <drmajorbob at bigfoot.com>
  • Date: Fri, 7 Dec 2007 03:06:58 -0500 (EST)
  • References: <18041847.1195406295111.JavaMail.root@m35> <op.t10c5bv0qu6oor@monster.gateway.2wire.net>
  • Reply-to: drmajorbob at bigfoot.com

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 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[];
>>
>>
>>
>>
>>
>>
>>
>
>
>



-- =

DrMajorBob at bigfoot.com


  • Prev by Date: Re: Re: Mathematica: Long divison for polynomials
  • Next by Date: GLToolbox Ver. 1.1 - OpenGL 3D Graphics Programming Package for Mathematica
  • Previous by thread: Re: forming filename string
  • Next by thread: GLToolbox Ver. 1.1 - OpenGL 3D Graphics Programming Package for Mathematica