Sanity Check III, some conclusions
wouter meeussen
wouter.meeussen at pandora.be
Sun Oct 27 00:03:31 CEST 2002
different Abs of vector sums generated by n vectors choosen from
2n (equally spaced) points around the unit circle should be:
1, 2, 3, 6, 11, 20, 53, 130, 196, 725
Grouping the bracelets from A006840 into equivalence classes (??)
defined as below {a sets of b equivalent bracelets}, gives :
{{1,1}}
{{2,1}}
{{3,1}}
{{5,1},{1,2}}
{{10,1},{1,3}}
{{14,1},{1,2},{1,3},{4,4}}
{{39,1},{13,3},{1,7}}
{{78,1},{6,2},{38,3},{3,6},{5,7}}
{{87,1},{9,2},{33,3},{21,4},{6,5},{17,6},{1,10},{6,12},{6,13},
{3,14},{3,18},{3,19},{1,32}}
The confusion stems from the following equivalent pairs:
{0,0,0,0,1,0,0,1,0,0,1,1,0,0,1,1,0,1}
{0,0,0,1,0,0,1,0,0,1,1,1,0,0,1,0,0,1}
{0,0,0,0,0,0,1,0,0,1,0,1,1,0,1,0,1,1}
{0,0,0,0,1,0,0,0,0,1,0,1,1,0,1,1,0,1}
{0,0,0,0,0,0,0,0,0,1,1,0,1,1,0,1,1,1}
{0,0,0,0,0,0,0,1,0,0,1,1,1,1,1,0,0,1}
A similar, but different, sequence is the following:
1, 2, 3, 6, 11, 20, 53, 130, 199, 811
these are the bracelets from A006840 with an additional
equivalence condition:
sets of identical 1-beads at 'opposing positions'
(1,n+1) or (1, 2n/3+1, 4n/3+1) or
(1,2n/5+1,4n/5+1,6n/5+1,8n/5+1) change to 0-beads,
and, in addition,
sets as above with one bead of the 'opposing positions'
mismatching (being 0 instead of 1) get 'simplified' by
setting these beads to 0, and the bead diagonally opposite
from the mismatching bead gets set to 1 :
{0,0,1,0,1,0} simplifies to {0,0,0,1,0,0)
For the Mathematica buffs:
lowest[li_]:=First at Union[ NestList[RotateRight,li,
2n],NestList[RotateRight,Reverse[li],
2n],NestList[RotateRight,1-li,
2n],NestList[RotateRight,Reverse[1-li], 2n]]
ker[n_,k_]:=Flatten[Table[Join[{1},0 Range[-1+2n/k]],{k}]]
rek[n_,k_]:=MapAt[1+#&,MapAt[0 #&,-ker[n,k],1 ],1+n]
ingekort[li_]:=Module[{temp=li,len=Length[li],divi},
divi=First/@FactorInteger[len];
Table[temp=Fold[#1-#2 Quotient[#1.#2,Plus@@#2]&,temp,
NestList[RotateRight,ker[len/2,divi[[k]]],len]],{k,Length[divi]}];
Table[temp=Fold[#1+#2 If[ #1.#2===-(divi[[k+1]] -1) ,1,0]&,
temp, NestList[RotateRight,rek[len/2,divi[[k+1]] ],len] ],
{k,Length[divi]-1}];lowest[temp] ]
Table[
permset = Join[Table[0, {n}], Table[1, {n}]];
perms = (Prepend[#1, 0] & ) /@ Permutations[Rest[permset]];
brace=First[#]& /@ Split[Sort[lowest[#]& /@ perms ]];
bra=Split at Sort[ ingekort/@brace]; Length at bra ,
{n,10}]
Wouter.
for n=10, the confusing equivalent pairs are:
{{0,0,0,0,0,0,1,1,0,0,1,0,0,0,0,1,0,0,1,1},
{0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,0,0,0,1,1}},
{{0,0,0,0,1,0,1,0,0,0,0,1,0,1,0,0,0,1,0,1},
{0,0,0,1,0,1,0,1,0,0,0,1,1,0,0,0,1,0,1,1}},
{{0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,1,0,0,1},
{0,0,0,0,0,1,0,0,1,0,0,0,0,1,0,0,0,1,0,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,0,1},
{0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,1,1}},
{{0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,0,1},
{0,0,0,1,0,0,0,1,0,0,1,0,0,0,1,0,0,0,1,1}},
{{0,0,0,0,0,0,1,1,0,0,0,1,0,0,1,0,0,0,1,1},
{0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,0,1,1}},
{{0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,1,0,1},
{0,0,0,1,0,0,0,1,0,0,1,0,0,0,1,0,1,0,0,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,1},
{0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1}},
{{0,0,0,0,0,0,1,1,0,0,0,0,1,0,0,1,0,0,1,1},
{0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,1}},
{{0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,1},
{0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1}},
{{0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,1},
{0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,1}},
{{0,0,0,0,1,0,0,0,1,0,0,1,1,0,0,0,0,1,0,1},
{0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,1,0,1}},
{{0,0,0,0,0,0,1,0,0,0,0,1,0,0,1,0,0,0,0,1},
{0,0,0,0,1,0,0,1,0,0,0,1,1,0,0,0,1,0,0,1}},
{{0,0,0,0,0,1,0,0,0,0,1,0,0,1,0,0,0,1,0,1},
{0,0,0,0,1,0,0,0,1,0,0,1,0,0,0,0,1,1,0,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,1},
{0,0,0,0,1,0,0,0,1,0,0,1,0,0,0,1,1,0,0,1}},
{{0,0,0,0,0,1,0,0,1,0,1,0,0,0,1,0,1,0,0,1},
{0,0,0,1,0,0,1,0,1,0,0,1,0,0,1,1,0,1,0,1}},
{{0,0,0,0,0,0,1,0,0,0,0,0,1,1,0,0,0,0,0,1},
{0,0,0,0,0,0,1,0,0,0,1,1,0,0,0,0,0,1,1,1}},
{{0,0,0,0,1,0,0,0,1,0,1,0,1,0,0,0,1,0,0,1},
{0,0,0,0,0,1,0,0,1,0,0,0,1,0,0,0,1,1,0,1}},
{{0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,1,0,0,1},
{0,0,0,0,1,0,0,1,0,0,0,0,1,0,0,1,1,0,0,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,1,0,0,0,1},
{0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,1},
{0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1}},
{{0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,1,1},
{0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1}},
{{0,0,0,0,0,0,0,1,0,0,0,1,0,1,0,0,0,0,1,1},
{0,0,0,0,0,1,0,0,0,0,1,1,0,0,1,0,0,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,1},
{0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,1,0,0,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,0,0,0,1,1},
{0,0,0,0,0,0,1,0,0,0,1,1,0,0,0,1,0,0,1,1}},
{{0,0,0,0,1,0,0,1,0,0,1,1,1,0,0,0,1,0,1,1},
{0,0,0,0,0,1,0,0,0,0,1,1,0,0,0,0,1,1,0,1}},
{{0,0,0,0,0,1,0,0,1,0,0,0,1,1,0,0,1,0,0,1},
{0,0,0,0,0,0,0,1,0,0,1,1,0,0,0,0,1,0,1,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,1},
{0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,1}},
{{0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,1,0,0,0,1},
{0,0,0,0,1,0,0,0,1,0,0,1,1,0,0,1,0,0,0,1}},
{{0,0,0,0,1,0,0,0,1,0,0,0,1,1,0,1,0,0,0,1},
{0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,1,0,1,0,1}},
{{0,0,0,0,0,0,1,0,0,0,0,0,1,0,1,0,0,0,1,1},
{0,0,0,0,0,0,1,0,0,0,1,1,0,1,0,0,0,0,1,1}},
{{0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,1,0,1},
{0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,0,1,1,0,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,1,1},
{0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1},
{0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,1}},
{{0,0,0,0,0,0,1,0,0,0,1,0,1,0,1,0,0,0,1,1},
{0,0,0,0,0,0,1,0,0,0,1,0,0,1,0,0,0,1,1,1}},
{{0,0,0,0,0,0,0,0,1,0,0,0,0,1,1,0,0,0,0,1},
{0,0,0,0,0,1,0,0,0,0,1,0,0,1,1,0,0,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,1,0,1},
{0,0,0,0,0,0,1,0,0,0,0,1,0,1,0,1,0,0,0,1}},
{{0,0,0,0,0,0,0,1,0,0,1,1,0,0,1,0,0,0,1,1},
{0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,1}},
{{0,0,0,0,0,0,1,0,0,0,1,0,0,1,0,1,0,0,1,1},
{0,0,0,0,0,0,1,0,0,0,1,1,0,0,1,0,0,1,0,1}},
{{0,0,0,0,0,0,0,1,0,0,0,1,0,1,0,0,1,0,0,1},
{0,0,0,0,0,0,0,1,0,0,1,0,1,0,0,1,0,0,1,1}},
{{0,0,0,0,0,0,0,1,0,0,1,1,1,0,0,0,0,0,1,1},
{0,0,0,0,0,0,1,0,0,0,0,1,1,0,0,1,0,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1},
{0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,1},
{0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,1,1}},
{{0,0,0,0,0,0,0,1,0,0,0,1,1,0,0,0,1,0,1,1},
{0,0,0,0,0,1,0,0,0,0,1,0,0,0,1,0,0,1,1,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,1,0,0,1,1},
{0,0,0,0,0,0,0,1,0,0,1,0,0,1,1,0,0,0,1,1}},
{{0,0,0,0,0,0,0,0,1,0,1,1,0,0,0,0,1,1,0,1},
{0,0,0,0,0,1,0,0,0,0,1,0,1,1,0,0,1,0,0,1}},
{{0,0,0,0,0,1,0,1,0,0,1,1,0,1,1,0,0,0,1,1},
{0,0,0,0,1,0,0,1,0,0,0,1,1,1,0,1,0,0,1,1}},
{{0,0,0,0,1,0,0,1,0,0,0,1,1,1,0,1,0,0,1,1},
{0,0,0,0,0,1,0,0,0,0,0,1,0,1,0,0,1,0,1,1}},
{{0,0,0,0,0,0,1,0,0,0,1,0,0,1,1,0,0,1,0,1},
{0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,0,1,1,1}},
{{0,0,0,0,0,0,0,1,0,0,1,0,0,0,1,1,0,0,1,1},
{0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,1,0,0,1},
{0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,1,1,0,1,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,1,1,0,1,0,0,0,1},
{0,0,0,0,0,0,1,0,0,0,0,1,0,0,1,0,0,1,1,1}},
{{0,0,0,0,0,0,1,0,0,0,0,1,0,0,1,1,0,0,1,1},
{0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,0,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,1,0,1},
{0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,1,0,1}},
{{0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,1,0,1},
{0,0,0,0,0,0,0,1,0,0,0,1,0,1,0,1,0,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1,0,0,0,1},
{0,0,0,0,0,0,1,0,0,0,1,1,0,0,1,1,0,0,0,1}},
{{0,0,0,0,0,0,0,0,1,0,0,0,1,0,1,0,1,0,0,1},
{0,0,0,0,0,0,0,1,0,0,0,1,0,0,1,0,1,0,1,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,0,1,1,1,0,0,0,1},
{0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,1,1}},
{{0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,0,1,1,1,1},
{0,0,0,0,0,0,1,0,0,0,0,0,1,1,0,1,0,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1},
{0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,0,0,0,1,1},
{0,0,0,0,0,0,1,0,0,0,1,0,0,1,1,1,0,0,0,1}},
{{0,0,0,0,0,0,1,0,0,0,1,0,1,1,0,1,0,0,0,1},
{0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,1,1,1,0,1}},
{{0,0,0,0,0,0,0,0,1,0,0,1,1,0,0,0,1,1,0,1},
{0,0,0,0,0,0,0,1,0,0,1,0,0,0,1,1,1,0,0,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,1},
{0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1,0,0,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,1,0,1,1,0,0,1,1},
{0,0,0,0,0,0,1,0,0,0,0,1,1,0,1,1,0,0,0,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,1,0,1},
{0,0,0,0,0,0,0,1,0,0,0,1,1,0,1,0,1,0,0,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,1,1,0,1,1},
{0,0,0,0,0,0,0,1,0,0,0,1,0,1,0,1,1,0,0,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,1,1},
{0,0,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,1,1,1}},
{{0,0,0,0,0,0,0,0,1,0,0,1,1,0,0,1,1,0,0,1},
{0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,1,0,0,1}},
{{0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,1,0,1,1},
{0,0,0,0,0,0,0,0,1,0,0,0,1,1,0,0,1,1,0,1}},
{{0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,0,0,1,1,1},
{0,0,0,0,0,0,0,1,0,0,0,1,0,1,1,1,0,0,0,1}},
{{0,0,0,0,0,0,0,1,0,0,0,0,1,0,1,1,1,0,0,1},
{0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,0,0,1,1}},
{{0,0,0,0,0,0,0,0,1,0,0,1,0,0,1,1,1,0,0,1},
{0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,0,1},
{0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,1,1,1,0,1}},
{{0,0,0,0,0,1,0,0,0,0,1,1,1,0,1,0,1,1,0,1},
{0,0,0,0,0,0,1,0,1,0,0,1,1,1,1,0,0,1,0,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1},
{0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,0,1,1}},
{{0,0,0,0,0,0,0,0,1,0,0,0,1,1,0,1,1,0,0,1},
{0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,1,1,0,1,1}},
{{0,0,0,0,0,0,0,1,0,0,1,1,1,0,1,0,1,0,1,1},
{0,0,0,0,0,0,0,0,1,0,0,0,0,1,1,1,0,1,0,1}},
{{0,0,0,0,0,0,0,0,1,0,0,0,0,1,1,1,0,1,0,1},
{0,0,0,0,0,0,1,0,0,0,1,0,1,0,1,1,0,1,1,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,1},
{0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,1,0,1,0,1}},
{{0,0,0,0,0,0,1,0,0,0,1,1,1,1,1,0,0,0,1,1},
{0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,1,1,1}},
{{0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1,1,0,1},
{0,0,0,0,0,0,0,0,0,0,1,0,0,1,1,0,0,1,1,1}},
{{0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,0,1,1,0,1},
{0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,1,1,1,0,1}},
{{0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,0,1,1,0,1},
{0,0,0,0,0,0,1,0,0,0,1,1,0,1,1,1,0,1,0,1}},
{{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1},
{0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,1,1}},
{{0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,0,1,1,0,1},
{0,0,0,0,0,0,0,1,0,0,1,1,0,1,1,1,1,0,0,1}}
----- Original Message -----
From: "wouter meeussen" <wouter.meeussen at pandora.be>
To: "Seqfan (E-mail)" <seqfan at ext.jussieu.fr>
Sent: Sunday, October 20, 2002 1:57 PM
Subject: Sanity Check II
> different Abs of vector sums generated by n vectors choosen from
> 2n (equally spaced) points around the unit circle should be:
>
> 1, 2, 3, 6, 11, 20, 54, 130, 200, 725
>
> Grouping the bracelets from A006840 into equivalence classes
(??)
> gives
>
> {{1,1}}
> {{2,1}}
> {{3,1}}
> {{5,1},{1,2}}
> {{10,1},{1,3}}
> {{14,1},{1,2},{1,3},{4,4}}
> {{40,1},{1,2},{12,3},{1,7}}
> {{78,1},{6,2},{38,3},{3,6},{5,7}}
> {{91,1},{10,2},{32,3},{21,4},{6,5},{17,6},{1,10},
> {6,12},{8,13},{1,14},{1,17},{2,18},{3,19},{1,32}}
> {{306,1},{15,2},{265,3},{14,4},{2,5},{24,6},{4,8},{3,9},
> {64,10},{17,13},{1,14},{1,19},{2,20},{5,24},{2,32}}
>
> whith "{{5,1},{1,2}}" to be read as
> 5 (sets of) bracelets with unique Abs vector sums, and
> 1 set of 2 bracelets having the same vector sum.
>
> In physics, the 'Abs vector sums' would be called 'dipole
> moments'.
> (cfr A045611)
>
> The calculation is hard on Mathematica :
> the vector sums must be sorted & grouped using the accurate
> floating point values of the sums over ugly radicals.
>
> Forgive me for coming back to these "Physical Analoges" with
> 'charges', 'energy states' and 'dipole moments' etc. applied to
> 'clean bracelets', but I consider it an intruiging fact that
> 'equivalences' seem to appear that were not yet looked at.
> (Is this so???)
> And I guess they are 'hard to count' combinatorially.
>
> Wouter Meeussen
> wouter.meeussen at pandora.be
>
>
More information about the SeqFan
mailing list