|
%I #16 May 21 2021 04:16:38
%S 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,
%T 79,76,84,87,90,96,101,101,113,108,115,122,131,125,134,138,144,147,
%U 155,150,169,163,168,173,185,180,194,191,200,198,211,209,227,218,224,231,246
%N Number of integer partitions y of n such that exactly one permutation of y is a Lyndon word.
%e 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.
%p with(combinat): with(numtheory):
%p g:= l-> (n-> `if`(n=0, 1, add(mobius(j)*multinomial(n/j,
%p (l/j)[]), j=divisors(igcd(l[])))/n))(add(i, i=l)):
%p b:= (n, i, l)-> `if`(n=0 or i=1, `if`(g([l[], n])=1, 1, 0),
%p add(b(n-i*j, i-1, [l[], j]), j=0..n/i)):
%p a:= n-> b(n$2, []):
%p seq(a(n), n=1..30); # _Alois P. Heinz_, Feb 09 2018
%t LyndonQ[q_]:=Array[OrderedQ[{q,RotateRight[q,#]}]&,Length[q]-1,1,And]&&Array[RotateRight[q,#]&,Length[q],1,UnsameQ];
%t Table[Length[Select[IntegerPartitions[n],Length[Select[Permutations[#],LyndonQ]]===1&]],{n,20}]
%t (* Second program: *)
%t multinomial[n_, k_List] := n!/Times @@ (k!);
%t g[l_List] := With[{n = Total[l]}, If[n == 0, 1, Sum[MoebiusMu[j]*multinomial[n/j, l/j], {j, Divisors[GCD @@ l]}]/n]];
%t 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}]];
%t a[n_] := b[n, n, {}];
%t Array[a, 30] (* _Jean-François Alcover_, May 20 2021, after _Alois P. Heinz_ *)
%Y Cf. A000041, A000740, A001037, A032741, A059966, A144300, A167934, A293511, A292444, A298941.
%K nonn
%O 1,3
%A _Gus Wiseman_, Jan 30 2018
%E a(23)-a(62) from _Alois P. Heinz_, Feb 09 2018
|
