#Version of May 7, 2003 (thanks fto Vince vatterfor correcting the GNW)
#----------------------- Help -----------------------


Help:=proc():

print(` Version of May 7,  2003 `):

if nargs=0 then

print(` Welcome to RSK, a Maple package written`):
print(`by the brilliant students of Math 583, Spring 2003`):
print(`Please send all bugs to mohamudm@math.rutgers.edu`):
print(`It implements the Robinson-Schenstead-Knuth and other algotirhms`):
print(``):

print(`Contains the following procedures:`):
print(` Bump, CheckRS, Fnk, GNW, GridWpL, GuessPoly, Ins1, NiceT, NuSYT, `):
 print(` Partition, RRS, RS, RSV, ShadowLines, ShadowLinesA, SYT, SYTpairs  `):

elif nargs=1 then


  if args[1]=Bump then
   print(`Bump(Row1,r): Inputs a row, Row1 of increasing integers`):
   print(`and outputs either a larger row, followed by 0 or`):
  print(`the modified row, followed by the bump element`):
  print(`For example, Bump([2,5,7],8); should be [2,5,7,8],0 `):
  print(`and Bump([2,5,7],4) should be: [2,4,7], 5 `):

elif args[1]=checkRS then
 print(`CheckRS(n): Checks whether the image of RS applied to all `):
 print(`permutations of length n is the set of pairs of Standard Young`):
 print(`Tableaux of the same shape with n cells. Try: CheckRS(5); `):

elif args[1]=Fnk then
 print(`Fnk(n,k): Sum of f_lam^k over all paritions lam of n `):

elif args[1]=GNW then
 print(`Corrected by Vince Vatter `):
 print(`GNW(Lam): Random Standard Young tableau of shape Lam`):
 print(` By the Greene-Nujenhuis-Wilf algorithm `):
 print(`For example, try: GNW([4,2,1]); `):

elif args[1]=GridWpL then

print(`GridWpL(n,ListP,ListPairs): Inputs an integer n, a list of`):
print(`lattice-points ListP, and a list of pairs ListPairs, and`):
print(`outputs a diagram with the grid of length n+1 with the`):
print(`points marked and the segments of ListPairs thickened`):



elif args[1]=GuessPoly then
print(`GuessPoly(S,st,x): guesses a polynomial of degree nops(S)-3`):
print(`P(i)=S[i-st+1]`):

elif args[1]=Ins1 then
 print(`Ins1(Tab1,r): inserts an integer r into a tableau Tab1`):

elif args[1]=NiceT then
 print(`NiceT(YT): prints YT nicely`):

elif args[1]=NuSYT then
  print(`NuSYT(Lam): The number of Standard Young Tableaux of shape Lam`):
  print(` For example try: SYT([2,1]) `);

elif args[1]=Partition then
 print(`Partition(n): The partitions of n, in weakly decreasing order`):

elif args[1]=RS then
  print(`RS(pi): The Robinson-Schenstead algorithm applied to a permutation`):
  print(` pi, for example, try: RS([4,1,2,3]`);

elif args[1]=RSV then
  print(`RSV(pi): The Viennot version of the `):
 print(`Robinson-Schenstead algorithm applied to a permutation`):
  print(` pi, for example, try: RS([4,1,2,3]`);

elif args[1]=ShadowLines then
  print(`ShadowLines(pi): The Shadow Lines of a permutation pi`):

elif args[1]=ShadowLinesA then
  print(`ShadowLinesA(pi): The Shadow Lines of a permutation pi`):
  print(`In pair-notation`):
  print(`For example, try: ShadowLinesA([[1,4],[2,3],[3,2],[4,1]]);`):

elif args[1]=SYT then
  print(`SYT(Lam): The set of Standard Young Tableaux of shape Lam`):
  print(` For example try: SYT([2,1]) `);

elif args[1]=SYTpairs then
print(`SYTpairs(n): pairs of Standard Young Tableaux of the same shape`):
print(` with n cells `):

elif args[1]=RRS then
  print(`Written by: David Biddulph biddulph@eden.rutgers.edu `):
 print(``):
  print(`RRS([P,Q]): Inputs a Standard Young Tableau Pair, of the same shape`):
  print(`and outputs a permutation`):
  print(`For example, RRS([[[1,4],[2],[3],[5]], [[1,4],[2],[3],[5]]]); `):
  print(`should be [5,3,2,4,1]`):

elif args[1]=FindN then
  print(`Written by: David Biddulph biddulph@eden.rutgers.edu `):
  print(``):
  print(`FindN(P): Inputs a Tableau and outputs the location of`):
  print(` the largest element and the element itself`):
  print(`For example, FindN([[1,4],[2],[3],[5]]); `):
  print(`returns [4,1,5]`):

elif args[1]=DelNfromQ then
  print(`Written by: David Biddulph biddulph@eden.rutgers.edu `):
  print(``):

  print(`DelNfromQ: Inputs a Tableau, a row and a column`):
  print(`and outputs a Tableau with that position deleted`):
  print(`For example, DelNfromQ([[1,4],[2],[3],[5]],[4,1]); `):
  print(`returns [[1,4],[2],[3]]`):

elif args[1]=RSK then
  print(`Written by: David Biddulph biddulph@eden.rutgers.edu `):
  print(``):

  print(`RSK(pi): The Robinson-Schenstead-Knuth algorithm applied`):
  print(`to a permutation pi.`):
  print(`This is RS modified to accept duplicate elements`):
  print(`For example, try: RSK([2,1,3,3]);`):


else
  print(`There is no  Help for`, args[1]):
  fi:


fi:
end:



Append1:=proc(a,r): [op(a),r]:end:



Bump:=proc(Row1,r)
local i:

for i from 1 to nops(Row1) while Row1[i]<r do od:

if i=nops(Row1)+1 then
[op(Row1),r],0:
 else
[op(1..i-1,Row1),r,op(i+1..nops(Row1),Row1)],Row1[i]:
fi:

end:


Ins1:=proc(Tab1,r)
local i,Tab2,Row1,r1,temp:

Tab2:=Tab1:
r1:=r:

for i from 1 to nops(Tab1) do
 Row1:=Tab1[i]:
 temp:=Bump(Row1,r1):
 
if temp[2]=0 then
  RETURN([op(1..i-1,Tab2),temp[1],op(i+1..nops(Tab2),Tab2)],i):
 else
 Tab2:=[op(1..i-1,Tab2),temp[1],op(i+1..nops(Tab2),Tab2)]:
 r1:=temp[2]:

fi:

od:

[op(Tab2),[r1]],nops(Tab1)+1:



end:


RS:=proc(pi)
local Tab1,Tab2,i,temp,david:

Tab1:=[]: Tab2:=[]:


for i from 1 to nops(pi) do

temp:=Ins1(Tab1,pi[i]):

Tab1:=temp[1]:
david:=temp[2]:

if david<=nops(Tab2) then
Tab2:=[op(1..david-1,Tab2), [op(Tab2[david]), i], 
op(david+1..nops(Tab2),Tab2)]:

else

Tab2:=[op(Tab2), [i]]:

fi:

od:

[Tab1,Tab2]:
end:


NiceTOld:=proc(YT)

local i:

for i from 1 to nops(YT) do
lprint(op(YT[i])):
od:

end:


Chop:=proc(Lam)
local i:

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

[op(1..i-1,Lam)]:
end:


Children:=proc(Lam)
local i, temp,Lam1,k:

if Lam=[] then
RETURN({}):
fi:

temp:={}:

for i from 1 to nops(Lam)-1 do
 if Lam[i]>Lam[i+1] then
   Lam1:=[op(1..i-1,Lam),Lam[i]-1,op(i+1..nops(Lam),Lam)]:
    temp:=temp union {[Lam1,i]}:
 fi:
od:


k:=nops(Lam):

if Lam[k]>1 then
 Lam1:=[op(1..k-1,Lam),Lam[k]-1]:
    temp:=temp union {[Lam1,k]}:
 else

 Lam1:=[op(1..k-1,Lam)]:
    temp:=temp union {[Lam1,k]}:
fi:

temp:

end:



Ap:=proc(Y,i,n) :
if i<=nops(Y) then
[op(1..i-1,Y),[op(Y[i]),n],op(i+1..nops(Y),Y)]:
else
[op(Y),[n]]:
fi:
end:


SYT:=proc(Lam)
local ch,i,n,j,temp,temp1:
option remember:

n:=convert(Lam,`+`):

if Lam=[] then
 RETURN({[]}):
fi:

temp:={}:
ch:=Children(Lam):

for i from 1 to nops(ch) do
temp1:=SYT(ch[i][1]):
temp:=temp union {seq(Ap(temp1[j],ch[i][2],n),j=1..nops(temp1))}:
od:
temp:
end:



RevMM:=proc(P) local i,N: N:=nops(P): [seq(P[N-i+1]   , i=1..N)]: end:
Partition:=proc(n)
local P,i,N:
with(combinat):
P:=partition(n):
N:=nops(P);
RevMM([seq(RevMM(P[i]),i=1..N)]):
end:



#SYTpairs(n): pairs of Standard Young Tableaux of the same shape
#with n cells
SYTpairs:=proc(n)
local i,j1,j2,par,temp,yt:

par:=Partition(n):

temp:={}:
for i from 1 to nops(par) do
yt:=SYT(par[i]):
temp:=
temp union {seq(seq([yt[j1],yt[j2]],j1=1..nops(yt)),j2=1..nops(yt))}:
od:
temp:

end:

CheckRS:=proc(n)
local pers,i:
with(combinat):
pers:=permute(n):
evalb({seq(RS(pers[i]),i=1..nops(pers))}=SYTpairs(n)):
end:


NuSYT:=proc(Lam)
local ch,i,temp,temp1:
option remember:

if Lam=[] then
 RETURN(1):
fi:

temp:=0:
ch:=Children(Lam):

for i from 1 to nops(ch) do
temp1:=NuSYT(ch[i][1]):
temp:=temp +temp1:
od:
temp:
end:

#Fnk(n,k): sum of f_lam^k over all paritions lam of n
#with n cells
Fnk:=proc(n,k)
local i,temp,par:

par:=Partition(n):
temp:=0:
for i from 1 to nops(par) do
 temp:=temp + NuSYT(par[i])^k:
od:
temp:

end:

#Written by Mohamud Mohammed
NiceT:= proc(lam)
local i,j:

for i from 1 to nops(lam) do
 for j to nops(lam[i])-1 do
  printf("%0.0002g",lam[i][j]):
 od:
 printf("%0.0002g\n",lam[i][j]):
od:
end:



#Written by Mohamud Mohammed
NiceTpairs:= proc(lam)
 local i,j,k,u,m,lam1,lam2:
for u from 1 to nops(lam) do

lam1:=lam[u][1]:
lam2:=lam[u][2]:

for i from 1 to nops(lam1) do

  for j from 1 to nops(lam1[i]) do
    printf("%0.0002g",lam1[i][j]):
  od:

if i>1 then

for m from 1 to nops(lam1[1])-nops(lam1[i]) do 
    printf("%0.0004s",`    `):
od:

fi:

printf("%s",`    `):

for k from 1 to nops(lam2[i])-1 do
   printf("%0.0002g",lam2[i][k]):
od:

printf("%0.0002g\n",lam2[i][k]):

od:

printf("%s\n %s\n %s\n",` `,` `,` `):
od:

end:



#GuessPoly(S,st,x): guesses a polynomial of degree nops(S)-3
#P(i)=S[i-st+1]:

GuessPoly:=proc(S,st,x)
local P, var, eq, a,i,deg:
deg:=nops(S)-3:

P:=  convert( [seq(a[i]*x^i,i=0..deg)], `+`):
var:= {seq(a[i],i=0..deg)}:

eq:={ seq( subs(x=st+i-1 , P)=S[i]      ,i=1..nops(S))}:

eq,var:

var:=solve(eq,var):

if var=NULL then
 FAIL:
else

factor(subs(var,P)):

fi:


end:




Grid1:=proc(n)
local i:
with(plots):

seq(implicitplot(x=i,x=0..n,y=0..n,axes=none), i=0..n),
seq(implicitplot(y=i,x=0..n,y=0..n,axes=none), i=0..n):

end:

GridWp:=proc(n,ListP)
local P:

P:=Grid1(n):

P:=P,plot(ListP,style=point,symbol=circle,symbolsize=20):
end:


XV:=proc(pi) 
local i,n:
n:=nops(pi):

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

end:



ThickLine:=proc(Pt1,Pt2):

if Pt1[1]=Pt2[1] or Pt1[2]=Pt2[2]  then
plot([Pt1,Pt2],thickness=3):
else
ERROR(`Have to be vertical or horiz,`):
fi:

end:


