# Fichier  : BijHG
# Format   : Maple file
# Auteur   : Bruno Gauthier, Institut Gaspard Monge, Universite Marne La Vallee
# A propos : Bijection Hillman & Grassl
# Date     : Mon Apr  1 18:43:52 METDST 1996
###############################################################################

print(`Version of Apr. 15, 1996`):
print(`This is BijHG, a Maple program that applies`):
print(`the bijection between a reverse plane partition P`):
print(`and a tabloid T such that n(P) = sum(T(x) * h(x),x)`):
lprint(``):
print(`This is a Maple implementation of the algorithm described in :`):
print(`A.P. Hillman and R. M. Grassl,`):
print(`Reverse Plane Partitions and Tableau Hook Numbers`):
print(`Journal of Combinatorial Theory (A) 21, 216-221 (1976)`):
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(`BijHG  Contains procedures: `):
print(`hillman, grassl, grasshill, hillgrass`):
print(`For help with a specific procedure, type "man(procedure_name);"`):
 
 
elif nops([args])=1 and op(1,[args])=`hillman` then
print(`hillman(RPP) computes the tabloid T`):
print(`such that n(P)=sum(x,T(x) * h(x))`):
lprint(``):
print(`For example :  hillman([[1, 2, 4], [3, 5, 5], [4]]);`):
print(`gives   [[2, 2, 0], [1, 1, 1], [1]]`):
 

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


elif nops([args])=1 and op(1,[args])=`grasshill` then
print(`grasshill(RPP) is equivalent to grassl(hillman(T))`):
lprint(``):
print(`For example : grasshill([[1, 2, 4], [3, 5, 5], [4]]);`):
print(`gives   [[1, 2, 4], [3, 5, 5], [4]])`):


elif nops([args])=1 and op(1,[args])=`hillgrass` then
print(`hillgrass(T) is equivalent to hillman(grassl(T))`):
lprint(``):
print(`For example : hillgrass([[2, 2, 0], [1, 1, 1], [1]]);`):
print(`gives   [[2, 2, 0], [1, 1, 1], [1]]`):


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

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:





derivation := proc(rpp,rows,cols) 
# Derivation de la r.p.p.
# (Operation elementaire de l'algo I)
local rppd,k,m,
      i,j,aux,ic,jc,tabj,numrow,numcol,bool,trouve,
      r,b,c,longueur;

  rppd := rpp:   # La rpp derivee est initialisee a rpp

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

  #######################################################
  # Recherche du premier element non nul parmi les 
  # elements en bas de chaque colonne (en effectuant
  # la recherche a partir de la colonne la plus a gauche)
  #######################################################

  numcol := 1:
  numrow := k:
  aux := op(numcol,op(numrow,rpp)):  # ici q1

  i := numcol:
  while ( aux <= 0 ) and ( i < m )
        do
           i := i+1:
           bool := true:
           while ( bool = true )
                 do
                    if ( rows[numrow] >= i )
                       then bool := false
                       else numrow := numrow-1:
                    fi:
                 od:
           aux := op(i,op(numrow,rpp)):
       od:
  numcol := i:

  if ( numcol = m ) and ( aux = 0 )   # Si l'element cherche n'existe pas
     then
          # print(`Partition Nulle`):
          r := 0:
          c := 0:
          longueur := 0:
     else 
          ########################################
          # Calcul des Ji
          ########################################

          b := cols[numcol]:
          c := numcol:
          jc := c:
          tabj[b+1] := jc:
          ic := b:

          bool := true:
          while bool
                do
                   trouve := false:
                   while ( trouve = false )
                         do
                            if ( ic <= 1 ) or ( jc > m ) or ( cols[jc] < ic )
                               then bool := false:
                                    trouve := true:
                                    r := ic:
                                    tabj[ic]:=rows[ic]:
                               elif ( op(jc,op(ic,rpp)) = op(jc,op(ic-1,rpp)) )
                                    then trouve := true:
                                         tabj[ic] := jc:
                                         ic := ic-1:
                                    else jc := jc+1:
                            fi:
                         od:

                od:

          # print(`pivot`,r,c):

          # Etude du chemin en Zig-Zag
          # Construction de la r.p.p. derivee
          longueur := 0:
          for i from r to b 
              do
                 for j from tabj[i] by -1 to tabj[i+1]
                     do
                        longueur := longueur+1:
                        rppd := subsop( i=subsop(j=-1+op(j,op(i,rppd)), op(i,rppd)),
                                rppd):
                     od:
              od:
  fi:

