#Please do not post homework
#AJ Bu, April 15 2021, Assignment 23
with(combinat):

########################	PROBLEM 2	########################
#SYTpairs(n): inputs a positive integer n 
#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,j,shape,shape2,pairs,i:
	if n<3 then
		RETURN({}):
	fi:
	
	S:=convert(AllSYT(n),list): 
	
	L[1]:=[S[1]]:
	j:=1:
	shape:=[nops(S[1])]:
	
	for i from 2 to nops(S) do
		shape2:=[seq(nops(S[i][k]),k=1..nops(S[i]))]:
		if shape2=shape then 
			L[j]:=[op(L[j]),S[i]]:
		else
			j:=j+1:
			L[j]:=[S[i]]:
			shape:=shape2:
		fi:
	od: 
	pairs:={}:

	for i from 1 to j do
		pairs:= pairs union convert(choose(L[i],2),set):
	od:

end:



########################	PROBLEM 3	########################
#RS(pi): inputs a permutation pi and outputs a member of STYpairs(n). 
#S is the output of RSleft(pi) and T is the "template" tableau obtained by inserting, 
#in turn 1,2,3,...,n to the new cell that emerges each time the shape of the left tableau 
#increases by one cell.

RS:=proc(pi) local S,n,P,Q,P1,Q1,i,j:
	S:=RSleft(pi):
	n:=nops(pi):
	P:=[[pi[1]]]:
	Q:=[[1]]: 
	for i from 2 to n do 
		P1:=RS1(P,pi[i]):
		if nops(P)<>nops(P1) then
			Q1:=[op(Q),[i]]:
		else
			for j from 1 to nops(P) do 
				if nops(P[j])<>nops(P1[j]) then 
					Q1:=[op(1..j-1,Q), [op(Q[j]),i],op(j+1..nops(Q),Q)]: 
					j:=nops(P):
				fi:
			od:
		fi:
		P:=P1:
		Q:=Q1:
	od:

S,Q:
end:

########################	PROBLEM 4	########################
#InvRSstep(P): one step in InvRS(P)
InvRSstep:=proc(P) local S,T,n,term,k,i,j,term1:
	S:=P[1]:
	T:=P[2]:
	n:=add(nops(l), l in S):
	term:=0:

	for k from 1 to nops(T) do 
		if T[k][-1]=n then
			i:=k-1:
			j:=nops(T[k]):
			term:=S[k][j]:
			
			if j=1 then
				S:=S[1..k-1]:
				T:=T[1..k-1]:
			else
				S[k]:=S[k][1..j-1]:
				T[k]:=T[k][1..j-1]:
			fi:
		fi:
	od:

	
	while i>0 do
		if j=nops(S[i]) then
			term1:=S[i][j]:
			S[i][j]:=term:
			term:=term1:
			
			i:=i-1:
		elif S[i][j+1]>term then
			term1:=S[i][j]:
			S[i][j]:=term:
			term:=term1:
			i:=i-1:
		else
			j:=j+1:
		fi:
	od:
	
	[[S,T],term]:

end:



#InvRS(P): inputs a pair [S,T] of standard Young tableaux of the same shape
 #outputs a permutation of 1,2,...n (where n is the number or cells of S (or T))

InvRS:=proc(P) local Q,n,pi,i,R:
	Q:=P:
	n:=add(nops(l), l in P[1]):
	pi:=[0$n]:
	
	for i from 1 to n do
		R:=InvRSstep(Q): 
		pi[-i]:=R[2]:
		Q:=R[1]:
	od:
	pi:
end:



#####FROM C23.txt #######
#C23.txt:  Maple code for Lecture 23

Help23:=proc(): print(` Ins(Y,i,m), RS1(Y,m) , RSleft(pi), AllSYT(n) `): 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:

#RS1(Y,m): ONE STEP OF THE RS algorithm
RS1:=proc(Y,m) local i,Y1:

Y1:=Ins(Y,1,m):
if Y1[2]=0 then
  RETURN(Y1[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]:
end:

with(combinat):

#RSleft(pi): The left tableau,S of the pair (S,T) that is the output
#of the Robinson-Scheastead mapping
RSleft:=proc(pi) local Y,i:
Y:=[[pi[1]]]:
for i from 2 to nops(pi) do
 Y:=RS1(Y,pi[i]):
od:
Y:
end:

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

#OLD STUFF
#C22.txt
Help22:=proc(): print(` Pn(n), AP(Y,i,m), SYT(L) , AllSYT(n) `): 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:



#syt(L): inputs an integer partion (given as a weakly decreasing
#list of POSITIVE integers OUTPUTS the NUMBER 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:=0:

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)]:
  S:=S+syt(L1):
 
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:

 S:=S+syt(L1):
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


#END OLD STUFF