%I #42 Aug 06 2024 09:48:35

%S 1,1,1,1,1,2,1,1,1,2,1,5,1,2,2,1,1,5,1,5,2,2,1,14,1,2,1,5,1,48,1,1,2,

%T 2,2,42,1,2,2,14,1,48,1,5,5,2,1,42,1,5,2,5,1,14,2,14,2,2,1,2452,1,2,5,

%U 1,2,48,1,5,2,48,1,462,1,2,5,5,2,48,1,42,1,2,1,2452,2,2,2,14,1,2452,2

%N Number of linear extensions of the divisor lattice of n.

%C Notice that only the powers of the primes determine a(n), so a(12) = a(75) = 5.

%C For prime powers, the lattice is a chain, so there is 1 linear extension.

%C a(p^1*q^n) = A000108(n+1), the Catalan numbers.

%C Alternatively, the number of ways to arrange the divisors of n in such a way that no divisor has any of its own divisors following it. E.g., for 12, the following five arrangements are possible: 1,2,3,4,6,12; 1,2,3,6,4,12; 1,2,4,3,6,12; 1,3,2,4,6,12 and 1,3,2,6,4,12. But 1,2,6,4,3,12 is not possible because 3 divides 6 but follows it. Thus a(12)=5. - _Antti Karttunen_, Jan 11 2006

%C For n = p1^r1 * p2^r2, the lattice is a grid (r1+1)*(r2+1), whose linear extensions are counted by ((r1+1)*(r2+1))!/Product_{k=0..r2} (r1+1+k)!/k!. Cf. A060854.

%D R. Stanley, Enumerative Combinatorics, Vol. 2, Proposition 7.10.3 and Vol. 1, Sec 3.5 Chains in Distributive Lattices.

%H Alois P. Heinz, <a href="/A114717/b114717.txt">Table of n, a(n) for n = 1..10000</a>

%H Graham Brightwell and Peter Winkler, <a href="https://doi.org/10.1007/BF00383444">Counting linear extensions</a>, Order 8 (1991), no. 3, 225-242.

%H Gary Pruesse and Frank Ruskey, <a href="https://citeseerx.ist.psu.edu/pdf/5e4ca7226502b6627dba415e1df2092888ed206d">Generating linear extensions fast</a>, SIAM J. Comput. 23 (1994), no. 2, 373-386.

%H <a href="/index/Eu#epf">Index entries for sequences computed from exponents in factorization of n</a>

%p with(numtheory):

%p b:= proc(s) option remember;

%p `if`(nops(s)<2, 1, add(`if`(nops(select(y->

%p irem(y, x)=0, s))=1, b(s minus {x}), 0), x=s))

%p end:

%p a:= proc(n) local l, m;

%p l:= sort(ifactors(n)[2], (x, y)-> x[2]>y[2]);

%p m:= mul(ithprime(i)^l[i][2], i=1..nops(l));

%p b(divisors(m) minus {1, m})

%p end:

%p seq(a(n), n=1..100); # _Alois P. Heinz_, Jun 29 2012

%t b[s_List] := b[s] = If[Length[s]<2, 1, Sum[If[Length[Select[s, Mod[#, x] == 0 &]] == 1, b[Complement[s, {x}]], 0], {x, s}]]; a[n_] := Module[{l, m}, l = Sort[ FactorInteger[n], #1[[2]] > #2[[2]] &]; m = Product[Prime[i]^l[[i]][[2]], {i, 1, Length[l]}]; b[Divisors[m] // Rest // Most]]; Table[a[n], {n, 1, 100}] (* _Jean-François Alcover_, May 28 2015, after _Alois P. Heinz_ *)

%Y Cf. A060854, A114714, A114715, A114716, A119842.

%K nonn

%O 1,6

%A _Mitch Harris_ and _Antti Karttunen_, Dec 27 2005