# OK to post homework
# Aurora Hiveley, 3/24/26, Assignment 16

Help:=proc(): print(`AntiRS(Pair), AntiRS1(P1,Q1), findBumper(row,bumpee), inv(pi)`):   end:


## Problem 1 
# AntiRS(Pair): inputs a members SYTpairs(n)=[P,Q] and outputs a permutation pi of {1, ..., n} such that RS(pi)=[P,Q].


AntiRS := proc(Pair) local P1,Q1,n,pi,i,step : 
P1 := Pair[1]:
Q1 := Pair[2]:
n := max(P1):
pi := [0$n]: 

for i from 1 to n do     
    step := [AntiRS1(P1,Q1)]: 
    
    pi[-i] := step[-1]:

    P1 := step[1]:
    Q1 := step[2]:
od:

pi:
end:


# returns [P2,Q2,i] where P2 and Q2 are P1 and Q1 after iteration's deletion, and 
# entry i is the next to last entry in the permutation pi 

AntiRS1 := proc(P1,Q1) local i,ind,P2,Q2,a, bumper,bumpee,bumperInd,bumpeeInd,activeRow:
## coordinates of biggest number in Q1, i.e., the last number to be placed 
a := [max[index](Q1)]:

if a[1] = 1 then    # element in first row, so no one was bumped 
    i := P1[op(a)]: 
    P2 := [ P1[a[1]][1..-2], op(P1[a[1]+1..-1]) ]: 
    Q2 := [ Q1[a[1]][1..-2], op(Q1[a[1]+1..-1]) ]:
    RETURN(P2,Q2,i):

else                # someone was bumped from an above entry 
    # look for the entry in the above row that is smaller than biggest entry. that entry was the bumper 
    # repeat until we land in the top row, as multiple entries may have been succesively bumped 

    activeRow := a[1]:

    # initialize
    bumpee := P1[op(a)]:
    bumpeeInd := a[2]:

    P2 := P1:

    while activeRow<>1 do 
        bumperInd := findBumper(P1[activeRow-1], bumpee):  # index of bumper in row above

        bumper := P1[activeRow-1,bumperInd]:

        if activeRow = a[1] then    # last row, delete bumpee
            P2 := [op(P2[1..activeRow-2]), 
              [op(P2[activeRow-1][1..bumperInd-1]), bumpee, op(P2[activeRow-1][bumperInd+1..-1])],         
              [op(P2[activeRow][1..bumpeeInd-1]),op(P2[activeRow][bumpeeInd+1..-1])],  
              op(P2[activeRow+1..-1])]:
        else                        # not last row, keep lower entries 
            P2 := [op(P2[1..activeRow-2]), 
              [op(P2[activeRow-1][1..bumperInd-1]), bumpee, op(P2[activeRow-1][bumperInd+1..-1])],    
              op(P2[activeRow..-1])]:
        fi:

        # update everyone 
        activeRow --: 
        bumpee := bumper:
        bumpeeInd := bumperInd:
    od:

    i := P1[activeRow,bumperInd]:  # bumper (number)

    Q2 := [ op(Q1[1..a[1]-1]), 
            Q1[a[1]][1..a[2]-1], 
            op(Q1[a[1]+1..-1]) ]:

    RETURN(P2,Q2,i):
fi:

end:



# find (index of) the bumper, i.e. the maximum entry which is smaller than the bumpee 

findBumper := proc(row,bumpee) local mindiff,newdiff,bumper,j:
mindiff := infinity:    # initialize large 

for j from 1 to nops(row) do 
    newdiff := bumpee - row[j]:  # expect element replacing the bumpee to be smaller, so want to be positive

    if newdiff > 0 and newdiff < mindiff then 
        mindiff := newdiff:     # rewrite minimum 
        bumper := j:
    fi:
od:

bumper:
end:



# Check that
# {seq(evalb(AntiRS(RS(pi))=pi), pi in permute(n))}={true} for n from 2 to 7. 

# for n from 1 to 7 do 
#   print(evalb({seq(evalb(AntiRS(RS(pi))=pi), pi in permute(n))}={true}));
# od:

# Also check that
# {seq(evalb(RS(AntiRS(s))=s), s in SYTpairs(n))}={true}

# all good!! 






## Problem 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?

## inverse permutation constructor 

inv:=proc(pi) local n,T,i:
n:=nops(pi):
for i from 1 to n do
 T[pi[i]]:=i:
od:
[seq(T[i],i=1..n)]:
end:

# for n from 1 to 7 do 
#     S := {}:
#     for pi in permute(n) do 
#         L := RS(pi):
#         M := RS(inv(pi)):
#         S := S union {evalb( L = [M[2],M[1]] )}:
#     od:
#     print(n, S);
# od:

## output:
# 1, {true}
# 2, {true}
# 3, {true}
# 4, {true}
# 5, {true}
# 6, {true}
# 7, {true}






### copied from C16.txt 
#C16.txt, March 23, 2026
Help16:=proc(): print(`RSleft(pi), RS1(Y,i), RS(pi) `): end:

#RS1(Y,i): inputs a partial Young tableau and another integer i NOT yet in Y
#places it in the right place, by a bumping process it returns a tableau
#with one more box followed by the name of the row where it settled
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:


with(combinat):

#RS(pi): inputs a permutation pi of ({1, ..., n:=nops(pi)) and outputs a pair of SYT of the SAME shape (with n boxes)
#The Robinson-Schenstead algorithm
RS:=proc(pi) local Yl, i, Yr,eaea, p:
if pi=[] then
 RETURN([[],[]]):
fi:
Yl:=[[pi[1]]]:
Yr:=[[1]]:
for i from 2 to nops(pi) do
eaea:=RS1(Yl,pi[i]):
Yl:=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:

[Yl, Yr]:
end:






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

#old stuff
#C14.txt; March 9, 2026

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

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

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:

SYTpairs:=proc(n) local S,P, p,S1,s1,s2:
option remember:
P:=Par(n):
S:={}:
for p in P do
S1:=SYT(p):
S:= S union {seq(seq([s1,s2], s1 in S1), s2 in S1)}:
od:
S:
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:
#Look for all legal rows where Mr. or Ms. n can place themselves
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:



#old stuff
#C13.txt
Help13:=proc(): print(` PFG(L), SYT(L), PSYT(n) `): end:
Help12:=proc():
 print(`Park(n,k), Par(n), ParN(n,k)`):
end:
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:
#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:

#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:
print(`----------------`):
end:




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:

#Def. Standard Young tableau of shape L L=[3,3,2] a partition of 8
#
#111111
#111111
#11
#
#A way of filling {1, ..., 8} the empty boxes such that every row and every column are increasing
#
#L=[2,2]
#
#12
#34
#
#13
#24    Number of of YT of shape [2,2]
#
#Where can n (the tallest person) seat w/o disturbing shorter people
#

#SYT(L): The SET of Standard Young tableaux of shape L
SYT:=proc(L) local i, k,n,S,L1,S1,s1:
option remember:
k:=nops(L):
n:=add(L[i],i=1..k):
if k=0 then
  RETURN({[]}):
fi:
S:={}:
#Look for all legal rows where Mr. or Ms. n can place themselves
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: