#OK to post homework
#George Spahn, 4/4/2021, Assignment 18

with(combinat):
# Aigner(n) uses Martin Aigner's lexigoraphic greed idea to output a 
# Symmetic Chain Decomposition of the Boolean Lattice
# For example, Aigner(2) should return [ [[],[1],[1,2]] , [[2]] ]

Aigner:=proc(n) local lattice, start, final, chain, i,j:

final := []:
lattice:= [seq(choose(n,i), i=0..n)]:

while nops(lattice[trunc((n+2)/2)]) > 0 do
 
 for start from 1 to n while nops(lattice[start]) = 0 do od:

 chain := [lattice[start][1]]:
 lattice[start]:=subsop(1=NULL,lattice[start]):

 for i from (start+1) to (n-start+2) do
  for j from 1 to nops(lattice[i]) do

   if {op(chain[-1])} subset {op(lattice[i][j])} then
    chain:=[op(chain),lattice[i][j]]:
    lattice[i]:=subsop(j=NULL,lattice[i]):
    break:
   fi:
  od:
 od:
 final:=[op(final),chain]:
od:
final:
end: