[BACK]Return to itvnum.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/itvnum.c between version 1.6 and 1.12

version 1.6, 2011/08/10 04:51:57 version 1.12, 2019/06/04 07:11:22
Line 1 
Line 1 
 /*  /*
  * $OpenXM: OpenXM_contrib2/asir2000/builtin/itvnum.c,v 1.5 2005/07/14 22:46:03 kondoh Exp $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/itvnum.c,v 1.11 2018/03/29 01:32:50 noro Exp $
  */   */
   
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
 #include "version.h"  #include "version.h"
   #if !defined(ANDROID)
 #include "../plot/ifplot.h"  #include "../plot/ifplot.h"
   #endif
   
 #if defined(INTERVAL)  // in engine/bf.c
   Num tobf(Num,int);
   
   #if defined(INTERVAL)
 static void Pitv(NODE, Obj *);  static void Pitv(NODE, Obj *);
 static void Pitvd(NODE, Obj *);  static void Pitvd(NODE, Obj *);
 static void Pitvbf(NODE, Obj *);  static void Pitvbf(NODE, Obj *);
Line 22  static void Pcup(NODE, Obj *);
Line 26  static void Pcup(NODE, Obj *);
 static void Pcap(NODE, Obj *);  static void Pcap(NODE, Obj *);
 static void Pwidth(NODE, Obj *);  static void Pwidth(NODE, Obj *);
 static void Pdistance(NODE, Obj *);  static void Pdistance(NODE, Obj *);
 static void Pitvversion(Q *);  static void Pitvversion(NODE, Q *);
   static void PzeroRewriteMode(NODE, Obj *);
   static void PzeroRewriteCountClear(NODE, Obj *);
   static void PzeroRewriteCount(NODE, Obj *);
   //void miditvp(Itv,Num *);
   //void absitvp(Itv,Num *);
   //int initvd(Num,IntervalDouble);
   //int initvp(Num,Itv);
   //int itvinitvp(Itv,Itv);
 #endif  #endif
 static void Pprintmode(NODE, Obj *);  static void Pprintmode(NODE, Obj *);
   
