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

Annotation of OpenXM_contrib2/asir2000/builtin/itvnum.c, Revision 1.12

1.1       saito       1: /*
1.12    ! kondoh      2:  * $OpenXM: OpenXM_contrib2/asir2000/builtin/itvnum.c,v 1.11 2018/03/29 01:32:50 noro Exp $
1.1       saito       3:  */
                      4:
                      5: #include "ca.h"
                      6: #include "parse.h"
                      7: #include "version.h"
1.10      ohara       8: #if !defined(ANDROID)
1.6       saito       9: #include "../plot/ifplot.h"
1.10      ohara      10: #endif
1.1       saito      11:
1.12    ! kondoh     12: // in engine/bf.c
        !            13: Num tobf(Num,int);
        !            14:
1.1       saito      15: #if defined(INTERVAL)
                     16: static void Pitv(NODE, Obj *);
                     17: static void Pitvd(NODE, Obj *);
                     18: static void Pitvbf(NODE, Obj *);
                     19: static void Pinf(NODE, Obj *);
                     20: static void Psup(NODE, Obj *);
                     21: static void Pmid(NODE, Obj *);
                     22: static void Pabsitv(NODE, Obj *);
                     23: static void Pdisjitv(NODE, Obj *);
                     24: static void Pinitv(NODE, Obj *);
                     25: static void Pcup(NODE, Obj *);
                     26: static void Pcap(NODE, Obj *);
                     27: static void Pwidth(NODE, Obj *);
                     28: static void Pdistance(NODE, Obj *);
1.12    ! kondoh     29: static void Pitvversion(NODE, Q *);
        !            30: static void PzeroRewriteMode(NODE, Obj *);
        !            31: static void PzeroRewriteCountClear(NODE, Obj *);
        !            32: static void PzeroRewriteCount(NODE, Obj *);
        !            33: //void miditvp(Itv,Num *);
        !            34: //void absitvp(Itv,Num *);
        !            35: //int initvd(Num,IntervalDouble);
        !            36: //int initvp(Num,Itv);
        !            37: //int itvinitvp(Itv,Itv);
1.1       saito      38: #endif
                     39: static void Pprintmode(NODE, Obj *);
                     40:
1.6       saito      41: /* plot time check func */
                     42: static void ccalc(double **, struct canvas *, int);
                     43: static void Pifcheck(NODE, Obj *);
                     44:
1.11      noro       45: #if  defined(__osf__) && 0
                     46: int  end;
1.1       saito      47: #endif
                     48:
                     49: struct ftab interval_tab[] = {
1.11      noro       50:   {"printmode",Pprintmode,1},
1.1       saito      51: #if defined(INTERVAL)
1.11      noro       52:   {"itvd",Pitvd,-2},
                     53:   {"intvald",Pitvd,-2},
                     54:   {"itv",Pitv,-2},
                     55:   {"intval",Pitv,-2},
                     56:   {"itvbf",Pitvbf,-2},
                     57:   {"intvalbf",Pitvbf,-2},
                     58:   {"inf",Pinf,1},
                     59:   {"sup",Psup,1},
                     60:   {"absintval",Pabsitv,1},
                     61:   {"disintval",Pdisjitv,2},
                     62:   {"inintval",Pinitv,2},
                     63:   {"cup",Pcup,2},
                     64:   {"cap",Pcap,2},
                     65:   {"mid",Pmid,1},
                     66:   {"width",Pwidth,1},
                     67:   {"diam",Pwidth,1},
                     68:   {"distance",Pdistance,2},
1.12    ! kondoh     69:   {"iversion",Pitvversion,-1},
        !            70:   {"intvalversion",Pitvversion,-1},
        !            71:   {"zerorewritemode",PzeroRewriteMode,-1},
        !            72:   {"zeroRewriteMode",PzeroRewriteMode,-1},
        !            73:   {"zeroRewriteCountClear",PzeroRewriteCountClear,-1},
        !            74:   {"zeroRewriteCount",PzeroRewriteCount,-1},
1.6       saito      75: /* plot time check */
1.11      noro       76:   {"ifcheck",Pifcheck,-7},
1.1       saito      77: #endif
1.11      noro       78:   {0,0,0},
1.1       saito      79: };
                     80:
1.12    ! kondoh     81: extern int mpfr_roundmode;
        !            82:
1.1       saito      83: #if defined(INTERVAL)
1.6       saito      84:
                     85: /* plot time check */
                     86: static void
                     87: Pifcheck(NODE arg, Obj *rp)
                     88: {
1.11      noro       89:   Q m2,p2,s_id;
                     90:   NODE defrange;
                     91:   LIST xrange,yrange,range[2],list,geom;
                     92:   VL vl,vl0;
                     93:   V v[2],av[2];
                     94:   int ri,i,j,sign;
                     95:   P poly;
                     96:   P var;
                     97:   NODE n,n0;
                     98:   Obj t;
                     99:
                    100:   struct canvas *can;
                    101:   MAT m;
                    102:   pointer **mb;
                    103:   double **tabe, *px, *px1, *px2;
                    104:   Q one;
                    105:   int width, height, ix, iy;
                    106:   int id;
                    107:
                    108:   STOQ(-2,m2); STOQ(2,p2);
                    109:   STOQ(1,one);
                    110:   MKNODE(n,p2,0); MKNODE(defrange,m2,n);
                    111:   poly = 0; vl = 0; geom = 0; ri = 0;
                    112:   v[0] = v[1] = 0;
                    113:   for ( ; arg; arg = NEXT(arg) ){
                    114:     switch ( OID(BDY(arg)) ) {
                    115:     case O_P:
                    116:       poly = (P)BDY(arg);
                    117:       get_vars_recursive((Obj)poly,&vl);
                    118:       for(vl0=vl,i=0;vl0;vl0=NEXT(vl0)){
                    119:         if(vl0->v->attr==(pointer)V_IND){
                    120:           if(i>=2){
                    121:             error("ifplot : invalid argument");
                    122:           } else {
                    123:             v[i++]=vl0->v;
                    124:           }
                    125:         }
                    126:       }
                    127:       break;
                    128:     case O_LIST:
                    129:       list = (LIST)BDY(arg);
                    130:       if ( OID(BDY(BDY(list))) == O_P )
                    131:         if ( ri > 1 )
                    132:           error("ifplot : invalid argument");
                    133:         else
                    134:           range[ri++] = list;
                    135:       else
                    136:         geom = list;
                    137:       break;
                    138:     default:
                    139:       error("ifplot : invalid argument"); break;
                    140:     }
                    141:   }
                    142:   if ( !poly ) error("ifplot : invalid argument");
                    143:   switch ( ri ) {
                    144:     case 0:
                    145:       if ( !v[1] ) error("ifplot : please specify all variables");
                    146:       MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);
                    147:       MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);
                    148:       break;
                    149:     case 1:
                    150:       if ( !v[1] ) error("ifplot : please specify all variables");
                    151:       av[0] = VR((P)BDY(BDY(range[0])));
                    152:       if ( v[0] == av[0] ) {
                    153:         xrange = range[0];
                    154:         MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);
                    155:       } else if ( v[1] == av[0] ) {
                    156:         MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);
                    157:         yrange = range[0];
                    158:       } else
                    159:         error("ifplot : invalid argument");
                    160:       break;
                    161:     case 2:
                    162:       av[0] = VR((P)BDY(BDY(range[0])));
                    163:       av[1] = VR((P)BDY(BDY(range[1])));
                    164:       if ( ((v[0] == av[0]) && (!v[1] || v[1] == av[1])) ||
                    165:          ((v[0] == av[1]) && (!v[1] || v[1] == av[0])) ) {
                    166:           xrange = range[0]; yrange = range[1];
                    167:       } else error("ifplot : invalid argument");
                    168:       break;
                    169:     default:
                    170:       error("ifplot : cannot happen"); break;
                    171:   }
                    172:   can = canvas[id = search_canvas()];
                    173:   if ( !geom ) {
                    174:     width = 300;
                    175:     height = 300;
                    176:     can->width = 300;
                    177:     can->height = 300;
                    178:   } else {
                    179:     can->width = QTOS((Q)BDY(BDY(geom)));
                    180:     can->height = QTOS((Q)BDY(NEXT(BDY(geom))));
                    181:     width = can->width;
                    182:     height = can->height;
                    183:   }
                    184:   if ( xrange ) {
                    185:     n = BDY(xrange); can->vx = VR((P)BDY(n)); n = NEXT(n);
                    186:     can->qxmin = (Q)BDY(n); n = NEXT(n); can->qxmax = (Q)BDY(n);
                    187:     can->xmin = ToReal(can->qxmin); can->xmax = ToReal(can->qxmax);
                    188:   }
                    189:   if ( yrange ) {
                    190:     n = BDY(yrange); can->vy = VR((P)BDY(n)); n = NEXT(n);
                    191:     can->qymin = (Q)BDY(n); n = NEXT(n); can->qymax = (Q)BDY(n);
                    192:     can->ymin = ToReal(can->qymin); can->ymax = ToReal(can->qymax);
                    193:   }
                    194:   can->wname = "ifcheck";
                    195:   can->formula = poly;
                    196:   tabe = (double **)ALLOCA((width+1)*sizeof(double *));
                    197:   for ( i = 0; i <= width; i++ )
                    198:     tabe[i] = (double *)ALLOCA((height+1)*sizeof(double));
                    199:   for(i=0;i<=width;i++)for(j=0;j<=height;j++)tabe[i][j]=0;
                    200:   ccalc(tabe,can,0);
                    201:   MKMAT(m,width,height);
                    202:   mb = BDY(m);
                    203:   for( ix=0; ix<width; ix++ ){
                    204:     for( iy=0; iy<height; iy++){
                    205:       if ( tabe[ix][iy] >= 0 ){
                    206:         if ( (tabe[ix+1][iy] <= 0) ||
                    207:           (tabe[ix][iy+1] <= 0 ) ||
                    208:           (tabe[ix+1][iy+1] <= 0 ) ) mb[ix][iy] = (Obj)one;
                    209:       } else {
                    210:         if ( (tabe[ix+1][iy] >= 0 ) ||
                    211:           ( tabe[ix][iy+1] >= 0 ) ||
                    212:           ( tabe[ix+1][iy+1] >= 0 )) mb[ix][iy] = (Obj)one;
                    213:       }
                    214:     }
                    215:   }
                    216:   *rp = (Obj)m;
1.6       saito     217: }
                    218:
                    219: void ccalc(double **tab,struct canvas *can,int nox)
                    220: {
1.11      noro      221:    double x,y,xmin,ymin,xstep,ystep;
                    222:    int ix,iy;
                    223:    Real r,rx,ry;
                    224:    Obj fr,g;
                    225:    int w,h;
                    226:    V vx,vy;
                    227:    Obj t,s;
                    228:
                    229:    MKReal(1.0,r); mulr(CO,(Obj)can->formula,(Obj)r,&fr);
                    230:    vx = can->vx;
                    231:    vy = can->vy;
                    232:    w = can->width; h = can->height;
                    233:    xmin = can->xmin; xstep = (can->xmax-can->xmin)/w;
                    234:    ymin = can->ymin; ystep = (can->ymax-can->ymin)/h;
                    235:    MKReal(1.0,rx); MKReal(1.0,ry);
                    236:    for( ix = 0, x = xmin; ix < w+1 ; ix++, x += xstep ) {
                    237:       BDY(rx) = x; substr(CO,0,fr,vx,x?(Obj)rx:0,&t);
                    238:       devalr(CO,t,&g);
                    239:       for( iy = 0, y = ymin; iy < h+1 ; iy++, y += ystep ) {
                    240:          BDY(ry) = y;
                    241:          substr(CO,0,g,vy,y?(Obj)ry:0,&t);
                    242:          devalr(CO,t,&s);
                    243:          tab[ix][iy] = ToReal(s);
                    244:       }
                    245:    }
1.6       saito     246: }
                    247: /* end plot time check */
                    248:
1.1       saito     249: static void
1.12    ! kondoh    250: Pitvversion(NODE arg, Q *rp)
1.1       saito     251: {
1.12    ! kondoh    252:   STOQ(INT_ASIR_VERSION, *rp);
1.1       saito     253: }
                    254:
1.11      noro      255: extern int  bigfloat;
1.1       saito     256:
                    257: static void
                    258: Pitv(NODE arg, Obj *rp)
                    259: {
1.11      noro      260:   Num  a, i, s;
                    261:   Itv  c;
                    262:   double  inf, sup;
1.1       saito     263:
                    264: #if 1
1.11      noro      265:   if ( bigfloat )
                    266:     Pitvbf(arg, rp);
                    267:   else
                    268:     Pitvd(arg,rp);
1.1       saito     269: #else
1.11      noro      270:   asir_assert(ARG0(arg),O_N,"itv");
                    271:   if ( argc(arg) > 1 ) {
                    272:     asir_assert(ARG1(arg),O_N,"itv");
                    273:     istoitv((Num)ARG0(arg),(Num)ARG1(arg),&c);
                    274:   } else {
                    275:     a = (Num)ARG0(arg);
                    276:     if ( ! a ) {
                    277:       *rp = 0;
                    278:       return;
                    279:     }
                    280:     else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat) {
                    281:       *rp = (Obj)a;
                    282:       return;
                    283:     }
                    284:     else if ( NID(a) == N_IntervalDouble ) {
                    285:       inf = INF((IntervalDouble)a);
                    286:       sup = SUP((IntervalDouble)a);
                    287:       double2bf(inf, (BF *)&i);
                    288:       double2bf(sup, (BF *)&s);
                    289:       istoitv(i,s,&c);
                    290:     }
                    291:     else istoitv(a,a,&c);
                    292:   }
                    293:   if ( NID( c ) == N_IntervalBigFloat )
                    294:     addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
                    295:   else *rp = (Obj)c;
1.1       saito     296: #endif
                    297: }
                    298:
                    299: static void
                    300: Pitvbf(NODE arg, Obj *rp)
                    301: {
1.11      noro      302:   Num  a, i, s;
1.12    ! kondoh    303:   IntervalBigFloat  c;
        !           304:   Num  ii,ss;
        !           305:   Real di, ds;
1.11      noro      306:   double  inf, sup;
1.12    ! kondoh    307:   int current_roundmode;
1.11      noro      308:
                    309:   asir_assert(ARG0(arg),O_N,"intvalbf");
                    310:   a = (Num)ARG0(arg);
                    311:   if ( argc(arg) > 1 ) {
                    312:     asir_assert(ARG1(arg),O_N,"intvalbf");
1.12    ! kondoh    313:
1.11      noro      314:     i = (Num)ARG0(arg);
                    315:     s = (Num)ARG1(arg);
1.12    ! kondoh    316:     current_roundmode = mpfr_roundmode;
        !           317:     mpfr_roundmode = MPFR_RNDD;
        !           318:     ii = tobf(i, DEFAULTPREC);
        !           319:     mpfr_roundmode = MPFR_RNDU;
        !           320:     ss = tobf(s, DEFAULTPREC);
        !           321:     istoitv(ii,ss,(Itv *)&c);
        !           322: //    MKIntervalBigFloat((BF)ii,(BF)ss,c);
        !           323: //    ToBf(s, &ss);
        !           324:     mpfr_roundmode = current_roundmode;
1.11      noro      325:   } else {
                    326:     if ( ! a ) {
                    327:       *rp = 0;
                    328:       return;
                    329:     }
                    330:     else if ( NID(a) == N_IP ) {
                    331:       itvtois((Itv)a, &i, &s);
1.12    ! kondoh    332:       current_roundmode = mpfr_roundmode;
        !           333:       mpfr_roundmode = MPFR_RNDD;
        !           334:       ii = tobf(i, DEFAULTPREC);
        !           335:       mpfr_roundmode = MPFR_RNDU;
        !           336:       ss = tobf(s, DEFAULTPREC);
        !           337:       istoitv(ii,ss,(Itv *)&c);
        !           338: //      MKIntervalBigFloat((BF)ii,(BF)ss,c);
        !           339:       mpfr_roundmode = current_roundmode;
1.11      noro      340:     }
                    341:     else if ( NID(a) == N_IntervalBigFloat) {
                    342:       *rp = (Obj)a;
                    343:       return;
                    344:     }
                    345:     else if ( NID(a) == N_IntervalDouble ) {
                    346:       inf = INF((IntervalDouble)a);
                    347:       sup = SUP((IntervalDouble)a);
1.12    ! kondoh    348:       current_roundmode = mpfr_roundmode;
        !           349:       //double2bf(inf, (BF *)&i);
        !           350:       //double2bf(sup, (BF *)&s);
        !           351:       mpfr_roundmode = MPFR_RNDD;
        !           352:       MKReal(inf,di);
        !           353:       ii = tobf((Num)di, DEFAULTPREC);
        !           354:       mpfr_roundmode = MPFR_RNDU;
        !           355:       MKReal(sup,ds);
        !           356:       ss = tobf((Num)ds, DEFAULTPREC);
        !           357:       istoitv(ii,ss,(Itv *)&c);
        !           358: //      MKIntervalBigFloat((BF)ii,(BF)ss,c);
        !           359:       mpfr_roundmode = current_roundmode;
1.11      noro      360:     }
                    361:     else {
1.12    ! kondoh    362:       current_roundmode = mpfr_roundmode;
        !           363:       mpfr_roundmode = MPFR_RNDD;
        !           364:       ii = tobf(a, DEFAULTPREC);
        !           365:       mpfr_roundmode = MPFR_RNDU;
        !           366:       ss = tobf(a, DEFAULTPREC);
        !           367:       //ToBf(a, (BF *)&i);
        !           368:       istoitv(ii,ss,(Itv *)&c);
        !           369: //      MKIntervalBigFloat((BF)ii,(BF)ss,c);
        !           370:       mpfr_roundmode = current_roundmode;
1.11      noro      371:     }
                    372:   }
1.12    ! kondoh    373: //  if ( c && OID( c ) == O_N && NID( c ) == N_IntervalBigFloat )
        !           374: //    addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
        !           375: //  else *rp = (Obj)c;
        !           376:   *rp = (Obj)c;
1.1       saito     377: }
                    378:
                    379: static void
                    380: Pitvd(NODE arg, Obj *rp)
                    381: {
1.11      noro      382:   double  inf, sup;
                    383:   Num  a, a0, a1, t;
                    384:   Itv  ia;
                    385:   IntervalDouble  d;
                    386:
                    387:   asir_assert(ARG0(arg),O_N,"intvald");
                    388:   a0 = (Num)ARG0(arg);
                    389:   if ( argc(arg) > 1 ) {
                    390:     asir_assert(ARG1(arg),O_N,"intvald");
                    391:     a1 = (Num)ARG1(arg);
                    392:   } else {
                    393:     if ( a0 && OID(a0)==O_N && NID(a0)==N_IntervalDouble ) {
                    394:       inf = INF((IntervalDouble)a0);
                    395:       sup = SUP((IntervalDouble)a0);
                    396:       MKIntervalDouble(inf,sup,d);
                    397:       *rp = (Obj)d;
                    398:       return;
                    399:     }
                    400:     a1 = (Num)ARG0(arg);
                    401:   }
                    402:   if ( compnum(0,a0,a1) > 0 ) {
                    403:     t = a0; a0 = a1; a1 = t;
                    404:   }
                    405:   inf = ToRealDown(a0);
                    406:   sup = ToRealUp(a1);
                    407:   MKIntervalDouble(inf,sup,d);
                    408:   *rp = (Obj)d;
1.1       saito     409: }
                    410:
                    411: static void
                    412: Pinf(NODE arg, Obj *rp)
                    413: {
1.11      noro      414:   Num  a, i, s;
                    415:   Real  r;
                    416:   double  d;
                    417:
                    418:   a = (Num)ARG0(arg);
                    419:   if ( ! a ) {
                    420:     *rp = 0;
                    421:   } else if  ( OID(a) == O_N ) {
                    422:     switch ( NID(a) ) {
                    423:       case N_IntervalDouble:
                    424:         d = INF((IntervalDouble)a);
                    425:         MKReal(d, r);
                    426:         *rp = (Obj)r;
                    427:         break;
                    428:       case N_IP:
                    429:       case N_IntervalBigFloat:
                    430:       case N_IntervalQuad:
                    431:         itvtois((Itv)ARG0(arg),&i,&s);
                    432:         *rp = (Obj)i;
                    433:         break;
                    434:       default:
                    435:         *rp = (Obj)a;
                    436:         break;
                    437:     }
                    438:   } else {
                    439:     *rp = (Obj)a;
                    440:   }
1.1       saito     441: }
                    442:
                    443: static void
                    444: Psup(NODE arg, Obj *rp)
                    445: {
1.11      noro      446:   Num  a, i, s;
                    447:   Real  r;
                    448:   double  d;
                    449:
                    450:   a = (Num)ARG0(arg);
                    451:   if ( ! a ) {
                    452:     *rp = 0;
                    453:   } else if  ( OID(a) == O_N ) {
                    454:     switch ( NID(a) ) {
                    455:       case N_IntervalDouble:
                    456:         d = SUP((IntervalDouble)a);
                    457:         MKReal(d, r);
                    458:         *rp = (Obj)r;
                    459:         break;
                    460:       case N_IP:
                    461:       case N_IntervalBigFloat:
                    462:       case N_IntervalQuad:
                    463:         itvtois((Itv)ARG0(arg),&i,&s);
                    464:         *rp = (Obj)s;
                    465:         break;
                    466:       default:
                    467:         *rp = (Obj)a;
                    468:         break;
                    469:     }
                    470:   } else {
                    471:       *rp = (Obj)a;
                    472:   }
1.1       saito     473: }
                    474:
                    475: static void
                    476: Pmid(NODE arg, Obj *rp)
                    477: {
1.11      noro      478:   Num  a, s;
                    479:   Real  r;
                    480:   double  d;
                    481:
                    482:   a = (Num)ARG0(arg);
                    483:   if ( ! a ) {
                    484:     *rp = 0;
                    485:   } else switch (OID(a)) {
                    486:     case O_N:
                    487:       if ( NID(a) == N_IntervalDouble ) {
                    488:         d = ( INF((IntervalDouble)a)+SUP((IntervalDouble)a) ) / 2.0;
                    489:         MKReal(d, r);
                    490:         *rp = (Obj)r;
                    491:       } else if ( NID(a) == N_IntervalQuad ) {
                    492:         error("mid: not supported operation");
                    493:         *rp = 0;
                    494:       } else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat ) {
                    495:         miditvp((Itv)ARG0(arg),&s);
                    496:         *rp = (Obj)s;
                    497:       } else {
                    498:         *rp = (Obj)a;
                    499:       }
                    500:       break;
1.1       saito     501: #if 0
1.11      noro      502:     case O_P:
                    503:     case O_R:
                    504:     case O_LIST:
                    505:     case O_VECT:
                    506:     case O_MAT:
1.1       saito     507: #endif
1.11      noro      508:     default:
                    509:       *rp = (Obj)a;
                    510:       break;
                    511:   }
1.1       saito     512: }
                    513:
                    514: static void
                    515: Pcup(NODE arg, Obj *rp)
                    516: {
1.11      noro      517:   Itv  s;
                    518:   Num  a, b;
1.1       saito     519:
1.11      noro      520:   asir_assert(ARG0(arg),O_N,"cup");
                    521:   asir_assert(ARG1(arg),O_N,"cup");
                    522:   a = (Num)ARG0(arg);
                    523:   b = (Num)ARG1(arg);
                    524:   if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
                    525:     cupitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);
                    526:   } else {
                    527:     cupitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
                    528:     *rp = (Obj)s;
                    529:   }
1.1       saito     530: }
                    531:
                    532: static void
                    533: Pcap(NODE arg, Obj *rp)
                    534: {
1.11      noro      535:   Itv  s;
                    536:   Num  a, b;
1.1       saito     537:
1.11      noro      538:   asir_assert(ARG0(arg),O_N,"cap");
                    539:   asir_assert(ARG1(arg),O_N,"cap");
                    540:   a = (Num)ARG0(arg);
                    541:   b = (Num)ARG1(arg);
                    542:   if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
                    543:     capitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);
                    544:   } else {
                    545:     capitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
                    546:     *rp = (Obj)s;
                    547:   }
1.1       saito     548: }
                    549:
                    550: static void
                    551: Pwidth(arg,rp)
                    552: NODE arg;
                    553: Obj *rp;
                    554: {
1.11      noro      555:   Num  s;
                    556:   Num  a;
1.1       saito     557:
1.11      noro      558:   asir_assert(ARG0(arg),O_N,"width");
                    559:   a = (Num)ARG0(arg);
                    560:   if ( ! a ) {
                    561:     *rp = 0;
                    562:   } else if ( NID(a) == N_IntervalDouble ) {
                    563:     widthitvd((IntervalDouble)a, (Num *)rp);
                    564:   } else {
                    565:     widthitvp((Itv)ARG0(arg),&s);
                    566:     *rp = (Obj)s;
                    567:   }
1.1       saito     568: }
                    569:
                    570: static void
                    571: Pabsitv(arg,rp)
                    572: NODE arg;
                    573: Obj *rp;
                    574: {
1.11      noro      575:   Num  s;
                    576:   Num  a, b;
1.1       saito     577:
1.11      noro      578:   asir_assert(ARG0(arg),O_N,"absitv");
                    579:   a = (Num)ARG0(arg);
                    580:   if ( ! a ) {
                    581:     *rp = 0;
                    582:   } else if ( NID(a) == N_IntervalDouble ) {
                    583:     absitvd((IntervalDouble)a, (Num *)rp);
                    584:   } else {
                    585:     absitvp((Itv)ARG0(arg),&s);
                    586:     *rp = (Obj)s;
                    587:   }
1.1       saito     588: }
                    589:
                    590: static void
                    591: Pdistance(arg,rp)
                    592: NODE arg;
                    593: Obj *rp;
                    594: {
1.11      noro      595:   Num  s;
                    596:   Num  a, b;
1.1       saito     597:
1.11      noro      598:   asir_assert(ARG0(arg),O_N,"distance");
                    599:   asir_assert(ARG1(arg),O_N,"distance");
                    600:   a = (Num)ARG0(arg);
                    601:   b = (Num)ARG1(arg);
                    602:   if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
                    603:     distanceitvd((IntervalDouble)a, (IntervalDouble)b, (Num *)rp);
                    604:   } else {
                    605:     distanceitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
                    606:     *rp = (Obj)s;
                    607:   }
1.1       saito     608: }
                    609:
                    610: static void
                    611: Pinitv(arg,rp)
                    612: NODE arg;
                    613: Obj *rp;
                    614: {
1.11      noro      615:   int  s;
                    616:   Q  q;
1.1       saito     617:
1.11      noro      618:   asir_assert(ARG0(arg),O_N,"intval");
                    619:   asir_assert(ARG1(arg),O_N,"intval");
                    620:   if ( ! ARG1(arg) ) {
                    621:     if ( ! ARG0(arg) ) s = 1;
                    622:     else s = 0;
                    623:   }
                    624:   else if ( NID(ARG1(arg)) == N_IntervalDouble ) {
                    625:     s = initvd((Num)ARG0(arg),(IntervalDouble)ARG1(arg));
                    626:
                    627:   } else if ( NID(ARG1(arg)) == N_IP || NID(ARG1(arg)) == N_IntervalBigFloat ) {
                    628:     if ( ! ARG0(arg) ) s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));
                    629:     else if ( NID(ARG0(arg)) == N_IP ) {
                    630:       s = itvinitvp((Itv)ARG0(arg),(Itv)ARG1(arg));
                    631:     } else {
                    632:       s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));
                    633:     }
                    634:   } else {
                    635:     s = ! compnum(0,(Num)ARG0(arg),(Num)ARG1(arg));
                    636:   }
                    637:   STOQ(s,q);
                    638:   *rp = (Obj)q;
1.1       saito     639: }
                    640:
                    641: static void
                    642: Pdisjitv(arg,rp)
                    643: NODE arg;
                    644: Obj *rp;
                    645: {
1.11      noro      646:   Itv  s;
1.1       saito     647:
1.11      noro      648:   asir_assert(ARG0(arg),O_N,"disjitv");
                    649:   asir_assert(ARG1(arg),O_N,"disjitv");
                    650:   error("disjitv: not implemented yet");
                    651:   if ( ! s ) *rp = 0;
                    652:   else *rp = (Obj)ONE;
1.1       saito     653: }
                    654:
1.12    ! kondoh    655: static void
        !           656: PzeroRewriteMode(NODE arg, Obj *rp)
        !           657: {
        !           658:   Q  a, r;
        !           659:
        !           660:   STOQ(zerorewrite,r);
        !           661:   *rp = (Obj)r;
        !           662:
        !           663:   if (arg) {
        !           664:     a = (Q)ARG0(arg);
        !           665:     if(!a) {
        !           666:       zerorewrite = 0;
        !           667:     } else if ( (NUM(a)&&INT(a)) ){
        !           668:       zerorewrite = 1;
        !           669:     }
        !           670:   }
        !           671: }
        !           672:
        !           673: static void
        !           674: PzeroRewriteCountClear(NODE arg, Obj *rp)
        !           675: {
        !           676:   Q  a, r;
        !           677:
        !           678:   STOQ(zerorewriteCount,r);
        !           679:   *rp = (Obj)r;
        !           680:
        !           681:   if (arg) {
        !           682:     a = (Q)ARG0(arg);
        !           683:     if(a &&(NUM(a)&&INT(a))){
        !           684:       zerorewriteCount = 0;
        !           685:     }
        !           686:   }
        !           687: }
        !           688:
        !           689: static void
        !           690: PzeroRewriteCount(NODE arg, Obj *rp)
        !           691: {
        !           692:   Q  r;
        !           693:
        !           694:   STOQ(zerorewriteCount,r);
        !           695:   *rp = (Obj)r;
        !           696: }
        !           697:
        !           698:
1.1       saito     699: #endif
1.11      noro      700: extern int  printmode;
1.1       saito     701:
1.11      noro      702: static void  pprintmode( void )
1.1       saito     703: {
1.11      noro      704:   switch (printmode) {
1.1       saito     705: #if defined(INTERVAL)
1.11      noro      706:     case MID_PRINTF_E:
                    707:       fprintf(stderr,"Interval printing mode is a mitpoint type.\n");
1.1       saito     708: #endif
1.11      noro      709:     case PRINTF_E:
                    710:       fprintf(stderr,"Printf's double printing mode is \"%%.16e\".\n");
                    711:       break;
1.1       saito     712: #if defined(INTERVAL)
1.11      noro      713:     case MID_PRINTF_G:
                    714:       fprintf(stderr,"Interval printing mode is a mitpoint type.\n");
1.1       saito     715: #endif
1.11      noro      716:     default:
                    717:     case PRINTF_G:
                    718:       fprintf(stderr,"Printf's double printing mode is \"%%g\".\n");
                    719:       break;
                    720:   }
1.1       saito     721: }
                    722:
                    723: static void
                    724: Pprintmode(NODE arg, Obj *rp)
                    725: {
1.11      noro      726:   int  l;
                    727:   Q  a, r;
1.1       saito     728:
1.11      noro      729:   a = (Q)ARG0(arg);
                    730:   if(!a||(NUM(a)&&INT(a))){
                    731:     l=QTOS(a);
                    732:     if ( l < 0 ) l = 0;
1.1       saito     733: #if defined(INTERVAL)
1.11      noro      734:     else if ( l > MID_PRINTF_E ) l = 0;
1.1       saito     735: #else
1.11      noro      736:     else if ( l > PRINTF_E ) l = 0;
1.1       saito     737: #endif
1.11      noro      738:     STOQ(printmode,r);
                    739:     *rp = (Obj)r;
                    740:     printmode = l;
                    741:     pprintmode();
                    742:   } else {
                    743:     *rp = 0;
                    744:   }
1.1       saito     745: }
1.11      noro      746:
1.1       saito     747:

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