Annotation of OpenXM/src/asir-contrib/testing/tr.rr, Revision 1.8
1.8 ! takayama 1: /* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.7 2005/05/04 05:47:03 takayama Exp $ */
! 2: /* $Id: tr.rr,v 1.26 2005/05/08 08:37:46 taka Exp $ */
1.2 takayama 3:
4: /*
5: OpenXM$BHG$N(B Risa/Asir $B$G<B9T$N$3$H(B. OpenXM $BHG$N4X?t$rMQ$$$k$?$a(B.
6: */
1.7 takayama 7: /*
1.2 takayama 8: $B$3$N%U%!%$%k$O(B quotetolist $B$G%j%9%H$KJQ49$7$?%G!<%?$KBP$7$F(B
9: $B%Q%?!<%s%^%C%A$*$h$S$=$l$r1~MQ$7$?JQ7A$r9T$&(B.
10: tr.oxt $B$N;EMM$H$3$H$J$j(B quotetolist $B$GJQ49$7$?$b$N$r07$&(B.
11: $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))
12: */
13:
1.7 takayama 14:
1.2 takayama 15: extern Debug$
16: Debug=0$
1.7 takayama 17: extern Debug2$ /* For tr.apply_or_rules. $B$H$F$bJXMx(B. */
18: Debug2=0$
1.2 takayama 19: def dprint(X) {
20: if (Debug) print(X);
21: }
22: def dprint0(X) {
23: if (Debug) print(X,0);
24: }
1.7 takayama 25: extern Debug2$
26: Debug2=0$
1.2 takayama 27:
1.3 takayama 28: /* quotetolist $B$N5U4X?t(B. $B$?$@$7J8;zNs$G(B */
29: def listtoquote_str(L) {
30: return quote_input_form_quote_list(L);
31: }
1.7 takayama 32: /* quotetolist $B$N5U4X?t(B. quote $B$rLa$9(B */
33: def listtoquote(L) {
34: return eval_str("quote("+quote_input_form_quote_list(L)+")");
35: }
36:
37: /* unix $B$N(B uniq $B$KF1$8(B */
38: def uniq(L) {
39: N = length(L);
40: if (N > 0) A = [L[0]]; else A=[];
41: for (I=1; I<N; I++) {
42: if (A[0] != L[I]) A=cons(L[I],A);
43: }
44: return reverse(A);
45: }
1.8 ! takayama 46:
1.2 takayama 47:
1.7 takayama 48: /* Object id */
49: #define O_N 1
50: #define O_P 2
51: #define O_R 3
52: #define O_LIST 4
53: #define O_VECT 5
54: #define O_MAT 6
55: #define O_STR 7
56: #define O_COMP 8
57: #define O_DP 9
58: #define O_USINT 10
59: #define O_ERR 11
60: #define O_GF2MAT 12
61: #define O_MATHCAP 13
62: #define O_F 14
63: #define O_GFMMAT 15
64: #define O_BYTEARRAY 16
65: #define O_QUOTE 17
66: #define O_OPTLIST 18
67: #define O_SYMBOL 19
68: #define O_RANGE 20
69: #define O_TB 21
70: #define O_DPV 22
71: #define O_QUOTEARG 23
72: #define O_VOID -1
73:
74: /* Numbers for the first element of quote_to_funargs */
75: #define I_BOP 0
76: #define I_COP 1
77: #define I_AND 2
78: #define I_OR 3
79: #define I_NOT 4
80: #define I_CE 5
81: #define I_PRESELF 6
82: #define I_POSTSELF 7
83: #define I_FUNC 8
84: #define I_FUNC_OPT 9
85: #define I_IFUNC 10
86: #define I_MAP 11
87: #define I_RECMAP 12
88: #define I_PFDERIV 13
89: #define I_ANS 14
90: #define I_PVAR 15
91: #define I_ASSPVAR 16
92: #define I_FORMULA 17
93: #define I_LIST 18
94: #define I_STR 19
95: #define I_NEWCOMP 20
96: #define I_CAR 21
97: #define I_CDR 22
98: #define I_CAST 23
99: #define I_INDEX 24
100: #define I_EV 25
101: #define I_TIMER 26
102: #define I_GF2NGEN 27
103: #define I_GFPNGEN 28
104: #define I_GFSNGEN 29
105: #define I_LOP 30
106: #define I_OPT 31
107: #define I_GETOPT 32
108: #define I_POINT 33
109: #define I_PAREN 34
110: #define I_MINUS 35
111: #define I_NARYOP 36
112:
113: module qt;
114: localf node $
115: localf nchild $
116: localf child $
117: localf is_integer $
118: localf replace $
119: localf is_dependent $
120: localf is_function $
121: localf map_arg $
122:
123: localf zero $
124: localf id $
125: localf one $
126: localf plus $
127: localf minus $
128: localf sin_int $
129: localf sin_int2 $
130: localf is_rational $
131: localf cancel_number $
132: /* 2/4 $B$,F~$C$F$k$J$i$P(B 1/2 $B$KJQ99$9$k$J$I(B. tkseries.expand1(1/(1-x),...) */
133: localf is_minus $ /* $B@hF,$K(B - $B$,$"$k$+7A<0E*$K$_$k(B. */
134: localf add_paren0 $
135: localf add_paren $ /* +- $BEy$K(B ( ) $B$r2C$($k(B. */
136: localf vars $
137: localf etov_pair$
1.8 ! takayama 138: localf hm $
! 139: localf rest $
! 140: localf hop $
! 141: localf input_form $
1.7 takayama 142:
143: def node(F) {
144: if (type(F) == O_QUOTE) F=quotetolist(F);
1.3 takayama 145: return [rtostr(F[0]),rtostr(F[1])];
1.2 takayama 146: }
147: /* Number of child */
1.7 takayama 148: def nchild(F) {
149: if (type(F) == O_QUOTE) F=quotetolist(F);
1.2 takayama 150: return length(F)-2;
151: }
1.7 takayama 152: def child(F,K) {
153: if (type(F) == O_QUOTE) F=quotetolist(F);
1.2 takayama 154: return F[K+2];
155: }
156:
1.7 takayama 157: /* quote $B$KBP$9$k(B $B=R8l(B */
158: def is_integer(Qlist) {
159: if (type(Qlist) == O_QUOTE) Qlist=quotetolist(Qlist);
160: if ((rtostr(Qlist[0]) == "u_op") && (rtostr(Qlist[1]) == "-")) {
161: return qt.is_integer(cdr(cdr(Qlist))[0]);
162: }
163: if (Qlist[0] == "internal") {
164: Z = eval_str(rtostr(Qlist[1]));
165: }else{
166: return 0;
167: }
168: if (type(Z) == 0) return 1;
169: if ((type(Z) == 1) && (ntype(Z) == 0)) return 1;
170: return 0;
171: }
172:
173: /* quote $B$N@8@.(B */
174: /* $B1&5,B'4X?t(B. 0 $B$rLa$9(B. */
175: def zero() {
176: return quotetolist(quote(0));
177: }
178:
179: /* $B1&5,B'4X?t(B. $B91Ey<0(B */
180: def id(X) {
181: if (type(X) == O_QUOTE) return quotetolist(X);
182: else return X;
183: }
184:
185: def one() {
186: return quote(1);
187: }
188:
189: def plus(X,Y) {
190: if ((type(X) == O_QUOTE) && (type(Y) == O_QUOTE)) return X+Y;
191: return ["b_op","+",X,Y];
192: }
193:
194: def minus(X,Y) {
195: if ((type(X) == O_QUOTE) && (type(Y) == O_QUOTE)) return X-Y;
196: return ["b_op","-",X,Y];
197: }
198:
199:
200: /* $B1&5,B'4X?t(B. sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B */
201: def sin_int(X) {
202: /* $B$$$^(B X $B$O(B quote $B7?(B */
203: Y = quotetolist(X);
204: /* Todo: $B$3$N$h$&$J$b$N$r:n$k5!G=$OAH$_9~$_$GM_$7$$(B. */
205: R = "quote(sin("+listtoquote_str(Y)+"*@pi))";
206: print(R);
207: R = eval_str(R);
208: /* Todo: X $B$,(B $B?t;z$+$I$&$+D4$Y$k5!G=$bAH$_9~$_$GM_$7$$(B.
209: */
210: if (Y[0] == "internal") {
211: Z = eval_str(rtostr(Y[1]));
212: }else{
1.8 ! takayama 213: return R;
1.7 takayama 214: }
1.8 ! takayama 215: if (type(Z) == 0) return quote(0);
! 216: if ((type(Z) == 1) && (ntype(Z) == 0)) return quote(0);
! 217: return R;
1.7 takayama 218: }
219:
220: /* $B1&5,B'4X?t(B. sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B. $B?<$5M%@hMQ(B */
221: def sin_int2(X) {
222: /* tr.apply_rule1 $B$r:F5"E*$K$h$V(B. $B$3$NJ}K!$G9=J82r@O$b$+$1$k(B. */
223: X = tr.apply_rule1(X,Rule_test2[0],Rule_test2[1]);
224: Y = quotetolist(X);
225: R = "quote(sin("+listtoquote_str(Y)+"*@pi))";
226: print(R);
227: R = eval_str(R);
1.8 ! takayama 228: if (qt.is_integer(Y)) return quote(0);
! 229: else return R;
1.7 takayama 230: }
231:
232: def replace(F,Rule) {
233: return base_replace(F,Rule);
234: }
235:
236: /* F $B$NCf$KITDj85(B X $B$,4^$^$l$F$$$k$+(B?
237: qt.is_dependent(quotetolist(quote(1+1/x)),x)
238: */
239: def is_dependent(F,X) {
240: if (type(F) == O_QUOTE) F = quotetolist(F);
241: Node = qt.node(F);
242: if ((F[0] == "internal") && (rtostr(F[1]) == rtostr(X))) {
243: return 1;
244: }else{
245: N = qt.nchild(F);
246: for (I=0; I<N;I++) {
247: C = qt.child(F,I);
248: if (qt.is_dependent(C,X)) return 1;
249: }
250: return 0;
251: }
252: }
253:
254: /* $BCm0U(B: @pi $B$b4X?t07$$(B. */
255: def is_function(X) {
256: if (type(X) == O_QUOTE) X=quotetolist(X);
257: if (rtostr(X[0]) == "function") return 1;
258: else return 0;
259: }
260:
261: /* qt.map_arg(nn,quote(f(x,y))) --> nn(f(nn(x),nn(y)))
262: qt.map_arg(nn,quote(1/4+f(x))) -->
263: $B%F%9%H$O(B test4().
264: */
265: def map_arg(F,Q) {
266: F = rtostr(F);
267: if (type(Q) == O_QUOTE) Q=quotetolist(Q);
268: if (rtostr(Q[0]) == "internal") {
269: T = listtoquote_str(Q);
270: return eval_str( "quote("+F+"("+T+"))" );
271: }
272: /* node $B$N;R6!$r(B F $B$GI>2A$9$k(B. */
273: N = qt.nchild(Q);
274: L = [];
275: for (I=0; I<N; I++) {
276: L = append(L,[quotetolist(qt.map_arg(F,qt.child(Q,I)))]);
277: }
278: dprint0("qt.map_arg:L="); dprint(L);
279: T = [Q[0],Q[1]];
280: for (I=0; I<N; I++) {
281: T = append(T,[L[I]]);
282: }
283: /* $B:G8e$K;R6!$r?F(B Q[0],Q[1] $B$GI>2A$7$F$+$i(B F $B$GI>2A(B */
284: T = ["function",F,T];
285: dprint0("qt.map_arg:T="); dprint(T);
286: T = listtoquote_str(T);
287: return eval_str("quote("+T+")");
288: }
289:
290: /* ($B7A<0E*$K(B) Q $B$KB0$9$k(B quote $B$+(B? */
291: def is_rational(X) {
292: if (type(X) == O_LIST) X=listtoquote(X);
293: A = quote_to_funargs(X);
294: if (A[0] == I_FORMULA) { /* 1, x */
295: if (type(A[1]) <= O_N) return 1;
296: else return 0;
297: }
298: if (A[0] == I_BOP) { /* 2+3, 2/x */
299: Op = get_function_name(A[1]);
300: if ((Op == "+") || (Op == "-") || (Op == "*") || (Op == "/")
301: || (Op == "^")) {
302: if (qt.is_rational(A[2]) && qt.is_rational(A[3])) return 1;
303: else return 0;
304: }
305: }
306: if (A[0] == I_PAREN) {
307: if (qt.is_rational(A[1])) return 1;
308: else return 0;
309: }
310: if (A[0] == I_MINUS) {
311: if (qt.is_rational(A[1])) return 1;
312: else return 0;
313: }
314: return 0;
315: }
316:
317: /* 2/4 --> 1/2 $B$X(B
318: $B$3$N<BAu$O8zN($O0-$$(B.
319: */
320: def cancel_number(Q) {
321: if (type(Q) == O_LIST) Q=listtoquote(Q);
322: if (qt.is_rational(Q)) {
323: Ans = eval_quote(Q);
324: return objtoquote(Ans);
325: }
326: A = quote_to_funargs(Q);
327: N = length(A); R=[];
328: for (I=N-1; I>= 0; I--) {
329: if (type(A[I]) == O_QUOTE)
330: R = cons(qt.cancel_number(A[I]),R);
331: else
332: R = cons(A[I],R);
333: }
334: return funargs_to_quote(R);
335: }
336:
337: /* $B@hF,$K(B - $B$,$"$k$+7A<0E*$K$_$k(B.
338: -a+b
339: -3
340: -34/y $BEy(B.
341: */
342: def is_minus(Q) {
343: if (type(Q) == O_LIST) Q=listtoquote(Q);
344: A = quote_to_funargs(Q);
345: if (A[0] == I_MINUS) return 1;
346: if (A[0] == I_BOP) {
347: if (qt.is_minus(A[2])) return 1;
348: else return 0;
349: }
350: return 0;
351: }
352: /* $BL5>r7o$K(B ( ) $B$r2C$($k(B. */
353: def add_paren0(Q) {
354: A = [I_PAREN,Q];
355: return funargs_to_quote(A);
356: }
357: /* +- $BEy$K(B ( ) $B$r2C$($k(B.
358: $BF0:n$,IT?3$J$N$G(B bug $B$,$"$k$+$b(B.
359: */
360: def add_paren(Q) {
361: if (type(Q) == O_LIST) Q=listtoquote(Q);
362: A = quote_to_funargs(Q);
363: /* $B$3$N=hM}$OKhEY;H$&$N$G$^$H$a$?J}$,$$$$$N$G$O(B? */
364: N = length(A); R=[];
365: for (I=N-1; I>= 0; I--) {
366: if (type(A[I]) == O_QUOTE)
367: R = cons(qt.add_paren(A[I]),R);
368: else
369: R = cons(A[I],R);
370: }
371: A = R;
372: if (A[0] == I_BOP) {
373: if (get_function_name(A[1]) == "+") {
374: if (qt.is_minus(A[3])) { /* x+-y ==> x+(-y) */
375: A2 = [I_BOP,A[1],
376: qt.add_paren(A[2]),
377: qt.add_paren0(A[3])];
378: return funargs_to_quote(A2);
379: }
380: }else if (get_function_name(A[1]) == "*" ||
381: get_function_name(A[1]) == "/")
382: {
383: if (qt.is_minus(A[2])) { /* -x*y ==> (-x)*y */
384: A2 = [I_BOP,A[1],
385: qt.add_paren0(A[2]),
386: qt.add_paren(A[3])];
387: return funargs_to_quote(A2);
388: }
389: }
390: }
391: return funargs_to_quote(A);
392: }
393:
394: /* vars $B$N??;w(B.
395: $B$3$N4X?t$b(B $BJQ?t$N=P8=2s?tJ,$N%j%9%H$r:n$k$N$G8zN($o$k$$(B.
396: */
397: def vars(Q) {
398: R = [ ];
399: if (type(Q) == O_LIST) Q=listtoquote(Q);
400: A = quote_to_funargs(Q);
401: if (A[0] == I_FORMULA) {
402: if (type(A[1]) == O_P) {
403: R = cons(A[1],R);
404: }
405: }
406: /* $B$3$N=hM}$OKhEY;H$&$N$G$^$H$a$?J}$,$$$$$N$G$O(B? */
407: N = length(A);
408: for (I=1; I<N; I++) {
409: if (type(A[I]) == O_QUOTE)
410: R = append(qt.vars(A[I]),R);
411: }
412: R=qsort(R);
413: R=uniq(R);
414: return reverse(R);
415: }
416:
417: /* p^q $B$r:F5"$GC5$7$F(B [p,q] $B$rLa$9(B. */
418: def etov_pair(Q) {
419: R = [ ];
420: if (type(Q) == O_LIST) Q=listtoquote(Q);
421: A = quote_to_funargs(Q);
422: if (A[0] == I_BOP) {
423: if (get_function_name(A[1]) == "^") {
424: R=[[A[2],A[3]]];
425: }
426: }
427: /* $B$3$N=hM}$OKhEY;H$&$N$G$^$H$a$?J}$,$$$$$N$G$O(B? */
428: N = length(A);
429: for (I=1; I<N; I++) {
430: if (type(A[I]) == O_QUOTE)
431: R = append(qt.etov_pair(A[I]),R);
432: }
433: return R;
434: }
435:
1.8 ! takayama 436: /* dp_hm + dp_rest $B$N%"%J%m%8!<(B.
! 437: $B$?$@$7(B * $BEy(B binary operator $B$G>o$KF0:n(B.
! 438: $BNc(B: Q=h*r*r2 --> hm(Q)=h, rest(Q)=r*r2, hop(Q)="*".
! 439: $B$?$@$7(B rest $B$G(B quote $B$O(B $B:87k9gE*$KJQ99(B. flatten_quote().
! 440: */
! 441: def hm(Q) {
! 442: if (type(Q) == O_LIST) Q = listtoquote(Q);
! 443: A=quote_to_funargs(Q);
! 444: if (A[0] == I_BOP) {
! 445: Op = get_function_name(A[1]);
! 446: if (Op == "+") {
! 447: return A[2];
! 448: }else if (Op == "-") {
! 449: return A[2];
! 450: }else if (Op == "*") {
! 451: return A[2];
! 452: }else if (Op == "/") {
! 453: return A[2];
! 454: }else if (Op == "^") {
! 455: return A[2];
! 456: }
! 457: }
! 458: return Q;
! 459: }
! 460:
! 461: def rest(Q) {
! 462: if (type(Q) == O_LIST) Q = listtoquote(Q);
! 463: A=quote_to_funargs(Q);
! 464: if (A[0] == I_BOP) {
! 465: Op = get_function_name(A[1]);
! 466: if (Op == "+") {
! 467: return flatten_quote(A[3],"+");
! 468: }else if (Op == "-") {
! 469: return "not implented to return -A[3]";
! 470: }else if (Op == "*") {
! 471: return flatten_quote(A[3],"*");
! 472: }else if (Op == "/") {
! 473: return flatten_quote(A[3],"/");
! 474: }else if (Op == "^") {
! 475: return flatten_quote(A[3],"^");
! 476: }else return 0;
! 477: }
! 478: return 0;
! 479: }
! 480:
! 481: def hop(Q) {
! 482: if (type(Q) == O_LIST) Q = listtoquote(Q);
! 483: A=quote_to_funargs(Q);
! 484: if (A[0] == I_BOP) return get_function_name(A[1]);
! 485: return 0;
! 486: }
! 487:
! 488: def input_form(Q) {
! 489: T = type(Q);
! 490: if ((T == O_VECT) || (T == O_MAT)) {
! 491: Q = matrix_matrix_to_list(Q);
! 492: }
! 493: if (type(Q) == O_LIST) {
! 494: A = [];
! 495: for (I=length(Q)-1; I>=0; I--) {
! 496: A = cons(qt.input_form(Q[I]),A);
! 497: }
! 498: if ((T == O_VECT) || (T == O_MAT)) { A = matrix_list_to_matrix(A); }
! 499: return A;
! 500: }
! 501: if (T == O_QUOTE) return quote_input_form(Q);
! 502: return rtostr(Q);
! 503: }
1.7 takayama 504: endmodule$
505:
506: module tr;
507: localf match0$
508: localf check_pn$
509: localf make_binding$
510: localf rp$
511: localf apply_function0$
512: localf apply_rule1$
513: localf rp_flag$
514: localf apply_rule1_flag$
515: localf apply_or_rules$
516:
1.8 ! takayama 517: static Rule_test2$ /* int_sin2 $B$,MxMQ(B */
! 518: /* " " $B$HIU$1$F$b$D$1$J$/$F$b$h$$(B. $BFbIt$G(B rtostr $B$7$F$k(B.
! 519: . $B$,IU$$$?$iIU$1$k$7$+$J$$(B.
! 520: */
! 521: /* Rule_test2=[quote(sin(pn("x")*@pi)),["qt.sin_int2","x"]]$ */
! 522: Rule_test2=[quote(sin(pn(x)*@pi)),["qt.sin_int2",x]]$
! 523:
1.2 takayama 524: /*
525: $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.
526: $B$=$&$G$J$$$+$i(B 0. $BI}M%@hC5:w(B.
527: Todo: P $B$KG$0U4X?t$r4^$`;EAH$_$O$^$@<BAu$7$F$J$$(B.
528: */
1.7 takayama 529: def match0(F,P) {
530: dprint0("tr.match0: F="); dprint(F);
531: dprint0("tr.match0: P="); dprint(P);
1.2 takayama 532:
533: if (type(F) != type(P)) return 0;
1.8 ! takayama 534: if (type(F) == O_QUOTE) {F=quotetolist(F); P=quotetolist(P);}
1.7 takayama 535: if (type(F) != O_LIST) {
1.2 takayama 536: if (F == P) return 1;
537: else return 0;
538: }
1.7 takayama 539: Node = qt.node(F);
540: Node2 = qt.node(P);
1.3 takayama 541: /* pn $B$K2?$N@)Ls$b$J$1$l$P(B 2 $B$rLa$9(B. */
1.7 takayama 542: if (Node2 == ["function","pn"]) return tr.check_pn(F,P);
1.2 takayama 543: if (Node != Node2) return 0;
1.7 takayama 544: N = qt.nchild(F);
545: if (N != qt.nchild(P)) return 0;
1.2 takayama 546: for (I=0; I<N; I++) {
1.7 takayama 547: C = qt.child(F,I);
548: C2 = qt.child(P,I);
549: if (!tr.match0(C,C2)) return 0;
1.2 takayama 550: }
551: return 1;
552: }
553:
1.3 takayama 554: /*
1.7 takayama 555: P $B$NNc(B: P = pn("x"); P=pn("x",qt.is_integer(x));
1.3 takayama 556: P $B$O(B [function,pn,[internal,x],[function,is_int,[internal,x]]]
557: FF $B$O(B ["is_int","x"]
558: $B%F%9%H%G!<%?(B.
1.8 ! takayama 559: tr.check_pn(quote(1/2),quote(pn("x",qt.is_integer(x))));
1.3 takayama 560: */
1.7 takayama 561: def check_pn(F,P) {
562: if (type(F) ==O_QUOTE) F=quotetolist(F);
563: if (type(P) == O_QUOTE) P=quotetolist(P);
1.8 ! takayama 564: /* print(F);print(P); */
1.7 takayama 565: N=qt.nchild(P);
1.3 takayama 566: if (N == 1) return 2;
1.7 takayama 567: X = rtostr(qt.child(P,0)[1]);
1.3 takayama 568: BindingTable = [[X,F]];
1.8 ! takayama 569: /* FF = [rtostr(qt.child(P,1)[1]),rtostr(qt.child(P,1)[2][1])]; */
! 570: FF = [rtostr(qt.child(P,1)[1])];
! 571: M = length(qt.child(P,1));
! 572: for (I=2; I<M; I++) {
! 573: FF = append(FF,[rtostr(qt.child(P,1)[I][1])]);
! 574: }
! 575: /* print(FF); print(BindingTable); */
1.7 takayama 576: R = tr.apply_function0(FF,BindingTable);
1.3 takayama 577: return R;
578: }
579:
1.7 takayama 580: /* F $B$H(B P $B$,(B tr.match0 $B$9$k$H$-(B bindingTable $B$r$b$I$9(B.
1.2 takayama 581: [[$BJQ?t$NL>A0(B($BJ8;zNs(B), $BCM(B(list)], ...]
582: */
1.7 takayama 583: def make_binding(F,P) {
1.2 takayama 584: Ans = [ ];
585: if (F == P) return Ans;
586:
1.7 takayama 587: Node = qt.node(F);
588: Node2 = qt.node(P);
1.2 takayama 589:
590: if (Node2 == ["function", "pn"]) {
1.3 takayama 591: Ans = append(Ans,[[rtostr(P[2][1]),F]]);
1.2 takayama 592: return Ans;
593: }
1.7 takayama 594: N = qt.nchild(F);
1.2 takayama 595: for (I=0; I<N; I++) {
1.7 takayama 596: C = qt.child(F,I);
597: C2 = qt.child(P,I);
598: Ans = append(Ans,tr.make_binding(C,C2));
1.2 takayama 599: }
600: return Ans;
601: }
602:
603: /*
604: Tree $B$NCf$rI}M%@hC5:w$G8!:w$7$F(B $BCV$-49$($k(B.
605: $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,
606: $BFbB&$OCV$-49$($i$l$J$$(B.
607: $B?<$5M%@hC5:w$K$7$?(B --> action $B4X?t$NCf$G:F5"E*$K8F$Y$P?<$5M%@h$H$J$k(B.
608: Todo: $B=q$-49$($,$*$3$C$?$+$N%U%i%0(B.
609: */
1.7 takayama 610: def rp(F,P,Q) {
611: dprint0("tr.rp, F="); dprint(F);
612: dprint0("tr.rp, P="); dprint(P);
613: dprint0("tr.rp, Q="); dprint(Q);
614: if (tr.match0(F,P)) {
615: BindTable = tr.make_binding(F,P);
1.2 takayama 616: dprint0("BindTable="); dprint(BindTable);
1.7 takayama 617: return tr.apply_function0(Q,BindTable);
1.2 takayama 618: }
1.7 takayama 619: if (type(F) != O_LIST) return F;
620: Node = qt.node(F);
621: N = qt.nchild(F);
1.2 takayama 622: Ans = Node;
623: for (I=0; I<N; I++) {
1.7 takayama 624: T = tr.rp(qt.child(F,I),P,Q);
1.2 takayama 625: Ans = append(Ans,[T]);
626: }
627: return Ans;
628: }
629:
630: /* ["f","x"],[["x",[internal,3]]] $B$N;~$O(B
631: f(3) $B$r7W;;$9$k(B.
632: */
1.7 takayama 633: def apply_function0(Q,BindTable) {
1.2 takayama 634: B = [ ];
635: N = length(BindTable);
636: /* BindTable $B$N1&JUCM$r(B quote(...) $B$J$kJ8;zNs$K(B */
637: for (I=0; I<N; I++) {
1.3 takayama 638: B = append(B,[[BindTable[I][0],"quote("+listtoquote_str(BindTable[I][1])+")"]]);
1.2 takayama 639: }
1.7 takayama 640: dprint0("tr.apply_function0: "); dprint(B);
1.2 takayama 641: N = length(Q)-1; /* $B0z?t$N?t(B */
642: M = length(B); /* binding table $B$N%5%$%:(B */
1.3 takayama 643: R = rtostr(Q[0])+"(";
1.2 takayama 644: for (I=0; I<N; I++) {
645: X = rtostr(Q[I+1]); /* $BJQ?t(B */
646: /* binding Table $B$r%5!<%A(B */
647: for (J=0; J<M; J++) {
648: Y = rtostr(B[J][0]);
649: if (X == Y) {
650: R = R+B[J][1];
651: if (I != N-1) R = R+",";
652: break;
653: }
1.3 takayama 654: if (J == M-1) {
655: dprint0("No binding data. Use the X itself. X="); dprint(X);
656: R = R+X;
657: if (I != N-1) R = R+",";
658: }
1.2 takayama 659: }
660: }
661: R = R+")";
662: dprint0("R="); dprint(R);
1.5 takayama 663: V=eval_str(R);
1.7 takayama 664: if (type(V) == O_QUOTE) return quotetolist(V);
1.5 takayama 665: else return V;
1.2 takayama 666: }
667:
668:
669: /* L $B$,:85,B'(B. R $B$,1&5,B'(B. $BI}M%@hC5:w(B.
670: $B=q$-49$($r$9$k$?$a$N%H%C%W%l%Y%k$N4X?t(B ($B$N$R$H$D(B).
671: $BNc(B:
1.7 takayama 672: tr.apply_rule1(quote(1+sin(3*@pi)*sin(@pi/2)),
1.2 takayama 673: quote(sin(pn("x")*@pi)),
1.7 takayama 674: ["qt.sin_int","x"]);
1.2 takayama 675: */
1.7 takayama 676: def apply_rule1(Obj,L,R) {
677: dprint("-------- start of tr.apply_rule1 ------------ ");
1.2 takayama 678: Obj = quotetolist(Obj);
679: L = quotetolist(L);
1.7 takayama 680: R = tr.rp(Obj,L,R);
681: if (type(R) == O_QUOTE) R=quotetolist(R);
1.3 takayama 682: RR = "quote("+listtoquote_str(R)+")";
1.7 takayama 683: dprint("-------- end of tr.apply_rule1 ------------ ");
1.2 takayama 684: return eval_str(RR);
685: }
686:
1.7 takayama 687: /* Flag $BIU$-(B $B$N(B tr.rp. $BB0@-$,$J$$$N$G$3$l$G$d$k(B. */
688: def rp_flag(F,P,Q) {
689: Flag = 0;
690: dprint0("tr.rp, F="); dprint(F);
691: dprint0("tr.rp, P="); dprint(P);
692: dprint0("tr.rp, Q="); dprint(Q);
693: if (tr.match0(F,P)) {
694: BindTable = tr.make_binding(F,P);
695: dprint0("BindTable="); dprint(BindTable);
696: return [1,tr.apply_function0(Q,BindTable)];
1.3 takayama 697: }
1.7 takayama 698: if (type(F) != O_LIST) return F;
699: Node = qt.node(F);
700: N = qt.nchild(F);
701: Ans = Node;
702: for (I=0; I<N; I++) {
703: T = tr.rp_flag(qt.child(F,I),P,Q);
704: if (T[0] == 1) Flag = 1;
705: Ans = append(Ans,[T[1]]);
706: }
707: return [Flag,Ans];
708: }
709:
710: /* $B=q$-49$((B flag $BIU$-$N(B tr.apply_rule_flag */
711: def apply_rule1_flag(Obj,L,R) {
712: Flag = 0;
713: if (Debug2)
714: print("-------- start of tr.apply_rule1_flag ------------ ");
715: if (Debug2) print(print_input_form(Obj));
716: Obj = quotetolist(Obj);
717: L = quotetolist(L);
718: R = tr.rp_flag(Obj,L,R);
719: Flag=R[0]; R=R[1];
720: if (type(R) == O_QUOTE) R=quotetolist(R);
721: RR = "quote("+listtoquote_str(R)+")";
722: if (Debug2) {print("==> "+RR+" by "); print(listtoquote_str(L));}
723: if (Debug2) print("-------- end of tr.apply_rule1_flag ------------ ");
724: return [Flag,eval_str(RR)];
725: }
726:
727: def apply_or_rules(Q,R) {
728: Flag = 1;
729: N = length(R);
730: while (Flag) {
731: Flag = 0;
732: for (I=0; I<N; I++) {
733: Q = tr.apply_rule1_flag(Q,R[I][0],R[I][1]);
734: if (Q[0]) {
735: Flag = 1;
736: dprint("Applied the rule "+rtostr(I));
737: }
738: Q = Q[1];
739: }
1.2 takayama 740: }
1.7 takayama 741: return Q;
742: }
743:
744: endmodule$
745:
746:
747: /* tr $B$N=q$-49$(%k!<%k(B */
748: module tr;
749: localf simp_zero$
750: localf simp_unary$
751: localf simp_sin$
752: /* 0+any, 0*any $B$K$J$k(B quote $B$r(B 0 $B$K$9$k(B. $BI,?\(B. cf. taka_series.expand1
753: test_0(); $B$G%F%9%H$9$k(B.
754: */
755: def simp_zero(R0) {
756: Rule1=[quote(0*pn(y)), ["qt.zero"]]; /* 0*any --> 0 */
757: Rule2=[quote(pn(y)*0), ["qt.zero"]]; /* any*0 --> 0 */
758: Rule3=[quote(0/pn(y)), ["qt.zero"]]; /* 0/any --> 0 */
759: Rule4=[quote(pn(y)+0), ["qt.id",y]]; /* any+0 --> any */
760: Rule5=[quote(0+pn(y)), ["qt.id",y]]; /* 0+any --> any */
761: Rule6=[quote(-0), ["qt.zero",y]]; /* -0 --> 0 */
762: Rule7=[quote((0)), ["qt.zero",y]]; /* (0) --> 0 */
763: Rule8=[quote(1*pn(y)), ["qt.id",y]]; /* 1*any --> any */
764: Rule9=[quote(pn(y)*1), ["qt.id",y]]; /* any*1 --> any */
765: R=tr.apply_or_rules(R0,[Rule1,Rule2,Rule3,Rule4,Rule5, Rule6,Rule7,
766: Rule8, Rule9]);
767: return R;
1.2 takayama 768: }
769:
1.7 takayama 770: def simp_unary(R0) {
771: Rule1=[quote(pn(x))+quote(-pn(y)), ["qt.minus",x,y]]; /* x+-y -> x-y */
772: Rule2=[quote(-(-pn(x))), ["qt.id",x]]; /* -(-x) --> x */
773: Rule3=[quote(pn(x)-(-pn(y))), ["qt.plus",x,y]]; /* x-(-y) --> x+y */
774: R=tr.apply_or_rules(R0,[Rule1,Rule2,Rule3]);
775: return R;
1.2 takayama 776: }
777:
1.7 takayama 778: /*
779: test_1() $B$O%5%s%W%k%F%9%H(B.
780: */
781: def simp_sin(R0) {
782: Rule1=[quote(sin(pn(x)*@pi)),["qt.sin_int",x]]; /* sin($B@0?t(B*@pi) --> 0 */
783: Rule2=[quote(0*pn(y)), ["qt.zero"]]; /* 0*any --> 0 */
784: Rule3=[quote(pn(y)*0), ["qt.zero"]]; /* any*0 --> 0 */
785: Rule4=[quote(pn(y)+0), ["qt.id",y]]; /* any+0 --> any */
786: Rule5=[quote(0+pn(y)), ["qt.id",y]]; /* 0+any --> any */
787: Rule6=[quote(sin(0)), ["qt.zero"]]; /* sin(0) --> 0 */
788: Rule7=[quote(cos(0)), ["qt.one"]]; /* cos(0) --> 1 */
789: /* print(print_input_form(R0)); */
790: R=tr.apply_rule1_flag(R0,Rule1[0],Rule1[1]);
791: /* print([R[0],print_input_form(R[1])]); */
792: R=tr.apply_or_rules(R0,[Rule1,Rule2,Rule3,Rule4,Rule5,Rule6,Rule7]);
793: return R;
1.2 takayama 794: }
795:
1.7 takayama 796: endmodule$
1.2 takayama 797: /* ------------ test --------------------------- */
1.7 takayama 798:
1.3 takayama 799:
1.2 takayama 800:
801: def test2() {
802: /* $BI}M%@hC5:w$N>l9g(B, R0 $B$O(B simplify $B$G$-$:(B. */
1.7 takayama 803: Rule1=[quote(sin(pn("x")*@pi)),["qt.sin_int","x"]];
1.2 takayama 804: R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
805: print(print_input_form(R0));
1.7 takayama 806: R=tr.apply_rule1(R0,Rule1[0],Rule1[1]);
1.2 takayama 807: print(print_input_form(R));
808: print("-----------------------");
809: /* $B<!$N$h$&$K=q$/$H?<$5M%@h$G=q$1$k(B */
810: R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2));
811: print(print_input_form(R0));
1.7 takayama 812: R=tr.apply_rule1(R0,Rule_test2[0],Rule_test2[1]);
1.2 takayama 813: print(print_input_form(R));
814: }
815:
1.3 takayama 816:
1.7 takayama 817: /* tr.check_pn $B$NF0:n%F%9%H(B */
1.3 takayama 818: def test2b() {
1.7 takayama 819: Rule=[quote(sin(pn(x,qt.is_integer(x))*@pi)),["qt.zero"]]$
1.3 takayama 820: R0 = quote(1+sin(2*@pi)*sin(a*@pi));;
821: print(print_input_form(R0));
1.7 takayama 822: R=tr.apply_rule1(R0,Rule[0],Rule[1]);
1.3 takayama 823: return R;
824: }
825:
1.7 takayama 826: /* tr.simp_zero $B$N%F%9%H(B */
827: def test_0() {
828: F = quote(x+(0*x+0));
829: print(quote_input_form(F));
830: return tr.simp_zero(F);
1.3 takayama 831: }
832:
1.7 takayama 833: /* tr.simp_sin $B$N%F%9%H(B */
834: def test_1() {
835: F = quote(sin(sin(0))+sin(0));
836: print(quote_input_form(F));
837: return tr.simp_sin(F);
1.5 takayama 838: }
839:
1.7 takayama 840: /* ------------------------------------------------ */
841:
1.5 takayama 842: /* Index $BIU$-JQ?t$r<B8=$9$k(B */
843: def idxtov(V,I) {
844: if (type(I) == 5) I=vtol(I);
1.7 takayama 845: if (type(I) != O_LIST) I=[I];
1.5 takayama 846: if (type(V) != 2) V=rtostr(V);
847: return util_v(V,I);
848: }
849:
850: def vtoidx(V) {
851: A = util_index(V);
852: if (length(A[1]) == 0) return [A[0]];
853: if (length(A[1]) == 1) return [A[0],A[1][0]];
854: return A;
1.3 takayama 855: }
1.2 takayama 856:
1.8 ! takayama 857: /* $B$3$l$i0J30$N%F%9%H%W%m%0%i%`$O(B test1-tr.rr $B$r8+$h(B.
1.2 takayama 858: */
1.6 takayama 859:
860: module qt;
861: localf dtoq$
1.7 takayama 862: localf qtod$ /* it has not yet been implemented. */
1.6 takayama 863: localf etoq$
1.8 ! takayama 864: localf hc_etov$
1.6 takayama 865:
866: /* Distributed polynomial to quote
867: qt.dtoq(dp_ptod((x-y)^3,[x,y]),[]);
868: */
869: def dtoq(F,V) {
870: if (F == 0) return quote(0);
871: N = length(dp_etov(F));
872: if (N > length(V)) {
873: for (I=length(V); I<N; I++) {
874: V = append(V,[util_v("x",[I+1])]);
875: }
876: }
877: R = 0;
878: while (F != 0) {
879: T = dp_hm(F);
880: F = dp_rest(F);
881: C = objtoquote(dp_hc(T));
1.7 takayama 882: if (qt.is_minus(C)) {
883: C = qt.add_paren0(C);
884: }
1.6 takayama 885: E = dp_etov(T);
886: Mq = etoq(E,V);
887: if (Mq == quote(1)) {
888: R = R+C;
889: }else{
890: if (C == quote(1)) R = R+Mq;
891: else if (C == quote(-1)) R = R-Mq;
892: else R = R+C*Mq;
893: }
894: }
1.8 ! takayama 895: return flatten_quote(R,"+");
1.6 takayama 896: }
897:
898: def etoq(E,V) {
899: N = length(E);
900: if (N > length(V)) {
901: for (I=length(V); I<N; I++) {
902: V = append(V,[util_v("x",[I+1])]);
903: }
904: }
905: II = -1;
906: for (I=0; I<N; I++) {
907: if (E[I] != 0) { II=I; break; }
908: }
909: if (II == -1) return quote(1);
910: if (E[II] == 1) R=objtoquote(V[II]);
911: else {
912: R=objtoquote(V[II])^objtoquote(E[II]);
913: }
914: for (I=II+1; I<N; I++) {
915: if (E[I] != 0) {
916: if (E[I] == 1) Rt=objtoquote(V[I]);
917: else Rt=objtoquote(V[I])^objtoquote(E[I]);
918: R = R*Rt;
919: }
920: }
1.8 ! takayama 921: return flatten_quote(R,"*");
! 922: }
! 923:
! 924: def hc_etov(Q,V) {
! 925: HC=quote(1);
! 926: N = length(V);
! 927: E = newvect(N);
! 928: while (type(Q) != 0) {
! 929: Q = flatten_quote(Q,"*");
! 930: A = quote_to_funargs(Q);
! 931: Sign = 1;
! 932: if (A[0] == I_MINUS) {
! 933: Sign = -1;
! 934: Q = A[1];
! 935: }
! 936: Q = flatten_quote(Q,"*");
! 937: Op=qt.hop(Q);
! 938: if (Op != "*") {
! 939: F=Q; if (Sign == -1) F = quote((-1))*F;
! 940: Q=0;
! 941: }else{
! 942: F=qt.hm(Q); if (Sign == -1) F = quote((-1))*F;
! 943: Q=qt.rest(Q);
! 944: }
! 945:
! 946: print(quote_input_form(F));
! 947: print(Op);
! 948: print(quote_input_form(Q));
! 949: Const = 1;
! 950: for (I=0; I<N; I++) {
! 951: if (qt.is_dependent(F,V[I])) {
! 952: Const = 0;
! 953: EE=qt.etov_pair(F);
! 954: if (EE != []) E[I] = EE[0][1];
! 955: else E[I] = quote(1);
! 956: }
! 957: }
! 958: if (Const) HC=HC*F;
! 959: }
! 960: return [HC,E];
1.6 takayama 961: }
962:
963: endmodule;
1.8 ! takayama 964:
! 965:
! 966:
1.2 takayama 967:
968: end$
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to tr.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