# Fichier  : BijKratt 
# Format   : Maple file
# Auteur   : Bruno Gauthier, Institut Gaspard Monge, Universite Marne La Vallee
# A propos : Bijection Krattenthaler
# Date     : Mon Apr 22 18:39:52 METDST 1996
###############################################################################

#############################################################
###                                                       ###
###              (Po , Tr)   <------->   (PL , TL)        ###
###                                                       ###
###                                  I          II        ###
###                                 --->      <----       ###
###                                                       ###
#############################################################

print(`Version of Apr. 18, 1996`):
print(`This is BijKratt, a Maple program that applies`):
print(`the bijection between a column-strict reverse plane partition PR`):
print(`with entries >= 1`):
print(`and`):
print(`a pair (PL,TL)`):
print(`where PL is a column-strict reverse plane partition`):
print(`with entries between 1 and A`):
print(`and where TL is a tabloid`):
print(`such that n(PR) = n(PL) + Wc(TL)`):
lprint(``):
print(`This is a Maple implementation of the algorithm described in :`):
print(`C. Krattenthaler`):
print(`An involution principle-free bijective proof`):
print(`of Stanley's hook-content formula`):
lprint(``):
print(`The most current version is available on WWW at:`):
print(`http://www-igm.univ-mlv.fr/~gauthier .`):
print(`Please report all bugs to: gauthier@univ-mlv.fr`):
print(`For general help, and a list of the available functions,`):
print(`type "man();". For specific help type "man(procedure_name)"`):
lprint(``):
 
 
 
man := proc()

if args=NULL then
print(`BijKratt  Contains procedures: `):
print(`rppTOcrpp, crppTOrpp`):
print(`For help with a specific procedure, type "man(procedure_name);"`):
 
 
elif nops([args])=1 and op(1,[args])=`rppTOcrpp` then
print(`rppTOcrpp(RPP) computes the tabloid T`):
print(`such that n(P)=sum(x,T(x) * h(x))`):
lprint(``):
print(`For example :  rppTOcrpp([[1,1,3,8], [2,3,4], [5,7,8], [7]],4);`);
print(`gives   [[1, 1, 1, 3], [2, 2, 2], [3, 3, 4], [4]],`);
print(`[[1, 0, 1, 0], [1, 0, 0], [3, 1, 0], [1]]`);

 

elif nops([args])=1 and op(1,[args])=`crppTOrpp` then
print(`crppTOrpp(PL,TL,A) computes the reverse plane partition RPP`):
print(`such that n(P)=sum(x,T(x) * h(x))`):
lprint(``):
print(`For example :  crppTOrpp([[1,1,1,3], [2,2,2], [3,3,4], [4]], [[1,0,1,0], [1,0,0], [3,1,0],[1]],4);`);
print(`gives   [[1, 1, 3, 8], [2, 3, 4], [5, 7, 8], [7]]`);




else ERROR(`There is no procedure in the BijKratt program by the name of`,args):
fi:

end:



verification_large_large := proc(T,rows,cols)
# Verifie que les longueurs des lignes decroissent au sens large
# Verifie que les entrees des lignes   sont croissantes au sens large
# Verifie que les entrees des colonnes sont croissantes au sens large
 
local k,m,
      i,j;


  k := nops(T);
  m := rows[1];


  for i from 1 to k-1
      do
         if ( rows[i+1] > rows[i] )
            then ERROR(`Les longueurs des lignes du tabloid ne doivent pas etre croissantes`): 
         fi:
      od:


  # Verification de la croissance par ligne
  for i from 1 to k
      do
         for j from 2 to rows[i]
             do
                if ( op(j,op(i,T)) < op(j-1,op(i,T)) )
                   then ERROR(`Le tabloid ne verifie pas les proprietes requises de croissance`): 
                fi:
             od:
      od:

  # Verification de la croissance par colonne
  for j from 1 to m
      do
         for i from 2 to cols[j]
             do
                if ( op(j,op(i,T)) < op(j,op(i-1,T)) )
                   then ERROR(`Le tabloid ne verifie pas les proprietes requises de croissance`): 
                fi:
             od:
      od:

end:





verification_large_stricte := proc(T,rows,cols)
# Verifie que les longueurs des lignes decroissent au sens large
# Verifie que les entrees des lignes   sont croissantes au sens large
# Verifie que les entrees des colonnes sont strcitement croissantes
 
local k,m,
      i,j;


  k := nops(T);
  m := rows[1];

  for i from 1 to k-1
      do
         if ( rows[i+1] > rows[i] )
            then ERROR(`Les longueurs des lignes du tabloid ne doivent pas etre croissantes`): 
         fi:
      od:


  # Verification de la croissance par ligne
  for i from 1 to k
      do
         for j from 2 to rows[i]
             do
                if ( op(j,op(i,T)) < op(j-1,op(i,T)) )
                   then ERROR(`Le tabloid ne verifie pas les proprietes requises de croissance`): 
                fi:
             od:
      od:

  # Verification de la croissance par colonne
  for j from 1 to m
      do
         for i from 2 to cols[j]
             do
                if ( op(j,op(i,T)) <= op(j,op(i-1,T)) )
                   then ERROR(`Le tabloid ne verifie pas les proprietes requises de croissance`): 
                fi:
             od:
      od:

end:




calcul := proc(mypart)
local rows,cols,nbrow,nbcol,i,j;

#######################################################
# Calcul des longueurs des lignes et des colonnes
#######################################################

# Traitement des lignes

  nbrow := nops(mypart):               # Nombre de lignes
  rows := array[1..nbrow]:
  for i from 1 to nbrow 
      do
         rows[i] := nops(mypart[i]):   # Longeur des lignes
      od:

# Traitement des colonnes

  nbcol := rows[1]:                    # Nombre de colonnes
  cols := array[1..rows[1]]:
  for i from 1 to rows[1]
      do
         j:=1:
         while ( j <= nbrow ) and ( rows[j] >= i )
              do
                 j:=j+1:
              od:
         cols[i] := j-1:               # Longueur des colonnes
      od:

  #print(rows):
  #print(cols):

RETURN(rows,cols):

end:





calcul_maxi := proc(tabl,rows,cols)
local k,m,
      i,j,maxi;
 
#######################################################
# Calcul de la valeur maxi de la partition
#######################################################

  k := nops(tabl):
  m := rows[1]:

  j := m:
  maxi := 0:
  while ( j >= 1 )
      do
         i := 1:
          while ( i <= cols[j] )
               do
                  maxi := max(maxi , op(j,op(i,tabl))):
                  i := i+1: 
               od:
         j := j-1:
      od:

RETURN(maxi):

end:








traitement := proc(PL,TL,A,rows,cols)
local P,T,k,m,
      i,numrow,bool,
      maxi,res,
      xs,ys,val, # coordonnees et valeur de l'entree speciale
      valx,valy;

  P := PL:
  T := TL:
  k := nops(P):
  m := rows[1]:


  ###########################################################
  # Recherche de l'entree speciale
  # (plus grande entrees parmi les coins  (la plus a gauche))
  # (on effectue la recherche a partir de la colonne
  # la plus a gauche)
  ###########################################################

  numrow := k:
  maxi := 0:

  i:=1:
  while ( i <= m )
        do
           bool := true:
           while ( bool = true )
                 do
                    if ( rows[numrow] < i )
                       then numrow := numrow-1:
                       else bool := false:
                    fi:
                 od:

           if ( rows[numrow] = i )    # si la cellule est un coin
              then res := op(i,op(numrow,P)):
              else res := 0:
           fi:
           if ( res > maxi )
              then
                   maxi := op(i,op(numrow,P)):
                   xs := numrow:
                   ys := i:
           fi:
           i := i+1:
       od:

  #print(xs,ys):
  val := op(ys,op(xs,P)) - (A+ys-xs):
  P := subsop( xs=subsop(ys=val, op(xs,P)),P):

  ###########################################################
  # Deplacement de l'entree speciale pour conserver
  # l'ordre sur les lignes et les colonnes
  ###########################################################


  
  if( xs > 1 )
     then valy := op(ys,op(xs-1,P)):
     else valy := 0:
  fi:
  if( ys > 1 )
     then valx := op(ys-1,op(xs,P)):
     else valx := 0:
  fi:

  while ( valx > val ) or ( valy >= val )
        do
           if ( valx > valy )
              then P := subsop( xs=subsop(ys=valx, op(xs,P)),P):
                   if ( ys > 1 )
                      then P := subsop( xs=subsop(ys-1=val+1, op(xs,P)),P):
                   fi:
                   val := val+1:
                   ys := ys-1:
              else P := subsop( xs=subsop(ys=valy, op(xs,P)),P):
                   if ( xs > 1 )
                      then P := subsop( xs-1=subsop(ys=val-1, op(xs-1,P)),P):
                   fi:
                   val := val-1:
                   xs := xs-1:
           fi:
           
           if( xs > 1 )
              then valy := op(ys,op(xs-1,P)):
              else valy := 0:
           fi:
           if( ys > 1 )
              then valx := op(ys-1,op(xs,P)):
              else valx := 0:
           fi:
        od:

  ###########################################################
  # Mise a jour du tableau T
  # (incrementation (+1) de la cellule speciale)
  ###########################################################

  T := subsop( xs=subsop(ys=1+op(ys,op(xs,T)), op(xs,T)),T):
  
  #print(T):

RETURN(P,T):

end:









rppTOcrpp := proc(rpp,A)

