/* SYMMETRICA file:ta.c */
#include "def.h"
#include "macro.h"

#define callocobject callocobject_trace
#undef callocobject
static struct tableaux * calloctableaux();
static INT inhaltcoroutine();
static INT free_tableaux();

static INT mem_counter_tab;

#ifdef TABLEAUXTRUE
INT tab_anfang()
/* AK 100893 */
	{
	mem_counter_tab=0L;
	return OK;
	}

INT tab_ende()
/* AK 100893 */
	{
	INT erg = OK;
	if (mem_counter_tab != 0L)
		{
		fprintf(stderr,"mem_counter_tab = %ld\n",mem_counter_tab);
		erg += error("tab memory not freed");
		}
	return erg;
	}

INT cast_apply_tableaux(a) OP a;
/* AK 270295 */
{
	INT erg = OK;
	if (MATRIXP(a))
		{
		erg += m_matrix_tableaux(a,a);
		}
	else if (VECTORP(a))
		{
		erg += cast_apply_matrix(a);
		erg += m_matrix_tableaux(a,a);
		}
	else 	{
                printobjectkind(a);
		erg += error("cast_apply_tableaux: transfer not possible");
		}
	if (a == S_T_S(a))
		FATALERROR("cast_apply_tableaux");
	ENDR("cast_apply_tableaux");
}

#endif /* TABLEAUXTRUE */

INT tableauxp(a) OP a;
{
	if (S_O_K(a) == TABLEAUX) 
		return TRUE;
	return FALSE;
}

#ifdef TABLEAUXTRUE
INT charge_tableaux(a,b) OP a,b;
/* AK 141196 */
{
	INT erg = OK;
	OP c;
	CTO(TABLEAUX,"charge_tableaux",a);
	c = callocobject();
	erg += rowwordoftableaux(a,c);
	erg += charge_word(c,b);
	erg += SYMfreeall(c);
	ENDR("charge_tableaux");
}

INT inverse_nilplactic_jeudetaquin_tableaux(a,si,sj,b) OP a,b;INT si,sj;
/* AK 120790 V1.1 */ /* AK 200691 V1.2 */ /* AK 200891 V1.3 */
	{
	OP self,umriss;
	INT posi,posj; /* aktuelle position des jokers */
	OP unten, links;
	if (not EMPTYP(b) ) freeself(b);
	if (sj != zeilenende(a,si)+1L)
		return error("INV_NILJDT: illegel index");
	if (S_O_K(S_T_U(a)) == PARTITION)
		if (si > S_T_ULI(a))
			return error("INV_NILJDT: illegel index");
	if (S_O_K(S_T_U(a)) == SKEWPARTITION)
		if (si > S_T_UGLI(a))
			return error("INV_NILJDT: illegel index");
	self = callocobject();
	copy(S_T_S(a),self);
	if (sj == S_M_LI(self)) inc(self);
	if (si == S_M_HI(self)) inc(self);
	posi = si; posj = sj;
m120790again:
	unten = NULL; links = NULL;
	if (posj > 0L) {
		links = S_M_IJ(self, posi, posj-1L);
		if (EMPTYP(links)) links = NULL;}
	if (posi > 0L) {
		unten = S_M_IJ(self, posi-1L, posj);
		if (EMPTYP(unten)) unten = NULL;}

	if ((links == NULL) && (unten == NULL))
		{
		/* Abbruchbedingung */
		C_O_K(S_M_IJ(self,posi,posj),EMPTY);
		umriss = callocobject(); 
		m_matrix_umriss(self,umriss);
		return b_us_t(umriss,self,b); 
		}

	if (links == NULL) 
		{ M_I_I(S_I_I(unten), S_M_IJ(self,posi,posj));
		posi--; goto m120790again; }
	if (unten == NULL) 
		{ M_I_I(S_I_I(links), S_M_IJ(self,posi,posj));
		posj--; goto m120790again; }
	if (S_I_I(unten) == S_I_I(links))
		{
		if ( not emptyp(S_M_IJ(self,posi-1L,posj-1L)))
		if ( S_M_IJI(self,posi-1L,posj-1L) == S_I_I(links)-1L )
			{
			/* jetzt anwenden der nilplactic relationen */
			INT i;
			M_I_I(S_M_IJI(self,posi,posj-1L),
			      S_M_IJ(self,posi,posj));
			for (i=1L; i <= posi ; i++)
				{
				if (
					(S_M_IJI(self,posi-i,posj-1L) 
					!= S_I_I(links)-i)  ||
					(S_M_IJI(self,posi-i,posj) 
					!= S_I_I(links)-i+1L)  
				   ) break;
				M_I_I(S_M_IJI(self,posi-i,posj-1L),
				      S_M_IJ(self,posi-i,posj));
				}
			posj--;
			goto m120790again;
			}
		}
	if (S_I_I(unten) >= S_I_I(links))
		{ M_I_I(S_I_I(unten), S_M_IJ(self,posi,posj));
		posi--; goto m120790again; }
	else
		{ M_I_I(S_I_I(links), S_M_IJ(self,posi,posj));
		posj--; goto m120790again; }
	
	}
#endif /* TABLEAUXTRUE */


#ifdef TABLEAUXTRUE
INT inverse_jeudetaquin_tableaux(a,si,sj,b) OP a,b;INT si,sj;
/* AK 100790 V1.1 */ /* AK 200891 V1.3 */
	{
	OP self,umriss;
	INT posi,posj; /* aktuelle position des jokers */
	OP unten, links;
	if (not EMPTYP(b) ) freeself(b);
	if (sj != zeilenende(a,si)+1L)
		return error("inverse_jeudetaquin_tableaux: illegel index");
	self = callocobject();
	copy(S_T_S(a),self);
	if (sj == S_M_LI(self)) inc(self);
	if (si == S_M_HI(self)) inc(self);
	posi = si; posj = sj;
m100790again:
	unten = NULL; links = NULL;
	if (posj > 0L) {
		links = S_M_IJ(self, posi, posj-1L);
		if (EMPTYP(links)) links = NULL;}
	if (posi > 0L) {
		unten = S_M_IJ(self, posi-1L, posj);
		if (EMPTYP(unten)) unten = NULL;}

	if ((links == NULL) && (unten == NULL))
		{
		/* Abbruchbedingung */
		C_O_K(S_M_IJ(self,posi,posj),EMPTY);
		umriss = callocobject(); 
		m_matrix_umriss(self,umriss);
		b_us_t(umriss,self,b); return(OK);
		}
	if (links == NULL) 
		{ M_I_I(S_I_I(unten), S_M_IJ(self,posi,posj));
		posi--; goto m100790again; }
	if (unten == NULL) 
		{ M_I_I(S_I_I(links), S_M_IJ(self,posi,posj));
		posj--; goto m100790again; }
	if (S_I_I(unten) >= S_I_I(links))
		{ M_I_I(S_I_I(unten), S_M_IJ(self,posi,posj));
		posi--; goto m100790again; }
	else
		{ M_I_I(S_I_I(links), S_M_IJ(self,posi,posj));
		posj--; goto m100790again; }
	
	}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT jeudetaquin_tableaux(a,b) OP a,b;
