/*
* Compare two complex numbers for equality, returning FALSE if they are equal,
* and TRUE if they differ.
*/
BOOL
ccmp(COMPLEX *c1, COMPLEX *c2)
{
BOOL i;
i = qcmp(c1->real, c2->real);
if (!i)
i = qcmp(c1->imag, c2->imag);
return i;
}
int
main ()
{
int (*fun1) (qcmplx *, qcmplx *);
qcmplx z, w;
/* char num[128]; */
int i, k, errs, tests;
union
{
double d;
unsigned short s[4];
} u;
errs = 0;
tests = 0;
i = 0;
for (;;)
{
fun1 = test1[i].func;
if (fun1 == NULL)
break;
/* Convert tabulated values to binary. */
asctoq (test1[i].real_arg_str, real_arg);
asctoq (test1[i].imag_arg_str, imag_arg);
asctoq (test1[i].real_ans_str, real_ans);
asctoq (test1[i].imag_ans_str, imag_ans);
/* Construct the complex argument. */
qmov (real_arg, z.r);
qmov (imag_arg, z.i);
/* Call the function under test. */
k = (*(fun1)) (&z, &w);
/* Estimate the error of the result. */
qsub (w.r, real_ans, real_err);
if (real_ans[1] != 0)
qdiv (real_ans, real_err, real_err);
qtoe (real_err, u.s);
d_real_err = u.d;
qsub (w.i, imag_ans, imag_err);
if (imag_ans[1] != 0)
qdiv (imag_ans, imag_err, imag_err);
qtoe (imag_err, u.s);
d_imag_err = u.d;
#if 1
if ((fabs (d_real_err) > ERR_THRESH) || (fabs (d_imag_err) > ERR_THRESH))
{
errs += 1;
printf ("Line %d: %s error = %.3e ", i + 1, test1[i].name,
d_real_err);
if (d_imag_err >= 0.0)
printf ("+ ");
printf ("%.3e i\n", d_imag_err);
}
#else
if ((qcmp (w.r, real_ans) != 0) || (qcmp (w.i, imag_ans) != 0))
{
errs += 1;
qtoasc (w.r, num, 70);
printf ("Line %d: %s\n", i + 1, num);
qtoasc (w.i, num, 70);
printf ("%si\n", num);
qtoasc (real_ans, num, 70);
printf ("s.b. %s\n", num);
qtoasc (imag_ans, num, 70);
printf ("%si\n", num);
/*
printf ("Line %d: %.9e %9e, s.b. %.9e %.9e\n", i + 1,
creal(w), cimag(w), test1[i].real_ans, test1[i].imag_ans);
*/
}
#endif
i += 1;
tests += 1;
}
printf ("%d errors in %d tests\n", errs, tests);
exit (0);
}
int main(){
char **a, **b, **c, **d, **e;
a = malloc(sizeof(char*));
b = malloc(sizeof(char*));
c = malloc(sizeof(char*));
d = malloc(sizeof(char*));
e = malloc(sizeof(char*));
*a = malloc(100 * sizeof(char));
*b = malloc(100 * sizeof(char));
*c = malloc(100 * sizeof(char));
*d = malloc(100 * sizeof(char));
*e = malloc(100 * sizeof(char));
strcpy(*a, "good");
strcpy(*b, "badd");
strcpy(*c, "gooda");
strcpy(*d, "\0");
strcpy(*e, "");
printf("%s\t%s\t%d\n", *a, *a, qcmp((void *) a, (void *)a));
printf("%s\t%s\t%d\n", *a, *b, qcmp((void *) a, (void *)b));
printf("%s\t%s\t%d\n", *a, *c, qcmp((void *) a, (void *)c));
printf("%s\t%s\t%d\n", *a, *d, qcmp((void *) a, (void *)d));
printf("%s\t%s\t%d\n\n", *a, *e, qcmp((void *) a, (void *)e));
printf("%s\t%s\t%d\n", *b, *b, qcmp((void *) b, (void *)b));
printf("%s\t%s\t%d\n", *b, *c, qcmp((void *) b, (void *)c));
printf("%s\t%s\t%d\n", *b, *d, qcmp((void *) b, (void *)d));
printf("%s\t%s\t%d\n\n", *b, *e, qcmp((void *) b, (void *)e));
printf("%s\t%s\t%d\n", *c, *c, qcmp((void *) c, (void *)c));
printf("%s\t%s\t%d\n", *c, *d, qcmp((void *) c, (void *)d));
printf("%s\t%s\t%d\n\n", *c, *e, qcmp((void *) c, (void *)e));
printf("%s\t%s\t%d\n", *d, *d, qcmp((void *) d, (void *)d));
printf("%s\t%s\t%d\n\n", *d, *e, qcmp((void *) d, (void *)e));
printf("%s\t%s\t%d\n\n", *e, *e, qcmp((void *) e, (void *)e));
free(*a);
free(*b);
free(*c);
free(*d);
free(*e);
free(a);
free(b);
free(c);
free(d);
free(e);
return 0;
}
main()
{
char s[80];
double fabs(), floor();
#if EXPSCALE || EXPSC2
double exp();
#endif
double sqrt(); /* required to compute rms error */
int i, j, k;
long m, n;
dprec(); /* set up floating point coprocessor */
merror = 0;
/*aiconf = -1;*/ /* configure Airy function */
x = 1.0;
z = x * x;
qclear( qmax );
qtoasc( qmax, strmax, 4 );
qclear( qrmsa );
qclear( qave );
#if 1
printf(" Start at random number #:" );
gets( s );
sscanf( s, "%ld", &n );
printf("%ld\n", n );
#else
n = 0;
#endif
for( m=0; m<n; m++ )
drand( &x );
n = 0;
m = 0;
x = floor( x );
loop:
for( i=0; i<100; i++ )
{
n++;
m++;
/* make random number in desired range */
drand( &x );
x = WIDTH * ( x - 1.0 ) + LOW;
#if EXPSCALE
x = exp(x);
drand( &a );
a = 1.0e-13 * x * a;
if( x > 0.0 )
x -= a;
else
x += a;
#endif
#if ONEINT
k = x;
x = k;
#endif
etoq( &x, q1 ); /* double number to q type */
/* do again if second argument required */
#if TWOARG || THREEARG || FOURARG
drand( &a );
a = WIDTHA * ( a - 1.0 ) + LOWA;
/*a /= 50.0;*/
#if EXPSC2
a = exp(a);
drand( &y2 );
y2 = 1.0e-13 * y2 * a;
if( a > 0.0 )
a -= y2;
else
a += y2;
#endif
#if TWOINT || THREEINT
k = a + 0.25;
a = k;
#endif
etoq( &a, qy4 );
#endif
#if THREEARG || FOURARG
drand( &b );
#if PROB
/*
b = b - 1.0;
b = a * b;
*/
b = WIDTHA * ( b - 1.0 ) + LOWA;
/* Half-integer a and b */
/*a = 0.5*floor(2.0*a+1.0);*/
a = 0.5;
b = 0.5*floor(2.0*b+1.0);
etoq( &a, qy4 );
/*x = (a / (a+b));*/
#else
b = WIDTHA * ( b - 1.0 ) + LOWA;
#endif
#if THREEINT
j = b + 0.25;
b = j;
#endif
etoq( &b, qb );
#endif
#if FOURARG
drand( &c );
c = WIDTHA * ( c - 1.0 ) + LOWA;
/* for hyp2f1 to ensure c-a-b > -1 */
/*
z = c-a-b;
if( z < -1.0 )
c -= 1.6 * z;
*/
etoq( &c, qc );
#endif
/*printf("%.16E %.16E\n", a, x);*/
/* compute function under test */
#if ONEARG
#if FOURANS
/*FUNC( x, &z, &y2, &y3, &y4 );*/
FUNC( x, &y4, &y2, &y3, &z );
#else
#if TWOANS
FUNC( x, &z, &y2 );
/*FUNC( x, &y2, &z );*/
#else
#if ONEINT
z = FUNC( k );
#else
z = FUNC( x );
#endif
#endif
#endif
#endif
#if TWOARG
#if TWOINT
/*z = FUNC( k, x );*/
/*z = FUNC( x, k );*/
z = FUNC( a, x );
#else
#if FOURANS
FUNC( a, x, &z, &y2, &y3, &y4 );
#else
z = FUNC( a, x );
#endif
#endif
#endif
#if THREEARG
#if THREEINT
z = FUNC( j, k, x );
#else
z = FUNC( a, b, x );
#endif
#endif
#if FOURARG
z = FUNC( a, b, c, x );
#endif
etoq( &z, q2 );
/* handle detected overflow */
if( (z == MAXNUM) || (z == -MAXNUM) )
{
printf("detected overflow ");
#if FOURARG
printf("%.4E %.4E %.4E %.4E %.4E %6ld \n",
a, b, c, x, y, n);
#else
printf("%.16E %.4E %.4E %6ld \n", x, a, z, n);
#endif
e = 0.0;
m -= 1;
goto endlup;
}
/* Skip high precision if underflow. */
if( merror == UNDERFLOW )
goto underf;
/* compute high precision function */
#if ONEARG
#if FOURANS
/*QFUNC( q1, qz, qy2, qy3, qy4 );*/
QFUNC( q1, qy4, qy2, qy3, qz );
#else
#if TWOANS
QFUNC( q1, qz, qy2 );
/*QFUNC( q1, qy2, qz );*/
#else
/*qclear( qy4 );*/
/*qmov( qone, qy4 );*/
/*QFUNC( qy4, q1, qz );*/
/*QFUNC( 1, q1, qz );*/
QFUNC( q1, qz ); /* normal */
#endif
#endif
#endif
#if TWOARG
#if TWOINT
/*QFUNC( k, q1, qz );*/
/*QFUNC( q1, qy4, qz );*/
QFUNC( qy4, q1, qz );
#else
#if FOURANS
QFUNC( qy4, q1, qz, qy2, qy3, qc );
#else
/*qclear( qy4 );*/
/*qmov( qone, qy4 );*/
QFUNC( qy4, q1, qz );
#endif
#endif
#endif
#if THREEARG
#if THREEINT
QFUNC( j, k, q1, qz );
#else
QFUNC( qy4, qb, q1, qz );
#endif
#endif
#if FOURARG
QFUNC( qy4, qb, qc, q1, qz );
#endif
qtoe( qz, &y ); /* correct answer, in double precision */
/* get absolute error, in extended precision */
qsub( qz, q2, qe );
qtoe( qe, &e ); /* the error in double precision */
/* handle function result equal to zero
or underflowed. */
if( qz[1] < 3 || merror == UNDERFLOW || fabs(z) < underthresh )
{
underf:
merror = 0;
/* Don't bother to print anything. */
#if 0
printf("ans 0 ");
#if ONEARG
printf("%.8E %.8E %.4E %6ld \n", x, y, e, n);
#endif
#if TWOARG
#if TWOINT
printf("%d %.8E %.8E %.4E %6ld \n", k, x, y, e, n);
#else
printf("%.6E %.6E %.6E %.4E %6ld \n", a, x, y, e, n);
#endif
#endif
#if THREEARG
printf("%.6E %.6E %.6E %.6E %.4E %6ld \n", a, b, x, y, e, n);
#endif
#if FOURARG
printf("%.4E %.4E %.4E %.4E %.4E %.4E %6ld \n",
a, b, c, x, y, e, n);
#endif
#endif /* 0 */
qclear( qe );
e = 0.0;
m -= 1;
goto endlup;
}
else
/* relative error */
/* comment out the following two lines if absolute accuracy report */
#if RELERR
qdiv( qz, qe, qe );
#else
{
qmov( qz, q2 );
q2[0] = 0;
if( qcmp( q2, qone ) > 0 )
qdiv( qz, qe, qe );
}
#endif
qadd( qave, qe, qave );
/* absolute value of error */
qe[0] = 0;
/* peak detect the error */
if( qcmp(qe, qmax) > 0 )
{
qmov( qe, qmax );
qtoasc( qmax, strmax, 4 );
#if ONEARG
printf("%.8E %.8E %s %6ld \n", x, y, strmax, n);
#endif
#if TWOARG
#if TWOINT
printf("%d %.8E %.8E %s %6ld \n", k, x, y, strmax, n);
#else
printf("%.6E %.6E %.6E %s %6ld \n", a, x, y, strmax, n);
#endif
#endif
#if THREEARG
printf("%.6E %.6E %.6E %.6E %s %6ld \n", a, b, x, y, strmax, n);
#endif
#if FOURARG
printf("%.4E %.4E %.4E %.4E %.4E %s %6ld \n",
a, b, c, x, y, strmax, n);
#endif
}
/* accumulate rms error */
/* rmsa += e * e; accumulate the square of the error */
qmul( qe, qe, q2 );
qadd( q2, qrmsa, qrmsa );
endlup:
;
}
/* report every 100 trials */
/* rms = sqrt( rmsa/m ); */
ltoq( &m, q1 );
qdiv( q1, qrmsa, q2 );
qsqrt( q2, q2 );
qtoasc( q2, strrms, 4 );
qdiv( q1, qave, q2 );
qtoasc( q2, strave, 4 );
/*
printf("%6ld max = %s rms = %s ave = %s \n", m, strmax, strrms, strave );
*/
printf("%6ld max = %s rms = %s ave = %s \r", m, strmax, strrms, strave );
fflush(stdout);
goto loop;
}
/*
* Add a particular number to the constant table.
* Returns the index of the number in the constant table, or zero
* if the number could not be saved. The incoming number if freed
* if it is already in the table.
*
* XXX - we should hash the constant table
*
* given:
* q number to be added
*/
long
addqconstant(NUMBER *q)
{
register NUMBER **tp; /* pointer to current number */
register NUMBER *t; /* number being tested */
unsigned long index; /* index into constant table */
long numlen; /* numerator length */
long denlen; /* denominator length */
HALF numlow; /* bottom value of numerator */
HALF denlow; /* bottom value of denominator */
long first; /* first non-null position found */
BOOL havefirst;
if (constavail <= 0) {
if (consttable == NULL) {
initconstants();
} else {
tp = (NUMBER **) realloc((char *) consttable,
sizeof(NUMBER *) * (constcount + CONSTALLOCSIZE));
if (tp == NULL) {
math_error("Unable to reallocate const table");
/*NOTREACHED*/
}
consttable = tp;
constavail = CONSTALLOCSIZE;
}
}
numlen = q->num.len;
denlen = q->den.len;
numlow = q->num.v[0];
denlow = q->den.v[0];
first = 0;
havefirst = FALSE;
tp = consttable;
for (index = 0; index < constcount; index++, tp++) {
t = *tp;
if (t->links == 0) {
if (!havefirst) {
havefirst = TRUE;
first = index;
}
continue;
}
if (q == t) {
if (q->links == 1) {
if (havefirst) {
*tp = consttable[first];
consttable[first] = q;
} else {
havefirst = TRUE;
first = index;
}
continue;
}
return index;
}
if ((numlen != t->num.len) || (numlow != t->num.v[0]))
continue;
if ((denlen != t->den.len) || (denlow != t->den.v[0]))
continue;
if (q->num.sign != t->num.sign)
continue;
if (qcmp(q, t) == 0) {
t->links++;
qfree(q);
return index;
}
}
if (havefirst) {
consttable[first] = q;
return first;
}
constavail--;
consttable[constcount++] = q;
return index;
}
