#include "def.h"
#include "macro.h"

#ifdef WTTRUE
/* AK 181188 */
/* routinen fuer den uebergang
vom diagramm (einer permutation)
zum  monom 

bsp : 4 3 5 2 1 --->


 0
 x 0
 x x     0
 x x 0
 x x x 0


anhand dieser kreuze erhaelt man das monom

a^3 b^2 c^2 d^1

*/


static INT co090889linien();
static INT co090889linien_sn();
static INT co090889linien_sk();
static INT co090889linien_co();
static INT co090889();
static INT co090889_co();
static INT co090889_sn();
static INT co090889_sk();
static INT co_150895();
static INT all_sk_weintrauben();
static INT all_sd_weintrauben();
static INT all_sn_weintrauben();

INT weintraube_monom(a,b) OP a,b;
/* AK 181188
a ist eine weintraube
b wird ein monom */
/* AK 100691 V1.2 */ /* AK 210891 V1.3 */
	{
	INT erg=OK;
	erg += b_skn_po(callocobject(),callocobject(),NULL,b);
	erg += weintraube_vector(a,S_PO_S(b));
	erg += m_i_i(1L,S_PO_K((b))); 
	ENDR("weintraube_monom");
	}


INT weintraube_vector(a,b) OP a,b;
/* AK 181188 a ist eine weintraube
b wird vector der zeilensummen von unten nach oben */ 
/* AK 210891 V1.3 */
	{
	INT i,j,k;
	INT erg = OK;

	erg += m_il_v(S_M_HI(a),b);
	for (i=(INT)0; i<S_M_HI(a); i++)
		{
		k=(INT)0;
		for (j=(INT)0; j<S_M_LI(a); j++)
			if (not nullp(S_M_IJ(a,i,j)))
				if (einsp(S_M_IJ(a,i,j))) k++;
				else    {
					erg += fprintln(stderr,a);
					erg += error("weintraube_monom:wrong content");
					}
		erg += m_i_i(k,S_V_I(b,S_M_HI(a)-1L-i));
		}
	ENDR("weintraube_vector");
	}

INT all_weintrauben(a,b,c) OP a,b,c;
/* AK 181188
a ist weintraube                         b ist zugehoeriger vector
c ist ergebnisliste von weintrauben,darin
sollen alle sein, die aus a folgen, incl. a */
	{
	INT i,j,k,l;
	INT  erg;
	OP m;

	m = callocobject(); 
	copy_matrix(a,m);
	erg = insert(m,c,NULL,NULL); 
		/* bei eq keine einfuegung, normaler vergleich*/

	for (i=(INT)0;i < S_V_LI(b); i++)
		{
		k = S_V_II(b,i);
		if (k == (INT)0) continue;

		for (j=S_M_LI(a)-1L; j>=(INT)0; j--)
			if (not nullp(S_M_IJ(a,S_M_HI(a)-1L-i,j))) break;
		if (j== -1L) {
			fprintln(stderr,b); fprintln(stderr,a);
			error("all_weintrauben:wrong vector");
			}

		/* j ist nun spaltenadresse des letzten eintrages */
		/* jetzt gucken ob dieser runter kann */

	    for (l=(INT)0; i-l > (INT)0; l++)
		if (nullp(S_M_IJ(a,S_M_HI(a)-i+l,j))) /* kann nach unten */
			{
			OP d = callocobject(); 
			OP e = callocobject();  /* neue vector */
			copy_matrix(a,d);
			m_i_i(1L,S_M_IJ(d,S_M_HI(d)-i+l,j));
			m_i_i((INT)0,S_M_IJ(d,S_M_HI(d)-i-1L,j));
			/* noch den vector manipulieren */
			copy_vector(b,e);
			INC_INTEGER(S_V_I(e,i-1L-l));
			DEC_INTEGER(S_V_I(e,i));
			all_weintrauben(d,e,c); /* rekursion */
			SYMfreeall(e); SYMfreeall(d); break;
			} /* schleife ueber zeilen 
			  interhalb der aktuellen zeile */
			  /* d.h. schauen wieviel kaestchen nach unten kommen */

	    if (l == (INT)0) continue;
		} /* ende schleife ueber zeilen */

	return(OK);
	}

INT weintrauben_polynom(a,b) OP a,b;
/* AK 181188 wandelt weintraubenliste a um in polynom b */
/* AK 291289 V1.1 */ /* AK 210891 V1.3 */
	{
	OP z = a;
	INT erg = OK;

	if (not EMPTYP(b)) 
		erg += freeself(b);
	while (z != NULL)
		{
		OP p = callocobject(); 
		erg += weintraube_monom(S_L_S(z),p);
		insert(p,b,NULL,NULL);
		z = S_L_N(z);
		}
	ENDR("weintrauben_polynom");
	}

INT pol_sn_wt(a,b) OP a,b;
/* AK 240895 */
/* polynom aus startweintraube */
{
	INT erg = OK;
	OP c = callocobject();
	erg += Sn_wt(a,c);
	erg += weintrauben_polynom(c,b);
	erg += SYMfreeall(c);
	ENDR("pol_sn_wt");
}
INT pol_sd_wt(a,b) OP a,b;
/* AK 100691 V1.2 */ /* AK 210891 V1.3 */
/* polynom aus startweintraube */
{
	INT erg = OK;
	OP c = callocobject();
	erg += Sd_wt(a,c);
	erg += weintrauben_polynom(c,b);
	erg += SYMfreeall(c);
	ENDR("pol_sd_wt");
}

INT pol_wt(a,b) OP a,b;
/* AK 100691 V1.2 */ /* AK 210891 V1.3 */
/* polynom aus startweintraube */
{
	INT erg = OK;
	OP c = callocobject();
	erg += S_wt(a,c);
	erg += weintrauben_polynom(c,b);
	erg += SYMfreeall(c);
	ENDR("pol_wt");
}

INT t_POLYNOM_T(a,b) OP a,b;
/* AK 100691 V1.2 */ /* AK 210891 V1.3 */
{
	OP c,d,e;
	INT erg = OK;
	if (not EMPTYP(b)) erg += freeself(b);
	c = callocobject();
	erg += copy(a,c);
	e = callocobject();
	while (not nullp(c))
		{
		d = callocobject();
		m_skn_po(S_PO_S(c),S_PO_K(c),NULL,d);
		erg += m_T_pol_summe( S_PO_S(c),e);
		mult_apply(S_PO_K(c),e);
		erg += sub(c,e,c);
		insert(d,b,NULL,NULL);
		}	
	erg += SYMfreeall(e);
	erg += SYMfreeall(c);
	ENDR("t_POLYNOM_T");
}


INT sn_weintraube(d,b) OP d,b;
/* AK 240895 */
/* start weintraube fuer sn moves */
{
	INT i,j,k=(INT)0,erg=OK;
	OP a = callocobject();
	lehmercode(d,a);
	erg += m_ilih_m(S_V_LI(a)-1,S_V_LI(a)-1,b);
	for (i=(INT)0;i<S_M_HI(b);i++)
		for (j=(INT)0;j<S_M_LI(b);j++)
			erg += m_i_i(((j<S_V_II(a,i)) ? 1L : (INT)0),
					S_M_IJ(b,S_M_HI(b)-1L-i,j));
	erg += SYMfreeall(a);
	ENDR("sn_weintraube");
}

INT T_weintraube(a,b) OP a,b;
/* AK 100691 V1.2 */ /* AK 210891 V1.3 */
{
	INT i,j,k=(INT)0,erg=OK;
	if (S_O_K(a) != VECTOR)
		return error("T_weintraube:a not VECTOR");
	for (i=(INT)0; i<S_V_LI(a); i++)
		if (S_V_II(a,i) > k) k = S_V_II(a,i);
	erg += m_ilih_m(k,S_V_LI(a),b);
	for (i=(INT)0;i<S_M_HI(b);i++)
		for (j=(INT)0;j<S_M_LI(b);j++)
			erg += m_i_i(((j<S_V_II(a,i)) ? 1L : (INT)0),
					S_M_IJ(b,S_M_HI(b)-1L-i,j));
	ENDR("T_weintraube");
}

INT m_T_pol_summe(a,b) OP a,b;
/* AK 100691 V1.2 */ /* AK 210891 V1.3 */
{
	INT erg = OK;
	OP d=callocobject();
	erg += T_weintraube(a,d);
	erg += pol_wt(d,b);
	erg += SYMfreeall(d);
	ENDR("m_T_pol_summe");
}

INT m_T_wt_summe(a,b) OP a,b;
/* AK 100691 V1.2 */ /* AK 210891 V1.3 */
/* nicht kommutative T_I */
{
	INT erg = OK;
	OP d=callocobject();
	erg += T_weintraube(a,d);
	erg += S_wt(d,b);
	erg += SYMfreeall(d);
	ENDR("m_T_wt_summe");
}

INT m_T_tableaux_summe(a,b) OP a,b;
/* AK 100691 V1.2 */ /* AK 210891 V1.3 */
	{
	OP d=callocobject();
	OP c,z;
	INT erg = OK;
	erg += b_sn_l(NULL,NULL,b);
	erg += m_T_wt_summe(a,d);
	z = d;
	while (z != NULL)
		{
		c = callocobject();
		erg += m_wt_tableaux(S_L_S(z),c);	
		erg += insert(c,b,NULL,NULL);
		z = S_L_N(z);
		}
	erg += SYMfreeall(d); 
	ENDR("m_T_tableaux_summe");
	}

INT m_perm_snwt_summe(a,b) OP a,b;
/* AK 240895 zu einer permutation alle weintrauben mittels sn Operation */
	{
	INT erg = OK;
	OP d=callocobject();
	erg += sn_weintraube(a,d);
	erg += Sn_wt(d,b);
	erg += SYMfreeall(d);
	ENDR("m_perm_sdwt_summe");
	}

INT m_perm_sdwt_summe(a,b) OP a,b;
/* AK 240895 zu einer permutation alle weintrauben mittels sd Operation */
	{
	INT erg = OK;
	OP d=callocobject();
	erg += perm_weintraube(a,d);
	erg += Sd_wt(d,b);
	erg += SYMfreeall(d);
	ENDR("m_perm_sdwt_summe");
	}

INT m_perm_skwt_summe(a,b) OP a,b;
/* AK 240895 zu einer permutation alle weintrauben mittels sk Operation */
	{
	INT erg = OK;
	OP d=callocobject();
	erg += perm_weintraube(a,d);
	erg += Sk_wt(d,b);
	erg += SYMfreeall(d);
	ENDR("m_perm_skwt_summe");
	}


INT m_perm_wt_summe(a,b) OP a,b;
/* AK 090889 zu einer permutation alle weintrauben */
/* AK 290591 V1.2 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	OP d=callocobject();
	erg += perm_weintraube(a,d);
	erg += S_wt(d,b);
	erg += SYMfreeall(d);
	ENDR("m_perm_wt_summe");
	}

INT m_perm_tableaux_summe(a,b) OP a,b;
/* AK 281289 V1.1 */ /* AK 100691 V1.2 */ /* AK 210891 V1.3 */
/* berechnet zu einer permutation alle tableaux des schubert pol */
	{
	OP d=callocobject();
	OP c;
	OP z;
	INT erg = OK;
	erg += b_sn_l(NULL,NULL,b);
	erg += m_perm_wt_summe(a,d);
	z = d;
	while (z != NULL)
		{
		c = callocobject();
		erg += m_wt_tableaux(S_L_S(z),c);	
		insert(c,b,NULL,NULL);
		z = S_L_N(z);
		}
	erg += SYMfreeall(d); 
	ENDR("m_perm_tableaux_summe");
	}

INT tab_wt(a,b) OP a,b;
/* tableaux fuer weintrauben */
{
	OP z,c,d;
	INT erg = OK;
	erg += m_sn_l(NULL,NULL,b);

	d=callocobject();
	erg += S_wt(a,d);
	z = d;
	while (z != NULL)
		{
		c = callocobject();
		erg += m_wt_tableaux(S_L_S(z),c);	
		insert(c,b,NULL,NULL);
		z = S_L_N(z);
		}
	erg += SYMfreeall(d); 
	ENDR("tab_wt");
}

INT Sk_wt(a,b) OP a,b;
/* AK 190397 zu einer weintraube alle weintrauben */
/* operation mittels sk */
	{
	INT erg = OK;
	erg += b_sn_l(NULL,NULL,b);
	erg += all_sk_weintrauben(a,b);
	ENDR("Sk_wt");
	}

INT Sn_wt(a,b) OP a,b;
/* AK 240895 zu einer weintraube alle weintrauben */
/* operation mittels sn */
	{
	INT erg = OK;
	erg += b_sn_l(NULL,NULL,b);
	erg += all_sn_weintrauben(a,b);
	ENDR("Sn_wt");
	}

INT Sd_wt(a,b) OP a,b;
/* AK 090889 zu einer weintraube alle weintrauben */
/* operation mittel symmetrischen teils */
	{
	INT erg = OK;
	erg += b_sn_l(NULL,NULL,b);
	erg += all_sd_weintrauben(a,b);
	ENDR("Sd_wt");
	}

INT S_wt(a,b) OP a,b;
/* AK 090889 zu einer weintraube alle weintrauben */
/* urspruengliche Methode */
	{
	OP c=callocobject();
	INT erg = OK;

	if (not EMPTYP(b)) 
		erg += freeself(b);
	erg += weintraube_vector(a,c);
	erg += b_sn_l(NULL,NULL,b);
	erg += all_weintrauben(a,c,b);
 
	erg += SYMfreeall(c); 
	ENDR("S_wt");
	}
INT inversion_matrix_perm(p,e) OP p,e;
{
    INT i,j,k,m;
    INT erg = OK;
    if (not EMPTYP(e))
           erg += freeself(e);
    erg += diagramm_permutation(p,e);
    for (j=(INT)0;j<S_M_LI(e); j++)
                {
                k=j+1L;
                for (i=S_M_HI(e)-1L;i>=(INT)0 ; i--)
                        {
                        if (EMPTYP(S_M_IJ(e,i,j)))
                                {
                                erg += m_i_i(1L,S_M_IJ(e,i,j)) ;
                                k++;
                                }
                        else if (S_M_IJI(e,i,j) == -1L)
                                erg += m_i_i((INT)0,S_M_IJ(e,i,j));
                        else if (S_M_IJI(e,i,j) == (INT)0){
                                erg += m_i_i((INT)0,S_M_IJ(e,i,j));
                                for (m=j+1L; m<S_M_LI(e);m++)
                                        erg += m_i_i(-1L,S_M_IJ(e,i,m));
                                for (m=i-1L; m>=(INT)0 ; m--)
                                        if (not EMPTYP(S_M_IJ(e,m,j))) {
                                                if (S_M_IJI(e,m,j) == -1L)
                                                    erg += m_i_i((INT)0,S_M_IJ(e,m,j)
);
                                                }
                                        else m_i_i((INT)0,S_M_IJ(e,m,j));

                                break;
                                }
                        else error("inversion_matrix_perm:wrong content");
                        }
                }
	ENDR("inversion_matrix_perm");
}

INT perm_weintraube(p,e) OP p,e;
/* AK 010988 */
/* AK 181188 modified form red_dia_perm */
/* perm --> diagramm --> weintraube */
/* AK 291289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT i,j,k,m;
	INT erg = OK;
	inversion_matrix_perm(p,e);
	/* nun streichen der oberen zeilen, falls diese leer */
ak100889:
	if (S_M_HI(e) == 1L) return(OK);
	erg += delete_row_matrix(e,(INT)0,e);
	for (j=(INT)0;j<S_M_LI(e);j++) 
		if (not nullp(S_M_IJ(e,(INT)0,j))) goto ak150190;
	goto ak100889;
ak150190:
	/* streichen von leeren Spalten */
	for (j=(INT)0;j<S_M_LI(e);j++)
		{
		if (S_M_LI(e) == 1L) return(OK);
		for (i=(INT)0;i<S_M_HI(e);i++)
			if (not nullp(S_M_IJ(e,i,j))) break;
		if (i==S_M_HI(e)) { delete_column_matrix(e,j,e);j--; }
		}
	ENDR("perm_weintraube");
	}
	


INT ds_j_wt(a,j,b) OP a,b;INT j;
/* AK 270789 loescht die spalte j in der weintraube */	
	{
	INT erg = OK;
	erg += delete_column_matrix(a,j,b);
	ENDR("ds_j_wt");
	}

INT dz_i_wt(a,i,b) OP a,b;INT i;
/* AK 270789 loescht die zeile i in der weintraube */	
	{
	INT erg = OK;
	erg += delete_row_matrix(a,i,b);
	ENDR("dz_i_wt");
	}
/* AK 090889 pictex_wt.c */

INT pictex_skwt_liste(a) OP a;
	{ return pictex_wt_liste_co(a,co090889_sk); }
INT pictex_snwt_liste(a) OP a;
	{ return pictex_wt_liste_co(a,co090889_sn); }
INT pictex_wt_liste(a) OP a;
	{ return pictex_wt_liste_co(a,co090889); }

INT pictex_wt_liste_co(a,ff) OP a; INT (*ff)();
/* AK 090889 a ist eine liste von weintrauben */
	{
	INT az; /* anzahl der schichten */
	INT i,j;
	INT xs, ys;
	INT ogi,ugi; /* oberes gewicht, unteres gewicht */
	OP v = callocobject(); /* vector von weintrauben */
	OP h = callocobject(); /* hilfsvariable */
	OP og = callocobject();
	OP ug = callocobject();
	OP anzahlschichten = callocobject();
	OP hv = callocobject(); /* integer vector mit anzahl elemente pro
		schicht */
	OP xk = callocobject();
	OP yk = callocobject();
	OP ysv = callocobject(); /* vector der schritte in y koor */
	OP nysv = callocobject(); /* vector der schritte in y koor */
	t_LIST_VECTOR(a,v); 
	m_il_v(S_V_LI(v),xk);
	m_il_v(S_V_LI(v),yk); /* koordinatenvectoren */
	/* nun anzahl der schichten bestimmen */
	gewicht_wt(S_V_I(v,(INT)0),ug);ugi=S_I_I(ug);
	gewicht_wt(S_V_I(v,S_V_LI(v)-1L),og);ogi=S_I_I(og);
	sub(og,ug,anzahlschichten);inc(anzahlschichten);
	/* println(anzahlschichten);  */
	az = S_I_I(anzahlschichten);
	/* nun anzahl pro schicht bestimmen */
	wt_liste_gewicht(a,hv);
	/* println(hv); */
	xs = 600 / (S_V_LI(hv)+1L);
	copy(hv,ysv);
	for (i=(INT)0;i<S_V_LI(ysv);i++) 
		m_i_i((400/(S_V_II(ysv,i)+1L)),S_V_I(ysv,i));
	/* println(ysv); */
	copy(ysv,nysv);
	for (i=(INT)0;i<S_V_LI(v);i++)
		{
		gewicht_wt(S_V_I(v,i),h);	
		m_i_i((S_I_I(h)-ugi+1L) * xs, S_V_I(xk,i));
		copy(S_V_I(nysv,(S_I_I(h)-ugi)), S_V_I(yk,i));
		add(	S_V_I(ysv,(S_I_I(h)-ugi)),
			S_V_I(nysv,(S_I_I(h)-ugi)),
			S_V_I(nysv,(S_I_I(h)-ugi)));
		}
	/* println(xk);
	println(yk); */
	(*ff)(v,xk,yk);
	SYMfreeall(v);
	SYMfreeall(h);
	SYMfreeall(og);
	SYMfreeall(ug);
	SYMfreeall(anzahlschichten);
	SYMfreeall(hv);
	SYMfreeall(xk);
	SYMfreeall(yk);
	SYMfreeall(ysv);
	SYMfreeall(nysv);
	}

static INT co090889linien_sk(v,xk,yk) OP v,xk,yk;
	{ return co090889linien_co(v,xk,yk,s_ki_wt); }
static INT co090889linien_sn(v,xk,yk) OP v,xk,yk;
	{ return co090889linien_co(v,xk,yk,s_ni_wt); }
static INT co090889linien(v,xk,yk) OP v,xk,yk;
	{ return co090889linien_co(v,xk,yk,s_i_wt); }

static INT co090889linien_co(v,xk,yk,ff) OP v,xk,yk; INT (*ff)();
/* zeichnet linien zwischen den wt */
	{
	INT i,m,k,res,l=0;
	INT erg = OK;
	INT hm = S_M_HI(S_V_I(v,(INT)0)); /* hoehe einer matrix */
	OP h = callocobject(); /* hilfsvariable */

	for (i=S_V_LI(v)-1L;i>=(INT)0;i--)
		{
		for (m=1L;m<=hm;m++)
			{
			if ((res=(*ff)(S_V_I(v,i),m,h)) > (INT)0)
				{
				/* suchen der wt in dem restlichen vector */
				for (k=0;k<S_V_LI(v);k++)
					if (eq(h,S_V_I(v,k)))
						{
						/* nun strich zwischen den
						wt */
	if (S_V_II(xk,k) < S_V_II(xk,i)) /* strich nach unten */
		{
		l++;
		fprintf(texout,"\n \\plot %d %d %d %d /",
			S_V_II(yk,i)+res,S_V_II(xk,i)-hm*6L,
			S_V_II(yk,k)+res,S_V_II(xk,k)
			);
		}
	else
		{
		l++;
		fprintf(texout,"\n \\plot %d %d %d %d \\",
			S_V_II(yk,k)+res,S_V_II(xk,k)-hm*6L,
			S_V_II(yk,i)+res,S_V_II(xk,i)
			);
		}
						}
			
				}
			}
		}
	SYMfreeall(h);
	fprintf(stderr,"verbindungen = %d\n",l);
	ENDR("internal routine:co090889linien_co");
	}

static INT co090889(v,xk,yk) OP v,xk,yk;
	{
	return co090889_co(v,xk,yk,co090889linien);
	}

static INT co090889_co(v,xk,yk,ff) OP v,xk,yk; INT (*ff)();
/* vector von objecten an den angegeben plaetzen */
	{
	INT i;
	fprintf(texout,"\\beginpicture\n");
	fprintf(texout,"\\setcoordinatesystem\n");
	fprintf(texout,"\\setlinear\n");
	fprintf(texout,"\\setdashpattern <.5pt, 1pt> \n");
	fprintf(texout,"\\setplotarea x from 0 to 400, y from 0 to 600 \n");
	for (i=(INT)0;i<S_V_LI(v);i++)
		{
		fprintf(texout,"\n\\put { $ \n");
		pictex_wt(S_V_I(v,i));
		fprintf(texout," $} [t] <0pt,3pt> at %d %d \n",
				S_V_II(yk,i),S_V_II(xk,i));
		}
	(*ff)(v,xk,yk);
	fprintf(texout,"\\endpicture\n");
	}

static INT co090889_sn(v,xk,yk) OP v,xk,yk;
	{ return co090889_co(v,xk,yk,co090889linien_sn); }
static INT co090889_sk(v,xk,yk) OP v,xk,yk;
	{ return co090889_co(v,xk,yk,co090889linien_sk); }

INT pictex_wt(a) OP a;
/* AK 090889 a eine einzelne weintraube */
	{
	INT i,j;
	INT erg = OK;

	fprintf(texout," \\weintraube {");
axcv090889:
	for (i=(INT)0;i<S_M_HI(a);i++)
		{
		for (j=(INT)0;j<S_M_LI(a);j++)
			{
			if (not nullp(S_M_IJ(a,i,j)))
				fprintf(texout,"\\bullet");
			else    fprintf(texout,"\\cdot ");
			if (j+1 < S_M_LI(a)) fprintf(texout,"&");
			}
		fprintf(texout,"\\cr\n");
		}
	fprintf(texout,"} \n"); 
	ENDR("pictex_wt");
	}

INT wt_liste_gewicht(a,b) OP a,b;
/* AK 090889 a ist eine liste von weintrauben */
/* b ist vector der gewichte , 0 komponente ist anzahl wt mit geringsten
gewicht */
	{
	INT az; /* anzahl der schichten */
	INT i,j;
	INT ogi,ugi; /* oberes gewicht, unteres gewicht */
	OP v = callocobject(); /* vector von weintrauben */
	OP h = callocobject(); /* hilfsvariable */
	OP og = callocobject();
	OP ug = callocobject();
	OP anzahlschichten = callocobject();

	freeself(b);
	t_LIST_VECTOR(a,v); 
	/* nun anzahl der schichten bestimmen */
	gewicht_wt(S_V_I(v,(INT)0),ug);ugi=S_I_I(ug);
	gewicht_wt(S_V_I(v,S_V_LI(v)-1L),og);ogi=S_I_I(og);
	sub(og,ug,anzahlschichten);inc(anzahlschichten);
	/* println(anzahlschichten);  */
	az = S_I_I(anzahlschichten);
	/* nun anzahl pro schicht bestimmen */
	m_il_v(az,b); /* in 0 ist das unterste gewicht */
	for (i=(INT)0;i<S_V_LI(b);i++) m_i_i((INT)0,S_V_I(b,i));

	for (i=(INT)0;i<S_V_LI(v);i++)
		{
		gewicht_wt(S_V_I(v,i),h);	
		inc(S_V_I(b,S_I_I(h)-ugi));
		}
	SYMfreeall(v);SYMfreeall(ug);SYMfreeall(og);SYMfreeall(anzahlschichten);
	SYMfreeall(h);
	return(OK);
	}


INT s_ni_wt(a,i,b) OP a,b; INT i;
/* AK 240895 implementiert die operation s_ni auf weintrauben
b wird das ergebnis, oder ist empty falls identitaet */
/* return ist gewicht veraenderung oder 0 */
/* weintraube ist MATRIX 1 falls kringel 0 sonst */

	{
	INT j,l,k,m,si;
	INT erg;

	if (i <= (INT)1) return (INT)0;
	if (i > S_M_HI(a)) return (INT)0;

	if (not EMPTYP(b)) freeself(b);
	for (k=1;k<i;k++)
	for (j=S_M_LI(a)-1L;j>=(INT)0;j--) 
		if 
			(
			einsp(S_M_IJ(a,S_M_HI(a)-i,j)) &&
			nullp(S_M_IJ(a,S_M_HI(a)-i+k,j))
			) 
		goto found; /* von (i,j) in die zeile i-k */

	erg = (INT) 0; goto ende;
found:
	/* j ist index mit ersten stein in der zeile i */
	/* der runter kann */

	/* nun freien platz suchen */

	for (l=j+1; l< S_M_LI(a); l++) 
		if (nullp(S_M_IJ(a,S_M_HI(a)-i+k,l))) /* kann nach unten */
			{
			copy(a,b);
			m_i_i(1L,S_M_IJ(b,S_M_HI(b)-i+k,l));
			m_i_i((INT)0,S_M_IJ(b,S_M_HI(b)-i,j));
			for (m=S_M_HI(a)-i+1;m<S_M_HI(a)-i+k;m++)
				{
				if (S_M_IJI(b,m,l) == (INT)0 )
					{
					M_I_I((INT)0, S_M_IJ(b,m,j));
					M_I_I((INT)1, S_M_IJ(b,m,l));
					}
				}
			erg = k; goto ende;
			} 

	erg = (INT)0;
ende:
/*
	println(a); println(b);
	printf("--erg = %d i = %d k = %d ---------------------\n",erg,i,k);
*/
	return erg;
	}

INT s_i_wt(a,i,b) OP a,b; INT i;
/* AK 090889 implementiert die operation s_i auf weintrauben
b wird das ergebnis, oder ist empty falls identitaet */
/* return ist gewicht veraenderung oder 0 */
/* weintraube ist MATRIX 1 falls kringel 0 sonst */
/* AK 291289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT j,l;
	INT erg = OK;
	CTO(MATRIX,"s_i_wt",a);
	if (i <= (INT)1) 
		return (INT)0;
	if (i > S_M_HI(a)) 
		return (INT)0;

	if (not EMPTYP(b)) 
		erg += freeself(b);
	for (j=S_M_LI(a)-1L;j>=(INT)0;j--) 
		if (einsp(S_M_IJ(a,S_M_HI(a)-i,j))) break;
	if (j == -1L) 
		return((INT)0); /* kein stein in der Zeile */

	/* j ist index mit ersten stein in der zeile i */
	/* jetzt gucken ob er nach unten kann */

	for (l=(INT)0; i-l > (INT)0; l++)
		if (nullp(S_M_IJ(a,S_M_HI(a)-i+l,j))) /* kann nach unten */
			{
			erg += copy(a,b);
			M_I_I(1,S_M_IJ(b,S_M_HI(b)-i+l,j));
			M_I_I(0,S_M_IJ(b,S_M_HI(b)-i,j));
			if (l==0) {
				error("s_i_wt:internal error condition");
				}
			return(l);
			} 

	return((INT)0); /* geht nicht */
	ENDR("s_i_wt");
	}

INT tex_weintraube(a,i) OP a, i;
/* druckt weintraube ab gewicht i aus schichtenweise in TeX */
/* AK 291289 V1.1 */
/* AK 070291 V1.2 to texout */ /* AK 210891 V1.3 */
	{
	INT k;
	fprintf(texout,"\\normalbaselineskip=1ex\n");
	fprintf(texout,"\\def\\quad{\\hskip0em\\relax}\n");
	for (k=S_I_I(i); k>=0 ; k--)
		{ fprintf(texout,"\\vskip 0.5cm\n");
		texposition = (INT)0; schicht_print(k,a); }
	fprintf(texout,"\\vfill\\end\n");return(OK);
	}

INT schicht_print(i,c) INT i; OP c;
/* z ist SYMLIST of wt */
/* AK 291289 V1.1 */ /* AK 210891 V1.3 */
	{
	OP z = c;
	OP zw=callocobject(); 
	OP v=callocobject(); 
	fprintf(texout,"\n$$");
	while(z != NULL)
		{
		weintraube_vector(S_L_S(z),v);
		gewicht_v(v,zw);
		if (S_I_I(zw) == i) tex_dia_wt(S_L_S(z));
		z = S_L_N(z);
		}
	fprintf(texout,"$$\n\n "); SYMfreeall(v); SYMfreeall(zw); return(OK);
	}

INT gewicht_v(a,b) OP a,b;
/* gewicht des vectors einer weintraube bei q-specialisierung */
/* AK 291289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT i;
	INT erg = OK;
	CTO(VECTOR,"gewicht_v",a);
	m_i_i((INT)0,b);
	for (i=(INT)0; i<S_V_LI(a); i++)
		m_i_i(S_I_I(b) + S_V_II(a,i)  *  i, b);
	ENDR("gewicht_v");
	}

INT tex_dia_wt(a) OP a;
/* AK 291289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT i,j;

	fprintf(texout," \\matrix {");
	for (i=(INT)0;i<S_M_HI(a);i++)
		for (j=(INT)0;j<S_M_LI(a);j++)
			if (not nullp(S_M_IJ(a,i,j))) goto axcv;
axcv:
	for (;i<S_M_HI(a);i++)
		{
		for (j=(INT)0;j<S_M_LI(a);j++)
			{
			if (not nullp(S_M_IJ(a,i,j)))
				fprintf(texout,"\\circ");
			if (j+1 < S_M_LI(a)) fprintf(texout,"&");
			}
		fprintf(texout,"\\cr\n");
		}
	fprintf(texout,"} \n \\hskip 0.2cm \n"); return(OK);
	}


/* AK 090889 wtbasic.c */

INT gewicht_wt(a,b) OP a,b;
/* AK 090889 a ist eine weintraube b wird das gewicht bei q spec. */
/* AK 290591 V1.2 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	OP v = callocobject();
	erg += weintraube_vector(a,v);
	erg += gewicht_v(v,b);
	erg += SYMfreeall(v);
	ENDR("gewicht_wt");
	}

INT t_j_wt(a,j,b) OP a,b; INT j;
/* Operation t_j auf Weintrauben */
/* return = TRUE falls etwas verschoben wurde */
/* AK 281289 V1.1 */ /* AK 210891 V1.3 */
{
	INT i,l;
	INT dt=(INT)0;
	INT erg = FALSE;
	if (a != b) copy(a,b);
	if (j >= S_M_LI(a)-1L) return(erg);
	for (l=(INT)0;l<S_M_HI(b);l++)
	for (i=(INT)0;i<S_M_HI(b)-l;i++)
	if (	(S_M_IJI(b,i,j) == 1L)
		&& (S_M_IJI(b,i+l,j+1L) == 1L)
	  )
		/* noch ein freier Partner */
			{
			m_i_i(-1L,S_M_IJ(b,i,j));
			m_i_i(-1L,S_M_IJ(b,i+l,j+1L));
			}

if (dt) {fprintf(stderr,"t_j_wt:b = ");fprintln(stderr,b);}

	for (i=(INT)0;i<S_M_HI(b);i++)
		if  (S_M_IJI(b,i,j+1L) == 1L) goto t_j_1;
		else if  (S_M_IJI(b,i,j) == 1L)
			{
			m_i_i((INT)0,S_M_IJ(b,i,j));
			m_i_i(1L,S_M_IJ(b,i,j+1L));
			erg = TRUE;
			}
	goto t_j_2;
	/* das war das verschieben nach rechts */
t_j_1:
	for (i=S_M_HI(b)-1L; i>=(INT)0; i--)
		if  (S_M_IJI(b,i,j) == 1L) break;
		else if  (S_M_IJI(b,i,j+1L) == 1L)
			{
			m_i_i(1L,S_M_IJ(b,i,j));
			m_i_i((INT)0,S_M_IJ(b,i,j+1L));
			erg = TRUE;
			}
	/* das war das verschieben nach links */
	/* jetzt noch die -1 loeschen */
t_j_2:
	for (i=(INT)0;i<S_M_HI(b);i++)
		{
		if  (S_M_IJI(b,i,j+1L) == -1L)
			m_i_i(1L,S_M_IJ(b,i,j+1L));
		if  (S_M_IJI(b,i,j) == -1L)
			m_i_i(1L,S_M_IJ(b,i,j));
		}
	return(erg);
}

INT m_wt_tableaux(a,b) OP a,b;
/* AK 281289 V1.1 */ /* AK 290591 V1.2 */ /* AK 210891 V1.3 */
{
	INT erg = OK;
	OP c = callocobject();
	erg += m_wt_wttab(a,c);
	erg += m_wttab_tableaux(c,b);
	erg += SYMfreeall(c);
	ENDR("m_wt_tableaux");
}

INT m_wt_wttab(a,b) OP a,b;
/* AK 281289 V1.1 */ /* AK 120691 V1.2 */ /* AK 210891 V1.3 */
/* weintraube wird zu tableau-wt gestalt gebracht */
/* dazu wird nach rechts gepackt */
{
	INT j,k;
	INT dt=(INT)0;
	if (a != b) copy(a,b);
	for (j=S_M_LI(b)-2L; j>=(INT)0; j--)
		if (pr_j_wt(b,j,b)) {
			for (k=j+1L;k<S_M_LI(b)-1L;k++)
				pr_j_wt(b,k,b);
			}
if (dt) {fprintf(stderr,"m_wt_wttab: b = ");fprintln(stderr,b);}
	return(OK);
}

INT rightkey_wt(a,b) OP a,b;
/* input: weintraube a, output: tableau b which is right key */
/* AK 230791 V1.3 */
{
	OP c = callocobject();
	OP d = callocobject();
	OP e = callocobject();
	INT i,j,erg = OK,k;
	erg += m_wt_wtkontertab(a,c);
	erg += spalten_summe(c,d);
	erg += sort(d);
	erg += m_v_pa(d,e);
	erg += conjugate(e,e);
	erg += m_u_t(e,b);
	/* nun die vers linken spalten anschauen */
	for (i=(INT)0; i<S_T_LI(b); i++)
		{
		k = (INT)0;
		for ( j=S_M_HI(c)-1L; j >= (INT)0 ; j--)
			if (S_M_IJI(c,j,(INT)0) == 1L) 
				{
				m_i_i(S_M_HI(c)-j,S_T_IJ(b,k,i));
				k++;
				}
		/* nun wurde die linke spalte gelesen */
		/* jetzt nach rechts packen */
		for (j=(INT)0; j < S_T_LI(b)-i; j++)
			erg += pr_j_wt(c,j,c); 

		}
	erg += SYMfreeall(c);
	erg += SYMfreeall(d);
	erg += SYMfreeall(e);
	return erg;
}

INT leftkey_wt(a,b) OP a,b;
/* input: weintraube a, output: tableau b which is left key */
/* AK 230791 V1.3 */
{
	OP c = callocobject();
	OP d = callocobject();
	OP e = callocobject();
	INT i,j,erg = OK,k;
	erg += m_wt_wttab(a,c);
	erg += spalten_summe(c,d);
	erg += sort(d);
	erg += m_v_pa(d,e);
	erg += conjugate(e,e);
	erg += m_u_t(e,b);
	/* nun die vers rechten spalten anschauen */
	for (i=(INT)0; i<S_T_LI(b); i++)
		{
		k = (INT)0;
		for ( j=S_M_HI(c)-1L; j >= (INT)0 ; j--)
			if (S_M_IJI(c,j,S_M_LI(c)-1L) == 1L) 
				{
				m_i_i(S_M_HI(c)-j,S_T_IJ(b,k,i));
				k++;
				}
		/* nun wurde die rechte spalte gelesen */
		/* jetzt nach links packen */
		for (j=(INT)0; j < S_T_LI(b)-i; j++)
			erg += pl_j_wt(c,S_T_LI(b)-1L-j,c); 

		}
	erg += SYMfreeall(c);
	erg += SYMfreeall(d);
	erg += SYMfreeall(e);
	return erg;
}

INT m_wt_wtkontertab(a,b) OP a,b;
/* AK 281289 V1.1 */ /* AK 120691 V1.2 */ /* AK 240791 V1.3 */
/* weintraube wird zu kontertableau-wt gestalt gebracht */
/* dazu wird nach links gepackt */
{
	INT j,k;
	INT dt=(INT)0;
	if (a != b) copy(a,b);
	for (j=1L; j<S_M_LI(b); j++)
		if (pl_j_wt(b,j,b)) {
			for (k=j-1L;k>(INT)0;k--)
				pl_j_wt(b,k,b);
			}
if (dt) {fprintf(stderr,"m_wt_wttab: b = ");fprintln(stderr,b);}
	return(OK);
}


INT m_wttab_tableaux(a,b) OP a,b;
/* AK 281289 V1.1 */ /* AK 120691 V1.2 */ /* AK 210891 V1.3 */
{
	INT i,j;
	INT ti,tj;
	INT dt=(INT)0,erg = OK;
	OP d,e;
	d = callocobject();
	e = callocobject();
	erg += spalten_summe(a,d);
	erg += m_v_pa(d,e); 
	if (EMPTYP(e)) /* leere wt */
		{
		erg += b_us_t(callocobject(),callocobject(),b);
		erg += SYMfreeall(d);
		erg += SYMfreeall(e);
		goto endr_ende;
		}
	erg += SYMfreeall(d);
	erg += conjugate(e,e);
	erg += m_u_t(e,b);
	for (tj=(INT)0,j=S_M_LI(a)-1L;j>=(INT)0; tj++,j--)
		for (i=(INT)0,ti=(INT)0;i<S_M_HI(a); i++)
			if (S_M_IJI(a,S_M_HI(a)-1-i,j) == (INT)1) 
				{
				erg += m_i_i(i+(INT)1,S_T_IJ(b,ti,tj));
				ti++;
				}
if (dt) {fprintf(stderr,"m_wttab_tableaux: b = ");fprintln(stderr,b);}
	erg += SYMfreeall(e);
	ENDR("m_wttab_tableaux");
}

INT sd_i_wt(a,i,b) OP a,b; INT i;
/* AK 170795 */
/* einen stein nach unten (hoeherer index ) mittel symmetrischen teil definiert */
/* return = TRUE falls etwas verschoben wurde */
{
	INT j,l;
	INT dt=(INT)0;
	INT erg = FALSE;
	if (a != b) copy(a,b);
	if (i >= S_M_HI(a)-1) return(erg);
	if (i < (INT)0) return(erg);
	for (l=(INT)0;l<S_M_LI(b);l++)
	for (j=(INT)0;j<S_M_LI(b)-l;j++)
	if (	(S_M_IJI(b,i,j+l) == (INT)1)
		&& (S_M_IJI(b,i+1,j) == (INT)1)
	  )
		/* noch ein freier Partner */
			{
			m_i_i((INT)-1,S_M_IJ(b,i,j+l));
			m_i_i((INT)-1,S_M_IJ(b,i+1,j));
			}

if (dt) {fprintf(stderr,"sd_i_wt:b = ");fprintln(stderr,b);}

	for (j=S_M_LI(b)-1;j>=0;j--)
		if  (S_M_IJI(b,i,j) == (INT)1)
			{
			m_i_i((INT)0,S_M_IJ(b,i,j));
			m_i_i((INT)1,S_M_IJ(b,i+1,j));
			erg = TRUE;
			break;
			}
	/* das war das verschieben nach rechts */
	/* jetzt noch die -1 loeschen */
	for (j=(INT)0;j<S_M_LI(b);j++)
		{
		if  (S_M_IJI(b,i,j) == -1L)
			m_i_i((INT)1,S_M_IJ(b,i,j));
		if  (S_M_IJI(b,i+1,j) == -1L)
			m_i_i((INT)1,S_M_IJ(b,i+1,j));
		}
	return(erg);

}

