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

File: [local] / OpenXM_contrib2 / asir2018 / builtin / itvnum.c (download)

Revision 1.6, Tue Dec 24 10:26:38 2019 UTC (4 years, 4 months ago) by kondoh
Branch: MAIN
CVS Tags: HEAD
Changes since 1.5: +317 -80 lines

fix interval arithmetic

/*
 * $OpenXM: OpenXM_contrib2/asir2018/builtin/itvnum.c,v 1.6 2019/12/24 10:26:38 kondoh Exp $
 */

#include "ca.h"
#include "parse.h"
#include "version.h"
#if !defined(ANDROID)
#include "../plot/ifplot.h"
#endif

#include <mpfr.h>
#include <mpfi.h>
// in engine/bf.c
Num tobf(Num,int);

#if defined(INTERVAL)
static void Pitv(NODE, Obj *);
static void Pitvd(NODE, Obj *);
static void Pitvbf(NODE, Obj *);
static void Pinf(NODE, Obj *);
static void Psup(NODE, Obj *);
static void Pmid(NODE, Obj *);
static void Pabsitv(NODE, Obj *);
static void Pdisjitv(NODE, Obj *);
static void Pinitv(NODE, Obj *);
static void Pcup(NODE, Obj *);
static void Pcap(NODE, Obj *);
static void Pwidth(NODE, Obj *);
static void Pdistance(NODE, 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);
static void Pevalitv(NODE, Obj *);
static void Pevalitvbf(NODE, Obj *);
static void Pevalitvd(NODE, Obj *);

static void Pitvbf_pi(NODE ,Obj *);
static void Pitvbf_e(NODE ,Obj *);
static void Pitvbf_sin(NODE ,Obj *);
static void Pitvbf_cos(NODE ,Obj *);
static void Pitvbf_tan(NODE ,Obj *);
static void Pitvbf_asin(NODE ,Obj *);
static void Pitvbf_acos(NODE ,Obj *);
static void Pitvbf_atan(NODE ,Obj *);
static void Pitvbf_sinh(NODE ,Obj *);
static void Pitvbf_cosh(NODE ,Obj *);
static void Pitvbf_tanh(NODE ,Obj *);
static void Pitvbf_asinh(NODE ,Obj *);
static void Pitvbf_acosh(NODE ,Obj *);
static void Pitvbf_atanh(NODE ,Obj *);
static void Pitvbf_exp(NODE ,Obj *);
static void Pitvbf_log(NODE ,Obj *);
static void Pitvbf_abs(NODE ,Obj *);
static void Pitvbf_pow(NODE ,Num *);

static void Pitvd_pi(NODE ,Obj *);
static void Pitvd_e(NODE ,Obj *);
static void Pitvd_sin(NODE ,Obj *);
static void Pitvd_cos(NODE ,Obj *);
static void Pitvd_tan(NODE ,Obj *);
static void Pitvd_asin(NODE ,Obj *);
static void Pitvd_acos(NODE ,Obj *);
static void Pitvd_atan(NODE ,Obj *);
static void Pitvd_sinh(NODE ,Obj *);
static void Pitvd_cosh(NODE ,Obj *);
static void Pitvd_tanh(NODE ,Obj *);
static void Pitvd_asinh(NODE ,Obj *);
static void Pitvd_acosh(NODE ,Obj *);
static void Pitvd_atanh(NODE ,Obj *);
static void Pitvd_exp(NODE ,Obj *);
static void Pitvd_log(NODE ,Obj *);
static void Pitvd_abs(NODE ,Obj *);
static void Pitvd_pow(NODE ,Num *);

static void Pitv_pi(NODE ,Obj *);
static void Pitv_e(NODE ,Obj *);
static void Pitv_sin(NODE ,Obj *);
static void Pitv_cos(NODE ,Obj *);
static void Pitv_tan(NODE ,Obj *);
static void Pitv_asin(NODE ,Obj *);
static void Pitv_acos(NODE ,Obj *);
static void Pitv_atan(NODE ,Obj *);
static void Pitv_sinh(NODE ,Obj *);
static void Pitv_cosh(NODE ,Obj *);
static void Pitv_tanh(NODE ,Obj *);
static void Pitv_asinh(NODE ,Obj *);
static void Pitv_acosh(NODE ,Obj *);
static void Pitv_atanh(NODE ,Obj *);
static void Pitv_exp(NODE ,Obj *);
static void Pitv_log(NODE ,Obj *);
static void Pitv_abs(NODE ,Obj *);
static void Pitv_pow(NODE ,Num *);
#endif
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
int  end;
#endif

struct ftab interval_tab[] = {
  {"printmode",Pprintmode,1},
#if defined(INTERVAL)
  {"itvd",Pitvd,-2},
  {"intvald",Pitvd,-2},
  {"itv",Pitv,-2},
  {"intval",Pitv,-2},
  {"itvbf",Pitvbf,-2},
  {"intvalbf",Pitvbf,-2},
  {"inf",Pinf,1},
  {"sup",Psup,1},
  {"absintval",Pabsitv,1},
  {"absitv",Pabsitv,1},
  {"disintval",Pdisjitv,2},
  {"inintval",Pinitv,2},
  {"cup",Pcup,2},
  {"cap",Pcap,2},
  {"mid",Pmid,1},
  {"width",Pwidth,1},
  {"diam",Pwidth,1},
  {"distance",Pdistance,2},
  {"iversion",Pitvversion,-1},
  {"intvalversion",Pitvversion,-1},
  {"zerorewritemode",PzeroRewriteMode,-1},
  {"zeroRewriteMode",PzeroRewriteMode,-1},
  {"zeroRewriteCountClear",PzeroRewriteCountClear,-1},
  {"zeroRewriteCount",PzeroRewriteCount,-1},
/* eval */
  {"evalitv", 	Pevalitv,	-2},
  {"evalitvbf",	Pevalitvbf,	-2},
  {"evalitvd",	Pevalitvd,	1},
/* math */

  {"piitv",		Pitv_pi,	-1},
  {"piitvbf",	Pitvbf_pi,	-1},
  {"piitvd",	Pitvd_pi,	-1},
  {"eitv",		Pitv_e,	-1},
  {"eitvbf",	Pitvbf_e,	-1},
  {"eitvd",		Pitvd_e,	-1},
#if 0
  {"factorialitv",Pfactorialitv,1},
  {"factorialitvd",Pfactorialitvd,1},

  {"absitv",	Pitv_abs,	-2},
  {"absitvbf",	Pitvbf_abs,	-2},
  {"absitvd",	Pitvd_abs,	-2},
#endif

  {"logitv",	Pitv_log,	-2},
  {"logitvbf",	Pitvbf_log,	-2},
  {"logitvd",	Pitvd_log,	-2},
  {"expitv",	Pitv_exp,	-2},
  {"expitvbf",	Pitvbf_exp,	-2},
  {"expitvd",	Pitvd_exp,	-2},
  {"powitv",	Pitv_pow,	-3},
  {"powitvbf",	Pitvbf_pow,	-3},
  {"powitvd",	Pitvd_pow,	-3},

  {"sinitv",	Pitv_sin,	-2},
  {"sinitvbf",	Pitvbf_sin,	-2},
  {"sinitvd",	Pitvd_sin,	-2},
  {"cositv",	Pitv_cos,	-2},
  {"cositvbf",	Pitvbf_cos,	-2},
  {"cositvd",	Pitvd_cos,	-2},
  {"tanitv",	Pitv_tan,	-2},
  {"tanitvbf",	Pitvbf_tan,	-2},
  {"tanitvd",	Pitvd_tan,	-2},
  {"asinitv",	Pitv_asin,	-2},
  {"asinitvbf",	Pitvbf_asin,	-2},
  {"asinitvd",	Pitvd_asin,		-2},
  {"acositv",	Pitv_acos,		-2},
  {"acositvbf",	Pitvbf_acos,	-2},
  {"acositvd",	Pitvd_acos,		-2},
  {"atanitv",	Pitv_atan,		-2},
  {"atanitvbf",	Pitvbf_atan,	-2},
  {"atanitvd",	Pitvd_atan,		-2},
  {"sinhitv",	Pitv_sinh,		-2},
  {"sinhitvbf",	Pitvbf_sinh,	-2},
  {"sinhitvd",	Pitvd_sinh,		-2},
  {"coshitv",	Pitv_cosh,		-2},
  {"coshitvbf",	Pitvbf_cosh,	-2},
  {"coshitvd",	Pitvd_cosh,		-2},
  {"tanhitv",	Pitv_tanh,		-2},
  {"tanhitvbf",	Pitvbf_tanh,	-2},
  {"tanhitvd",	Pitvd_tanh,		-2},
  {"asinhitv",	Pitv_asinh,		-2},
  {"asinhitvbf",	Pitvbf_asinh,	-2},
  {"asinhitvd",		Pitvd_asinh,	-2},
  {"acoshitv",		Pitv_acosh,		-2},
  {"acoshitvbf",	Pitvbf_acosh,	-2},
  {"acoshitvd",		Pitvd_acosh,	-2},
  {"atanhitv",		Pitv_atanh,		-2},
  {"atanhitvbf",	Pitvbf_atanh,	-2},
  {"atanhitvd",		Pitvd_atanh,	-2},

/* plot time check */
  {"ifcheck",Pifcheck,-7},
#endif
  {0,0,0},
};

extern int mpfr_roundmode;

#if defined(INTERVAL)

/* plot time check */
static void
Pifcheck(NODE arg, Obj *rp)
{
  Z 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;
  Z one;
  int width, height, ix, iy;
  int id;

  STOZ(-2,m2); STOZ(2,p2);
  STOZ(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 = ZTOS((Z)BDY(BDY(geom)));
    can->height = ZTOS((Z)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(NODE arg, Q *rp)
{
	Z r;
  STOZ(INT_ASIR_VERSION, r);
	*rp = (Q)r;
}

extern int  bigfloat;

static void
Pitv(NODE arg, Obj *rp)
{
  Num  a, i, s;
  Itv  c;
  double  inf, sup;

#if 1
  if ( bigfloat )
    Pitvbf(arg, rp);
  else
    Pitvd(arg,rp);
#else
  asir_assert(ARG0(arg),O_N,"itv");
  if ( argc(arg) > 1 ) {
    asir_assert(ARG1(arg),O_N,"itv");
    istoitv((Num)ARG0(arg),(Num)ARG1(arg),&c);
  } else {
    a = (Num)ARG0(arg);
    if ( ! a ) {
      *rp = 0;
      return;
    }
    else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat) {
      *rp = (Obj)a;
      return;
    }
    else if ( NID(a) == N_IntervalDouble ) {
      inf = INF((IntervalDouble)a);
      sup = SUP((IntervalDouble)a);
      double2bf(inf, (BF *)&i);
      double2bf(sup, (BF *)&s);
      istoitv(i,s,&c);
    }
    else istoitv(a,a,&c);
  }
  if ( NID( c ) == N_IntervalBigFloat )
    addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
  else *rp = (Obj)c;
#endif
}

static void
Pitvbf(NODE arg, Obj *rp)
{
  Num  a, i, s;
  IntervalBigFloat  c;
  Num  ii,ss;
  Real di, ds;
  double  inf, sup;
  int current_roundmode;

  asir_assert(ARG0(arg),O_N,"intvalbf");
  a = (Num)ARG0(arg);
  if ( argc(arg) > 1 ) {
    asir_assert(ARG1(arg),O_N,"intvalbf");

    i = (Num)ARG0(arg);
    s = (Num)ARG1(arg);
    current_roundmode = mpfr_roundmode;
    mpfr_roundmode = MPFR_RNDD;
    ii = tobf(i, DEFAULTPREC);
    mpfr_roundmode = MPFR_RNDU;
    ss = tobf(s, DEFAULTPREC);
    istoitv(ii,ss,(Itv *)&c);
//    MKIntervalBigFloat((BF)ii,(BF)ss,c);
//    ToBf(s, &ss);
    mpfr_roundmode = current_roundmode;
  } else {
    if ( ! a ) {
      *rp = 0;
      return;
    }
    else if ( NID(a) == N_IP ) {
      itvtois((Itv)a, &i, &s);
      current_roundmode = mpfr_roundmode;
      mpfr_roundmode = MPFR_RNDD;
      ii = tobf(i, DEFAULTPREC);
      mpfr_roundmode = MPFR_RNDU;
      ss = tobf(s, DEFAULTPREC);
      istoitv(ii,ss,(Itv *)&c);
//      MKIntervalBigFloat((BF)ii,(BF)ss,c);
      mpfr_roundmode = current_roundmode;
    }
    else if ( NID(a) == N_IntervalBigFloat) {
      *rp = (Obj)a;
      return;
    }
    else if ( NID(a) == N_IntervalDouble ) {
      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
Pitvd(NODE arg, Obj *rp)
{
  double  inf, sup;
  Num  a, a0, a1, t;
  Itv  ia;
  IntervalDouble  d;

  asir_assert(ARG0(arg),O_N,"intvald");
  a0 = (Num)ARG0(arg);
  if ( argc(arg) > 1 ) {
    asir_assert(ARG1(arg),O_N,"intvald");
    a1 = (Num)ARG1(arg);
  } else {
    if ( a0 && OID(a0)==O_N && NID(a0)==N_IntervalDouble ) {
      inf = INF((IntervalDouble)a0);
      sup = SUP((IntervalDouble)a0);
      MKIntervalDouble(inf,sup,d);
      *rp = (Obj)d;
      return;
    }
    a1 = (Num)ARG0(arg);
  }
  if ( compnum(0,a0,a1) > 0 ) {
    t = a0; a0 = a1; a1 = t;
  }
  inf = toRealDown(a0);
  sup = toRealUp(a1);
  MKIntervalDouble(inf,sup,d);
  *rp = (Obj)d;
}

static void
Pinf(NODE arg, Obj *rp)
{
  Num  a, i, s;
  Real  r;
  double  d;

  a = (Num)ARG0(arg);
  if ( ! a ) {
    *rp = 0;
  } else if  ( OID(a) == O_N ) {
    switch ( NID(a) ) {
      case N_IntervalDouble:
        d = INF((IntervalDouble)a);
        MKReal(d, r);
        *rp = (Obj)r;
        break;
      case N_IP:
      case N_IntervalBigFloat:
      case N_IntervalQuad:
        itvtois((Itv)ARG0(arg),&i,&s);
        *rp = (Obj)i;
        break;
      default:
        *rp = (Obj)a;
        break;
    }
  } else {
    *rp = (Obj)a;
  }
}

static void
Psup(NODE arg, Obj *rp)
{
  Num  a, i, s;
  Real  r;
  double  d;

  a = (Num)ARG0(arg);
  if ( ! a ) {
    *rp = 0;
  } else if  ( OID(a) == O_N ) {
    switch ( NID(a) ) {
      case N_IntervalDouble:
        d = SUP((IntervalDouble)a);
        MKReal(d, r);
        *rp = (Obj)r;
        break;
      case N_IP:
      case N_IntervalBigFloat:
      case N_IntervalQuad:
        itvtois((Itv)ARG0(arg),&i,&s);
        *rp = (Obj)s;
        break;
      default:
        *rp = (Obj)a;
        break;
    }
  } else {
      *rp = (Obj)a;
  }
}

static void
Pmid(NODE arg, Obj *rp)
{
  Num  a, s;
  Real  r;
  double  d;

  a = (Num)ARG0(arg);
  if ( ! a ) {
    *rp = 0;
  } else switch (OID(a)) {
    case O_N:
      if ( NID(a) == N_IntervalDouble ) {
        d = ( INF((IntervalDouble)a)+SUP((IntervalDouble)a) ) / 2.0;
        MKReal(d, r);
        *rp = (Obj)r;
      } else if ( NID(a) == N_IntervalQuad ) {
        error("mid: not supported operation");
        *rp = 0;
      } else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat ) {
        miditvp((Itv)ARG0(arg),&s);
        *rp = (Obj)s;
      } else {
        *rp = (Obj)a;
      }
      break;
#if 0
    case O_P:
    case O_R:
    case O_LIST:
    case O_VECT:
    case O_MAT:
#endif
    default:
      *rp = (Obj)a;
      break;
  }
}

static void
Pcup(NODE arg, Obj *rp)
{
  Itv  s;
  Num  a, b;

  asir_assert(ARG0(arg),O_N,"cup");
  asir_assert(ARG1(arg),O_N,"cup");
  a = (Num)ARG0(arg);
  b = (Num)ARG1(arg);
  if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
    cupitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);
  } else {
    cupitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
    *rp = (Obj)s;
  }
}

static void
Pcap(NODE arg, Obj *rp)
{
  Itv  s;
  Num  a, b;

  asir_assert(ARG0(arg),O_N,"cap");
  asir_assert(ARG1(arg),O_N,"cap");
  a = (Num)ARG0(arg);
  b = (Num)ARG1(arg);
  if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
    capitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);
  } else {
    capitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
    *rp = (Obj)s;
  }
}

static void
Pwidth(arg,rp)
NODE arg;
Obj *rp;
{
  Num  s;
  Num  a;

  asir_assert(ARG0(arg),O_N,"width");
  a = (Num)ARG0(arg);
  if ( ! a ) {
    *rp = 0;
  } else if ( NID(a) == N_IntervalDouble ) {
    widthitvd((IntervalDouble)a, (Num *)rp);
  } else {
    widthitvp((Itv)ARG0(arg),&s);
    *rp = (Obj)s;
  }
}

static void
Pabsitv(arg,rp)
NODE arg;
Obj *rp;
{
  Num  s;
  Num  a, b;

  asir_assert(ARG0(arg),O_N,"absitv");
  a = (Num)ARG0(arg);
  if ( ! a ) {
    *rp = 0;
  } else if ( NID(a) == N_IntervalDouble ) {
    absitvd((IntervalDouble)a, (Num *)rp);
  } else {
    absitvp((Itv)ARG0(arg),&s);
    *rp = (Obj)s;
  }
}

static void
Pdistance(arg,rp)
NODE arg;
Obj *rp;
{
  Num  s;
  Num  a, b;

  asir_assert(ARG0(arg),O_N,"distance");
  asir_assert(ARG1(arg),O_N,"distance");
  a = (Num)ARG0(arg);
  b = (Num)ARG1(arg);
  if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
    distanceitvd((IntervalDouble)a, (IntervalDouble)b, (Num *)rp);
  } else {
    distanceitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
    *rp = (Obj)s;
  }
}

static void
Pinitv(NODE arg, Obj *rp)
{
  int  s;
  Z  q;

  asir_assert(ARG0(arg),O_N,"intval");
  asir_assert(ARG1(arg),O_N,"intval");
  if ( ! ARG1(arg) ) {
    if ( ! ARG0(arg) ) s = 1;
    else s = 0;
  }
  else if ( NID(ARG1(arg)) == N_IntervalDouble ) {
    s = initvd((Num)ARG0(arg),(IntervalDouble)ARG1(arg));

  } else if ( NID(ARG1(arg)) == N_IP || NID(ARG1(arg)) == N_IntervalBigFloat ) {
    if ( ! ARG0(arg) ) s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));
    else if ( NID(ARG0(arg)) == N_IP ) {
      s = itvinitvp((Itv)ARG0(arg),(Itv)ARG1(arg));
    } else {
      s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));
    }
  } else {
    s = ! compnum(0,(Num)ARG0(arg),(Num)ARG1(arg));
  }
  STOZ(s,q);
  *rp = (Obj)q;
}

static void
Pdisjitv(arg,rp)
NODE arg;
Obj *rp;
{
  Itv  s;

  asir_assert(ARG0(arg),O_N,"disjitv");
  asir_assert(ARG1(arg),O_N,"disjitv");
  error("disjitv: not implemented yet");
  if ( ! s ) *rp = 0;
  else *rp = (Obj)ONE;
}

