Return to r-fd.rr CVS log

Up to [local] / OpenXM / src / asir-port / cgi

Annotation of OpenXM/src/asir-port/cgi/r-fd.rr, Revision 1.11

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