version 1.1, 2000/12/22 09:58:32 |
version 1.5, 2005/07/14 22:46:03 |
|
|
/* |
/* |
* $OpenXM: $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/itvnum.c,v 1.4 2005/02/08 16:53:00 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; |
defaults: |
default: |
*rp = (Obj)a; |
*rp = (Obj)a; |
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; |
defaults: |
default: |
*rp = (Obj)a; |
*rp = (Obj)a; |
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 281 Pmid(NODE arg, Obj *rp) |
|
Line 283 Pmid(NODE arg, Obj *rp) |
|
case O_VECT: |
case O_VECT: |
case O_MAT: |
case O_MAT: |
#endif |
#endif |
defaults: |
default: |
*rp = (Obj)a; |
*rp = (Obj)a; |
break; |
break; |
} |
} |
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)); |