#OK to post homework
#Blair Seidler, 2021-04-04 Assignment 18

with(combinat):

Help:=proc():
print(`Aigner(n),GrabChain(L),SCD(n),CheckSCDs(n)`):
end:

# 1.

#Aigner(n): Inputs a pos. integer n, and outputs a SCD
#of the Boolean lattice of subsets of [n]
#following the great combinatorialist Martin Aigner's method
#of lexicographic greed
Aigner:=proc(n) local CD,L,k,C:
CD:=[]:
L:=[seq(choose(n,k),k=0..n)]:
while L<>[[]$(n+1)] do
  C:=GrabChain(L):
  CD:=[op(CD),C[1]]:
  L:=C[2]:
od:
CD:
end:

#GrabChain(L): inputs the still-available lattice
#outputs a chain (taken greedily) and the smaller
#L with the members of C removed
GrabChain:=proc(L) local i,C,L1,L2,st,c,grabflag:
L1:=[]:
for i from 1 to nops(L) while L[i]=[] do L1:=[op(L1),[]]: od:

if i=nops(L)+1 then RETURN(FAIL): fi:
st:=i:
C:=[L[st][1]]:
L1:=[op(L1),[seq(L[st][i],i=2..nops(L[st]))]]:
for i from st+1 to nops(L) do
  grabflag:=true:
  L2:=[]:
  for c in L[i] do
    if grabflag and (convert(C[i-st],`set`) subset convert(c,`set`)) then
      C:=[op(C),c]:
      grabflag:=false:
    else
      L2:=[op(L2),c]:
    fi:
  od:
  L1:=[op(L1),L2]:
od:
[C,L1]:

end:

# 2.

#SCD(n): uses the idea at the very end of the lecture to construct from each
#chain of SCD(n-1) by creating two new chains of SCD(n).
SCD:=proc(n) local C,P,c,i:
option remember:
if n<=0 then RETURN([[[]]]): fi:
P:=SCD(n-1):
C:=[]:
for c in P do
#print(c):
  if nops(c)>1 then
    C:=[op(C),[op(c),[op(c[-1]),n]],
        [seq([op(c[i]),n],i=1..nops(c)-1)]]:
  else
    C:=[op(C),[op(c),[op(c[-1]),n]]]:
  fi:
od:
C:
end:


#Verify that you get the same output as Aigner(n) #### Verified up to n=13 ####
#Making SCD output in the same order as Aigner proved too annoying, so I convert to sets
#in order to make sure that the actual decompositions match.
#CheckSCDs(n)
CheckSCDs:=proc(n) local i:
seq(evalb(convert(Aigner(i), set) = convert(SCD(i), set)), i = 0 .. n):
end: