/* SYMMETRICA source code file: bruch.c */
#include "def.h"
#include "macro.h"
static INT ggt_mp();
static INT lowcf_br();
static INT lowcf_br();


INT kuerzen_yn;
static struct bruch * callocbruch();
#ifdef MEMCHECK 
static INT mem_counter_bruch;
#endif
#define MEMDEBUG 1
#undef MEMDEBUG

#ifdef BRUCHTRUE
INT bruch_anfang()
/* AK 100893 */
	{
#ifdef MEMCHECK 
	mem_counter_bruch=0L;
#endif
	return OK;
	}

INT bruch_ende()
/* AK 100893 */
/* this function is called to clean up data structures concerning BRUCH objects */
/* this function is called from the function ende */
	{
	INT erg = OK;
#ifdef MEMCHECK
	if (mem_counter_bruch != 0L)
		{
		fprintf(stderr,"mem_counter_bruch = %ld\n",mem_counter_bruch);
		erg += error("bruch memory not freed");
		}
#endif
	ENDR("bruch_ende");
	}




INT add_bruch_scalar(a,b,c) OP a, b, c;
/* AK 050789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	OP d;
	CTO(BRUCH,"add_bruch_scalar",a);
	d = callocobject();
	erg += m_scalar_bruch(b,d);
	erg += add_bruch_bruch(a,d,c); /* hat kuerzen */
	erg += freeall(d);
	ENDR("add_bruch_scalar");
}


INT random_bruch(a) OP a;
/* AK 191093 */
{
	INT erg = OK;
rb_again:
	erg += b_ou_b(callocobject(),callocobject(),a); 
		/* a is freed automatically */
	erg += random_integer(S_B_O(a),NULL,NULL);
	erg += random_integer(S_B_U(a),cons_zwei,NULL);
	kuerzen(a);
	if (S_O_K(a) != BRUCH)
		goto rb_again;
	ENDR("random_bruch");
}

#endif  /* BRUCHTRUE */

#ifdef BRUCHTRUE
INT add_bruch_bruch(a,b,c) OP a, b, c;
/* AK 050789 V1.0 */ /* AK 181289 V1.1 */ /* AK 270291 V1.2 */
/* AK 200891 V1.3 */
{
	OP  zw2;
	INT erg =OK;
	CTO(BRUCH,"add_bruch_bruch",a);
	CTO(BRUCH,"add_bruch_bruch",b);

	erg += b_ou_b(callocobject(),callocobject(),c);
	erg += mult(S_B_U(a),S_B_U(b),S_B_U(c));
	zw2 = callocobject();
	erg += mult(S_B_O(a), S_B_U(b), S_B_O(c));
	erg += mult(S_B_U(a), S_B_O(b), zw2);
	erg += add_apply(zw2,S_B_O(c));

	erg += freeall(zw2);
	erg += kuerzen(c);
	ENDR("add_bruch_bruch");
}




INT absolute_bruch(a,b) OP a,b;
/* AK 150393 */
{
	INT erg = OK;
	if (a==b)
		{
		erg += ERROR;
		goto endr_ende;
		}
	erg += b_ou_b(callocobject(),callocobject(),b);
	erg += absolute(S_B_O(a),S_B_O(b));
	erg += absolute(S_B_U(a),S_B_U(b));
	ENDR("absolute_bruch");
}



INT add_bruch(a,b,c) OP a,b,c;
/* AK 310888 */ /* AK 050789 V1.0 */ /* AK 181289 V1.1 */
/* AK 270291 V1.2 */ /* AK 200891 V1.3 */
/*CC 190995 */
{
	INT erg = OK;
	OP tp1,tp2;
	switch(S_O_K(b))
	{
	case INTEGER:
	case LONGINT: 
		erg +=  add_bruch_scalar(a,b,c);
		break;
	case BRUCH: 
		erg +=  add_bruch_bruch(a,b,c); 
		break;
#ifdef POLYTRUE
	case LAURENT:
		tp2=callocobject();
                erg += m_ou_b(b,cons_eins,tp2);
                erg += add_bruch_bruch(a,tp2,c);
		erg += freeall(tp2);
		break;
/*CC*/
        case MONOPOLY:

                tp2=callocobject();
                erg += m_ou_b(b,cons_eins,tp2);
                erg += add_bruch_bruch(a,tp2,c);
                erg += freeall(tp2);
                break;

	case POLYNOM:
		if (has_one_variable(b))
		{
		tp2=callocobject();
                erg += m_ou_b(b,cons_eins,tp2);
                erg += add_bruch_bruch(a,tp2,c);
		erg += freeall(tp2);
		}
		else
			erg += add_scalar_polynom(a,b,c);
		break;
#endif /* POLYTRUE */
	default :
		erg += WTT("add_bruch",a,b);
	};
	erg += kuerzen(c);
	ENDR("add_bruch");
}



INT negp_bruch(a) OP a;
/* AK 050789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
/* AK 221298 V2.0 */
/* TRUE if a < 0 */
{
	if (negp(S_B_O(a))) {
		if (negp(S_B_U(a))) return(FALSE);
		else return(TRUE);
	}
	else if (nullp(S_B_O(a))) /* AK 221298 */
		return FALSE;
	/* now S_B_O > 0 */
	if (negp(S_B_U(a))) 
		return(TRUE);
	return(FALSE);
}



INT einsp_bruch(a) OP a;
/* AK 050789 V1.0 */ /* AK 081289 V1.1 */ /* AK 200891 V1.3 */
{
	return EQ(S_B_O(a),S_B_U(a));
}



INT negeinsp_bruch(a) OP a;
/* AK 181289 V1.1 */ /* AK 200891 V1.3 */
{
	OP c = callocobject();
	INT erg;
	addinvers(S_B_O(a),c);
	erg = EQ(c,S_B_U(a));
	freeall(c);
	return(erg);
}



INT nullp_bruch(a) OP a;
/* AK 050789 V1.0 */ /* AK 201289 V1.1 */ /* AK 200891 V1.3 */
{
	return (nullp(S_B_O(a)));
}





INT addinvers_bruch(a,b) OP a,b;
/* AK 290388*/ /* AK 050789 V1.0 */ /* AK 201289 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	erg += b_ou_b(callocobject(),callocobject(),b);
	erg += addinvers(S_B_O(a),S_B_O(b));
	erg += copy(S_B_U(a),S_B_U(b));
	ENDR("addinvers_bruch");
}



INT addinvers_apply_bruch(a) OP a;
/* AK 201289 V1.1 */ /* AK 200891 V1.3 */
{ 
	INT erg = OK;
	CTO(BRUCH,"addinvers_apply_bruch",a);
	erg += addinvers_apply(S_B_O(a)); 
	ENDR("addinvers_apply_bruch");
}




INT invers_bruch(a,b) OP a,b;
/* AK 031286 */ /* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	CTO(BRUCH,"invers_bruch",a);
	erg += b_ou_b(callocobject(),callocobject(),b);
	erg += copy(S_B_U(a),S_B_O(b));
	erg += copy(S_B_O(a),S_B_U(b));
	ENDR("invers_bruch");
}



INT mult_bruch_integer(a,b,c) OP a,b,c;
/* AK 040789 V1.0 */ /* AK 081289 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	/* AK fuer integer und longint */
	CTO(BRUCH,"mult_bruch_integer",a);
	erg += copy(a,c);
	erg += mult(b,S_B_O(a),S_B_O(c));
	C_B_I(c,NGEKUERZT); /* AK 010695 */
	erg += kuerzen(c);
	ENDR("mult_bruch_integer");
}

INT mult_bruch_bruch(a,b,ergebnis) OP a,b,ergebnis;
/* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	CTO(BRUCH,"mult_bruch_bruch",a);
	CTO(BRUCH,"mult_bruch_bruch",b);
	erg += b_ou_b(callocobject(),callocobject(),ergebnis);
	erg += mult(S_B_O(a),S_B_O(b),S_B_O(ergebnis));
	erg += mult(S_B_U(a),S_B_U(b),S_B_U(ergebnis));
	erg += kuerzen(ergebnis);
	ENDR("mult_bruch_bruch");
}



INT tex_bruch(a) OP a;
/* AK 070291 V1.2 */ /* AK 300791 V1.3 */ /* AK 200891 V1.3 */
{
	INT erg = OK,merk;
	merk = texmath_yn;
	if (texmath_yn != (INT)1) 
		{  fprintf(texout,"$"); texmath_yn = (INT)1; }
	fprintf(texout,"{");
	erg += tex(S_B_O(a));
	fprintf(texout," \\over ");
	erg += tex(S_B_U(a));
	fprintf(texout,"}");
	texposition += (INT)10;
	texmath_yn = merk;
	if (texmath_yn != (INT)1)  /* d.h. no math mode any more */
		  fprintf(texout,"$");
	ENDR("tex_bruch");
}



INT fprint_bruch(a,b) FILE *a; OP b;
/* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 040391 V1.2 */
/* AK 200891 V1.3 */
{
	extern INT zeilenposition;

	fprint(a,S_B_O(b));
	fprintf(a,"/");
	if (a == stdout)
	{
		if (zeilenposition > 70L)
		{
			zeilenposition = 0L;
			fprintf(a,"\n");
		}
		else
			zeilenposition++;
	}
	fprint(a,S_B_U(b));
	return OK;
}



INT freeself_bruch(bruch) OP bruch;
/* AK 050789 V1.0 */ /* AK 211189 V1.1 */ /* AK 200891 V1.3 */
{
	OBJECTSELF d;
	INT erg = OK;
	d = S_O_S(bruch);

	erg += freeall(S_B_O(bruch));
	erg += freeall(S_B_U(bruch));

#ifdef MEMCHECK
#ifdef MEMDEBUG
	fprintf(stderr,"free_bruch:%d\n",d.ob_bruch);
#endif /* MEMDEBUG */
#endif
	SYM_free(d.ob_bruch);
#ifdef MEMCHECK
	mem_counter_bruch--; /* AK 100893 */
#endif
	C_O_K(bruch,EMPTY);
	ENDR("freeself_bruch");
}


INT copy_bruch(von,nach) OP von, nach;
/* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{
	OP a;
	INT erg = OK;
	if (von == nach) 
		{
		erg += ERROR;
		goto endr_ende;
		}
	erg += m_ou_b(S_B_O(von),S_B_U(von),nach);
	ENDR("copy_bruch");
}



static struct bruch * callocbruch()
/* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{
	struct bruch *
	ergebnis = (struct bruch *) 
		SYM_malloc( sizeof(struct bruch));
	if (ergebnis == NULL) 
		no_memory();
#ifdef MEMCHECK
#ifdef MEMDEBUG
	fprintf(stderr,"calloc_bruch:%d\n",ergebnis);
#endif /* MEMDEBUG */
	mem_counter_bruch++;
#endif /* MEMCHECK */
	return ergebnis;
}
#endif /* BRUCHTRUE */



#ifdef BRUCHTRUE
INT m_ou_b(oben,unten,ergebnis) OP oben, unten,ergebnis;
/* AK 221190 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	erg += b_ou_b(callocobject(),callocobject(),ergebnis);
	erg += copy(oben, S_B_O(ergebnis));
	erg += copy(unten, S_B_U(ergebnis));
	ENDR("m_ou_b");
}



INT b_ou_b(oben,unten,ergebnis) OP oben, unten,ergebnis;
/* AK 050789 V1.0 */ /* AK 071289 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	OBJECTSELF d;

	d.ob_bruch = callocbruch();
	erg += b_ks_o(BRUCH, d, ergebnis);
	C_B_O(ergebnis,oben);
	C_B_U(ergebnis,unten);
	C_B_I(ergebnis,NGEKUERZT);
	return erg;
}



INT m_ioiu_b(oben,unten,ergebnis) INT oben,unten; OP ergebnis;
/* AK 030389
	ein bruch mit einem integer eintrag im zaehler und einem
	integer eintrag im nenner z.b. oben = 3 unten = 5 --> 3/5 */
/* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	erg += b_ou_b(callocobject(),callocobject(),ergebnis);
	M_I_I(oben,S_B_O(ergebnis));
	M_I_I(unten,S_B_U(ergebnis));
	return erg;
}




INT scan_bruch(ergebnis) OP ergebnis;
/* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
/* AK 220998 V2.0 */
{
	OBJECTKIND kind;
	INT erg = OK;
	erg += b_ou_b(callocobject(),callocobject(),ergebnis);
	erg += printeingabe("input of a fractional number");
	erg += printeingabe("input of the nominator");
	kind = scanobjectkind();
	erg += scan(kind,S_B_O(ergebnis));
	erg += printeingabe("input of the denominator");
	kind = scanobjectkind();
	erg += scan(kind,S_B_U(ergebnis));
	erg += kuerzen(ergebnis);
	ENDR("scan_bruch");
}

INT scan_integerbruch(ergebnis) OP ergebnis;
/* AK 220998 V2.0 */
{
        OBJECTKIND kind;
	INT erg = OK;
        erg +=b_ou_b(callocobject(),callocobject(),ergebnis);
	erg += printeingabe("input of a fraction two INTEGER objects");
	erg += printeingabe("input of the nominator");
        erg += scan(INTEGER,S_B_O(ergebnis));
	erg += printeingabe("input of the denominator");
        erg += scan(INTEGER,S_B_U(ergebnis));
        erg += kuerzen(ergebnis);
        ENDR("scan_integerbruch");
}




OP s_b_o(a) OP a;
/* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{

	OBJECTSELF c;
	INT erg = OK;
	CTO(BRUCH, "s_b_o",a);
	c = s_o_s(a);
	return(c.ob_bruch->b_oben);
	ENDO("s_b_o");
}

OP s_b_u(a) OP a;
/* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{

	OBJECTSELF c;
	INT erg = OK;
	CTO(BRUCH, "s_b_u",a);
	c = s_o_s(a);
	return(c.ob_bruch->b_unten);
	ENDO("s_b_u");
}

INT s_b_oi(a) OP a;
/* AK 240789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{
	return(s_i_i(s_b_o(a)));
}

INT s_b_ui(a) OP a;
/* AK 240789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{
	return(s_i_i(s_b_u(a)));
}

INT c_b_o(a,b) OP a,b;
/* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{

	OBJECTSELF c;
	c = s_o_s(a);

	c.ob_bruch->b_oben = b;
	return(OK);
}

INT c_b_u(a,b) OP a,b;
/* AK 050789 V1.0 */ /* AK 010290 V1.1 */ /* AK 200891 V1.3 */
{

	OBJECTSELF c;
	c = s_o_s(a);

	c.ob_bruch->b_unten = b;
	return(OK);
}



INT posp_bruch(a) OP a;
/* AK 040590 V1.1 */ /* AK 200891 V1.3 */
/* AK 190298 V2.0 */
/* TRUE if >= 0 */
{
	INT erg = OK;
	CTO(BRUCH,"posp_bruch",a);

	if (nullp(S_B_O(a))) 
			return TRUE; 

	if (posp(S_B_O(a))) {
		if (posp(S_B_U(a))) 
			return TRUE;
		else
			return FALSE;
		}

	if (negp(S_B_U(a))) 
			return TRUE;
	else
			return FALSE;

	ENDR("posp_bruch");
}



INT comp_bruch(a,b) OP a,b;
/* AK 050789 V1.0 */
/* AK 310190 V1.1 */ /* fehler beseitigt von Isabel Klein */ 
/* AK 200891 V1.3 */
{
	if (S_O_K(b) == BRUCH)
	{
		/* a/b < c/d   <==>  ad < cb */
		INT erg;
		OP c = callocobject(),d = callocobject();
		mult(S_B_O(a),S_B_U(b),c);
		mult(S_B_O(b),S_B_U(a),d);
		if 	(
		    (negp(S_B_U(a)) && negp(S_B_U(b)))
		    || 
		    (posp(S_B_U(a)) && posp(S_B_U(b)))
		    )
			erg = comp(c,d);
		else 
			erg = comp(d,c);
		freeall(c); 
		freeall(d); 
		return(erg);
	}
	else if (scalarp(b))
		return(comp_bruch_scalar(a,b));
	else	{
		printobjectkind(b);
		return error("comp_bruch: wrong second type");
	}
}



INT comp_bruch_scalar(a,b) OP a,b;
/* AK 050789 V1.0 */ /* AK 310190 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg;
	OP c = callocobject();
	mult(S_B_U(a),b,c);
	erg = comp(S_B_O(a),c);
	freeall(c);
	if (negp(S_B_U(a))) erg =  -erg; /* AK 271192 */
	return(erg);
}




INT kuerzen(bruch) OP bruch;
{
	krz(bruch);
	return OK;
}

INT kuerzen_old(bruch) OP bruch;
/* AK 050789 V1.0 */ /* AK 061289 V1.1 */ /* AK 100791 V1.3 */
{
	OP ggterg, moderg;
	INT erg=OK;
	INT ggtierg,vorzeichen=1L;
	extern INT kuerzen_yn;
	if (kuerzen_yn == 1L) 
		return OK; /* d.h. nicht kuerzen */

	if (S_O_K(bruch) != BRUCH) /* AK 070789 */ 
		return(OK);

	if (S_B_I(bruch) == GEKUERZT)
		return OK;

	if (nullp(S_B_O(bruch)))
		return m_i_i(0L,bruch);

	if (
	    (S_O_K(S_B_O(bruch)) == INTEGER) &&
	    (S_O_K(S_B_U(bruch)) == INTEGER) )
	{
		INT oi = S_B_OI(bruch);
		INT ui = S_B_UI(bruch);
		/* bruch mit oben und unten INTEGER */
		/* AK 061289 */
		if (oi == ui)
			return m_i_i(1L,bruch);
		
		ggtierg = ggt_i(oi,ui);
		if (ggtierg == ui)
		{
			return m_i_i(oi/ggtierg,bruch);
		}
		if (ui/ggtierg == 1L)
		{
			return m_i_i(oi/ggtierg,bruch);
		}
		if (ui/ggtierg == -1L)
		{
			return m_i_i(-oi/ggtierg,bruch);
		}
		M_I_I(oi/ggtierg,S_B_O(bruch));
		M_I_I(ui/ggtierg,S_B_U(bruch));
		C_B_I(bruch,GEKUERZT);
		return(OK);
	}

	moderg = callocobject();
	if (negp(S_B_U(bruch))) {
		vorzeichen *= -1L;
		erg += addinvers_apply(S_B_U(bruch));
	}
	if (negp(S_B_O(bruch))) {
		vorzeichen *= -1L;
		erg += addinvers_apply(S_B_O(bruch));
	}


	ggterg = callocobject();

	erg += ggt(S_B_O(bruch),S_B_U(bruch),ggterg);

	erg += ganzdiv(S_B_O(bruch),ggterg,S_B_O(bruch));
	erg += ganzdiv(S_B_U(bruch),ggterg,S_B_U(bruch));
	erg += freeall(ggterg);

	if (einsp(S_B_U(bruch)) )
	{
		erg += copy(S_B_O(bruch),moderg);
		erg += freeself(bruch);
		*bruch = *moderg;
		C_O_K(moderg,EMPTY);
		goto ende;
	}

ende:
	erg += freeall(moderg);
	if (vorzeichen == -1L)
		erg += addinvers_apply(bruch);
	if (S_O_K(bruch) == BRUCH)
		C_B_I(bruch,GEKUERZT);
	ENDR("kuerzen");
}
#endif  /* BRUCHTRUE */


#ifdef BRUCHTRUE
INT m_scalar_bruch(a,b) OP a,b;
/* AK 210387 macht aus scalar bruch */
/* die integerzahl 5 wird z.B. 5/1 */
/* AK 050789 V1.0 */ /* AK 040590 V1.1 */
/* AK 050789 V1.0 */ /* AK 061289 V1.1 */ /* AK 100791 V1.3 */
{
	return m_ou_b(a,cons_eins,b);
}
#endif  /* BRUCHTRUE */

#ifdef BRUCHTRUE
INT mult_apply_scalar_bruch(a,b) OP a,b;
/* AK 150290 V1.1 */ /* AK 100791 V1.3 */
{
	INT erg = OK;
	erg += mult_apply(a,S_B_O(b));
	C_B_I(b,NGEKUERZT); /* AK 010695 */
	erg += kuerzen(b);
	ENDR("mult_apply_scalar_bruch");
}



INT mult_apply_bruch_scalar(a,b) OP a,b;
/* AK 140290 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	OP c = callocobject();
	*c = *b;
	C_O_K(b,EMPTY);
	erg += copy_bruch(a,b);
	erg += mult_apply_scalar_bruch(c,b); /* hat kuerzen */
	erg += freeall(c);
	ENDR("mult_apply_bruch_scalar");
}



INT add_apply_bruch_bruch(a,b) OP a,b;
/* b = b + a */
/* AK 220390 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
#ifdef UNDEF
	OP c = callocobject();
	*c = *b;
	C_O_K(b,EMPTY);
	erg += add_bruch_bruch(a,c,b);  /* hat kuerzen */
	erg += freeall(c);
#endif
	OP c = callocobject();
	erg += mult(S_B_O(a),S_B_U(b),c);
	erg += mult_apply(S_B_U(a), S_B_U(b));
	erg += mult_apply(S_B_U(a), S_B_O(b));
	erg += add_apply(c,S_B_O(b));
	C_B_I(b,NGEKUERZT);
	erg += kuerzen(b);
	erg += freeall(c);
	ENDR("add_apply_bruch_bruch");
}



INT add_apply_bruch_scalar(a,b) OP a,b;
/* AK 220390 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	OP c = callocobject();
	*c = *b;
	C_O_K(b,EMPTY);
	erg += add_bruch_scalar(a,c,b);
	erg += freeall(c);
	ENDR("add_apply_bruch_scalar");
}
#endif /* BRUCHTRUE */

#ifdef BRUCHTRUE
INT add_apply_scalar_bruch(a,b) OP a,b;
/* AK 220390 V1.1 */ /* AK 050791 V1.3 */
{
	OP c;
	INT erg = OK;
	c = callocobject();
	*c = *b;
	C_O_K(b,EMPTY);
	erg += add_bruch_scalar(c,a,b);
	erg += freeall(c);
	ENDR("add_apply_scalar_bruch");
}
#endif /* BRUCHTRUE */

#ifdef BRUCHTRUE

INT add_apply_bruch(a,b) OP a,b;
/* AK 220390 V1.1 */ /* AK 190291 V1.2 */ /* AK 050791 V1.3 */
{
	INT erg = OK;
	switch (S_O_K(b)) {
	case BRUCH:
		erg += add_apply_bruch_bruch(a,b); 
		break;
	case LONGINT:
	case INTEGER:
		erg += add_apply_bruch_scalar(a,b); 
		break;
	default:
		{
			OP c = callocobject();
			*c = *b;
			C_O_K(b,EMPTY);
			erg += add(a,c,b);
			erg += freeall(c);
			break;
		}
	}
	erg += kuerzen(b);
	ENDR("add_apply_bruch");
}




INT mult_apply_bruch(a,b) OP a,b;
/* a is BRUCHobject */
/* AK 140290 V1.1 */ /* AK 190291 V1.2 */ /* AK 200891 V1.3 */
{
	OP c;
	INT erg=OK;

/*CC 260696*/
        if(bruch_not_scalar(a))
        {
                erg += mult_apply(S_B_O(a),b);
                c=callocobject(); 
		erg += copy(b,c); 
                erg += m_ou_b(c,S_B_U(a),b); 
		erg += freeall(c); 
		goto endr_ende;
        }

                
	switch (S_O_K(b)) {
	case BRUCH: 
		erg += mult_apply(S_B_O(a),S_B_O(b));
		erg += mult_apply(S_B_U(a),S_B_U(b));
		C_B_I(b,NGEKUERZT);
		erg += kuerzen(b);
		break;

	case INTEGER:
	case LONGINT:  
		erg+= mult_apply_bruch_scalar(a,b);
		erg += kuerzen(b);
		break;
#ifdef MATRIXTRUE
	case MATRIX: 
		erg += mult_apply_scalar_matrix(a,b);
		break;
#endif /* MATRIXTRUE */
#ifdef MONOMTRUE
	case MONOM: 
		erg += mult_apply_scalar_monom(a,b);
		break;
#endif /* MONOMTRUE */
#ifdef POLYTRUE
	case POLYNOM: 
		erg += mult_apply_scalar_polynom(a,b);
		break;
#endif /* POLYTRUE */
	default:
		c = callocobject();
		erg+=mult(a,b,c);
		erg+=freeself(b);
		*b = *c;
		C_O_K(c,EMPTY);
		erg += freeall(c);
	}
	ENDR("mult_apply_bruch");
}

#endif /* BRUCHTRUE */

#ifdef BRUCHTRUE
INT mult_bruch(a,b,c) OP a,b,c;
/* AK 050789 V1.0 */ /* AK 140290 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	OP tp1,tp2;
	switch( S_O_K(b)) {

	case BRUCH:  
		erg += mult_bruch_bruch(a,b,c);
		break;
#ifdef INTEGERTRUE
	case LONGINT:
	case INTEGER: 
		erg += mult_bruch_integer(a,b,c);
		break;
#endif /* INTEGERTRUE */
#ifdef MATRIXTRUE
	case MATRIX: 
		erg += mult_scalar_matrix(a,b,c);
		break;
#endif /* MATRIXTRUE */
#ifdef MONOMTRUE
	case MONOM: 
		erg += mult_scalar_monom(a,b,c);
		break;
#endif /* MONOMTRUE */
	case LAURENT:
		erg += copy(a,c);
		erg += mult(b,S_B_O(c), S_B_O(c));
		break;

#ifdef POLYTRUE
	case GRAL:
	case SCHUBERT:
	case POLYNOM: 
		if (
			(has_one_variable(b)) 
			&& 
		((!scalarp(S_B_O(a))) ||(!scalarp(S_B_U(a))))
			)
                {
                        tp2=callocobject();
                        erg += m_ou_b(b,cons_eins,tp2);
                        erg += mult_bruch_bruch(a,tp2,c);
			erg += freeall(tp2);
                }
                else
			erg += mult_scalar_polynom(a,b,c);
		break;
#endif /* POLYTRUE */
#ifdef SCHURTRUE
	case ELM_SYM:
	case HOM_SYM:
	case POW_SYM:
	case MONOMIAL:
	case SCHUR: 
		erg += mult_scalar_schur(a,b,c);
		break;
#endif /* SCHURTRUE */
#ifdef CHARTRUE
	case SYMCHAR: 
		erg += mult_scalar_symchar(a,b,c);
		break;
#endif /* CHARTRUE */
#ifdef VECTORTRUE
	case VECTOR:  
		erg += mult_scalar_vector(a,b,c);
		break;
#endif /* VECTORTRUE */
	default:
		printobjectkind(b);
		error("mult_bruch: wrong second type");
		return(ERROR);
	};
	ENDR("mult_bruch");
}

#endif /* BRUCHTRUE */

#ifdef BRUCHTRUE
INT test_bruch()
/* AK 150290 V1.1 */ /* AK 200891 V1.3 */
{
	OP a= callocobject();
	OP b= callocobject();
	OP c= callocobject();

	printf("test_bruch:scan(a) ");
	scan(BRUCH,a);
	println(a);
	printf("test_bruch:scan(b) ");
	scan(BRUCH,b);
	println(b);
	printf("test_bruch:posp(a) ");
	if (posp(a)) {
		printf(" a ist positiv\n");
	}
	else {
		printf(" a ist nicht positiv\n");
	}
	printf("test_bruch:einsp(a) ");
	if (einsp(a)) {
		printf(" a ist eins\n");
	}
	else {
		printf(" a ist nicht eins\n");
	}

	printf("test_bruch:add(a,b,c) ");
	add(a,b,c);
	println(c);
	printf("test_bruch:mult(a,b,c) ");
	mult(a,b,c);
	println(c);
	printf("test_bruch:kuerzen(c) ");
	kuerzen(c); 
	println(c);
	freeall(a); 
	freeall(b); 
	freeall(c);
	return(OK);
}

#endif /* BRUCHTRUE */

#ifdef BRUCHTRUE
INT objectwrite_bruch(f,a) FILE *f; OP a;
/* AK 200690 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	fprintf(f,"%ld\n", (INT)BRUCH);
	erg += objectwrite(f,S_B_O(a));
	erg += objectwrite(f,S_B_U(a)); 
	ENDR("objectwrite_bruch");
}

#endif /* BRUCHTRUE */

#ifdef BRUCHTRUE
INT objectread_bruch(f,a) FILE *f; OP a;
/* AK 200690 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	erg += b_ou_b(callocobject(),callocobject(),a);
	erg += objectread(f,S_B_O(a));
	erg += objectread(f,S_B_U(a)); 
	ENDR("objectread_bruch");
}


INT cast_apply_bruch(a) OP a;
/* AK 210294 */
{
	INT erg = OK;
	switch S_O_K(a) {
		case BRUCH:
			break;
		case INTEGER: 
			erg += m_ioiu_b(S_I_I(a), (INT) 1, a);
			break;
		case LONGINT: 
			erg += m_ou_b(a,cons_eins,a);
			break;
		}
	ENDR("cast_apply_bruch");
}
#endif /* BRUCHTRUE */



/*
Met dans dg le degre du monopoly mp
*/

INT dg_mp(mp,dg) OP mp,dg;
{
	
	OP z,za;
	if(not EMPTYP(dg)) freeself(dg);
	z=mp;
	while(z !=NULL)
	{
		za=z;
		z=S_L_N(z);
	}
	copy(S_PO_S(za),dg);
	return(OK);
}


/*
Met dans ld le coefficient du terme maximal  du monopoly mp
*/

INT ldcf_mp(mp,ld) OP mp,ld;
{
	
	OP z,za;
	if(not EMPTYP(ld)) freeself(ld);
	z=mp;
	while(z !=NULL)
	{
		za=z;
		z=S_L_N(z);
	}
	copy(S_PO_K(za),ld);
	return(OK);
}


INT t_POLYNOM_MONOPOLY(a,b) OP a,b;
{
	OP z,hh;

	if (not EMPTYP(b)) freeself(b);
	init(MONOPOLY,b);
	z=a;
	while(z!=NULL)
	{
		hh=callocobject();
		m_sk_mo(S_V_I(S_PO_S(z),0L),S_PO_K(z),hh);
		insert(hh,b,add_koeff,NULL);
		z=S_PO_N(z);
	}
	return(OK);
}


/*
n est de type INTEGER
po est de type POLYNOM ou MONOPOLY
pg est le pgcd de n et des coefficients de po
Retourne ERROR si le pgcd n'est pas definie
*/

INT gcd_int_po(n,po,pg) OP n,po,pg;
{
	OP z,tmp,k;

	if(not EMPTYP(pg)) freeself(pg);
	z=po;
	if(nullp(z)){ copy(n,pg);return(OK);}
	tmp=callocobject();
	copy(n,tmp);
	while(z!=NULL)
	{
		k=S_PO_K(z);
		if(S_O_K(k)==BRUCH)
			krz(k);
		if(S_O_K(k)!=INTEGER)
			return ERROR;
		ggt(tmp,k,tmp);
		z=S_L_N(z);
	}
	copy(tmp,pg);
	freeall(tmp);
	return(OK);
}

/*
Calcule le pgcd de a et b qui sont de type quelconque.
Retourne ERROR si le pgcd de a et b n'existe pas
*/

INT pgcd(a,b,c) OP a,b,c;
{
	OP aa,bb,nb;
	if(S_O_K(a)==BRUCH) krz(a);
	if(S_O_K(b)==BRUCH) krz(b);
	if((S_O_K(a)==BRUCH)||(S_O_K(b)==BRUCH))
		return ERROR;
	if((S_O_K(a)==INTEGER)&&(S_O_K(b)==INTEGER))
	{
		ggt(a,b,c);return(OK);
	}
	if(nullp(a))
	{
		if(has_one_variable(b)==TRUE)
		{
			copy(b,c);return(OK);
		}
		else
			return ERROR;
	}
	if(nullp(b))
	{
		if(has_one_variable(a)==TRUE)
		{
			copy(a,c);return(OK);
		}
		else
			return ERROR;
	}
	if(scalarp(a))
	{
		copy(a,c);
		return(OK);
	}
	if(scalarp(b))
	{
		copy(b,c);
		return(OK);
	}
	
	if(S_O_K(a)==POLYNOM)
	{
		nb=callocobject();
		numberofvariables(a,nb);
		if(S_I_I(nb)>1L)
		{
			freeall(nb);
			return(ERROR);
		}
		else
		{
			freeall(nb);
			aa=callocobject();
			t_POLYNOM_MONOPOLY(a,aa);
		}
	}	
	else
	{
		aa=callocobject();
		copy(a,aa);
	}

	if(S_O_K(b)==POLYNOM)
	{
		nb=callocobject();
		numberofvariables(b,nb);
		if(S_I_I(nb)>1L)
		{
			freeall(nb);
			return(ERROR);
		}
		else
		{
			freeall(nb);
			bb=callocobject();
			t_POLYNOM_MONOPOLY(b,bb);
		}
	}	
	else
	{
		bb=callocobject();
		copy(b,bb);
	}
	ggt_mp(aa,bb,c);
	freeall(aa);freeall(bb);
}






/*
Lance le pgcd de 2 polynomes non nuls de type MONOPOLY
Computes the gcd of 2 MONOPOLY objects
*/

static INT ggt_mp(a,b,c) OP a,b,c;
{
	OP dg1,dg2;
	INT dgi1,dgi2;
	dg1=callocobject();dg2=callocobject();
	dg_mp(a,dg1); dg_mp(b,dg2);
	dgi1=S_I_I(dg1); dgi2=S_I_I(dg2);
	if(dgi1==0)
		copy(a,c);
	else if(dgi2==0)
		copy(b,c);
	else if(dgi1>dgi2)
		gcd_mp(a,b,c);
	else
		gcd_mp(b,a,c);
	freeall(dg1);freeall(dg2);
	return(OK);
}


/*
Calcule le pgcd de 2 polynomes  de type MONOPOLY a et b
degre(a)>degre(b)>0
Algo d'Euclide non optimise
*/

	
INT gcd_mp_lent(a,b,c) OP a,b,c;
{
	OP aa,bb,qp,rp;
	aa=callocobject(); qp=callocobject(); rp=callocobject(); bb=callocobject();
	copy(a,aa);copy(b,bb);
	while(1)
	{
		quores_monopoly(aa,bb,qp,rp);
		if(nullp_monopoly(rp)) break;
		copy(bb,aa);
		copy(rp,bb);
	}
	copy(bb,c);
	freeall(bb);freeall(aa);
}



/*
Calcule le pgcd de 2 polynomes de type MONOPOLY a et b
degre(a)>degre(b)>0
*/

INT gcd_mp(a,b,c) OP a,b,c;
{
	OP av,nv,ld,dlt,tp,aa,bb,qp,rp;
	INT avi,nvi,dlti,ldi;

	tp=callocobject(); aa=callocobject(); bb=callocobject();
	av=callocobject(); nv=callocobject(); ld=callocobject();
	dlt=callocobject(); qp=callocobject(); rp=callocobject();
	dg_mp(a,av);avi=S_I_I(av);
	dg_mp(b,nv);nvi=S_I_I(nv);
	copy(a,aa);copy(b,bb);
	while(nvi>0)
	{
		dlti=avi-nvi+1;M_I_I(dlti,dlt);
		ldcf_mp(b,ld);
		hoch(ld,dlt,tp);
		mult(tp,aa,aa);
		quores_monopoly(aa,bb,qp,rp);
		if(nullp_monopoly(rp))  break;
		else
		{
			copy(bb,aa);
			copy(rp,bb);
			avi=nvi;
			dg_mp(bb,nv);
			nvi=S_I_I(nv);
		}
	}
	copy(bb,c);
	freeall(tp); freeall(aa);
	freeall(ld); freeall(dlt);
	freeall(bb); freeall(av);
	freeall(nv);
	freeall(qp); /* AK 130297 */
	freeall(rp); /* AK 130297 */
	return(OK);
}	


/*
mp est de type MONOPOLY.
Renvoie TRUE si mp est une constante 
FALSE sinon
*/

INT mp_is_cst(mp) OP mp;
{
	OP z;
	INT i,boo;
	z=mp;i=0L;boo=0L;
	while(z!=NULL)
	{
		if(i > 0L) return FALSE;
		if(S_I_I(S_PO_S(z))==0L)
			boo=1L;
		z=S_L_N(z);
		i++;
	}
	if(boo==1L) return TRUE;
	else return FALSE;
}

/*Simplifie fc3
renvoie ERROR si fc3 est une fraction rationnelle avec 0 au denominateur
*/

INT bruch_not_scalar(a) OP a;
/*
Returns 1 if a is built wit MONOPOLY or POLYNOM object.
Returns 0 if not.
*/
{
        INT tp1,tp2;
        if(S_O_K(S_B_O(a))==MONOPOLY || S_O_K(S_B_O(a))==POLYNOM
                ||S_O_K(S_B_U(a))==MONOPOLY || S_O_K(S_B_U(a))==POLYNOM)
                return 1;
        tp1=tp2=0L;
        if(S_O_K(S_B_O(a))==BRUCH && bruch_not_scalar(S_B_O(a))
                || S_O_K(S_B_U(a))==BRUCH && bruch_not_scalar(S_B_U(a))) return
1;
        return 0;
}


/*
ma0 est une matrice de polynomes, fractions rationnelles, entiers...
Transforme les types MONOPOLY de ma0
 en type POLYNOM dans ma	
*/

INT t_MA_MONOPOLY_MA_POLYNOM(ma0,ma) OP ma0, ma;
{
	INT i,j;
	OP tp,ttp1,tp1,ttp2,tp2;

	m_ilih_m(S_M_LI(ma0),S_M_HI(ma0),ma);
	for(i=0L;i<S_M_LI(ma0);i++)
		for(j=0L;j<S_M_LI(ma0);j++)
		{
			tp=S_M_IJ(ma0,i,j);
			if(S_O_K(tp)==MONOPOLY)
			{
				tp=callocobject();
				t_MONOPOLY_POLYNOM(S_M_IJ(ma0,i,j),tp);
				copy(tp,S_M_IJ(ma,i,j));
				freeall(tp);
			}
			else if (S_O_K(tp)==BRUCH)
			{
				tp1=S_B_O(tp); ttp1=callocobject();
				if(S_O_K(tp1)==MONOPOLY)
				{
					t_MONOPOLY_POLYNOM(tp1,ttp1);
				}
				else copy(tp1,ttp1);
				tp2=S_B_U(tp); ttp2=callocobject();
				if(S_O_K(tp2)==MONOPOLY)
				{
					t_MONOPOLY_POLYNOM(tp2,ttp2);
				}
				else copy(tp2,ttp2);
				b_ou_b(ttp1,ttp2,S_M_IJ(ma,i,j));
			}
			else copy(tp,S_M_IJ(ma,i,j));
		}
}

/*
met 0 a la place de empty_list dans la matrice ma
*/

INT en_forme(ma) OP ma;
{
	INT i,j;
	INT erg = OK;

	for(i=0L;i<S_M_LI(ma);i++)
		for(j=0L;j<S_M_LI(ma);j++)
			if(EMPTYP(S_M_IJ(ma,i,j)))
				M_I_I(0L,S_M_IJ(ma,i,j));
			else if (empty_listp(S_M_IJ(ma,i,j)))
				erg += m_i_i(0L,S_M_IJ(ma,i,j));
			else if (nullp(S_M_IJ(ma,i,j)))
				erg += m_i_i(0L,S_M_IJ(ma,i,j));
	ENDR("en_forme");
}



INT krz(fc3) OP fc3;
{
	OP oo,uu,uuu,pg,tp,q,r,dgu,dgo,dgpg,tpu,tpo,tmp,fc4;
	INT erg = OK;

	if(S_O_K(fc3)!=BRUCH)
		return OK;
	oo=S_B_O(fc3); uu=S_B_U(fc3);
	if(nullp(uu))
		{
		erg += error("internal routine krz: nenner=null");
		goto endr_ende;
		}
	if(nullp(oo))
	{
		freeself(fc3);M_I_I(0L,fc3);return(OK);
	}
	if(
		((S_O_K(oo)==INTEGER)||(S_O_K(oo) == LONGINT))
		&&
		((S_O_K(uu)==INTEGER)||(S_O_K(uu) == LONGINT))
	  )
	{
		kuerzen_old(fc3);
		return(OK);
	}

/* CC  28/09/95*/
	if(S_O_K(oo)==BRUCH)krz(oo);
	if(S_O_K(uu)==BRUCH)krz(uu);
	if((S_O_K(oo)==BRUCH)||(S_O_K(uu)==BRUCH))
	{
	 	tp=callocobject();
		if(S_O_K(uu)==BRUCH)
			m_ou_b(S_B_U(uu),S_B_O(uu),tp);
		else
			m_ou_b(cons_eins,uu,tp);
		mult(oo,tp,tp);
		copy(tp,fc3);
		freeall(tp);
		return(krz(fc3));
	}		

	if(scalarp(uu))
	{
		tp=callocobject();
		div(oo,uu,tp);
		copy(tp,fc3);
		freeall(tp);
		sp_br(fc3);
		return(OK);
	}
	if(scalarp(oo))
	{
		tp=callocobject();
		div(uu,oo,tp);

/*CC 28/09/95*/
		if(S_O_K(tp)==BRUCH)
			m_ou_b(S_B_U(tp),S_B_O(tp),fc3);
		else
			m_ou_b(cons_eins,tp,fc3);
		sp_br(fc3);
		freeall(tp);

		return(OK);
	}
	if (S_O_K(uu) == LAURENT)
		{
		tpo=callocobject();
		tp=callocobject();
		copy(oo,tp);
		t_LAURENT_OBJ(uu,tpo);
		m_ou_b(tp,tpo,fc3);
		freeall(tpo);
		freeall(tp);
		krz(fc3);
		return(OK);
		}

	if (S_O_K(oo) == LAURENT)
		{
		tpo=callocobject();
		tp=callocobject();
		copy(uu,tp);
		t_LAURENT_OBJ(oo,tpo);
		m_ou_b(tpo,tp,fc3);
		freeall(tpo);
		freeall(tp);
		krz(fc3);
		return(OK);
		}

	pg=callocobject();
	if(pgcd(oo,uu,pg)==ERROR) return ERROR;

/*CC 28/09/95*/
	if(scalarp(pg))
	{
		sp_br(fc3);
		freeall(pg);return(OK);
	}
	if(S_O_K(pg)==MONOPOLY)
	{
		dgpg=callocobject();
		degree_monopoly(pg,dgpg);
		if(nullp(dgpg))
		{
			sp_br(fc3);
			freeall(pg);freeall(dgpg);
			return(OK);
		}
	}
	if(S_O_K(pg)==POLYNOM)
	{
		dgpg=callocobject();
		degree_polynom(pg,dgpg);
		if(nullp(dgpg)==TRUE)
		{
			sp_br(fc3);
			freeall(dgpg);freeall(pg);
			return OK;
		}
	}

	tpu=callocobject();
	if(S_O_K(uu)==POLYNOM)
		t_POLYNOM_MONOPOLY(uu,tpu);
	else
		copy(uu,tpu);
	tpo=callocobject();
	if(S_O_K(oo)==POLYNOM)
		t_POLYNOM_MONOPOLY(oo,tpo);
	else
		copy(oo,tpo);

	dgu=callocobject();
	degree_monopoly(tpu,dgu);
	if(S_I_I(dgu)==S_I_I(dgpg))
	{
		freeself(fc3);
		r=callocobject(); tmp=callocobject();
		quores_monopoly(tpo,tpu,tmp,r);
		copy(tmp,fc3);

		freeall(tmp);	
		freeall(r);freeall(pg);
		freeall(tpo);freeall(tpu);
		freeall(dgu);freeall(dgpg);
		return(OK);
	}
	
	dgo=callocobject();
	degree_monopoly(tpo,dgo);
	if(S_I_I(dgo)==S_I_I(dgpg))
	{
		r=callocobject(); tmp=callocobject();
		quores_monopoly(tpu,tpo,tmp,r);

		div(cons_eins,tmp,fc3);

		freeall(r);freeall(pg);freeall(tmp);
		freeall(dgu);freeall(dgo);freeall(dgpg);
		freeall(tpu);freeall(tpo);
		return(OK);
	}
	r=callocobject();
	quores_monopoly(tpo,pg,oo,r);
	quores_monopoly(tpu,pg,uu,r);

/*CC 28/09/95*/
	sp_br(fc3);

	freeall(r);freeall(dgo);freeall(dgu);freeall(dgpg);
	freeall(tpo);freeall(tpu);freeall(pg);
	ENDR("internal routine:krz");
}

/*
CC 28/09/95
If br is a bruch with monopoly or polynom in the numerator or denominator.
Try to remove bruch in the numerator and denominator
*/
INT sp_br(br) OP br;
{
        OP cf,tp1,tp2;
        if(S_O_K(br)!=BRUCH)return OK;
        if((S_O_K(S_B_O(br))!=MONOPOLY && S_O_K(S_B_O(br))!=POLYNOM)
        ||(S_O_K(S_B_U(br))!=MONOPOLY && S_O_K(S_B_U(br))!=POLYNOM))
                return OK;
        cf=callocobject();
        lowcf_br(br,cf);
        if(comp(cons_eins,cf)!=0L)
        {
                tp1=callocobject();tp2=callocobject();
                div(S_B_O(br),cf,tp1);
                div(S_B_U(br),cf,tp2);
                m_ou_b(tp1,tp2,br);
                freeall(tp1);freeall(tp2);
        }
        freeall(cf);
        return OK;
}

/*
CC 28/09/95
mp is a polynom or a monopoly with scalar coefficient.
cf will be the smallest coefficient different from 0 in mp.
*/

static INT lowcf_mp(mp,cf) OP mp,cf;
{
        OP z;
        INT boo;
        if(not EMPTYP(cf)) freeself(cf);
        z=mp;
        boo=0L;
        while(z!=NULL)
        {
                if(nullp(S_PO_K(z))==FALSE)
                {
                        if(boo==0L)
                        {
                                copy(S_PO_K(z),cf);

                                boo=1L;
                        }
                        else if(lt(S_PO_K(z),cf)==TRUE)
                        {
                                copy(S_PO_K(z),cf);
                        }
                }
                z=S_L_N(z);
        }
        return OK;
}

/*
CC 28/09/95
br is a bruch with monopoly or polynom in the numerator or denominator.
cf will be the smallest coefficient different from 0 in br.
*/

static INT lowcf_br(br,cf) OP br,cf;
{
        OP cf1,cf2;
	INT erg = OK;
        cf1=callocobject();
	cf2=callocobject();
        erg += lowcf_mp(S_B_O(br),cf1);
        erg += lowcf_mp(S_B_U(br),cf2);
        if(lt(cf1,cf2)==TRUE)
                erg += copy(cf1,cf);
        else
                erg += copy(cf2,cf);
        erg += freeall(cf1);
	erg += freeall(cf2);
	ENDR("internal func: lowcf_br");
}

#define callocobject callocobject_trace
#undef callocobject