A114714 Number of linear extensions of a 2 X 2 X n lattice.

1, 2, 48, 2452, 183958, 17454844, 1941406508, 242201554680, 32959299267334, 4801233680739724, 738810565910888784, 118929992674840615128, 19880920716640427983476, 3431624482227380273056728, 608880419873586515669564728, 110654016191338341346670548240

Offset: 0

Author

Mitch Harris, Dec 27 2005

Keywords

• nonn
• hard

Comments

The additional terms were found using dynamic programming to count the maximal chains in the distributive lattice of order-preserving functions from the chain of length n to J(P), where J is the lattice of downsets of the poset P = 2x2. - Nick Krempel, Jul 08 2010

References

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

Links

• Alois P. Heinz, Table of n, a(n) for n = 0..180 (first 41 terms from Nick Krempel)

Crossrefs

Cf. A114717.

Programs

Maple

b:= proc(x, y, u, w) option remember;
      `if`(x=0 and y=0 and u=0 and w=0, 1, `if`(x>y and x>u,
       b(x-1, y, u, w), 0)+ `if`(y>w, b(x, y-1, u, w), 0)+
      `if`(u>w, b(x, y, u-1, w), 0)+ `if`(w>0, b(x, y, u, w-1), 0))
    end:
a:= n-> b(n$4):
seq(a(n), n=0..20);  # Alois P. Heinz, Apr 27 2012

Mathematica

b[x_, y_, u_, w_] := b[x, y, u, w] = If[x == 0 && y == 0 && u == 0 && w == 0, 1, If[x>y && x>u, b[x-1, y, u, w], 0] + If[y>w, b[x, y-1, u, w], 0] + If[u>w, b[x, y, u-1, w], 0] + If[w>0, b[x, y, u, w-1], 0]]; a[n_] := b[n, n, n, n]; Table[a[n], {n, 0, 20}] (* Jean-François Alcover, May 29 2015, after Alois P. Heinz *)

Extensions

More terms from Nick Krempel, Jul 08 2010