File: [local] / OpenXM / src / asir-contrib / testing / noro / normalize.rr (download)
Revision 1.1, Fri Sep 30 06:41:07 2005 UTC (18 years, 11 months ago) by noro
Branch: MAIN
CVS Tags: R_1_3_1-2, RELEASE_1_3_1_13b, RELEASE_1_2_3_12, KNOPPIX_2006, HEAD, DEB_REL_1_2_3-9
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$