| version 1.1, 2000/12/22 09:58:32 |
version 1.4, 2005/02/08 16:53:00 |
|
|
| /* |
/* |
| * $OpenXM: $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/itvnum.c,v 1.3 2005/02/08 16:42:39 saito Exp $ |
| */ |
*/ |
| |
|
| #include "ca.h" |
#include "ca.h" |
| Line 21 static void Pcup(NODE, Obj *); |
|
| Line 21 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(Obj *); |
static void Pitvversion(Q *); |
| #endif |
#endif |
| static void Pprintmode(NODE, Obj *); |
static void Pprintmode(NODE, Obj *); |
| |
|
| Line 56 struct ftab interval_tab[] = { |
|
| Line 56 struct ftab interval_tab[] = { |
|
| |
|
| #if defined(INTERVAL) |
#if defined(INTERVAL) |
| static void |
static void |
| Pitvversion(Obj *rp) |
Pitvversion(Q *rp) |
| { |
{ |
| STOQ(ASIR_VERSION,(Q)*rp); |
STOQ(ASIR_VERSION, *rp); |
| } |
} |
| |
|
| extern int bigfloat; |
extern int bigfloat; |
| Line 86 Pitv(NODE arg, Obj *rp) |
|
| Line 86 Pitv(NODE arg, Obj *rp) |
|
| *rp = 0; |
*rp = 0; |
| return; |
return; |
| } |
} |
| else if ( NID(a) == N_IP || NID(a) == N_IF) { |
else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat) { |
| *rp = (Obj)a; |
*rp = (Obj)a; |
| return; |
return; |
| } |
} |
| else if ( NID(a) == N_ID ) { |
else if ( NID(a) == N_IntervalDouble ) { |
| inf = INF((ItvD)a); |
inf = INF((IntervalDouble)a); |
| sup = SUP((ItvD)a); |
sup = SUP((IntervalDouble)a); |
| double2bf(inf, (BF *)&i); |
double2bf(inf, (BF *)&i); |
| double2bf(sup, (BF *)&s); |
double2bf(sup, (BF *)&s); |
| istoitv(i,s,&c); |
istoitv(i,s,&c); |
| } |
} |
| else istoitv(a,a,&c); |
else istoitv(a,a,&c); |
| } |
} |
| if ( NID( c ) == N_IF ) addulp((ItvF)c, (ItvF *)rp); |
if ( NID( c ) == N_IntervalBigFloat ) |
| |
addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp); |
| else *rp = (Obj)c; |
else *rp = (Obj)c; |
| #endif |
#endif |
| } |
} |
| Line 132 Pitvbf(NODE arg, Obj *rp) |
|
| Line 133 Pitvbf(NODE arg, Obj *rp) |
|
| ToBf(s, &ss); |
ToBf(s, &ss); |
| istoitv((Num)ii,(Num)ss,&c); |
istoitv((Num)ii,(Num)ss,&c); |
| } |
} |
| else if ( NID(a) == N_IF) { |
else if ( NID(a) == N_IntervalBigFloat) { |
| *rp = (Obj)a; |
*rp = (Obj)a; |
| return; |
return; |
| } |
} |
| else if ( NID(a) == N_ID ) { |
else if ( NID(a) == N_IntervalDouble ) { |
| inf = INF((ItvD)a); |
inf = INF((IntervalDouble)a); |
| sup = SUP((ItvD)a); |
sup = SUP((IntervalDouble)a); |
| double2bf(inf, (BF *)&i); |
double2bf(inf, (BF *)&i); |
| double2bf(sup, (BF *)&s); |
double2bf(sup, (BF *)&s); |
| istoitv(i,s,&c); |
istoitv(i,s,&c); |
| Line 148 Pitvbf(NODE arg, Obj *rp) |
|
| Line 149 Pitvbf(NODE arg, Obj *rp) |
|
| istoitv(i,i,&c); |
istoitv(i,i,&c); |
| } |
} |
| } |
} |
| if ( c && OID( c ) == O_N && NID( c ) == N_IF ) addulp((ItvF)c, (ItvF *)rp); |
if ( c && OID( c ) == O_N && NID( c ) == N_IntervalBigFloat ) |
| |
addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp); |
| else *rp = (Obj)c; |
else *rp = (Obj)c; |
| } |
} |
| |
|
| Line 158 Pitvd(NODE arg, Obj *rp) |
|
| Line 160 Pitvd(NODE arg, Obj *rp) |
|
| double inf, sup; |
double inf, sup; |
| Num a, a0, a1, t; |
Num a, a0, a1, t; |
| Itv ia; |
Itv ia; |
| ItvD d; |
IntervalDouble d; |
| |
|
| asir_assert(ARG0(arg),O_N,"intvald"); |
asir_assert(ARG0(arg),O_N,"intvald"); |
| a0 = (Num)ARG0(arg); |
a0 = (Num)ARG0(arg); |
| Line 166 Pitvd(NODE arg, Obj *rp) |
|
| Line 168 Pitvd(NODE arg, Obj *rp) |
|
| asir_assert(ARG1(arg),O_N,"intvald"); |
asir_assert(ARG1(arg),O_N,"intvald"); |
| a1 = (Num)ARG1(arg); |
a1 = (Num)ARG1(arg); |
| } else { |
} else { |
| if ( a0 && OID(a0)==O_N && NID(a0)==N_ID ) { |
if ( a0 && OID(a0)==O_N && NID(a0)==N_IntervalDouble ) { |
| inf = INF((ItvD)a0); |
inf = INF((IntervalDouble)a0); |
| sup = SUP((ItvD)a0); |
sup = SUP((IntervalDouble)a0); |
| MKItvD(inf,sup,d); |
MKIntervalDouble(inf,sup,d); |
| *rp = (Obj)d; |
*rp = (Obj)d; |
| return; |
return; |
| } |
} |
| Line 180 Pitvd(NODE arg, Obj *rp) |
|
| Line 182 Pitvd(NODE arg, Obj *rp) |
|
| } |
} |
| inf = ToRealDown(a0); |
inf = ToRealDown(a0); |
| sup = ToRealUp(a1); |
sup = ToRealUp(a1); |
| MKItvD(inf,sup,d); |
MKIntervalDouble(inf,sup,d); |
| *rp = (Obj)d; |
*rp = (Obj)d; |
| } |
} |
| |
|
| Line 196 Pinf(NODE arg, Obj *rp) |
|
| Line 198 Pinf(NODE arg, Obj *rp) |
|
| *rp = 0; |
*rp = 0; |
| } else if ( OID(a) == O_N ) { |
} else if ( OID(a) == O_N ) { |
| switch ( NID(a) ) { |
switch ( NID(a) ) { |
| case N_ID: |
case N_IntervalDouble: |
| d = INF((ItvD)a); |
d = INF((IntervalDouble)a); |
| MKReal(d, r); |
MKReal(d, r); |
| *rp = (Obj)r; |
*rp = (Obj)r; |
| break; |
break; |
| case N_IP: |
case N_IP: |
| case N_IF: |
case N_IntervalBigFloat: |
| case N_IT: |
case N_IntervalQuad: |
| itvtois((Itv)ARG0(arg),&i,&s); |
itvtois((Itv)ARG0(arg),&i,&s); |
| *rp = (Obj)i; |
*rp = (Obj)i; |
| break; |
break; |
| Line 228 Psup(NODE arg, Obj *rp) |
|
| Line 230 Psup(NODE arg, Obj *rp) |
|
| *rp = 0; |
*rp = 0; |
| } else if ( OID(a) == O_N ) { |
} else if ( OID(a) == O_N ) { |
| switch ( NID(a) ) { |
switch ( NID(a) ) { |
| case N_ID: |
case N_IntervalDouble: |
| d = SUP((ItvD)a); |
d = SUP((IntervalDouble)a); |
| MKReal(d, r); |
MKReal(d, r); |
| *rp = (Obj)r; |
*rp = (Obj)r; |
| break; |
break; |
| case N_IP: |
case N_IP: |
| case N_IF: |
case N_IntervalBigFloat: |
| case N_IT: |
case N_IntervalQuad: |
| itvtois((Itv)ARG0(arg),&i,&s); |
itvtois((Itv)ARG0(arg),&i,&s); |
| *rp = (Obj)s; |
*rp = (Obj)s; |
| break; |
break; |
| Line 260 Pmid(NODE arg, Obj *rp) |
|
| Line 262 Pmid(NODE arg, Obj *rp) |
|
| *rp = 0; |
*rp = 0; |
| } else switch (OID(a)) { |
} else switch (OID(a)) { |
| case O_N: |
case O_N: |
| if ( NID(a) == N_ID ) { |
if ( NID(a) == N_IntervalDouble ) { |
| d = ( INF((ItvD)a)+SUP((ItvD)a) ) / 2.0; |
d = ( INF((IntervalDouble)a)+SUP((IntervalDouble)a) ) / 2.0; |
| MKReal(d, r); |
MKReal(d, r); |
| *rp = (Obj)r; |
*rp = (Obj)r; |
| } else if ( NID(a) == N_IT ) { |
} else if ( NID(a) == N_IntervalQuad ) { |
| error("mid: not supported operation"); |
error("mid: not supported operation"); |
| *rp = 0; |
*rp = 0; |
| } else if ( NID(a) == N_IP || NID(a) == N_IF ) { |
} else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat ) { |
| miditvp((Itv)ARG0(arg),&s); |
miditvp((Itv)ARG0(arg),&s); |
| *rp = (Obj)s; |
*rp = (Obj)s; |
| } else { |
} else { |
| Line 297 Pcup(NODE arg, Obj *rp) |
|
| Line 299 Pcup(NODE arg, Obj *rp) |
|
| asir_assert(ARG1(arg),O_N,"cup"); |
asir_assert(ARG1(arg),O_N,"cup"); |
| a = (Num)ARG0(arg); |
a = (Num)ARG0(arg); |
| b = (Num)ARG1(arg); |
b = (Num)ARG1(arg); |
| if ( a && NID(a) == N_ID && b && NID(b) == N_ID ) { |
if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) { |
| cupitvd((ItvD)a, (ItvD)b, (ItvD *)rp); |
cupitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp); |
| } else { |
} else { |
| cupitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s); |
cupitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s); |
| *rp = (Obj)s; |
*rp = (Obj)s; |
| Line 315 Pcap(NODE arg, Obj *rp) |
|
| Line 317 Pcap(NODE arg, Obj *rp) |
|
| asir_assert(ARG1(arg),O_N,"cap"); |
asir_assert(ARG1(arg),O_N,"cap"); |
| a = (Num)ARG0(arg); |
a = (Num)ARG0(arg); |
| b = (Num)ARG1(arg); |
b = (Num)ARG1(arg); |
| if ( a && NID(a) == N_ID && b && NID(b) == N_ID ) { |
if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) { |
| capitvd((ItvD)a, (ItvD)b, (ItvD *)rp); |
capitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp); |
| } else { |
} else { |
| capitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s); |
capitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s); |
| *rp = (Obj)s; |
*rp = (Obj)s; |
|
|
| a = (Num)ARG0(arg); |
a = (Num)ARG0(arg); |
| if ( ! a ) { |
if ( ! a ) { |
| *rp = 0; |
*rp = 0; |
| } else if ( NID(a) == N_ID ) { |
} else if ( NID(a) == N_IntervalDouble ) { |
| widthitvd((ItvD)a, (Num *)rp); |
widthitvd((IntervalDouble)a, (Num *)rp); |
| } else { |
} else { |
| widthitvp((Itv)ARG0(arg),&s); |
widthitvp((Itv)ARG0(arg),&s); |
| *rp = (Obj)s; |
*rp = (Obj)s; |
|
|
| a = (Num)ARG0(arg); |
a = (Num)ARG0(arg); |
| if ( ! a ) { |
if ( ! a ) { |
| *rp = 0; |
*rp = 0; |
| } else if ( NID(a) == N_ID ) { |
} else if ( NID(a) == N_IntervalDouble ) { |
| absitvd((ItvD)a, (Num *)rp); |
absitvd((IntervalDouble)a, (Num *)rp); |
| } else { |
} else { |
| absitvp((Itv)ARG0(arg),&s); |
absitvp((Itv)ARG0(arg),&s); |
| *rp = (Obj)s; |
*rp = (Obj)s; |
|
|
| asir_assert(ARG1(arg),O_N,"distance"); |
asir_assert(ARG1(arg),O_N,"distance"); |
| a = (Num)ARG0(arg); |
a = (Num)ARG0(arg); |
| b = (Num)ARG1(arg); |
b = (Num)ARG1(arg); |
| if ( a && NID(a) == N_ID && b && NID(b) == N_ID ) { |
if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) { |
| distanceitvd((ItvD)a, (ItvD)b, (Num *)rp); |
distanceitvd((IntervalDouble)a, (IntervalDouble)b, (Num *)rp); |
| } else { |
} else { |
| distanceitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s); |
distanceitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s); |
| *rp = (Obj)s; |
*rp = (Obj)s; |
|
|
| if ( ! ARG0(arg) ) s = 1; |
if ( ! ARG0(arg) ) s = 1; |
| else s = 0; |
else s = 0; |
| } |
} |
| else if ( NID(ARG1(arg)) == N_ID ) { |
else if ( NID(ARG1(arg)) == N_IntervalDouble ) { |
| s = initvd((Num)ARG0(arg),(ItvD)ARG1(arg)); |
s = initvd((Num)ARG0(arg),(IntervalDouble)ARG1(arg)); |
| |
|
| } else if ( NID(ARG1(arg)) == N_IP || NID(ARG1(arg)) == N_IF ) { |
} else if ( NID(ARG1(arg)) == N_IP || NID(ARG1(arg)) == N_IntervalBigFloat ) { |
| if ( ! ARG0(arg) ) s = initvp((Num)ARG0(arg),(Itv)ARG1(arg)); |
if ( ! ARG0(arg) ) s = initvp((Num)ARG0(arg),(Itv)ARG1(arg)); |
| else if ( NID(ARG0(arg)) == N_IP ) { |
else if ( NID(ARG0(arg)) == N_IP ) { |
| s = itvinitvp((Itv)ARG0(arg),(Itv)ARG1(arg)); |
s = itvinitvp((Itv)ARG0(arg),(Itv)ARG1(arg)); |