#include #include #include #include #include "interval.h" #include "spread.h" #include "output.h" #define error(s) error=1, output(s"\n") static long nmark; #define increase(r,n) nmark=(n); if (!freeramfrom((r),(nmark))) outofram(); (r)+=nmark; double eps_1_up=(1+DBL_EPSILON),eps_1_down=(1-DBL_EPSILON); static double min (double x, double y) { if (xy) return x; else return y; } double round_up (double x) { if (x>0) return x*eps_1_up; else return x*eps_1_down; } double round_down (double x) { if (x>0) return x*eps_1_down; else return x*eps_1_up; } void interval_add (double *a, double *b, double *a1, double *b1, double *ar, double *br) { *ar=round_down(*a+*a1); *br=round_up(*b+*b1); } void interval_sub (double *a, double *b, double *a1, double *b1, double *ar, double *br) { *ar=round_down(*a-*b1); *br=round_up(*b-*a1); } void interval_mult (double *a, double *b, double *a1, double *b1, double *ar, double *br) { if (*a>=0) { if (*a1>=0) { *ar=round_down(*a**a1); *br=round_up(*b**b1); } else if (*b1>=0) { *ar=round_down(*b**a1); *br=round_up(*b**b1); } else { *ar=round_down(*b**a1); *br=round_up(*a**b1); } } else if (*b>=0) { if (*a1>=0) { *ar=round_down(*a**b1); *br=round_up(*b**b1); } else if (*b1>=0) { *ar=min(round_down(*a**b1),round_down(*b**a1)); *br=max(round_up(*b**b1),round_up(*a**a1)); } else { *ar=round_down(*b**a1); *br=round_up(*a**a1); } } else { if (*a1>=0) { *ar=round_down(*a**b1); *br=round_up(*b**a1); } else if (*b1>=0) { *ar=round_down(*a**b1); *br=round_up(*a**a1); } else { *ar=round_down(*b**b1); *br=round_up(*a**a1); } } } void interval_div (double *a, double *b, double *a1, double *b1, double *ar, double *br) { if (*a>=0) { if (*a1>=0) { *ar=round_down(*a/ *b1); *br=round_up(*b/ *a1); } else if (*b1>=0) error("Division by 0"); else { *ar=round_down(*b/ *b1); *br=round_up(*a/ *a1); } } else if (*b>=0) { if (*a1>=0) { *ar=round_down(*a/ *a1); *br=round_up(*b/ *a1); } else if ( *b1>=0) error("Division by 0"); else { *ar=round_down(*b/ *b1); *br=round_up(*a/ *b1); } } else { if (*a1>=0) { *ar=round_down(*a/ *a1); *br=round_up(*b/ *b1); } else if ( *b1>=0) error("Division by 0"); else { *ar=round_down(*b/ *a1); *br=round_up(*a/ *b1); } } } void interval_invert (double *a, double *b, double *ar, double *br) { *ar=-*b; *br=-*a; } void minterval (header *hd) { header *st=hd,*hd1=nextof(hd),*result=0; int i,j; long n,k; double *m1,*m2,*m; hd=getvalue(hd); hd1=getvalue(hd1); if (error) return; if (hd->type==s_real) { if (hd1->type==s_real) { result=new_interval(*realof(hd),*realof(hd1),""); if (error) return; if (*aof(result)>*bof(result)) error("Empty Interval"); } else if (hd1->type==s_matrix) { i=dimsof(hd1)->r; j=dimsof(hd1)->c; result=new_imatrix(i,j,""); if (error) return; n=(long)i*j; m=matrixof(result); m1=matrixof(hd1); for (k=0; k*(m-1)) { error("Empty interval"); return; } } } else error("Illegal argument for ~"); } else if (hd->type==s_matrix) { if (hd1->type==s_real) { i=dimsof(hd)->r; j=dimsof(hd)->c; result=new_imatrix(i,j,""); if (error) return; n=(long)i*j; m=matrixof(result); m1=matrixof(hd); for (k=0; k*(m-1)) { error("Empty interval"); return; } } } else if (hd1->type==s_matrix) { i=dimsof(hd1)->r; j=dimsof(hd1)->c; result=new_imatrix(i,j,""); if (i!=dimsof(hd)->r || j!=dimsof(hd)->c) error("Matrix dimensions must agree for ~"); if (error) return; n=(long)i*j; m=matrixof(result); m1=matrixof(hd); m2=matrixof(hd1); for (k=0; k*(m-1)) { error("Empty interval"); return; } } } else error("Illegal argument for ~a,b~"); } else error("Illegal argument for ~a,b~"); if (error) return; moveresult(st,result); } void minterval1 (header *hd) { header *st=hd,*result=0; int i,j; long n,k; double *m1,*m; hd=getvalue(hd); if (error) return; if (hd->type==s_real) { result=new_interval(round_down(*realof(hd)), round_up(*realof(hd)),""); } else if (hd->type==s_matrix) { i=dimsof(hd)->r; j=dimsof(hd)->c; result=new_imatrix(i,j,""); if (error) return; n=(long)i*j; m=matrixof(result); m1=matrixof(hd); for (k=0; k1) *ar=1; if (*br<-1) *br=-1; else if (*br>1) *br=1; } void icos (double *a, double *b, double *ar, double *br) { double m=(*a+*b)/2,x=-1,y=1,a1=*a-m,b1=*b-m; interval_mult(&x,&y,&a1,&b1,ar,br); *ar-=sin(m); *br-=sin(m); interval_mult(ar,br,&a1,&b1,&x,&y); *ar=x+cos(m); *br=y+cos(m); if (*ar<-1) *ar=-1; else if (*ar>1) *ar=1; if (*br<-1) *br=-1; else if (*br>1) *br=1; } void itan (double *a, double *b, double *ar, double *br) { if (*a>=M_PI/2 || *b<=-M_PI/2) { error("tan out of range"); return; } *ar=round_down(tan(*a)); *br=round_up(tan(*b)); } void iatan (double *a, double *b, double *ar, double *br) { *ar=round_down(atan(*a)); *br=round_up(atan(*b)); } void iexp (double *a, double *b, double *ar, double *br) { *ar=round_down(exp(*a)); *br=round_up(exp(*b)); } void ilog (double *a, double *b, double *ar, double *br) { if (*a<=0) { error("Log out of range"); return; } *ar=round_down(log(*a)); *br=round_up(log(*b)); } void isqrt (double *a, double *b, double *ar, double *br) { if (*a<=0) { error("Sqrt out of range"); return; } *ar=round_down(sqrt(*a)); *br=round_up(sqrt(*b)); } void iabs (double *a, double *b, double *ar, double *br) { if (*a<0) { if (*b<0) { *ar=-*b; *br=-*a; } else { *ar=0; if (*b>-*a) *br=*b; else *br=-*a; } } else { *ar=*a; *br=*b; } } void ipow (double *a, double *b, double *a1, double *b1, double *ar, double *br) { int n; if (*a>0) { if (*a>=1) { if (*a1>=0) { *ar=round_down(pow(*a,*a1)); *br=round_up(pow(*b,*b1)); } else if (*b1>0) { *ar=round_down(pow(*b,*a1)); *br=round_up(pow(*b,*b1)); } else { *ar=round_down(pow(*b,*a1)); *br=round_up(pow(*a,*b1)); } } else if (*b>1) { *ar=round_down(min(pow(*a,*b1),pow(*b,*a1))); *br=round_up(max(pow(*b,*b1),pow(*a,*a1))); } else { if (*a1>=0) { *br=round_up(pow(*b,*a1)); *ar=round_down(pow(*a,*b1)); } else if (*b1>0) { *br=round_up(pow(*a,*a1)); *ar=round_down(pow(*a,*b1)); } else { *br=round_up(pow(*a,*a1)); *ar=round_down(pow(*b,*b1)); } } } else if (*a1==*b1 && *b1==(n=(int)*a1)) { if (n%2==0) { if (n>0) { if (*b>=0) { *ar=0; *br=round_up(max(pow(*b,n),pow(-*a,n))); } else { *ar=round_down(pow(-*b,n)); *br=round_up(pow(-*a,n)); } } else if (n==0) { *ar=*br=1; } else { if (*b>=0) error("0^n undefined for negative n"); else { *ar=round_down(pow(-*a,n)); *br=round_up(pow(-*b,n)); } } } else { if (n>0) { *ar=round_down(pow(*a,n)); *br=round_up(pow(*b,n)); } else { *br=-round_down(pow(*b,n)); *ar=-round_up(pow(*a,n)); } } } else error("Cannot raise negative number to non-integer power."); } void imax (double *a, double *b, double *a1, double *b1, double *ar, double *br) { *br=max(*b,*b1); *ar=max(*a,*a1); } void imin (double *a, double *b, double *a1, double *b1, double *ar, double *br) { *br=min(*b,*b1); *ar=min(*a,*a1); } void fid (double *a, double *b) { *b=*a; } void ileft (double *a, double *b, double *r) { *r=*a; } void mleft (header *hd) { spreadir1(fid,ileft,hd); } void iright (double *a, double *b, double *r) { *r=*b; } void mright (header *hd) { spreadir1(fid,iright,hd); } void imiddle (double *a, double *b, double *r) { *r=(*a+*b)/2; } void mmiddle (header *hd) { spreadir1(fid,imiddle,hd); } void idiameter (double *a, double *b, double *r) { *r=*b-*a; } void fnull (double *a, double *b) { *b=0; } void mdiameter (header *hd) { spreadir1(fnull,idiameter,hd); } void ior (double *a, double *b, double *a1, double *b1, double *ar, double *br) { *ar=min(*a,*a1); *br=max(*b,*b1); } void iintersects (double *a, double *b, double *a1, double *b1, double *z) { if (*b>=*a1 && *a<=*b1) *z=1.0; else *z=0.0; } void iand (double *a, double *b, double *a1, double *b1, double *ar, double *br) { *ar=max(*a,*a1); *br=min(*b,*b1); if (*ar>*br) error("Empty intersection."); } void iless1 (double *a, double *b, double *a1, double *b1, double *r) { *r=(*a>*a1 && *b<=*b1) || (*a>=*a1 && *b<*b1); } void miless (header *hd) { spreadf2r(0,0,iless1,hd); } void ilesseq1 (double *a, double *b, double *a1, double *b1, double *r) { *r=*a>=*a1 && *b<=*b1; } void milesseq (header *hd) { spreadf2r(0,0,ilesseq1,hd); } void copy_interval (double *x, double *y) { *x++=*y++; *x=*y; } void make_interval (header *hd) /**** make_interval make a function argument interval. ****/ { header *old=hd,*nextarg; unsigned long size; int r,c,i,j; double *m,*m1; hd=getvariablesub(hd); if (isinterval(hd)) return; if (iscomplex(hd)) { output("Cannot convert from complex to interval.\n"); error=1; return; } hd=getvalue(hd); if (hd->type==s_real) { size=sizeof(header)+2*sizeof(double); nextarg=nextof(old); if (!freeram(size-old->size)) { output("Memory overflow!\n"); error=180; return; } if (newram>(char *)nextarg) memmove((char *)old+size,(char *)nextarg, newram-(char *)nextarg); newram+=size-old->size; *(old->name)=0; old->size=size; old->type=s_interval; *aof(old)=*realof(hd); *bof(old)=*realof(hd); } else if (hd->type==s_matrix) { getmatrix(hd,&r,&c,&m); size=imatrixsize(r,c); nextarg=nextof(old); if (!freeram(size-old->size)) { output("Memory overflow!\n"); error=180; return; } if (newram>(char *)nextarg) memmove((char *)old+size,(char *)nextarg, newram-(char *)nextarg); newram+=size-old->size; *(old->name)=0; old->size=size; old->type=s_imatrix; dimsof(old)->r=r; dimsof(old)->c=c; m1=matrixof(old); for (i=r-1; i>=0; i--) for (j=c-1; j>=0; j--) { *imat(m1,c,i,j)=*mat(m,c,i,j); *(imat(m1,c,i,j)+1)=*mat(m,c,i,j); } } else { output("Argument not real or complex.\n"); error=1; return; } } /******************* interval linear systems **************/ void i_add (interval x, interval y, interval z) { z[0]=round_down(x[0]+y[0]); z[1]=round_up(x[1]+y[1]); } void i_sub (interval x, interval y, interval z) { z[0]=round_down(x[0]-y[1]); z[1]=round_up(x[1]-y[0]); } void i_mult (interval x, interval y, interval z) { double h,h1; interval_mult(x,x+1,y,y+1,&h,&h1); z[0]=h; z[1]=h1; } void i_div (interval x, interval y, interval z) { double h,h1; interval_div(x,x+1,y,y+1,&h,&h1); z[0]=h; z[1]=h1; } double i_abs (interval x) { return max(fabs(x[1]),fabs(x[2])); } void i_copy (interval x, interval y) { x[0]=y[0]; x[1]=y[1]; } static char *ram; static int *perm,*col,signdet,luflag=0; static interval **i_lumat,*i_c,i_det; static int rank; void i_lu (double *a, int n, int m) /***** clu lu decomposition of a *****/ { int i,j,k,mm,j0,kh; double *d,piv,temp,zmax,help; interval t,*h,*temp1; if (!luflag) { /* get place for result c and move a to c */ i_c=(interval *)ram; increase(ram,(long)n*m*sizeof(interval)); memmove((char *)i_c,(char *)a,(long)n*m*sizeof(interval)); } else i_c=(interval *)a; /* inititalize c_lumat */ i_lumat=(interval **)ram; increase(ram,(long)n*sizeof(interval *)); h=i_c; for (i=0; izmax) zmax=help; if (zmax==0.0) { error=130; return; } d[k]=zmax; } signdet=1; rank=0; i_det[0]=1.0; i_det[1]=0.0; k=0; for (kh=0; kh=0) { output("Determinant may be 0\n"); error=131; return; } if (j0!=k) { signdet=-signdet; mm=perm[j0]; perm[j0]=perm[k]; perm[k]=mm; temp=d[j0]; d[j0]=d[k]; d[k]=temp; temp1=i_lumat[j0]; i_lumat[j0]=i_lumat[k]; i_lumat[k]=temp1; } for (j=k+1; j=n) { kh++; break; } } if (k=0; k--) { sum[0]=0; sum[1]=0.0; for (j=k+1; j=0; i--) { interval_mult(xa,xb,za,zb,&ha,&hb); interval_add(&ha,&hb,p,p+1,za,zb); p-=2; } } void iddeval (double *x, double *xi, double *z, double *zi) { int i; double *p,h,hi,*dd,xh,xhi; p=divdif+(2l*degree); dd=divx+(2l*(degree-1)); *z=*p; *zi=*(p+1); p-=2; for (i=degree-1; i>=0; i--) { xh=round_down(*x-*(dd+1)); xhi=round_up(*xi-*dd); dd-=2; interval_mult(&xh,&xhi,z,zi,&h,&hi); *z=round_down(h+*p); *zi=round_up(hi+*(p+1)); p-=2; } } void mexpand (header *hd) { header *st=hd,*hd1=nextof(hd),*result; double *m,*mr,x,d,f; int c,r; long n; hd=getvalue(hd); hd1=getvalue(hd1); if (error) return; if (!hd1->type==s_real || (f=*realof(hd1))<=0) { output("expand by a positiv scalar only!\n"); error=1; return; } if (hd->type==s_interval) { d=(*bof(hd)-*aof(hd))/2; x=*aof(hd)+d; result=new_interval( round_down(x-d*f),round_up(x+d*f),""); if (error) return; } else if (hd->type==s_imatrix) { getmatrix(hd,&c,&r,&m); result=new_imatrix(c,r,""); if (error) return; mr=matrixof(result); n=(long)r*c; while (n>0) { d=(*(m+1)-*m)/2; x=*m+d; *mr++=round_down(x-d*f); *mr++=round_up(x+d*f); m+=2; n--; } } else if (hd->type==s_real) { result=new_interval(round_down(*realof(hd)-f), round_up(*realof(hd)+f),""); if (error) return; } else if (hd->type==s_matrix) { getmatrix(hd,&c,&r,&m); result=new_imatrix(c,r,""); if (error) return; mr=matrixof(result); n=(long)r*c; while (n>0) { *mr++=round_down(*m-f); *mr++=round_up(*m++ +f); n--; } } else wrong_arg(); moveresult(st,result); }