[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.1 and 1.12

version 1.1, 2000/12/22 09:58:32 version 1.12, 2019/06/04 07:11:22
Line 1 
Line 1 
 /*  /*
  * $OpenXM: $   * $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"
   #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 21  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(Obj *);  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 *);
   
 #if     defined(__osf__) && 0  /* plot time check func */
 int     end;  static void ccalc(double **, struct canvas *, int);
   static void Pifcheck(NODE, Obj *);
   
   #if  defined(__osf__) && 0
   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 */
     {"ifcheck",Pifcheck,-7},
 #endif  #endif
         {0,0,0},    {0,0,0},
 };  };
   
   extern int mpfr_roundmode;
   
 #if defined(INTERVAL)  #if defined(INTERVAL)
   
   /* plot time check */
 static void  static void
 Pitvversion(Obj *rp)  Pifcheck(NODE arg, Obj *rp)
 {  {
         STOQ(ASIR_VERSION,(Q)*rp);    Q m2,p2,s_id;
     NODE defrange;
     LIST xrange,yrange,range[2],list,geom;
     VL vl,vl0;
     V v[2],av[2];
     int ri,i,j,sign;
     P poly;
     P var;
     NODE n,n0;
     Obj t;
   
     struct canvas *can;
     MAT m;
     pointer **mb;
     double **tabe, *px, *px1, *px2;
     Q one;
     int width, height, ix, iy;
     int id;
   
     STOQ(-2,m2); STOQ(2,p2);
     STOQ(1,one);
     MKNODE(n,p2,0); MKNODE(defrange,m2,n);
     poly = 0; vl = 0; geom = 0; ri = 0;
     v[0] = v[1] = 0;
     for ( ; arg; arg = NEXT(arg) ){
       switch ( OID(BDY(arg)) ) {
       case O_P:
         poly = (P)BDY(arg);
         get_vars_recursive((Obj)poly,&vl);
         for(vl0=vl,i=0;vl0;vl0=NEXT(vl0)){
           if(vl0->v->attr==(pointer)V_IND){
             if(i>=2){
               error("ifplot : invalid argument");
             } else {
               v[i++]=vl0->v;
             }
           }
         }
         break;
       case O_LIST:
         list = (LIST)BDY(arg);
         if ( OID(BDY(BDY(list))) == O_P )
           if ( ri > 1 )
             error("ifplot : invalid argument");
           else
             range[ri++] = list;
         else
           geom = list;
         break;
       default:
         error("ifplot : invalid argument"); break;
       }
     }
     if ( !poly ) error("ifplot : invalid argument");
     switch ( ri ) {
       case 0:
         if ( !v[1] ) error("ifplot : please specify all variables");
         MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);
         MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);
         break;
       case 1:
         if ( !v[1] ) error("ifplot : please specify all variables");
         av[0] = VR((P)BDY(BDY(range[0])));
         if ( v[0] == av[0] ) {
           xrange = range[0];
           MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);
         } else if ( v[1] == av[0] ) {
           MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);
           yrange = range[0];
         } else
           error("ifplot : invalid argument");
         break;
       case 2:
         av[0] = VR((P)BDY(BDY(range[0])));
         av[1] = VR((P)BDY(BDY(range[1])));
         if ( ((v[0] == av[0]) && (!v[1] || v[1] == av[1])) ||
            ((v[0] == av[1]) && (!v[1] || v[1] == av[0])) ) {
             xrange = range[0]; yrange = range[1];
         } else error("ifplot : invalid argument");
         break;
       default:
         error("ifplot : cannot happen"); break;
     }
     can = canvas[id = search_canvas()];
     if ( !geom ) {
       width = 300;
       height = 300;
       can->width = 300;
       can->height = 300;
     } else {
       can->width = QTOS((Q)BDY(BDY(geom)));
       can->height = QTOS((Q)BDY(NEXT(BDY(geom))));
       width = can->width;
       height = can->height;
     }
     if ( xrange ) {
       n = BDY(xrange); can->vx = VR((P)BDY(n)); n = NEXT(n);
       can->qxmin = (Q)BDY(n); n = NEXT(n); can->qxmax = (Q)BDY(n);
       can->xmin = ToReal(can->qxmin); can->xmax = ToReal(can->qxmax);
     }
     if ( yrange ) {
       n = BDY(yrange); can->vy = VR((P)BDY(n)); n = NEXT(n);
       can->qymin = (Q)BDY(n); n = NEXT(n); can->qymax = (Q)BDY(n);
       can->ymin = ToReal(can->qymin); can->ymax = ToReal(can->qymax);
     }
     can->wname = "ifcheck";
     can->formula = poly;
     tabe = (double **)ALLOCA((width+1)*sizeof(double *));
     for ( i = 0; i <= width; i++ )
       tabe[i] = (double *)ALLOCA((height+1)*sizeof(double));
     for(i=0;i<=width;i++)for(j=0;j<=height;j++)tabe[i][j]=0;
     ccalc(tabe,can,0);
     MKMAT(m,width,height);
     mb = BDY(m);
     for( ix=0; ix<width; ix++ ){
       for( iy=0; iy<height; iy++){
         if ( tabe[ix][iy] >= 0 ){
           if ( (tabe[ix+1][iy] <= 0) ||
             (tabe[ix][iy+1] <= 0 ) ||
             (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;
 }  }
   
 extern int      bigfloat;  void ccalc(double **tab,struct canvas *can,int nox)
   {
      double x,y,xmin,ymin,xstep,ystep;
      int ix,iy;
      Real r,rx,ry;
      Obj fr,g;
      int w,h;
      V vx,vy;
      Obj t,s;
   
      MKReal(1.0,r); mulr(CO,(Obj)can->formula,(Obj)r,&fr);
      vx = can->vx;
      vy = can->vy;
      w = can->width; h = can->height;
      xmin = can->xmin; xstep = (can->xmax-can->xmin)/w;
      ymin = can->ymin; ystep = (can->ymax-can->ymin)/h;
      MKReal(1.0,rx); MKReal(1.0,ry);
      for( ix = 0, x = xmin; ix < w+1 ; ix++, x += xstep ) {
         BDY(rx) = x; substr(CO,0,fr,vx,x?(Obj)rx:0,&t);
         devalr(CO,t,&g);
         for( iy = 0, y = ymin; iy < h+1 ; iy++, y += ystep ) {
            BDY(ry) = y;
            substr(CO,0,g,vy,y?(Obj)ry:0,&t);
            devalr(CO,t,&s);
            tab[ix][iy] = ToReal(s);
         }
      }
   }
   /* end plot time check */
   
 static void  static void
   Pitvversion(NODE arg, Q *rp)
   {
     STOQ(INT_ASIR_VERSION, *rp);
   }
   
   extern int  bigfloat;
   
   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_IF) {      else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat) {
                         *rp = (Obj)a;        *rp = (Obj)a;
                         return;        return;
                 }      }
                 else if ( NID(a) == N_ID ) {      else if ( NID(a) == N_IntervalDouble ) {
                         inf = INF((ItvD)a);        inf = INF((IntervalDouble)a);
                         sup = SUP((ItvD)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_IF ) addulp((ItvF)c, (ItvF *)rp);    if ( NID( c ) == N_IntervalBigFloat )
         else *rp = (Obj)c;      addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
     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_IF) {      }
                         *rp = (Obj)a;      else if ( NID(a) == N_IP ) {
                         return;        itvtois((Itv)a, &i, &s);
                 }        current_roundmode = mpfr_roundmode;
                 else if ( NID(a) == N_ID ) {        mpfr_roundmode = MPFR_RNDD;
                         inf = INF((ItvD)a);        ii = tobf(i, DEFAULTPREC);
                         sup = SUP((ItvD)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_IF ) addulp((ItvF)c, (ItvF *)rp);      else if ( NID(a) == N_IntervalDouble ) {
         else *rp = (Obj)c;        inf = INF((IntervalDouble)a);
         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;
         ItvD    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_ID ) {      if ( a0 && OID(a0)==O_N && NID(a0)==N_IntervalDouble ) {
                         inf = INF((ItvD)a0);        inf = INF((IntervalDouble)a0);
                         sup = SUP((ItvD)a0);        sup = SUP((IntervalDouble)a0);
                         MKItvD(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);
         MKItvD(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_ID:        case N_IntervalDouble:
                                 d = INF((ItvD)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_IF:        case N_IntervalBigFloat:
                         case N_IT:        case N_IntervalQuad:
                                 itvtois((Itv)ARG0(arg),&i,&s);          itvtois((Itv)ARG0(arg),&i,&s);
                                 *rp = (Obj)i;          *rp = (Obj)i;
                                 break;          break;
                         defaults:        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_ID:        case N_IntervalDouble:
                                 d = SUP((ItvD)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_IF:        case N_IntervalBigFloat:
                         case N_IT:        case N_IntervalQuad:
                                 itvtois((Itv)ARG0(arg),&i,&s);          itvtois((Itv)ARG0(arg),&i,&s);
                                 *rp = (Obj)s;          *rp = (Obj)s;
                                 break;          break;
                         defaults:        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_ID ) {        if ( NID(a) == N_IntervalDouble ) {
                                 d = ( INF((ItvD)a)+SUP((ItvD)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_IT ) {        } 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_IF ) {        } 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
                 defaults:      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_ID && b && NID(b) == N_ID ) {    if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
                 cupitvd((ItvD)a, (ItvD)b, (ItvD *)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_ID && b && NID(b) == N_ID ) {    if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
                 capitvd((ItvD)a, (ItvD)b, (ItvD *)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 328  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_ID ) {    } else if ( NID(a) == N_IntervalDouble ) {
                 widthitvd((ItvD)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 348  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_ID ) {    } else if ( NID(a) == N_IntervalDouble ) {
                 absitvd((ItvD)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 368  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_ID && b && NID(b) == N_ID ) {    if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
                 distanceitvd((ItvD)a, (ItvD)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 388  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_ID ) {    else if ( NID(ARG1(arg)) == N_IntervalDouble ) {
                 s = initvd((Num)ARG0(arg),(ItvD)ARG1(arg));      s = initvd((Num)ARG0(arg),(IntervalDouble)ARG1(arg));
   
         } else if ( NID(ARG1(arg)) == N_IP || NID(ARG1(arg)) == N_IF ) {    } 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 419  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.1  
changed lines
  Added in v.1.12
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>