OpenXM/src/asir-port/cgi/r-fd.rr - diff

Return to r-fd.rr CVS log

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

Diff for /OpenXM/src/asir-port/cgi/r-fd.rr between version 1.5 and 1.9

-version 1.5, 2014/08/27 02:14:40
+version 1.9, 2015/03/01 04:23:15
 Line 1
 Line 1
 Line 1
- /* $OpenXM: OpenXM/src/asir-port/cgi/r-fd.rr,v 1.4 2014/08/06 07:39:47 takayama Exp $ */
+ /* $OpenXM: OpenXM/src/asir-port/cgi/r-fd.rr,v 1.8 2015/02/28 11:39:13 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) {
+ def r_d2rat(Y,Prec) {
-   if ((type(Y) ==4)||(type(Y)==5)||(type(Y)==6)) return map(r_d2rat,Y);
+   if ((type(Y) ==4)||(type(Y)==5)||(type(Y)==6)) return map(r_d2rat,Y,Prec);
    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  */
+     return rats2(Y | prec=Prec);  /* temporary  */
    }else return Y;
  }
  def r_ahvec(A,B,C,Y) {
-   Y = r_d2rat(Y);
+   if (type(getopt(prec))<0) Prec=20;
+   else Prec=getopt(prec);
+   Y = r_d2rat(Y,Prec);
+   Ans=a_ahvec(A,B,C,Y);
+   /*  Fans=map(rtostr,map(tk_fd.tk_number_rattofloat,Ans)); */
+   Fans=map(deval,Ans);
+   Fans = tk_r.asir2r_c(Fans);
+   return Fans;
+ }
+ def a_ahvec(A,B,C,Y) {
    R=tk_fd.ahvec_abc(A,B,C,Y|all=1);
    Gamma=R[1];
    Der=R[0];
-Line 26  def r_ahvec(A,B,C,Y) {
+Line 36  def r_ahvec(A,B,C,Y) {
 Line 26  def r_ahvec(A,B,C,Y) {
 Line 36  def r_ahvec(A,B,C,Y) {
    for (I=0; I<length(Der); I++) Der2[I] = Der[I]*Gamma;
    Der2 = vtol(Der2);
    Ans=cons(Z,Der2);
-   /*  Fans=map(rtostr,map(tk_fd.tk_number_rattofloat,Ans)); */
+   return(Ans);
-   Fans=map(deval,Ans);
-   Fans = tk_r.asir2r_c(Fans);
-   return Fans;
  }
  /* temporary */
  def rats2(X) {
+   if (type(getopt(prec))<0) Prec=20;
+   else Prec=getopt(prec);
    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);
+   Num = number_floor((X/(10^Digit))*10^Prec);
-   return Sign*(Num/(10^20))*(10^Digit);
+   return Sign*(Num/(10^Prec))*(10^Digit);
  }
  def checkrats2() {
-Line 53  def checkrats2() {
+Line 62  def checkrats2() {
 Line 53  def checkrats2() {
 Line 62  def checkrats2() {
          printf("error: X = %a, Y=%a\n",X,Y);
       }
    }
+ }
+ def a_expect(A,B,C,Y) {
+   E=tk_fd.expectation_abc(A,B,C,Y);
+   return(E);
+ }
+ def r_expect(A,B,C,Y) {
+   if (type(getopt(prec))<0) Prec=20;
+   else Prec=getopt(prec);
+   Y = r_d2rat(Y,Prec);
+   E=a_expect(A,B,C,Y);
+   Fans=map_deval(E);
+   Fans = tk_r.asir2r_c(Fans);
+   return Fans;
+ }
+ def r_ahmat(A,B,C,Y) {
+   if (type(getopt(prec))<0) Prec=20;
+   else Prec=getopt(prec);
+   Y = r_d2rat(Y,Prec);
+   Ans=a_ahmat(A,B,C,Y);
+   Fans=map_deval(Ans);
+   Fans = tk_r.asir2r_c(Fans);
+   return Fans;
+ }
+ def a_ahmat(A,B,C,Y) {
+   return(tk_fd.ahmat_abc(A,B,C,Y));
+ }
+ def r_log_ahmat(A,B,C,Y) {
+   if (type(getopt(prec))<0) Prec=20;
+   else Prec=getopt(prec);
+   Y = r_d2rat(Y,Prec);
+   Ans=a_log_ahmat(A,B,C,Y);
+   Fans=map_deval(Ans);
+   Fans = tk_r.asir2r_c(Fans);
+   return Fans;
+ }
+ def a_log_ahmat(A,B,C,Y) {
+   Ans=tk_fd.log_ahmat_abc(A,B,C,Y);
+   return Ans;
+ }
+ def map_deval(L) {
+   if (type(L) >=4) return(map(map_deval,L));
+   return(deval(L));
  }
  end$

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>