![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to normalize.rr CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / asir-contrib / testing / noro|
Return to normalize.rr CVS log | Up to [local] / OpenXM / src / asir-contrib / testing / noro |
1.1 ! noro 1: def norm_mono(F)
! 2: {
! 3: F = flatten_quote(F,"+");
! 4: F = flatten_quote(F,"*");
! 5: F = quote_to_nary(F);
! 6: return norm_mono_main(F);
! 7: }
! 8:
! 9: def norm_mono_main(F)
! 10: {
! 11: if ( quote_unify(F,`-X) )
! 12: return -norm_mono_main(X);
! 13: else if ( quote_unify(F,`(X)) )
! 14: return norm_mono_main(F);
! 15: else if ( quote_unify(F,`X-Y) )
! 16: return norm_mono_main(X+(-Y));
! 17: else if ( quote_unify(F,`X^Y) )
! 18: return norm_mono_main(X)^norm_mono_main(Y);
! 19: else if ( quote_unify(F,`X/Y) )
! 20: return norm_mono_main(X)/norm_mono_main(Y);
! 21: else {
! 22: Id = get_quote_id(F);
! 23: if ( Id != 36 ) return F;
! 24: /* NARYOP */
! 25: FA = quote_to_funargs(F);
! 26: Op = get_function_name(FA[1]);
! 27: if ( Op == "+" )
! 28: return funargs_to_quote([FA[0],FA[1],map(norm_mono_main,FA[2])]);
! 29: else if ( Op == "*" ) {
! 30: Factor = extract_factor(F);
! 31: if ( length(Factor) == 1 ) return Factor[0];
! 32: if ( Factor[0] == `1 )
! 33: Factor = cdr(Factor);
! 34: return funargs_to_quote([FA[0],FA[1],Factor]);
! 35: } else
! 36: error("norm_mono_main : cannot happen");
! 37: }
! 38: }
! 39:
! 40:
! 41: def is_number(F)
! 42: {
! 43: if ( type(eval_quote(F)) <= 1 ) return 1;
! 44: else return 0;
! 45: }
! 46:
! 47: def is_nonnegative_integer(F)
! 48: {
! 49: N = eval_quote(F);
! 50: if ( type(N) <= 1 && ntype(N) == 0
! 51: && dn(N)==1 && N >= 0 ) return 1;
! 52: else return 0;
! 53: }
! 54:
! 55: def base_exp(F)
! 56: {
! 57: if ( quote_unify(F,`X^Y) )
! 58: return [X,Y];
! 59: else
! 60: return [F,`1];
! 61: }
! 62:
! 63: def extract_factor(F)
! 64: {
! 65: if ( quote_unify(F,`-X) ) {
! 66: L = extract_factor(X);
! 67: N = eval_quote(-L[0]);
! 68: return cons(objtoquote(N),cdr(L));
! 69: } else if ( quote_unify(F,`(X)) )
! 70: return extract_factor(X);
! 71: else if ( quote_unify(F,`X*Y) ) {
! 72: L = extract_factor(X); N = eval_quote(L[0]); L = cdr(L);
! 73: R = extract_factor(Y); N *= eval_quote(R[0]); R = cdr(R);
! 74: if ( N == 0 ) return [`0];
! 75:
! 76: if ( R != [] && L != [] ) {
! 77: L0 = base_exp(L[length(L)-1]);
! 78: R0 = base_exp(R[0]);
! 79: if ( L0[0] == R0[0] ) {
! 80: Exp = eval_quote(L0[1]+R0[1]);
! 81: R = cons(L0[0]^Exp,cdr(R));
! 82: for ( L = cdr(reverse(L)); L != []; L = cdr(L) )
! 83: R = cons(car(L),R);
! 84: } else
! 85: R = append(L,R);
! 86: } else
! 87: R = append(L,R);
! 88: return cons(objtoquote(N),R);
! 89: } else if ( is_number(F) )
! 90: return [F];
! 91: else
! 92: return [`1,F];
! 93: }
! 94:
! 95: def chsgn_list(L)
! 96: {
! 97: for ( R = [], T = L; T != []; T = cdr(T) )
! 98: if ( quote_unify(car(T),`-X) )
! 99: R = cons(X,R);
! 100: else
! 101: R = cons(-car(T),R);
! 102: return reverse(R);
! 103: }
! 104:
! 105: def is_internal_zero(F)
! 106: {
! 107: if ( get_quote_id(F) == 17 && eval_quote(F) == 0 ) return 1;
! 108: else return 0;
! 109: }
! 110:
! 111: def is_mono(F)
! 112: {
! 113: if ( get_quote_id(F) == 17 ) return 1;
! 114: else if ( quote_unify(F,`-X) ) return is_mono(X);
! 115: else if ( quote_unify(F,`(X)) ) return is_mono(X);
! 116: else if ( quote_unify(F,`X*Y) ) return is_mono(X) && is_mono(Y);
! 117: else return 0;
! 118: }
! 119:
! 120: def mul_mono_list(M,F)
! 121: {
! 122: if ( F == [] ) return [];
! 123: else
! 124: return cons(norm_mono(M*car(F)),mul_mono_list(M,cdr(F)));
! 125: }
! 126:
! 127: def mul_list(F,G)
! 128: {
! 129: R = [];
! 130: for ( T = F; T != []; T = cdr(T) ) {
! 131: F0 = car(T);
! 132: S = mul_mono_list(F0,G);
! 133: R = add_list(R,S);
! 134: }
! 135: return R;
! 136: }
! 137:
! 138: /* F, G are normalized monomials */
! 139:
! 140: def compare_mono(F,G)
! 141: {
! 142: FA = extract_factor(F);
! 143: GA = extract_factor(G);
! 144: S = cdr(FA); T = cdr(GA);
! 145: while ( S != [] && T != [] ) {
! 146: S1 = car(S); T1 = car(T);
! 147: if ( !quote_unify(S1,`BS^ES) || !is_nonnegative_integer(ES) ) { BS = S1; ES = 1; }
! 148: if ( !quote_unify(T1,`BT^ET) || !is_nonnegative_integer(ET) ) { BT = T1; ET = 1; }
! 149: if ( BS > BT ) return 1;
! 150: else if ( BS < BT ) return -1;
! 151: else if ( ES > ET ) {
! 152: S = cdr(S); T = cdr(T);
! 153: E = eval_quote(ES-ET);
! 154: S = cons(E==1?BS:BS^E,S);
! 155: } else if ( ES < ET ) {
! 156: S = cdr(S); T = cdr(T);
! 157: E = eval_quote(ET-ES);
! 158: T = cons(E==1?BT:BT^E,T);
! 159: } else {
! 160: S = cdr(S); T = cdr(T);
! 161: }
! 162: }
! 163: if ( S != [] ) return 1;
! 164: else if ( T != [] ) return -1;
! 165: else return 0;
! 166: }
! 167:
! 168: def separate_coef(F)
! 169: {
! 170: if ( quote_unify(F,`-X) ) {
! 171: L = separate_coef(X);
! 172: N = eval_quote(-L[0]);
! 173: return [objtoquote(N),L[1]];
! 174: } else if ( quote_unify(F,`(X)) )
! 175: return separate_coef(X);
! 176: else if ( quote_unify(F,`X*Y) ) {
! 177: L = separate_coef(X); N = objtoquote(eval_quote((L[0])));
! 178: if ( is_number(L[1]) )
! 179: return [N,Y];
! 180: else
! 181: return [N,L[1]*Y];
! 182: } else if ( is_number(F) )
! 183: return [F,`1];
! 184: else
! 185: return [`1,F];
! 186: }
! 187:
! 188: def add_mono(F,G)
! 189: {
! 190: L = separate_coef(F);
! 191: R = separate_coef(G);
! 192: if ( L[1] != R[1] ) error("add_mono : cannot happen");
! 193: C = eval_quote(L[0]+R[0]);
! 194: if ( C == 0 )
! 195: return `0;
! 196: else if ( C == 1 )
! 197: return L[1];
! 198: else if ( C == -1 )
! 199: return -L[1];
! 200: else if ( is_number(L[1]) )
! 201: return objtoquote(C);
! 202: else
! 203: return objtoquote(C)*L[1];
! 204: }
! 205:
! 206: def add_list(F,G)
! 207: {
! 208: R = [];
! 209: while ( F != [] && G != [] ) {
! 210: F0 = car(F); G0 = car(G);
! 211: if ( is_internal_zero(F0) ) F = cdr(F);
! 212: else if ( is_internal_zero(G0) ) G = cdr(G);
! 213: else {
! 214: C = compare_mono(F0,G0);
! 215: if ( C > 0 ) {
! 216: R = cons(F0,R); F = cdr(F);
! 217: } else if ( C < 0 ) {
! 218: R = cons(G0,R); G = cdr(G);
! 219: } else {
! 220: S = add_mono(F0,G0);
! 221: if ( !is_internal_zero(S) )
! 222: R = cons(add_mono(F0,G0),R);
! 223: F = cdr(F); G = cdr(G);
! 224: }
! 225: }
! 226: }
! 227: if ( F != [] ) Rest = F;
! 228: else if ( G != [] ) Rest = G;
! 229: else Rest = [];
! 230: for ( T = R; T != []; T = cdr(T) ) Rest = cons(car(T),Rest);
! 231: return Rest;
! 232: }
! 233:
! 234: def power_list(F,N)
! 235: {
! 236: if ( N == 0 ) return [`1];
! 237: else if ( is_internal_zero(F[0]) ) return [`0];
! 238: else if ( N == 1 ) return F;
! 239: else {
! 240: N1 = idiv(N,2);
! 241: F1 = power_list(F,N1);
! 242: F2 = mul_list(F1,F1);
! 243: if ( N%2 ) F2 = mul_list(F2,F);
! 244: return F2;
! 245: }
! 246: }
! 247:
! 248: def expand(F)
! 249: {
! 250: L = expand0(F);
! 251: for ( R = car(L), L = cdr(L); L != []; L = cdr(L) )
! 252: R += car(L);
! 253: return quote_to_nary(R);
! 254: }
! 255:
! 256: def expand0(F)
! 257: {
! 258: if ( get_quote_id(F) == 17 ) return [F];
! 259: F = quote_to_nary(F);
! 260: if ( quote_unify(F,`-X) ) {
! 261: L = expand0(X);
! 262: return chsgn_list(L);
! 263: } else if ( quote_unify(F,`(X)) )
! 264: return expand0(X);
! 265: else if ( quote_unify(F,`X+Y) ) {
! 266: L = expand0(X); R = expand0(Y);
! 267: return add_list(L,R);
! 268: } else if ( quote_unify(F,`X-Y) ) {
! 269: return expand0(X+(-Y));
! 270: } else if ( quote_unify(F,`X*Y) ) {
! 271: L = expand0(X); R = expand0(Y);
! 272: return mul_list(L,R);
! 273: } else if ( quote_unify(F,`X^Y) ) {
! 274: B = expand0(X);
! 275: if ( is_nonnegative_integer(Y) )
! 276: return power_list(B,eval_quote(Y));
! 277: else
! 278: return [B^Y];
! 279: } else if ( quote_unify(F,`X/Y) ) {
! 280: L = expand0(X);
! 281: return mul_list(L,[(`1)/expand(Y)]);
! 282: } else
! 283: return [F];
! 284: }
! 285: end$