/* AK 080688 */
/* Jeu de Taquin auf a wird b . a ist schieftableau und wird ein tableau b */
/* AK 010889 V1.1 */ /* AK 200891 V1.3 */
	{
	OP self,umriss,unten,rechts;
	INT i,j; 
	INT posi,posj;  /* aktuelle position des jokers */
	INT nexti,nextj;  /* naechste position des jokers */
	INT si,sj; /* start of joker */

	if (S_O_K(S_T_U(a)) == PARTITION) return copy(a,b);

	self = callocobject(); 
	copy (S_T_S(a),self);
m0806883: /* ein neues spiel */
	i = 0L;
	for (j=0L;j<S_M_LI(self);j++)
		if (not EMPTYP(S_M_IJ(self,i,j)))
			{
			if (j == 0L) goto m080688stop1; /* ende */
					/* man hat ein tableaux */


			/* spalte mit eintrag */
			j = j - 1L; 
			for (i=0L;i<S_M_HI(self);i++)
				if (not EMPTYP(S_M_IJ(self,i,j)))
					{ si=i-1L;sj=j;goto m0806881;}
			};
m0806881:	/* si,sj die position des jokers */
	posi = si; posj = sj;
m0806882: 	/* next step */
		/* nach richtung kleineres element, bei gleich nach unten */
	unten = NULL; rechts = NULL;
	if (posi+1 < S_M_HI(self)) /* joker nicht in unterste zeile */
		{
		unten = S_M_IJ(self,posi+1L,posj);
		if (EMPTYP(unten)) unten = NULL;
		};
	if (posj+1 < S_M_LI(self)) /* joker nicht in letzter spalte */
		{
		rechts = S_M_IJ(self,posi,posj+1L);
		if (EMPTYP(rechts)) rechts = NULL;
		};
	if ( (unten == NULL) && (rechts == NULL) ) 
		/* ende ein neues spiel */ goto m0806883;
	if ( (unten == NULL))  /* nach rechts */
		{ nexti = posi; nextj=posj+1L; }
	else if ( (rechts == NULL))  /* nach unten */
		{ nexti = posi+1L; nextj=posj; }
	else /* in beide richtungen ist noch ein eintrag */
		{
		if (lt(rechts,unten))
			{ nexti = posi; nextj=posj+1L; }
		else	{ nexti = posi+1L; nextj=posj; };
		};

	copy(S_M_IJ(self,nexti,nextj),S_M_IJ(self,posi,posj));
	freeself(S_M_IJ(self,nexti,nextj));
	posi=nexti; posj=nextj;
	goto m0806882; /* noch eine runde */
m080688stop1: /* wir sind fertig,aus der matrix wird ein tableau */
	umriss = callocobject(); 
	m_matrix_umriss(self,umriss);
	b_us_t(umriss,self,b); 
	return(OK);
	}
#endif


#ifdef TABLEAUXTRUE
INT m_u_t(umriss,res) OP umriss,res;
/* AK 020488 aufbau eines tableaus ohne inhalt */
/* AK 281289 V1.1 */ /* AK 240791 V1.3 */
	{
	OP l,h;
	INT erg = OK;

	l= callocobject(); 
	h= callocobject(); 

	erg += length(umriss,h);
		/* bsp umriss = 1234 ==> height = 4
		umriss = 23456789/3456 ==> height = 8 */

	erg += lastof(umriss,l);

	erg += b_us_t(callocobject(),callocobject(),res);
	erg += copy(umriss,S_T_U(res));
	erg += b_lh_m(l,h,S_T_S(res)); 
	ENDR("m_u_t");
	}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
static INT free_tableaux(a) char *a;
{
	SYM_free(a);
	mem_counter_tab--;
}

INT freeself_tableaux(a) OP a;
/* AK 260789 */ /* AK 281289 V1.1 */ /* AK 200891 V1.3 */
	{
	OBJECTSELF c;
	INT erg = OK;
	erg += SYMfreeall(S_T_S(a)); 
	erg += SYMfreeall(S_T_U(a));
	c = S_O_S(a); 
	free_tableaux(c.ob_tableaux); 
	ENDR("freeself_tableaux");
	}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT copy_tableaux(a,b) OP a,b;
/* AK 260789 */ /* AK 230790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT erg = OK;
	erg += b_us_t(callocobject(),callocobject(),b);
	erg += copy_matrix(S_T_S(a),S_T_S(b)); /* self ist immer matrix */
	erg += copy(S_T_U(a),S_T_U(b));
	ENDR("copy_tableaux");
	}
#endif /* TABLEAUXTRUE */
	

#ifdef TABLEAUXTRUE
static struct tableaux * calloctableaux()
/* 020488 AK erste prozedur beim einfuehren eines neuen datentyps */
/* AK 010889 V1.1 */ /* AK 200891 V1.3 */
	{
	struct  tableaux *erg
	= (struct tableaux *) SYM_calloc((int)1,sizeof(struct tableaux));
	if (erg == NULL) 
		error("calloctableaux:no memory");
	mem_counter_tab++;
	return(erg);
	}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT m_us_t(umriss,self,res) OP umriss,self,res;
/* AK 230790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT erg = OK;
	erg += b_us_t(callocobject(),callocobject(),res);
	erg += copy(umriss,S_T_U(res)); 
	erg += copy(self,S_T_S(res)); 
	ENDR("m_us_t");
	}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT b_us_t(umriss,self,res) OP umriss,self,res;
/* die zweite prozedur bei neuen typen */
/* AK 010889 V1.1 */ /* AK 200891 V1.3 */
	{
	OBJECTSELF d;
	INT erg = OK;

	if (res==NULL) 
		return NOP("b_us_t");

	d.ob_tableaux = calloctableaux();
	erg += b_ks_o(TABLEAUX, d, res);

	erg += c_t_u(res,umriss); /*change_tableaux_umriss*/
	erg += c_t_s(res,self); /*change_tableaux_self*/
	ENDR("b_us_t");
	}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT objectread_tableaux(f,a) FILE *f; OP a;
/* AK 210690 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	erg += b_us_t(callocobject(),callocobject(),a);
	erg += objectread(f,S_T_U(a));
	erg += objectread(f,S_T_S(a));
	ENDR("objectread_tableaux");
}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT objectwrite_tableaux(f,a) FILE *f; OP a;
/* AK 210690 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	fprintf(f,"%ld ",(INT)S_O_K(a));
	erg += objectwrite(f,S_T_U(a));
	erg += objectwrite(f,S_T_S(a));
	ENDR("objectwrite_tableaux");
}
#endif /* TABLEAUXTRUE */


#ifdef TABLEAUXTRUE
INT b_matrix_tableaux(mat,tab) OP mat,tab;
/* AK 010988 */ /* AK 010889 V1.1 */ /* AK 200891 V1.3 */
	{
	OP u = callocobject(); 
	INT erg = OK;
	if (not MATRIXP(mat))
		WTO("b_matrix_tableaux",mat);
	if (check_equal_2(mat,tab,b_matrix_tableaux,&erg) == EQUAL)
		goto endr_ende;

	erg += m_matrix_umriss(mat,u); 
	erg += b_us_t(u,mat,tab);
	if (mat == tab)
		FATALERROR("b_matrix_tableaux");

	ENDR("b_matrix_tableaux");
	}
#endif  /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT m_matrix_tableaux(mat,tab) OP mat,tab;
/* AK 010988 */ /* AK 010889 V1.1 */ /* AK 200891 V1.3 */
	{
	OP u = callocobject(); 
	INT erg = OK;
	if (not MATRIXP(mat))
		WTO("m_matrix_tableaux",mat);
	if (check_equal_2(mat,tab,m_matrix_tableaux,&erg) == EQUAL)
		goto mte;

	erg += m_matrix_umriss(mat,u); 
	erg += m_us_t(u,mat,tab);
	erg += SYMfreeall(u);
	if (mat == tab)
		FATALERROR("m_matrix_tableaux");
mte:
	ENDR("m_matrix_tableaux");
	}
#endif  /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT m_matrix_umriss(mat,umr) OP mat,umr;
/* AK 080688 */
/* aus einer matrix, welche tableaux ist , wird der umriss berechnet */
/* AK 010989 V1.0 */ /* AK 110790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT i,j,k,schalter;
	INT erg = OK;

	if (not MATRIXP(mat))
		{
		 WTO("m_matrix_umriss",mat);
		goto endr_ende;
		}

	if (not (EMPTYP(umr)) ) 
		erg += freeself(umr);
	/* zuerst die laenge der partition */
	for (i=0L;i<S_M_HI(mat);i++) 
		if (EMPTYP(S_M_IJ(mat,i,0L))) break;

	if (i==0L) {
		/* SKEWPARTITION */
		/* AK 110790 V1.1 */
		OP a = callocobject(), b = callocobject();
		erg += m_il_v(S_M_HI(mat),a); 
		erg += m_il_v(S_M_HI(mat),b);
		for (i=0L;i<S_M_HI(mat); i++)
		{
		schalter = 0L;
		for (j=0L;j<S_M_LI(mat); j++)
			{
			if (schalter == 0L) {
				/* noch im linken leeren teil */
				if (not EMPTYP(S_M_IJ(mat,i,j))) {
					M_I_I(j,S_V_I(b,i));
					schalter=1L;
					}
				else if (j == S_M_LI(mat)-1L) {
					/* d.h. am ende */
					M_I_I(S_M_LI(mat),S_V_I(a,i));
					M_I_I(S_M_LI(mat),S_V_I(b,i));
					}
				}
			if (schalter == 1L) {
				/* im teil mit eintraegen */
				if (EMPTYP(S_M_IJ(mat,i,j))) {
					M_I_I(j,S_V_I(a,i));
					schalter=2L;
					}
				else
				if (j == S_M_LI(mat)-1L) {
					/* d.h. am ende */
					M_I_I(S_M_LI(mat),S_V_I(a,i));}
				}
			else
			if (schalter == 2L) {
				if (not EMPTYP(S_M_IJ(mat,i,j))) {
					SYMfreeall(a); SYMfreeall(b);
					debugprint(mat);
					return
					 error("m_matrix_umriss:no MATRIX");
					}
				}
			}
		}
		for (i=S_M_HI(mat)-1L; i>=0L; i--)
			{
			if (S_V_II(b,i) == S_M_LI(mat)) 
				{
				M_I_I(0L,S_V_I(b,i));
				M_I_I(0L,S_V_I(a,i));
				}
			else    break;
			}
		/* nun sind die nullen am ende */
		/* das umdrehen */ 
		erg += b_gk_spa(callocobject(),callocobject(),umr);
		erg += m_v_pa(a,S_SPA_G(umr)); 
		erg += m_v_pa(b,S_SPA_K(umr));
		erg += SYMfreeall(a);
		erg += SYMfreeall(b); 
		goto endr_ende;
		}

	erg += b_ks_pa(VECTOR,callocobject(),umr); 
	erg += m_il_v(i,S_PA_S(umr));
	/* die laenge wurde berechnet */

	k = S_M_LI(mat);
	for (i=0L;i<S_PA_LI(umr);i++)
		{
		for (j=0L;j<S_M_LI(mat);j++) 
			if (EMPTYP(S_M_IJ(mat,i,j))) break;
		if (j==0L) 
			{
			erg += error("0 in m_matrix_umriss");
			goto endr_ende;
			}
		if (j > k)
			{
			erg += error("m_matrix_umriss:no partition shape");
			goto endr_ende;
			}
		M_I_I(j,S_PA_I(umr,S_PA_LI(umr)-1-i));
		k = j;
		};
	ENDR("m_matrix_umriss");
	}
#endif  /* TABLEAUXTRUE */


#ifdef TABLEAUXTRUE
INT tex_tableaux(a) OP a;
/* AK 060588 */ /* AK 230790 V1.1 */
/* AK 070291 V1.2 prints to texout */ /* AK 200891 V1.3 */
	{
	INT i,j;
	if (S_O_K(S_T_U(a)) != PARTITION) /* AK 310892 */
		{
		return error("tex_tableaux: only for PARTITION shape");
		}
	fprintf(texout,"\\hbox { \\vbox {\n");
	for (i=0L; i< S_PA_LI(S_T_U(a)); i++)
			{
			fprintf(texout,"\\hrule width %dpt\n",
				S_PA_II(S_T_U(a),i)*13-1L);
			fprintf(texout,"\\vskip 0pt\n\\hbox {\n");
			for (j=0L; j< S_PA_II(S_T_U(a),i); j++)
				{
				fprintf(texout,
					"\\kern -3.5pt\n\\hbox to 13pt{");
				fprintf(texout,"\\vrule height10pt depth3pt$");
/* s_t_iji statt S_T_IJI */
			if (s_t_iji(a,S_PA_LI(S_T_U(a))-1-i,j) < 10L)
				fprintf(texout,"\\ %d",
/* s_t_iji statt S_T_IJI */
					s_t_iji(a,S_PA_LI(S_T_U(a))-1-i,j));
/* s_t_iji statt S_T_IJI */
			else if (s_t_iji(a,S_PA_LI(S_T_U(a))-1-i,j) < 100L)
				fprintf(texout,"%d",
/* s_t_iji statt S_T_IJI */
					s_t_iji(a,S_PA_LI(S_T_U(a))-1-i,j));
			else return
			error("tex_tableaux:entry too big in tableaux");
					
				fprintf(texout,
					"$ \\vrule height10pt depth3pt}\n");
				}
			fprintf(texout,"}\n\\vskip 0pt\n");
			if (i== S_PA_LI(S_T_U(a)) -1L)
			fprintf(texout,
			"\\hrule width %dpt\n",S_PA_II(S_T_U(a),i)*13-1L);
			}

	fprintf(texout,"} } ");
	return(OK);
	}
#endif  /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT comp_tableaux(a,b)	OP a,b;
/* AK 060588 */ /* AK 281289 V1.1 */ /* AK 200891 V1.3 */
	{
	return(comp(S_T_S(a),S_T_S(b)));
	}
#endif  /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT inc_tableaux(tab) OP tab;
/* AK 250488 */ /* AK 291289 V1.1 */ /* AK 200891 V1.3 */
	{
	OP b=callocobject(); /* die neue matrix */

	OP a = S_T_S(tab);

	INT i,j;
	INT erg = OK;


	erg += m_ilih_m(S_M_LI(a)+1,S_M_HI(a)+1,b);

	for (i=0L;i<S_M_HI(a);i++)
		for (j=0L;j<S_M_LI(a);j++)
			{
			C_O_S(S_M_IJ(b,i+1L,j),S_O_S(S_M_IJ(a,i,j)));
			C_O_K(S_M_IJ(b,i+1L,j),S_O_K(S_M_IJ(a,i,j)));
			}
	erg += SYMfreeall(S_M_H(a)); 
	erg += SYMfreeall(S_M_L(a));
	*a = *b;
	ENDR("inc_tableaux");
	}
#endif /* TABLEAUXTRUE */




#ifdef TABLEAUXTRUE
INT weight_tableaux(a,b) OP a,b;
/* AK 170790 V1.1 */ /* AK 200891 V1.3 */
	{
	return weight(S_T_U(a),b);
	}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
#define co_co_fpt \
		if (S_O_K(S_T_U(a)) == PARTITION)\
			if (i >= S_T_ULI(a)) continue;\
		if (S_O_K(S_T_U(a)) == SKEWPARTITION)\
			if (i >= S_T_UGLI(a)) continue;\
\
                fprintf(fp,"\n");\
                if (fp == stdout) zeilenposition = 0L;\
                schalter=1L;\
                for (j=0L; j<S_T_LI(a); j++)\
                        if (EMPTYP(S_T_IJ(a,i,j)))\
                                {\
                        if (schalter==2L)/*fprintf(fp,"  ")*/;\
                        else if (schalter==1L)fprintf(fp,"# ");\
                                }\
                        else {\
                                schalter=2L;\
                                fprint(fp,S_T_IJ(a,i,j));\
                                fprintf(fp," ");\
                                }\

INT fprint_tableaux(fp,a) FILE *fp; OP a;
/* AK 020488 */ /* AK 281289 V1.1 */ /* AK 200891 V1.3 */
	{
	INT i,j,schalter;
	INT erg = OK;
	CTO(TABLEAUX,"fprint_tableaux",a);
	if (english_tableau != TRUE)
		{
		for (i=S_T_HI(a)-1L;i >= 0L; i--)
			{
			co_co_fpt
			};
		}
	else
		{
		for (i=0L; i < S_T_HI(a);i++)
			{
			co_co_fpt
			};
		}
/*
		if (S_O_K(S_T_U(a)) == PARTITION) 
			if (i >= S_T_ULI(a)) continue;
		if (S_O_K(S_T_U(a)) == SKEWPARTITION) 
			if (i >= S_T_UGLI(a)) continue;

		fprintf(fp,"\n");
		if (fp == stdout) zeilenposition = 0L;
		schalter=1L;
		for (j=0L; j<S_T_LI(a); j++)
			if (EMPTYP(S_T_IJ(a,i,j))) 
				{
			if (schalter==2L)fprintf(fp,"  ");
			else if (schalter==1L)fprintf(fp,"# ");
				}
			else {
				schalter=2L;
				fprint(fp,S_T_IJ(a,i,j));
				fprintf(fp," ");
				}
*/
	fprintf(fp,"\n");
	ENDR("fprint_tableaux");
	}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
OP s_t_s(a) OP a; 
/* AK 200891 V1.3 */
	{ 
	OBJECTSELF c; 
	c = s_o_s(a); 
	return(c.ob_tableaux->t_self); 
	}

OP s_t_u(a) OP a; 
/* AK 200891 V1.3 */
	{
	OBJECTSELF c;
	c=s_o_s(a); 
	return(c.ob_tableaux->t_umriss); 
	}

OP s_t_ug(a) OP a; 
/* AK 200891 V1.3 */
	{ return(s_spa_g(s_t_u(a))); }

OP s_t_l(a) OP a; 
/* AK 200891 V1.3 */
	{ return(s_m_l(s_t_s(a))); }

INT s_t_li(a) OP a; 
/* AK 200891 V1.3 */
	{ return(s_m_li(s_t_s(a))); }

INT s_t_hi(a) OP a; 
/* AK 200891 V1.3 */
	{ return(s_m_hi(s_t_s(a))); }

INT s_t_iji(a,i,j) OP a;INT i,j; 
/* AK 200891 V1.3 */
	{ return(s_i_i(s_t_ij(a,i,j))); }

OP s_t_ij(a,i,j) OP a;INT i,j; 
/* AK 200891 V1.3 */
	{ return(s_m_ij(s_t_s(a),i,j)); }

OP s_t_h(a) OP a; 
/* AK 200891 V1.3 */
	{ return(s_m_h(s_t_s(a))); }

INT c_t_s(a,b) OP a,b; 
/* AK 200891 V1.3 */
	{ OBJECTSELF c; c = s_o_s(a); c.ob_tableaux->t_self = b;
	return(OK); }

INT c_t_u(a,b) OP a,b;
/* AK 200891 V1.3 */
	{ OBJECTSELF c; c = s_o_s(a); c.ob_tableaux->t_umriss = b; return(OK); }

OP s_t_uk(a) OP a; 
/* AK 200891 V1.3 */
	{ return(s_spa_k(s_t_u(a))); }

OP s_t_us(a) OP a; 
/* AK 200891 V1.3 */
	{ return(s_pa_s(s_t_u(a))); }

OP s_t_ui(a,i) OP a;INT i; 
/* AK 200891 V1.3 */
	{ return(s_pa_i(s_t_u(a),i)); }

INT s_t_uii(a,i) OP a;INT i; 
/* AK 200891 V1.3 */
	{ return(s_pa_ii(s_t_u(a),i)); }

INT s_t_ukii(a,i) OP a;INT i; 
/* AK 200891 V1.3 */
	{ return(s_spa_kii(s_t_u(a),i)); }

INT s_t_ukli(a) OP a; 
/* AK 200891 V1.3 */
	{ return(s_spa_kli(s_t_u(a))); }

INT s_t_ugii(a,i) OP a;INT i; 
/* AK 200891 V1.3 */
	{ return(s_spa_gii(s_t_u(a),i)); }

INT s_t_ugli(a) OP a; 
/* AK 200891 V1.3 */
	{ return(s_spa_gli(s_t_u(a))); }
#endif

#ifdef TABLEAUXTRUE
INT inhalt_tableaux(a,inhalt) OP a,inhalt;
/* 250488 berechnet inhalt i von tableaux a */
/* AK 230790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT i,j,an,en;
	INT erg = OK;

	m_il_nv(1L,inhalt);

	for (i=S_T_HI(a)-1L;i>=0L;i--)
		{
		an = zeilenanfang(a,i);
		en = zeilenende(a,i);
		for (j=an;j<=en;j++)
			erg += inhaltcoroutine(S_T_IJI(a,i,j),inhalt);
		}
	ENDR("inhalt_tableaux");
	}
#endif /* TABLEAUXTRUE */


#ifdef TABLEAUXTRUE
static INT inhaltcoroutine(zahl,inhalt) INT zahl; OP inhalt;
/* AK 230790 V1.1 */ /* AK 200891 V1.3 */
	{
	if (zahl <= S_V_LI(inhalt)) 
		inc(S_V_I(inhalt,zahl-1L));
	else {
		OP b=callocobject(); 
		INT k,m=S_V_LI(inhalt); 
		m_il_v(zahl,b);
		for (k=0L;k<m;k++)
			M_I_I(S_V_II(inhalt,k),S_V_I(b,k));
		for (k=m;k<zahl;k++)
			M_I_I(0L,S_V_I(b,k));
		M_I_I(1L,S_V_I(b,zahl-1L));
		freeself(inhalt);
		*inhalt =  *b;
		C_O_K(b,EMPTY);
		SYMfreeall(b);
		};
	return(OK);
	}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT scan_tableaux(a) OP a;
/* 020488 AK */ /* AK 010889 V1.1 */ /* AK 200691 V1.2 */ /* AK 200891 V1.3 */
	{
	INT i,j;
	char c[100];
	OP umriss = callocobject();

	printeingabe("(S)kewpartition or (P)artition for shape");
	scanf("%s",&c[0]);

	if (c[0] == 'P')
	{
	printeingabe("enter a tableau, shape is partition\n");
	scan(PARTITION,umriss);

	m_u_t(umriss,a);
	printeingabe("enter the tableau\n");
	for (i=0L; i<S_T_HI(a); i++)
		{ 
		sprintf(c,"row nr %d \n",(i+1L)); /* AK 020792 */
		printeingabe(c); /* AK 020792 */
		for (j=0L;j<S_PA_II(S_T_U(a),S_T_HI(a)-1-i);j++)
			scan(INTEGER,S_T_IJ(a,i,j)); 
		};
	}
	else if (c[0] == 'S')
	{
	INT k,m;
	printeingabe("enter a tableau, shape is skewpartition\n");
	scan(SKEWPARTITION,umriss);
	m_u_t(umriss,a);
	printeingabe("enter the tableau\n");
	m = S_T_UKLI(a); /* ab diesen index ist nur noch
					die groessere Partition */
	for (i=0L; i<S_T_HI(a); i++)
		{ 
/* s_t_ukii statt S_T_UKII */
		if (i<m) k=s_t_ukii(a,S_T_UKLI(a)-1-i);
		else k=0L;
				/* in spalte k wird eingetragen */
		sprintf(c,"row nr %d \n",(i+1L)); /* AK 020792 */
		printeingabe(c); /* AK 020792 */
		for (j=k;j<S_PA_II(s_t_ug(a),S_T_UGLI(a)-1-i);j++)
			scan(INTEGER,S_T_IJ(a,i,j)); 
		};
	}
	else /* AK 020792 */
		{
		return ERROR;
		}
	SYMfreeall(umriss);
	return(OK);
	}
#endif /* TABLEAUXTRUE */


#ifdef TABLEAUXTRUE
INT wordoftableaux(a,b) OP a,b;
/* AK 200891 V1.3 */
	{ 
	INT erg = OK;
	CTO(TABLEAUX,"wordoftableaux",a);
	erg +=  columnwordoftableaux(a,b);
	ENDR("wordoftableaux");
	}	



INT rowwordoftableaux(a,b) OP a,b;
/* berechnet das zu einem Tableaux gehoerende word */
/* MD p.70 */ /* AK 281289 V1.1 */ /* AK 200891 V1.3 */
	{
	OP l = callocobject();
	INT i,j,k;
	INT index=0L; /* der index im word */
	INT erg = OK;  /* AK 300792 */

	CTO(TABLEAUX,"rowwordoftableaux",a);

	erg += weight_tableaux(a,l);
	/* die laenge des wortes ist das gewicht des tableaus */

	erg += m_il_w(S_I_I(l),b);

	for (i=S_T_HI(a)-1L;i>=0L;i--) /*AK 300792 error in previous version*/
		{
		k = zeilenende(a,i);
		for(j=zeilenanfang(a,i);j<=k;j++)
			{ M_I_I(S_T_IJI(a,i,j),S_W_I(b,index));index++; }
			
		}
	erg += SYMfreeall(l); 
	ENDR("rowwordoftableaux");
	}



INT columnwordoftableaux(a,b) OP a,b;
/* berechnet das zu einem Tableaux gehoerende word */
/* AK 020290 V1.1 */ /* AK 200891 V1.3 */
	{
	OP l;
	INT i,j,k,erg=OK;
	INT index=0L; /* der index im word */

	l = callocobject();
	erg += weight_tableaux(a,l);
	/* die laenge des wortes ist das gewicht des tableaus */

	erg += m_il_w(S_I_I(l),b);

	for (j=0L;j<S_T_LI(a);j++)
		{
		k = spaltenanfang(a,j);
		for(i=spaltenende(a,j);i>=k;i--)
			{ M_I_I(S_T_IJI(a,i,j),S_W_I(b,index));index++; }
			
		}
	erg += SYMfreeall(l); 
	ENDR("columnwordoftableaux");
	}


INT spaltenanfang(a,b) OP a; INT b;
/* AK 020290 V1.1 */ /* AK 180691 V1.2 */ /* Ak 200891 V1.3 */
{
	OP z = S_T_U(a);
	INT j;
	if (b <0L) 
		return error("spaltenanfang:index < 0");
	if (S_O_K(z) == PARTITION) 
		{
		if (b >= S_PA_II(z,S_PA_LI(z)-1L)) return(S_T_HI(a));
		else return(0L);
		}
	else if (S_O_K(z) == SKEWPARTITION)
		{
/* s_t_ugii statt S_T_UGII */
		if (b >= s_t_ugii(a,S_T_UGLI(a)-1L)) return(S_T_HI(a));
/* s_t_ukii statt S_T_UKII */
		else if (b>=s_t_ukii(a,S_T_UKLI(a)-1L)) return(0L);
		else 
			{
			for (j=S_T_UKLI(a)-1L;j>=0L;j--) 
				if (S_T_UKII(a,j) <=  b) break;
			return(S_T_UKLI(a) - 1L - j);
			}
		}
	else error("spaltenanfang: wrong shape");
	return OK;
}

INT spaltenende(a,b) OP a; INT b;
/* AK 020290 V1.1 */ /* AK 180691 V1.2 */ /* Ak 200891 V1.3 */
{
	OP z = S_T_U(a);
	INT j;
	if (b <0L) 
		return error("spaltenende:index < 0");
	if (S_O_K(z) == PARTITION) 
		{
		if (b >= S_PA_II(z,S_PA_LI(z)-1L)) return(-1L);
		else {
			for (j=S_PA_LI(z)-1L;j>=0L;j--) 
				if (S_PA_II(z,j) <=  b) break;
			return(S_PA_LI(z) - 2L - j);
		     }
		}
	else if (S_O_K(z) == SKEWPARTITION)
		{
/* s_t_ugii statt S_T_UGII */
		if (b >= s_t_ugii(a,S_T_UGLI(a)-1L)) return(-1L);
		else {
			for (j=S_T_UGLI(a)-1L;j>=0L;j--) 
				if (S_T_UGII(a,j) <=  b) break;
			return(S_T_UGLI(a) - 2L - j);
		     }
		}
	else return error("spaltenende: wrong shape");
}

INT zeilenanfang(tab,zn) OP tab; INT zn;
/* AK 090688 */
/* gibt index ersten eintrag in zeile zn */
/* falls zn keine besetzte zeile ist, dann ist das ergebnis die breite der
matrix */
/* AK 281289 V1.1 */ /* AK 180691 V1.2 */ /* Ak 200891 V1.3 */
	{
	if (zn <0L) 
		return error("zeilenanfang:index < 0");
	if (S_O_K(S_T_U(tab)) == PARTITION) { /* ein tableau */
		if (zn < S_PA_LI(S_T_U(tab)) ) return(0L);
		else return(S_T_LI(tab));
		}
	else if (S_O_K(S_T_U(tab)) == SKEWPARTITION) /* ein schieftableau */
		{
		if (zn >=  S_T_UGLI(tab)) return(S_T_LI(tab));
		else if (zn >=  S_T_UKLI(tab)) return(0L);
/* s_t_ukii statt S_T_UKII */
		else return( s_t_ukii(tab,S_T_UKLI(tab)-zn-1L));
		}
	else {
		debugprint(tab);
		return error("zeilenanfang: wrong umriss");}
	}

INT zeilenende(tab,zn) OP tab; INT zn; 
/* letzter erlaubter index */
/* AK 281289 V1.1 */ /* AK 180691 V1.2 */ /* Ak 200891 V1.3 */
	{
	OP u = S_T_U(tab);
	if (zn <(INT)0) 
		return error("zeilenende:index < 0");
	if (S_O_K(u) == PARTITION) 
		{
		if (zn >= S_PA_LI(u)) return(-1L);
		else return(S_PA_II(u,S_PA_LI(u)-1L-zn) -1L);
		}
	else if (S_O_K(u) == SKEWPARTITION)
		{
		if (zn >=   S_T_UGLI(tab)) return(-1L);
/* s_pa_ii statt S_PA_II wg MSC */
		else return(s_pa_ii(s_t_ug(tab),S_T_UGLI(tab)-zn-1L)-1L);
		}
	else {
		debugprint(tab);
		return error("zeilenende: wrong umriss");}
	}

#endif /* TABLEAUXTRUE */

INT skewplane_plane(a,b) OP a,b;
/* AK 010889 */
/* Jeu de Taquin auf a wird b . a ist schiefplanepartition
 und wird eine planepartition b */
/* AK 010889 V1.1 */ /* Ak 200891 V1.3 */
	{
#ifdef TABLEAUXTRUE
	OP self = callocobject(); 
	OP umriss;
	OP unten,rechts;
	INT i,j; 
	INT posi,posj;  /* aktuelle position des jokers */
	INT nexti,nextj;  /* naechste position des jokers */
	INT si,sj; /* start of joker */

	copy (S_T_S(a),self);
m0108893: /* ein neues spiel */
	i = 0L;
	for (j=0L;j<S_M_LI(self);j++)
		if (not EMPTYP(S_M_IJ(self,i,j)))
			{
			if (j == 0L) goto m010889stop1; /* ende */
					/* man hat ein tableaux */


			/* spalte mit eintrag */
			j = j - 1L; 
			for (i=0L;i<S_M_HI(self);i++)
				if (not EMPTYP(S_M_IJ(self,i,j)))
					{ si=i-1L;sj=j;goto m0108891;}
			};
m0108891:	/* si,sj die position des jokers */
	posi = si; posj = sj;
m0108892: 	/* next step */
		/* nach richtung kleineres element, bei gleich nach unten */
	unten = NULL; rechts = NULL;
	if (posi+1 < S_M_HI(self)) /* joker nicht in unterste zeile */
		{
		unten = S_M_IJ(self,posi+1L,posj);
		if (EMPTYP(unten)) unten = NULL;
		};
	if (posj+1 < S_M_LI(self)) /* joker nicht in letzter spalte */
		{
		rechts = S_M_IJ(self,posi,posj+1L);
		if (EMPTYP(rechts)) rechts = NULL;
		};
	if ( (unten == NULL) && (rechts == NULL) ) 
		/* ende ein neues spiel */ goto m0108893;
	if ( (unten == NULL))  /* nach rechts */
		{ nexti = posi; nextj=posj+1L; }
	else if ( (rechts == NULL))  /* nach unten */
		{ nexti = posi+1L; nextj=posj; }
	else /* in beide richtungen ist noch ein eintrag */
		{
		if (gt(rechts,unten))
			{ nexti = posi; nextj=posj+1L; }
		else	{ nexti = posi+1L; nextj=posj; };
		};

	copy(S_M_IJ(self,nexti,nextj),S_M_IJ(self,posi,posj));
	freeself(S_M_IJ(self,nexti,nextj));
	posi=nexti; posj=nextj;
	goto m0108892; /* noch eine runde */
m010889stop1: /* wir sind fertig,aus der matrix wird ein tableau */
	umriss = callocobject(); 
	m_matrix_umriss(self,umriss);
	return b_us_t(umriss,self,b);
#else
	error("skewplane_plane:TABLEAUX not supported");
	return(ERROR);
#endif
	}




INT plane_tableau(a,b) OP a,b;
/* AK 010889 */
/* Jeu de Taquin auf a wird b . a ist planepartition
 und wird ein tableau b */
/* AK 010889 V1.1 */ /* AK 200891 V1.3 */
	{
#ifdef TABLEAUXTRUE
	OP self = callocobject(); 
	OP unten,rechts;
	INT startwert; 
	INT posi,posj;  /* aktuelle position des jokers */
	INT nexti,nextj;  /* naechste position des jokers */

	copy(a,b);
	copy (S_T_S(a),self);
n0108893: /* ein neues spiel */
n0108891:	/* si,sj die position des jokers */
	posi = 0L; posj = 0L;
	if (EMPTYP(S_M_IJ(self,posi,posj)))
		goto n010889stop1;
	startwert=S_M_IJI(self,posi,posj);
n0108892: 	/* next step */
		/* nach richtung kleineres element, bei gleich nach unten */
	unten = NULL; rechts = NULL;
	if (posi+1 < S_M_HI(self)) /* joker nicht in unterste zeile */
		{
		unten = S_M_IJ(self,posi+1L,posj);
		if (EMPTYP(unten)) unten = NULL;
		};
	if (posj+1 < S_M_LI(self)) /* joker nicht in letzter spalte */
		{
		rechts = S_M_IJ(self,posi,posj+1L);
		if (EMPTYP(rechts)) rechts = NULL;
		};
	if ( (unten == NULL) && (rechts == NULL) ) 
		/* ende ein neues spiel */ {
		freeself(S_M_IJ(self,posi,posj));
		M_I_I(startwert,S_T_IJ(b,posi,posj));
		goto n0108893; }
	if ( (unten == NULL))  /* nach rechts */
		{ nexti = posi; nextj=posj+1L; }
	else if ( (rechts == NULL))  /* nach unten */
		{ nexti = posi+1L; nextj=posj; }
	else /* in beide richtungen ist noch ein eintrag */
		{
		if (gt(rechts,unten))
			{ nexti = posi; nextj=posj+1L; }
		else	{ nexti = posi+1L; nextj=posj; };
		};

	copy(S_M_IJ(self,nexti,nextj),S_M_IJ(self,posi,posj));
	freeself(S_M_IJ(self,nexti,nextj));
	posi=nexti; posj=nextj;
	goto n0108892; /* noch eine runde */
n010889stop1: /* wir sind fertig */
	SYMfreeall(self);
	return(OK);
#else
	error("plane_tableau:TABLEAUX not supported");
	return(ERROR);
#endif
	}

#ifdef TABLEAUXTRUE
INT apply_INJDT(a,l,k,anz) OP a,l;INT k,anz;
/* a ist tableau, l ist liste, hier werden die ergebnisse eingefuegt */
/* k ist die mindestspalte */
/* AK 160790 V1.1 */ /* AK 200891 V1.3 */
{	
	OP b ;
	INT i,j,oj,obergrenze;
	if (anz == 0L) return OK;
	oj = S_T_LI(a)+1L;
	if (S_O_K(S_T_U(a)) == PARTITION) obergrenze=S_T_ULI(a);
	if (S_O_K(S_T_U(a)) == SKEWPARTITION) obergrenze=S_T_UGLI(a);
	for (i=0L; i<=obergrenze ; i++)
		{
		j=zeilenende(a,i)+1L; 
		if (j == -1L) break;
		if (j == oj) continue; /* keine ecke */
		if (j < k) continue;
		b = callocobject();
		inverse_nilplactic_jeudetaquin_tableaux(a,i,j,b);
		oj = j;
		if (anz == 1L)insert(b,l,NULL,NULL);
		else { apply_INJDT(b,l,j+1L,anz-1L); SYMfreeall(b); }
		}
	return OK;
}
#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
INT perm_tableaux(a,b) OP a,b;
/* a ist permutation
   b wird liste von tableaux, die reduzierte Zerlegung sind */
/* AK 230790 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	OP c;
	c= callocobject();
	erg += lehmercode(a,c);   /* c entahelt den lehmercode der permutation */
	erg += lehmercode_tableaux(c,b); /* b ist eine liste von tableaux, die red.
			zerlegung von a sind */
	erg += SYMfreeall(c); /* object c freigeben */
	ENDR("perm_tableaux");
}


INT lehmercode_tableaux(a,b) OP a,b;
/* a ist lehmercode
   b wird liste von tableaux, die reduzierte Zerlegung sind */
/* AK 230790 V1.1 */ /* AK 200891 V1.3 */
{
	INT i,j,za,k;
	OP zz,c,d,z,e;
	if (not EMPTYP(b)) 
		freeself(b); 
		/* b zum leeren object machen */
	for (i=0L; i<S_V_LI(a); i++) if (S_V_II(a,i) != 0L) break;
		/* i ist der erste index eines 
			eintrags ungleich 0 im lehmercode */
	if (i==S_V_LI(a)) return OK;  /* lehmercode == 0-Vektor */

	/* nun haben wir einen lehmercode mit inversionen */
	c = callocobject(); copy(a,c); M_I_I(0L,S_V_I(c,i)); 
	/* c ist der gleiche lehmercode wie a nur 
		mit einer 0 an der ersten stelle
	einer inversion */

	d = callocobject(); lehmercode_tableaux(c,d);
	init(SYMLIST,b); /* b ist list-object mit NULL self und next */
	if (EMPTYP(d)) {
		/* c war 0-Vektor */
		freeself(c);
		b_us_t(callocobject(),callocobject(),c);
		m_ilih_m(S_V_II(a,i),1L,S_T_S(c));
		for (j=0;j<S_T_LI(c);j++) M_I_I(j+1+i,S_T_IJ(c,0L,j));
		m_matrix_umriss(S_T_S(c),S_T_U(c));
		insert(c,b,NULL,NULL);
		SYMfreeall(d);
		return OK;
		}
	SYMfreeall(c);
	z=d;
	e = callocobject(); init(SYMLIST,e);
	while (z != NULL)
		{
		apply_INJDT(S_L_S(z),e,0L,S_V_II(a,i));
		z = S_L_N(z);
		}	
	SYMfreeall(d);
	/* jetzt muss diese liste durch sucht werden ob man in der untersten
	zeile einfuegen kann */
	z = e;
	while (z != NULL) 
		{
		zz = S_L_S(z);
		if (S_T_UKLI(zz) != 1L) freeself(zz);
	/* s_t_ukii statt S_T_UKII wg MSC */
	/* s_t_ugii statt S_T_UGII wg MSC */
		else if ( s_t_ukii(zz,S_T_UKLI(zz)-1L) == 
			  s_t_ugii(zz,S_T_UGLI(zz)-1L) ) 
			{
			za = S_V_II(a,i);
			for (j=S_V_II(a,i),k=1L;j>0L; j--,k++) 
				m_i_i(j+i,S_T_IJ(zz,0L,za-k));
			m_matrix_umriss(S_T_S(zz),S_T_U(zz));
			insert(zz,b,NULL,NULL);
			C_L_S(z,NULL);
			}
		else if (
			S_T_IJI(zz,0L,zeilenanfang(zz,0L)) <=
			S_V_II(a,i) + i + 1L
			)  freeself(zz);
		else {
			za = zeilenanfang(zz,0L);
			for (j=S_V_II(a,i),k=1L;j>0L; j--,k++) 
				m_i_i(j+i,S_T_IJ(zz,0L,za-k));
			m_matrix_umriss(S_T_S(zz),S_T_U(zz));
			insert(zz,b,NULL,NULL);
			C_L_S(z,NULL);
			}
		z = S_L_N(z);
		}
	SYMfreeall(e);
	return OK;
}