INT pr_j_wt(a,j,b) OP a,b; INT j;
/* Operation pr_j auf Weintrauben */
/* pack right */
/* in den spalten j,j+1 wird alles nach rechts geschoben */
/* return = TRUE falls etwas verschoben wurde */
/* AK 281289 V1.1 */ /* AK 120691 V1.2 */ /* AK 210891 V1.3 */
{
	INT i,l;
	INT dt=(INT)0;
	INT erg = FALSE;
	if (a != b) copy(a,b);
	if (j >= S_M_LI(a)-1L) return(erg);
	for (l=(INT)0;l<S_M_HI(b);l++)
	for (i=(INT)0;i<S_M_HI(b)-l;i++)
	if (	(S_M_IJI(b,i,j) == (INT)1)
		&& (S_M_IJI(b,i+l,j+(INT)1) == (INT)1)
	  )
		/* noch ein freier Partner */
			{
			m_i_i(-1L,S_M_IJ(b,i,j));
			m_i_i(-1L,S_M_IJ(b,i+l,j+(INT)1));
			}

if (dt) {fprintf(stderr,"pr_j_wt:b = ");fprintln(stderr,b);}

	for (i=(INT)0;i<S_M_HI(b);i++)
		if  (S_M_IJI(b,i,j) == (INT)1)
			{
			m_i_i((INT)0,S_M_IJ(b,i,j));
			m_i_i((INT)1,S_M_IJ(b,i,j+(INT)1));
			erg = TRUE;
			}
	/* das war das verschieben nach rechts */
	/* jetzt noch die -1 loeschen */
	for (i=(INT)0;i<S_M_HI(b);i++)
		{
		if  (S_M_IJI(b,i,j+(INT)1) == -1L)
			m_i_i((INT)1,S_M_IJ(b,i,j+1L));
		if  (S_M_IJI(b,i,j) == -1L)
			m_i_i(1L,S_M_IJ(b,i,j));
		}
	return(erg);
}

INT pl_j_wt(a,j,b) OP a,b; INT j;
/* Operation pl_j auf Weintrauben */
/* pack left */
/* in den spalten j,j-1 wird alles nach links geschoben */
/* return = TRUE falls etwas verschoben wurde */
/* AK 281289 V1.1 */ /* AK 120691 V1.2 */  /* AK 210891 V1.3 */
{
	INT i,l;
	INT dt=(INT)0;
	INT erg = FALSE;
	if (a != b) copy(a,b);
	if (j > S_M_LI(a)-1L) return(erg);
	if (j < 1L) return(erg);
	for (l=(INT)0;l<S_M_HI(b);l++)
	for (i=(INT)0;i<S_M_HI(b)-l;i++)
	if (	(S_M_IJI(b,i,j-1L) == 1L)
		&& (S_M_IJI(b,i+l,j) == 1L)
	  )
		/* noch ein freier Partner */
			{
			m_i_i(-1L,S_M_IJ(b,i,j-1L));
			m_i_i(-1L,S_M_IJ(b,i+l,j));
			}

if (dt) {fprintf(stderr,"pl_j_wt:b = ");fprintln(stderr,b);}
	/* jetzt ist alles markiert */

	for (i=(INT)0;i<S_M_HI(b);i++)
		if  (S_M_IJI(b,i,j) == 1L)
			{
			m_i_i((INT)0,S_M_IJ(b,i,j));
			m_i_i(1L,S_M_IJ(b,i,j-1L));
			erg = TRUE;
			}
	/* das war das verschieben nach links */
	/* jetzt noch die -1 loeschen */
	for (i=(INT)0;i<S_M_HI(b);i++)
		{
		if  (S_M_IJI(b,i,j-1L) == -1L)
			m_i_i(1L,S_M_IJ(b,i,j-1L));
		if  (S_M_IJI(b,i,j) == -1L)
			m_i_i(1L,S_M_IJ(b,i,j));
		}
	return(erg);
}

INT distanzdiagramm(a,b,c) OP a,b,c;
/* a ist startweintraube
b ist zielweintraube
c wird distanzdiagramm */
/* AK 291289 V1.1 */ /* AK 120691 V1.2 */ /* AK 210891 V1.3 */
{
	INT i,j,ti,tj;
	copy(a,c);
	for (j=(INT)0;j<S_M_LI(c);j++)
	{
	ti = (INT)0;
	for (i=(INT)0;i<S_M_HI(c);i++)
		if (S_M_IJI(c,i,j) == 1L) 
			{
			for(;ti<S_M_HI(b);ti++)
				if (S_M_IJI(b,ti,j)==1L) break;
			/* ti ist die zeile wo der stein hinwanderte */
			m_i_i(ti - i, S_M_IJ(c,i,j));
			ti++;
			}
		else C_O_K(S_M_IJ(c,i,j),EMPTY);
	}
	return(OK);
}


INT wt_word(a,b) OP a,b;
/* from weintraube to word */
/* AK 290591 V1.2 */ /* AK 210891 V1.3 */
{
	INT i,j,s=(INT)0,k;
	INT erg = OK;
	CTO(MATRIX,"wt_word",a);
	for (i=(INT)0;i<S_M_HI(a); i++)
	for (j=(INT)0;j<S_M_LI(a); j++)
		if (S_M_IJI(a,i,j) == 1L) s++;
/* s is number of pieces */
	erg += m_il_w(s,b);
	k = (INT)0;
	for (j=S_M_LI(a)-1L; j>=(INT)0;j--) /* right to left */
		for (i=(INT)0;i<S_M_HI(a); i++) /* up to down */
			if (S_M_IJI(a,i,j) == 1L)
				{
				erg += m_i_i(S_M_HI(a)-i,S_W_I(b,k));
				k++;
				}
	ENDR("wt_word");
}


INT word_wt(a,b) OP a,b;
/* Abbildung, die aus einem Wort die Weintraube bestimmt */
/* AK 080290 V1.1 */ /* AK 210891 V1.3 */
{
	INT i,j;
	INT erg = OK;
	INT h=(INT)0,l;
	if (S_W_LI(a) == (INT)0) 
		{
		erg += m_ilih_nm(1,1,b);
		goto endr_ende;
		}
	for (i=(INT)0;i<S_W_LI(a); i++)
		{
		if (S_W_II(a,i) > h) h = S_W_II(a,i);
		if (i == (INT)0) l=1L;
		else     {
			if (S_W_II(a,i) >= S_W_II(a,i-1L)) l++;
			 }
		}

	erg += m_ilih_nm(l,h,b);


	for (i=(INT)0;i<S_W_LI(a); i++)
	{
	if (i == (INT)0) l=1L;
	else     {
		if (S_W_II(a,i) >= S_W_II(a,i-1L)) l++;
		 }
	erg += m_i_i(1L,S_M_IJ(b,S_M_HI(b)-S_W_II(a,i),S_M_LI(b)-l));
	}
	ENDR("word_wt");
}