#GridWpL(n,ListP,ListPairs): Inputs an integer n, a list of
#lattice-points ListP, and a list of pairs ListPairs, and
#outputs a diagram with the grid of length n+1 with the
#points marked and the segments of ListPairs thickened

GridWpL:=proc(n,ListP,ListPairs)
local P,i:

P:=GridWp(n+1,ListP):

P:=P,seq( ThickLine(op(ListPairs[i]) ), i=1..nops(ListPairs)):

display(P):

end:

#DependsOn(Leaders,cand): does cand depend on any of the leaders?
DependsOn:=proc(Leaders,cand)
local i:

for i from 1 to nops(Leaders) do

if Leaders[i][1]<=cand[1] and Leaders[i][2]<=cand[2] then
RETURN(true):
fi:
od:
false:

end:


#Shadow1(ListPairs): Given a list of points extracts
#list (in that order) of the extreme points, followed by
#the rejects
Shadow1:=proc(ListPairs)
local Leaders, Followers, i,cand:

Leaders:=[ListPairs[1]]:
Followers:=[]:

for i from 2 to nops(ListPairs) do
cand:=ListPairs[i]:
 if DependsOn(Leaders,cand) then
     Followers:=[op(Followers),cand]:
  else
    Leaders:=[op(Leaders), cand]:
 fi:
od:
Leaders,Followers:
end:


ShadowLinesA:=proc(q)
local X,Rejects,tem  :

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

tem:=Shadow1(q):
Rejects:=tem[2]:

X:=[tem[1]]:

while Rejects<> [] do

tem:=Shadow1(Rejects):

Rejects:=tem[2]:

X:=[op(X), tem[1]]:

od:

X:

end:

RSV:=proc(per)
local q,i,gu,P,Q,mu:

q:=[ seq( [i, per[i]], i=1..nops(per)) ]:

gu:=ShadowLinesA(q):


mu:=PQfromSL(gu):
P:=[]: Q:=[]:

while gu<>[] do
P:=[op(P),mu[1]]:Q:=[op(Q),mu[2]]:

gu:=ShadowLinesA(Deriv(gu)):

mu:=PQfromSL(gu):

od:
[P,Q]:

end:



Deriv1:=proc(ShaL) local i:
[seq([ShaL[i+1][1],ShaL[i][2]],i=1..nops(ShaL)-1)]:
end:

Deriv:=proc(ShaLL) local i,gu,mu:
gu:=[]:

for i from 1 to nops(ShaLL) do
 mu:=Deriv1(ShaLL[i]):
      gu:=[op(gu),op(mu)]:
od:
Sort1(gu):
end:





Sort1:=proc(ListPairs)
local mu1,T,i:


for i from 1 to nops(ListPairs) do
 T[ListPairs[i][1]]:=ListPairs[i][2]:
od:

mu1:=sort([seq(ListPairs[i][1],i=1..nops(ListPairs))]):

[seq([mu1[i],T[mu1[i]]],i=1..nops(mu1))]:
end:


PQfromSL:=proc(SL) local i:
[seq(SL[i][nops(SL[i])][2],i=1..nops(SL))],
[seq(SL[i][1][1],i=1..nops(SL))]:
end:



Shape:=proc(T) local i: [seq(nops(T[i]),i=1..nops(T))]: end:


Peq:=proc(pi)
local P,Q, lam, SetQ, F:

P:=RS(pi)[1]:

lam:=Shape(P):

SetQ:=SYT(lam):

{ seq( RRS( [P, SetQ[i]] ),  i=1..nops(SetQ) ) }:


end:





Keq:=proc(pi)

end:


Keq2:=proc(pi)
local n,i,S:

n:=nops(pi):
S:={ }:

for i from 1 to n-2 do

   if pi[i]> min( pi[i+1], pi[i+2] ) and
     pi[i]< max( pi[i+1], pi[i+2] )  then
      S:={ op(S),  [ op(1..i, pi) , pi[i+2], pi[i+1], 
                           op(i+3..n,pi)]}:
    fi:
od:



for i from 3 to n do

   if pi[i]> min( pi[i-1], pi[i-2] ) and
     pi[i]< max( pi[i-1], pi[i-2] )  then
      S:={ op(S),  [ op(1..i-3, pi) , pi[i-1], pi[i-2], 
                           op(i..n,pi)]}:
    fi:
od:


S:


end:

Keq1:=proc(SetP) local i:

  { op(SetP), seq( op( Keq2(SetP[i]) ) ,i=1..nops(SetP) )}:

end:



Keq:=proc(pi)

local S1,S2:

S1:={ pi}:

S2:=Keq1(S1):

while S1<>S2 do

S1:=S2:

S2:=Keq1(S2):

od:

S2:


end:








#----------------------- CheckRRS -----------------------
# used by RRS to check the validity of the input Standard Young Tableau pair
# CheckRRS checks that P & Q are valid Standard Young Tableaus
# and that P & Q are the same shape


CheckRRS:=proc(P,Q)
local i,j,k,prev,row:

#check to see if P, the insertion Tableau, is a valid Young Tableau
k:=nops(P[1]):
for i from 1 to nops(P) do
  if nops(P[i])> k then
    ERROR(`P, the insertion Tableau has an invalid shape`):
  fi:
  k:=nops(P[i]):
  row:=P[i]:
  for j from 2 to nops(row) do
    if row[j]<row[j-1] then
      ERROR(`P, the insertion Tableau has invalid entries`):
    elif i>1 then
       prev:=(P[i-1]):
       if row[j]<=prev[j] then
         ERROR(`P, the insertion Tableau has invalid entries`):
       fi:
    fi:
  od:
od:
for i from 2 to nops(P) do
  prev:=P[i-1]:
  row:=P[i]:
  if row[1]<=prev[1] then
    ERROR(`P, the insertion Tableau has invalid entries`):
  fi:
 od:


#check to see if Q, the recording Tableau, is a valid Young Tableau
k:=nops(Q[1]):
for i from 1 to nops(Q) do
  if nops(Q[i])> k then
    ERROR(`Q, the recording Tableau has an invalid shape`):
  fi:
  k:=nops(Q[i]):
  row:=Q[i]:
  for j from 2 to nops(row) do
    if row[j]<=row[j-1] then
      ERROR(`Q, the recording Tableau has invalid entries`):
    elif i>1 then
      prev:=(Q[i-1]):
        if row[j]<=prev[j] then
          ERROR(`Q, the recording Tableau has invalid entries`):
        fi:
	 fi:
  od:
od:
for i from 2 to nops(Q) do
  prev:=Q[i-1]:
  row:=Q[i]:
  if row[1]<=prev[1] then
    ERROR(`Q, the recording Tableau has invalid entries`):
  fi:
od:

# now we check that P & Q are the same shape
if nops(P)=nops(Q) then
  for i from 1 to nops(P) do
    if nops(P[i])<>nops(Q[i]) then
      ERROR(`P and Q are not the same shape`):
    fi:
  od:
else
  ERROR(`P and Q are not the same shape`):
fi:

end:  #CheckRRS



#----------------------- FindN -----------------------
FindN:=proc(Q)
local i,n,Nindex,row:

n:=0:

for i from 1 to nops(Q) do
  row:=Q[i]:
  if row[nops(row)]>n then
    n:=row[nops(row)]:
    Nindex:=[i,nops(row),n]:
  fi:
od:

return(Nindex):
end:  #FindN


#----------------------- DelNfromQ -----------------------
DelNfromQ:=proc(Q,nindex)
local Nrow,Ncol, q:

q:=Q:

Nrow:=nindex[1]:  #row to delete n from
Ncol:=nindex[2]:  #position (column) of n in row Nrow

if nops(q[Nrow]) > 1 then
  q[Nrow]:=[op(1..Ncol-1,q[Nrow])]:
else
  if nops(q)>1 then
    q:=[op(1..Nrow-1,q)]:
  else
    q:=[]:
  fi:
fi:

return(q):

end:  #DelNfromQ



#----------------------- GetNext -----------------------
# used by RRS to find the element in P in the position
# returned by FindN operating on the index tableau, Q
# inputs the recording tableau and position
# outputs the recording tableau with the position deleted
# and the element that was in that position

GetNext:=proc(P,nindex)
local p,Prow,Pcol,row,el:

p:=P:
Prow:=nindex[1]:
Pcol:=nindex[2]:
row:=P[Prow]:
el:=row[Pcol]:

if nops(p[Prow]) > 1 then
  p[Prow]:=[op(1..Pcol-1,p[Prow])]:
else
  if nops(p)>1 then
    p:=[op(1..Prow-1,p)]:
  else
    p:=[]:
  fi:
fi:

return([p,el]):

end:  #GetNext




#----------------------- FindNextP -----------------------
# recursive procedure used by RRS
# inputs a recording tableau, Element, and row
# final output is the tableau with the element
# produced by "un-bumping" the intial element

FindNextP:=proc(P,El,Row)
#P=P with El deleted from it

local j, p, PEl, row, tempEl, swapEl:

if Row=1 then
  return([P,El])
fi:

p:=P:
row:=p[Row-1]:
j:=nops(row):
tempEl:=El:

while j > 0 do
  if tempEl> row[j] then
    swapEl:=row[j]:
    row[j]:=tempEl:
    tempEl:=swapEl:
    p[Row-1]:=row:
    j:=0:
	 PEl:=FindNextP(p,tempEl,Row-1):
    p:=PEl[1]:
    tempEl:=PEl[2]:
  else
    j:=j-1:s
  fi:
od:
return([p,tempEl]):

end:  #FindNextP


#----------------------- RRS -----------------------

RRS:=proc(T)
local P,Q,NextEl,nindex,permEl,pList:
if nops(T)=2 then
  P:=T[1]:
  Q:=T[2]:
else
  ERROR(`RRS expects [insertion tableau, recording tableau]`):
fi:

CheckRRS(P,Q):

pList:=[]:

while nops(Q)>0 do
  nindex:=FindN(Q):  #nindex=[n's row, n's col, n]
  Q:=DelNfromQ(Q,nindex):  #deletes n from Tableau Q
  NextEl:= GetNext(P,nindex):
           #NextEl=[modified P,element tentatively deleted from P]
  permEl:= FindNextP(NextEl[1],NextEl[2],nindex[1]):
           #permEl=[re-modified P, element permenantly deleted from P]
  pList:=[permEl[2],op(1..nops(pList),pList)]:
  P:=permEl[1]:
od:

return(pList):

end: #RRS


#----------------------- RSK -----------------------
# RS modified to accept duplicate numbers

RSK:=proc(pi)
local Tab1,Tab2,i,temp,david:

Tab1:=[]: Tab2:=[]:


for i from 1 to nops(pi) do

temp:=InsK(Tab1,pi[i]):

Tab1:=temp[1]:
david:=temp[2]:

if david<=nops(Tab2) then
Tab2:=[op(1..david-1,Tab2), [op(Tab2[david]), i],
op(david+1..nops(Tab2),Tab2)]:

else

Tab2:=[op(Tab2), [i]]:

fi:

od:

[Tab1,Tab2]:
end:  #RSK


#----------------------- InsK -----------------------
# used by RSK procedure - Ins1 modified to work with duplicate elements

InsK:=proc(Tab1,r)
local i,Tab2,Row1,r1,temp:

Tab2:=Tab1:
r1:=r:

for i from 1 to nops(Tab1) do
 Row1:=Tab1[i]:
 temp:=BumpK(Row1,r1):

if temp[2]=0 then
  RETURN([op(1..i-1,Tab2),temp[1],op(i+1..nops(Tab2),Tab2)],i):
 else
 Tab2:=[op(1..i-1,Tab2),temp[1],op(i+1..nops(Tab2),Tab2)]:
 r1:=temp[2]:

fi:

od:

[op(Tab2),[r1]],nops(Tab1)+1:

end:  #InsK

#----------------------- BumpK -----------------------
# used by InsK procedure - Bump modified to work with duplicate elements

BumpK:=proc(Row1,r)
local i:

for i from 1 to nops(Row1) while Row1[i]<=r do od:

if i=nops(Row1)+1 then
[op(Row1),r],0:
 else
[op(1..i-1,Row1),r,op(i+1..nops(Row1),Row1)],Row1[i]:
fi:

end:  #BumpK



#*********************************************************************

#----------------------- Testing Section -----------------------
# The following procedures are used to check the correctness
# of RRS


#----------------------- TestDriver -----------------------
# Permutes N (1 to 8) and uses RSK to produce
# Young Tableau pairs which are then fed into RRS
# Then result from RRS is compared to the original permutation

TestDriver:=proc()
local i,k,N,t,p_q,perm:
with(combinat):

for k from 1 to 8 do
  N:=k:
  print(`Testing RRS with the permutations of`,N):
  print(`Permuting`, N,`....`):
  t:=permute(N):
  print(`this has`,nops(t),`permutations`):

  for i from 1 to nops(t) do
    p_q:=RSK(t[i]):
    perm:=RRS(p_q):
    if t[i]<>perm then
      ERROR(`RRS returned`,perm,`the original permutation was`,t[i]):
    fi:
  od:
  print(`RRS returned the correct answer for all permutations of`,N):
od:

end:  #TestDriver


#----------------------- RandTestDriver -----------------------
# Creates a random list of integers (0..9) of random length(1..7)
# and then tests the list's permutations with RSK/RRS

RandTestDriver:=proc()
local el,i,j,k,EL,L,Length,List,t,T,pList,p_q,perm:
with(combinat):


L:=rand(1..7):
Length:=L():
EL:=rand(0..9):
List:=[]:

for k from 1 to Length do
  el:=EL():
  List:=[op(1..nops(List),List),el]:
od:

t:=permute(Length):

for i from 1 to nops(t) do
    T:=t[i]:
    pList:=[]:
	 for j from 1 to Length do
      pList:=[op(1..nops(pList),pList),List[T[j]]]:
    od:

	 p_q:=RSK(pList):
    perm:=RRS(p_q):
    if pList <> perm then
      ERROR(`RRS returned`,perm,`the original permutation was`,pList):
    fi:
od:
print(`RRS returned the correct answer for all permutations of`,List):

RandTestDriver():

end:  #RandTestDriver():


#----------------------- SYTPTestDriver -----------------------
# inputs an integer, feeds it into SYTpairs to produce a set SYT pairs
# which are fed into RRS to produce a permutation
# the permutation is then fed into RSK and the resulting SYT pair is compared
# to the SYT pair input into RRS

SYTPTestDriver:=proc(n)
local i,perm, NewT, T:

if n > 8 then
  print(`Sorry`,n,`is too large. Please try an integer less than 9`):
  break:
fi:

T:=SYTpairs(n):
print(`There are`,nops(T),`SYT pairs to check.  Checking...`):

for i from 1 to nops(T) do
  perm:=RRS(T[i]):
  NewT:=RSK(perm):
  if NewT <> T[i] then
    ERROR(`RS returned`,NewT,`the original SYT pair was`,T[i]):
  fi:
od:

print(`The correct SYT pairs were returned for all SYT's of`, n):

end:  #SYTPTestDriver


ShadowLines:=proc(pi) local i:
ShadowLinesA([seq([i,pi[i]],i=1..nops(pi))]):
end:


Hook := proc(lambda, c)
  local H, i, x, y;
  x := c[1];
  y := c[2];
  H := {};
  for i from y to lambda[x] do
    H := H union {[x,i]};
  od;
  for i from x to nops(lambda) do
    if lambda[i] >= y then
      H := H union {[i,y]};
    fi;
  od;
  H
end:

isCorner := proc(lambda, c)
  local x, y;
  x := c[1];
  y := c[2];
  if y < lambda[x] then
    return false;
  fi;
  if x = nops(lambda) then
    return true;
  fi;
  if y <= lambda[x+1] then
    return false;
  fi;
  return true;
end:

GNW1 := proc(lambda)
  local n, c, x, y, H;
  n := convert(lambda, `+`);
  y := rand(1..n)();
  x := 1;
  while y > lambda[x] do
    y := y - lambda[x];
    x := x + 1;
  od;
  c := [x,y];
  # Now we have our random node, c.
  while not isCorner(lambda, c) do
    H := Hook(lambda, c) minus {c};
    # H must be non-empty, since c is not a corner cell.
    c := H[rand(1..nops(H))()];
  od;
  return c;
end:

GNW := proc(lambda)
  local lambda1, T, c, n;
  if lambda = [] then
    return [];
  fi;
  n := convert(lambda, `+`);
  c := GNW1(lambda);
  lambda1 := lambda;
  lambda1[c[1]] := lambda[c[1]] - 1;
  if lambda1[c[1]] = 0 then
    lambda1 := [op(1..nops(lambda1)-1, lambda1)];
    T := GNW(lambda1);
    T := [op(T), [n]];
  else
    T := GNW(lambda1);
    T[c[1]] := [op(T[c[1]]), n];
  fi;
  return T;
end: