| version 1.2, 2018/09/28 08:20:27 |
version 1.4, 2019/10/17 03:03:12 |
|
|
| /* |
/* |
| * $OpenXM: OpenXM_contrib2/asir2018/builtin/itvnum.c,v 1.1 2018/09/19 05:45:06 noro Exp $ |
* $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; |
| |
|
| 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 = ZTOS((Q)BDY(BDY(geom))); |
can->width = ZTOS((Z)BDY(BDY(geom))); |
| can->height = ZTOS((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) |
| { |
{ |
| STOZ(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"); |
|
|
| if ( ! s ) *rp = 0; |
if ( ! s ) *rp = 0; |
| 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; |