INT umriss_tableaux(a,b) OP a,b;
/* AK 300792 */
{
	if (S_O_K(a) != TABLEAUX)
		return ERROR;
	return copy(S_T_U(a),b);
}
#endif /* TABLEAUXTRUE */


#ifdef  TABLEAUXTRUE 
INT standardp(a) OP a;
/* AK 300792 */
/* true if weakly increasing in rows
        and strictly in columns */
{
	INT i,j;
	if (S_O_K(a) != TABLEAUX) 
		return FALSE;
	for (i=0L; i<S_T_HI(a); i++)
	for (j=0L; j<S_T_LI(a); j++)
		if (not EMPTYP(S_T_IJ(a,i,j)))
		{
			if (i>0L)
			if (not EMPTYP(S_T_IJ(a,i-1L,j)))
			if (S_T_IJI(a,i,j) <= S_T_IJI(a,i-1L,j)) 
				return FALSE;
			if (j>0L)
			if (not EMPTYP(S_T_IJ(a,i,j-1L)))
			if (S_T_IJI(a,i,j) < S_T_IJI(a,i,j-1L)) 
				return FALSE;
		}
	return TRUE;
}
#endif /* TABLEAUXTRUE */

#ifdef  TABLEAUXTRUE 
INT youngp(a) OP a;
/* AK 160992 */
{
	OP c;
	INT res;
	c = callocobject();
	inhalt(a,c);
	if (not einsp(c)) res=FALSE;
	else res=TRUE;
	SYMfreeall(c);
	return res;
}
#endif /* TABLEAUXTRUE */

#ifdef  TABLEAUXTRUE 
INT sort_rows_tableaux_apply(b) OP b;
/* AK 070295 */
{
	INT erg = OK;
	INT i,j,k;
	for (i=0;i<S_T_HI(b);i++)
		{
		k = zeilenanfang(b,i);
		j = zeilenende(b,i);
		
		qsort(S_T_IJ(b,i,k),j-k+1,sizeof(struct object),comp_integer);
		}
	ENDR("sort_rows_tableaux_apply");	
}
	

INT select_row_tableaux(a,i,b) OP a,b; INT i;
/* AK 280193 */
{
	INT za = zeilenanfang(a,i);
	INT ze = zeilenende(a,i);
	INT erg = OK;
	INT j;

	erg += freeself(b);
	if (za == S_T_LI(a)) 
		return OK; /* no entry in this row */
	erg += m_il_v(ze-za+1L,b);
	for (j=za; j <= ze; j++)
		copy(S_T_IJ(a,i,j), S_V_I(b, j-za));
	return erg;
}

INT select_column_tableaux(a,i,b) OP a,b; INT i;
/* AK 280193 */
{
	INT za = spaltenanfang(a,i);
	INT ze = spaltenende(a,i);
	INT erg = OK;
	INT j;

	erg += freeself(b);
	if (za == S_T_HI(a)) 
		return OK; /* no entry in this column */
	erg += m_il_v(ze-za+1L,b);
	for (j=za; j <= ze; j++)
		copy(S_T_IJ(a,j,i), S_V_I(b, j-za));
	return erg;
}

#endif /* TABLEAUXTRUE */

#ifdef TABLEAUXTRUE
#ifdef PERMTRUE
INT operate_perm_tableaux(b,a,c) OP a,b,c;
/* AK 110593 */
{
	INT i,j,erg=OK;
	CTO(TABLEAUX,"operate_perm_tableaux",a);
	CTO(PERMUTATION,"operate_perm_tableaux",b);
		
	if (S_P_K(b) != VECTOR)
		return ERROR;
	erg  += copy_tableaux(a,c);
	for (i=0L;i<S_T_HI(a);i++)
	for (j=0L;j<S_T_LI(a);j++)
	{
	if (not EMPTYP(S_T_IJ(a,i,j)))
		{
		if (S_T_IJI(a,i,j) <= S_P_LI(b))
			M_I_I(S_P_II(b,S_T_IJI(a,i,j)-1L), S_T_IJ(c,i,j));
		}
	}
	ENDR("operate_perm_tableaux");
}
#endif /* PERMTRUE */
#endif /* TABLEAUXTRUE */


#ifdef TABLEAUXTRUE
INT first_tableaux(a,b) OP a,b;
/* AK 040693 */ /* a is umriss */ /* b first tableau according lex order
on column word */
{
	INT erg = OK;
	INT i,j,k=1,sa,se;
	erg += m_u_t(a,b);
	for (j=0L;j<S_T_LI(b);j++)
		{
		sa = spaltenanfang(b,j); se=spaltenende(b,j);
		for (i=sa;i<=se;i++,k++)
			M_I_I(k,S_T_IJ(b,i,j));
		}
	
	ENDR("first_tableaux");
}

INT makevectoroftableaux(a,b,c) OP a,b,c;
/* AK 080295 */
{
        INT erg = OK;
        OP d,e;
	CTO(PARTITION,"makevectoroftableaux",a);
	CTO(PARTITION,"makevectoroftableaux",b);
        d = callocobject();
        e = callocobject();
	erg += weight_partition(a,d);
	erg += weight_partition(b,e);
	if (neq(d,e))
		{
		erg += error("makevectoroftableaux: different weight of input partitions");
		goto aa;
		}
	C2R(a,b,"makevectoroftableaux",c);
        erg += kostka_tab(a,b,d);
        erg += t_LIST_VECTOR(d,c);
	S2R(a,b,"makevectoroftableaux",c);
aa:
        erg += SYMfreeall(d);
        erg += SYMfreeall(e);
        ENDR("makevectoroftableaux");
}


INT ym_min(form,res) OP form,res;
{
	INT lg_part,i,j,db,ind;
	OP wght,form1;
	INT erg = OK;

	wght=callocobject();
	form1=callocobject();
	erg += conjugate(form,form1);
	erg += weight(form,wght);
	erg += m_l_v(wght,res);
	lg_part=S_PA_LI(form1);
	ind=0L;
	for(i=0L;i<lg_part;i++)
	{
		db=S_PA_II(form1,i)-1L;
		for(j=db;j>=0L;j--)
		{
			M_I_I(j,S_V_I(res,ind));
			ind++;
		}
	}
	erg += SYMfreeall(wght);
	erg += SYMfreeall(form1);
	ENDR("ym_min");
}