#ifdef UNDEF
	INT all_sn_weintrauben(a,c) OP a,c;
	/* AK 240895
	a ist weintraube                 
	c ist ergebnisliste von weintrauben,darin
	sollen alle sein, die aus a folgen, incl. a */
		{
		INT i,j,k,l;
		INT  erg=OK;
		OP m,e;

		m = callocobject(); 
		copy_matrix(a,m);
		erg = insert(m,c,NULL,NULL); 
			/* bei eq keine einfuegung, normaler vergleich*/

		m = callocobject();
		for (i=(INT)1;i <= S_M_HI(a); i++)
			{
			if (s_ni_wt(a,i,m) != (INT)0) 
				{
				erg += all_sn_weintrauben(m,c); /* rekursion */
				} 
			}
		erg += SYMfreeall(m);
		ENDR("all_sn_weintrauben");
		}
#endif


static INT all_co_weintrauben(a,c,f) OP a,c; INT (*f)();
{
	INT i,j,k,l;
	INT  erg=OK;
	OP m,e;

	m = callocobject(); 
	copy_matrix(a,m);
	erg = insert(m,c,NULL,NULL); 
		/* bei eq keine einfuegung, normaler vergleich*/

	m = callocobject();
	for (i=(INT)1;i <= S_M_HI(a); i++)
		{
		if ((*f)(a,i,m) != (INT)0) 
			{
			erg += all_co_weintrauben(m,c,f); /* rekursion */
			} 
		}
	erg += SYMfreeall(m);
	ENDR("all_co_weintrauben");
}
static INT all_sd_weintrauben(a,c) OP a,c; 
	{ return all_co_weintrauben(a,c,sd_i_wt); }
static INT all_sn_weintrauben(a,c) OP a,c; 
	{ return all_co_weintrauben(a,c,s_ni_wt); }
static INT all_sk_weintrauben(a,c) OP a,c; 
	{ return all_co_weintrauben(a,c,s_ki_wt); }


#ifdef UNDEF
	INT all_sd_weintrauben(a,c) OP a,c;
	/* AK 181188
	a ist weintraube                 
	c ist ergebnisliste von weintrauben,darin
	sollen alle sein, die aus a folgen, incl. a */
		{
		INT i,j,k,l;
		INT  erg=OK;
		OP m,e;

		m = callocobject(); 
		copy_matrix(a,m);
		erg = insert(m,c,NULL,NULL); 
			/* bei eq keine einfuegung, normaler vergleich*/

		m = callocobject();
		for (i=(INT)0;i < S_M_HI(a); i++)
			{
			if (sd_i_wt(a,i,m) == TRUE)
				{
				/* noch den vector manipulieren */
				erg += all_sd_weintrauben(m,c); /* rekursion */
				} 
			}
		erg += SYMfreeall(m);
		ENDR("all_sd_weintrauben");
		}
#endif

INT m_perm_2wt_summe(a,b) OP a,b;
/* AK 090889 zu einer permutation alle weintrauben zu double schubert */
/* AK 160895 */
	{
	INT erg = OK;
	OP d=callocobject();
	erg += m_perm_2schubert_monom_summe(a,d);
	erg += co_150895(d,b);
	erg += SYMfreeall(d);
	ENDR("m_perm_2wt_summe");
	}

INT m_2schubert_wt(a,b) OP a,b;
/* zu einem vector = self von double schubert 
	wird die zugehoerige wt erzeugt */
{
        INT i,j,k,l;
	INT erg = OK;
        for (i=(INT)0,k=(INT)0,j=(INT)0;i<S_V_LI(a);i++)
                {
                        if (k == j) { k++;j=(INT)0; }
                        else j++;
                }
        /* k ist die dimension */
        erg += m_ilih_nm(k,k,b);
        for (i=0L,l=0,j=0;i<S_V_LI(a);i++)
                {
                        if (S_V_II(a,i) == (INT)1)
                                {
                                erg += m_i_i((INT)1,S_M_IJ(b,k-1-j,l-j));
                                }
                        if (l == j) { l++;j=(INT)0; }
                        else j++;
                }
	ENDR("m_2schubert_wt");
}

static INT co_150895(b,c) OP b,c;
{
        OP z = b,d;
	INT erg = OK;
        erg += init(SYMLIST,c);
        while (z != NULL)
                {
                d = callocobject();
                erg += m_2schubert_wt(S_PO_S(z),d);
                insert(d,c,NULL,NULL);
                z = S_PO_N(z);
                }
	ENDR("internal routine:co_150895");
}

INT s_ki_wt(a,i,b) OP a,b; INT i;
/* AK 190397 implementiert die operation s_ki auf weintrauben
b wird das ergebnis, oder ist empty falls identitaet */
/* return ist gewicht veraenderung oder 0 */
/* weintraube ist MATRIX 1 falls kringel 0 sonst */
/* AK 291289 V1.1 */ /* AK 210891 V1.3 */
/* der unterschied zu s_i_wt ist, dass folgende operationen 
verboten ist:
	... o .... -|-> .........
	..o ......      .....oo..
*/
	{
	INT j,l;
	INT erg = OK;
	CTO(MATRIX,"s_i_wt",a);
	if (i <= (INT)1) 
		return (INT)0;
	if (i > S_M_HI(a)) 
		return (INT)0;

	if (not EMPTYP(b)) 
		erg += freeself(b);
	for (j=S_M_LI(a)-1L;j>=(INT)0;j--) 
		if (einsp(S_M_IJ(a,S_M_HI(a)-i,j))) break;
	if (j == -1L) 
		return((INT)0); /* kein stein in der Zeile */

	/* j ist index mit ersten stein in der zeile i */
	/* jetzt gucken ob er nach unten kann */

	for (l=(INT)0; i-l > (INT)0; l++)
		if (nullp(S_M_IJ(a,S_M_HI(a)-i+l,j))) /* kann nach unten */
			{
		/* noch testen ob nicht sonderfall vorliegt */
			if ( (j>0) && (S_M_IJI(a,S_M_HI(a)-i,j-1) == 0) 
				&& (S_M_IJI(a,S_M_HI(a)-i+l,j-1) == 1) )
					return 0; /* unterschied zu s_i_wt */
			erg += copy(a,b);
			M_I_I(1,S_M_IJ(b,S_M_HI(b)-i+l,j));
			M_I_I(0,S_M_IJ(b,S_M_HI(b)-i,j));
			if (l==0) {
				error("s_ki_wt:internal error condition");
				}
			return(l);
			} 

	return((INT)0); /* geht nicht */
	ENDR("s_ki_wt");
	}
#endif /* WTTRUE */
