#Final Project for Roman Holowinsky(04/28/03)
#A Bijective proof of the hook formula
#-----------------------------------------------------
#Definitions/Abbreviations:
#
#flam=number of Standard Young Tableau of shape lambda
#hook=Hij={(k,l) | k=i and l>=j or k>=i and l=j}=(i,j)
#hook-length of (i,j)=hij=|Hij|
#P={(T,S) | T is an SYT of shape lambda, S is a PT of shape lambda}
#Pseudo Tableau = YT whose rows are increasing
#PT=Pointer Tableau=Any of the Prod(hij) possible "sub-tableau" of SYT
#PYT=Pointed Young Tableau(an element of P) 
#SYT=Standard Young Tableau
#NOTE: An empty Tableau will be represented by []
#----------------------------------------------------------------
#Theorem to Prove:
#
#(Frame-Robinson-Thrall)
#If Lambda is a partition of n then
#flam=n!/(Prod(hij))
#---------------------------------------------------------------
#Goal:
#
#We know that |P|=flam*Prod(hij) by definition of P.
#We want to show |P|=n! in order to prove the above theorem.
#This program focuses on two main methods: FINDR and RSORT
#FINDR takes a PYT in P and returns a Young Tableau R.
#RSORT takes an R and returns a PYT in P. 
#If these maps are inverses we have the desired bijection and
#in fact show that |P|=# of Young Tableaux of shape lambda=n!
#---------------------------------------------------------------
#Representing PT:
#
#For the (i,j)th entry in a PT,S
#Sij=Cx with x>=1 then Sij points to cell (i,j+x-1)
#Sij=Ry with y>=2 then Sij points to cell (i+y-1,j)
#---------------------------------------------------------------
print(` Welcome to FRANZEIL, a Maple package written by Roman Holowinsky.`):
print(` Type Help(); for more details`):
#--------------------- Help ------------------------------------
Help:=proc():

print(`Version of April 28, 2003`):

if nargs=0 then

print(` Welcome to FRANZEIL, a Maple package written by Roman Holowinsky.`):
print(` FRANZEIL contains the Franzblau-Zeilberger algorithms for the`):
print(` bijective proof of the hook-length formula`):
print(` printed in JOURNAL OF ALGORITHMS V3, 317-343(1982)`):
print(`Please send all bugs to romanh@math.rutgers.edu`):
print(``):

print(`Contains the following procedures:`):
print(`BadElem,BuildS,Chop,DC,EXCHANGE2,FINDR,IC,INSERT1`):
print(`REMOVE1,RSORT,SatisfyDC,SIMPLIFY1,Transpose`):
print(`For help with any of these type Help(procedure name);`):
print(``):

print(`Note: A tableau must be entered as a list of lists.`):
print(` T:=[]: is an empty tableau.`):
print(`Check the package file itself for some definitions`):
print(`and a package summary if so desired.`):

