Re: Tally[ ] and Union[ ]
- To: mathgroup at smc.vnet.net
- Subject: [mg83395] Re: [mg83367] Tally[ ] and Union[ ]
- From: DrMajorBob <drmajorbob at bigfoot.com>
- Date: Mon, 19 Nov 2007 06:17:05 -0500 (EST)
- References: <18041847.1195406295111.JavaMail.root@m35>
- Reply-to: drmajorbob at bigfoot.com
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 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[];
>
>
>
>
>
>
>
--
DrMajorBob at bigfoot.com