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