OFFSET
1,4
COMMENTS
Cf. Bernstein-Kouba paper, function K(n).
A necklace or bracelet is colorful if no pair of adjacent beads are the same color. In addition, two necklaces are equivalent if one results from the other by permuting its colors, and two bracelets are equivalent if one results from the other by either permuting its colors or reversing the order of the beads; a bracelet is thus a necklace that can be turned over.
LINKS
Michael De Vlieger, Table of n, a(n) for n = 1..3336
Dennis S. Bernstein and Omran Kouba, Counting Colorful Necklaces and Bracelets in Three Colors, arXiv:1901.10703 [math.CO], 2019.
Dennis S. Bernstein and Omran Kouba, Counting Colorful Necklaces and Bracelets in Three Colors, Aequat. Math, 2019.
FORMULA
a(n) = floor(Sum_{d|n} (1 + 4/3 * cos(d * Pi/2)^2 * sin(d * Pi/3)^2 ) * gcd(d,6) * phi(d) * 2^(n/d)/(6*n)). [corrected by Omran Kouba, Apr 11 2019]
Eq. (4.15) of Bernstein-Kouba expresses K(n) in terms of A_n, B_n, C_n, and the Maple code below calculates all four sequences and confirms the values given here. - N. J. A. Sloane, Mar 15 2019
a(n) = Sum_{k=1..3} A327396(n, k). - Andrew Howroyd, Oct 09 2019
a(n) ~ 2^(n-1) / (3*n). - Vaclav Kotesovec, May 02 2020
MAPLE
# Maple code from N. J. A. Sloane, Mar 15 2019
p:=numtheory[phi]; M:=80;
fA:=proc(n) local d, t1; global p; t1:=0; # A_n, A306896
for d from 1 to n do
if (n mod d) = 0 then t1:=t1 + (2^d+ 2*(-1)^d)*p(n/d); fi; od; t1; end;
[seq(fA(n), n=1..M)]; # A306896
fB:=proc(n) local d, t1; global p; t1:=0; # B_n, A306898
for d from 1 to n do
if ((n mod 2) = 0 and ((n/2) mod d) = 0) then t1:=t1 + 2^d*p(n/d); fi; od; t1; end;
[seq(fB(2*n), n=1..M)]; # A306898
fC:=proc(n) local d, t1; global p; t1:=0; # C_n, A306899
for d from 1 to n do
if ((n mod 3) = 0 and ((n/3) mod d) = 0)
then t1:=t1 + (2^d - (-1)^d)*p(n/d); fi; od; t1; end;
[seq(fC(3*n), n=1..M)]; # A306899
K:=proc(n) global fA, fB, fC;
(fA(n)+3*fB(n)+2*fC(n))/(6*n); end;
[seq(K(n), n=1..M)]; # A306888
MATHEMATICA
f[n_] := DivisorSum[n, (2^# + 2 (-1)^#) EulerPhi[n/#] &]; g[n_] := DivisorSum[n, 2^# *EulerPhi[n/#] &, And[Mod[n, 2] == 0, Mod[(n/2), #] == 0] &]; h[n_] := DivisorSum[n, (2^# - (-1)^#) EulerPhi[n/#] &, And[Mod[n, 3] == 0, Mod[(n/3), #] == 0] &]; Array[(f[#] + 3 g[#] + 2 h[#])/(6 #) &, 40] (* Michael De Vlieger, Mar 18 2019 *)
(* Alternatively, using Remark 4.4 from the article *)
K[n_]:=Floor[ 1/(6 n) DivisorSum[n, 2^(n/#)(1 + 4/3 Cos[# Pi/2]^2
Sin[# Pi/3]^2) GCD[#, 6] EulerPhi[#] &]]; Table[K[n], {n, 1, 500}]
(* Omran Kouba, Apr 11 2019; typo fixed by Jean-François Alcover, May 01 2020 *)
PROG
(PARI) a(n) = round(sumdiv(n, d, (1 + (4/3) * (1-(d%2)) * (if (d%3, 3/4))) * gcd(d, 6) * eulerphi(d) * 2^(n/d))/(6*n)); \\ Michel Marcus, May 01 2020; corrected Jun 15 2022
CROSSREFS
KEYWORD
nonn
AUTHOR
Omran Kouba, Mar 15 2019
STATUS
approved