Annotation of OpenXM/src/asir-contrib/testing/rewriting.rr, Revision 1.2
1.2 ! takayama 1: /* $OpenXM: OpenXM/src/asir-contrib/testing/rewriting.rr,v 1.1 2005/03/30 05:10:40 takayama Exp $ */
1.1 takayama 2:
3: /*
4: OpenXM$BHG$N(B Risa/Asir $B$G<B9T$N$3$H(B. OpenXM $BHG$N4X?t$rMQ$$$k$?$a(B.
5: */
1.2 ! takayama 6: /* $Id: quote2.rr,v 1.7 2005/03/30 10:48:29 taka Exp $
1.1 takayama 7: $B$3$N%U%!%$%k$O(B quotetolist $B$G%j%9%H$KJQ49$7$?%G!<%?$KBP$7$F(B
8: $B%Q%?!<%s%^%C%A$*$h$S$=$l$r1~MQ$7$?JQ7A$r9T$&(B.
9: $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))
10: */
11:
12: extern Debug$
13: Debug=0$
14: def dprint(X) {
15: if (Debug) print(X);
16: }
17: def dprint0(X) {
18: if (Debug) print(X,0);
19: }
20:
21: /*
22: $BJQ?t%Q%?!<%s$N=q$-J}(B
23: pn(name) pattern $B$NA0$H8e$m$r$H$j(B pn
24: pn("x")
25:
26: Todo: pn(name,length,type)
27: pn("x","rest")?
28:
29: $B4X?t%Q%?!<%s$N=q$-J}(B. (Todo)
30: fn(name,argv)
31: fn("f",1,23) --> f(1,23) $B$X(B.
32: */
33:
34: /*
35: Rule $B$NNc(B1:
36: sin(3*@pi) $BEy$r(B 0 $B$K=q$-49$($kNc(B:
37: quote(sin(pn("n")*@pi))
38: --> f(n)
39:
40: def f(X) { if (X$B$,@0?t(B) return 0; else sin(X*@pi); }
41:
42: Rule $B$N:8JU$O(B quote $B7?$N%Q%?!<%s(B. $B1&JU$O$+$J$i$:(B asir $B$N4X?t(B.
43:
44: [function,sin,[b_op,*,[function,pn,[internal,x]],[function,@pi]]]
45: [function,fn,[internal,f],[internal,x]]
46:
47: $B2<$N(B test0(), test1(), test2() $B$r;2>H(B.
48: */
49:
50: /*
51: $BNc(B: $BITDj@QJ,(B. test3() $B$r;2>H(B.
52: */
53:
54: /* Todo:
55: $BNc(B. Mathematica $B$N(B N[ ] $BAjEv$N4X?t$r%f!<%6$,=q$1$k$h$&$K(B.
56: nn(sin(cos(@pi)+sqrt(2)))
57: --> nn(sin(nn(cos(nn(@pi)))+nn(sqrt(nn(2)))))
58:
59: $BNc(B: $BQQ5i?t$N7W;;$r(B quote $B$G<B8=(B.
60: sort $B$d(B expand $B$OAH$_9~$_$G(B.
61:
62: $BNc(B: Mathematica $B$N(B Expand[], Toghether[] $BAjEv$N$b$N(B.
63:
64: $BNc(B: D $B$N3]$1;;$r(B $B%Q%?!<%s%^%C%A$G<B8=(B.
65:
66: $BNc(B: (x^(1/n))^n --> x $BEy(B.
67:
68: */
69:
70: /*
71: $B%H%C%W%l%Y%k$N4X?tC#(B. (stylesheet $B$N9M$($K;w$F$k(B.)
72: apply_rule1(Obj,rule).
73: apply_rule1 $B$O(B iterator $B$N0l<o(B. $B1&JU$O$D$M$K4X?t(B.
74:
75: Todo: rules $B$O%f!<%6Dj5A$N$b$N$H(B default rule $BL>$,$"$k(B.
76: $B$?$H$($P(B sort $B$H$+E83+(B, 0 $B$N:o=|$OAH$_9~$_(B rule $B$H$7$FM_$7$$(B.
77: */
78:
79: def node(F) {
80: return [F[0],F[1]];
81: }
82: /* Number of child */
83: def nchild(F) {
84: return length(F)-2;
85: }
86: def child(F,K) {
87: return F[K+2];
88: }
89:
90: /*
91: $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.
92: $B$=$&$G$J$$$+$i(B 0. $BI}M%@hC5:w(B.
93: Todo: P $B$KG$0U4X?t$r4^$`;EAH$_$O$^$@<BAu$7$F$J$$(B.
94: $B$?$H$($P(B quote(nn(fn("f")))
95: $B$3$N>l9g(B quote(nn(sin(1.3))) $B$K(B f=sin , $B0z?t(B 1.3 $B$G(B match.
96: $B$3$N>l9g(B quote(nn(cos(1.3))) $B$K(B f=cos , $B0z?t(B 1.3 $B$G(B match.
97: nn(f(g(x)+h(x))) --> nn(f(nn(g(x))+nn(h(x)))) $B$H$7$?$$(B.
98:
99: */
100: def match0(F,P) {
101: dprint0("F="); dprint(F);
102: dprint0("P="); dprint(P);
103:
104: if (type(F) != type(P)) return 0;
105: if (type(F) != 4) {
106: if (F == P) return 1;
107: else return 0;
108: }
109: Node = node(F);
110: Node2 = node(P);
111: if (Node2 == ["function","pn"]) return 2;
112: if (Node != Node2) return 0;
113: N = nchild(F);
114: if (N != nchild(P)) return 0;
115: for (I=0; I<N; I++) {
116: C = child(F,I);
117: C2 = child(P,I);
118: if (!match0(C,C2)) return 0;
119: }
120: return 1;
121: }
122:
123: /* F $B$H(B P $B$,(B match0 $B$9$k$H$-(B bindingTable $B$r$b$I$9(B.
124: [[$BJQ?t$NL>A0(B($BJ8;zNs(B), $BCM(B(list)], ...]
125: */
126: def makeBind(F,P) {
127: Ans = [ ];
128: if (F == P) return Ans;
129:
130: Node = node(F);
131: Node2 = node(P);
132:
133: if (Node2 == ["function", "pn"]) {
134: Ans = append(Ans,[[P[2][1],F]]);
135: return Ans;
136: }
137: N = nchild(F);
138: for (I=0; I<N; I++) {
139: C = child(F,I);
140: C2 = child(P,I);
141: Ans = append(Ans,makeBind(C,C2));
142: }
143: return Ans;
144: }
145:
146: /*
147: Tree $B$NCf$rI}M%@hC5:w$G8!:w$7$F(B $BCV$-49$($k(B.
148: $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,
149: $BFbB&$OCV$-49$($i$l$J$$(B.
1.2 ! takayama 150: $B?<$5M%@hC5:w(B --> $B$H$j$"$($:$O(B action $B4X?t$NCf$G:F5"E*$K8F$Y$P?<$5M%@h$H$J$k(B.
1.1 takayama 151: Todo: $B=q$-49$($,$*$3$C$?$+$N%U%i%0(B.
152: */
153: def rp(F,P,Q) {
154: dprint0("rp, F="); dprint(F);
155: dprint0("rp, P="); dprint(P);
156: dprint0("rp, Q="); dprint(P);
157: if (match0(F,P)) {
158: BindTable = makeBind(F,P);
159: dprint0("BindTable="); dprint(BindTable);
160: return applyfunction0(Q,BindTable);
161: }
162: if (type(F) != 4) return F;
163: Node = node(F);
164: N = nchild(F);
165: Ans = Node;
166: for (I=0; I<N; I++) {
167: T = rp(child(F,I),P,Q);
168: Ans = append(Ans,[T]);
169: }
170: return Ans;
171: }
172:
173: /* ["f","x"],[["x",[internal,3]]] $B$N;~$O(B
174: f(3) $B$r7W;;$9$k(B.
175: */
176: def applyfunction0(Q,BindTable) {
177: B = [ ];
178: N = length(BindTable);
179: /* BindTable $B$N1&JUCM$r(B quote(...) $B$J$kJ8;zNs$K(B */
180: for (I=0; I<N; I++) {
181: B = append(B,[[BindTable[I][0],"quote("+quote_input_form_quote_list(BindTable[I][1])+")"]]);
182: }
183: dprint0("applyfunction0: "); dprint(B);
184: N = length(Q)-1; /* $B0z?t$N?t(B */
185: M = length(B); /* binding table $B$N%5%$%:(B */
186: R = Q[0]+"(";
187: for (I=0; I<N; I++) {
188: X = rtostr(Q[I+1]); /* $BJQ?t(B */
189: /* binding Table $B$r%5!<%A(B */
190: for (J=0; J<M; J++) {
191: Y = rtostr(B[J][0]);
192: if (X == Y) {
193: R = R+B[J][1];
194: if (I != N-1) R = R+",";
195: break;
196: }
197: if (J == M-1) error("No binding data.");
198: }
199: }
200: R = R+")";
201: dprint0("R="); dprint(R);
202: return eval_str(R);
203: }
204:
205: /* $B1&5,B'4X?t(B. sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B */
206: def r_sin_int(X) {
207: /* $B$$$^(B X $B$O(B quote $B7?(B */
208: Y = quotetolist(X);
209: /* Todo: $B$3$N$h$&$J$b$N$r:n$k5!G=$OAH$_9~$_$GM_$7$$(B. */
210: R = "quote(sin("+quote_input_form_quote_list(Y)+"*@pi))";
211: print(R);
212: R = eval_str(R);
213: /* Todo: X $B$,(B $B?t;z$+$I$&$+D4$Y$k5!G=$bAH$_9~$_$GM_$7$$(B.
214: */
215: if (Y[0] == "internal") {
216: Z = eval_str(rtostr(Y[1]));
217: }else{
218: return quotetolist(R);
219: }
220: if (type(Z) == 0) return quotetolist(quote(0));
221: if ((type(Z) == 1) && (ntype(Z) == 0)) return quotetolist(quote(0));
222: return quotetolist(R);
223: }
224:
225: /* L $B$,:85,B'(B. R $B$,1&5,B'(B. $BI}M%@hC5:w(B.
226: $BNc(B:
227: apply_rule1(quote(1+sin(3*@pi)*sin(@pi/2)),
228: quote(sin(pn("x")*@pi)),
229: ["r_sin_int","x"]);
230: */
231: def apply_rule1(Obj,L,R) {
232: dprint("-------- start of apply_rule1 ------------ ");
233: Obj = quotetolist(Obj);
234: L = quotetolist(L);
235: R = rp(Obj,L,R);
236: RR = "quote("+quote_input_form_quote_list(R)+")";
237: dprint("-------- end of apply_rule1 ------------ ");
238: return eval_str(RR);
239: }
240:
241: def test0() {
242: A = quotetolist(quote(1+sin(x)+sin(3*@pi)*sin(0)));
243: P = quotetolist(quote(sin(pn("x")*@pi)));
244: Q = ["r_sin_int","x"];
245: print(A);
246: print(P);
247: print(Q);
248: print("----------------");
249: print(match0(A,P));
250: A2 = quotetolist(quote(sin(2*@pi)));
251: print(match0(A2,P));
252: print("----------------");
253: print("---- makeBind --------");
254: print(makeBind(A2,P));
255: print("-----rp -------------");
256: R=rp(A,P,Q);
257: print("--------------------");
258: print(R);
259: print("--------------------");
260: return quote_input_form_quote_list(R);
261: }
262:
263: /* $B1&5,B'4X?t(B. 0 $B$rLa$9(B. */
264: def r_zero() {
265: return quotetolist(quote(0));
266: }
267:
268: /* $B1&5,B'4X?t(B. $B91Ey<0(B */
269: def r_id(X) {
270: return quotetolist(X);
271: }
272:
273: def test1() {
274: Rule1=[quote(sin(pn("x")*@pi)),["r_sin_int","x"]]; /* sin($B@0?t(B*@pi) --> 0 */
275: Rule2=[quote(0*pn("y")), ["r_zero"]]; /* 0*any --> 0 */
276: Rule3=[quote(pn("y")*0), ["r_zero"]]; /* any*0 --> 0 */
277: Rule4=[quote(pn("y")+0), ["r_id","y"]]; /* any+0 --> any */
278: Rule5=[quote(0+pn("y")), ["r_id","y"]]; /* 0+any --> any */
279: Rule6=[quote(sin(0)), ["r_zero"]]; /* sin(0) --> 0 */
280: R0 = quote(1+sin(sin(2*@pi)*sin(@pi/2))+sin(5*@pi));
281: print(print_input_form(R0));
282: R=apply_rule1(R0,Rule1[0],Rule1[1]);
283: print(print_input_form(R));
284: R=apply_rule1(R,Rule2[0],Rule2[1]);
285: print(print_input_form(R));
286: R=apply_rule1(R,Rule4[0],Rule4[1]);
287: print(print_input_form(R));
288: R=apply_rule1(R,Rule6[0],Rule6[1]);
289: print(print_input_form(R));
290: R=apply_rule1(R,Rule4[0],Rule4[1]);
291: print(print_input_form(R));
292: return R;
293: }
294:
1.2 ! takayama 295: extern Rule_test2$
! 296: Rule_test2=[quote(sin(pn("x")*@pi)),["r_sin_int2","x"]]$
! 297:
1.1 takayama 298: def test2() {
1.2 ! takayama 299: /* $BI}M%@hC5:w$N>l9g(B, $B$3$l$O(B simplify $B$G$-$:(B. */
1.1 takayama 300: Rule1=[quote(sin(pn("x")*@pi)),["r_sin_int","x"]];
301: R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
302: print(print_input_form(R0));
303: R=apply_rule1(R0,Rule1[0],Rule1[1]);
1.2 ! takayama 304: print(print_input_form(R));
! 305: print("-----------------------");
! 306: /* $B$7$+$7<!$N$h$&$K=q$/$H?<$5M%@h$G=q$1$k(B */
! 307: R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
! 308: print(print_input_form(R0));
! 309: R=apply_rule1(R0,Rule_test2[0],Rule_test2[1]);
! 310: print(print_input_form(R));
! 311: }
! 312:
! 313: /* $B1&5,B'4X?t(B. sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B. $B?<$5M%@hMQ(B */
! 314: def r_sin_int2(X) {
! 315: /* apply_rule1 $B$r:F5"E*$K$h$V(B. $B$3$NJ}K!$G9=J82r@O$b$+$1$k(B. */
! 316: X = apply_rule1(X,Rule_test2[0],Rule_test2[1]);
! 317: Y = quotetolist(X);
! 318: R = "quote(sin("+quote_input_form_quote_list(Y)+"*@pi))";
! 319: print(R);
! 320: R = eval_str(R);
! 321: if (Y[0] == "internal") {
! 322: Z = eval_str(rtostr(Y[1]));
! 323: }else{
! 324: return quotetolist(R);
! 325: }
! 326: if (type(Z) == 0) return quotetolist(quote(0));
! 327: if ((type(Z) == 1) && (ntype(Z) == 0)) return quotetolist(quote(0));
! 328: return quotetolist(R);
1.1 takayama 329: }
330:
331:
332: /* $BITDj@QJ,7W;;$NNc(B
333: c x^n $B$NOB$NITDj@QJ,(B (c $B$O(B x $B$K0MB8$;$:(B)
334: $B$$$m$$$m(B $BLdBjE@$"$j(B: $B$?$H$($P(B c $B$,(B $BL5$$$H$-$N=hM}$G$-$:(B.
335: */
336:
337: /* $B1&JU4X?t(B. c x^n $B$NITDj@QJ,(B (c $B$O(B x $B$K0MB8$;$:(B)
338: Todo: $B1&JU4X?t$rMF0W$K=q$/J}K!(B.
339: */
340: def r_integral0(C,N) {
341: NN = eval_str(quote_input_form_quote_list(quotetolist(N)));
342: CC = quote_input_form_quote_list(quotetolist(C));
343: if (NN == -1) {
344: R = "quote("+CC+"*log(x))";
345: }else{
346: R = "quote("+CC+"/"+rtostr(NN+1)+"*x^"+rtostr(NN+1)+")";
347: }
348: print("r_integral0:",0);print(R);
349: R = eval_str(R);
350: return quotetolist(R);
351: }
352: /* $B1&JU4X?t(B $B@QJ,$N@~7?@-(B */
353: def r_int_linear(F,G) {
354: FF = quote_input_form_quote_list(quotetolist(F));
355: GG = quote_input_form_quote_list(quotetolist(G));
356: R = "quote(integral("+FF+")+integral("+GG+"))";
357: print("r_int_linear:",0);print(R);
358: R = eval_str(R);
359: return quotetolist(R);
360: }
361: def test3() {
362: R0 = quote(1+integral(2*x^(-1)+2*x^2));
363: return test3a(R0);
364: }
365: def test3a(R0) {
366: Rules=[
367: /* c*x^n --> (c/(n+1))*x^(n+1) or c*log(x) */
368: [quote(integral(pn("c")*x^pn("n"))),["r_integral0","c","n"]],
369: [quote(integral(pn("f")+pn("g"))), ["r_int_linear","f","g"]]
370: ];
371: print("Input=",0); print(print_input_form(R0));
372: N = length(Rules);
373: R = R0;
374: for (J=0; J<3; J++) { /* Todo: $B%U%i%0$,$J$$$N$G(B, $B$H$j$"$($:(B 3 $B2s(B */
375: for (I=0; I<N; I++) {
376: print(print_input_form(R));
377: R=apply_rule1(R,Rules[I][0],Rules[I][1]);
378: }
379: }
380: return R;
381: }
382:
383: end$
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to rewriting.rr CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / asir-contrib / testing