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

# TABpairs(n,m) outputs all pairs [S,T] where S is a a (column-strict) tableau
# with entires from {1,...,m}, and T is a STANDARD tableau of the SAME shape

TABpairs:=proc(n,m) local s,L,T,U,i,j:

L:={}:
for s in Pn(n) do:
 T:=SYT(s):
 U:=TAB(s,m):
 L := L union {seq(seq([U[i],T[j]] ,j=1..nops(T)) ,i=1..nops(U))}:
od:
L:
end: 


# George's InvRS(P) still works for the general scenario.
 

##############################################################################

#NewBox(B): inputs a list of NON-NEGATIVE integers and outputs
#the set of all lists [i1,i2,...] i1<=B[1], i2<=B[2] ,...
NewBox:=proc(B) local k,B1,S1,i,v:
option remember:
if B=[]  then
 RETURN({[]}):
fi:

k:=nops(B):
B1:=[op(1..k-1,B)]:

S1:=NewBox(B1):
{seq(seq([op(v),i], v in S1),i=0..B[k])}:

end:

#APP(Y,b,m): inputs a tableaux Y with entires {1,...,m-1} and
#and a vector b of either the same length of Y or one longer and appends
#b[i] m's to the end of row i for i=1..nops(Y) and if nops(b)=nops(Y)+1 a new row of b[nops(b)] m's. For example
#APP([[1,1,2],[2,2]],[1,1,1],3) should be
#[[1,1,2,3],[2,2,3],[3]]
APP:=proc(Y,b,m) local i,Y1:
Y1:=[seq([op(Y[i]),m$b[i]],i=1..nops(Y))]:
if nops(b)=nops(Y)+1 then
 Y1:=[op(Y1),[m$b[-1]]]:
fi:
Y1:
end:

#TAB(L,m): the set of all tableaux of shape L with entries
#{1,2,...,m}
TAB:=proc(L,m)  local L1,B,i,S,b,y,S1:
option remember:

if L=[] then
  RETURN({[]}):
fi:

if m<nops(L) then
  RETURN({}):
fi:

if nops(L)=1 and m=1 then
 RETURN({[[1$L[1]]]}):
fi:


B:=NewBox([seq(L[i]-L[i+1],i=1..nops(L)-1),L[nops(L)]]):

S:={}:

for b in B do
 L1:=[seq(L[i]-b[i],i=1..nops(L))]:
 if L1[-1]=0 then
  L1:=[op(1..nops(L1)-1,L1)]:
fi:

 S1:=TAB(L1,m-1):

S:=S union {seq(APP(y,b,m),y in S1)}:

od:
S:

end:


#AP(Y,i,m):write a procedure that inputs a Standard Young Tableau
#and an integer i between 1 and nops(Y)+1 and inserts the
#entry m at  the end of the i-th row, or if i=nops(Y)+1 make
#a new row with 1 cell occupied with m
AP:=proc(Y,i,m):

if i=nops(Y)+1 then
 RETURN([op(Y),[m]]):
fi:


if i>1 and nops(Y[i])=nops(Y[i-1]) then
  RETURN(FAIL):
fi:

[op(1..i-1,Y),[op(Y[i]),m],op(i+1..nops(Y),Y)]:


end:

#SYT(L): inputs an integer partion (given as a weakly decreasing
#list of POSITIVE integers OUTPUTS the LIST of
#Standard Young Tableax of shape L (n=Number of boxes of L)
#(A way of filling 1, ..., n in the boxes such that horiz. and
#vertically they are increasing
SYT:=proc(L) local n,L1,S,S1,i,j:
option remember:
n:=add(L):

if n=1 then 
  RETURN([[[1]]]):
fi:

S:=[]:

for i from 1 to nops(L)-1 do
 if L[i]>L[i+1] then
  L1:=[op(1..i-1,L),L[i]-1,op(i+1..nops(L),L)]:
  S1:=SYT(L1):
 S:=[op(S), seq(AP(S1[j],i,n),j=1..nops(S1))]:
 fi:
od:


 if L[-1]>1 then
  L1:=[op(1..nops(L)-1,L), L[nops(L)]-1 ]:
  else
  L1:=[op(1..nops(L)-1,L)]:
 fi:

 S1:=SYT(L1):
 S:=[op(S), seq(AP(S1[j],nops(L),n),j=1..nops(S1))]:

S:

end:

##FROM C11.txt
#Pnk(n,k): The LIST of integer partitions of n with largest part k
Pnk:=proc(n,k) local k1,L,L1,j:
option remember:

if not (type(n,integer) and type(k,integer) and n>=1 and k>=1 )then
 RETURN([]):
fi:
 
if k>n then
 RETURN([]):
fi:

if k=n then
 RETURN([[n] ]):
fi:

L:=[]:

for k1 from min(n-k,k) by -1 to 1 do
 L1:=Pnk(n-k,k1):
 L:=[op(L), seq([k, op(L1[j])],j=1..nops(L1))]:
od:

L:

end:

#Pn(n): The list of integer partitions of n in rev. lex. order
Pn:=proc(n) local k:option remember:[seq(op(Pnk(n,n-k+1)),k=1..n)]:end:
#END FROM C11.txt