A114717 Number of linear extensions of the divisor lattice of n.

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, 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, 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

Offset: 1

Author

Mitch Harris and Antti Karttunen, Dec 27 2005

Keywords

• nonn

Comments

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

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

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

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

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.

References

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

Links

• Alois P. Heinz, Table of n, a(n) for n = 1..10000
• Graham Brightwell and Peter Winkler, Counting linear extensions, Order 8 (1991), no. 3, 225-242.
• Gary Pruesse and Frank Ruskey, Generating linear extensions fast, SIAM J. Comput. 23 (1994), no. 2, 373-386.
• Index entries for sequences computed from exponents in factorization of n

Crossrefs

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

Programs

Maple

with(numtheory):
b:= proc(s) option remember;
      `if`(nops(s)<2, 1, add(`if`(nops(select(y->
       irem(y, x)=0, s))=1, b(s minus {x}), 0), x=s))
    end:
a:= proc(n) local l, m;
      l:= sort(ifactors(n)[2], (x, y)-> x[2]>y[2]);
      m:= mul(ithprime(i)^l[i][2], i=1..nops(l));
      b(divisors(m) minus {1, m})
    end:
seq(a(n), n=1..100);  # Alois P. Heinz, Jun 29 2012

Mathematica

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 *)