elif nargs=1 then

    if args[1]=BadElem then
     print(`BadElem(T) Called from IC`):
     print(`Returns the smallest "bad" element and its row/column location.`):
     print(`For example, BadElem([[1,8,12],[4,5],[3,7],[6]]);`):
     print(`returns [3,3,1]`):
    elif args[1]=BuildS then
     print(`BuildS(column d,S) Called by IC`):
     print(`Returns a new S with column d adjoined to the left of previous S`):
     print(`For example, BuildS([["C1"],["C2"],["R2"]],[["C1","C3"],["C1"]]);`):
     print(`returns [["C1", "C1", "C3"], ["C2", "C1"], ["R2"]]`):
    elif args[1]=Chop then
     print(`Chop(lam), Try Chop([5,3,2,1,0]);`):
    elif args[1]=DC then
     print(`DC(PYT(T,S) with m rows)`): 
     print(`Returns a column vector a such that ai is in T for all i and returns`):
     print(`a smaller PYT with the vector a removed and the left most columns deleted`):
     print(`For example, try DC([[1,4,8],[3,7],[5,12],[6]],[["R3", "C2", "C1"], ["C1", "C1"], ["C2", "C1"], ["C1"]]);`):  
    elif args[1]=EXCHANGE2 then
     print(`EXCHANGE2(i1 row, j1 column, i2 row, j2 column, T)`):
     print(`Swaps element(i1,j1) in T with element(i2,j2) in T`):
     print(`and sorts into Pseudo Tableau`):
     print(`Returns new T and new column position of element 1 and element 2`):
     print(`For example, EXCHANGE2(1,1,2,2,[[1,2],[3,4]]);`):
     print(`returns [[2, 4], [1, 3]], 1, 2`):
    elif args[1]=FINDR then
     print(`FINDR(T,S) T,S of shape lambda. Returns YT of shape lambda.`):
     print(`For example, try FINDR([[1,3,4,8],[2,7,9],[5,10,12],[6,11]],[["C1","R3","C2","C1"],["C3","C1","C1"],["R2","C2","C1"],["C2","C1"]]);`):
    elif args[1]=IC then
     print(`IC(column vector a of size m>=l,PYT(T,S) with l rows)`):
     print(`Returns (T, Kth column of S) with all ai now in T.`):
     print(`For example, try IC([12,5,3,6],[[1,8],[4],[7]],[["C2","C1"],["C1"],["C1"]]);`):
    elif args[1]=INSERT1 then
     print(`INSERT1(a[j]th entry of a, j row, T SYT)`):
     print(`Returns new T with a[j] inserted in row j and gives it's column position`):
     print(`For example, try INSERT1(3,1,[[1,2,4],[5,6]]);`):
    elif args[1]=REMOVE1 then
     print(`REMOVE1(i row, j column, T)`): 
     print(`Removes an element from T in row i/column j`):
    elif args[1]=RSORT then
     print(`RSORT(YT on [n] with shape lambda) returns PYT(T,S) of shape lambda`):
     print(`For example, try RSORT([[9,12,8,1],[2,5,4],[11,3,7],[10,6]]);`):
    elif args[1]=SatisfyDC then
     print(`SatisfyDC(T,d) Called from DC`):
     print(`Returns list of elements that satisfy the required conditions`):
    elif args[1]=SIMPLIFY1 then
     print(`SIMPLIFY1(T) Returns T with any rows equal to [] removed`):
     print(`For example SIMPLIFY1([[1,2],[],[3]]); returns [[1,2],[3]]`):
    elif args[1]=Transpose then
     print(`Transpose(YT) forms the transpose of YT`):
     print(`Used for switching from row vectors to column vectors`):
     print(`For example, Transpose([[1,2],[3]]); returns [[1,3],[2]]`):
    fi:

fi:

end: #Help

#--------------------- Chop -----------------------
Chop:=proc(lam) local i:

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

[op(1..i,lam)]:


end:  #Chop

#--------------------- BadElem -----------------------
#BadElem(T) Called from IC
#Returns the smallest "bad" element and its location.
BadElem:=proc(T)
local bad,i,j,trans:
trans:=Transpose(T):
bad:=[0,0,0]:

if T=[] then 
  RETURN("ERROR: There is no Tableau!"):
fi:

for j from 1 to nops(T[1]) do
  for i from 1 to nops(trans[j])-1 do
    if T[i+1][j]<T[i][j] and (T[i+1][j]<bad[1] or bad[1]=0) then 
      bad:=[T[i+1][j],i+1,j]: 
    fi:
   od:
od:
RETURN(bad):
end: #BadElem

#--------------------- SatisfyDC --------------------
#SatisfyDC(T,d) called from DC
#Returns list of elements that satisfy the conditions
#for entering the first while loop in DC
SatisfyDC:=proc(T,d)
local satisfy,j,check,temp1,temp2,yj,v,t:

satisfy:={}:
check:=0:

for j from 2 to nops(d) do
   temp1:=d[j]:
   temp1:=convert(temp1,list):
   yj:=convert(temp1[2],decimal,10):
   temp2:=d[j-1]:
   temp2:=convert(temp2,list):
   v:=convert(temp2[2],decimal,10):

   for t from v+1 to yj while check=0 do
    if yj<=nops(T[j-1]) then   #can happen that yj is 2 and T is one column 
      if T[j][t-1]<T[j-1][t] then
        check:=1:
      else
        check:=0:
      fi:
    fi:
   od:

   if temp1[1]="C" then 
     if temp2[1]="R" or (v<yj and check=1) then
       satisfy:=satisfy union {[T[j][yj],j,yj]}:
     fi:
   fi: 
od:

satisfy:=[seq(satisfy[j],j=1..nops(satisfy))]:
RETURN(satisfy):

end: #SatisfyDC

#--------------------- BuildS -----------------------
#BuildS(column d,S) Called by IC
#Returns a new S with column d adjoined to the left of previous S
BuildS:=proc(d,S)
local Snew,i,j:

if nops(d)<nops(S) then        #this will never occur in flow of RSORT
  RETURN("d is to small to adjoin to S"): 
fi:

Snew:=[seq([],i=1..nops(d))]:

for i from 1 to nops(d) do
   if i<=nops(S) then 
     Snew[i]:=[d[i][1],seq(S[i][j],j=1..nops(S[i]))]:
   else
     Snew[i]:=d[i]:
   fi:
od:
RETURN(Snew):
end: #BuildS

#--------------------- Transpose -----------------------
#Transpose(YT) forms the transpose of YT
#Used for switching from row vectors to column vectors
Transpose:=proc(YT)
local M,trans,k:

if YT=[] then
  RETURN([]):
fi:

with(linalg,transpose):
M:=transpose(Matrix(nops(YT),nops(YT[1]),YT)):
M:=convert(M,listlist):
trans:=[seq(Chop(M[k]),k=1..nops(YT[1]))]:
RETURN(trans):

end: #Transpose

#--------------------- RSORT -----------------------
#RSORT(YT on [n] with shape lambda) returns PYT(T,S) of shape lambda
RSORT:=proc(YT)
local T,S,PYT,K,a,trans,i,temp:
T:=[]:
S:=[]:
trans:=Transpose(YT):
for K from nops(YT[1]) by -1 while K<>0 do 
  a:=trans[K]:
  temp:=IC(a,T,S): 
  T:=temp[1]:
  S:=temp[2]:
od:
PYT:=[T,S]:
end: #RSORT

#--------------------- FINDR -----------------------
#FINDR(T,S) T,S of shape lambda. Returns YT of shape lambda.
FINDR:=proc(T,S)
local Tnew,Snew,K,YT,trans,temp,i:
Tnew:=T:
Snew:=S:
trans:=[seq([],i=1..nops(T[1]))]: 
for K from 1 by 1 while K<=nops(T[1]) do
  temp:=DC(Tnew,Snew): #to get column vector a and new PYT
  trans[K]:=temp[1]: #Set Kth row of trans to be a
  Tnew:=temp[2]:
  Snew:=temp[3]:
od:
YT:=Transpose(trans):
end: #FINDR  

#--------------------- INSERT1 -----------------------
#INSERT1(a[j]th entry of a, j row, T SYT)
#Returns new T with a[j] inserted in row j and gives it's column position
INSERT1:=proc(aj,j,T)
local newj,i,row,k,Tnew:

if j=nops(T)+1 then 
  newj:=[aj]:
  i:=1:
elif j=0 or j>nops(T)+1 then 
  RETURN("ERROR: row index not expected in INSERT1"):
else 
  row:=T[j]:
  for i from 1 by 1 while i<=nops(row) and aj>row[i] do
     #Finding proper spot for insertion of aj
  od:
  newj:=[seq(row[k],k=1..i-1),aj,seq(row[k],k=i..nops(row))]:
fi:
Tnew:=[seq(T[k],k=1..j-1),newj,seq(T[k],k=j+1..nops(T))]:
RETURN (Tnew,i):
end: #INSERT1

#--------------------- REMOVE1 -----------------------
#REMOVE1(i row, j column, T) 
#Removes an element from T in row i
REMOVE1:=proc(i,j,T)
local newi,row,Tnew:

if i=0 or i>nops(T) then
  RETURN("ERROR: row index not expected in REMOVE1"):
fi:

if j=0 or j>nops(T[i]) then
  RETURN("ERROR: column index not expected in REMOVE1"):
fi:

row:=T[i]:

newi:=[seq(row[k],k=1..j-1),seq(row[k],k=j+1..nops(row))]:
Tnew:=[seq(T[k],k=1..i-1),newi,seq(T[k],k=i+1..nops(T))]:

RETURN(Tnew):

end: #REMOVE1

#--------------------- SIMPLIFY1 -----------------------
#SIMPLIFY1(T)
#Returns T with any rows equal to [] removed
SIMPLIFY1:=proc(T)
local i,j,Tnew:

Tnew:=[]:

if T=[] then 
  RETURN(T):
fi:

for i from 1 to nops(T) do
   if T[i]<>[] then
     if Tnew=[] then
       Tnew:=[T[i]]:
     else
       Tnew:=[seq(Tnew[j],j=1..nops(Tnew)),T[i]]:
     fi:
   fi:
od:

RETURN(Tnew):

end: #SIMPLIFY1

#--------------------- EXCHANGE2 -----------------------
#EXCHANGE2(i1 row, j1 column, i2 row, j2 column, T)
#Swaps element(i1,j1) in T with element(i2,j2) in T
#Returns T and new column position of element 1 and element 2
EXCHANGE2:=proc(i1,j1,i2,j2,T)
local Tnew,j1new,j2new,temp:

if i1>nops(T) or i1=0 then
  RETURN("ERROR: row i1 does not exist in T"):
fi:
if i2>nops(T) or i2=0 then
  RETURN("ERROR: row i2 does not exist in T"):
fi:

Tnew:=REMOVE1(i1,j1,T):
Tnew:=REMOVE1(i2,j2,Tnew):
temp:=INSERT1(T[i2][j2],i1,Tnew):
Tnew:=temp[1]:
j2new:=temp[2]:
temp:=INSERT1(T[i1][j1],i2,Tnew):
Tnew:=temp[1]:
j1new:=temp[2]:

RETURN(Tnew,j1new,j2new):
end: #EXCHANGE2

#--------------------- IC(Insert Column) -----------------------
#IC(PYT(T,S) with l rows, column vector a of size m>=l, ai not in T)
#Returns (T, Kth column of S) with all ai now in T.
IC:=proc(a,T,S)
local i,j,k,Tnew,Snew,temp,d,bad,x,y,yprime,up:
Tnew:=T:
d:=array(1..nops(a)):

for j from 1 to nops(a) do
   temp:=INSERT1(a[j],j,Tnew):
   Tnew:=temp[1]:
   d[j]:=temp[2]: #dj is the new position of a[j]
   d[j]:=cat("C",convert(d[j],string)):
od:

bad:=BadElem(Tnew):

while bad<>[0,0,0] do
   k:=bad[2]:
   x:=bad[3]:
   y:=d[k-1]:
   y:=convert(y,list):
   y:=y[2]:
   y:=convert(y,decimal,10):
   
   temp:=EXCHANGE2(k,x,k-1,y,Tnew):
      Tnew:=temp[1]:
      yprime:=temp[3]:

   ##Update Pointers##
   up:=d[k]:
   up:=convert(up,list):
   if up[1]="R" then 
     d[k-1]:=cat("R",convert(convert(up[2],decimal,10)+1,string)): 
   elif up[1]="C" and convert(up[2],decimal,10)=x then
     d[k-1]:="R2":
   else 
     d[k-1]:=d[k]: 
   fi:
   d[k]:=cat("C",convert(yprime,string)):
   ###################

   bad:=BadElem(Tnew):
od:
#Tnew is now SYT
Snew:=BuildS([seq([d[i]],i=1..nops(a))],S):
RETURN(Tnew,Snew):
end: #IC

#--------------------- DC(Delete Column) -----------------------
#DC(PYT(T,S) with m rows) 
#Returns a column vector a such that ai is in T for all i and returns
#a smaller PYT the vector a removed and the left most columns deleted
DC:=proc(T,S)
local a,ajyj,Tnew,Snew,d,i,j,k,r,s,sj,y,yj,yprime,t,max,satisfy,temp,up:

d:=array(1..nops(T)):
r:=0:
Tnew:=T:
Snew:=S:
max:=0:

for j from 1 to nops(T) do
   d[j]:=S[j][1]:  
od: #d=leftmost column of S

satisfy:=SatisfyDC(Tnew,[seq(d[j],j=1..nops(Tnew))]):

while satisfy<>[] do

   ###sj set up for each j in satisfy###### 
   for i from 1 to nops(satisfy) do
      ajyj:=satisfy[i][1]:
      j:=satisfy[i][2]:
      yj:=satisfy[i][3]:

      for t from 2 to yj do
        if Tnew[j][t-1]<Tnew[j-1][t] then
          r:=t: 
        fi:
      od:

      if r=0 or d[j]="C1" then  
        sj:=1:
      else
        sj:=r:
      fi:

      if max<Tnew[j-1][sj] then 
        max:=Tnew[j-1][sj]:
        k:=j:
        y:=yj:
        s:=sj:
      fi:
   od:     
   ###end sj set up#############
   
   temp:=EXCHANGE2(k-1,s,k,y,Tnew):
   Tnew:=temp[1]:
   yprime:=temp[3]:

   ##Update Pointers##
   up:=d[k-1]:
   up:=convert(up,list):
   if d[k-1]="R2" then 
     d[k]:=cat("C",convert(s,string)): 
   elif up[1]="C" then
     d[k]:=d[k-1]:
   else 
     d[k]:=cat("R",convert(convert(up[2],decimal,10)-1,string)): 
   fi:
   d[k-1]:=cat("C",convert(yprime,string)):
   ###################

   r:=0:
   max:=0:
   satisfy:=SatisfyDC(Tnew,[seq(d[j],j=1..nops(Tnew))]):
od:
#T is now a Pseudo Tableau and dj=Cyj for all j
#If we remove ajyj from T for all j then we will have an SYT
a:=[seq(Tnew[j][convert(convert(d[j],list)[2],decimal,10)],j=1..nops(Tnew))]:  
for j from 1 to nops(Tnew) do
   Tnew:=REMOVE1(j,convert(convert(d[j],list)[2],decimal,10),Tnew):
   Snew:=REMOVE1(j,1,Snew): 
od:
Tnew:=SIMPLIFY1(Tnew):
Snew:=SIMPLIFY1(Snew):

RETURN(a,Tnew,Snew):
end: #DC

#END#END#END#END#END#END#END#END#END#END#END#END#END#END#END#END#