Annotation of OpenXM/src/asir-contrib/testing/test1-tr.rr, Revision 1.6
1.6 ! takayama 1: /* $Id: test1-tr.rr,v 1.16 2005/04/21 08:16:26 taka Exp $ */
! 2: /* $OpenXM: OpenXM/src/asir-contrib/testing/test1-tr.rr,v 1.5 2005/04/15 12:47:14 takayama Exp $ */
1.2 takayama 3:
4: load("tr.rr")$
5:
6:
7:
8:
9: def test0() {
10: A = quotetolist(quote(1+sin(x)+sin(3*@pi)*sin(0)));
11: P = quotetolist(quote(sin(pn("x")*@pi)));
12: Q = ["qt_sin_int","x"];
13: print(A);
14: print(P);
15: print(Q);
16: print("----------------");
17: print(tr_match0(A,P));
18: A2 = quotetolist(quote(sin(2*@pi)));
19: print(tr_match0(A2,P));
20: print("----------------");
21: print("---- tr_make_binding --------");
22: print(tr_make_binding(A2,P));
23: print("-----tr_rp -------------");
24: R=tr_rp(A,P,Q);
25: print("--------------------");
26: print(R);
27: print("--------------------");
28: return quote_input_form_quote_list(R);
29: }
30:
31: def test1() {
32: Rule1=[quote(sin(pn("x")*@pi)),["qt_sin_int","x"]]; /* sin($B@0?t(B*@pi) --> 0 */
33: Rule2=[quote(0*pn("y")), ["qt_zero"]]; /* 0*any --> 0 */
34: Rule3=[quote(pn("y")*0), ["qt_zero"]]; /* any*0 --> 0 */
35: Rule4=[quote(pn("y")+0), ["qt_id","y"]]; /* any+0 --> any */
36: Rule5=[quote(0+pn("y")), ["qt_id","y"]]; /* 0+any --> any */
37: Rule6=[quote(sin(0)), ["qt_zero"]]; /* sin(0) --> 0 */
38: R0 = quote(1+sin(sin(2*@pi)*sin(@pi/2))+sin(5*@pi));
39: print(print_input_form(R0));
40: R=tr_apply_rule1(R0,Rule1[0],Rule1[1]);
41: print(print_input_form(R));
42: R=tr_apply_rule1(R,Rule2[0],Rule2[1]);
43: print(print_input_form(R));
44: R=tr_apply_rule1(R,Rule4[0],Rule4[1]);
45: print(print_input_form(R));
46: R=tr_apply_rule1(R,Rule6[0],Rule6[1]);
47: print(print_input_form(R));
48: R=tr_apply_rule1(R,Rule4[0],Rule4[1]);
49: print(print_input_form(R));
50: return R;
51: }
52:
53:
54: /* $BITDj@QJ,7W;;$NNc(B
55: c x^n $B$NOB$NITDj@QJ,(B (c $B$O(B x $B$K0MB8$;$:(B)
56: $B$$$m$$$m(B $BLdBjE@$"$j(B: $B$?$H$($P(B c $B$,(B $BL5$$$H$-$N=hM}$G$-$:(B.
57: */
58:
59: /* $B1&JU4X?t(B. c x^n $B$NITDj@QJ,(B (c $B$O(B x $B$K0MB8$;$:(B)
60: Todo: $B1&JU4X?t$rMF0W$K=q$/J}K!(B.
61: */
62: def r_integral0(C,N) {
63: NN = eval_str(quote_input_form_quote_list(quotetolist(N)));
64: CC = quote_input_form_quote_list(quotetolist(C));
65: if (NN == -1) {
66: R = "quote("+CC+"*log(x))";
67: }else{
68: R = "quote("+CC+"/"+rtostr(NN+1)+"*x^"+rtostr(NN+1)+")";
69: }
70: print("r_integral0:",0);print(R);
71: R = eval_str(R);
72: return quotetolist(R);
73: }
74: /* $B1&JU4X?t(B $B@QJ,$N@~7?@-(B */
75: def r_int_linear(F,G) {
76: FF = quote_input_form_quote_list(quotetolist(F));
77: GG = quote_input_form_quote_list(quotetolist(G));
78: R = "quote(integral("+FF+")+integral("+GG+"))";
79: print("r_int_linear:",0);print(R);
80: R = eval_str(R);
81: return quotetolist(R);
82: }
83: def test3() {
84: R0 = quote(1+integral(2*x^(-1)+2*x^2));
85: return test3a(R0);
86: }
87: def test3a(R0) {
88: Rules=[
89: /* c*x^n --> (c/(n+1))*x^(n+1) or c*log(x) */
90: [quote(integral(pn("c")*x^pn("n"))),["r_integral0","c","n"]],
91: [quote(integral(pn("f")+pn("g"))), ["r_int_linear","f","g"]]
92: ];
93: print("Input=",0); print(print_input_form(R0));
94: N = length(Rules);
95: R = R0;
96: for (J=0; J<3; J++) { /* Todo: $B%U%i%0$,$J$$$N$G(B, $B$H$j$"$($:(B 3 $B2s(B */
97: for (I=0; I<N; I++) {
98: print(print_input_form(R));
99: R=tr_apply_rule1(R,Rules[I][0],Rules[I][1]);
100: }
101: }
1.3 takayama 102: return R;
103: }
104:
105:
106: /* $B4X?t$N%^%C%A(B. N[] $BAjEv(B. test4(). */
107: /* quote(nn(pn(f),qt_is_function(f))); $B$OITMW(B. qt_map_arg $B$,=hM}(B */
108: def test4() {
109: Rule=[quote(nn(pn(f))),[qt_map_arg,nn,f]];
110: R0 = quote(nn(sin(1/2)*cos(1/3)));
111: print(print_input_form(R0));
112: R=tr_apply_rule1(R0,Rule[0],Rule[1]);
113: return R;
114: }
115:
116: /* tr_apply_or_rule $B$N;n:n(B */
117:
118: /* Flag $BIU$-(B $B$N(B tr_rp. $BB0@-$,$J$$$N$G$3$l$G$d$k(B. */
119: def tr_rp_flag(F,P,Q) {
120: Flag = 0;
121: dprint0("tr_rp, F="); dprint(F);
122: dprint0("tr_rp, P="); dprint(P);
123: dprint0("tr_rp, Q="); dprint(Q);
124: if (tr_match0(F,P)) {
125: BindTable = tr_make_binding(F,P);
126: dprint0("BindTable="); dprint(BindTable);
127: return [1,tr_apply_function0(Q,BindTable)];
128: }
129: if (type(F) != 4) return F;
130: Node = qt_node(F);
131: N = qt_nchild(F);
132: Ans = Node;
133: for (I=0; I<N; I++) {
134: T = tr_rp_flag(qt_child(F,I),P,Q);
135: if (T[0] == 1) Flag = 1;
136: Ans = append(Ans,[T[1]]);
137: }
138: return [Flag,Ans];
139: }
140:
1.5 takayama 141: extern Debug2$
142: Debug2=0$
1.3 takayama 143: /* $B=q$-49$((B flag $BIU$-$N(B tr_apply_rule_flag */
144: def tr_apply_rule1_flag(Obj,L,R) {
145: Flag = 0;
1.5 takayama 146: if (Debug2)
147: print("-------- start of tr_apply_rule1_flag ------------ ");
148: if (Debug2) print(print_input_form(Obj));
1.3 takayama 149: Obj = quotetolist(Obj);
150: L = quotetolist(L);
151: R = tr_rp_flag(Obj,L,R);
152: Flag=R[0]; R=R[1];
153: if (type(R) == 17) R=quotetolist(R);
154: RR = "quote("+listtoquote_str(R)+")";
1.5 takayama 155: if (Debug2) {print("==> "+RR+" by "); print(listtoquote_str(L));}
156: if (Debug2) print("-------- end of tr_apply_rule1_flag ------------ ");
1.3 takayama 157: return [Flag,eval_str(RR)];
158: }
159:
160: def tr_apply_or_rules(Q,R) {
161: Flag = 1;
162: N = length(R);
163: while (Flag) {
164: Flag = 0;
165: for (I=0; I<N; I++) {
166: Q = tr_apply_rule1_flag(Q,R[I][0],R[I][1]);
167: if (Q[0]) {
168: Flag = 1;
169: dprint("Applied the rule "+rtostr(I));
170: }
171: Q = Q[1];
172: }
173: }
174: return Q;
175: }
176: def test5() {
177: Rule1=[quote(sin(pn(x)*@pi)),[qt_sin_int,x]]; /* sin($B@0?t(B*@pi) --> 0 */
178: Rule2=[quote(0*pn(y)), [qt_zero]]; /* 0*any --> 0 */
179: Rule3=[quote(pn(y)*0), [qt_zero]]; /* any*0 --> 0 */
180: Rule4=[quote(pn(y)+0), [qt_id,y]]; /* any+0 --> any */
181: Rule5=[quote(0+pn(y)), [qt_id,y]]; /* 0+any --> any */
182: Rule6=[quote(sin(0)), [qt_zero]]; /* sin(0) --> 0 */
183: R0 = quote(1+sin(sin(2*@pi)*sin(@pi/2))+sin(5*@pi));
184: print(print_input_form(R0));
185: R=tr_apply_rule1_flag(R0,Rule1[0],Rule1[1]);
186: print([R[0],print_input_form(R[1])]);
187: R=tr_apply_or_rules(R0,[Rule1,Rule2,Rule3,Rule4,Rule5,Rule6]);
1.6 ! takayama 188: return R;
! 189: }
! 190:
! 191: def qt_one() {
! 192: return quote(1);
! 193: }
! 194: def tr_simp_sin(R0) {
! 195: Rule1=[quote(sin(pn(x)*@pi)),[qt_sin_int,x]]; /* sin($B@0?t(B*@pi) --> 0 */
! 196: Rule2=[quote(0*pn(y)), [qt_zero]]; /* 0*any --> 0 */
! 197: Rule3=[quote(pn(y)*0), [qt_zero]]; /* any*0 --> 0 */
! 198: Rule4=[quote(pn(y)+0), [qt_id,y]]; /* any+0 --> any */
! 199: Rule5=[quote(0+pn(y)), [qt_id,y]]; /* 0+any --> any */
! 200: Rule6=[quote(sin(0)), [qt_zero]]; /* sin(0) --> 0 */
! 201: Rule7=[quote(cos(0)), [qt_one]]; /* cos(0) --> 1 */
! 202: /* print(print_input_form(R0)); */
! 203: R=tr_apply_rule1_flag(R0,Rule1[0],Rule1[1]);
! 204: /* print([R[0],print_input_form(R[1])]); */
! 205: R=tr_apply_or_rules(R0,[Rule1,Rule2,Rule3,Rule4,Rule5,Rule6,Rule7]);
! 206: return R;
! 207: }
! 208:
! 209: /* 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 */
! 210: def tr_simp_zero(R0) {
! 211: Rule1=[quote(0*pn(y)), [qt_zero]]; /* 0*any --> 0 */
! 212: Rule2=[quote(pn(y)*0), [qt_zero]]; /* any*0 --> 0 */
! 213: Rule3=[quote(0/pn(y)), [qt_zero]]; /* 0/any --> 0 */
! 214: Rule4=[quote(pn(y)+0), [qt_id,y]]; /* any+0 --> any */
! 215: Rule5=[quote(0+pn(y)), [qt_id,y]]; /* 0+any --> any */
! 216: Rule6=[quote(-0), [qt_zero,y]]; /* -0 --> 0 */
! 217: R=tr_apply_or_rules(R0,[Rule1,Rule2,Rule3,Rule4,Rule5, Rule6]);
1.2 takayama 218: return R;
219: }
220:
1.5 takayama 221: /* $BHyJ,4D$N7W;;(B */
222: /* x $B$K0MB8$7$F$k$+(B? u, u_0, u_1, u_2, ... $B$O(B x $B$K0MB8$7$F$k(B.*/
223: def to_quote(L) {
224: return eval_str("quote("+listtoquote_str(L)+")");
225: }
226: def dep6(Q) {
227: if (type(Q) == 4) {
228: Q = to_quote(Q);
229: }
230: if (qt_is_dependent(Q,x)) return 1;
231: if (qt_is_dependent(Q,u)) return 1;
232: /* $B$H$j$"$($:(B 10 $B<!$^$G$N(B f. --> $B$J$s$H$+$;$h(B. */
233: for (I=0; I<10; I++) {
234: if (qt_is_dependent(Q,idxtov(u,I))) return 1;
235: }
236: return 0;
237: }
238: def diff_lin(F,G) {
239: if (type(F) == 4) F=to_quote(F);
240: if (type(G) == 4) G=to_quote(G);
241: return qt_replace(quote(diff(f)+diff(g)),[[f,F],[g,G]]);
242: }
243: def diff_mul(F,G) {
244: F1 = dep6(F); G1 = dep6(G);
245: if (type(F) == 4) F=to_quote(F);
246: if (type(G) == 4) G=to_quote(G);
247: if (F1 && G1)
248: return qt_replace(quote(diff(f)*g+f*diff(g)),[[f,F],[g,G]]);
249: if ((F1 == 1) && (G1 == 0))
250: return qt_replace(quote(diff(f)*g),[[f,F],[g,G]]);
251: if ((F1 == 0) && (G1 == 1))
252: return qt_replace(quote(f*diff(g)),[[f,F],[g,G]]);
253: if ((F1 == 0) && (G1 == 0))
254: return qt_zero();
255: }
256: def qt_one() {
257: return quote(1);
258: }
259: def diff_x_n(N) {
260: N = eval_quote(N);
261: N1=N-1;
262: if (N1 == 0) return qt_one();
263: if (N1 == 1) return quote(2*x);
264: if (N1 > 1) return eval_str("quote("+rtostr(N)+"*x^"+rtostr(N1)+")");
265: }
266: /* F $B$,(B u $B$H$+(B u_0, u_1, ... $B$J$i(B 1 $B$rLa$9(B. */
267: /* debug $BMQ$NF~NO(B.
268: tr_check_pn(quote(u_1),quote(pn(x,is_u_variable(x))));
269: */
270: def is_u_variable(F) {
271: /* $B=R8l$NA0$N(B check point $B$b(B debugger $B$KM_$7$$(B. */
272: /* print("is_u_variable: ",0); print(print_input_form(F)); */
273: if (type(F) == 17) F=quotetolist(F);
274: if (rtostr(F[0]) == "internal") {
275: V = eval_str(rtostr(F[1]));
276: if (vtoidx(V)[0] == "u") return 1;
277: }
278: return 0;
279: }
280: /* u_i^n $B$NHyJ,$r$9$k(B. n*u_{i+1}*u_i^{n-1}
281: Todo: $B$b$C$H4J7i$K(B quote $B$r=q$1$J$$$+(B?
282: */
283: def diff_u_n(F,N) {
284: F = eval_quote(F);
285: I = vtoidx(F);
286: if (length(I) == 1) I = 0; else I=I[1];
287: N = eval_quote(N);
288: N1=N-1;
289: NextU = "u_"+rtostr(I+1);
290: if (I == 0) U = "u"; else U = "u_"+rtostr(I);
291:
292: NN = objtoquote(N);
293: NN1 = objtoquote(N1);
294: NextU = objtoquote(eval_str(NextU));
295: U = objtoquote(eval_str(U));
296:
297: if (N1 == 0) return NextU;
298: if (N1 == 1) return qt_replace(quote(2*up*uu),[[up,NextU],[uu,U]]);
299: if (N1 > 1) return qt_replace(quote(n*up*uu^m),[[up,NextU],[uu,U],
300: [n,NN],[m,NN1]]);
301: }
302:
303: def test6b() {
304: T1=[quote(diff(x)),[qt_one]];
305: T2=[quote(diff(x^pn(n))),[diff_x_n,n]]; /* is_poly? $B$,M_$7$$(B. */
306: R1=[quote(diff(pn(f)+pn(g))),[diff_lin,f,g]];
307: R2=[quote(diff(pn(f)*pn(g))),[diff_mul,f,g]];
308:
309: A = quote(diff(2*4*x^3+x));
310: print(print_input_form(A));
311: R=tr_apply_or_rules(A,[R1,R2,T1,T2]);
312: return R;
313: }
314:
315: /* Use Debug2=1; $B$O(B debug $B$K$H$F$bM-1W(B. */
316: def test6() {
317: T1=[quote(diff(x)),[qt_one]];
318: T2=[quote(diff(x^pn(n))),[diff_x_n,n]]; /* is_poly? $B$,M_$7$$(B. */
319: T3=[quote(diff(pn(f,is_u_variable(f))^pn(n))),[diff_u_n,f,n]];
320: R1=[quote(diff(pn(f)+pn(g))),[diff_lin,f,g]];
321: R2=[quote(diff(pn(f)*pn(g))),[diff_mul,f,g]];
322:
323: /* A = quote(diff(2*x^3+x));*/
324: A = quote(diff(2*u^3+x));
325: print(print_input_form(A));
326: R=tr_apply_or_rules(A,[R1,R2,T1,T2,T3]);
327: return R;
328: }
1.2 takayama 329: end$
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to test1-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