[BACK]Return to test1-tr.rr CVS log [TXT][DIR] Up to [local] / OpenXM / src / asir-contrib / testing

Diff for /OpenXM/src/asir-contrib/testing/test1-tr.rr between version 1.2 and 1.5

version 1.2, 2005/04/02 05:56:57 version 1.5, 2005/04/15 12:47:14
Line 1 
Line 1 
 /* $OpenXM$ */  
 /* $Id$ */  /* $Id$ */
   /* $OpenXM: OpenXM/src/asir-contrib/testing/test1-tr.rr,v 1.4 2005/04/06 09:26:28 takayama Exp $ */
   
 load("tr.rr")$  load("tr.rr")$
   
Line 102  def test3a(R0)  {
Line 102  def test3a(R0)  {
   return R;    return R;
 }  }
   
   
   /* $B4X?t$N%^%C%A(B.  N[] $BAjEv(B.  test4(). */
   /*  quote(nn(pn(f),qt_is_function(f))); $B$OITMW(B. qt_map_arg $B$,=hM}(B */
   def test4() {
     Rule=[quote(nn(pn(f))),[qt_map_arg,nn,f]];
     R0 = quote(nn(sin(1/2)*cos(1/3)));
     print(print_input_form(R0));
     R=tr_apply_rule1(R0,Rule[0],Rule[1]);
     return R;
   }
   
   /* tr_apply_or_rule $B$N;n:n(B */
   
   /* Flag $BIU$-(B $B$N(B tr_rp. $BB0@-$,$J$$$N$G$3$l$G$d$k(B. */
   def tr_rp_flag(F,P,Q) {
     Flag = 0;
     dprint0("tr_rp, F="); dprint(F);
     dprint0("tr_rp, P="); dprint(P);
     dprint0("tr_rp, Q="); dprint(Q);
     if (tr_match0(F,P)) {
        BindTable = tr_make_binding(F,P);
        dprint0("BindTable="); dprint(BindTable);
        return [1,tr_apply_function0(Q,BindTable)];
     }
     if (type(F) != 4) return F;
     Node = qt_node(F);
     N = qt_nchild(F);
     Ans = Node;
     for (I=0; I<N; I++) {
       T = tr_rp_flag(qt_child(F,I),P,Q);
       if (T[0] == 1) Flag = 1;
       Ans = append(Ans,[T[1]]);
     }
     return [Flag,Ans];
   }
   
   extern Debug2$
   Debug2=0$
   /* $B=q$-49$((B flag $BIU$-$N(B tr_apply_rule_flag */
   def tr_apply_rule1_flag(Obj,L,R) {
     Flag = 0;
     if (Debug2)
      print("--------  start of tr_apply_rule1_flag ------------ ");
     if (Debug2) print(print_input_form(Obj));
     Obj = quotetolist(Obj);
     L = quotetolist(L);
     R = tr_rp_flag(Obj,L,R);
     Flag=R[0]; R=R[1];
     if (type(R) == 17) R=quotetolist(R);
     RR = "quote("+listtoquote_str(R)+")";
     if (Debug2) {print("==> "+RR+"  by  "); print(listtoquote_str(L));}
     if (Debug2) print("--------  end of tr_apply_rule1_flag ------------ ");
     return [Flag,eval_str(RR)];
   }
   
   def tr_apply_or_rules(Q,R) {
     Flag = 1;
     N = length(R);
     while (Flag) {
      Flag = 0;
      for (I=0; I<N; I++) {
        Q = tr_apply_rule1_flag(Q,R[I][0],R[I][1]);
        if (Q[0]) {
          Flag = 1;
          dprint("Applied the rule "+rtostr(I));
        }
        Q = Q[1];
      }
     }
     return Q;
   }
   def test5() {
     Rule1=[quote(sin(pn(x)*@pi)),[qt_sin_int,x]]; /* sin($B@0?t(B*@pi) --> 0 */
     Rule2=[quote(0*pn(y)),       [qt_zero]];       /* 0*any --> 0 */
     Rule3=[quote(pn(y)*0),       [qt_zero]];       /* any*0 --> 0 */
     Rule4=[quote(pn(y)+0),       [qt_id,y]];       /* any+0 --> any */
     Rule5=[quote(0+pn(y)),       [qt_id,y]];       /* 0+any --> any */
     Rule6=[quote(sin(0)),          [qt_zero]];       /* sin(0) --> 0 */
     R0 = quote(1+sin(sin(2*@pi)*sin(@pi/2))+sin(5*@pi));
     print(print_input_form(R0));
     R=tr_apply_rule1_flag(R0,Rule1[0],Rule1[1]);
     print([R[0],print_input_form(R[1])]);
     R=tr_apply_or_rules(R0,[Rule1,Rule2,Rule3,Rule4,Rule5,Rule6]);
     return R;
   }
   
   /* $BHyJ,4D$N7W;;(B */
   /* x $B$K0MB8$7$F$k$+(B?  u, u_0, u_1, u_2, ... $B$O(B x $B$K0MB8$7$F$k(B.*/
   def to_quote(L) {
     return eval_str("quote("+listtoquote_str(L)+")");
   }
   def dep6(Q) {
     if (type(Q) == 4) {
       Q = to_quote(Q);
     }
     if (qt_is_dependent(Q,x)) return 1;
     if (qt_is_dependent(Q,u)) return 1;
     /* $B$H$j$"$($:(B 10 $B<!$^$G$N(B f. --> $B$J$s$H$+$;$h(B. */
     for (I=0; I<10; I++) {
       if (qt_is_dependent(Q,idxtov(u,I))) return 1;
     }
     return 0;
   }
   def diff_lin(F,G) {
     if (type(F) == 4) F=to_quote(F);
     if (type(G) == 4) G=to_quote(G);
     return qt_replace(quote(diff(f)+diff(g)),[[f,F],[g,G]]);
   }
   def diff_mul(F,G) {
     F1 = dep6(F); G1 = dep6(G);
     if (type(F) == 4) F=to_quote(F);
     if (type(G) == 4) G=to_quote(G);
     if (F1 && G1)
       return qt_replace(quote(diff(f)*g+f*diff(g)),[[f,F],[g,G]]);
     if ((F1 == 1) &&  (G1 == 0))
       return qt_replace(quote(diff(f)*g),[[f,F],[g,G]]);
     if ((F1 == 0) &&  (G1 == 1))
       return qt_replace(quote(f*diff(g)),[[f,F],[g,G]]);
     if ((F1 == 0) && (G1 == 0))
       return qt_zero();
   }
   def qt_one() {
     return quote(1);
   }
   def diff_x_n(N) {
     N = eval_quote(N);
     N1=N-1;
     if (N1 == 0)  return qt_one();
     if (N1 == 1)  return quote(2*x);
     if (N1 > 1) return eval_str("quote("+rtostr(N)+"*x^"+rtostr(N1)+")");
   }
   /* F $B$,(B u $B$H$+(B u_0, u_1, ... $B$J$i(B 1 $B$rLa$9(B. */
   /* debug $BMQ$NF~NO(B.
     tr_check_pn(quote(u_1),quote(pn(x,is_u_variable(x))));
   */
   def is_u_variable(F) {
     /* $B=R8l$NA0$N(B check point $B$b(B debugger $B$KM_$7$$(B. */
     /* print("is_u_variable: ",0); print(print_input_form(F)); */
     if (type(F) == 17) F=quotetolist(F);
     if (rtostr(F[0]) == "internal") {
       V = eval_str(rtostr(F[1]));
       if (vtoidx(V)[0] == "u") return 1;
     }
     return 0;
   }
   /*  u_i^n $B$NHyJ,$r$9$k(B.  n*u_{i+1}*u_i^{n-1}
      Todo: $B$b$C$H4J7i$K(B quote $B$r=q$1$J$$$+(B?
   */
   def diff_u_n(F,N) {
     F = eval_quote(F);
     I = vtoidx(F);
     if (length(I) == 1) I = 0; else I=I[1];
     N = eval_quote(N);
     N1=N-1;
     NextU = "u_"+rtostr(I+1);
     if (I == 0) U = "u"; else U = "u_"+rtostr(I);
   
     NN = objtoquote(N);
     NN1 = objtoquote(N1);
     NextU = objtoquote(eval_str(NextU));
     U = objtoquote(eval_str(U));
   
     if (N1 == 0)  return NextU;
     if (N1 == 1)  return qt_replace(quote(2*up*uu),[[up,NextU],[uu,U]]);
     if (N1 > 1) return qt_replace(quote(n*up*uu^m),[[up,NextU],[uu,U],
        [n,NN],[m,NN1]]);
   }
   
   def test6b() {
     T1=[quote(diff(x)),[qt_one]];
     T2=[quote(diff(x^pn(n))),[diff_x_n,n]];  /* is_poly? $B$,M_$7$$(B. */
     R1=[quote(diff(pn(f)+pn(g))),[diff_lin,f,g]];
     R2=[quote(diff(pn(f)*pn(g))),[diff_mul,f,g]];
   
     A = quote(diff(2*4*x^3+x));
     print(print_input_form(A));
     R=tr_apply_or_rules(A,[R1,R2,T1,T2]);
     return R;
   }
   
   /* Use Debug2=1; $B$O(B debug $B$K$H$F$bM-1W(B. */
   def test6() {
     T1=[quote(diff(x)),[qt_one]];
     T2=[quote(diff(x^pn(n))),[diff_x_n,n]];  /* is_poly? $B$,M_$7$$(B. */
     T3=[quote(diff(pn(f,is_u_variable(f))^pn(n))),[diff_u_n,f,n]];
     R1=[quote(diff(pn(f)+pn(g))),[diff_lin,f,g]];
     R2=[quote(diff(pn(f)*pn(g))),[diff_mul,f,g]];
   
     /* A = quote(diff(2*x^3+x));*/
     A = quote(diff(2*u^3+x));
     print(print_input_form(A));
     R=tr_apply_or_rules(A,[R1,R2,T1,T2,T3]);
     return R;
   }
 end$  end$
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>