Line 30  static void Pprintmode(NODE, Obj *);
Line 42  static void Pprintmode(NODE, Obj *);
 static void ccalc(double **, struct canvas *, int);  static void ccalc(double **, struct canvas *, int);
 static void Pifcheck(NODE, Obj *);  static void Pifcheck(NODE, Obj *);
   
 #if     defined(__osf__) && 0  #if  defined(__osf__) && 0
 int     end;  int  end;
 #endif  #endif
   
 struct ftab interval_tab[] = {  struct ftab interval_tab[] = {
         {"printmode",Pprintmode,1},    {"printmode",Pprintmode,1},
 #if defined(INTERVAL)  #if defined(INTERVAL)
         {"itvd",Pitvd,-2},    {"itvd",Pitvd,-2},
         {"intvald",Pitvd,-2},    {"intvald",Pitvd,-2},
         {"itv",Pitv,-2},    {"itv",Pitv,-2},
         {"intval",Pitv,-2},    {"intval",Pitv,-2},
         {"itvbf",Pitvbf,-2},    {"itvbf",Pitvbf,-2},
         {"intvalbf",Pitvbf,-2},    {"intvalbf",Pitvbf,-2},
         {"inf",Pinf,1},    {"inf",Pinf,1},
         {"sup",Psup,1},    {"sup",Psup,1},
         {"absintval",Pabsitv,1},    {"absintval",Pabsitv,1},
         {"disintval",Pdisjitv,2},    {"disintval",Pdisjitv,2},
         {"inintval",Pinitv,2},    {"inintval",Pinitv,2},
         {"cup",Pcup,2},    {"cup",Pcup,2},
         {"cap",Pcap,2},    {"cap",Pcap,2},
         {"mid",Pmid,1},    {"mid",Pmid,1},
         {"width",Pwidth,1},    {"width",Pwidth,1},
         {"diam",Pwidth,1},    {"diam",Pwidth,1},
         {"distance",Pdistance,2},    {"distance",Pdistance,2},
         {"iversion",Pitvversion,0},    {"iversion",Pitvversion,-1},
     {"intvalversion",Pitvversion,-1},
     {"zerorewritemode",PzeroRewriteMode,-1},
     {"zeroRewriteMode",PzeroRewriteMode,-1},
     {"zeroRewriteCountClear",PzeroRewriteCountClear,-1},
     {"zeroRewriteCount",PzeroRewriteCount,-1},
 /* plot time check */  /* plot time check */
         {"ifcheck",Pifcheck,-7},    {"ifcheck",Pifcheck,-7},
 #endif  #endif
         {0,0,0},    {0,0,0},
 };  };
   
   extern int mpfr_roundmode;
   
 #if defined(INTERVAL)  #if defined(INTERVAL)
   
 /* plot time check */  /* plot time check */
 static void  static void
 Pifcheck(NODE arg, Obj *rp)  Pifcheck(NODE arg, Obj *rp)
 {  {
         Q m2,p2,s_id;    Q m2,p2,s_id;
         NODE defrange;    NODE defrange;
         LIST xrange,yrange,range[2],list,geom;    LIST xrange,yrange,range[2],list,geom;
         VL vl,vl0;    VL vl,vl0;
         V v[2],av[2];    V v[2],av[2];
         int ri,i,j,sign;    int ri,i,j,sign;
         P poly;    P poly;
         P var;    P var;
         NODE n,n0;    NODE n,n0;
         Obj t;    Obj t;
   
         struct canvas *can;    struct canvas *can;
         MAT m;    MAT m;
         pointer **mb;    pointer **mb;
         double **tabe, *px, *px1, *px2;    double **tabe, *px, *px1, *px2;
         Q one;    Q one;
         int width, height, ix, iy;    int width, height, ix, iy;
         int id;    int id;
   
         STOQ(-2,m2); STOQ(2,p2);    STOQ(-2,m2); STOQ(2,p2);
         STOQ(1,one);    STOQ(1,one);
         MKNODE(n,p2,0); MKNODE(defrange,m2,n);    MKNODE(n,p2,0); MKNODE(defrange,m2,n);
         poly = 0; vl = 0; geom = 0; ri = 0;    poly = 0; vl = 0; geom = 0; ri = 0;
         v[0] = v[1] = 0;    v[0] = v[1] = 0;
         for ( ; arg; arg = NEXT(arg) ){    for ( ; arg; arg = NEXT(arg) ){
                 switch ( OID(BDY(arg)) ) {      switch ( OID(BDY(arg)) ) {
                 case O_P:      case O_P:
                         poly = (P)BDY(arg);        poly = (P)BDY(arg);
                         get_vars_recursive((Obj)poly,&vl);        get_vars_recursive((Obj)poly,&vl);
                         for ( vl0 = vl, i = 0; vl0; vl0 = NEXT(vl0) )        for(vl0=vl,i=0;vl0;vl0=NEXT(vl0)){
                                 if ( vl0->v->attr == (pointer)V_IND )          if(vl0->v->attr==(pointer)V_IND){
                                         if ( i >= 2 )            if(i>=2){
                                                 error("ifplot : invalid argument");              error("ifplot : invalid argument");
                                         else            } else {
                                                 v[i++] = vl0->v;              v[i++]=vl0->v;
                         break;            }
                 case O_LIST:          }
                         list = (LIST)BDY(arg);        }
                         if ( OID(BDY(BDY(list))) == O_P )        break;
                                 if ( ri > 1 )      case O_LIST:
                                         error("ifplot : invalid argument");        list = (LIST)BDY(arg);
                                 else        if ( OID(BDY(BDY(list))) == O_P )
                                         range[ri++] = list;          if ( ri > 1 )
                         else            error("ifplot : invalid argument");
                                 geom = list;          else
                         break;            range[ri++] = list;
                 default:        else
                         error("ifplot : invalid argument"); break;          geom = list;
                 }        break;
         }      default:
         if ( !poly ) error("ifplot : invalid argument");        error("ifplot : invalid argument"); break;
         switch ( ri ) {      }
                 case 0:    }
                         if ( !v[1] ) error("ifplot : please specify all variables");    if ( !poly ) error("ifplot : invalid argument");
                         MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);    switch ( ri ) {
                         MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);      case 0:
                         break;        if ( !v[1] ) error("ifplot : please specify all variables");
                 case 1:        MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);
                         if ( !v[1] ) error("ifplot : please specify all variables");        MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);
                         av[0] = VR((P)BDY(BDY(range[0])));        break;
                         if ( v[0] == av[0] ) {      case 1:
                                 xrange = range[0];        if ( !v[1] ) error("ifplot : please specify all variables");
                                 MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);        av[0] = VR((P)BDY(BDY(range[0])));
                         } else if ( v[1] == av[0] ) {        if ( v[0] == av[0] ) {
                                 MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);          xrange = range[0];
                                 yrange = range[0];          MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);
                         } else        } else if ( v[1] == av[0] ) {
                                 error("ifplot : invalid argument");          MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);
                         break;          yrange = range[0];
                 case 2:        } else
                         av[0] = VR((P)BDY(BDY(range[0])));          error("ifplot : invalid argument");
                         av[1] = VR((P)BDY(BDY(range[1])));        break;
                         if ( ((v[0] == av[0]) && (!v[1] || v[1] == av[1])) ||      case 2:
                                  ((v[0] == av[1]) && (!v[1] || v[1] == av[0])) ) {        av[0] = VR((P)BDY(BDY(range[0])));
                                         xrange = range[0]; yrange = range[1];        av[1] = VR((P)BDY(BDY(range[1])));
                         } else error("ifplot : invalid argument");        if ( ((v[0] == av[0]) && (!v[1] || v[1] == av[1])) ||
                         break;           ((v[0] == av[1]) && (!v[1] || v[1] == av[0])) ) {
                 default:            xrange = range[0]; yrange = range[1];
                         error("ifplot : cannot happen"); break;        } else error("ifplot : invalid argument");
         }        break;
         can = canvas[id = search_canvas()];      default:
         if ( !geom ) {        error("ifplot : cannot happen"); break;
                 width = 300;    }
                 height = 300;    can = canvas[id = search_canvas()];
                 can->width = 300;    if ( !geom ) {
                 can->height = 300;      width = 300;
         } else {      height = 300;
                 can->width = QTOS((Q)BDY(BDY(geom)));      can->width = 300;
                 can->height = QTOS((Q)BDY(NEXT(BDY(geom))));      can->height = 300;
                 width = can->width;    } else {
                 height = can->height;      can->width = QTOS((Q)BDY(BDY(geom)));
         }      can->height = QTOS((Q)BDY(NEXT(BDY(geom))));
         if ( xrange ) {      width = can->width;
                 n = BDY(xrange); can->vx = VR((P)BDY(n)); n = NEXT(n);      height = can->height;
                 can->qxmin = (Q)BDY(n); n = NEXT(n); can->qxmax = (Q)BDY(n);    }
                 can->xmin = ToReal(can->qxmin); can->xmax = ToReal(can->qxmax);    if ( xrange ) {
         }      n = BDY(xrange); can->vx = VR((P)BDY(n)); n = NEXT(n);
         if ( yrange ) {      can->qxmin = (Q)BDY(n); n = NEXT(n); can->qxmax = (Q)BDY(n);
                 n = BDY(yrange); can->vy = VR((P)BDY(n)); n = NEXT(n);      can->xmin = ToReal(can->qxmin); can->xmax = ToReal(can->qxmax);
                 can->qymin = (Q)BDY(n); n = NEXT(n); can->qymax = (Q)BDY(n);    }
                 can->ymin = ToReal(can->qymin); can->ymax = ToReal(can->qymax);    if ( yrange ) {
         }      n = BDY(yrange); can->vy = VR((P)BDY(n)); n = NEXT(n);
         can->wname = "ifcheck";      can->qymin = (Q)BDY(n); n = NEXT(n); can->qymax = (Q)BDY(n);
         can->formula = poly;      can->ymin = ToReal(can->qymin); can->ymax = ToReal(can->qymax);
         tabe = (double **)ALLOCA((width+1)*sizeof(double *));    }
         for ( i = 0; i <= width; i++ )    can->wname = "ifcheck";
                 tabe[i] = (double *)ALLOCA((height+1)*sizeof(double));    can->formula = poly;
         for(i=0;i<=width;i++)for(j=0;j<=height;j++)tabe[i][j]=0;    tabe = (double **)ALLOCA((width+1)*sizeof(double *));
         ccalc(tabe,can,0);    for ( i = 0; i <= width; i++ )
         MKMAT(m,width,height);      tabe[i] = (double *)ALLOCA((height+1)*sizeof(double));
         mb = BDY(m);    for(i=0;i<=width;i++)for(j=0;j<=height;j++)tabe[i][j]=0;
         for( ix=0; ix<width; ix++ ){    ccalc(tabe,can,0);
                 for( iy=0; iy<height; iy++){    MKMAT(m,width,height);
                         if ( tabe[ix][iy] >= 0 ){    mb = BDY(m);
                                 if ( (tabe[ix+1][iy] <= 0) ||    for( ix=0; ix<width; ix++ ){
                                         (tabe[ix][iy+1] <= 0 ) ||      for( iy=0; iy<height; iy++){
                                         (tabe[ix+1][iy+1] <= 0 ) ) mb[ix][iy] = (Obj)one;        if ( tabe[ix][iy] >= 0 ){
                         } else {          if ( (tabe[ix+1][iy] <= 0) ||
                                 if ( (tabe[ix+1][iy] >= 0 ) ||            (tabe[ix][iy+1] <= 0 ) ||
                                         ( tabe[ix][iy+1] >= 0 ) ||            (tabe[ix+1][iy+1] <= 0 ) ) mb[ix][iy] = (Obj)one;
                                         ( tabe[ix+1][iy+1] >= 0 )) mb[ix][iy] = (Obj)one;        } else {
                         }          if ( (tabe[ix+1][iy] >= 0 ) ||
                 }            ( tabe[ix][iy+1] >= 0 ) ||
         }            ( tabe[ix+1][iy+1] >= 0 )) mb[ix][iy] = (Obj)one;
         *rp = (Obj)m;        }
       }
     }
     *rp = (Obj)m;
 }  }
   
 void ccalc(double **tab,struct canvas *can,int nox)  void ccalc(double **tab,struct canvas *can,int nox)
 {  {
          double x,y,xmin,ymin,xstep,ystep;     double x,y,xmin,ymin,xstep,ystep;
          int ix,iy;     int ix,iy;
          Real r,rx,ry;     Real r,rx,ry;
          Obj fr,g;     Obj fr,g;
          int w,h;     int w,h;
          V vx,vy;     V vx,vy;
          Obj t,s;     Obj t,s;
   
          MKReal(1.0,r); mulr(CO,(Obj)can->formula,(Obj)r,&fr);     MKReal(1.0,r); mulr(CO,(Obj)can->formula,(Obj)r,&fr);
          vx = can->vx;     vx = can->vx;
          vy = can->vy;     vy = can->vy;
          w = can->width; h = can->height;     w = can->width; h = can->height;
          xmin = can->xmin; xstep = (can->xmax-can->xmin)/w;     xmin = can->xmin; xstep = (can->xmax-can->xmin)/w;
          ymin = can->ymin; ystep = (can->ymax-can->ymin)/h;     ymin = can->ymin; ystep = (can->ymax-can->ymin)/h;
          MKReal(1.0,rx); MKReal(1.0,ry);     MKReal(1.0,rx); MKReal(1.0,ry);
          for( ix = 0, x = xmin; ix < w+1 ; ix++, x += xstep ) {     for( ix = 0, x = xmin; ix < w+1 ; ix++, x += xstep ) {
             BDY(rx) = x; substr(CO,0,fr,vx,x?(Obj)rx:0,&t);        BDY(rx) = x; substr(CO,0,fr,vx,x?(Obj)rx:0,&t);
             devalr(CO,t,&g);        devalr(CO,t,&g);
             for( iy = 0, y = ymin; iy < h+1 ; iy++, y += ystep ) {        for( iy = 0, y = ymin; iy < h+1 ; iy++, y += ystep ) {
                BDY(ry) = y;           BDY(ry) = y;
                substr(CO,0,g,vy,y?(Obj)ry:0,&t);           substr(CO,0,g,vy,y?(Obj)ry:0,&t);
                devalr(CO,t,&s);           devalr(CO,t,&s);
                tab[ix][iy] = ToReal(s);           tab[ix][iy] = ToReal(s);
             }        }
          }     }
 }  }
 /* end plot time check */  /* end plot time check */
   
 static void  static void
 Pitvversion(Q *rp)  Pitvversion(NODE arg, Q *rp)
 {  {
         STOQ(ASIR_VERSION, *rp);    STOQ(INT_ASIR_VERSION, *rp);
 }  }
   
 extern int      bigfloat;  extern int  bigfloat;
   
 static void  static void
 Pitv(NODE arg, Obj *rp)  Pitv(NODE arg, Obj *rp)
 {  {
         Num     a, i, s;    Num  a, i, s;
         Itv     c;    Itv  c;
         double  inf, sup;    double  inf, sup;
   
 #if 1  #if 1
         if ( bigfloat )    if ( bigfloat )
                 Pitvbf(arg, rp);      Pitvbf(arg, rp);
         else    else
                 Pitvd(arg,rp);      Pitvd(arg,rp);
 #else  #else
         asir_assert(ARG0(arg),O_N,"itv");    asir_assert(ARG0(arg),O_N,"itv");
         if ( argc(arg) > 1 ) {    if ( argc(arg) > 1 ) {
                 asir_assert(ARG1(arg),O_N,"itv");      asir_assert(ARG1(arg),O_N,"itv");
                 istoitv((Num)ARG0(arg),(Num)ARG1(arg),&c);      istoitv((Num)ARG0(arg),(Num)ARG1(arg),&c);
         } else {    } else {
                 a = (Num)ARG0(arg);      a = (Num)ARG0(arg);
                 if ( ! a ) {      if ( ! a ) {
                         *rp = 0;        *rp = 0;
                         return;        return;
                 }      }
                 else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat) {      else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat) {
                         *rp = (Obj)a;        *rp = (Obj)a;
                         return;        return;
                 }      }
                 else if ( NID(a) == N_IntervalDouble ) {      else if ( NID(a) == N_IntervalDouble ) {
                         inf = INF((IntervalDouble)a);        inf = INF((IntervalDouble)a);
                         sup = SUP((IntervalDouble)a);        sup = SUP((IntervalDouble)a);
                         double2bf(inf, (BF *)&i);        double2bf(inf, (BF *)&i);
                         double2bf(sup, (BF *)&s);        double2bf(sup, (BF *)&s);
                         istoitv(i,s,&c);        istoitv(i,s,&c);
                 }      }
                 else istoitv(a,a,&c);      else istoitv(a,a,&c);
         }    }
         if ( NID( c ) == N_IntervalBigFloat )    if ( NID( c ) == N_IntervalBigFloat )
                 addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);      addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
         else *rp = (Obj)c;    else *rp = (Obj)c;
 #endif  #endif
 }  }
   
 static void  static void
 Pitvbf(NODE arg, Obj *rp)  Pitvbf(NODE arg, Obj *rp)
 {  {
         Num     a, i, s;    Num  a, i, s;
         Itv     c;    IntervalBigFloat  c;
         BF      ii,ss;    Num  ii,ss;
         double  inf, sup;    Real di, ds;
     double  inf, sup;
     int current_roundmode;
   
         asir_assert(ARG0(arg),O_N,"intvalbf");    asir_assert(ARG0(arg),O_N,"intvalbf");
         a = (Num)ARG0(arg);    a = (Num)ARG0(arg);
         if ( argc(arg) > 1 ) {    if ( argc(arg) > 1 ) {
                 asir_assert(ARG1(arg),O_N,"intvalbf");      asir_assert(ARG1(arg),O_N,"intvalbf");
                 i = (Num)ARG0(arg);  
                 s = (Num)ARG1(arg);      i = (Num)ARG0(arg);
                 ToBf(i, &ii);      s = (Num)ARG1(arg);
                 ToBf(s, &ss);      current_roundmode = mpfr_roundmode;
                 istoitv((Num)ii,(Num)ss,&c);      mpfr_roundmode = MPFR_RNDD;
         } else {      ii = tobf(i, DEFAULTPREC);
                 if ( ! a ) {      mpfr_roundmode = MPFR_RNDU;
                         *rp = 0;      ss = tobf(s, DEFAULTPREC);
                         return;      istoitv(ii,ss,(Itv *)&c);
                 }  //    MKIntervalBigFloat((BF)ii,(BF)ss,c);
                 else if ( NID(a) == N_IP ) {  //    ToBf(s, &ss);
                         itvtois((Itv)a, &i, &s);      mpfr_roundmode = current_roundmode;
                         ToBf(i, &ii);    } else {
                         ToBf(s, &ss);      if ( ! a ) {
                         istoitv((Num)ii,(Num)ss,&c);        *rp = 0;
                 }        return;
                 else if ( NID(a) == N_IntervalBigFloat) {      }
                         *rp = (Obj)a;      else if ( NID(a) == N_IP ) {
                         return;        itvtois((Itv)a, &i, &s);
                 }        current_roundmode = mpfr_roundmode;
                 else if ( NID(a) == N_IntervalDouble ) {        mpfr_roundmode = MPFR_RNDD;
                         inf = INF((IntervalDouble)a);        ii = tobf(i, DEFAULTPREC);
                         sup = SUP((IntervalDouble)a);        mpfr_roundmode = MPFR_RNDU;
                         double2bf(inf, (BF *)&i);        ss = tobf(s, DEFAULTPREC);
                         double2bf(sup, (BF *)&s);        istoitv(ii,ss,(Itv *)&c);
                         istoitv(i,s,&c);  //      MKIntervalBigFloat((BF)ii,(BF)ss,c);
                 }        mpfr_roundmode = current_roundmode;
                 else {      }
                         ToBf(a, (BF *)&i);      else if ( NID(a) == N_IntervalBigFloat) {
                         istoitv(i,i,&c);        *rp = (Obj)a;
                 }        return;
         }      }
         if ( c && OID( c ) == O_N && NID( c ) == N_IntervalBigFloat )      else if ( NID(a) == N_IntervalDouble ) {
                 addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);        inf = INF((IntervalDouble)a);
         else *rp = (Obj)c;        sup = SUP((IntervalDouble)a);
         current_roundmode = mpfr_roundmode;
         //double2bf(inf, (BF *)&i);
         //double2bf(sup, (BF *)&s);
         mpfr_roundmode = MPFR_RNDD;
         MKReal(inf,di);
         ii = tobf((Num)di, DEFAULTPREC);
         mpfr_roundmode = MPFR_RNDU;
         MKReal(sup,ds);
         ss = tobf((Num)ds, DEFAULTPREC);
         istoitv(ii,ss,(Itv *)&c);
   //      MKIntervalBigFloat((BF)ii,(BF)ss,c);
         mpfr_roundmode = current_roundmode;
       }
       else {
         current_roundmode = mpfr_roundmode;
         mpfr_roundmode = MPFR_RNDD;
         ii = tobf(a, DEFAULTPREC);
         mpfr_roundmode = MPFR_RNDU;
         ss = tobf(a, DEFAULTPREC);
         //ToBf(a, (BF *)&i);
         istoitv(ii,ss,(Itv *)&c);
   //      MKIntervalBigFloat((BF)ii,(BF)ss,c);
         mpfr_roundmode = current_roundmode;
       }
     }
   //  if ( c && OID( c ) == O_N && NID( c ) == N_IntervalBigFloat )
   //    addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
   //  else *rp = (Obj)c;
     *rp = (Obj)c;
 }  }
   
 static void  static void
 Pitvd(NODE arg, Obj *rp)  Pitvd(NODE arg, Obj *rp)
 {  {
         double  inf, sup;    double  inf, sup;
         Num     a, a0, a1, t;    Num  a, a0, a1, t;
         Itv     ia;    Itv  ia;
         IntervalDouble  d;    IntervalDouble  d;
   
         asir_assert(ARG0(arg),O_N,"intvald");    asir_assert(ARG0(arg),O_N,"intvald");
         a0 = (Num)ARG0(arg);    a0 = (Num)ARG0(arg);
         if ( argc(arg) > 1 ) {    if ( argc(arg) > 1 ) {
                 asir_assert(ARG1(arg),O_N,"intvald");      asir_assert(ARG1(arg),O_N,"intvald");
                 a1 = (Num)ARG1(arg);      a1 = (Num)ARG1(arg);
         } else {    } else {
                 if ( a0 && OID(a0)==O_N && NID(a0)==N_IntervalDouble ) {      if ( a0 && OID(a0)==O_N && NID(a0)==N_IntervalDouble ) {
                         inf = INF((IntervalDouble)a0);        inf = INF((IntervalDouble)a0);
                         sup = SUP((IntervalDouble)a0);        sup = SUP((IntervalDouble)a0);
                         MKIntervalDouble(inf,sup,d);        MKIntervalDouble(inf,sup,d);
                         *rp = (Obj)d;        *rp = (Obj)d;
                         return;        return;
                 }      }
                 a1 = (Num)ARG0(arg);      a1 = (Num)ARG0(arg);
         }    }
         if ( compnum(0,a0,a1) > 0 ) {    if ( compnum(0,a0,a1) > 0 ) {
                 t = a0; a0 = a1; a1 = t;      t = a0; a0 = a1; a1 = t;
         }    }
         inf = ToRealDown(a0);    inf = ToRealDown(a0);
         sup = ToRealUp(a1);    sup = ToRealUp(a1);
         MKIntervalDouble(inf,sup,d);    MKIntervalDouble(inf,sup,d);
         *rp = (Obj)d;    *rp = (Obj)d;
 }  }
   
 static void  static void
 Pinf(NODE arg, Obj *rp)  Pinf(NODE arg, Obj *rp)
 {  {
         Num     a, i, s;    Num  a, i, s;
         Real    r;    Real  r;
         double  d;    double  d;
   
         a = (Num)ARG0(arg);    a = (Num)ARG0(arg);
         if ( ! a ) {    if ( ! a ) {
                 *rp = 0;      *rp = 0;
         } else if  ( OID(a) == O_N ) {    } else if  ( OID(a) == O_N ) {
                 switch ( NID(a) ) {      switch ( NID(a) ) {
                         case N_IntervalDouble:        case N_IntervalDouble:
                                 d = INF((IntervalDouble)a);          d = INF((IntervalDouble)a);
                                 MKReal(d, r);          MKReal(d, r);
                                 *rp = (Obj)r;          *rp = (Obj)r;
                                 break;          break;
                         case N_IP:        case N_IP:
                         case N_IntervalBigFloat:        case N_IntervalBigFloat:
                         case N_IntervalQuad:        case N_IntervalQuad:
                                 itvtois((Itv)ARG0(arg),&i,&s);          itvtois((Itv)ARG0(arg),&i,&s);
                                 *rp = (Obj)i;          *rp = (Obj)i;
                                 break;          break;
                         default:        default:
                                 *rp = (Obj)a;          *rp = (Obj)a;
                                 break;          break;
                 }      }
         } else {    } else {
                 *rp = (Obj)a;      *rp = (Obj)a;
         }    }
 }  }
   
 static void  static void
 Psup(NODE arg, Obj *rp)  Psup(NODE arg, Obj *rp)
 {  {
         Num     a, i, s;    Num  a, i, s;
         Real    r;    Real  r;
         double  d;    double  d;
   
         a = (Num)ARG0(arg);    a = (Num)ARG0(arg);
         if ( ! a ) {    if ( ! a ) {
                 *rp = 0;      *rp = 0;
         } else if  ( OID(a) == O_N ) {    } else if  ( OID(a) == O_N ) {
                 switch ( NID(a) ) {      switch ( NID(a) ) {
                         case N_IntervalDouble:        case N_IntervalDouble:
                                 d = SUP((IntervalDouble)a);          d = SUP((IntervalDouble)a);
                                 MKReal(d, r);          MKReal(d, r);
                                 *rp = (Obj)r;          *rp = (Obj)r;
                                 break;          break;
                         case N_IP:        case N_IP:
                         case N_IntervalBigFloat:        case N_IntervalBigFloat:
                         case N_IntervalQuad:        case N_IntervalQuad:
                                 itvtois((Itv)ARG0(arg),&i,&s);          itvtois((Itv)ARG0(arg),&i,&s);
                                 *rp = (Obj)s;          *rp = (Obj)s;
                                 break;          break;
                         default:        default:
                                 *rp = (Obj)a;          *rp = (Obj)a;
                                 break;          break;
                 }      }
         } else {    } else {
                         *rp = (Obj)a;        *rp = (Obj)a;
         }    }
 }  }
   
 static void  static void
 Pmid(NODE arg, Obj *rp)  Pmid(NODE arg, Obj *rp)
 {  {
         Num     a, s;    Num  a, s;
         Real    r;    Real  r;
         double  d;    double  d;
   
         a = (Num)ARG0(arg);    a = (Num)ARG0(arg);
         if ( ! a ) {    if ( ! a ) {
                 *rp = 0;      *rp = 0;
         } else switch (OID(a)) {    } else switch (OID(a)) {
                 case O_N:      case O_N:
                         if ( NID(a) == N_IntervalDouble ) {        if ( NID(a) == N_IntervalDouble ) {
                                 d = ( INF((IntervalDouble)a)+SUP((IntervalDouble)a) ) / 2.0;          d = ( INF((IntervalDouble)a)+SUP((IntervalDouble)a) ) / 2.0;
                                 MKReal(d, r);          MKReal(d, r);
                                 *rp = (Obj)r;          *rp = (Obj)r;
                         } else if ( NID(a) == N_IntervalQuad ) {        } else if ( NID(a) == N_IntervalQuad ) {
                                 error("mid: not supported operation");          error("mid: not supported operation");
                                 *rp = 0;          *rp = 0;
                         } else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat ) {        } else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat ) {
                                 miditvp((Itv)ARG0(arg),&s);          miditvp((Itv)ARG0(arg),&s);
                                 *rp = (Obj)s;          *rp = (Obj)s;
                         } else {        } else {
                                 *rp = (Obj)a;          *rp = (Obj)a;
                         }        }
                         break;        break;
 #if 0  #if 0
                 case O_P:      case O_P:
                 case O_R:      case O_R:
                 case O_LIST:      case O_LIST:
                 case O_VECT:      case O_VECT:
                 case O_MAT:      case O_MAT:
 #endif  #endif
                 default:      default:
                         *rp = (Obj)a;        *rp = (Obj)a;
                         break;        break;
         }    }
 }  }
   
 static void  static void
 Pcup(NODE arg, Obj *rp)  Pcup(NODE arg, Obj *rp)
 {  {
         Itv     s;    Itv  s;
         Num     a, b;    Num  a, b;
   
         asir_assert(ARG0(arg),O_N,"cup");    asir_assert(ARG0(arg),O_N,"cup");
         asir_assert(ARG1(arg),O_N,"cup");    asir_assert(ARG1(arg),O_N,"cup");
         a = (Num)ARG0(arg);    a = (Num)ARG0(arg);
         b = (Num)ARG1(arg);    b = (Num)ARG1(arg);
         if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {    if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
                 cupitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);      cupitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);
         } else {    } else {
                 cupitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);      cupitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
                 *rp = (Obj)s;      *rp = (Obj)s;
         }    }
 }  }
   
 static void  static void
 Pcap(NODE arg, Obj *rp)  Pcap(NODE arg, Obj *rp)
 {  {
         Itv     s;    Itv  s;
         Num     a, b;    Num  a, b;
   
         asir_assert(ARG0(arg),O_N,"cap");    asir_assert(ARG0(arg),O_N,"cap");
         asir_assert(ARG1(arg),O_N,"cap");    asir_assert(ARG1(arg),O_N,"cap");
         a = (Num)ARG0(arg);    a = (Num)ARG0(arg);
         b = (Num)ARG1(arg);    b = (Num)ARG1(arg);
         if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {    if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
                 capitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);      capitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);
         } else {    } else {
                 capitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);      capitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
                 *rp = (Obj)s;      *rp = (Obj)s;
         }    }
 }  }
   
 static void  static void
Line 499  Pwidth(arg,rp)
Line 552  Pwidth(arg,rp)
 NODE arg;  NODE arg;
 Obj *rp;  Obj *rp;
 {  {
         Num     s;    Num  s;
         Num     a;    Num  a;
   
         asir_assert(ARG0(arg),O_N,"width");    asir_assert(ARG0(arg),O_N,"width");
         a = (Num)ARG0(arg);    a = (Num)ARG0(arg);
         if ( ! a ) {    if ( ! a ) {
                 *rp = 0;      *rp = 0;
         } else if ( NID(a) == N_IntervalDouble ) {    } else if ( NID(a) == N_IntervalDouble ) {
                 widthitvd((IntervalDouble)a, (Num *)rp);      widthitvd((IntervalDouble)a, (Num *)rp);
         } else {    } else {
                 widthitvp((Itv)ARG0(arg),&s);      widthitvp((Itv)ARG0(arg),&s);
                 *rp = (Obj)s;      *rp = (Obj)s;
         }    }
 }  }
   
 static void  static void
Line 519  Pabsitv(arg,rp)
Line 572  Pabsitv(arg,rp)
 NODE arg;  NODE arg;
 Obj *rp;  Obj *rp;
 {  {
         Num     s;    Num  s;
         Num     a, b;    Num  a, b;
   
         asir_assert(ARG0(arg),O_N,"absitv");    asir_assert(ARG0(arg),O_N,"absitv");
         a = (Num)ARG0(arg);    a = (Num)ARG0(arg);
         if ( ! a ) {    if ( ! a ) {
                 *rp = 0;      *rp = 0;
         } else if ( NID(a) == N_IntervalDouble ) {    } else if ( NID(a) == N_IntervalDouble ) {
                 absitvd((IntervalDouble)a, (Num *)rp);      absitvd((IntervalDouble)a, (Num *)rp);
         } else {    } else {
                 absitvp((Itv)ARG0(arg),&s);      absitvp((Itv)ARG0(arg),&s);
                 *rp = (Obj)s;      *rp = (Obj)s;
         }    }
 }  }
   
 static void  static void
Line 539  Pdistance(arg,rp)
Line 592  Pdistance(arg,rp)
 NODE arg;  NODE arg;
 Obj *rp;  Obj *rp;
 {  {
         Num     s;    Num  s;
         Num     a, b;    Num  a, b;
   
         asir_assert(ARG0(arg),O_N,"distance");    asir_assert(ARG0(arg),O_N,"distance");
         asir_assert(ARG1(arg),O_N,"distance");    asir_assert(ARG1(arg),O_N,"distance");
         a = (Num)ARG0(arg);    a = (Num)ARG0(arg);
         b = (Num)ARG1(arg);    b = (Num)ARG1(arg);
         if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {    if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
                 distanceitvd((IntervalDouble)a, (IntervalDouble)b, (Num *)rp);      distanceitvd((IntervalDouble)a, (IntervalDouble)b, (Num *)rp);
         } else {    } else {
                 distanceitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);      distanceitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
                 *rp = (Obj)s;      *rp = (Obj)s;
         }    }
 }  }
   
 static void  static void
Line 559  Pinitv(arg,rp)
Line 612  Pinitv(arg,rp)
 NODE arg;  NODE arg;
 Obj *rp;  Obj *rp;
 {  {
         int     s;    int  s;
         Q       q;    Q  q;
   
         asir_assert(ARG0(arg),O_N,"intval");    asir_assert(ARG0(arg),O_N,"intval");
         asir_assert(ARG1(arg),O_N,"intval");    asir_assert(ARG1(arg),O_N,"intval");
         if ( ! ARG1(arg) ) {    if ( ! ARG1(arg) ) {
                 if ( ! ARG0(arg) ) s = 1;      if ( ! ARG0(arg) ) s = 1;
                 else s = 0;      else s = 0;
         }    }
         else if ( NID(ARG1(arg)) == N_IntervalDouble ) {    else if ( NID(ARG1(arg)) == N_IntervalDouble ) {
                 s = initvd((Num)ARG0(arg),(IntervalDouble)ARG1(arg));      s = initvd((Num)ARG0(arg),(IntervalDouble)ARG1(arg));
   
         } else if ( NID(ARG1(arg)) == N_IP || NID(ARG1(arg)) == N_IntervalBigFloat ) {    } else if ( NID(ARG1(arg)) == N_IP || NID(ARG1(arg)) == N_IntervalBigFloat ) {
                 if ( ! ARG0(arg) ) s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));      if ( ! ARG0(arg) ) s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));
                 else if ( NID(ARG0(arg)) == N_IP ) {      else if ( NID(ARG0(arg)) == N_IP ) {
                         s = itvinitvp((Itv)ARG0(arg),(Itv)ARG1(arg));        s = itvinitvp((Itv)ARG0(arg),(Itv)ARG1(arg));
                 } else {      } else {
                         s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));        s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));
                 }      }
         } else {    } else {
                 s = ! compnum(0,(Num)ARG0(arg),(Num)ARG1(arg));      s = ! compnum(0,(Num)ARG0(arg),(Num)ARG1(arg));
         }    }
         STOQ(s,q);    STOQ(s,q);
         *rp = (Obj)q;    *rp = (Obj)q;
 }  }
   
 static void  static void
Line 590  Pdisjitv(arg,rp)
Line 643  Pdisjitv(arg,rp)
 NODE arg;  NODE arg;
 Obj *rp;  Obj *rp;
 {  {
         Itv     s;    Itv  s;
   
         asir_assert(ARG0(arg),O_N,"disjitv");    asir_assert(ARG0(arg),O_N,"disjitv");
         asir_assert(ARG1(arg),O_N,"disjitv");    asir_assert(ARG1(arg),O_N,"disjitv");
         error("disjitv: not implemented yet");    error("disjitv: not implemented yet");
         if ( ! s ) *rp = 0;    if ( ! s ) *rp = 0;
         else *rp = (Obj)ONE;    else *rp = (Obj)ONE;
 }  }
   
   static void
   PzeroRewriteMode(NODE arg, Obj *rp)
   {
     Q  a, r;
   
     STOQ(zerorewrite,r);
     *rp = (Obj)r;
   
     if (arg) {
       a = (Q)ARG0(arg);
       if(!a) {
         zerorewrite = 0;
       } else if ( (NUM(a)&&INT(a)) ){
         zerorewrite = 1;
       }
     }
   }
   
   static void
   PzeroRewriteCountClear(NODE arg, Obj *rp)
   {
     Q  a, r;
   
     STOQ(zerorewriteCount,r);
     *rp = (Obj)r;
   
     if (arg) {
       a = (Q)ARG0(arg);
       if(a &&(NUM(a)&&INT(a))){
         zerorewriteCount = 0;
       }
     }
   }
   
   static void
   PzeroRewriteCount(NODE arg, Obj *rp)
   {
     Q  r;
   
     STOQ(zerorewriteCount,r);
     *rp = (Obj)r;
   }
   
   
 #endif  #endif
 extern int      printmode;  extern int  printmode;
   
 static void     pprintmode( void )  static void  pprintmode( void )
 {  {
         switch (printmode) {    switch (printmode) {
 #if defined(INTERVAL)  #if defined(INTERVAL)
                 case MID_PRINTF_E:      case MID_PRINTF_E:
                         fprintf(stderr,"Interval printing mode is a mitpoint type.\n");        fprintf(stderr,"Interval printing mode is a mitpoint type.\n");
 #endif  #endif
                 case PRINTF_E:      case PRINTF_E:
                         fprintf(stderr,"Printf's double printing mode is \"%%.16e\".\n");        fprintf(stderr,"Printf's double printing mode is \"%%.16e\".\n");
                         break;        break;
 #if defined(INTERVAL)  #if defined(INTERVAL)
                 case MID_PRINTF_G:      case MID_PRINTF_G:
                         fprintf(stderr,"Interval printing mode is a mitpoint type.\n");        fprintf(stderr,"Interval printing mode is a mitpoint type.\n");
 #endif  #endif
                 default:      default:
                 case PRINTF_G:      case PRINTF_G:
                         fprintf(stderr,"Printf's double printing mode is \"%%g\".\n");        fprintf(stderr,"Printf's double printing mode is \"%%g\".\n");
                         break;        break;
         }    }
 }  }
   
 static void  static void
 Pprintmode(NODE arg, Obj *rp)  Pprintmode(NODE arg, Obj *rp)
 {  {
         int     l;    int  l;
         Q       a, r;    Q  a, r;
   
         a = (Q)ARG0(arg);    a = (Q)ARG0(arg);
         if ( !a || NUM(a) && INT(a) ) {    if(!a||(NUM(a)&&INT(a))){
                 l = QTOS(a);      l=QTOS(a);
                 if ( l < 0 ) l = 0;      if ( l < 0 ) l = 0;
 #if defined(INTERVAL)  #if defined(INTERVAL)
                 else if ( l > MID_PRINTF_E ) l = 0;      else if ( l > MID_PRINTF_E ) l = 0;
 #else  #else
                 else if ( l > PRINTF_E ) l = 0;      else if ( l > PRINTF_E ) l = 0;
 #endif  #endif
                 STOQ(printmode,r);      STOQ(printmode,r);
                 *rp = (Obj)r;      *rp = (Obj)r;
                 printmode = l;      printmode = l;
                 pprintmode();      pprintmode();
         } else {    } else {
                 *rp = 0;      *rp = 0;
         }    }
 }  }
   
   
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.12
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>