INT nxt_ym(ym1,ym2)	OP ym1,ym2;
{
	INT i,j,l,ind_max,av,pres,crt,tp,mem;
	char *tab;

	ind_max=S_V_LI(ym1)-1L; av=S_V_II(ym1,ind_max);
	for(i=ind_max-1L;i>=0L;i--)
	{
		pres=S_V_II(ym1,i);
		if(pres<av) break;
		av=pres;
	}
	if(i== -1L) return FALSE;
	if(ym1!=ym2)
	{
		m_il_v(ind_max+1L,ym2);
		for(j=0L;j<i;j++)
			M_I_I(S_V_II(ym1,j),S_V_I(ym2,j));
	}
	av=pres;tp=0L;
	while(tp<=0L)
	{
		tp=0L;av++;l=0L;
		for(j=ind_max;(j>i)&&(l<av+2L);j--)
		{
			l=S_V_II(ym1,j);
			if(l==av) tp++;
			else if(l==av+1L) tp--;
		}
	}

	tp=i; pres=S_V_II(ym1,i+1L);
	tab=(char *)SYM_calloc(pres+1L,1);
	for(;i<=ind_max;i++)
		(*(tab+S_V_II(ym1,i)))++;
	(*(tab+av))--;
	M_I_I(av,S_V_I(ym2,tp));
	crt=ind_max;i=0L;
	for(j=pres;j>0L;j--)
		for(;i<*(tab+j);i++)
			for(l=0L;l<=j;l++,crt--)
				M_I_I(l,S_V_I(ym2,crt));
	for(;crt>tp;crt--)
		M_I_I(0L,S_V_I(ym2,crt));
	SYM_free(tab);
	return(TRUE);
}


	
INT find_tab_entry(tab,b,i,j) OP tab,b; INT *i, *j;
/* place of b in tab */
/* FALSE if not */
{
INT k,l;
for (k=0;k<S_T_HI(tab);k++)
for (l=0;l<S_T_LI(tab);l++)
	if (eq(b,S_T_IJ(tab,k,l)))
		{ *i = k; *j = l; return TRUE; }
*i = -1; *j = -1; 
return FALSE;
}

INT word_tableaux(a,b) OP a,b;
{
	INT erg = OK;
	if (check_equal_2(a,b,word_tableaux,&erg) == EQUAL)
                goto se;
	erg += word_schen(a,b,NULL);
se:
	ENDR("word_tableaux");
}

INT word_schen(a,b,c) OP a,b,c;
{
        INT i;
	INT erg = OK;
        erg += freeself(b);
	if (c != NULL)
		erg += freeself(c);
	
        for (i=0;i<S_V_LI(a);i++)
                erg += schensted_row_insert_step(S_V_I(a,i),b,c);
        ENDR("word_schen");
}

INT schen_word(a,bb,cb) OP a,bb,cb;
{
        INT i;
	INT erg = OK;
	OP c,b;
	c = callocobject();
	b = callocobject();
	erg += copy(bb,b);
	erg += copy(cb,c);
        erg += weight(b,a);
        erg += m_il_w(S_I_I(a),a);
        for (i=S_V_LI(a)-1;i>=0;i--)
                {
                erg += schensted_row_delete_step(S_V_I(a,i),b,c);
                }
	erg += SYMfreeall(b);
	erg += SYMfreeall(c);
        ENDR("schen_word");
}

INT schensted_row_insert_step(rein,P,Q) OP rein,P,Q;
{
	INT erg = OK,i,j,k;
	OP c,z;
	c = callocobject();
	if (emptyp(P))  /* anfang */
		{
		m_ilih_m(10L,10L,c);
		if (Q != NULL)
			{
			m_i_i(1L,S_M_IJ(c,0,0));
			m_matrix_tableaux(c,Q);
			}
		copy(rein,S_M_IJ(c,0,0));
		b_matrix_tableaux(c,P);
		goto sk;
		}
	z = callocobject();
	i=0;copy(rein,z);
aa:
	k = zeilenende(P,i);
	for (j=0;j<=k;j++)
		if (lt(z,S_T_IJ(P,i,j))) break;
	if (j <= k)  /* d.h. im tableau */
		{
		if (
		(S_O_K(S_T_IJ(P,i,j)) == INTEGER) &&
		(S_O_K(z) == INTEGER)
		) {
			M_I_I(S_T_IJI(P,i,j),c);
			M_I_I(S_I_I(z),S_T_IJ(P,i,j));
			M_I_I(S_I_I(c),z);
			}
		else {
		copy(S_T_IJ(P,i,j),c);
		copy(z,S_T_IJ(P,i,j));
		copy(c,z);
		}
		i++;
		if (i == S_T_ULI(P))
			{
			/* neue zeile */
			j=0;
			goto kk;
			}
		else goto aa;
		}
	else /* anhaengen */
		{
kk:
		freeself(c);
		swap(S_T_S(P),c); 
		if ((i >= S_M_HI(c)) || (j>= S_M_LI(c)) )
			{
			inc(c);
			}
		if (i < S_T_ULI(P))
			{
			if (S_O_K(z) == INTEGER)
				M_I_I(S_I_I(z),S_M_IJ(c,i,j));
			else
				copy(z,S_M_IJ(c,i,j));
			INC_INTEGER(S_T_UI(P,S_T_ULI(P)-1-i));
			swap(S_T_S(P),c); 
			SYMfreeall(c); /* AK 130297 */
			}
		else {
			copy(z,S_M_IJ(c,i,j));
			b_matrix_tableaux(c,P);
			}
		if (Q == NULL)
			{
			SYMfreeall(z);
			goto sk; /* nicht freigeben */
			}
		weight(Q,z); k = S_I_I(z); /* gewicht */
		freeself(z);
		swap(S_T_S(Q),z);
		if ((i >= S_M_HI(z)) || (j>= S_M_LI(z)) )
			{
			inc(z);
			}
		if (i < S_T_ULI(Q))
			{
			M_I_I(k+1,S_M_IJ(z,i,j));
			INC_INTEGER(S_T_UI(Q,S_T_ULI(Q)-1-i));
			swap(S_T_S(Q),z); 
			SYMfreeall(z);
			}
		else {
			m_i_i(k+1,S_M_IJ(z,i,j));
			b_matrix_tableaux(z,Q);
			}
		goto sk;
		}
se:
	SYMfreeall(z);
sc:
	SYMfreeall(c);
sk:
	ENDR("schensted_row_insert_step");
}

INT schensted_row_delete_step(raus,P,Q) OP raus,P,Q;
{
	INT i,j,l,m,k,erg = OK;
	OP c;
	if (S_T_ULI(P) == 1)
		{
		i = zeilenende(P,0);
		erg += copy(S_T_IJ(P,0L,i),raus);
		if (i==0) {
			erg += freeself(P);
			erg += freeself(Q);
			goto sre;
			}
		erg += dec(S_T_UI(P,0));
		erg += dec(S_T_UI(Q,0));
		erg += freeself(S_T_IJ(P,0L,i));
		erg += freeself(S_T_IJ(Q,0L,i));
		goto sre;
		}
	/* richtiges tableau */
	c = callocobject();
	weight(Q,c);
	find_tab_entry(Q,c,&i,&j);
	if (i == -1) error("internal error:");	
	copy(S_T_IJ(P,i,j),c);
	freeself(S_T_IJ(P,i,j));
	freeself(S_T_IJ(Q,i,j));
	for (l=i-1;l>=0;l--)
		{
		i = zeilenende(P,l);
		for (k=0;k<= i;k++)
			if (ge(S_T_IJ(P,l,k),c)) break;
		k--;
		/* nun an k setzen */
		swap(S_T_IJ(P,l,k),c);
		}
	copy(c,raus);
	copy(S_T_S(P),c);
	m_matrix_tableaux(c,P);
	copy(S_T_S(Q),c);
	b_matrix_tableaux(c,Q);
	sre:
	ENDR("schensted_row_delete_step");
}
                      
INT all_plactic_word(w,c) OP w,c;
/* AK 211195 */
/* enter a word return all plactic equivalent words */
/* using Schensted */
{
        OP a,b,d;
        INT i, erg = OK;
        a = callocobject();
        b = callocobject();
        d = callocobject();
        erg += word_schen(w,a,b);
        erg += last_partition(S_V_L(w),b);
        erg += kostka_tab(S_T_U(a),b,d);
        erg += t_LIST_VECTOR(d,b);
        erg += m_il_v(S_V_LI(b),c);
        for (i=0;i<S_V_LI(b);i++)
                {
                erg += schen_word(S_V_I(c,i),a,S_V_I(b,i));
                }
        erg += SYMfreeall(a);
        erg += SYMfreeall(b);
        erg += SYMfreeall(d);
        ENDR("all_plactic_word");
}
#endif /* TABLEAUXTRUE */

