[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.1 and 1.3

version 1.1, 2005/04/01 08:08:36 version 1.3, 2005/04/03 11:05:21
Line 0 
Line 1 
   /* $OpenXM: OpenXM/src/asir-contrib/testing/test1-tr.rr,v 1.2 2005/04/02 05:56:57 takayama Exp $ */
   /* $Id$ */
   
   load("tr.rr")$
   
   
   
   
   def test0() {
     A = quotetolist(quote(1+sin(x)+sin(3*@pi)*sin(0)));
     P = quotetolist(quote(sin(pn("x")*@pi)));
     Q = ["qt_sin_int","x"];
     print(A);
     print(P);
     print(Q);
     print("----------------");
     print(tr_match0(A,P));
     A2 = quotetolist(quote(sin(2*@pi)));
     print(tr_match0(A2,P));
     print("----------------");
     print("---- tr_make_binding --------");
     print(tr_make_binding(A2,P));
     print("-----tr_rp -------------");
     R=tr_rp(A,P,Q);
     print("--------------------");
     print(R);
     print("--------------------");
     return quote_input_form_quote_list(R);
   }
   
   def test1()  {
     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(R0,Rule1[0],Rule1[1]);
     print(print_input_form(R));
     R=tr_apply_rule1(R,Rule2[0],Rule2[1]);
     print(print_input_form(R));
     R=tr_apply_rule1(R,Rule4[0],Rule4[1]);
     print(print_input_form(R));
     R=tr_apply_rule1(R,Rule6[0],Rule6[1]);
     print(print_input_form(R));
     R=tr_apply_rule1(R,Rule4[0],Rule4[1]);
     print(print_input_form(R));
     return R;
   }
   
   
   /* $BITDj@QJ,7W;;$NNc(B
       c x^n $B$NOB$NITDj@QJ,(B (c $B$O(B x $B$K0MB8$;$:(B)
      $B$$$m$$$m(B $BLdBjE@$"$j(B:  $B$?$H$($P(B c $B$,(B $BL5$$$H$-$N=hM}$G$-$:(B.
   */
   
   /* $B1&JU4X?t(B.  c x^n $B$NITDj@QJ,(B (c $B$O(B x $B$K0MB8$;$:(B)
      Todo: $B1&JU4X?t$rMF0W$K=q$/J}K!(B.
   */
   def r_integral0(C,N) {
     NN = eval_str(quote_input_form_quote_list(quotetolist(N)));
     CC = quote_input_form_quote_list(quotetolist(C));
     if (NN == -1) {
        R = "quote("+CC+"*log(x))";
     }else{
        R = "quote("+CC+"/"+rtostr(NN+1)+"*x^"+rtostr(NN+1)+")";
     }
     print("r_integral0:",0);print(R);
     R = eval_str(R);
     return quotetolist(R);
   }
   /* $B1&JU4X?t(B $B@QJ,$N@~7?@-(B */
   def r_int_linear(F,G) {
     FF = quote_input_form_quote_list(quotetolist(F));
     GG = quote_input_form_quote_list(quotetolist(G));
     R = "quote(integral("+FF+")+integral("+GG+"))";
     print("r_int_linear:",0);print(R);
     R = eval_str(R);
     return quotetolist(R);
   }
   def test3() {
     R0 = quote(1+integral(2*x^(-1)+2*x^2));
     return test3a(R0);
   }
   def test3a(R0)  {
     Rules=[
        /* c*x^n --> (c/(n+1))*x^(n+1) or c*log(x) */
        [quote(integral(pn("c")*x^pn("n"))),["r_integral0","c","n"]],
        [quote(integral(pn("f")+pn("g"))),  ["r_int_linear","f","g"]]
     ];
     print("Input=",0); print(print_input_form(R0));
     N = length(Rules);
     R = R0;
     for (J=0; J<3; J++) {  /* Todo: $B%U%i%0$,$J$$$N$G(B, $B$H$j$"$($:(B 3 $B2s(B */
       for (I=0; I<N; I++) {
         print(print_input_form(R));
         R=tr_apply_rule1(R,Rules[I][0],Rules[I][1]);
       }
     }
     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];
   }
   
   /* $B=q$-49$((B flag $BIU$-$N(B tr_apply_rule_flag */
   def tr_apply_rule1_flag(Obj,L,R) {
     Flag = 0;
     dprint("--------  start of tr_apply_rule1_flag ------------ ");
     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)+")";
     dprint("--------  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;
   }
   
   end$
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>