version 1.1, 2018/09/19 05:45:06 |
version 1.4, 2019/10/17 03:03:12 |
|
|
/* |
/* |
* $OpenXM$ |
* $OpenXM: OpenXM_contrib2/asir2018/builtin/itvnum.c,v 1.3 2019/06/04 07:11:23 kondoh Exp $ |
*/ |
*/ |
|
|
#include "ca.h" |
#include "ca.h" |
|
|
#include "../plot/ifplot.h" |
#include "../plot/ifplot.h" |
#endif |
#endif |
|
|
#if defined(INTERVAL) |
// in engine/bf.c |
|
Num tobf(Num,int); |
|
|
|
#if defined(INTERVAL) |
static void Pitv(NODE, Obj *); |
static void Pitv(NODE, Obj *); |
static void Pitvd(NODE, Obj *); |
static void Pitvd(NODE, Obj *); |
static void Pitvbf(NODE, Obj *); |
static void Pitvbf(NODE, Obj *); |
Line 24 static void Pcup(NODE, Obj *); |
|
Line 26 static void Pcup(NODE, Obj *); |
|
static void Pcap(NODE, Obj *); |
static void Pcap(NODE, Obj *); |
static void Pwidth(NODE, Obj *); |
static void Pwidth(NODE, Obj *); |
static void Pdistance(NODE, Obj *); |
static void Pdistance(NODE, Obj *); |
static void Pitvversion(Q *); |
static void Pitvversion(NODE, Q *); |
void miditvp(Itv,Num *); |
static void PzeroRewriteMode(NODE, Obj *); |
void absitvp(Itv,Num *); |
static void PzeroRewriteCountClear(NODE, Obj *); |
int initvd(Num,IntervalDouble); |
static void PzeroRewriteCount(NODE, Obj *); |
int initvp(Num,Itv); |
//void miditvp(Itv,Num *); |
int itvinitvp(Itv,Itv); |
//void absitvp(Itv,Num *); |
|
//int initvd(Num,IntervalDouble); |
|
//int initvp(Num,Itv); |
|
//int itvinitvp(Itv,Itv); |
#endif |
#endif |
static void Pprintmode(NODE, Obj *); |
static void Pprintmode(NODE, Obj *); |
|
|
Line 61 struct ftab interval_tab[] = { |
|
Line 66 struct ftab interval_tab[] = { |
|
{"width",Pwidth,1}, |
{"width",Pwidth,1}, |
{"diam",Pwidth,1}, |
{"diam",Pwidth,1}, |
{"distance",Pdistance,2}, |
{"distance",Pdistance,2}, |
{"iversion",Pitvversion,0}, |
{"iversion",Pitvversion,-1}, |
|
{"intvalversion",Pitvversion,-1}, |
|
{"zerorewritemode",PzeroRewriteMode,-1}, |
|
{"zeroRewriteMode",PzeroRewriteMode,-1}, |
|
{"zeroRewriteCountClear",PzeroRewriteCountClear,-1}, |
|
{"zeroRewriteCount",PzeroRewriteCount,-1}, |
/* plot time check */ |
/* plot time check */ |
{"ifcheck",Pifcheck,-7}, |
{"ifcheck",Pifcheck,-7}, |
#endif |
#endif |
{0,0,0}, |
{0,0,0}, |
}; |
}; |
|
|
|
extern int mpfr_roundmode; |
|
|
#if defined(INTERVAL) |
#if defined(INTERVAL) |
|
|
/* plot time check */ |
/* plot time check */ |
static void |
static void |
Pifcheck(NODE arg, Obj *rp) |
Pifcheck(NODE arg, Obj *rp) |
{ |
{ |
Q m2,p2,s_id; |
Z m2,p2,s_id; |
NODE defrange; |
NODE defrange; |
LIST xrange,yrange,range[2],list,geom; |
LIST xrange,yrange,range[2],list,geom; |
VL vl,vl0; |
VL vl,vl0; |
Line 89 Pifcheck(NODE arg, Obj *rp) |
|
Line 101 Pifcheck(NODE arg, Obj *rp) |
|
MAT m; |
MAT m; |
pointer **mb; |
pointer **mb; |
double **tabe, *px, *px1, *px2; |
double **tabe, *px, *px1, *px2; |
Q one; |
Z one; |
int width, height, ix, iy; |
int width, height, ix, iy; |
int id; |
int id; |
|
|
STOQ(-2,m2); STOQ(2,p2); |
STOZ(-2,m2); STOZ(2,p2); |
STOQ(1,one); |
STOZ(1,one); |
MKNODE(n,p2,0); MKNODE(defrange,m2,n); |
MKNODE(n,p2,0); MKNODE(defrange,m2,n); |
poly = 0; vl = 0; geom = 0; ri = 0; |
poly = 0; vl = 0; geom = 0; ri = 0; |
v[0] = v[1] = 0; |
v[0] = v[1] = 0; |
Line 164 Pifcheck(NODE arg, Obj *rp) |
|
Line 176 Pifcheck(NODE arg, Obj *rp) |
|
can->width = 300; |
can->width = 300; |
can->height = 300; |
can->height = 300; |
} else { |
} else { |
can->width = QTOS((Q)BDY(BDY(geom))); |
can->width = ZTOS((Z)BDY(BDY(geom))); |
can->height = QTOS((Q)BDY(NEXT(BDY(geom)))); |
can->height = ZTOS((Z)BDY(NEXT(BDY(geom)))); |
width = can->width; |
width = can->width; |
height = can->height; |
height = can->height; |
} |
} |
Line 235 void ccalc(double **tab,struct canvas *can,int nox) |
|
Line 247 void ccalc(double **tab,struct canvas *can,int nox) |
|
/* end plot time check */ |
/* end plot time check */ |
|
|
static void |
static void |
Pitvversion(Q *rp) |
Pitvversion(NODE arg, Q *rp) |
{ |
{ |
STOQ(ASIR_VERSION, *rp); |
Z r; |
|
STOZ(INT_ASIR_VERSION, r); |
|
*rp = (Q)r; |
} |
} |
|
|
extern int bigfloat; |
extern int bigfloat; |
|
|
Pitvbf(NODE arg, Obj *rp) |
Pitvbf(NODE arg, Obj *rp) |
{ |
{ |
Num a, i, s; |
Num a, i, s; |
Itv c; |
IntervalBigFloat c; |
BF ii,ss; |
Num ii,ss; |
|
Real di, ds; |
double inf, sup; |
double inf, sup; |
|
int current_roundmode; |
|
|
asir_assert(ARG0(arg),O_N,"intvalbf"); |
asir_assert(ARG0(arg),O_N,"intvalbf"); |
a = (Num)ARG0(arg); |
a = (Num)ARG0(arg); |
if ( argc(arg) > 1 ) { |
if ( argc(arg) > 1 ) { |
asir_assert(ARG1(arg),O_N,"intvalbf"); |
asir_assert(ARG1(arg),O_N,"intvalbf"); |
|
|
i = (Num)ARG0(arg); |
i = (Num)ARG0(arg); |
s = (Num)ARG1(arg); |
s = (Num)ARG1(arg); |
ToBf(i, &ii); |
current_roundmode = mpfr_roundmode; |
ToBf(s, &ss); |
mpfr_roundmode = MPFR_RNDD; |
istoitv((Num)ii,(Num)ss,&c); |
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 { |
} else { |
if ( ! a ) { |
if ( ! a ) { |
*rp = 0; |
*rp = 0; |
Line 308 Pitvbf(NODE arg, Obj *rp) |
|
Line 331 Pitvbf(NODE arg, Obj *rp) |
|
} |
} |
else if ( NID(a) == N_IP ) { |
else if ( NID(a) == N_IP ) { |
itvtois((Itv)a, &i, &s); |
itvtois((Itv)a, &i, &s); |
ToBf(i, &ii); |
current_roundmode = mpfr_roundmode; |
ToBf(s, &ss); |
mpfr_roundmode = MPFR_RNDD; |
istoitv((Num)ii,(Num)ss,&c); |
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) { |
else if ( NID(a) == N_IntervalBigFloat) { |
*rp = (Obj)a; |
*rp = (Obj)a; |
Line 319 Pitvbf(NODE arg, Obj *rp) |
|
Line 347 Pitvbf(NODE arg, Obj *rp) |
|
else if ( NID(a) == N_IntervalDouble ) { |
else if ( NID(a) == N_IntervalDouble ) { |
inf = INF((IntervalDouble)a); |
inf = INF((IntervalDouble)a); |
sup = SUP((IntervalDouble)a); |
sup = SUP((IntervalDouble)a); |
double2bf(inf, (BF *)&i); |
current_roundmode = mpfr_roundmode; |
double2bf(sup, (BF *)&s); |
//double2bf(inf, (BF *)&i); |
istoitv(i,s,&c); |
//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 { |
else { |
ToBf(a, (BF *)&i); |
current_roundmode = mpfr_roundmode; |
istoitv(i,i,&c); |
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 ) |
// if ( c && OID( c ) == O_N && NID( c ) == N_IntervalBigFloat ) |
addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp); |
// addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp); |
else *rp = (Obj)c; |
// else *rp = (Obj)c; |
|
*rp = (Obj)c; |
} |
} |
|
|
static void |
static void |
|
|
} |
} |
|
|
static void |
static void |
Pinitv(arg,rp) |
Pinitv(NODE arg, Obj *rp) |
NODE arg; |
|
Obj *rp; |
|
{ |
{ |
int s; |
int s; |
Q q; |
Z q; |
|
|
asir_assert(ARG0(arg),O_N,"intval"); |
asir_assert(ARG0(arg),O_N,"intval"); |
asir_assert(ARG1(arg),O_N,"intval"); |
asir_assert(ARG1(arg),O_N,"intval"); |
|
|
} else { |
} else { |
s = ! compnum(0,(Num)ARG0(arg),(Num)ARG1(arg)); |
s = ! compnum(0,(Num)ARG0(arg),(Num)ARG1(arg)); |
} |
} |
STOQ(s,q); |
STOZ(s,q); |
*rp = (Obj)q; |
*rp = (Obj)q; |
} |
} |
|
|
|
|
else *rp = (Obj)ONE; |
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 |
#endif |
extern int printmode; |
extern int printmode; |
|
|
Line 641 Pprintmode(NODE arg, Obj *rp) |
|
Line 730 Pprintmode(NODE arg, Obj *rp) |
|
|
|
a = (Z)ARG0(arg); |
a = (Z)ARG0(arg); |
if(!a||(NUM(a)&&INT(a))){ |
if(!a||(NUM(a)&&INT(a))){ |
l=QTOS(a); |
l=ZTOS(a); |
if ( l < 0 ) l = 0; |
if ( l < 0 ) l = 0; |
#if defined(INTERVAL) |
#if defined(INTERVAL) |
else if ( l > MID_PRINTF_E ) l = 0; |
else if ( l > MID_PRINTF_E ) l = 0; |
#else |
#else |
else if ( l > PRINTF_E ) l = 0; |
else if ( l > PRINTF_E ) l = 0; |
#endif |
#endif |
STOQ(printmode,r); |
STOZ(printmode,r); |
*rp = (Obj)r; |
*rp = (Obj)r; |
printmode = l; |
printmode = l; |
pprintmode(); |
pprintmode(); |