# OK to post homework
# Lucy Martinez, 03-26-2026, Assignment 16

with(combinat):


# Question 1:
# Write a procedure AntiRS(Pair)
#  that inputs a members SYTpairs(n)=[P,Q] and outputs
#  a permutation pi of {1, ..., n} such that RS(pi)=[P,Q].
# Check that
#  {seq(evalb(AntiRS(RS(pi))=pi), pi in permute(n))}={true} for n from 2 to 7
# Also check that
#  {seq(evalb(RS(AntiRS(s))=s), s in SYTpairs(n))}={true}
# ANSWER: both return true 
AntiRS:=proc(Pair) local n, pi, k, r, i, j, newP, newQ, pos:
n:=add(nops(Pair[1][i]), i=1..nops(Pair[1])):
pi:=array(1..n):

newP:=Pair[1]:
newQ:=Pair[2]:

for k from n by -1 to 1 do
 # find position of k in Q
 for i to nops(newQ) do
  for j to nops(newQ[i]) do
   if newQ[i][j]=k then
     r:=i:
     pos:=j:
   fi:
  od:
 od:

 # remove from Q
 newQ[r] := [op(1..pos-1,newQ[r]), op(pos+1..nops(newQ[r]),newQ[r])]:
 if nops(newQ[r])=0 then
  newQ := [op(1..r-1,newQ), op(r+1..nops(newQ),newQ)]:
 fi:

# reverse bump in P
newP, pi[k]:=op(RS1up(newP,r)):
 if nops(newP[r])=0 then
  newP:=[op(1..r-1,newP), op(r+1..nops(newP),newP)]:
 fi:
od:

[seq(pi[i],i=1..n)]:
end:


#RS1inv(row,x): reverse bumping on a single row
#finds the rightmost entry < x, swaps, and bumps it upward
RS1inv:=proc(row,x) local i, y, newrow:

for i from nops(row) by -1 to 1 do
 if row[i] < x then
   y := row[i]:
   newrow:=[op(1..i-1,row), x, op(i+1..nops(row),row)]:
   RETURN([newrow, y]):
 fi:
od:

# if no such element, x just gets removed (top row case)
RETURN([row, x]):

end:



#RS1up(P, r): remove from row r and reverse bump upward
RS1up:=proc(P, r) local x, i, newP, lucy:
newP:=P:

# take last element of row r
x:=newP[r][nops(newP[r])]:
newP[r]:=[op(1..nops(newP[r])-1, newP[r])]:

for i from r-1 by -1 to 1 do
 lucy:=RS1inv(newP[i], x):
 newP[i]:=lucy[1]:
 x:=lucy[2]:
od:

# x is the output: one entry of permutation
RETURN([newP, x]):

end:


# Question 2:
# Verify experimentally that if RS(pi)=[P,Q] then RS(pi^(-1))=[Q,P]
#  for all permutations pi of length up to 7. Can you prove it? 

#The following outputs true :)
#for n from 1 to 7 do
#S:={}:
# for pi in permute(n) do
#  P:=RS(pi)[1]:
#  Q:=RS(pi)[2]:
#  if  (evalb(P=RS(invPi(pi))[2]) and evalb(Q=RS(invPi(pi))[1])) then
#   S:=S union {true}:
#  fi:
# od:
#od:


#FROM Spring 2024:
#invPi(pi): The inverse of the permutation pi. For example InvPi([2,3,4,1]) is [4,1,2,3]
invPi:=proc(pi) local i1,sig:
for i1 from 1 to nops(pi) do
 sig[pi[i1]]:=i1:
od:
[seq(sig[i1],i1=1..nops(pi))]:
end:





#########################From previous class:
# C16.txt, March 23, 2026

Help16:=proc():
 print(`RS1(Y,i), RS1left(pi), RS(pi)`):
end:

#We will finish the RSK algorithm
# Example:
# Given the following partial STY 
# 4 5 7
# 6 8
# Want to insert 2:
# 2 5 7  and bumpee=4 so now we have to insert 4 next
# 6 8    
# Want to insert 4 (after second row):
# 2 5 7
# 4 8    and bumpee=6 so now we have to insert 6 next
# Want to insert 6 (after third row):
# 2 5 7
# 4 8
# 6
#The previous SYT is the output  

#Now given a permutation pi=31452
#Begin STY:
# 3
# insert 1 and bump 3
# 1
# 3
# insert 4
# 1
# 3 4
# insert 5
# 1
# 3 4 5
# insert 2
# 1 2
# 3 4 5 


#RS1(Y,i): Inputs a partial Young tableaux and another integer i NOT yet in Y
# and places it in the right place, by a bumping process
# it returns a tableaux with one more box followed by the row 
RS1:=proc(Y,i) local k, NewY,lucy,bumpee,i1,j:
if Y=[] then
 return([[i]],1):
fi:
k:=nops(Y):
lucy:=RS11(Y[1],i):
NewY[1]:=lucy[1]:
bumpee:=lucy[2]:

if bumpee=0 then 
 return([NewY[1], op(2..k,Y)],1):
fi:

for i1 from 2 to k while bumpee<>0 do
 lucy:=RS11(Y[i1],bumpee):
 NewY[i1]:=lucy[1]:
 bumpee:=lucy[2]:
 if bumpee=0 then
  return( [seq(NewY[j],j=1..i1), op(i1+1..k,Y)],i1):
 fi:
od:
[seq(NewY[j],j=1..k),[bumpee]],k+1:
end:



#RS1left(pi): inputs a permutation pi (of size nops(pi)) and outputs ONE
# STY of whatever shape (with n boxes)
RS1left:=proc(pi) local Y,i:
Y:=[]:
for i from 1 to nops(pi) do
 Y:=RS1(Y,pi[i])[1]:
od:
Y:
end:



#RS(pi): inputs a permutation pi of ({1,2,...,n:=nops(pi)) and outputs
# a pair of SYT of the SAME shape (with n boxes)
#The Robinson–Schensted algorithm
RS:=proc(pi) local Y1, i,Yr,eaea,p:
if pi=[] then
 return([[],[]]):
fi:
Y1:=[[pi[1]]]:
Yr:=[[1]]:

for i from 2 to nops(pi) do
 eaea:=RS1(Y1,pi[i]):
 Y1:=eaea[1]:
 p:=eaea[2]:
 if p<=nops(Yr) then
  Yr:=[op(1..p-1,Yr),[op(Yr[p]),i],op(p+1..nops(Yr),Yr)]:
 else
  Yr:=[op(Yr),[i]]:
 fi:
od:
[Y1,Yr]:
#Yr is usually what they call Q
end:



############################
# C14.txt, March 09, 2026

Help14:=proc():
 print(`NuSYT(L), SYTpairs(n), NuSYTpairs(n)`):
 print(`RS11(a,i)`):
end:


#NuSYT(L): The NUMBER of Standard Young tableaux of shape L
NuSYT:=proc(L) local i, k,S,L1:
option remember:
k:=nops(L):

if k=0 then
  RETURN(1):
fi:
S:=0:

#now we look for all the legal rows where the element n can be placed
for i from 1 to k-1 do
if L[i]>L[i+1] then
 L1:=[op(1..i-1,L),L[i]-1,op(i+1..k,L)]:
 S:=S+NuSYT(L1): 
fi:
od:

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

S:=S+NuSYT(L1):
else
L1:=[op(1..k-1,L)]:
S:=S+NuSYT(L1):
fi:
S:
end:


#Pairs of SYT of the same shape
# We are interested in pairs (Y1,Y2) such that
# shape of Y1 equals shape of Y2
# For n=2:
#  SYT([1,1])={[ [1], [2] ] } so there is only 1 of these STY of shape [1,1]
#
#  SYTpairs(2)= { [[[1, 2]], [[1, 2]]], [ [[1], [2]], [[1], [2]] ]}

#SYTpairs(n):
SYTpairs:=proc(n) local S,P,p,S1,s1,s2:
option remember:
P:=Par(n):
S:={}:
for p in P do
 S1:=SYT(p): #the set of Young Tableaux of the partition p (shape p)
 S:=S union {seq(seq([s1,s2], s1 in S1),s2 in S1)}:
od:
S:
end:

#NuSYTpairs(n):
NuSYTpairs:=proc(n) local S,P, p:
option remember:
P:=Par(n):
S:=0:
for p in P do
S:=S+NuSYT(p)^2:
od:
S:
end:



#RSK: Find a mapping from the set of permutations to the set of STYpairs(n)
#Input: permutation of {1,2,...,n}
#Output: a pair of SYTs of the SAME shape (with n boxes)
#Example: Given [1,4,5,9] then where can we place 10 so that
# it is still increasing? --> put it at the end
# What if I want to place the number 3 using RSK such that if I place it
#  somewhere other than at the end, we must bump the number that was in it
#  So, [1,4,5,9] becomes [1,3,5,9]
# 

#RS11(a,i): inputs an INCREASING list of positive integers a and
# another positive integer i, outputs a pair a1,j where 
# (usually a1 is of the same length as a) and i is placed where it belongs
# and j is the entry that it bumped, unless i is larger than all the members of a
# (i.e. larger than a[-1]) then a1 is [op(a), i], and j is 0
# For example: RS1([11,12,13],4)= [4,12,13], 11
#  where the second output is the element that got bumped out
RS11:=proc(a,i) local k,j:
k:=nops(a):
for j from 1 to k while a[j]<i do
od:
if j=k+1 then
 return([op(a),i],0):
fi:
[op(1..j-1,a),i,op(j+1..k,a)], a[j]:
end:



#Now that we have the helper function RS11(a,i), we do the following:
#
#Input a Young Tableaux (YT) with distinct entries and an integer i
# NOT yet in the YT, outputs a larger YT with ONE more box, obtained as follows:
#  Try to insert i in the first row if it fits w/o bumping it
#  otherwise put it in its rightful place and bump somebody
#  now the one that got bumped has to bump someone else
#  and place the bumpee in the second row


