consider the table of necklace polynomials, n beads, c<=n colours, substitute colour k by Exp[2 Pi I k/c], Table[NecklacePolynomial[n,Exp[2 I Pi Range[c]/c],Cyclic]//FullSimplify,{n,13},{c,n}] and find: {1}, {1,1}, {1,0,2}, {1,2,0,2}, {1,0,0,0,4}, {1,2,4,0,0,2}, {1,0,0,0,0,0,6}, {1,4,0,6,0,0,0,4}, {1,0,8,0,0,0,0,0,6}, {1,4,0,0,12,0,0,0,0,4}, {1,0,0,0,0,0,0,0,0,0,10}, {1,8,16,12,0,8,0,0,0,0,0,4}, {1,0,0,0,0,0,0,0,0,0,0,0,12}, and that might very well be: if c|n then Sum(d|(n/c), phi(c d) d^(n/c/d) /n) else 0 or, Table[If[MemberQ[Divisors[n],c], Fold[ #1 + EulerPhi[c #2]c^(n/c/#2)/(n) &, 0, Divisors[n/c]],0 ],{n,20},{c,n}] which is nice too, Wouter. earlier: ----- Original Message ----- From: "wouter meeussen" <wouter.meeussen@pandora.be> To: "math-fun" <math-fun@mailman.xmission.com> Sent: Saturday, July 28, 2007 9:57 PM Subject: [math-fun] gefundenes Fressen (a cheap find)
Imagine a necklace with n beads of up to n colours, say n=3 beads made of colours x[1], x[2] and x[3], then these are counted by:
Table[NecklacePolynomial[n,Array[x,n],Cyclic],{n,3,3}] {x[1]^3 + x[1]^2*x[2] + x[1]*x[2]^2 + x[2]^3 + x[1]^2*x[3] + 2*x[1]*x[2]*x[3] + x[2]^2*x[3] + x[1]*x[3]^2 + x[2]*x[3]^2 + x[3]^3}
now, change the colours into complex roots of 1 x[k] -> E^(2I Pi k/n) so that they do a 'complex cancellation' on the unit circle, and, hey presto, the whole caboodle collapses to EulerPhi[n]:
EulerPhi[n] == NecklacePolynomial[n,E^(2I Pi Range[n]/n),Cyclic]
which is nice...
Wouter.