|
%I #15 Dec 15 2020 16:27:16
%S 1,1,0,1,1,1,0,0,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,0,1,0,1,1,2,1,0,1,1,1,
%T 1,1,1,1,1,1,2,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,3,1,1,1,0,1,2,1,1,1,
%U 2,1,2,1,1,1,1,1,2,1,1,0,1,1,3,1,1,1,1,1,3
%N Number of permutations of the multiset of prime factors of n > 1 that are Lyndon words.
%H Alois P. Heinz, <a href="/A298941/b298941.txt">Table of n, a(n) for n = 2..20000</a>
%e The a(90) = 3 Lyndon permutations are {2,3,3,5}, {2,3,5,3}, {2,5,3,3}.
%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 a:= n-> g(map(i-> i[2], ifactors(n)[2])):
%p seq(a(n), n=2..150); # _Alois P. Heinz_, Feb 09 2018
%t primeMS[n_]:=If[n===1,{},Flatten[Cases[FactorInteger[n],{p_,k_}:>Table[PrimePi[p],{k}]]]];
%t LyndonQ[q_]:=Array[OrderedQ[{q,RotateRight[q,#]}]&,Length[q]-1,1,And]&&Array[RotateRight[q,#]&,Length[q],1,UnsameQ];
%t Table[Length[Select[Permutations[primeMS[n]],LyndonQ]],{n,2,60}]
%t (* Second program: *)
%t multinomial[n_, k_List] := n!/Times @@ (k!);
%t g[l_] := With[{n = Total[l]}, If[n == 0, 1, Sum[MoebiusMu[j] multinomial[ n/j, l/j], {j, Divisors[GCD @@ l]}]/n]];
%t a[n_] := g[FactorInteger[n][[All, 2]]];
%t a /@ Range[2, 150] (* _Jean-François Alcover_, Dec 15 2020, after _Alois P. Heinz_ *)
%Y Cf. A000740, A001037, A001222, A008480, A008965, A059966, A060223, A096443, A112798, A215366, A275024, A294859, A298947.
%K nonn
%O 2,29
%A _Gus Wiseman_, Jan 29 2018
|