#Example of the algorithm above
#Y= [ [1,4,8], [2,7], [3] ]
#i=5

#148 bumpee is 8
#27
#3

#becomes 

#145
#278
#3

#######################################
# C13.txt, March 05, 2026

Help13:=proc():
 print(`ParN(n,k), PFG(L), SYT(L), PSYT(Y)`):
end:


#ParN(n,k): outputs the partitions of n for which the first part equal to k
ParN:=proc(n,k) local s,S,T:
S:=Par(n):
T:={}:
for s in S do
 if s[1]=k then
  T:=T union {s}:
 fi:
od:
T:
end:


#PFG(L): The Ferrers graph of the partition L
PFG:=proc(L) local i:
for i from 1 to nops(L) do
 lprint(1$L[i]):
od:
end:



#SYT(L): the set of standard young tableaux of shape L
SYT:=proc(L) local i,s1,k,n,S,L1,S1:
option remember:
k:=nops(L):
n:=add(L[i],i=1..k):

if k=0 then
 return({[]}):
fi:

S:={}:

#now we look for all the legal rows where the element n can be placed
for i from 1 to k-1 do
 if L[i]>L[i+1] then
  L1:=[op(1..i-1,L),L[i]-1,op(i+1..k,L)]:
  S1:=SYT(L1):
  S:=S union {seq([op(1..i-1,s1) , [op(s1[i]),n], op(i+1..k,s1)] ,s1 in S1)}:
 fi:
od:

if L[k]>1 then 
 L1:=[op(1..k-1,L),L[k]-1]:
 S1:=SYT(L1):
 S:=S union {seq([op(1..k-1,s1) , [op(s1[k]),n]],s1 in S1)}:
else
 L1:=[op(1..k-1,L)]:
 S1:=SYT(L1):
 S:=S union {seq([op(1..k-1,s1) , [n] ],s1 in S1)}:
fi:
S:
end:


#PSYT(Y): prints the SYT Y
PSYT:=proc(Y) local i:
for i from 1 to nops(Y) do
 lprint(op(Y[i])):
od:
end:



#Def: We are going to construct the Standard Young tableaux
# of shape L=[3,3,2], which is a partition of 8

# The following is the Ferrers graph for [3,3,2]
# 111
# 111
# 11

# Now, imagine each number "1" is an empty box. You fill each box
#  with the numbers {1,...,8} such that every row and every column
#  are increasing from left to right and top to bottom, respectively
# One way is the following:
# 123
# 456
# 78

# Example 2:
# Let L=[2,2] so n=4
# This is the shape:
# 11
# 11
#
# So the Young Tableaux are the following 2:
#
# 12
# 34
#
# AND
#
# 13
# 24

# Where can n (the tallest person) sit w/o disturbing shorter people?
#

# Below is a recap from last week:
#
# Recall that the number of partitions of n, denoted by p(n) satisfies
# sum(p(n)*q^n,n=0..infinity)=Prod(1/(1-q^k),k=1..infinity)
#
# G.F. of distinct partitions Prod((1+q^k),k=1..infinity)
# sum(d(n)*q^n,n=0..infinity)=(1+q)*(1+q^2)*(1+q^3)*...
#  where d(n) is the number of partitions with distinct parts
#
# sum(o(n)*q^n,n=0..infinity)=Prod(1/(1-q^(2*k-1)),k=1..infinity)=
#  1/((1-q)*(1-q^3)*(1-q^5)*...)
#  where o(n) is the number of partitions where all the parts are odd 
#
# Recall that (1+z)=(1-z^2)/(1-z)
# SO,
# 1/((1-q)*(1-q^3)*(1-q^5)*...) = (1-q^2)*(1-q^4)*(1-q^6)*(1-q^8)*.../((1-q)*(1-q^2)*(1-q^3)*(1-q^4)...)
#                           = ( (1-q^2)/(1-q) )*( (1-q^4)/(1-q^2) )*( (1-q^6)/(1-q^3) )*...
#                           =  (1+q)*(1+q^2)*(1+q^3)*...
# On the left hand side we have the G.F. of the partitions with odd parts
# On the right hand side we have the G.F. of the partitions with distinct parts
# For more detail, see: https://sites.math.rutgers.edu/~zeilberg/numtheory/L22.pdf




###################################
# C12.txt, March 02, 2026

Help12:=proc():
 print(`Park(n,k), Par(n)`):
end:

#Park(n,k): The set of partitions of n into exactly k parts
Park:=proc(n,k) local S,k1,S1,s1:
option remember:

if n<k then
   RETURN({}):
fi:

if k=0 then
 if n=0 then
   RETURN({[]}):
   else
    RETURN({}):
fi:
fi:

S:={}:
for k1 from 0 to k do
 S1:=Park(n-k,k1):
 S:= S union {seq([op(s1+[1$k1]),1$(k-k1)], s1 in S1)}:
od:
S:
end:


#Par(n): The set of partitions of n, the clever way.
Par:=proc(n) local k:
{seq(op(Park(n,k)), k=1..n)}:
end: