=================================================================== RCS file: /home/cvs/OpenXM/src/asir-port/cgi/r-fd.rr,v retrieving revision 1.1 retrieving revision 1.4 diff -u -p -r1.1 -r1.4 --- OpenXM/src/asir-port/cgi/r-fd.rr 2014/07/27 03:18:44 1.1 +++ OpenXM/src/asir-port/cgi/r-fd.rr 2014/08/06 07:39:47 1.4 @@ -1,5 +1,23 @@ +/* $OpenXM: OpenXM/src/asir-port/cgi/r-fd.rr,v 1.3 2014/07/31 07:00:41 takayama Exp $ */ load("tk_fd.rr")$ +import("tk_r.rr")$ +import("oh_number.rr")$ + +/* r_d2rat(0.3) --> precision loss in truncation if not ctrl("bigfloat",1) */ +ctrl("bigfloat",1)$ +def r_d2rat(Y) { + if ((type(Y) ==4)||(type(Y)==5)||(type(Y)==6)) return map(r_d2rat,Y); + if ((type(Y) == 1) && (ntype(Y) >= 1)) { + S = rtostr(Y); Y = "eval(("+S+")*exp(0));"; + /* print(Y); */ + Y = eval_str(Y); + /* printf("Y=%a\n",Y); */ + /* return oh_number.rats(Y); */ + return rats2(Y); /* temporary */ + }else return Y; +} def r_ahvec(A,B,C,Y) { + Y = r_d2rat(Y); R=tk_fd.ygahvec(A,B,C,Y|all=1); Gamma=R[1]; Der=R[0]; @@ -10,6 +28,30 @@ def r_ahvec(A,B,C,Y) { Ans=cons(Z,Der2); /* Fans=map(rtostr,map(tk_fd.tk_number_rattofloat,Ans)); */ Fans=map(deval,Ans); + Fans = tk_r.asir2r_c(Fans); return Fans; +} + +/* temporary */ +def rats2(X) { + if (X == 0) return 0; + Sign=1; + if (X <0) {Sign=-1 ; X = -X;} + Digit = number_floor(eval(log(X)/log(10))); + Num = number_floor((X/(10^Digit))*10^20); + return Sign*(Num/(10^20))*(10^Digit); +} + +def checkrats2() { + for (I=0; I<10; I++) { + Sign=(-1)^(random()%2); + X = eval(exp(0)*(random()/random())*10^(Sign*(random()%300))); /* 308 */ + printf("X=%a\n",X); + Y = rats2(X); + printf("Y=%a\n",Y); + if (number_abs(eval(Y*exp(0))/X-1) > 0.0000001) { + printf("error: X = %a, Y=%a\n",X,Y); + } + } } end$