Annotation of OpenXM/src/asir-port/cgi/r-fd.rr, Revision 1.8
1.8 ! takayama 1: /* $OpenXM: OpenXM/src/asir-port/cgi/r-fd.rr,v 1.7 2015/02/25 04:47:50 takayama Exp $ */
1.1 takayama 2: load("tk_fd.rr")$
1.2 takayama 3: import("tk_r.rr")$
1.3 takayama 4: import("oh_number.rr")$
5:
6: /* r_d2rat(0.3) --> precision loss in truncation if not ctrl("bigfloat",1) */
7: ctrl("bigfloat",1)$
8: def r_d2rat(Y) {
9: if ((type(Y) ==4)||(type(Y)==5)||(type(Y)==6)) return map(r_d2rat,Y);
10: if ((type(Y) == 1) && (ntype(Y) >= 1)) {
11: S = rtostr(Y); Y = "eval(("+S+")*exp(0));";
12: /* print(Y); */
13: Y = eval_str(Y);
1.4 takayama 14: /* printf("Y=%a\n",Y); */
15: /* return oh_number.rats(Y); */
16: return rats2(Y); /* temporary */
1.3 takayama 17: }else return Y;
18: }
1.1 takayama 19: def r_ahvec(A,B,C,Y) {
1.3 takayama 20: Y = r_d2rat(Y);
1.7 takayama 21: Ans=a_ahvec(A,B,C,Y);
22: /* Fans=map(rtostr,map(tk_fd.tk_number_rattofloat,Ans)); */
23: Fans=map(deval,Ans);
24: Fans = tk_r.asir2r_c(Fans);
25: return Fans;
26: }
27:
28: def a_ahvec(A,B,C,Y) {
1.5 takayama 29: R=tk_fd.ahvec_abc(A,B,C,Y|all=1);
1.1 takayama 30: Gamma=R[1];
31: Der=R[0];
32: Z=R[2]*Gamma;
33: Der2 = newvect(length(Der));
34: for (I=0; I<length(Der); I++) Der2[I] = Der[I]*Gamma;
35: Der2 = vtol(Der2);
36: Ans=cons(Z,Der2);
1.7 takayama 37: return(Ans);
1.1 takayama 38: }
1.4 takayama 39:
40: /* temporary */
41: def rats2(X) {
42: if (X == 0) return 0;
43: Sign=1;
44: if (X <0) {Sign=-1 ; X = -X;}
45: Digit = number_floor(eval(log(X)/log(10)));
46: Num = number_floor((X/(10^Digit))*10^20);
47: return Sign*(Num/(10^20))*(10^Digit);
48: }
49:
50: def checkrats2() {
51: for (I=0; I<10; I++) {
52: Sign=(-1)^(random()%2);
53: X = eval(exp(0)*(random()/random())*10^(Sign*(random()%300))); /* 308 */
54: printf("X=%a\n",X);
55: Y = rats2(X);
56: printf("Y=%a\n",Y);
57: if (number_abs(eval(Y*exp(0))/X-1) > 0.0000001) {
58: printf("error: X = %a, Y=%a\n",X,Y);
59: }
60: }
61: }
1.6 takayama 62:
63: def a_expect(A,B,C,Y) {
64: E=tk_fd.expectation_abc(A,B,C,Y);
65: return(E);
66: }
67: def r_expect(A,B,C,Y) {
68: Y = r_d2rat(Y);
69: E=a_expect(A,B,C,Y);
1.8 ! takayama 70: Fans=map_deval(E);
1.6 takayama 71: Fans = tk_r.asir2r_c(Fans);
72: return Fans;
73: }
74:
1.8 ! takayama 75: def r_ahmat(A,B,C,Y) {
! 76: Y = r_d2rat(Y);
! 77: Ans=a_ahmat(A,B,C,Y);
! 78: Fans=map_deval(Ans);
! 79: Fans = tk_r.asir2r_c(Fans);
! 80: return Fans;
! 81: }
! 82:
! 83: def a_ahmat(A,B,C,Y) {
! 84: return(tk_fd.ahmat_abc(A,B,C,Y));
! 85: }
! 86:
! 87: def r_log_ahmat(A,B,C,Y) {
! 88: Y = r_d2rat(Y);
! 89: Ans=a_log_ahmat(A,B,C,Y);
! 90: Fans=map_deval(Ans);
! 91: Fans = tk_r.asir2r_c(Fans);
! 92: return Fans;
! 93: }
! 94:
! 95: def a_log_ahmat(A,B,C,Y) {
! 96: Ans=tk_fd.log_ahmat_abc(A,B,C,Y);
! 97: return Ans;
! 98: }
! 99:
! 100: def map_deval(L) {
! 101: if (type(L) >=4) return(map(map_deval,L));
! 102: return(deval(L));
! 103: }
1.1 takayama 104: end$
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>