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$