A298941 - OEIS

%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