static void
PzeroRewriteMode(NODE arg, Obj *rp)
{
  Q  a;
  Z r;

  STOZ(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;
  Z  r;

  STOZ(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)
{
  Z  r;

  STOZ(zerorewriteCount,r);
  *rp = (Obj)r;
}
  

#endif
extern int  printmode;

static void  pprintmode( void )
{
  switch (printmode) {
#if defined(INTERVAL)
    case MID_PRINTF_E:
      fprintf(stderr,"Interval printing mode is a mitpoint type.\n");
#endif
    case PRINTF_E:
      fprintf(stderr,"Printf's double printing mode is \"%%.16e\".\n");
      break;
#if defined(INTERVAL)
    case MID_PRINTF_G:
      fprintf(stderr,"Interval printing mode is a mitpoint type.\n");
#endif
    default:
    case PRINTF_G:
      fprintf(stderr,"Printf's double printing mode is \"%%g\".\n");
      break;
  }
}

static void
Pprintmode(NODE arg, Obj *rp)
{
  int  l;
  Z  a, r;

  a = (Z)ARG0(arg);
  if(!a||(NUM(a)&&INT(a))){
    l=ZTOS(a);
    if ( l < 0 ) l = 0;
#if defined(INTERVAL)
    else if ( l > MID_PRINTF_E ) l = 0;
#else
    else if ( l > PRINTF_E ) l = 0;
#endif
    STOZ(printmode,r);
    *rp = (Obj)r;
    printmode = l;
    pprintmode();
  } else {
    *rp = 0;
  }
}

#if defined(INTERVAL)
void 
Ppi_itvd(NODE arg, Obj *rp)
{
	double inf, sup;
	IntervalDouble c;
    FPMINUSINF
	sscanf("3.1415926535897932384626433832795028841971693993751", "%lf", &inf);
    FPPLUSINF
    sscanf("3.1415926535897932384626433832795028841971693993752", "%lf", &sup);
    FPNEAREST
    MKIntervalDouble(inf,sup,c);
	*rp = (Obj)c;
}
void 
Pe_itvd(NODE arg, Obj *rp)
{
	double inf, sup;
	IntervalDouble c;
    FPMINUSINF
	sscanf( "2.7182818284590452353602874713526624977572470936999", "%lf", &inf);
    FPPLUSINF
    sscanf( "2.7182818284590452353602874713526624977572470937000", "%lf", &sup);
    FPNEAREST
    MKIntervalDouble(inf,sup,c);
	*rp = (Obj)c;
}
void 
Pln2_itvd(NODE arg, Obj *rp)
{
	double inf, sup;
	IntervalDouble c;
    FPMINUSINF
	sscanf( "0.69314718055994530941723212145817656807550013436025", "%lf", &inf);
    FPPLUSINF
    sscanf( "0.69314718055994530941723212145817656807550013436026", "%lf", &sup);
    FPNEAREST
    MKIntervalDouble(inf,sup,c);
	*rp = (Obj)c;
}

void mpfi_func(NODE arg, int (*mpfi_f)(), int prec, Obj *rp)
{
  Num a, ii, ss;
  Itv c;
  BF inf, sup;
  int arg1prec;
  mpfi_t mpitv, rv;


/*  
  if ( argc(arg) == 2 ) {
    prec = QTOS((Q)ARG1(arg))*3.32193;
    if ( prec < MPFR_PREC_MIN ) prec = MPFR_PREC_MIN;
    else if ( prec > MPFR_PREC_MAX ) prec = MPFR_PREC_MAX;
  } else {
    prec = 0;
    prec = mpfr_get_default_prec();
  }
*/
  if ( prec > 0 ) arg1prec = prec;
  else arg1prec = NEXT(arg) ? ZTOS((Q)ARG1(arg)) : mpfr_get_default_prec();
  a = ARG0(arg);
  itvtois((Itv)a, &ii, &ss);

  inf = (BF)tobf(ii, arg1prec);
  sup = (BF)tobf(ss, arg1prec);
  
  mpfi_init2(rv,arg1prec);
  mpfi_init2(mpitv,arg1prec);
  mpfr_set(&(mpitv->left),  BDY(inf), MPFR_RNDD);
  mpfr_set(&(mpitv->right), BDY(sup), MPFR_RNDU);

  (*mpfi_f)(rv, mpitv);
  //mpfi_sin(rv, mpitv);

  MPFRTOBF(&(rv->left), inf);
  MPFRTOBF(&(rv->right), sup);

  if ( !cmpbf((Num)inf,0) ) inf = 0;
  if ( !cmpbf((Num)sup,0) ) sup = 0;          

  if ( inf || sup ) {
  	istoitv((Num)inf, (Num)sup, &c);
  } else {
    c = 0;
  }
  *rp = (Obj)c;
  //mpfi_clear(rv);
  mpfi_clear(mpitv);
}

void mpfi_func_d(NODE arg, int (*mpfi_f)(), Obj *rp)
{
  Obj bfv;
  Num ii, ss;
  IntervalDouble c;
  double inf, sup;

  mpfi_func(arg, mpfi_f, 53, &bfv);
  itvtois((Itv)bfv, &ii, &ss);
  inf = toRealDown(ii);
  sup = toRealUp(ss);
  MKIntervalDouble(inf,sup,c);
  *rp = (Obj)c;
}

  
void
Psinitvd(NODE arg, Obj *rp)
{
  Obj bfv;
  Num ii,ss;
  IntervalDouble c;
  double  ai,as,mas, bi,bs;
  double  inf,sup;

  mpfi_func(arg, mpfi_sin, 53, &bfv);
  itvtois((Itv)bfv, &ii, &ss);
  inf = toRealDown(ii);
  sup = toRealUp(ss);
  MKIntervalDouble(inf,sup,c);
  *rp = (Obj)c;
}

static
void
Psinitv(NODE arg, Obj *rp)
{
  mpfi_func(arg, mpfi_sin, 0, rp);
}




//void evalitvr(VL, Obj, int, int, Obj *);

static void
Pevalitv(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pevalitvbf(arg, rp);
  else
	Pevalitvd(arg, rp);
}

static void
Pevalitvbf(NODE arg, Obj *rp)
{
  int prec;

  asir_assert(ARG0(arg),O_R,"evalitv");
  if ( argc(arg) == 2 ) {
    long int mpfr_prec_max = MPFR_PREC_MAX;
    prec = ZTOS((Q)ARG1(arg))*3.32193;
    if ( prec < MPFR_PREC_MIN ) prec = MPFR_PREC_MIN;
    //else if ( prec > MPFR_PREC_MAX ) prec = MPFR_PREC_MAX;
    else if ( prec > mpfr_prec_max ) prec = mpfr_prec_max;
  } else
    prec = 0;
  evalitvr(CO,(Obj)ARG0(arg),prec,EvalIntervalBigFloat,rp);
}

static void
Pevalitvd(NODE arg, Obj *rp)
{
  asir_assert(ARG0(arg),O_R,"evalitvd");
  evalitvr(CO,(Obj)ARG0(arg),53,EvalIntervalDouble,rp);
}

// in parse/puref.c
void instoobj(PFINS ins,Obj *rp);

// in this
void evalitvr(VL, Obj, int, int, Obj *);
void evalitvp(VL,   P, int, int, P *);
void evalitvv(VL,   V, int, int, Obj *);
void evalitvins(PFINS, int, int, Obj *);



void evalitvr(VL vl,Obj a,int prec, int type, Obj *c)
{
  Obj nm,dn;

  if ( !a )
    *c = 0;
  else {
    switch ( OID(a) ) {
      case O_N:
        toInterval((Num)a, prec, type, (Num *)c);
		break;
      case O_P:
        evalitvp(vl,(P)a,prec,type,(P *)c);
		break;
      case O_R:  
        evalitvp(vl,NM((R)a),prec,type,(P *)&nm);
		evalitvp(vl,DN((R)a),prec,type,(P *)&dn);
        divr(vl,nm,dn,c);
        break;
      default:
        error("evalr : not implemented"); break;
    }
  }
}

void evalitvp(VL vl,P p,int prec, int type, P *pr)
{
  P t;
  DCP dc,dcr0,dcr;
  Obj u;

  if ( !p || NUM(p) ) {
        toInterval((Num)p, prec, type, (Num *)pr);
    //*pr = p;
  } else {
    for ( dcr0 = 0, dc = DC((P)p); dc; dc = NEXT(dc) ) {
      evalitvp(vl,COEF(dc),prec,type, &t);
      if ( t ) {
        NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
      }
    }
    if ( !dcr0 ) {
      *pr = 0; return;
    } else {
      NEXT(dcr) = 0; MKP(VR(p),dcr0,t);
    }
    if ( NUM(t) ) {
      //*pr = t;
        toInterval((Num)t, prec, type, (Num *)pr);
		return;
	} else if ( (VR(t) != VR(p)) || ((vid)VR(p)->attr != V_PF) ) {
      *pr = t; return;
    } else {
    	evalitvv(vl,VR(p),prec,type,&u);
		substr(vl,1,(Obj)t,VR(p),u, (Obj *)&t);
		if ( t && NUM(t) ) {
        	toInterval((Num)t, prec, type, (Num *)pr);
		} else {
			*pr = t;
		}
    }
  }
}

void evalitvv(VL vl,V v,int prec, int type, Obj *rp)
{
  PFINS ins,tins;
  PFAD ad,tad;
  PF pf;
  P t;
  int i;

  if ( (vid)v->attr != V_PF ) {
    MKV(v,t); *rp = (Obj)t;
  } else {
    ins = (PFINS)v->priv; ad = ins->ad; pf = ins->pf;
    tins = (PFINS)CALLOC(1,sizeof(PF)+pf->argc*sizeof(struct oPFAD));
    tins->pf = pf;
    for ( i = 0, tad = tins->ad; i < pf->argc; i++ ) {
      tad[i].d = ad[i].d;
		evalitvr(vl,ad[i].arg,prec,type,&tad[i].arg);
    }
    evalitvins(tins,prec,type,rp);
  }
}

void evalitvins(PFINS ins,int prec, int type, Obj *rp)
{
  PF pf;
  PFINS tins;
  PFAD ad,tad;
  int i;
  Z q;
  V v;
  P x;
  NODE n0,n;


  pf = ins->pf; ad = ins->ad;
  tins = (PFINS)CALLOC(1,sizeof(PF)+pf->argc*sizeof(struct oPFAD));
  tins->pf = pf; tad = tins->ad;
  for ( i = 0; i < pf->argc; i++ ) {
    //tad[i].d = ad[i].d; evalr(CO,ad[i].arg,prec,&tad[i].arg);
    tad[i].d = ad[i].d; evalitvr(CO,ad[i].arg,prec,type,&tad[i].arg);
   }
  for ( i = 0; i < pf->argc; i++ )
    if ( tad[i].d || (tad[i].arg && !NUM(tad[i].arg)) ) break;
  if ( (i != pf->argc) || !pf->intervalfunc[type] ) { ///////////////////////////
    instoobj(tins,rp);
  } else {
	int IsCPLX = 0;
    for ( n0 = 0, i = 0; i < pf->argc; i++ ) {
      NEXTNODE(n0,n); BDY(n) = (pointer)tad[i].arg;
		if (tad[i].arg && NID(tad[i].arg) == N_C) IsCPLX = 1;
    }
    if ( prec ) {
      NEXTNODE(n0,n); STOZ(prec,q); BDY(n) = (pointer)q;
    }
    if ( n0 ) NEXT(n) = 0;


	if ( IsCPLX ) {
    	instoobj(tins,rp);
	} else {
    	(*pf->intervalfunc[type])(n0,rp);
	}
  }
}


static
void Pitvbf_pi(NODE arg, Obj *rp)
{
  BF inf, sup;
  IntervalBigFloat c;
  mpfi_t rv;
  int prec;

  prec = (arg) ? ZTOS((Q)ARG0(arg)) : 0; //mpfr_get_default_prec();
  prec ? mpfi_init2(rv,prec) : mpfi_init(rv);

  mpfi_const_pi(rv);

  MPFRTOBF(&(rv->left), inf);
  MPFRTOBF(&(rv->right), sup);

  MKIntervalBigFloat(inf,sup,c);

  *rp = (Obj)c;
}

static
void Pitvd_pi(NODE arg, Obj *rp)
{
  BF bfinf, bfsup;
  IntervalDouble c;
  mpfi_t rv;
  double inf, sup;

  mpfi_init2(rv,53);

  mpfi_const_pi(rv);

  MPFRTOBF(&(rv->left),  bfinf);
  MPFRTOBF(&(rv->right), bfsup);

  inf = toRealDown((Num)bfinf);
  sup = toRealUp((Num)bfsup);

  MKIntervalDouble(inf,sup,c);

  *rp = (Obj)c;
}

static
void Pitvbf_e(NODE arg,Obj *rp)
{
  BF inf, sup;
  IntervalBigFloat c;
  mpfi_t rv;
  mpfi_t one;
  int prec;

  prec = (arg) ? ZTOS((Q)ARG0(arg)) : 0; //mpfr_get_default_prec();
  prec ? mpfi_init2(rv,prec) : mpfi_init(rv);

  mpfi_init(one);
  mpfi_set_ui(one,1);
  mpfi_exp(rv,one);

  MPFRTOBF(&(rv->left), inf);
  MPFRTOBF(&(rv->right), sup);

  MKIntervalBigFloat(inf,sup,c);
  //istoitv((Num)inf, (Num)sup, &c);
  *rp = (Obj)c;
  mpfi_clear(one);
}

static
void Pitvd_e(NODE arg, Obj *rp)
{
  BF bfinf, bfsup;
  IntervalDouble c;
  mpfi_t rv;
  mpfi_t one;
  double inf, sup;

  mpfi_init2(rv,53);

  mpfi_init2(one, 53);
  mpfi_set_ui(one,1);
  mpfi_exp(rv,one);


  MPFRTOBF(&(rv->left),  bfinf);
  MPFRTOBF(&(rv->right), bfsup);

  inf = toRealDown((Num)bfinf);
  sup = toRealUp((Num)bfsup);

  MKIntervalDouble(inf,sup,c);

  *rp = (Obj)c;
}

void (*pi_itv_ft[])() =		{Pitvd_pi,		0,	Pitvbf_pi};
void (*e_itv_ft[])() =		{Pitvd_e,		0,	Pitvbf_e};
//void (*sin_itv_ft[])() =	{Psinitvd,	0,	Psinitv};
void (*sin_itv_ft[])() =	{Pitvd_sin,		0,	Pitvbf_sin};
void (*cos_itv_ft[])() =	{Pitvbf_cos,	0,	Pitvbf_cos};
void (*tan_itv_ft[])() =	{Pitvd_tan,		0,	Pitvbf_tan};
void (*asin_itv_ft[])() =	{Pitvd_asin,	0,	Pitvbf_asin};
void (*acos_itv_ft[])() =	{Pitvd_acos,	0,	Pitvbf_acos};
void (*atan_itv_ft[])() =	{Pitvd_atan,	0,	Pitvbf_atan};
void (*sinh_itv_ft[])() =	{Pitvd_sinh,	0,	Pitvbf_sinh};
void (*cosh_itv_ft[])() =	{Pitvd_cosh,	0,	Pitvbf_cosh};
void (*tanh_itv_ft[])() =	{Pitvd_tanh,	0,	Pitvbf_tanh};
void (*asinh_itv_ft[])() =	{Pitvd_asinh,	0,	Pitvbf_asinh};
void (*acosh_itv_ft[])() =	{Pitvd_acosh,	0,	Pitvbf_acosh};
void (*atanh_itv_ft[])() =	{Pitvd_atanh,	0,	Pitvbf_atanh};
void (*exp_itv_ft[])() =	{Pitvd_exp,		0,	Pitvbf_exp};
void (*log_itv_ft[])() =	{Pitvd_log,		0,	Pitvbf_log};
void (*abs_itv_ft[])() =	{0};
void (*pow_itv_ft[])() =	{Pitvbf_pow,	0,	Pitvbf_pow};
//void (*pow_itv_ft[])() =	{0,	0,	0};       


static
void Pitvbf_sin(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_sin, 0, rp);
}

static
void Pitvbf_cos(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_cos, 0, rp);
}

static
void Pitvbf_tan(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_tan, 0, rp);
}

static
void Pitvbf_asin(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_asin, 0, rp);
}

static
void Pitvbf_acos(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_acos, 0, rp);
}

static
void Pitvbf_atan(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_atan, 0, rp);
}

static
void Pitvbf_sinh(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_sinh, 0, rp);
}

static
void Pitvbf_cosh(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_cosh, 0, rp);
}

static
void Pitvbf_tanh(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_tanh, 0, rp);
}

static
void Pitvbf_asinh(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_asinh, 0, rp);
}

static
void Pitvbf_acosh(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_acosh, 0, rp);
}

static
void Pitvbf_atanh(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_atanh, 0, rp);
}

static
void Pitvbf_exp(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_exp, 0, rp);
}

static
void Pitvbf_log(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_log, 0, rp);
}

static
void Pitvbf_abs(NODE arg,Obj *rp)
{
  mpfi_func(arg, mpfi_abs, 0, rp);
}

static
void Pitvd_sin(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_sin, rp);
}

static
void Pitvd_cos(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_cos, rp);
}

static
void Pitvd_tan(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_tan, rp);
}

static
void Pitvd_asin(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_asin, rp);
}

static
void Pitvd_acos(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_acos, rp);
}

static
void Pitvd_atan(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_atan, rp);
}

static
void Pitvd_sinh(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_sinh, rp);
}

static
void Pitvd_cosh(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_cosh, rp);
}

static
void Pitvd_tanh(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_tanh, rp);
}

static
void Pitvd_asinh(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_asinh, rp);
}

static
void Pitvd_acosh(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_acosh, rp);
}

static
void Pitvd_atanh(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_atanh, rp);
}

static
void Pitvd_exp(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_exp, rp);
}

static
void Pitvd_log(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_log, rp);
}

static
void Pitvd_abs(NODE arg,Obj *rp)
{
  mpfi_func_d(arg, mpfi_abs, rp);
}

/*
void mp_factorial(NODE arg,Num *rp)
{
  struct oNODE arg0;
  Num a,a1;

  a = (Num)ARG0(arg);
  if ( !a ) *rp = (Num)ONE;
  else if ( INT(a) ) Pfac(arg,rp);
  else {
    addnum(0,a,(Num)ONE,&a1);
    arg0.body = (pointer)a1;
    arg0.next = arg->next;
    Pmpfr_gamma(&arg0,rp);
  }
}
*/
static
void Pitvd_pow(NODE arg,Num *rp)
{
  Num ii, ss;
  IntervalDouble c;
  Num rpbf;
  double inf, sup;

  Pitvbf_pow(arg, &rpbf);
  itvtois((Itv)rpbf, &ii, &ss);
  inf = toRealDown(ii);
  sup = toRealUp(ss);
  MKIntervalDouble(inf,sup,c);
  *rp = (Num)c;
}

static
void Pitvbf_pow(NODE arg,Num *rp)
{
  Num a,e;
  BF r,re,im;
  C c;
  mpc_t mpc,a1,e1;
  int prec;

  prec = NEXT(NEXT(arg)) ? ZTOS((Q)ARG2(arg)) : mpfr_get_default_prec();
  a = ARG0(arg);
  e = ARG1(arg);
  if ( !e ) {
    *rp = (Num)ONE;
  } else if ( !a ) {
    *rp = 0;
  } else if ( NID(a) == N_C || NID(e) == N_C ) {
    error("itv_pow() : not support args");
    *rp = 0;
  } else {
    Num ii, ss;
    Itv c;
    BF inf, sup;
    mpfi_t a_val, e_val, rv;

    mpfi_init2(rv,prec);

    itvtois((Itv)a, &ii, &ss);
    inf = (BF)tobf(ii, prec);
    sup = (BF)tobf(ss, prec);
    mpfi_init2(a_val,prec);
    mpfr_set(&(a_val->left),  BDY(inf), MPFR_RNDD);
    mpfr_set(&(a_val->right), BDY(sup), MPFR_RNDU);

    itvtois((Itv)e, &ii, &ss);
    inf = (BF)tobf(ii, prec);
    sup = (BF)tobf(ss, prec);
    mpfi_init2(e_val,prec);
    mpfr_set(&(e_val->left),  BDY(inf), MPFR_RNDD);
    mpfr_set(&(e_val->right), BDY(sup), MPFR_RNDU);


    mpfi_log(rv, a_val);
    mpfi_mul(a_val, rv, e_val);
    mpfi_exp(rv, a_val);

    MPFRTOBF(&(rv->left), inf);
    MPFRTOBF(&(rv->right), sup);
 
    if ( !cmpbf((Num)inf,0) ) inf = 0;
    if ( !cmpbf((Num)sup,0) ) sup = 0;

    if ( inf || sup ) {
      istoitv((Num)inf, (Num)sup, &c);
    } else {
      c = 0;
    }
    *rp = (Num)c;
  //mpfi_clear(rv);
    mpfi_clear(a_val);
    mpfi_clear(e_val);
  }
}

static void Pitv_pi(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_pi(arg, rp);
  else
	Pitvd_pi(arg, rp);
}

static void Pitv_e(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_e(arg, rp);
  else
	Pitvd_e(arg, rp);
}

static void Pitv_sin(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_sin(arg, rp);
  else
	Pitvd_sin(arg, rp);
}

static void Pitv_cos(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_cos(arg, rp);
  else
	Pitvd_cos(arg, rp);
}

static void Pitv_tan(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_tan(arg, rp);
  else
	Pitvd_tan(arg, rp);
}

static void Pitv_asin(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_asin(arg, rp);
  else
	Pitvd_asin(arg, rp);
}

static void Pitv_acos(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_acos(arg, rp);
  else
	Pitvd_acos(arg, rp);
}

static void Pitv_atan(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_atan(arg, rp);
  else
	Pitvd_atan(arg, rp);
}

static void Pitv_sinh(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_sinh(arg, rp);
  else
	Pitvd_sinh(arg, rp);
}

static void Pitv_cosh(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_cosh(arg, rp);
  else
	Pitvd_cosh(arg, rp);
}

static void Pitv_tanh(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_tanh(arg, rp);
  else
	Pitvd_tanh(arg, rp);
}

static void Pitv_asinh(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_asinh(arg, rp);
  else
	Pitvd_asinh(arg, rp);
}

static void Pitv_acosh(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_acosh(arg, rp);
  else
	Pitvd_acosh(arg, rp);
}

static void Pitv_atanh(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_atanh(arg, rp);
  else
	Pitvd_atanh(arg, rp);
}

static void Pitv_exp(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_exp(arg, rp);
  else
	Pitvd_exp(arg, rp);
}

static void Pitv_log(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_log(arg, rp);
  else
	Pitvd_log(arg, rp);
}

static void Pitv_abs(NODE arg, Obj *rp)
{
  if ( bigfloat )
	Pitvbf_abs(arg, rp);
  else
	Pitvd_abs(arg, rp);
}

static void Pitv_pow(NODE arg, Num *rp)
{
  if ( bigfloat )
	Pitvbf_pow(arg, rp);
  else
	Pitvd_pow(arg, rp);
}

#endif