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

Help:=proc(): print(`OneTrial(L), RandSYT(L)`):   end:

### Problem 1 

RandSYT := proc(L) local k,n,x,c,i,j,L1,S:
k := nops(L):
n := add(x,x in L): 
S := [seq([0$L[i]], i=1..nops(L))]:
L1 := L:

while n > 0 do 
    c := OneTrial(L1):  # picks a random corner of tableau shape L 
    i := c[1]:
    j := c[2]:

    # add entry n to tableau S in position c 
    S := [ op(S[1..i-1]), [ op(S[i][1..j-1]), n, op(S[i][j+1..nops(S[i])]) ] , op(S[i+1..k]) ]:  

    # redefine for next iteration of loop 
    L1 := [op(L1[1..i-1]), L1[i]-1, op(L1[i+1..-1])]:  # shape obtained by removing corner
    n := n-1:
od:

S:
end:


# inputs a partition L and picks a random corner-cell, following the "kick the buck" algorithm of the paper

OneTrial := proc(L) local c,C,H: 
C := Cells(L): 
c := C[rand(1..nops(C))()]: 
H := Hook(L,c):

while H<>{c} do 
    H := H minus {c}: 
    c := H[rand(1..nops(H))()]:
    H := Hook(L,c):
od:

c:
end:



### Problem 2 
# By running RandSYT([5$5]) 10000 times, estmate the probabilty that "2" is in location [1,2] (rather than [2,1]).

# counts := [0,0]:

# for i from 1 to 10000 do 
#     S := RandSYT([5$5]): 

#     if S[1][2] = 2 then 
#         counts := [counts[1]++, counts[2]]:
#     else 
#         counts := [counts[1], counts[2]++]:
#     fi:
# od:

# output: counts := [4960, 5040]




### copied from C17.txt 

#C17.txt, March 26, 2006
Help17:=proc():  print(`Cells(L), Conj(L), NuSYT(L)`): end:

#Cells(L): the set of n (=sum(L)) cells [i,j]in the shape L
Cells:=proc(L) local k,i,j:
k:=nops(L):
{seq(seq([i,j]   , j=1..L[i]  ), i=1..k)}
end:

Conj:=proc(L) local k,C1,i1,L1,i:
option remember:
if L=[] then
RETURN([]):
fi:
k:=nops(L):
L1:=[seq(L[i]-1,i=1..k)]:

for i1 from 1 to nops(L1) while L1[i1]>0 do od:
i1:=i1-1:

L1:=[op(1..i1,L1)]:

C1:=Conj(L1):
[k,op(C1)]:
end:

#Hook(L,c): The set of the cells in the hoo corresponding to the cell c=[i,j]
#(i.e. the set of cells to the right and to the bottom of c
Hook:=proc(L,c) local k,i,j,C,i1,j1,i2:
k:=nops(L):
i:=c[1]:
j:=c[2]:
if not (i>=1 and i<=k) then
  RETURN(FAIL):
fi:

if not(j>=1 and j<=L[i]) then
  RETURN(FAIL):
fi:

C:={seq([i,j1],j1=j..L[i])}:

for i2 from i to k while j<=L[i2] do od:
i2:=i2-1:
C:=C union {seq([i1,j],i1=i..i2)}:
end:

#HL(L,c): the hook-length of cell c in the shape L
HL:=proc(L,c): nops(Hook(L,c)):end:

HLc:=proc(L,c) local i,j,L1:
L1:=Conj(L):
i:=c[1]:
j:=c[2]:
L[i]-j+L1[j]-i+1:

end:

#NuSYTc(L): implementing the Frame-Robinson-Thrall Hook Length Formula
NuSYTc:=proc(L) local n,C,i,c:
n:=add(L[i],i=1..nops(L)):
C:=Cells(L):
n!/mul(HL(L,c),c in C):
end:


#NuSYTcc(L): implementing the Frame-Robinson-Thrall Hook Length Formula Cleverly
NuSYTcc:=proc(L) local n,C,i,c:
n:=add(L[i],i=1..nops(L)):
C:=Cells(L):
n!/mul(HLc(L,c),c in C):
end:









#old stuff

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