![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to f-itv.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / engine|
Return to f-itv.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / engine |
1.1 saito 1: /*
1.4 ! kondoh 2: * $OpenXM: OpenXM_contrib2/asir2000/engine/f-itv.c,v 1.3 2003/02/14 22:29:08 ohara Exp $
1.1 saito 3: */
4: #if defined(INTERVAL)
5: #include "ca.h"
6: #include "base.h"
1.3 ohara 7: #if defined(PARI)
1.1 saito 8: #include "genpari.h"
9: #include "itv-pari.h"
10: extern long prec;
11: #endif
12:
13: void ToBf(Num a, BF *rp)
14: {
15: GEN pa, pb, pc;
16: BF bn, bd;
17: BF c;
18: long ltop, lbot;
19:
20: if ( ! a ) {
21: *rp = 0;
22: }
23: else switch ( NID(a) ) {
24: case N_Q:
25: ltop = avma;
26: ritopa_i(NM((Q)a), SGN((Q)a), &pa);
27: pb = cgetr(prec);
28: mpaff(pa, pb);
29: if ( INT((Q)a) ) {
30: lbot = avma;
31: pb = gerepile(ltop, lbot, pb);
32: patori(pb, &c);
33: cgiv(pb);
34: *rp = c;
35: } else {
36: patori(pb, &bn);
37: ritopa_i(DN((Q)a), 1, &pa);
38: pb = cgetr(prec);
39: mpaff(pa, pb);
40: lbot = avma;
41: pb = gerepile(ltop, lbot, pb);
42: patori(pb, &bd);
43: cgiv(pb);
44: divbf((Num)bn,(Num)bd, (Num *)&c);
45: *rp = c;
46: }
47: break;
48: case N_R:
49: pb = dbltor(BDY((Real)a));
50: patori(pb, &c);
51: cgiv(pb);
52: *rp = c;
53: break;
54: case N_B:
55: *rp = (BF)a;
56: break;
57: default:
58: error("ToBf : not implemented");
59: break;
60: }
61: }
62:
63: void double2bf(double d, BF *rp)
64: {
65: GEN p;
66:
67: p = dbltor(d);
68: patori(p, rp);
69: cgiv(p);
70: }
71:
72: double bf2double(BF a)
73: {
74: GEN p;
75:
76: ritopa(a, &p);
77: return rtodbl(p);
78: }
79:
80: void getulp(BF a, BF *au)
81: {
82: GEN b, c;
83: long lb, i;
84:
85: ritopa(a, &b);
86: lb = lg(b);
87: c = cgetr(lb);
88: c[1] = b[1];
89: for (i=2;i<lb-1;i++) c[i] = 0;
90: c[i] = 1;
91: setsigne(c, 1);
92: patori(c,au);
93: cgiv(c);
94: cgiv(b);
95: }
96:
1.2 kondoh 97: void addulp(IntervalBigFloat a, IntervalBigFloat *c)
1.1 saito 98: {
99: Num ai, as, aiu, asu, inf, sup;
100:
101: itvtois((Itv)a,&ai,&as);
102: if ( ai ) {
103: getulp((BF)ai, (BF *)&aiu);
104: subbf(ai,aiu,&inf);
105: } else inf = ai;
106: if ( as ) {
107: getulp((BF)as, (BF *)&asu);
108: addbf(as,asu,&sup);
109: } else sup = as;
110: istoitv(inf,sup, (Itv *)c);
111: }
112:
1.2 kondoh 113: void additvf(IntervalBigFloat a, IntervalBigFloat b, IntervalBigFloat *c)
1.1 saito 114: {
115: Num ai,as,bi,bs,mas,mbs,tmp;
116: Num inf,sup;
117: GEN pa, pb, z;
118: long ltop, lbot;
119:
120: if ( !a )
121: *c = b;
122: else if ( !b )
123: *c = a;
124: else if ( (NID(a) <= N_B) && (NID(b) <= N_B ) )
125: addnum(0,(Num)a,(Num)b,(Num *)c);
126: else {
127: itvtois((Itv)a,&inf,&sup);
128: ToBf(inf, (BF *)&ai); ToBf(sup, (BF *)&as);
129: itvtois((Itv)b,&inf,&sup);
130: ToBf(inf, (BF *)&bi); ToBf(sup, (BF *)&bs);
131: #if 0
132: printexpr(CO, ai);
133: printexpr(CO, as);
134: printexpr(CO, bi);
135: printexpr(CO, bs);
136: #endif
137:
138: #if 1
139: addnum(0,ai,bi,&inf);
140: addnum(0,as,bs,&sup);
141: istoitv(inf,sup,(Itv *)&tmp);
1.2 kondoh 142: addulp((IntervalBigFloat)tmp, c);
1.1 saito 143: return;
144: #else
145: ltop = avma;
146: ritopa(ai,&pa);
147: ritopa(bi,&pb);
148: lbot = avma;
149: z = gerepile(ltop,lbot,PariAddDown(pa,pb));
150: patori(z,&inf); cgiv(z);
151:
152: /* MUST check if ai, as, bi, bs are bigfloat. */
153:
154: /* as + bs = ( - ( (-as) + (-bs) ) ) */
155: chsgnbf(as,&mas);
156: chsgnbf(bs,&mbs);
157: ltop = avma;
158: ritopa(mas,&pa);
159: ritopa(mbs,&pb);
160: lbot = avma;
161: z = gerepile(ltop,lbot,PariAddDown(pa,pb));
162: patori(z,&tmp); cgiv(z);
163:
164: chsgnbf(tmp,&sup);
165: istoitv(inf,sup,c);
166: #endif
167: }
168: }
169:
1.2 kondoh 170: void subitvf(IntervalBigFloat a, IntervalBigFloat b, IntervalBigFloat *c)
1.1 saito 171: {
172: Num ai,as,bi,bs,mas, mbs;
173: Num inf,sup,tmp;
174: GEN pa, pb, z;
175: long ltop, lbot;
176:
177: if ( !a )
178: chsgnnum((Num)b,(Num *)c);
179: else if ( !b )
180: *c = a;
181: else if ( (NID(a) <= N_B) && (NID(b) <= N_B ) )
182: subnum(0,(Num)a,(Num)b,(Num *)c);
183: else {
184: itvtois((Itv)a,&inf,&sup);
185: ToBf(inf, (BF *)&ai); ToBf(sup, (BF *)&as);
186: itvtois((Itv)b,&inf,&sup);
187: ToBf(inf, (BF *)&bi); ToBf(sup, (BF *)&bs);
188: #if 1
189: subnum(0,ai,bs,&inf);
190: subnum(0,as,bi,&sup);
191: istoitv(inf,sup,(Itv *)&tmp);
1.2 kondoh 192: addulp((IntervalBigFloat)tmp, c);
1.1 saito 193: #else
194:
195: /* MUST check if ai, as, bi, bs are bigfloat. */
196: /* ai - bs = ai + (-bs) */
197: chsgnbf(bs,&mbs);
198: ltop = avma;
199: ritopa(ai,&pa);
200: ritopa(mbs,&pb);
201: lbot = avma;
202: z = gerepile(ltop,lbot,PariAddDown(pa,pb));
203: patori(z,&inf); cgiv(z);
204:
205: /* as - bi = ( - ( bi + (-as) ) ) */
206: chsgnbf(as,&mas);
207: ltop = avma;
208: ritopa(mas,&pa);
209: ritopa(bi,&pb);
210: lbot = avma;
211: z = gerepile(ltop,lbot,PariAddDown(pa,pb));
212: patori(z,&tmp); cgiv(z);
213:
214: chsgnbf(tmp,&sup);
215: istoitv(inf,sup,c);
216: #endif
217: }
218: }
219:
1.2 kondoh 220: void mulitvf(IntervalBigFloat a, IntervalBigFloat b, IntervalBigFloat *c)
1.1 saito 221: {
222: Num ai,as,bi,bs,a1,a2,b1,b2,c1,c2,p,t,tmp;
223: Num inf, sup;
224: int ba,bb;
225:
226: if ( !a || !b )
227: *c = 0;
228: else if ( (NID(a) <= N_B) && (NID(b) <= N_B ) )
229: mulnum(0,(Num)a,(Num)b,(Num *)c);
230: else {
231: itvtois((Itv)a,&inf,&sup);
232: ToBf(inf, (BF *)&ai); ToBf(sup, (BF *)&as);
233: itvtois((Itv)b,&inf,&sup);
234: ToBf(inf, (BF *)&bi); ToBf(sup, (BF *)&bs);
235:
236: /* MUST check if ai, as, bi, bs are bigfloat. */
237: chsgnnum(as,&a2);
238: chsgnnum(bs,&b2);
239:
240:
241: if ( ba = (compnum(0,0,a2) > 0) ) {
242: a1 = ai;
243: } else {
244: a1 = a2;
245: a2 = ai;
246: }
247: if ( bb = (compnum(0,0,b2) > 0) ) {
248: b1 = bi;
249: } else {
250: b1 = b2;
251: b2 = bi;
252: }
253: mulnum(0,a2,b2,&t);
254: subnum(0,0,t,&c2);
255: if ( compnum(0,0,b1) > 0 ) {
256: mulnum(0,a2,b1,&t);
257: subnum(0,0,t,&c1);
258: if ( compnum(0,0,a1) > 0 ) {
259: mulnum(0,a1,b2,&t);
260: subnum(0,0,t,&p);
261: if ( compnum(0,c1,p) > 0 ) c1 = p;
262: mulnum(0,a1,b1,&t);
263: subnum(0,0,t,&p);
264: if ( compnum(0,c2,p) > 0 ) c2 = p;
265: }
266: } else {
267: if ( compnum(0,0,a1) > 0 ) {
268: mulnum(0,a1,b2,&t);
269: subnum(0,0,t,&c1);
270: } else {
271: mulnum(0,a1,b1,&c1);
272: }
273: }
274: if ( ba == bb ) {
275: subnum(0,0,c2,&t);
276: istoitv(c1,t,(Itv *)&tmp);
277: } else {
278: subnum(0,0,c1,&t);
279: istoitv(c2,t,(Itv *)&tmp);
280: }
1.2 kondoh 281: addulp((IntervalBigFloat)tmp, c);
1.1 saito 282: }
283: }
284:
285: int initvf(Num a, Itv b)
286: {
287: Num inf, sup;
288:
289: itvtois(b, &inf, &sup);
290: if ( compnum(0,inf,a) > 0 ) return 0;
291: else if ( compnum(0,a,sup) > 0 ) return 0;
292: else return 1;
293: }
294:
295: int itvinitvf(Itv a, Itv b)
296: {
297: Num ai,as,bi,bs;
298:
299: itvtois(a, &ai, &as);
300: itvtois(b, &bi, &bs);
301: if ( compnum(0,ai,bi) >= 0 && compnum(0,bs,as) >= 0 ) return 1;
302: else return 0;
303: }
304:
1.2 kondoh 305: void divitvf(IntervalBigFloat a, IntervalBigFloat b, IntervalBigFloat *c)
1.1 saito 306: {
307: Num ai,as,bi,bs,a1,a2,b1,b2,c1,c2,t,tmp;
308: Num inf, sup;
309: int ba,bb;
310:
311: if ( !b )
312: error("divitv : division by 0");
313: else if ( !a )
314: *c = 0;
315: else if ( (NID(a) <= N_B) && (NID(b) <= N_B ) )
316: divnum(0,(Num)a,(Num)b,(Num *)c);
317: else {
318: itvtois((Itv)a,&inf,&sup);
319: ToBf(inf, (BF *)&ai); ToBf(sup, (BF *)&as);
320: itvtois((Itv)b,&inf,&sup);
321: ToBf(inf, (BF *)&bi); ToBf(sup, (BF *)&bs);
322: /* MUST check if ai, as, bi, bs are bigfloat. */
323: chsgnnum(as,&a2);
324: chsgnnum(bs,&b2);
325: if ( ba = (compnum(0,0,a2) > 0) ) {
326: a1 = ai;
327: } else {
328: a1 = a2;
329: a2 = ai;
330: }
331: if ( bb = (compnum(0,0,b2) > 0) ) {
332: b1 = bi;
333: } else {
334: b1 = b2;
335: b2 = bi;
336: }
337: if ( compnum(0,0,b1) >= 0 ) {
338: error("divitv : division by interval including 0.");
339: } else {
340: divnum(0,a2,b1,&c2);
341: if ( compnum(0,0,a1) > 0 ) {
342: divnum(0,a1,b1,&c1);
343: } else {
344: divnum(0,a1,b2,&t);
345: subnum(0,0,t,&c1);
346: }
347: }
348: if ( ba == bb ) {
349: subnum(0,0,c2,&t);
350: istoitv(c1,t,(Itv *)&tmp);
351: } else {
352: subnum(0,0,c1,&t);
353: istoitv(c2,t,(Itv *)&tmp);
354: }
1.2 kondoh 355: addulp((IntervalBigFloat)tmp, c);
1.1 saito 356: }
357: }
358:
359: void pwritvf(Itv a, Num e, Itv *c)
360: {
361: int ei;
362: Itv t;
363:
364: if ( !e )
365: *c = (Itv)ONE;
366: else if ( !a )
367: *c = 0;
368: else if ( NID(a) <= N_B )
369: pwrnum(0,(Num)a,e,(Num *)c);
370: else if ( !INT(e) ) {
1.3 ohara 371: #if defined(PARI) && 0
1.1 saito 372: GEN pa,pe,z;
373: int ltop,lbot;
374:
375: ltop = avma; ritopa(a,&pa); ritopa(e,&pe); lbot = avma;
376: z = gerepile(ltop,lbot,gpui(pa,pe,prec));
377: patori(z,c); cgiv(z);
378: #else
379: error("pwritv : can't calculate a fractional power");
380: #endif
381: } else {
382: ei = QTOS((Q)e);
383: pwritv0f(a,ei,&t);
384: if ( SGN((Q)e) < 0 )
385: divbf((Num)ONE,(Num)t,(Num *)c);
386: else
387: *c = t;
388: }
389: }
390:
391: void pwritv0f(Itv a, int e, Itv *c)
392: {
393: Num inf, sup;
394: Num ai,Xmin,Xmax;
1.2 kondoh 395: IntervalBigFloat tmp;
1.1 saito 396: Q ne;
397:
398: if ( e == 1 )
399: *c = a;
400: else {
401: STOQ(e,ne);
402: if ( !(e%2) ) {
403: if ( initvp(0,a) ) {
404: Xmin = 0;
405: chsgnnum(INF(a),&ai);
406: if ( compnum(0,ai,SUP(a)) > 0 ) {
407: Xmax = ai;
408: } else {
409: Xmax = SUP(a);
410: }
411: } else {
412: if ( compnum(0,INF(a),0) > 0 ) {
413: Xmin = INF(a);
414: Xmax = SUP(a);
415: } else {
416: Xmin = SUP(a);
417: Xmax = INF(a);
418: }
419: }
420: } else {
421: Xmin = INF(a);
422: Xmax = SUP(a);
423: }
424: if ( ! Xmin ) inf = 0;
425: else pwrbf(Xmin,(Num)ne,&inf);
426: if ( ! Xmax ) sup = 0;
427: else pwrbf(Xmax,(Num)ne,&sup);
428: istoitv(inf,sup,(Itv *)&tmp);
1.2 kondoh 429: addulp(tmp, (IntervalBigFloat *)c);
1.1 saito 430: }
431: }
432:
433: void chsgnitvf(Itv a, Itv *c)
434: {
435: Num inf,sup;
436:
437: if ( !a )
438: *c = 0;
439: else if ( NID(a) <= N_B )
440: chsgnnum((Num)a,(Num *)c);
441: else {
442: chsgnnum(INF((Itv)a),&inf);
443: chsgnnum(SUP((Itv)a),&sup);
444: istoitv(inf,sup,c);
445: }
446: }
447:
448: int cmpitvf(Itv a, Itv b)
449: {
450: Num ai,as,bi,bs;
451: int s,t;
452:
453: if ( !a ) {
1.4 ! kondoh 454: if ( !b || (NID(b)<=N_B) ) {
1.1 saito 455: return compnum(0,(Num)a,(Num)b);
1.4 ! kondoh 456: } else {
! 457: itvtois(b,&bi,&bs);
! 458: if ( compnum(0,(Num)a,bs) > 0 ) return 1;
! 459: else if ( compnum(0,bi,(Num)a) > 0 ) return -1;
! 460: else return 0;
! 461: }
1.1 saito 462: } else if ( !b ) {
1.4 ! kondoh 463: if ( !a || (NID(a)<=N_B) ) {
1.1 saito 464: return compnum(0,(Num)a,(Num)b);
1.4 ! kondoh 465: } else {
! 466: itvtois(a,&ai,&as);
! 467: if ( compnum(0,ai,(Num)b) > 0 ) return 1;
! 468: else if ( compnum(0,(Num)b,as) > 0 ) return -1;
! 469: else return 0;
! 470: }
1.1 saito 471: } else {
472: itvtois(a,&ai,&as);
473: itvtois(b,&bi,&bs);
1.2 kondoh 474: s = compnum(0,ai,bs) ;
475: t = compnum(0,bi,as) ;
476: if ( s > 0 ) return 1;
477: else if ( t > 0 ) return -1;
478: else return 0;
1.1 saito 479: }
480: }
481:
482: void miditvf(Itv a, Num *b)
483: {
484: Num ai,as;
485: Num t;
486: Q TWO;
487:
488: if ( ! a ) *b = 0;
489: else if ( (NID(a) <= N_B) )
490: *b = (Num)a;
491: else {
492: STOQ(2,TWO);
493: itvtois(a,&ai,&as);
494: addbf(ai,as,&t);
495: divbf(t,(Num)TWO,b);
496: }
497: }
498:
499: void cupitvf(Itv a, Itv b, Itv *c)
500: {
501: Num ai,as,bi,bs;
502: Num inf,sup;
503:
504: itvtois(a,&ai,&as);
505: itvtois(b,&bi,&bs);
506: if ( compnum(0,ai,bi) > 0 ) inf = bi;
507: else inf = ai;
508: if ( compnum(0,as,bs) > 0 ) sup = as;
509: else sup = bs;
510: istoitv(inf,sup,c);
511: }
512:
513: void capitvf(Itv a, Itv b, Itv *c)
514: {
515: Num ai,as,bi,bs;
516: Num inf,sup;
517:
518: itvtois(a,&ai,&as);
519: itvtois(b,&bi,&bs);
520: if ( compnum(0,ai,bi) > 0 ) inf = ai;
521: else inf = bi;
522: if ( compnum(0,as,bs) > 0 ) sup = bs;
523: else sup = as;
524: if ( compnum(0,inf,sup) > 0 ) *c = 0;
525: else istoitv(inf,sup,c);
526: }
527:
528:
529: void widthitvf(Itv a, Num *b)
530: {
531: Num ai,as;
532:
533: if ( ! a ) *b = 0;
534: else if ( (NID(a) <= N_B) )
535: *b = (Num)a;
536: else {
537: itvtois(a,&ai,&as);
538: subnum(0,as,ai,b);
539: }
540: }
541:
542: void absitvf(Itv a, Num *b)
543: {
544: Num ai,as,bi,bs;
545:
546: if ( ! a ) *b = 0;
547: else if ( (NID(a) <= N_B) ) {
548: if ( compnum(0,(Num)a,0) < 0 ) chsgnnum((Num)a,b);
549: else *b = (Num)a;
550: } else {
551: itvtois(a,&ai,&as);
552: if ( compnum(0,ai,0) < 0 ) chsgnnum(ai,&bi);
553: else bi = ai;
554: if ( compnum(0,as,0) < 0 ) chsgnnum(as,&bs);
555: else bs = as;
556: if ( compnum(0,bi,bs) > 0 ) *b = bi;
557: else *b = bs;
558: }
559: }
560:
561: void distanceitvf(Itv a, Itv b, Num *c)
562: {
563: Num ai,as,bi,bs;
564: Num di,ds;
565: Itv d;
566:
567: itvtois(a,&ai,&as);
568: itvtois(b,&bi,&bs);
569: subnum(0,ai,bi,&di);
570: subnum(0,as,bs,&ds);
571: istoitv(di,ds,&d);
572: absitvf(d,c);
573: }
574:
575: #endif