[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.9

version 1.1, 2000/12/22 09:58:32 version 1.9, 2015/08/14 13:51:54
Line 1 
Line 1 
 /*  /*
  * $OpenXM: $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/itvnum.c,v 1.8 2015/08/08 14:19:41 fujimoto Exp $
  */   */
   
 #include "ca.h"  #include "ca.h"
 #include "parse.h"  #include "parse.h"
 #include "version.h"  #include "version.h"
   #include "../plot/ifplot.h"
   
 #if defined(INTERVAL)  #if defined(INTERVAL)
   
Line 21  static void Pcup(NODE, Obj *);
Line 22  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(Q *);
   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 *);
   
   /* plot time check func */
   static void ccalc(double **, struct canvas *, int);
   static void Pifcheck(NODE, Obj *);
   
 #if     defined(__osf__) && 0  #if     defined(__osf__) && 0
 int     end;  int     end;
 #endif  #endif
Line 50  struct ftab interval_tab[] = {
Line 60  struct ftab interval_tab[] = {
         {"diam",Pwidth,1},          {"diam",Pwidth,1},
         {"distance",Pdistance,2},          {"distance",Pdistance,2},
         {"iversion",Pitvversion,0},          {"iversion",Pitvversion,0},
   /* plot time check */
           {"ifcheck",Pifcheck,-7},
 #endif  #endif
         {0,0,0},          {0,0,0},
 };  };
   
 #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;
 }  }
   
   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
   Pitvversion(Q *rp)
   {
           STOQ(ASIR_VERSION, *rp);
   }
   
 extern int      bigfloat;  extern int      bigfloat;
   
 static void  static void
Line 86  Pitv(NODE arg, Obj *rp)
Line 263  Pitv(NODE arg, Obj *rp)
                         *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 )
                   addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
         else *rp = (Obj)c;          else *rp = (Obj)c;
 #endif  #endif
 }  }
Line 132  Pitvbf(NODE arg, Obj *rp)
Line 310  Pitvbf(NODE arg, Obj *rp)
                         ToBf(s, &ss);                          ToBf(s, &ss);
                         istoitv((Num)ii,(Num)ss,&c);                          istoitv((Num)ii,(Num)ss,&c);
                 }                  }
                 else if ( NID(a) == N_IF) {                  else if ( 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);
Line 148  Pitvbf(NODE arg, Obj *rp)
Line 326  Pitvbf(NODE arg, Obj *rp)
                         istoitv(i,i,&c);                          istoitv(i,i,&c);
                 }                  }
         }          }
         if ( c && OID( c ) == O_N && NID( c ) == N_IF ) addulp((ItvF)c, (ItvF *)rp);          if ( c && OID( c ) == O_N && NID( c ) == N_IntervalBigFloat )
                   addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
         else *rp = (Obj)c;          else *rp = (Obj)c;
 }  }
   
Line 158  Pitvd(NODE arg, Obj *rp)
Line 337  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);
Line 166  Pitvd(NODE arg, Obj *rp)
Line 345  Pitvd(NODE arg, Obj *rp)
                 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;
                 }                  }
Line 180  Pitvd(NODE arg, Obj *rp)
Line 359  Pitvd(NODE arg, Obj *rp)
         }          }
         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;
 }  }
   
Line 196  Pinf(NODE arg, Obj *rp)
Line 375  Pinf(NODE arg, Obj *rp)
                 *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;
                 }                  }
Line 228  Psup(NODE arg, Obj *rp)
Line 407  Psup(NODE arg, Obj *rp)
                 *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;
                 }                  }
Line 260  Pmid(NODE arg, Obj *rp)
Line 439  Pmid(NODE arg, Obj *rp)
                 *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 {
Line 281  Pmid(NODE arg, Obj *rp)
Line 460  Pmid(NODE arg, Obj *rp)
                 case O_VECT:                  case O_VECT:
                 case O_MAT:                  case O_MAT:
 #endif  #endif
                 defaults:                  default:
                         *rp = (Obj)a;                          *rp = (Obj)a;
                         break;                          break;
         }          }
Line 297  Pcup(NODE arg, Obj *rp)
Line 476  Pcup(NODE arg, Obj *rp)
         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;
Line 315  Pcap(NODE arg, Obj *rp)
Line 494  Pcap(NODE arg, Obj *rp)
         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;
Line 335  Obj *rp;
Line 514  Obj *rp;
         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;
Line 355  Obj *rp;
Line 534  Obj *rp;
         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;
Line 375  Obj *rp;
Line 554  Obj *rp;
         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;
Line 397  Obj *rp;
Line 576  Obj *rp;
                 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));
Line 459  Pprintmode(NODE arg, Obj *rp)
Line 638  Pprintmode(NODE arg, Obj *rp)
         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;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.9
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>