version 1.4, 2019/10/17 03:03:12 |
version 1.6, 2019/12/24 10:26:38 |
|
|
/* |
/* |
* $OpenXM: OpenXM_contrib2/asir2018/builtin/itvnum.c,v 1.3 2019/06/04 07:11:23 kondoh Exp $ |
* $OpenXM: OpenXM_contrib2/asir2018/builtin/itvnum.c,v 1.5 2019/11/12 10:53:22 kondoh Exp $ |
*/ |
*/ |
|
|
#include "ca.h" |
#include "ca.h" |
|
|
#include "../plot/ifplot.h" |
#include "../plot/ifplot.h" |
#endif |
#endif |
|
|
|
#include <mpfr.h> |
|
#include <mpfi.h> |
// in engine/bf.c |
// in engine/bf.c |
Num tobf(Num,int); |
Num tobf(Num,int); |
|
|
Line 35 static void PzeroRewriteCount(NODE, Obj *); |
|
Line 37 static void PzeroRewriteCount(NODE, Obj *); |
|
//int initvd(Num,IntervalDouble); |
//int initvd(Num,IntervalDouble); |
//int initvp(Num,Itv); |
//int initvp(Num,Itv); |
//int itvinitvp(Itv,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 |
#endif |
static void Pprintmode(NODE, Obj *); |
static void Pprintmode(NODE, Obj *); |
|
|
Line 58 struct ftab interval_tab[] = { |
|
Line 120 struct ftab interval_tab[] = { |
|
{"inf",Pinf,1}, |
{"inf",Pinf,1}, |
{"sup",Psup,1}, |
{"sup",Psup,1}, |
{"absintval",Pabsitv,1}, |
{"absintval",Pabsitv,1}, |
|
{"absitv",Pabsitv,1}, |
{"disintval",Pdisjitv,2}, |
{"disintval",Pdisjitv,2}, |
{"inintval",Pinitv,2}, |
{"inintval",Pinitv,2}, |
{"cup",Pcup,2}, |
{"cup",Pcup,2}, |
Line 72 struct ftab interval_tab[] = { |
|
Line 135 struct ftab interval_tab[] = { |
|
{"zeroRewriteMode",PzeroRewriteMode,-1}, |
{"zeroRewriteMode",PzeroRewriteMode,-1}, |
{"zeroRewriteCountClear",PzeroRewriteCountClear,-1}, |
{"zeroRewriteCountClear",PzeroRewriteCountClear,-1}, |
{"zeroRewriteCount",PzeroRewriteCount,-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 */ |
/* plot time check */ |
{"ifcheck",Pifcheck,-7}, |
{"ifcheck",Pifcheck,-7}, |
#endif |
#endif |
Line 404 Pitvd(NODE arg, Obj *rp) |
|
Line 535 Pitvd(NODE arg, Obj *rp) |
|
if ( compnum(0,a0,a1) > 0 ) { |
if ( compnum(0,a0,a1) > 0 ) { |
t = a0; a0 = a1; a1 = t; |
t = a0; a0 = a1; a1 = t; |
} |
} |
inf = ToRealDown(a0); |
inf = toRealDown(a0); |
sup = ToRealUp(a1); |
sup = toRealUp(a1); |
MKIntervalDouble(inf,sup,d); |
MKIntervalDouble(inf,sup,d); |
*rp = (Obj)d; |
*rp = (Obj)d; |
} |
} |
Line 745 Pprintmode(NODE arg, Obj *rp) |
|
Line 876 Pprintmode(NODE arg, Obj *rp) |
|
*rp = 0; |
*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 |