Return to new_rewrite.rr CVS log

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

Annotation of OpenXM/src/asir-contrib/testing/noro/new_rewrite.rr, Revision 1.3

1.3     ! noro        1: /* $OpenXM: OpenXM/src/asir-contrib/testing/noro/new_rewrite.rr,v 1.2 2005/12/16 23:49:26 noro Exp $ */
1.1       noro        2:
                      3: /*
                      4:  * test functions for rewriting by rules
                      5:  *
                      6:  * usage : qt_rewrite(Expr,Rules,0|1|2) 0 : do not expand, 1 : expand
                      7:  *
                      8:  */
                      9:
                     10: /* commutativity */
                     11: #if 0
1.3     ! noro       12: Rc0=[`X*Y,`!qt_is_number(X) && nqt_comp(X,Y)<0,`Y*X]$
1.1       noro       13: #else
1.3     ! noro       14: Rc0=[`X*Y,`nqt_comp(Y*X,X*Y)>0,`Y*X]$
1.1       noro       15: #endif
                     16: Rcomm = [Rc0]$
                     17:
                     18: /* alternativity */
                     19: Ra0=[`X*Y,`qt_is_var(X) && qt_is_var(Y) && nqt_comp(Y,X)>0,`-Y*X]$
                     20: Ra1=[`X^N,`eval_quote(N)>=2,`0]$
                     21: Ra2=[`X*X,`0]$
                     22: Ralt = [Ra0,Ra1,Ra2]$
                     23:
                     24: /* simplifier of exp() */
1.3     ! noro       25: Re1=[`exp(X)*exp(Y),`exp(X+Y)]$
        !            26: Re2=[`exp(X)^K,`exp(K*X)]$
1.1       noro       27: Re3=[`exp(0),`1]$
1.3     ! noro       28: Re4=[`exp(N*p*i),`qt_is_integer(N) && eval_quote(N)%2==0,`1]$
1.1       noro       29: Rexp = [Re1,Re2,Re3,Re4]$
                     30:
1.3     ! noro       31: R5=[`(V^N)^M,`V^(N*M)]$
1.1       noro       32:
                     33: /* integration */
1.3     ! noro       34: Ri1=[`int(F+G,X),`int(F,X)+int(G,X)]$
        !            35: Ri2=[`int(N*F,X),`qt_is_number(N),`N*int(F,X)]$
        !            36: Ri3=[`int(F,X),`qt_is_number(F), `F*X]$
        !            37: Ri4=[`int(X^N,X),`qt_is_number(N) && eval_quote(N)!=-1,`X^(N+1)/(N+1)]$
        !            38: Ri5=[`int(X^(-1),X),`log(X)]$
        !            39: Ri6=[`int((A*X+B)^(-1),X),`1/A*log(A*X+B)]$
1.1       noro       40: Rint = [Ri1,Ri2,Ri3,Ri4,Ri5,Ri6]$
                     41:
                     42: /* derivation */
1.3     ! noro       43: Rd0=[`d(N*X),`qt_is_number(N),`N*d(X)]$
1.1       noro       44: Rd1=[`d(X+Y),`d(X)+d(Y)]$
                     45: Rd2=[`d(X*Y),`d(X)*Y+X*d(Y)]$
1.3     ! noro       46: Rd3=[`d(N),`qt_is_number(N),`0]$
        !            47: Rd=[Rd1,Rd2,Rd3]$
1.1       noro       48:
                     49: /* representing an expression as a polynomial w.r.t. x */
                     50: /* T = qt_rewrite(qt_rewrite(Expr,[Ru0],1),[Ru1],0) */
1.3     ! noro       51: Ru0=[`x^N*X,`X*x^N]$
        !            52: Ru1=[`F*x^N+G*x^N,`(F+G)*x^N]$
1.1       noro       53: #define O_LIST 4
                     54: #define O_QUOTE 17
                     55:
                     56: ctrl("print_quote",2)$
                     57:
                     58: def normalize_rule(R,Expand)
                     59: {
                     60:        return map(qt_normalize,R,Expand);
                     61: }
                     62:
                     63: def qt_rewrite(F,Rules,Expand)
                     64: {
                     65:        F = qt_normalize(F,Expand);
                     66:        Rules = map(normalize_rule,Rules,Expand);
                     67:
                     68:        /* rewrite chidren */
                     69:        F00 = F0 = F;
                     70:        while ( 1 ) {
                     71:                FA = quote_to_funargs(F);
                     72:                for ( R = [FA[0]], T = cdr(FA); T != []; T = cdr(T) ) {
                     73:                        E = car(T); TE = type(E);
                     74:                        if ( TE == O_QUOTE )
                     75:                                E1 = qt_rewrite(E,Rules,Expand);
                     76:                        else if ( TE == O_LIST )
                     77:                                E1 = map(qt_rewrite,E,Rules,Expand);
                     78:                        else
                     79:                                E1 = E;
                     80:                        R = cons(E1,R);
                     81:                }
                     82:                F = qt_normalize(funargs_to_quote(reverse(R)),Expand);
                     83:                if ( F == F0 ) break;
                     84:                else F0 = F;
                     85:        }
                     86:        F0 = F;
                     87:        while ( 1 ) {
                     88:                for ( T = Rules; T != []; T = cdr(T) ) {
                     89:                        F1 = nqt_match_rewrite(F,car(T),Expand);
                     90:                        if ( F1 != F ) {
                     91:                                F = F1; break;
                     92:                        }
                     93:                }
                     94:                if ( F == F0 ) break;
                     95:                else F0 = F;
                     96:        }
                     97:        if ( F00 == F ) return F;
                     98:        else return qt_normalize(qt_rewrite(F,Rules,Expand),Expand);
                     99: }
                    100: end$
                    101: