| version 1.1, 2005/04/01 08:08:36 |
version 1.7, 2005/05/04 05:47:03 |
|
|
| |
/* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.6 2005/04/21 10:54:50 takayama Exp $ */ |
| |
/* $Id$ */ |
| |
|
| |
/* |
| |
OpenXM$BHG$N(B Risa/Asir $B$G<B9T$N$3$H(B. OpenXM $BHG$N4X?t$rMQ$$$k$?$a(B. |
| |
*/ |
| |
/* |
| |
$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. |
| |
tr.oxt $B$N;EMM$H$3$H$J$j(B quotetolist $B$GJQ49$7$?$b$N$r07$&(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$ |
| |
extern Debug2$ /* For tr.apply_or_rules. $B$H$F$bJXMx(B. */ |
| |
Debug2=0$ |
| |
def dprint(X) { |
| |
if (Debug) print(X); |
| |
} |
| |
def dprint0(X) { |
| |
if (Debug) print(X,0); |
| |
} |
| |
extern Debug2$ |
| |
Debug2=0$ |
| |
|
| |
/* quotetolist $B$N5U4X?t(B. $B$?$@$7J8;zNs$G(B */ |
| |
def listtoquote_str(L) { |
| |
return quote_input_form_quote_list(L); |
| |
} |
| |
/* quotetolist $B$N5U4X?t(B. quote $B$rLa$9(B */ |
| |
def listtoquote(L) { |
| |
return eval_str("quote("+quote_input_form_quote_list(L)+")"); |
| |
} |
| |
|
| |
/* unix $B$N(B uniq $B$KF1$8(B */ |
| |
def uniq(L) { |
| |
N = length(L); |
| |
if (N > 0) A = [L[0]]; else A=[]; |
| |
for (I=1; I<N; I++) { |
| |
if (A[0] != L[I]) A=cons(L[I],A); |
| |
} |
| |
return reverse(A); |
| |
} |
| |
/* Global rules */ |
| |
extern Rule_test2$ |
| |
/* " " $B$HIU$1$F$b$D$1$J$/$F$b$h$$(B. $BFbIt$G(B rtostr $B$7$F$k(B. |
| |
. $B$,IU$$$?$iIU$1$k$7$+$J$$(B. |
| |
*/ |
| |
/* Rule_test2=[quote(sin(pn("x")*@pi)),["qt.sin_int2","x"]]$ */ |
| |
Rule_test2=[quote(sin(pn(x)*@pi)),["qt.sin_int2",x]]$ |
| |
|
| |
/* Object id */ |
| |
#define O_N 1 |
| |
#define O_P 2 |
| |
#define O_R 3 |
| |
#define O_LIST 4 |
| |
#define O_VECT 5 |
| |
#define O_MAT 6 |
| |
#define O_STR 7 |
| |
#define O_COMP 8 |
| |
#define O_DP 9 |
| |
#define O_USINT 10 |
| |
#define O_ERR 11 |
| |
#define O_GF2MAT 12 |
| |
#define O_MATHCAP 13 |
| |
#define O_F 14 |
| |
#define O_GFMMAT 15 |
| |
#define O_BYTEARRAY 16 |
| |
#define O_QUOTE 17 |
| |
#define O_OPTLIST 18 |
| |
#define O_SYMBOL 19 |
| |
#define O_RANGE 20 |
| |
#define O_TB 21 |
| |
#define O_DPV 22 |
| |
#define O_QUOTEARG 23 |
| |
#define O_VOID -1 |
| |
|
| |
/* Numbers for the first element of quote_to_funargs */ |
| |
#define I_BOP 0 |
| |
#define I_COP 1 |
| |
#define I_AND 2 |
| |
#define I_OR 3 |
| |
#define I_NOT 4 |
| |
#define I_CE 5 |
| |
#define I_PRESELF 6 |
| |
#define I_POSTSELF 7 |
| |
#define I_FUNC 8 |
| |
#define I_FUNC_OPT 9 |
| |
#define I_IFUNC 10 |
| |
#define I_MAP 11 |
| |
#define I_RECMAP 12 |
| |
#define I_PFDERIV 13 |
| |
#define I_ANS 14 |
| |
#define I_PVAR 15 |
| |
#define I_ASSPVAR 16 |
| |
#define I_FORMULA 17 |
| |
#define I_LIST 18 |
| |
#define I_STR 19 |
| |
#define I_NEWCOMP 20 |
| |
#define I_CAR 21 |
| |
#define I_CDR 22 |
| |
#define I_CAST 23 |
| |
#define I_INDEX 24 |
| |
#define I_EV 25 |
| |
#define I_TIMER 26 |
| |
#define I_GF2NGEN 27 |
| |
#define I_GFPNGEN 28 |
| |
#define I_GFSNGEN 29 |
| |
#define I_LOP 30 |
| |
#define I_OPT 31 |
| |
#define I_GETOPT 32 |
| |
#define I_POINT 33 |
| |
#define I_PAREN 34 |
| |
#define I_MINUS 35 |
| |
#define I_NARYOP 36 |
| |
|
| |
module qt; |
| |
localf node $ |
| |
localf nchild $ |
| |
localf child $ |
| |
localf is_integer $ |
| |
localf replace $ |
| |
localf is_dependent $ |
| |
localf is_function $ |
| |
localf map_arg $ |
| |
|
| |
localf zero $ |
| |
localf id $ |
| |
localf one $ |
| |
localf plus $ |
| |
localf minus $ |
| |
localf sin_int $ |
| |
localf sin_int2 $ |
| |
localf is_rational $ |
| |
localf cancel_number $ |
| |
/* 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),...) */ |
| |
localf is_minus $ /* $B@hF,$K(B - $B$,$"$k$+7A<0E*$K$_$k(B. */ |
| |
localf add_paren0 $ |
| |
localf add_paren $ /* +- $BEy$K(B ( ) $B$r2C$($k(B. */ |
| |
localf vars $ |
| |
localf etov_pair$ |
| |
|
| |
def node(F) { |
| |
if (type(F) == O_QUOTE) F=quotetolist(F); |
| |
return [rtostr(F[0]),rtostr(F[1])]; |
| |
} |
| |
/* Number of child */ |
| |
def nchild(F) { |
| |
if (type(F) == O_QUOTE) F=quotetolist(F); |
| |
return length(F)-2; |
| |
} |
| |
def child(F,K) { |
| |
if (type(F) == O_QUOTE) F=quotetolist(F); |
| |
return F[K+2]; |
| |
} |
| |
|
| |
/* quote $B$KBP$9$k(B $B=R8l(B */ |
| |
def is_integer(Qlist) { |
| |
if (type(Qlist) == O_QUOTE) Qlist=quotetolist(Qlist); |
| |
if ((rtostr(Qlist[0]) == "u_op") && (rtostr(Qlist[1]) == "-")) { |
| |
return qt.is_integer(cdr(cdr(Qlist))[0]); |
| |
} |
| |
if (Qlist[0] == "internal") { |
| |
Z = eval_str(rtostr(Qlist[1])); |
| |
}else{ |
| |
return 0; |
| |
} |
| |
if (type(Z) == 0) return 1; |
| |
if ((type(Z) == 1) && (ntype(Z) == 0)) return 1; |
| |
return 0; |
| |
} |
| |
|
| |
/* quote $B$N@8@.(B */ |
| |
/* $B1&5,B'4X?t(B. 0 $B$rLa$9(B. */ |
| |
def zero() { |
| |
return quotetolist(quote(0)); |
| |
} |
| |
|
| |
/* $B1&5,B'4X?t(B. $B91Ey<0(B */ |
| |
def id(X) { |
| |
if (type(X) == O_QUOTE) return quotetolist(X); |
| |
else return X; |
| |
} |
| |
|
| |
def one() { |
| |
return quote(1); |
| |
} |
| |
|
| |
def plus(X,Y) { |
| |
if ((type(X) == O_QUOTE) && (type(Y) == O_QUOTE)) return X+Y; |
| |
return ["b_op","+",X,Y]; |
| |
} |
| |
|
| |
def minus(X,Y) { |
| |
if ((type(X) == O_QUOTE) && (type(Y) == O_QUOTE)) return X-Y; |
| |
return ["b_op","-",X,Y]; |
| |
} |
| |
|
| |
|
| |
/* $B1&5,B'4X?t(B. sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B */ |
| |
def 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("+listtoquote_str(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); |
| |
} |
| |
|
| |
/* $B1&5,B'4X?t(B. sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B. $B?<$5M%@hMQ(B */ |
| |
def sin_int2(X) { |
| |
/* tr.apply_rule1 $B$r:F5"E*$K$h$V(B. $B$3$NJ}K!$G9=J82r@O$b$+$1$k(B. */ |
| |
X = tr.apply_rule1(X,Rule_test2[0],Rule_test2[1]); |
| |
Y = quotetolist(X); |
| |
R = "quote(sin("+listtoquote_str(Y)+"*@pi))"; |
| |
print(R); |
| |
R = eval_str(R); |
| |
if (qt.is_integer(Y)) return quotetolist(quote(0)); |
| |
else return quotetolist(R); |
| |
} |
| |
|
| |
def replace(F,Rule) { |
| |
return base_replace(F,Rule); |
| |
} |
| |
|
| |
/* F $B$NCf$KITDj85(B X $B$,4^$^$l$F$$$k$+(B? |
| |
qt.is_dependent(quotetolist(quote(1+1/x)),x) |
| |
*/ |
| |
def is_dependent(F,X) { |
| |
if (type(F) == O_QUOTE) F = quotetolist(F); |
| |
Node = qt.node(F); |
| |
if ((F[0] == "internal") && (rtostr(F[1]) == rtostr(X))) { |
| |
return 1; |
| |
}else{ |
| |
N = qt.nchild(F); |
| |
for (I=0; I<N;I++) { |
| |
C = qt.child(F,I); |
| |
if (qt.is_dependent(C,X)) return 1; |
| |
} |
| |
return 0; |
| |
} |
| |
} |
| |
|
| |
/* $BCm0U(B: @pi $B$b4X?t07$$(B. */ |
| |
def is_function(X) { |
| |
if (type(X) == O_QUOTE) X=quotetolist(X); |
| |
if (rtostr(X[0]) == "function") return 1; |
| |
else return 0; |
| |
} |
| |
|
| |
/* qt.map_arg(nn,quote(f(x,y))) --> nn(f(nn(x),nn(y))) |
| |
qt.map_arg(nn,quote(1/4+f(x))) --> |
| |
$B%F%9%H$O(B test4(). |
| |
*/ |
| |
def map_arg(F,Q) { |
| |
F = rtostr(F); |
| |
if (type(Q) == O_QUOTE) Q=quotetolist(Q); |
| |
if (rtostr(Q[0]) == "internal") { |
| |
T = listtoquote_str(Q); |
| |
return eval_str( "quote("+F+"("+T+"))" ); |
| |
} |
| |
/* node $B$N;R6!$r(B F $B$GI>2A$9$k(B. */ |
| |
N = qt.nchild(Q); |
| |
L = []; |
| |
for (I=0; I<N; I++) { |
| |
L = append(L,[quotetolist(qt.map_arg(F,qt.child(Q,I)))]); |
| |
} |
| |
dprint0("qt.map_arg:L="); dprint(L); |
| |
T = [Q[0],Q[1]]; |
| |
for (I=0; I<N; I++) { |
| |
T = append(T,[L[I]]); |
| |
} |
| |
/* $B:G8e$K;R6!$r?F(B Q[0],Q[1] $B$GI>2A$7$F$+$i(B F $B$GI>2A(B */ |
| |
T = ["function",F,T]; |
| |
dprint0("qt.map_arg:T="); dprint(T); |
| |
T = listtoquote_str(T); |
| |
return eval_str("quote("+T+")"); |
| |
} |
| |
|
| |
/* ($B7A<0E*$K(B) Q $B$KB0$9$k(B quote $B$+(B? */ |
| |
def is_rational(X) { |
| |
if (type(X) == O_LIST) X=listtoquote(X); |
| |
A = quote_to_funargs(X); |
| |
if (A[0] == I_FORMULA) { /* 1, x */ |
| |
if (type(A[1]) <= O_N) return 1; |
| |
else return 0; |
| |
} |
| |
if (A[0] == I_BOP) { /* 2+3, 2/x */ |
| |
Op = get_function_name(A[1]); |
| |
if ((Op == "+") || (Op == "-") || (Op == "*") || (Op == "/") |
| |
|| (Op == "^")) { |
| |
if (qt.is_rational(A[2]) && qt.is_rational(A[3])) return 1; |
| |
else return 0; |
| |
} |
| |
} |
| |
if (A[0] == I_PAREN) { |
| |
if (qt.is_rational(A[1])) return 1; |
| |
else return 0; |
| |
} |
| |
if (A[0] == I_MINUS) { |
| |
if (qt.is_rational(A[1])) return 1; |
| |
else return 0; |
| |
} |
| |
return 0; |
| |
} |
| |
|
| |
/* 2/4 --> 1/2 $B$X(B |
| |
$B$3$N<BAu$O8zN($O0-$$(B. |
| |
*/ |
| |
def cancel_number(Q) { |
| |
if (type(Q) == O_LIST) Q=listtoquote(Q); |
| |
if (qt.is_rational(Q)) { |
| |
Ans = eval_quote(Q); |
| |
return objtoquote(Ans); |
| |
} |
| |
A = quote_to_funargs(Q); |
| |
N = length(A); R=[]; |
| |
for (I=N-1; I>= 0; I--) { |
| |
if (type(A[I]) == O_QUOTE) |
| |
R = cons(qt.cancel_number(A[I]),R); |
| |
else |
| |
R = cons(A[I],R); |
| |
} |
| |
return funargs_to_quote(R); |
| |
} |
| |
|
| |
/* $B@hF,$K(B - $B$,$"$k$+7A<0E*$K$_$k(B. |
| |
-a+b |
| |
-3 |
| |
-34/y $BEy(B. |
| |
*/ |
| |
def is_minus(Q) { |
| |
if (type(Q) == O_LIST) Q=listtoquote(Q); |
| |
A = quote_to_funargs(Q); |
| |
if (A[0] == I_MINUS) return 1; |
| |
if (A[0] == I_BOP) { |
| |
if (qt.is_minus(A[2])) return 1; |
| |
else return 0; |
| |
} |
| |
return 0; |
| |
} |
| |
/* $BL5>r7o$K(B ( ) $B$r2C$($k(B. */ |
| |
def add_paren0(Q) { |
| |
A = [I_PAREN,Q]; |
| |
return funargs_to_quote(A); |
| |
} |
| |
/* +- $BEy$K(B ( ) $B$r2C$($k(B. |
| |
$BF0:n$,IT?3$J$N$G(B bug $B$,$"$k$+$b(B. |
| |
*/ |
| |
def add_paren(Q) { |
| |
if (type(Q) == O_LIST) Q=listtoquote(Q); |
| |
A = quote_to_funargs(Q); |
| |
/* $B$3$N=hM}$OKhEY;H$&$N$G$^$H$a$?J}$,$$$$$N$G$O(B? */ |
| |
N = length(A); R=[]; |
| |
for (I=N-1; I>= 0; I--) { |
| |
if (type(A[I]) == O_QUOTE) |
| |
R = cons(qt.add_paren(A[I]),R); |
| |
else |
| |
R = cons(A[I],R); |
| |
} |
| |
A = R; |
| |
if (A[0] == I_BOP) { |
| |
if (get_function_name(A[1]) == "+") { |
| |
if (qt.is_minus(A[3])) { /* x+-y ==> x+(-y) */ |
| |
A2 = [I_BOP,A[1], |
| |
qt.add_paren(A[2]), |
| |
qt.add_paren0(A[3])]; |
| |
return funargs_to_quote(A2); |
| |
} |
| |
}else if (get_function_name(A[1]) == "*" || |
| |
get_function_name(A[1]) == "/") |
| |
{ |
| |
if (qt.is_minus(A[2])) { /* -x*y ==> (-x)*y */ |
| |
A2 = [I_BOP,A[1], |
| |
qt.add_paren0(A[2]), |
| |
qt.add_paren(A[3])]; |
| |
return funargs_to_quote(A2); |
| |
} |
| |
} |
| |
} |
| |
return funargs_to_quote(A); |
| |
} |
| |
|
| |
/* vars $B$N??;w(B. |
| |
$B$3$N4X?t$b(B $BJQ?t$N=P8=2s?tJ,$N%j%9%H$r:n$k$N$G8zN($o$k$$(B. |
| |
*/ |
| |
def vars(Q) { |
| |
R = [ ]; |
| |
if (type(Q) == O_LIST) Q=listtoquote(Q); |
| |
A = quote_to_funargs(Q); |
| |
if (A[0] == I_FORMULA) { |
| |
if (type(A[1]) == O_P) { |
| |
R = cons(A[1],R); |
| |
} |
| |
} |
| |
/* $B$3$N=hM}$OKhEY;H$&$N$G$^$H$a$?J}$,$$$$$N$G$O(B? */ |
| |
N = length(A); |
| |
for (I=1; I<N; I++) { |
| |
if (type(A[I]) == O_QUOTE) |
| |
R = append(qt.vars(A[I]),R); |
| |
} |
| |
R=qsort(R); |
| |
R=uniq(R); |
| |
return reverse(R); |
| |
} |
| |
|
| |
/* p^q $B$r:F5"$GC5$7$F(B [p,q] $B$rLa$9(B. */ |
| |
def etov_pair(Q) { |
| |
R = [ ]; |
| |
if (type(Q) == O_LIST) Q=listtoquote(Q); |
| |
A = quote_to_funargs(Q); |
| |
if (A[0] == I_BOP) { |
| |
if (get_function_name(A[1]) == "^") { |
| |
R=[[A[2],A[3]]]; |
| |
} |
| |
} |
| |
/* $B$3$N=hM}$OKhEY;H$&$N$G$^$H$a$?J}$,$$$$$N$G$O(B? */ |
| |
N = length(A); |
| |
for (I=1; I<N; I++) { |
| |
if (type(A[I]) == O_QUOTE) |
| |
R = append(qt.etov_pair(A[I]),R); |
| |
} |
| |
return R; |
| |
} |
| |
|
| |
endmodule$ |
| |
|
| |
module tr; |
| |
localf match0$ |
| |
localf check_pn$ |
| |
localf make_binding$ |
| |
localf rp$ |
| |
localf apply_function0$ |
| |
localf apply_rule1$ |
| |
localf rp_flag$ |
| |
localf apply_rule1_flag$ |
| |
localf apply_or_rules$ |
| |
|
| |
/* |
| |
$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. |
| |
*/ |
| |
def match0(F,P) { |
| |
dprint0("tr.match0: F="); dprint(F); |
| |
dprint0("tr.match0: P="); dprint(P); |
| |
|
| |
if (type(F) != type(P)) return 0; |
| |
if (type(F) != O_LIST) { |
| |
if (F == P) return 1; |
| |
else return 0; |
| |
} |
| |
Node = qt.node(F); |
| |
Node2 = qt.node(P); |
| |
/* pn $B$K2?$N@)Ls$b$J$1$l$P(B 2 $B$rLa$9(B. */ |
| |
if (Node2 == ["function","pn"]) return tr.check_pn(F,P); |
| |
if (Node != Node2) return 0; |
| |
N = qt.nchild(F); |
| |
if (N != qt.nchild(P)) return 0; |
| |
for (I=0; I<N; I++) { |
| |
C = qt.child(F,I); |
| |
C2 = qt.child(P,I); |
| |
if (!tr.match0(C,C2)) return 0; |
| |
} |
| |
return 1; |
| |
} |
| |
|
| |
/* |
| |
P $B$NNc(B: P = pn("x"); P=pn("x",qt.is_integer(x)); |
| |
P $B$O(B [function,pn,[internal,x],[function,is_int,[internal,x]]] |
| |
FF $B$O(B ["is_int","x"] |
| |
$B%F%9%H%G!<%?(B. |
| |
tr.check_pn(quote(1/2),quote(pn("x",qt.is_integer(x)))); |
| |
*/ |
| |
def check_pn(F,P) { |
| |
if (type(F) ==O_QUOTE) F=quotetolist(F); |
| |
if (type(P) == O_QUOTE) P=quotetolist(P); |
| |
N=qt.nchild(P); |
| |
if (N == 1) return 2; |
| |
X = rtostr(qt.child(P,0)[1]); |
| |
BindingTable = [[X,F]]; |
| |
FF = [rtostr(qt.child(P,1)[1]),rtostr(qt.child(P,1)[2][1])]; |
| |
R = tr.apply_function0(FF,BindingTable); |
| |
return R; |
| |
} |
| |
|
| |
/* F $B$H(B P $B$,(B tr.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 make_binding(F,P) { |
| |
Ans = [ ]; |
| |
if (F == P) return Ans; |
| |
|
| |
Node = qt.node(F); |
| |
Node2 = qt.node(P); |
| |
|
| |
if (Node2 == ["function", "pn"]) { |
| |
Ans = append(Ans,[[rtostr(P[2][1]),F]]); |
| |
return Ans; |
| |
} |
| |
N = qt.nchild(F); |
| |
for (I=0; I<N; I++) { |
| |
C = qt.child(F,I); |
| |
C2 = qt.child(P,I); |
| |
Ans = append(Ans,tr.make_binding(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. |
| |
$B?<$5M%@hC5:w$K$7$?(B --> action $B4X?t$NCf$G:F5"E*$K8F$Y$P?<$5M%@h$H$J$k(B. |
| |
Todo: $B=q$-49$($,$*$3$C$?$+$N%U%i%0(B. |
| |
*/ |
| |
def rp(F,P,Q) { |
| |
dprint0("tr.rp, F="); dprint(F); |
| |
dprint0("tr.rp, P="); dprint(P); |
| |
dprint0("tr.rp, Q="); dprint(Q); |
| |
if (tr.match0(F,P)) { |
| |
BindTable = tr.make_binding(F,P); |
| |
dprint0("BindTable="); dprint(BindTable); |
| |
return tr.apply_function0(Q,BindTable); |
| |
} |
| |
if (type(F) != O_LIST) return F; |
| |
Node = qt.node(F); |
| |
N = qt.nchild(F); |
| |
Ans = Node; |
| |
for (I=0; I<N; I++) { |
| |
T = tr.rp(qt.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 apply_function0(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("+listtoquote_str(BindTable[I][1])+")"]]); |
| |
} |
| |
dprint0("tr.apply_function0: "); dprint(B); |
| |
N = length(Q)-1; /* $B0z?t$N?t(B */ |
| |
M = length(B); /* binding table $B$N%5%$%:(B */ |
| |
R = rtostr(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) { |
| |
dprint0("No binding data. Use the X itself. X="); dprint(X); |
| |
R = R+X; |
| |
if (I != N-1) R = R+","; |
| |
} |
| |
} |
| |
} |
| |
R = R+")"; |
| |
dprint0("R="); dprint(R); |
| |
V=eval_str(R); |
| |
if (type(V) == O_QUOTE) return quotetolist(V); |
| |
else return V; |
| |
} |
| |
|
| |
|
| |
/* L $B$,:85,B'(B. R $B$,1&5,B'(B. $BI}M%@hC5:w(B. |
| |
$B=q$-49$($r$9$k$?$a$N%H%C%W%l%Y%k$N4X?t(B ($B$N$R$H$D(B). |
| |
$BNc(B: |
| |
tr.apply_rule1(quote(1+sin(3*@pi)*sin(@pi/2)), |
| |
quote(sin(pn("x")*@pi)), |
| |
["qt.sin_int","x"]); |
| |
*/ |
| |
def apply_rule1(Obj,L,R) { |
| |
dprint("-------- start of tr.apply_rule1 ------------ "); |
| |
Obj = quotetolist(Obj); |
| |
L = quotetolist(L); |
| |
R = tr.rp(Obj,L,R); |
| |
if (type(R) == O_QUOTE) R=quotetolist(R); |
| |
RR = "quote("+listtoquote_str(R)+")"; |
| |
dprint("-------- end of tr.apply_rule1 ------------ "); |
| |
return eval_str(RR); |
| |
} |
| |
|
| |
/* Flag $BIU$-(B $B$N(B tr.rp. $BB0@-$,$J$$$N$G$3$l$G$d$k(B. */ |
| |
def rp_flag(F,P,Q) { |
| |
Flag = 0; |
| |
dprint0("tr.rp, F="); dprint(F); |
| |
dprint0("tr.rp, P="); dprint(P); |
| |
dprint0("tr.rp, Q="); dprint(Q); |
| |
if (tr.match0(F,P)) { |
| |
BindTable = tr.make_binding(F,P); |
| |
dprint0("BindTable="); dprint(BindTable); |
| |
return [1,tr.apply_function0(Q,BindTable)]; |
| |
} |
| |
if (type(F) != O_LIST) return F; |
| |
Node = qt.node(F); |
| |
N = qt.nchild(F); |
| |
Ans = Node; |
| |
for (I=0; I<N; I++) { |
| |
T = tr.rp_flag(qt.child(F,I),P,Q); |
| |
if (T[0] == 1) Flag = 1; |
| |
Ans = append(Ans,[T[1]]); |
| |
} |
| |
return [Flag,Ans]; |
| |
} |
| |
|
| |
/* $B=q$-49$((B flag $BIU$-$N(B tr.apply_rule_flag */ |
| |
def apply_rule1_flag(Obj,L,R) { |
| |
Flag = 0; |
| |
if (Debug2) |
| |
print("-------- start of tr.apply_rule1_flag ------------ "); |
| |
if (Debug2) print(print_input_form(Obj)); |
| |
Obj = quotetolist(Obj); |
| |
L = quotetolist(L); |
| |
R = tr.rp_flag(Obj,L,R); |
| |
Flag=R[0]; R=R[1]; |
| |
if (type(R) == O_QUOTE) R=quotetolist(R); |
| |
RR = "quote("+listtoquote_str(R)+")"; |
| |
if (Debug2) {print("==> "+RR+" by "); print(listtoquote_str(L));} |
| |
if (Debug2) print("-------- end of tr.apply_rule1_flag ------------ "); |
| |
return [Flag,eval_str(RR)]; |
| |
} |
| |
|
| |
def apply_or_rules(Q,R) { |
| |
Flag = 1; |
| |
N = length(R); |
| |
while (Flag) { |
| |
Flag = 0; |
| |
for (I=0; I<N; I++) { |
| |
Q = tr.apply_rule1_flag(Q,R[I][0],R[I][1]); |
| |
if (Q[0]) { |
| |
Flag = 1; |
| |
dprint("Applied the rule "+rtostr(I)); |
| |
} |
| |
Q = Q[1]; |
| |
} |
| |
} |
| |
return Q; |
| |
} |
| |
|
| |
endmodule$ |
| |
|
| |
|
| |
/* tr $B$N=q$-49$(%k!<%k(B */ |
| |
module tr; |
| |
localf simp_zero$ |
| |
localf simp_unary$ |
| |
localf simp_sin$ |
| |
/* 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 |
| |
test_0(); $B$G%F%9%H$9$k(B. |
| |
*/ |
| |
def simp_zero(R0) { |
| |
Rule1=[quote(0*pn(y)), ["qt.zero"]]; /* 0*any --> 0 */ |
| |
Rule2=[quote(pn(y)*0), ["qt.zero"]]; /* any*0 --> 0 */ |
| |
Rule3=[quote(0/pn(y)), ["qt.zero"]]; /* 0/any --> 0 */ |
| |
Rule4=[quote(pn(y)+0), ["qt.id",y]]; /* any+0 --> any */ |
| |
Rule5=[quote(0+pn(y)), ["qt.id",y]]; /* 0+any --> any */ |
| |
Rule6=[quote(-0), ["qt.zero",y]]; /* -0 --> 0 */ |
| |
Rule7=[quote((0)), ["qt.zero",y]]; /* (0) --> 0 */ |
| |
Rule8=[quote(1*pn(y)), ["qt.id",y]]; /* 1*any --> any */ |
| |
Rule9=[quote(pn(y)*1), ["qt.id",y]]; /* any*1 --> any */ |
| |
R=tr.apply_or_rules(R0,[Rule1,Rule2,Rule3,Rule4,Rule5, Rule6,Rule7, |
| |
Rule8, Rule9]); |
| |
return R; |
| |
} |
| |
|
| |
def simp_unary(R0) { |
| |
Rule1=[quote(pn(x))+quote(-pn(y)), ["qt.minus",x,y]]; /* x+-y -> x-y */ |
| |
Rule2=[quote(-(-pn(x))), ["qt.id",x]]; /* -(-x) --> x */ |
| |
Rule3=[quote(pn(x)-(-pn(y))), ["qt.plus",x,y]]; /* x-(-y) --> x+y */ |
| |
R=tr.apply_or_rules(R0,[Rule1,Rule2,Rule3]); |
| |
return R; |
| |
} |
| |
|
| |
/* |
| |
test_1() $B$O%5%s%W%k%F%9%H(B. |
| |
*/ |
| |
def simp_sin(R0) { |
| |
Rule1=[quote(sin(pn(x)*@pi)),["qt.sin_int",x]]; /* sin($B@0?t(B*@pi) --> 0 */ |
| |
Rule2=[quote(0*pn(y)), ["qt.zero"]]; /* 0*any --> 0 */ |
| |
Rule3=[quote(pn(y)*0), ["qt.zero"]]; /* any*0 --> 0 */ |
| |
Rule4=[quote(pn(y)+0), ["qt.id",y]]; /* any+0 --> any */ |
| |
Rule5=[quote(0+pn(y)), ["qt.id",y]]; /* 0+any --> any */ |
| |
Rule6=[quote(sin(0)), ["qt.zero"]]; /* sin(0) --> 0 */ |
| |
Rule7=[quote(cos(0)), ["qt.one"]]; /* cos(0) --> 1 */ |
| |
/* print(print_input_form(R0)); */ |
| |
R=tr.apply_rule1_flag(R0,Rule1[0],Rule1[1]); |
| |
/* print([R[0],print_input_form(R[1])]); */ |
| |
R=tr.apply_or_rules(R0,[Rule1,Rule2,Rule3,Rule4,Rule5,Rule6,Rule7]); |
| |
return R; |
| |
} |
| |
|
| |
endmodule$ |
| |
/* ------------ test --------------------------- */ |
| |
|
| |
|
| |
|
| |
def test2() { |
| |
/* $BI}M%@hC5:w$N>l9g(B, R0 $B$O(B simplify $B$G$-$:(B. */ |
| |
Rule1=[quote(sin(pn("x")*@pi)),["qt.sin_int","x"]]; |
| |
R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2)); |
| |
print(print_input_form(R0)); |
| |
R=tr.apply_rule1(R0,Rule1[0],Rule1[1]); |
| |
print(print_input_form(R)); |
| |
print("-----------------------"); |
| |
/* $B<!$N$h$&$K=q$/$H?<$5M%@h$G=q$1$k(B */ |
| |
R0 = quote(1+sin(sin(2*@pi)*@pi)*sin(@pi/2)); |
| |
print(print_input_form(R0)); |
| |
R=tr.apply_rule1(R0,Rule_test2[0],Rule_test2[1]); |
| |
print(print_input_form(R)); |
| |
} |
| |
|
| |
|
| |
/* tr.check_pn $B$NF0:n%F%9%H(B */ |
| |
def test2b() { |
| |
Rule=[quote(sin(pn(x,qt.is_integer(x))*@pi)),["qt.zero"]]$ |
| |
R0 = quote(1+sin(2*@pi)*sin(a*@pi));; |
| |
print(print_input_form(R0)); |
| |
R=tr.apply_rule1(R0,Rule[0],Rule[1]); |
| |
return R; |
| |
} |
| |
|
| |
/* tr.simp_zero $B$N%F%9%H(B */ |
| |
def test_0() { |
| |
F = quote(x+(0*x+0)); |
| |
print(quote_input_form(F)); |
| |
return tr.simp_zero(F); |
| |
} |
| |
|
| |
/* tr.simp_sin $B$N%F%9%H(B */ |
| |
def test_1() { |
| |
F = quote(sin(sin(0))+sin(0)); |
| |
print(quote_input_form(F)); |
| |
return tr.simp_sin(F); |
| |
} |
| |
|
| |
/* ------------------------------------------------ */ |
| |
|
| |
/* Index $BIU$-JQ?t$r<B8=$9$k(B */ |
| |
def idxtov(V,I) { |
| |
if (type(I) == 5) I=vtol(I); |
| |
if (type(I) != O_LIST) I=[I]; |
| |
if (type(V) != 2) V=rtostr(V); |
| |
return util_v(V,I); |
| |
} |
| |
|
| |
def vtoidx(V) { |
| |
A = util_index(V); |
| |
if (length(A[1]) == 0) return [A[0]]; |
| |
if (length(A[1]) == 1) return [A[0],A[1][0]]; |
| |
return A; |
| |
} |
| |
|
| |
/* $B$3$l$i0J30$N%F%9%H%W%m%0%i%`$O(B test1-tr.rr $B$r(B |
| |
*/ |
| |
|
| |
module qt; |
| |
localf dtoq$ |
| |
localf qtod$ /* it has not yet been implemented. */ |
| |
localf etoq$ |
| |
|
| |
/* Distributed polynomial to quote |
| |
qt.dtoq(dp_ptod((x-y)^3,[x,y]),[]); |
| |
*/ |
| |
def dtoq(F,V) { |
| |
if (F == 0) return quote(0); |
| |
N = length(dp_etov(F)); |
| |
if (N > length(V)) { |
| |
for (I=length(V); I<N; I++) { |
| |
V = append(V,[util_v("x",[I+1])]); |
| |
} |
| |
} |
| |
R = 0; |
| |
while (F != 0) { |
| |
T = dp_hm(F); |
| |
F = dp_rest(F); |
| |
C = objtoquote(dp_hc(T)); |
| |
if (qt.is_minus(C)) { |
| |
C = qt.add_paren0(C); |
| |
} |
| |
E = dp_etov(T); |
| |
Mq = etoq(E,V); |
| |
if (Mq == quote(1)) { |
| |
R = R+C; |
| |
}else{ |
| |
if (C == quote(1)) R = R+Mq; |
| |
else if (C == quote(-1)) R = R-Mq; |
| |
else R = R+C*Mq; |
| |
} |
| |
} |
| |
return R; |
| |
} |
| |
|
| |
def etoq(E,V) { |
| |
N = length(E); |
| |
if (N > length(V)) { |
| |
for (I=length(V); I<N; I++) { |
| |
V = append(V,[util_v("x",[I+1])]); |
| |
} |
| |
} |
| |
II = -1; |
| |
for (I=0; I<N; I++) { |
| |
if (E[I] != 0) { II=I; break; } |
| |
} |
| |
if (II == -1) return quote(1); |
| |
if (E[II] == 1) R=objtoquote(V[II]); |
| |
else { |
| |
R=objtoquote(V[II])^objtoquote(E[II]); |
| |
} |
| |
for (I=II+1; I<N; I++) { |
| |
if (E[I] != 0) { |
| |
if (E[I] == 1) Rt=objtoquote(V[I]); |
| |
else Rt=objtoquote(V[I])^objtoquote(E[I]); |
| |
R = R*Rt; |
| |
} |
| |
} |
| |
return R; |
| |
} |
| |
|
| |
endmodule; |
| |
|
| |
end$ |
| |
|
![[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