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