# print(longueur):
# La variable "longueur" n'est pas exploitee,
# (c'est la longueur du chemin en zig-zag)

# Retour de la r.p.p., et du pivot
RETURN(rppd,r,c):

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:





hillman := proc(rpp)
local k,m,rows,cols,
      res,pp,encore,
      ret,i,j,z,
      nbderiv,pivots,tab;

  if ( nargs <>1 )
     then ERROR(`The syntax is hillman(RPP)`):
  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]:

  verification_large_large(rpp,rows,cols);


  #######################################################
  # Derivations successives de la r.p.p.
  #######################################################

  encore := true:
  pp:= rpp:
  nbderiv := 0:
  while encore
        do
           res:=derivation(pp,rows,cols):
           if ( res[2] = 0 ) and ( res[3] = 0 )
              then 
                   encore := false:
              else
                   nbderiv := nbderiv+1:
                   pp := res[1]:
                   pivots[nbderiv] := [res[2],res[3]]:
           fi
        od:

  # nbderiv
  # print(pivots):


  #######################################################
  # Construction du tabloid
  #######################################################
  
  # meme forme que la partition plane
  # avec les entres initialisees a 0

  tab := rpp:  

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

      od:

  # pour chaque pivot (i,j).
  # on itere de 1 la valeur de l'entree (i,j) du tableau tab
  for z from 1 to nbderiv
     do
        i := pivots[z][1]:
        j := pivots[z][2]:
        tab:=subsop(i=subsop(j=1+op(j,op(i,tab)), op(i,tab)), tab):
     od:

RETURN(tab):

end:






integration := proc(rpp,rows,cols,pivot)
# Integration de la r.p.p.
# (Operation elementaire de l'algo II)
local k,m,
      i,j,jc,tabj,trouve,
      r,b,c,
      rppi;


  rppi := rpp:   # La rpp integree est initialise a rpp

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


  ###################################################
  # Calcul des Ji
  ###################################################

  r := op(1,pivot):
  c := op(2,pivot):

  b := cols[c]:

  tabj[r] := rows[r]:

  jc := rows[r]:
  i := r+1:

  while ( i <= b )
       do
          trouve := false:
          while not(trouve) 
                do
                   while ( i > cols[jc] ) 
                         do
                            jc := jc-1:
                         od:

                   # print (i,jc):
                   if ( op(jc,op(i,rppi)) = op(jc,op(i-1,rppi)) )
                      then trouve := true:
                           tabj[i] := jc:
                           else jc := jc-1:
                   fi
                od:
          i := i+1:
       od:
  tabj[b+1] := c:


  ########################################
  # Etude du chemin en Zig-Zag
  # Construction de la r.p.p. integree
  ########################################
  for i from r to b 
      do
         for j from tabj[i] by -1 to tabj[i+1]
             do
                rppi:=subsop( i=subsop(j=+1+op(j,op(i,rppi)), op(i,rppi)), rppi):
             od:
      od:

RETURN(rppi):

end:









grassl := proc(tab)
local ret,i,j,cp,
      rows,cols,k,m,nbentries, pivots,rpp;

  if ( nargs <>1 )
     then ERROR(`The syntax is grassl(T)`):
  fi:

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

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

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


  nbentries := 0:
  pivots := []:

  j := m:
  while ( j >= 1 )
       do
          i:=1:
          while ( i <= cols[j] )
                do
                   nbentries := nbentries+1:
                   for cp from 1 to op(j,op(i,tab))
                       do
                          pivots:=[op(pivots),[i,j]]:
                       od:
                   i := i+1:
                od:
          j:=j-1:
      od:

  # print(pivots):


 
  #######################################################
  # Initialisation de la r.p.p. a nulle
  #######################################################

  rpp := tab:

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

  # print(rpp):


  #######################################################
  # Calcul des integrales successives de r.p.p.
  #######################################################

  for i from 1 to nops(pivots) 
      do
         rpp:=integration(rpp,rows,cols,op(i,pivots)):
      od:

RETURN(rpp):

end:




grasshill := proc(rpp)

if ( nargs <>1 )
   then ERROR(`The syntax is grasshill(T)`):
fi:

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

RETURN(grassl(hillman(rpp))):

end:





hillgrass := proc(tab)

if ( nargs <>1 )
   then ERROR(`The syntax is hillgrass(T)`):
fi:

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

RETURN(hillman(grassl(tab))):

end: