Return to rewriting.rr CVS log

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

An experimental functions to implement iterators for F-node trees.
Try test0(), test1(), test2(), test3().

/* $OpenXM: OpenXM/src/asir-contrib/testing/rewriting.rr,v 1.1 2005/03/30 05:10:40 takayama Exp $ */

/*  
  OpenXM$BHG$N(B Risa/Asir $B$G<B9T$N$3$H(B. OpenXM $BHG$N4X?t$rMQ$$$k$?$a(B.
*/
/* $Id: quote2.rr,v 1.5 2005/03/30 05:03:44 taka Exp $
  $B$3$N%U%!%$%k$O(B quotetolist $B$G%j%9%H$KJQ49$7$?%G!<%?$KBP$7$F(B
  $B%Q%?!<%s%^%C%A$*$h$S$=$l$r1~MQ$7$?JQ7A$r9T$&(B.
  $B%F%9%H%W%m%0%i%`$N$?$a8zN($OL5;k(B.   (append $B$NB?MQ(B, $BL5BL$J(B2$B=E8F$S=P$7(B, $B$J$I(B))
*/

extern Debug$
Debug=0$
def dprint(X) {
  if (Debug) print(X);
}
def dprint0(X) {
  if (Debug) print(X,0);
}

/*
  $BJQ?t%Q%?!<%s$N=q$-J}(B
  pn(name)  pattern $B$NA0$H8e$m$r$H$j(B pn
  pn("x")

  Todo: pn(name,length,type) 
        pn("x","rest")?

  $B4X?t%Q%?!<%s$N=q$-J}(B. (Todo)
  fn(name,argv)
  fn("f",1,23) --> f(1,23) $B$X(B.
*/

/*
  Rule $B$NNc(B1:
    sin(3*@pi) $BEy$r(B 0 $B$K=q$-49$($kNc(B:
      quote(sin(pn("n")*@pi))
  --> f(n)
  
  def f(X) { if (X$B$,@0?t(B) return 0; else sin(X*@pi); }

   Rule $B$N:8JU$O(B quote $B7?$N%Q%?!<%s(B. $B1&JU$O$+$J$i$:(B asir $B$N4X?t(B.

   [function,sin,[b_op,*,[function,pn,[internal,x]],[function,@pi]]]
   [function,fn,[internal,f],[internal,x]]

   $B2<$N(B test0(), test1(), test2() $B$r;2>H(B.  
*/

/*
 $BNc(B: $BITDj@QJ,(B.  test3() $B$r;2>H(B.
*/

/*   Todo:
 $BNc(B. Mathematica $B$N(B N[ ] $BAjEv$N4X?t$r%f!<%6$,=q$1$k$h$&$K(B.
    nn(sin(cos(@pi)+sqrt(2))) 
    --> nn(sin(nn(cos(nn(@pi)))+nn(sqrt(nn(2)))))

 $BNc(B: $BQQ5i?t$N7W;;$r(B quote $B$G<B8=(B.
        sort $B$d(B expand $B$OAH$_9~$_$G(B.

 $BNc(B: Mathematica $B$N(B Expand[], Toghether[] $BAjEv$N$b$N(B.

 $BNc(B: D $B$N3]$1;;$r(B $B%Q%?!<%s%^%C%A$G<B8=(B.  

 $BNc(B: (x^(1/n))^n --> x $BEy(B.

*/

/*
 $B%H%C%W%l%Y%k$N4X?tC#(B.  (stylesheet $B$N9M$($K;w$F$k(B.)
  apply_rule1(Obj,rule). 
  apply_rule1 $B$O(B iterator $B$N0l<o(B. $B1&JU$O$D$M$K4X?t(B.

  Todo: rules $B$O%f!<%6Dj5A$N$b$N$H(B default rule $BL>$,$"$k(B.
      $B$?$H$($P(B sort $B$H$+E83+(B, 0 $B$N:o=|$OAH$_9~$_(B rule $B$H$7$FM_$7$$(B.
*/

def node(F) {
   return [F[0],F[1]];
}
/* Number of  child */
def nchild(F) {
   return length(F)-2;
}
def child(F,K) {
   return F[K+2];
}

/* 
   $B%j%9%H(B F $B$,(B $B%j%9%H(B P $B$K(B($B@hF,$+$i$NHf3S$G(B)$B%^%C%A$7$?$i(B 1.
   $B$=$&$G$J$$$+$i(B 0.  $BI}M%@hC5:w(B.
    Todo: P $B$KG$0U4X?t$r4^$`;EAH$_$O$^$@<BAu$7$F$J$$(B.  
         $B$?$H$($P(B  quote(nn(fn("f"))) 
         $B$3$N>l9g(B quote(nn(sin(1.3))) $B$K(B f=sin , $B0z?t(B 1.3 $B$G(B match.
         $B$3$N>l9g(B quote(nn(cos(1.3))) $B$K(B f=cos , $B0z?t(B 1.3 $B$G(B match.
         nn(f(g(x)+h(x))) --> nn(f(nn(g(x))+nn(h(x)))) $B$H$7$?$$(B.

*/
def match0(F,P)  {
  dprint0("F="); dprint(F);
  dprint0("P="); dprint(P);  

  if (type(F) != type(P)) return 0;
  if (type(F) != 4) {
    if (F == P) return 1;
    else return 0;
  }
  Node = node(F);
  Node2 = node(P);
  if (Node2 == ["function","pn"]) return 2;
  if (Node != Node2) return 0;
  N = nchild(F);
  if (N != nchild(P)) return 0;
  for (I=0; I<N; I++) {
     C = child(F,I);
     C2 = child(P,I);
     if (!match0(C,C2)) return 0;
  }
  return 1;
}

/* F $B$H(B P $B$,(B match0 $B$9$k$H$-(B  bindingTable $B$r$b$I$9(B.
  [[$BJQ?t$NL>A0(B($BJ8;zNs(B), $BCM(B(list)], ...]
*/
def makeBind(F,P) {
  Ans = [ ];
  if (F == P) return Ans;

  Node = node(F);
  Node2 = node(P);

  if (Node2 == ["function", "pn"]) {
     Ans = append(Ans,[[P[2][1],F]]);
     return Ans;
  }
  N = nchild(F);
  for (I=0; I<N; I++) {
     C = child(F,I);
     C2 = child(P,I);
     Ans = append(Ans,makeBind(C,C2));
  }
  return Ans;
}

/* 
   Tree $B$NCf$rI}M%@hC5:w$G8!:w$7$F(B $BCV$-49$($k(B.
   $BI}M%@hC5:w$J$N$G(B, $BF1$8(B rule $B$K%^%C%A$9$k$b$N$,F~$l;R$K$J$C$?>l9g(B, 
   $BFbB&$OCV$-49$($i$l$J$$(B.
   Todo: $B?<$5M%@hC5:w(B.
   Todo: $B=q$-49$($,$*$3$C$?$+$N%U%i%0(B.
*/
def rp(F,P,Q) {
  dprint0("rp, F="); dprint(F);
  dprint0("rp, P="); dprint(P);
  dprint0("rp, Q="); dprint(P);
  if (match0(F,P)) {
     BindTable = makeBind(F,P);
     dprint0("BindTable="); dprint(BindTable);
     return applyfunction0(Q,BindTable);
  }
  if (type(F) != 4) return F;
  Node = node(F);
  N = nchild(F);
  Ans = Node;
  for (I=0; I<N; I++) {
    T = rp(child(F,I),P,Q);
    Ans = append(Ans,[T]); 
  }
  return Ans;
}

/* ["f","x"],[["x",[internal,3]]]  $B$N;~$O(B
   f(3) $B$r7W;;$9$k(B.
*/
def applyfunction0(Q,BindTable) {
  B = [ ];
  N = length(BindTable);
  /* BindTable $B$N1&JUCM$r(B quote(...) $B$J$kJ8;zNs$K(B */
  for (I=0; I<N; I++) {
    B = append(B,[[BindTable[I][0],"quote("+quote_input_form_quote_list(BindTable[I][1])+")"]]);
  } 
  dprint0("applyfunction0: "); dprint(B);
  N = length(Q)-1; /* $B0z?t$N?t(B */
  M = length(B);   /*  binding table $B$N%5%$%:(B */
  R = Q[0]+"(";
  for (I=0; I<N; I++) {
    X = rtostr(Q[I+1]); /* $BJQ?t(B */
    /* binding Table $B$r%5!<%A(B */
    for (J=0; J<M; J++) {
       Y = rtostr(B[J][0]);
       if (X == Y) {
          R = R+B[J][1];
          if (I != N-1) R = R+",";
          break;
       }
       if (J == M-1) error("No binding data.");
    }
  }
  R = R+")";
  dprint0("R="); dprint(R);
  return eval_str(R);
}

/* $B1&5,B'4X?t(B.  sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B */
def r_sin_int(X) {
  /* $B$$$^(B X $B$O(B quote $B7?(B */
  Y = quotetolist(X);
  /* Todo: $B$3$N$h$&$J$b$N$r:n$k5!G=$OAH$_9~$_$GM_$7$$(B. */
  R = "quote(sin("+quote_input_form_quote_list(Y)+"*@pi))";
  print(R);
  R = eval_str(R);
  /* Todo: X $B$,(B $B?t;z$+$I$&$+D4$Y$k5!G=$bAH$_9~$_$GM_$7$$(B.
  */
  if (Y[0] == "internal") {
     Z = eval_str(rtostr(Y[1]));
  }else{ 
    return quotetolist(R);
  }
  if (type(Z) == 0) return quotetolist(quote(0));
  if ((type(Z) == 1) &&   (ntype(Z) == 0)) return quotetolist(quote(0));
  return quotetolist(R);
}

/* L $B$,:85,B'(B. R $B$,1&5,B'(B.  $BI}M%@hC5:w(B.
  $BNc(B: 
    apply_rule1(quote(1+sin(3*@pi)*sin(@pi/2)),
                quote(sin(pn("x")*@pi)),
                ["r_sin_int","x"]);
*/
def apply_rule1(Obj,L,R) {
  dprint("--------  start of apply_rule1 ------------ ");
  Obj = quotetolist(Obj);
  L = quotetolist(L);
  R = rp(Obj,L,R);
  RR = "quote("+quote_input_form_quote_list(R)+")";
  dprint("--------  end of apply_rule1 ------------ ");
  return eval_str(RR);  
}

def test0() {
  A = quotetolist(quote(1+sin(x)+sin(3*@pi)*sin(0)));
  P = quotetolist(quote(sin(pn("x")*@pi)));
  Q = ["r_sin_int","x"];
  print(A);
  print(P);
  print(Q);
  print("----------------");
  print(match0(A,P));
  A2 = quotetolist(quote(sin(2*@pi)));
  print(match0(A2,P));
  print("----------------");
  print("---- makeBind --------");
  print(makeBind(A2,P));
  print("-----rp -------------");
  R=rp(A,P,Q);
  print("--------------------");
  print(R);
  print("--------------------");
  return quote_input_form_quote_list(R);
}

/* $B1&5,B'4X?t(B.   0 $B$rLa$9(B. */
def r_zero() {
  return quotetolist(quote(0));
}

/* $B1&5,B'4X?t(B.   $B91Ey<0(B */
def r_id(X) {
  return quotetolist(X);
}

def test1()  {
  Rule1=[quote(sin(pn("x")*@pi)),["r_sin_int","x"]]; /* sin($B@0?t(B*@pi) --> 0 */
  Rule2=[quote(0*pn("y")),       ["r_zero"]];       /* 0*any --> 0 */
  Rule3=[quote(pn("y")*0),       ["r_zero"]];       /* any*0 --> 0 */
  Rule4=[quote(pn("y")+0),       ["r_id","y"]];       /* any+0 --> any */
  Rule5=[quote(0+pn("y")),       ["r_id","y"]];       /* 0+any --> any */
  Rule6=[quote(sin(0)),          ["r_zero"]];       /* sin(0) --> 0 */
  R0 = quote(1+sin(sin(2*@pi)*sin(@pi/2))+sin(5*@pi));
  print(print_input_form(R0));
  R=apply_rule1(R0,Rule1[0],Rule1[1]);
  print(print_input_form(R));
  R=apply_rule1(R,Rule2[0],Rule2[1]);
  print(print_input_form(R));
  R=apply_rule1(R,Rule4[0],Rule4[1]);
  print(print_input_form(R));
  R=apply_rule1(R,Rule6[0],Rule6[1]);
  print(print_input_form(R));
  R=apply_rule1(R,Rule4[0],Rule4[1]);
  print(print_input_form(R));
  return R;
}

/* $BI}M%@hC5:w$N>l9g(B, $B$3$l$O(B simplify $B$G$-$:(B. */
def test2() {
  Rule1=[quote(sin(pn("x")*@pi)),["r_sin_int","x"]];
  R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
  print(print_input_form(R0));
  R=apply_rule1(R0,Rule1[0],Rule1[1]);
  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=apply_rule1(R,Rules[I][0],Rules[I][1]);
    }
  }
  return R;
}

end$