| version 1.1, 2005/04/01 08:08:36 |
version 1.4, 2005/04/06 09:26:28 |
|
|
| |
/* $OpenXM: OpenXM/src/asir-contrib/testing/tr.rr,v 1.3 2005/04/03 11:05:21 takayama Exp $ */ |
| |
/* $Id$ */ |
| |
|
| |
/* |
| |
OpenXM$BHG$N(B Risa/Asir $B$G<B9T$N$3$H(B. OpenXM $BHG$N4X?t$rMQ$$$k$?$a(B. |
| |
*/ |
| |
/* $Id$ |
| |
$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$ |
| |
def dprint(X) { |
| |
if (Debug) print(X); |
| |
} |
| |
def dprint0(X) { |
| |
if (Debug) print(X,0); |
| |
} |
| |
|
| |
/* quotetolist $B$N5U4X?t(B. $B$?$@$7J8;zNs$G(B */ |
| |
def listtoquote_str(L) { |
| |
return quote_input_form_quote_list(L); |
| |
} |
| |
|
| |
def qt_node(F) { |
| |
if (type(F) == 17) F=quotetolist(F); |
| |
return [rtostr(F[0]),rtostr(F[1])]; |
| |
} |
| |
/* Number of child */ |
| |
def qt_nchild(F) { |
| |
if (type(F) == 17) F=quotetolist(F); |
| |
return length(F)-2; |
| |
} |
| |
def qt_child(F,K) { |
| |
if (type(F) == 17) F=quotetolist(F); |
| |
return F[K+2]; |
| |
} |
| |
|
| |
/* |
| |
$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 tr_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) != 4) { |
| |
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 tr_check_pn(F,P) { |
| |
if (type(F) ==17) F=quotetolist(F); |
| |
if (type(P) == 17) 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 tr_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 tr_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) != 4) 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 tr_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); |
| |
return eval_str(R); |
| |
} |
| |
|
| |
|
| |
/* 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 tr_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) == 17) R=quotetolist(R); |
| |
RR = "quote("+listtoquote_str(R)+")"; |
| |
dprint("-------- end of tr_apply_rule1 ------------ "); |
| |
return eval_str(RR); |
| |
} |
| |
|
| |
/* quote $B$KBP$9$k(B $B=R8l(B */ |
| |
def qt_is_integer(Qlist) { |
| |
if (type(Qlist) == 17) 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 qt_zero() { |
| |
return quotetolist(quote(0)); |
| |
} |
| |
|
| |
/* $B1&5,B'4X?t(B. $B91Ey<0(B */ |
| |
def qt_id(X) { |
| |
if (type(X) == 17) return quotetolist(X); |
| |
else return X; |
| |
} |
| |
|
| |
/* ------------ test --------------------------- */ |
| |
extern Rule_test2$ |
| |
/* " " $B$HIU$1$F$b$D$1$J$/$F$b$h$$(B. $BFbIt$G(B rtostr $B$7$F$k(B. */ |
| |
/* Rule_test2=[quote(sin(pn("x")*@pi)),["qt_sin_int2","x"]]$ */ |
| |
Rule_test2=[quote(sin(pn(x)*@pi)),[qt_sin_int2,x]]$ |
| |
|
| |
|
| |
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)); |
| |
} |
| |
|
| |
/* $B1&5,B'4X?t(B. sin($B@0?t(B*@pi) $B$r(B 0 $B$K(B */ |
| |
def qt_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 qt_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); |
| |
} |
| |
|
| |
/* --------------- end test -----------------------*/ |
| |
def qt_replace(F,Rule) { |
| |
return base_replace(F,Rule); |
| |
} |
| |
|
| |
/* F $B$NCf$KITDj85(B X $B$,4^$^$l$F$$$k$+(B? |
| |
qt_dependent(quotetolist(quote(1+1/x)),x) |
| |
*/ |
| |
def qt_dependent(F,X) { |
| |
if (type(F) == 17) 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_dependent(C,X)) return 1; |
| |
} |
| |
return 0; |
| |
} |
| |
} |
| |
|
| |
/* 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; |
| |
} |
| |
|
| |
/* $BCm0U(B: @pi $B$b4X?t07$$(B. */ |
| |
def qt_is_function(X) { |
| |
if (type(X) == 17) 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 qt_map_arg(F,Q) { |
| |
F = rtostr(F); |
| |
if (type(Q) == 17) 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+")"); |
| |
} |
| |
|
| |
/* $B$3$l$i0J30$N%F%9%H%W%m%0%i%`$O(B test1-tr.rr $B$r(B |
| |
*/ |
| |
|
| |
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