#include <stdio.h>
#include <float.h>
#include <math.h>
#include <string.h>
#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 (x<y) return x;
else return y;
}
static double max (double x, double y)
{ if (x>y) 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<n; k++)
{ *m++=*realof(hd);
*m++=*m1++;
if (*(m-2)>*(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<n; k++)
{ *m++=*m1++;
*m++=*realof(hd1);
if (*(m-2)>*(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<n; k++)
{ *m++=*m1++;
*m++=*m2++;
if (*(m-2)>*(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; k<n; k++)
{ *m++=round_down(*m1);
*m++=round_up(*m1++);
}
}
else if (isinterval(hd)) return;
else error("Illegal argument for ~a~");
if (error) return;
moveresult(st,result);
}
void isin (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+=cos(m); *br+=cos(m);
interval_mult(ar,br,&a1,&b1,&x,&y);
*ar=x+sin(m); *br=y+sin(m);
if (*ar<-1) *ar=-1;
else if (*ar>1) *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; i<n; i++) { i_lumat[i]=h; h+=m; }
/* get place for perm */
perm=(int *)ram;
increase(ram,(long)n*sizeof(int));
/* get place for col */
col=(int *)ram;
increase(ram,(long)m*sizeof(int));
/* d is a vector needed by the algorithm */
d=(double *)ram;
increase(ram,(long)n*sizeof(double));
/* gauss algorithm */
for (k=0; k<n; k++)
{ perm[k]=k;
for (zmax=0.0, j=0; j<m; j++)
if ( (help=i_abs(i_lumat[k][j])) >zmax) 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<m; kh++)
{ piv=i_abs(i_lumat[k][kh])/d[k];
j0=k;
for (j=k+1; j<n; j++)
{ temp=i_abs(i_lumat[j][kh])/d[j];
if (piv<temp)
{ piv=temp; j0=j;
}
}
col[kh]=1; rank++;
i_mult(i_det,i_lumat[j0][kh],i_det);
if (i_det[0]<=0 && i_det[1]>=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; j++)
if (i_lumat[j][kh][0] != 0.0 || i_lumat[j][kh][1]!=0.0)
{ i_div(i_lumat[j][kh],i_lumat[k][kh],i_lumat[j][kh]);
if (error) return;
for (mm=kh+1; mm<m; mm++)
{ i_mult(i_lumat[j][kh],i_lumat[k][mm],t);
i_sub(i_lumat[j][mm],t,i_lumat[j][mm]);
}
}
k++;
if (k>=n) { kh++; break; }
}
if (k<n || kh<m)
{ signdet=0;
error=131; output("Determinant zero!\n");
return;
}
for (j=kh; j<m; j++) col[j]=0;
if (signdet<0)
{ i_det[0]=i_det[1]*signdet; i_det[1]=i_det[0]*signdet;
}
}
void i_solvesim (double *a, int n, double *rs, int m, double *res)
/**** solvesim
solve simultanuously a linear system.
****/
{ interval **x,**b,*h;
interval sum,t;
int i,k,l,j;
ram=newram;
luflag=0; i_lu(a,n,n); if (error) return;
/* initialize x and b */
x=(interval **)ram;
increase(ram,(long)n*sizeof(interval *));
h=(interval *)res; for (i=0; i<n; i++) { x[i]=h; h+=m; }
b=(interval **)ram;
increase(ram,(long)n*sizeof(interval *));
h=(interval *)rs; for (i=0; i<n; i++) { b[i]=h; h+=m; }
for (l=0; l<m; l++)
{ i_copy(x[0][l],b[perm[0]][l]);
for (k=1; k<n; k++)
{ i_copy(x[k][l],b[perm[k]][l]);
for (j=0; j<k; j++)
{ i_mult(i_lumat[k][j],x[j][l],t);
i_sub(x[k][l],t,x[k][l]);
}
}
i_div(x[n-1][l],i_lumat[n-1][n-1],x[n-1][l]);
for (k=n-2; k>=0; k--)
{ sum[0]=0; sum[1]=0.0;
for (j=k+1; j<n; j++)
{ i_mult(i_lumat[k][j],x[j][l],t);
i_add(sum,t,sum);
}
i_sub(x[k][l],sum,t);
i_div(t,i_lumat[k][k],x[k][l]);
}
}
}
extern double *polynom,*divx,*divdif;
extern int degree;
void ipeval (double *xa, double *xb, double *za, double *zb)
{ int i;
double *p,ha,hb;
p=polynom+(2l*degree);
*za=*p; *zb=*(p+1);
p-=2;
for (i=degree-1; i>=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);
}
syntax highlighted by Code2HTML, v. 0.9.1