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

#2

# SYTpairs(n) inputs a positive integer n and outputs the set of pairs of 
# standard Young tableaux of the same shape [S,T] each with n cells

SYTpairs:=proc(n) local s,L,T:

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

###############################################################################
#3


#RS1m(Y,m): ONE STEP OF THE RS algorithm
# modified to also return the row of the insertion
RS1m:=proc(Y,m) local i,Y1:

Y1:=Ins(Y,1,m):
if Y1[2]=0 then
  RETURN(Y1[1],1):
fi:

#continued after class
for i from 2 to nops(Y)+1 while Y1[2]<>0 do
 Y1:=Ins(Y1[1],i,Y1[2]):
od:
Y1[1],i-1:
end:



#RS(pi):  the pair [S,T] that is the output
#of the Robinson-Scheastead mapping
RS:=proc(pi) local Y1,Y2,i,row:
Y1:=[[pi[1]]]:
Y2:=[[1]]:
for i from 2 to nops(pi) do
 Y1,row:=RS1m(Y1,pi[i]):
 if row = nops(Y2)+1 then 
  Y2:=[op(Y2),[i]]:
 else 
  Y2[row]:=[op(Y2[row]),i]:
 fi:
od:
[Y1,Y2]:
end:

#############################################################################
#4

invert1 := proc(T1,row) local T,a,i,j,c:
T:=T1:
i:=row:
a := T[i][-1]:
if nops(T[i]) = 1 then 
 T:=[op(1..nops(T)-1, T)]:
else
 T[i]:=[op(1..nops(T[i])-1, T[i])]:
fi:
while i>1 do 
 i:=i-1:
 for j from 2 to nops(T[i]) while T[i][j] < a do od:
 c:=T[i][j-1]:
 T[i][j-1]:=a:
 a:=c:
od:
T,a:
end:

# InvRS(P) inputs a pair [S,T] of standard Young tableaux of the same shape 
# and outputs a permutation of 1,2,...n
InvRS:=proc(P) local S,T,perm,n,x,j,a:
S:=P[1]:
T:=P[2]:
perm := []:

n:= max( seq(max(T[i]),i=1..nops(T)) ):
for x from n to 1 by -1 do

 for j from 1 to nops(T) while not(x in T[j]) do od:
 S,a:=invert1(S,j):
 perm:=[a,op(perm)]:  

od:
perm:
end:

##############################################################################
#old stuff

with(combinat):

#AllSYT(n): The set of all Standard Young Tableau with n cells
AllSYT:=proc(n) local S:
S:=Pn(n):
{seq(op(SYT(S[i])),i=1..nops(S))}:
end:

#Ins(Y,i,m): Inputs a (partially filled tableux Y,
#a row i, between 1 and nops(Y)+1 and an integer m
#and tries to place it LEGALLY at row i
#(if it is larger than all the current entries of row i
#and does not stick out, i=1 OR nops(Y[i])<nops(Y[i-1])
#and outputs the new tableau and either 0 or the new bumpbee
Ins:=proc(Y,i,m) local Y1,j:
if not (1<=i and i<=nops(Y)+1) then
 RETURN(FAIL):
fi:

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

if i=1 then 
  if m>=Y[1][-1] then
    RETURN([[op(Y[1]),m], op(2..nops(Y),Y)],0):
   fi:
fi:

for j from 1 to nops(Y[i]) while m>Y[i][j] do od:

if j=nops(Y[i])+1  and (i=1 or nops(Y[i])<nops(Y[i-1])) then

#corrected after class , Maple does not like op(m..n,L) if m-n>=2
if j+1<=nops(Y[i]) then
  RETURN ([op(1..i-1,Y),[op(1..j-1,Y[i]),m,op(j+1..nops(Y[i]),Y[i])],
op(i+1..nops(Y),Y)],0):
else

RETURN ([op(1..i-1,Y),[op(1..j-1,Y[i]),m],
op(i+1..nops(Y),Y)],0):
fi:


else
RETURN([op(1..i-1,Y),[op(1..j-1,Y[i]),m,op(j+1..nops(Y[i]),Y[i])],
op(i+1..nops(Y),Y)],Y[i][j]):
fi:

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