A298947 Number of integer partitions y of n such that exactly one permutation of y is a Lyndon word.

1, 1, 2, 3, 6, 7, 11, 12, 15, 19, 22, 22, 29, 32, 32, 38, 42, 44, 49, 51, 54, 63, 63, 64, 71, 79, 76, 84, 87, 90, 96, 101, 101, 113, 108, 115, 122, 131, 125, 134, 138, 144, 147, 155, 150, 169, 163, 168, 173, 185, 180, 194, 191, 200, 198, 211, 209, 227, 218, 224, 231, 246

Offset: 1

Author

Gus Wiseman, Jan 30 2018

Keywords

• nonn

Examples

			The a(6) = 7 partitions are (6), (51), (42), (411), (3111), (2211), (21111). This list does not include (321) because there are two possible permutations that are Lyndon words, namely (123) and (132). The list does not include (33), (222), or (111111) because no permutation of these is a Lyndon word.
		

Crossrefs

Cf. A000041, A000740, A001037, A032741, A059966, A144300, A167934, A293511, A292444, A298941.

Programs

Maple

with(combinat): with(numtheory):
g:= l-> (n-> `if`(n=0, 1, add(mobius(j)*multinomial(n/j,
        (l/j)[]), j=divisors(igcd(l[])))/n))(add(i, i=l)):
b:= (n, i, l)-> `if`(n=0 or i=1, `if`(g([l[], n])=1, 1, 0),
                 add(b(n-i*j, i-1, [l[], j]), j=0..n/i)):
a:= n-> b(n$2, []):
seq(a(n), n=1..30);  # Alois P. Heinz, Feb 09 2018

Mathematica

LyndonQ[q_]:=Array[OrderedQ[{q,RotateRight[q,#]}]&,Length[q]-1,1,And]&&Array[RotateRight[q,#]&,Length[q],1,UnsameQ];
Table[Length[Select[IntegerPartitions[n],Length[Select[Permutations[#],LyndonQ]]===1&]],{n,20}]
(* Second program: *)
multinomial[n_, k_List] := n!/Times @@ (k!);
g[l_List] := With[{n = Total[l]}, If[n == 0, 1, Sum[MoebiusMu[j]*multinomial[n/j, l/j], {j, Divisors[GCD @@ l]}]/n]];
b[n_, i_, l_List] := If[n == 0 || i == 1, If[g[Append[l, n]] == 1, 1, 0], Sum[b[n - i*j, i - 1, Append[l, j]], {j, 0, n/i}]];
a[n_] := b[n, n, {}];
Array[a, 30] (* Jean-François Alcover, May 20 2021, after Alois P. Heinz *)

Extensions

a(23)-a(62) from Alois P. Heinz, Feb 09 2018