# Fichier  : Dim  
# Format   : Maple file
# Auteur   : Bruno Gauthier, Institut Gaspard Monge, Universite Marne La Vallee
# A propos : Formule des equerres
# Date     : Mon Apr 22 18:22:31 METDST 1996
###############################################################################


###################################################
# LES 1 speciaux sont notes 0
###################################################

print(`Version of Apr. 22, 1996`):
print(`This is Dim, a Maple program that computes`):
print(`the dimension of a tableau`):
lprint(``):
print(`This is a Maple implementation of the algorithm described in :`):
print(`A. Lascoux, B. Leclerc and J.Y. Thibon,`):
print(`Ribbon tableaux, Hall-Littlewood function,`);
print(`quantum affine algebras and unipotent varieties`);
print(`Groupe de recherche algorithmique & logique`);
print(`Universite de Caen, (1996-2)`);
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(`Dim  Contains procedures: `):
print(`dimd, dime`):
print(`For help with a specific procedure, type "man(procedure_name);"`):
 
 
elif nops([args])=1 and op(1,[args])=`dimd` then
print(`dimd(T) computes the statistic d(T)`):
lprint(``):
print(`For example :  dimd([[1, 1, 2], [1, 2, 3], [1, 4]]);`):
print(`gives   4`):
 

elif nops([args])=1 and op(1,[args])=`dime` then
print(`dime(T) computes the statistic e(T)`):
lprint(``):
print(`For example :  dime([[1, 1, 2], [1, 2, 3], [1, 4]]);`):
print(`gives   4`):