local k,m,rows,cols,
      ret,i,j,maxi,
      PL,TL;

  if ( nargs <>2 )
     then ERROR(`The syntax is rppTOcrpp(RPP,A)`):
  fi:

  if ( whattype(rpp) <> list )
     then ERROR(`L'argument doit etre un tableau`):
  fi:


  # Calcul des longueurs des lignes et des colonnes
  ret :=calcul(rpp):
  rows:=ret[1]:
  cols:=ret[2]:

  k := nops(rpp):
  m := rows[1]:

  if ( A < k )
     then ERROR(`A must be >= number of rows`):
  fi:

  verification_large_large(rpp,rows,cols):


  #######################################################
  # Construction de PL
  #######################################################

  PL:= rpp:

  #######################################################
  # Construction de TL
  #######################################################
  
  # meme forme que la partition plane
  # avec les entres initialisees a 0

  TL := rpp:

  j := m:
  while ( j >= 1 )
      do
         i := 1:
          while ( i <= cols[j] )
               do
                  TL := subsop( i=subsop(j=0, op(i,TL)), TL):
        	  i := i+1: 
	       od:
         j := j-1:
      od:

  #######################################################
  # Si les entrees de PL sont <= A          --> STOP
  #######################################################
  

  maxi:=calcul_maxi(PL,rows,cols):
  while ( maxi > A )
        do
           ret:=traitement(PL,TL,A,rows,cols):
           PL := ret[1]:
           TL := ret[2]:
           maxi:=calcul_maxi(PL,rows,cols):
       od:


RETURN(PL,TL):

end:












traitement_bis := proc(PL,TL,A,rows,cols)
local P,T,k,m,
      i,j,
      mini,
      MAXINT,
      xs,ys,val, # coordonnees et valeur de l'entree speciale
      valx,valy;

  MAXINT := 999:

  P := PL:
  T := TL:
  k := nops(P):
  m := rows[1]:


  ###########################################################
  # Recherche de l'entree speciale
  # (l'entree (i,j) non nulle de T 
  # telle que P(i,j)+A+(j-i) soit minimale 
  # (la plus a droite et la plus haute)
  # (on effectue la recherche a partir de la colonne
  # la plus a droite)
  ###########################################################

  mini := MAXINT:

  j := m:
  while ( j >= 1 )
      do
	 i := 1:
          while ( i <= cols[j] )
	       do
		  if ( op(j,op(i,T)) <> 0 )
		     then if ( op(j,op(i,P)) + A+j-i  <  mini )
			     then mini := op(j,op(i,P)) + A+j-i:
				  xs := i:
				  ys := j:
                          fi:
                  fi:
		  i := i+1: 
	       od:
         j := j-1:
      od:


  #print(xs,ys):
  val := op(ys,op(xs,P)) + A+ys-xs:
  P := subsop( xs=subsop(ys=val, op(xs,P)),P):



  ###########################################################
  # Mise a jour du tableau T
  # (incrementation (+1) de la cellule speciale)
  ###########################################################

  T := subsop( xs=subsop(ys=op(ys,op(xs,T))-1, op(xs,T)),T):
  
  #print(T):



  ###########################################################
  # Deplacement de l'entree speciale pour conserver
  # l'ordre sur les lignes et les colonnes
  ###########################################################

  
  if( cols[ys] > xs )
     then valy := op(ys,op(xs+1,P)):
     else valy := MAXINT:
  fi:
  if( rows[xs] > ys )
     then valx := op(ys+1,op(xs,P)):
     else valx := MAXINT:
  fi:

  while ( val > valx ) or ( val >= valy )
        do
           if ( valx < valy )
              then P := subsop( xs=subsop(ys=valx, op(xs,P)),P):
                   if ( rows[xs] > ys )
                      then P := subsop( xs=subsop(ys+1=val, op(xs,P)),P):
                   fi:
                   ys := ys+1:
              else P := subsop( xs=subsop(ys=valy, op(xs,P)),P):
                   if ( cols[ys] > xs )
                      then P := subsop( xs+1=subsop(ys=val, op(xs+1,P)),P):
                   fi:
                   xs := xs+1:
           fi:
           
           if( cols[ys] > xs )
              then valy := op(ys,op(xs+1,P)):
              else valy := MAXINT:
           fi:
           if( rows[xs] > ys )
              then valx := op(ys+1,op(xs,P)):
              else valx := MAXINT:
           fi:
        od:

RETURN(P,T):

end:






crppTOrpp := proc(PL,TL,A)

local k,m,rows,cols,
      ret,i,j,maxi,
      P,T;


  if ( nargs <> 3 )
     then ERROR(`The syntax is crppTOrpp(PL,TL,A)`):
  fi:

  if ( whattype(PL) <> list ) or ( whattype(TL) <> list )
     then ERROR(`Les arguments doit etre un tableau`):
  fi:

  P := PL:
  T := TL:

  # Calcul des longueurs des lignes et des colonnes
  ret :=calcul(P):
  rows:=ret[1]:
  cols:=ret[2]:

  k := nops(P):
  m := rows[1]:


  if ( A < k ) 
     then ERROR(`A must be >= number of rows`):
  fi:

  maxi := calcul_maxi(P,rows,cols):

  if ( maxi > A)
     then ERROR(`A must be >= Entries of PL`):
  fi:

  verification_large_stricte(P,rows,cols):

  #############################################
  # Iteration de l'algorithme de calcul de P
  #############################################

  maxi:=calcul_maxi(T,rows,cols):

  while ( maxi <> 0 )
        do
           ret := traitement_bis(P,T,A,rows,cols):
           P  := ret[1]:
           T := ret[2]:
           maxi := calcul_maxi(T,rows,cols):
        od:


RETURN(P):

end: