File: [local] / OpenXM / src / asir-contrib / testing / tr.rr (download)
Revision 1.8, Wed May 11 06:40:10 2005 UTC (19 years ago) by takayama
Branch: MAIN
CVS Tags: R_1_3_1-2, RELEASE_1_3_1_13b, RELEASE_1_2_3_12, KNOPPIX_2006, HEAD, DEB_REL_1_2_3-9
Changes since 1.7: +144 -20
lines
1. qt.input_form, qt.hop,
qt.hc_etov(Q,V), Q is a monomial in quote. It returns the leading
coefficient and the exponent vector of Q.
|
/* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.8 2005/05/11 06:40:10 takayama Exp $ */
/* $Id: tr.rr,v 1.26 2005/05/08 08:37:46 taka Exp $ */
/*
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);
}
/* 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$
localf hm $
localf rest $
localf hop $
localf input_form $
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 R;
}
if (type(Z) == 0) return quote(0);
if ((type(Z) == 1) && (ntype(Z) == 0)) return quote(0);
return 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 quote(0);
else return 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;
}
/* dp_hm + dp_rest $B$N%"%J%m%8!<(B.
$B$?$@$7(B * $BEy(B binary operator $B$G>o$KF0:n(B.
$BNc(B: Q=h*r*r2 --> hm(Q)=h, rest(Q)=r*r2, hop(Q)="*".
$B$?$@$7(B rest $B$G(B quote $B$O(B $B:87k9gE*$KJQ99(B. flatten_quote().
*/
def hm(Q) {
if (type(Q) == O_LIST) Q = listtoquote(Q);
A=quote_to_funargs(Q);
if (A[0] == I_BOP) {
Op = get_function_name(A[1]);
if (Op == "+") {
return A[2];
}else if (Op == "-") {
return A[2];
}else if (Op == "*") {
return A[2];
}else if (Op == "/") {
return A[2];
}else if (Op == "^") {
return A[2];
}
}
return Q;
}
def rest(Q) {
if (type(Q) == O_LIST) Q = listtoquote(Q);
A=quote_to_funargs(Q);
if (A[0] == I_BOP) {
Op = get_function_name(A[1]);
if (Op == "+") {
return flatten_quote(A[3],"+");
}else if (Op == "-") {
return "not implented to return -A[3]";
}else if (Op == "*") {
return flatten_quote(A[3],"*");
}else if (Op == "/") {
return flatten_quote(A[3],"/");
}else if (Op == "^") {
return flatten_quote(A[3],"^");
}else return 0;
}
return 0;
}
def hop(Q) {
if (type(Q) == O_LIST) Q = listtoquote(Q);
A=quote_to_funargs(Q);
if (A[0] == I_BOP) return get_function_name(A[1]);
return 0;
}
def input_form(Q) {
T = type(Q);
if ((T == O_VECT) || (T == O_MAT)) {
Q = matrix_matrix_to_list(Q);
}
if (type(Q) == O_LIST) {
A = [];
for (I=length(Q)-1; I>=0; I--) {
A = cons(qt.input_form(Q[I]),A);
}
if ((T == O_VECT) || (T == O_MAT)) { A = matrix_list_to_matrix(A); }
return A;
}
if (T == O_QUOTE) return quote_input_form(Q);
return rtostr(Q);
}
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$
static Rule_test2$ /* int_sin2 $B$,MxMQ(B */
/* " " $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]]$
/*
$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_QUOTE) {F=quotetolist(F); P=quotetolist(P);}
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);
/* print(F);print(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])]; */
FF = [rtostr(qt.child(P,1)[1])];
M = length(qt.child(P,1));
for (I=2; I<M; I++) {
FF = append(FF,[rtostr(qt.child(P,1)[I][1])]);
}
/* print(FF); print(BindingTable); */
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$r8+$h(B.
*/
module qt;
localf dtoq$
localf qtod$ /* it has not yet been implemented. */
localf etoq$
localf hc_etov$
/* 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 flatten_quote(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 flatten_quote(R,"*");
}
def hc_etov(Q,V) {
HC=quote(1);
N = length(V);
E = newvect(N);
while (type(Q) != 0) {
Q = flatten_quote(Q,"*");
A = quote_to_funargs(Q);
Sign = 1;
if (A[0] == I_MINUS) {
Sign = -1;
Q = A[1];
}
Q = flatten_quote(Q,"*");
Op=qt.hop(Q);
if (Op != "*") {
F=Q; if (Sign == -1) F = quote((-1))*F;
Q=0;
}else{
F=qt.hm(Q); if (Sign == -1) F = quote((-1))*F;
Q=qt.rest(Q);
}
print(quote_input_form(F));
print(Op);
print(quote_input_form(Q));
Const = 1;
for (I=0; I<N; I++) {
if (qt.is_dependent(F,V[I])) {
Const = 0;
EE=qt.etov_pair(F);
if (EE != []) E[I] = EE[0][1];
else E[I] = quote(1);
}
}
if (Const) HC=HC*F;
}
return [HC,E];
}
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