else ERROR(`There is no procedure in the Dim package 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,cols):

RETURN(rows,cols):

end:






decomp1 := proc(tab,rows,cols,MAX)
local i,j, 
      m,
      tabres;

###########################
# Determination de T1
###########################

  m := rows[1]:
  tabres := tab:

  j := m:
  while ( j >= 1 )
       do
	  i:=1:
	  while ( i <= cols[j] )
		do
 		   if ( op(j,op(i,tab)) = MAX )
                      then # On remplace la valeur par 2
                           tabres := subsop( i=subsop(j=2, op(i,tabres)), tabres):
		      else # On remplace la valeur par 1
                           tabres := subsop( i=subsop(j=1, op(i,tabres)), tabres):
                   fi:
		   i := i+1:
		od:
          j:=j-1:
      od:

RETURN(tabres):

end:







decomp2 := proc(tab,rows,cols,MAX)
local i,j, 
      k,m,
      tabres;

###########################
# Determination de T2
###########################

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

  tabres := tab:

  j := m:
  while ( j >= 1 )
       do
	  i:=1:
	  while ( i <= cols[j] )
		do
 		   if ( op(j,op(i,tabres)) = MAX )
                      then # On supprime la cellule
                           tabres := subsop( i=subsop(j=NULL, op(i,tabres)), tabres):
                   fi:
		   i := i+1:
		od:
          j:=j-1:
      od:

  i := 1:
  while ( i <= k )
      do
	 if ( nops(op(i,tabres)) = 0 )   # Si ligne vide
	    then tabres := subsop(i=NULL,tabres):  # alors suprression de la ligne
		 k:=k-1:
         fi:
	 i := i+1:
      od:

RETURN(tabres):

end:






arrangement := proc(tab)
local i,j,ret,aux,
      rows,cols,
      k,
      tabres;


###########################
# rearrangement des lignes
###########################

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

  k := nops(tab):

  tabres := tab:

  if ( k > 1 )
     then ################################################# 
          # Tri des linges ( par longueur decroissante)
          ################################################# 

          for i from 1 to k 
              do
	         for j from 1 to k-1
	              do
                         if ( rows[j] < rows[j+1] )
		            then # Echange des deux lignes
                                 aux := op(j,tabres):
			         tabres := subsop(j=op(j+1,tabres),tabres):
			         tabres := subsop(j+1=aux,tabres):
                         fi:
	              od:
              od:
  fi:

RETURN(tabres):

end:






dimension := proc(tab,rows,cols,ii,jj)
local k,m,d,
      w;

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

  d := 0:
  for w from 1 to cols[jj] 
      do
	 if ( op(jj,op(w,tab)) = 1 )
	 or ( ( op(jj,op(w,tab)) = 0 ) and ( w < ii ) )
	    then d := d+1:


	 fi:
      od:

RETURN(d):

end:





cas_de_base := proc(tab,rows,cols)
# entrees egales a 1 ou 2
local i,j,encore,
      k,m,tabmarq,d;



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

  tabmarq := tab:

  ##########################
  # Marquage des 1 speciaux
  ##########################

  for i from 1 to k
       do 
	  j:=rows[i]:
	  encore := true:
	  while ( j >= 1 ) and encore 
		do
 		   if  ( op(j,op(i,tabmarq)) = 1 )
                       then tabmarq := subsop( i=subsop(j=0, op(i,tabmarq)), tabmarq):
			    encore := false:
                   fi:
		   j := j-1:
		od:
      od:

  # print(tabmarq):

  # calcul de d

  d := 0:

  j := m:
  while ( j >= 1 )
       do
	  i:=1:
	  while ( i <= cols[j] )
		do
 		   if ( op(j,op(i,tabmarq)) = 2 )
                      then d := d + dimension(tabmarq,rows,cols,i,j):
                   fi:
		   i := i+1:
		od:
          j:=j-1:
      od:

RETURN(d):

end:







dimd := proc(tab)
local k,m,ret,rows,cols,d,
      tab1,tab2,
      i,j,MAX;

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


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


  MAX := 0:
  j := m:
  while ( j >= 1 )
      do
         for i from 1 to cols[j]
	     do
 	        if  ( op(j,op(i,tab)) > MAX )
                    then MAX := op(j,op(i,tab)):
                fi:
	     od:
         j:=j-1:
      od:


  if ( MAX <= 2 )
     then  d := cas_de_base(tab,rows,cols):
     else  tab1 := decomp1(tab,rows,cols,MAX):
           tab2 := decomp2(tab,rows,cols,MAX):
	   tab2 := arrangement(tab2):
	   # print(tab1,tab2):
           d := dimd(tab1)+dimd(tab2):
  fi:

RETURN(d):

end:








decomp1bis := proc(tab,rows,MAX)
local i,j, 
      k,
      tabres;

###########################
# Determination de T1
###########################

  k := nops(tab):
  tabres := tab:

  for i from 1 to k
      do
         for j from 1 to rows[i] 
	     do
 	        if ( op(j,op(i,tab)) = MAX )
                   then # On remplace la valeur par 2
                        tabres := subsop( i=subsop(j=2, op(i,tabres)), tabres):
	           else # On remplace la valeur par 1
                        tabres := subsop( i=subsop(j=1, op(i,tabres)), tabres):
                fi:
	     od:
      od:

RETURN(tabres):

end:








decomp2bis := proc(tab,rows,MAX)
local i,j, 
      k,m,
      tabres;

###########################
# Determination de T2
###########################

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

  tabres := tab:

  for i from 1 to k 
      do
         for j from rows[i] by -1 to 1    
	 
	 # peut-etre aussi a l'envers pour decomp2

	     do
 	        if ( op(j,op(i,tabres)) = MAX )
                   then # On supprime la cellule
                        tabres := subsop( i=subsop(j=NULL, op(i,tabres)), tabres):
                fi:
	     od:
      od:

  i := 1:
  while ( i <= k )
      do
	 if ( nops(op(i,tabres)) = 0 )   # Si ligne vide
	    then tabres := subsop(i=NULL,tabres):  # alors suprression de la ligne
		 k:=k-1:
         fi:
	 i := i+1:
      od:

RETURN(tabres):

end:









dimensionbis := proc(tab,rows,ii,jj)
local k,m,d,
      w;

  k := nops(tab):

  d := 0:
  for w from 1 to k
      do
	 if ( rows[w] >= jj ) 
	    then
		 if ( op(jj,op(w,tab)) = 1 )
	            or ( ( op(jj,op(w,tab)) = 0 ) and ( w < ii ) )
	            then d := d+1:
                 fi:
	fi:
      od:

RETURN(d):

end:





cas_de_base_bis := proc(tab,rows)
# entrees egales a 1 ou 2
local i,j,encore,
      k,m,tabmarq,d;



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

  tabmarq := tab:

  ##########################
  # Marquage des 1 speciaux
  ##########################

  for i from 1 to k
       do 
	  j:=rows[i]:
	  encore := true:
	  while ( j >= 1 ) and encore 
		do
 		   if  ( op(j,op(i,tabmarq)) = 1 )
                       then tabmarq := subsop( i=subsop(j=0, op(i,tabmarq)), tabmarq):
			    encore := false:
                   fi:
		   j := j-1:
		od:
      od:

  # print(tabmarq):

  # calcul de d

  d := 0:

  for j from m by -1 to 1
      do
         for i from 1 to k
             do
		if ( rows[i] >= j )
	           then
 	                if  ( op(j,op(i,tabmarq)) = 2 )
                            then d := d + dimensionbis(tabmarq,rows,i,j):
                        fi:
	        fi:
             od:
      od:

RETURN(d):

end:













dime := proc(tab)
local k,ret,rows,d,
      tab1,tab2,
      i,j,MAX;

  if ( nargs <>1 )
     then ERROR(`The syntax is dime(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]:    # ici, les longueurs de colonne 
		     # ne sont pas utilisees

  k := nops(tab):


  MAX := 0:
  for i from 1 to k
      do
         for j from 1 to rows[i] 
	     do
 	        if ( op(j,op(i,tab)) > MAX )
                   then MAX := op(j,op(i,tab)):
                fi:
	     od:
      od:


  if ( MAX <= 2 )
     then  d := cas_de_base_bis(tab,rows):
     else  tab1 := decomp1bis(tab,rows,MAX):
           tab2 := decomp2bis(tab,rows,MAX):
	   # print(tab1,tab2):
           d := dime(tab1)+dime(tab2):
  fi:

RETURN(d):

end: