gefundenes Fressen 2

[wouter meeussen]

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 at pandora.be>
To: "math-fun" <math-fun at 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.