Return to normalize.rr CVS log

Up to [local] / OpenXM / src / asir-contrib / testing / noro

Added test files for term rewriting and simplification.

def norm_mono(F)
{
	F = flatten_quote(F,"+");
	F = flatten_quote(F,"*");
	F = quote_to_nary(F);
	return norm_mono_main(F);
}

def norm_mono_main(F)
{
	if ( quote_unify(F,`-X) )
		return -norm_mono_main(X);
	else if ( quote_unify(F,`(X)) )
		return norm_mono_main(F);
	else if ( quote_unify(F,`X-Y) )
		return norm_mono_main(X+(-Y));
	else if ( quote_unify(F,`X^Y) )
		return norm_mono_main(X)^norm_mono_main(Y);
	else if ( quote_unify(F,`X/Y) )
		return norm_mono_main(X)/norm_mono_main(Y);
	else {
		Id = get_quote_id(F);
		if ( Id != 36 ) return F;
		/* NARYOP */
		FA = quote_to_funargs(F);
		Op = get_function_name(FA[1]);
		if ( Op == "+" )
			return funargs_to_quote([FA[0],FA[1],map(norm_mono_main,FA[2])]);
		else if ( Op == "*" ) {
			Factor = extract_factor(F);
			if ( length(Factor) == 1 ) return Factor[0];
			if ( Factor[0] == `1 )
				Factor = cdr(Factor);
			return funargs_to_quote([FA[0],FA[1],Factor]);
		} else
			error("norm_mono_main : cannot happen");
	}
}


def is_number(F)
{
	if ( type(eval_quote(F)) <= 1 ) return 1;
	else return 0;
}

def is_nonnegative_integer(F)
{
	N = eval_quote(F);
	if ( type(N) <= 1 && ntype(N) == 0 
		&& dn(N)==1 && N >= 0 ) return 1;
	else return 0;
}

def base_exp(F)
{
	if ( quote_unify(F,`X^Y) )
		return [X,Y];
	else
		return [F,`1];
}

def extract_factor(F)
{
	if ( quote_unify(F,`-X) ) {
		L = extract_factor(X);
		N = eval_quote(-L[0]);
		return cons(objtoquote(N),cdr(L));
	} else if ( quote_unify(F,`(X)) )
		return extract_factor(X);
	else if ( quote_unify(F,`X*Y) ) {
		L = extract_factor(X); N = eval_quote(L[0]); L = cdr(L);
		R = extract_factor(Y); N *= eval_quote(R[0]); R = cdr(R);
		if ( N == 0 ) return [`0];

		if ( R != [] && L != [] ) {
			L0 = base_exp(L[length(L)-1]);
			R0 = base_exp(R[0]);
			if ( L0[0] == R0[0] ) {
				Exp = eval_quote(L0[1]+R0[1]);
				R = cons(L0[0]^Exp,cdr(R));
				for ( L = cdr(reverse(L)); L != []; L = cdr(L) )
					R = cons(car(L),R);
			} else
				R = append(L,R);
		} else
			R = append(L,R);
		return cons(objtoquote(N),R);
	} else if ( is_number(F) )
		return [F];
	else
		return [`1,F];
}

def chsgn_list(L)
{
	for ( R = [], T = L; T != []; T = cdr(T) )
		if ( quote_unify(car(T),`-X) )
			R = cons(X,R);
		else
			R = cons(-car(T),R);
	return reverse(R);
}

def is_internal_zero(F)
{
	if ( get_quote_id(F) == 17 && eval_quote(F) == 0 ) return 1;
	else return 0;
}

def is_mono(F)
{
	if ( get_quote_id(F) == 17 ) return 1;
	else if ( quote_unify(F,`-X) ) return is_mono(X);
	else if ( quote_unify(F,`(X)) ) return is_mono(X);
	else if ( quote_unify(F,`X*Y) ) return is_mono(X) && is_mono(Y);
	else return 0;
}

def mul_mono_list(M,F)
{
	if ( F == [] ) return [];
	else
		return cons(norm_mono(M*car(F)),mul_mono_list(M,cdr(F)));
}

def mul_list(F,G)
{
	R = [];
	for ( T = F; T != []; T = cdr(T) ) {
		F0 = car(T);
		S = mul_mono_list(F0,G);
		R = add_list(R,S);
	}
	return R;
}

/* F, G are normalized monomials */

def compare_mono(F,G)
{
	FA = extract_factor(F);
	GA = extract_factor(G);
	S = cdr(FA); T = cdr(GA); 
	while ( S != [] && T != [] ) {
		S1 = car(S); T1 = car(T);
		if ( !quote_unify(S1,`BS^ES) || !is_nonnegative_integer(ES) ) { BS = S1; ES = 1; }
		if ( !quote_unify(T1,`BT^ET) || !is_nonnegative_integer(ET) ) { BT = T1; ET = 1; }
		if ( BS > BT ) return 1;
		else if ( BS < BT ) return -1;
		else if ( ES > ET ) {
			S = cdr(S); T = cdr(T);
			E = eval_quote(ES-ET);
			S = cons(E==1?BS:BS^E,S);
		} else if ( ES < ET ) {
			S = cdr(S); T = cdr(T);
			E = eval_quote(ET-ES);
			T = cons(E==1?BT:BT^E,T);
		} else {
			S = cdr(S); T = cdr(T);
		}
	}
	if ( S != [] ) return 1;
	else if ( T != [] ) return -1;
	else return 0;
}

def separate_coef(F)
{
	if ( quote_unify(F,`-X) ) {
		L = separate_coef(X);
		N = eval_quote(-L[0]);
		return [objtoquote(N),L[1]];
	} else if ( quote_unify(F,`(X)) )
		return separate_coef(X);
	else if ( quote_unify(F,`X*Y) ) {
		L = separate_coef(X); N = objtoquote(eval_quote((L[0])));
		if ( is_number(L[1]) )
			return [N,Y];
		else
			return [N,L[1]*Y];
	} else if ( is_number(F) )
		return [F,`1];
	else
		return [`1,F];
}

def add_mono(F,G)
{
	L = separate_coef(F);
	R = separate_coef(G);
	if ( L[1] != R[1] ) error("add_mono : cannot happen");
	C = eval_quote(L[0]+R[0]);
	if ( C == 0 )
		return `0;
	else if ( C == 1 )
		return L[1];
	else if ( C == -1 )
		return -L[1];
	else if ( is_number(L[1]) )
		return objtoquote(C);
	else
		return objtoquote(C)*L[1];
}

def add_list(F,G)
{
	R = [];
	while ( F != [] && G != [] ) {
		F0 = car(F); G0 = car(G);
		if ( is_internal_zero(F0) ) F = cdr(F);
		else if ( is_internal_zero(G0) ) G = cdr(G);
		else {
			C = compare_mono(F0,G0);
			if ( C > 0 ) {
				R = cons(F0,R); F = cdr(F);
			} else if ( C < 0 ) {
				R = cons(G0,R); G = cdr(G);
			} else {
				S = add_mono(F0,G0);
				if ( !is_internal_zero(S) )
					R = cons(add_mono(F0,G0),R);
				F = cdr(F); G = cdr(G);
			}
		}
	}
	if ( F != [] ) Rest = F;
	else if ( G != [] ) Rest = G;
	else Rest = [];
	for ( T = R; T != []; T = cdr(T) ) Rest = cons(car(T),Rest);
	return Rest;
}

def power_list(F,N)
{
	if ( N == 0 ) return [`1];
	else if ( is_internal_zero(F[0]) ) return [`0];
	else if ( N == 1 ) return F;
	else {
		N1 = idiv(N,2);
		F1 = power_list(F,N1);
		F2 = mul_list(F1,F1);
		if ( N%2 ) F2 = mul_list(F2,F);
		return F2;
	}
}

def expand(F)
{
	L = expand0(F);
	for ( R = car(L), L = cdr(L); L != []; L = cdr(L) ) 
		R += car(L);
	return quote_to_nary(R);
}

def expand0(F)
{
	if ( get_quote_id(F) == 17 ) return [F];
	F = quote_to_nary(F);
	if ( quote_unify(F,`-X) ) {
		L = expand0(X);
		return chsgn_list(L);
	} else if ( quote_unify(F,`(X)) )
		return expand0(X);
	else if ( quote_unify(F,`X+Y) ) {
		L = expand0(X); R = expand0(Y);
		return add_list(L,R);
	} else if ( quote_unify(F,`X-Y) ) {
		return expand0(X+(-Y));
	} else if ( quote_unify(F,`X*Y) ) {
		L = expand0(X); R = expand0(Y);
		return mul_list(L,R);
	} else if ( quote_unify(F,`X^Y) ) {
		B = expand0(X);
		if ( is_nonnegative_integer(Y) )
			return power_list(B,eval_quote(Y));
		else
			return [B^Y];	
	} else if ( quote_unify(F,`X/Y) ) {
		L = expand0(X);
		return mul_list(L,[(`1)/expand(Y)]);
	} else
		return [F];
}
end$