/*
 * Copyright (c) 1996 Ernest Bowen and Landon Curt Noll
 * Permission is granted to use, distribute, or modify this source,
 * provided that this copyright notice remains intact.
 *
 * By: Ernest Bowen and Landon Curt Noll
 *     ernie@neumann.une.edu.au and chongo@toad.com
 *
 * This library is used by the 2600 series of the regress.cal test suite.
 */
/*
 * Stringent tests of some of calc's builtin functions.
 * Most of the tests are concerned with the accuracy of the value
 * returned for a function; usually it is expected that
 * remainder (true value - calculated value) will be less in
 * absolute value than "epsilon", where this is either a specified
 * argument eps, or if this is omitted, the current value of epsilon().
 * In some cases the remainder is to have a particular sign, or to
 * have absolute value not exceeding eps/2, or in some cases 3 * eps/4.
 *
 * Typical of these tests is testpower("power", n, b, eps, verbose).
 * Here n is the number of numbers a for which power(a, b, eps) is to
 * be evaluated; the ratio c = (true value - calculated value)/eps
 * is calculated and if this is not less in absolute value than
 * 0.75, a "failure" is recorded and the value of a displayed.
 * On completion of the tests, the minimum and maximum values of
 * c are displayed.
 *
 * The numbers a are usually large "random" integers or sometimes
 * ratios of such integers.  In some cases the formulae used to
 * calculate c assume eps is small compared with the value of the
 * function.  If eps is very small, say 1e-1000, or if the denominator
 * of b in power(a, b, eps) is large, the computation required for
 * a test may be very heavy.
 *
 * Test funcations are called as:
 *
 *	testabc(str, ..., verbose)
 *
 * where str is a string that names the test.  This string is printed
 * without a newline (if verbose > 0), near the beginning of the function.
 * The verbose parameter controls how verbose the test will be:
 *
 *	0 - print nothing
 *	1 - print str and the error count
 *	2 - print min and max errors as well
 *	3 - print everything including individual loop counts
 *
 * All functions return the number of errors that they detected.
 */

global defaultverbose = 1;	/* default verbose value */
global err;

define testismult(str, n, verbose)
{
	local a, b, c, i, m;

	if (isnull(verbose)) verbose = defaultverbose;
	if (verbose > 0) {
		print str:":",:;
	}
	m = 0;
	for (i = 0; i < n; i++) {
		if (verbose > 2) print i,:;
		a = scale(rand(1,1e1000), rand(100));
		b = scale(rand(1,1e1000), rand(100));
		c = a * b;
		if (!ismult(c,a)) {
			m++;
			if (verbose > 1) {
				printf("*** Failure with:\na = %d\nb = %d\n", a,b);
			}
		}
	}
	if (verbose > 0) {
		if (m) {
			printf("*** %d error(s)\n", m);
		} else {
			printf("no errors\n");
		}
	}
	return m;
}

define testsqrt(str, n, eps, verbose)
{
	local a, c, i, x, m, min, max;

	if (isnull(verbose)) verbose = 2;
	if (verbose > 0) {
		print str:":",:;
	}
	m = 0;
	min = 1000;
	max = -1000;
	if (isnull(eps))
		eps = epsilon();
	for (i = 1; i <= n; i++) {
		if (verbose > 2) print i,:;
		a = scale(rand(1,1000), rand(100));
		x = sqrt(a, eps);
		if (x)
			c = (a/x - x)/2/eps;
		else
			c = a/eps;		/* ??? */
		if (c < min)
			min = c;
		if (c > max)
			max = c;
		if (abs(c) > 1) {
			m++;
			if (verbose > 1) {
				printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
			}
		}
	}
	if (verbose > 0) {
		if (m) {
			printf("*** %d error(s)\n", m);
			printf("    %s: rem/eps min=%d, max=%d\n",
			       str, min, max);
		} else {
			printf("no errors\n");
		}
	}
	if (verbose > 1) {
		printf("    %s: rem/eps min=%0.4d, max=%0.4d\n", str, min, max);
	}
	return m;
}


define testexp(str, n, eps, verbose)
{
	local i, a, c, m, min, max;

	if (isnull(verbose)) verbose = 2;
	if (verbose > 0) {
		print str:":",:;
	}
	if (isnull(eps))
		eps = epsilon();
	min = 1000;
	max = -1000;
	for (i = 1; i <= n; i++) {
		if (verbose > 2) print i,:;
		a = rand(1,1e20)/rand(1,1e20) + rand(50);
		if (rand(1))
			a = -a;
		c = cexp(a, eps);
		if (c < min)
			min = c;
		if (c > max)
			max = c;
		if (abs(c) > 0.02) {
			m++;
			if (verbose > 1) {
				printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
			}
		}
	}
	if (verbose > 0) {
		if (m) {
			printf("*** %d error(s)\n", m);
			printf("    %s: rem/eps min=%d, max=%d\n",
			       str, min, max);
		} else {
			printf("no errors\n");
		}
	}
	if (verbose > 1) {
		printf("    %s: rem/eps min=%0.4d, max=%0.4d\n", str, min, max);
	}
	return m;
}


define cexp(x,eps)		/* Find relative rem/eps for exp(x, eps) */
{
	local eps1, v, v1, c;

	if (isnull(eps))
		eps = epsilon();
	eps1 = eps * 1e-6;
	v = exp(x, eps);
	v1 = exp(x, eps1);
	c = round((v1 - v)/v1/eps, 6, 24);
	return c;
}


define testln(str, n, eps, verbose)
{
	local i, a, c, m, min, max;

	if (isnull(verbose)) verbose = 2;
	if (verbose > 0) {
		print str:":",:;
	}
	if (isnull(eps))
		eps = epsilon();
	min = 1000;
	max = -1000;
	for (i = 1; i <= n; i++) {
		if (verbose > 2) print i,:;
		a = rand(1,1e20)/rand(1,1e20) + rand(50);
		c = cln(a, eps);
		if (c < min)
			min = c;
		if (c > max)
			max = c;
		if (abs(c) > 0.5) {
			m++;
			if (verbose > 1) {
				printf("*** Failure with:\na = %d\neps = %d\n", a,eps);
			}
		}
	}
	if (verbose > 0) {
		if (m) {
			printf("*** %d error(s)\n", m);
			printf("    %s: rem/eps min=%d, max=%d\n",
			       str, min, max);
		} else {
			printf("no errors\n");
		}
	}
	if (verbose > 1) {
		printf("    %s: rem/eps min=%0.4d, max=%0.4d\n", str, min, max);
	}
	return m;
}

define cln(a, eps)
{
	local eps1, v, v1, c;

	if (isnull(eps))
		eps = epsilon();
	eps1 = eps/1e6;
	v = ln(a, eps);
	v1 = ln(a, eps1);
	c = round((v1 - v)/eps, 6, 24);
	return c;
}


define testpower(str, n, b, eps, verbose)
{
	local i, a, c, m, min, max;

	if (isnull(verbose)) verbose = 2;
	if (verbose > 0) {
		print str:":",:;
	}
	if (isnull(eps))
		eps = epsilon();
	if (!isnum(b))
		quit "Second argument (exponent) to be a number";
	min = 1000;
	max = -1000;
	for (i = 1; i <= n; i++) {
		if (verbose > 2) print i,:;
		a = rand(1,1e20)/rand(1,1e20);
		c = cpow(a, b, eps);
		if (abs(c) > .75) {
			m++;
			if (verbose > 1) {
				printf("*** Failure for a = %d\n", a);
			}
		}
		if (c < min)
			min = c;
		if (c > max)
			max = c;
	}
	if (verbose > 0) {
		if (m) {
			printf("*** %d error(s)\n", m);
			printf("    %s: rem/eps min=%d, max=%d\n",
			       str, min, max);
		} else {
			printf("no errors\n");
		}
	}
	if (verbose > 1) {
		printf("    %s: rem/eps min=%0.4d, max=%0.4d\n", str, min, max);
	}
	return m;
}


define cpow(a, b, eps)		/* Find rem/eps for power(a,b,eps) */
{
	local v, v1, c, n, d, h;

	if (isnull(eps))
		eps = epsilon();
	n = num(b);
	d = den(b);

	v = power(a, b, eps);
	h = (a^n/v^d - 1) * v/d;
	c = round(h/eps, 6, 24);
	return c;
}

define testgcd(str, n, verbose)
{
	local i, a, b, g, m;

	if (isnull(verbose)) verbose = 2;
	if (verbose > 0) {
		print str:":",:;
	}
	m = 0;
	for (i = 1; i <= n; i++) {
		if (verbose > 2) print i,:;
		a = rand(1,1e1000);
		b = rand(1,1e1000);
		g = gcd(a,b);
		if (!ismult(a,g) || !ismult(b,g) || !g || !isrel(a/g, b/g)) {
			m++;
			printf("*** Failure for a = %d, b = %d\n", a, b);
		}
	}
	if (verbose > 0) {
		if (m) {
			printf("*** %d error(s)\n", m);
		} else {
			printf("no errors\n");
		}
	}
	return m;
}

define mkreal() = scale(rand(-1000,1001)/rand(1,1000), rand(-100, 101));

define mkcomplex() = mkreal() + 1i * mkreal();

define mkbigreal()
{
	local x;

	x = rand(100, 1000)/rand(1,10);
	if (rand(2))
		x = -x;
	return x;
}

define mksmallreal() = rand(-10, 11)/rand(100,1000);

define testappr(str, n, verbose)
{
	local x, y, z, m, i, p;

	if (isnull(verbose))
		verbose = defaultverbose;
	if (verbose > 0) {
		print str:":",:;
	}
	m = 0;
	for (i = 1; i <= n; i++) {
		x = rand(3) ? mkreal(): mkcomplex();
		y = mkreal();
		if (verbose > 2)
			printf("    %d: x = %d, y = %d\n", i, x, y);

		for (z = 0; z < 32; z++) {
			p = checkappr(x,y,z,verbose);
			if (p) {
				printf("*** Failure for x=%d, y=%d, z=%d\n",
					x, y, z);
				m++;
			}
		}
	}
	if (verbose > 0) {
		if (m) {
			printf("*** %d error(s)\n", m);
		} else {
			printf("no errors\n");
		}
	}
	return m;
}


define checkappr(x,y,z,verbose)		/* Returns 1 if an error is detected */
{
	local a;

	a = appr(x,y,z);
	if (verbose > 1)
		printf("\ta = %d\n", a);
	if (isreal(x))
		return checkresult(x,y,z,a);
	if (isnum(x))
		return checkresult(re(x), y, z, re(a))
			| checkresult(im(x), y, z, im(a));

	quit "Bad first argument for checkappr()";
}

define checkresult(x,y,z,a)	/* tests correctness of a = appr(x,y,z) */
{
	local r, n, s, v;

	if (y == 0)
		return (a != x);
	r = x - a;
	n = a/y;

	if (!isint(n))
		return 1;
	if (abs(r) >= abs(y))
		return 1;
	if (r == 0)
		return 0;
	if (z & 16) {
		if (abs(r) > abs(y)/2)
			return 1;
		if (abs(r) < abs(y)/2)
			return 0;
		z &= 15;
	}
	s = sgn(r);
	switch (z) {
		case 0: v = (s == sgn(y)); break;
		case 1: v = (s == -sgn(y)); break;
		case 2: v = (s == sgn(x)); break;
		case 3: v = (s == -sgn(x)); break;
		case 4: v = (s > 0); break;
		case 5: v = (s < 0); break;
		case 6: v = (s == sgn(x/y)); break;
		case 7: v = (s == -sgn(x/y)); break;
		case 8: v = iseven(n); break;
		case 9: v = isodd(n); break;
		case 10: v = (x/y > 0) ? iseven(n) : isodd(n); break;
		case 11: v = (x/y > 0) ? isodd(n) : iseven(n); break;
		case 12: v = (y > 0) ? iseven(n) : isodd(n); break;
		case 13: v = (y > 0) ? isodd(n) : iseven(n); break;
		case 14: v = (x > 0) ? iseven(n) : isodd(n); break;
		case 15: v = (x > 0) ? isodd(n) : iseven(n); break;
	}
	return !v;
}

/*
 * test2600 - perform all of the above tests a bunch of times
 */
define test2600(verbose, tnum)
{
	local n;	/* test parameter */
	local ep;	/* test parameter */
	local i;

	/* set test parameters */
	n = 5;		/* internal test loop count */
	if (isnull(verbose)) {
		verbose = defaultverbose;
	}
	if (isnull(tnum)) {
		tnum = 1;	/* initial test number */
	}

	/*
	 * test a lot of stuff
	 */
	srand(2600e2600);
	ep = 1e-250;
	err += testismult(strcat(str(tnum++), ": mult"), n*20, verbose);
	err += testappr(strcat(str(tnum++), ": appr"), n*40, verbose);
	err += testexp(strcat(str(tnum++),": exp"), n, ep, verbose);
	err += testln(strcat(str(tnum++),": ln"), n, ep, verbose);
	err += testpower(strcat(str(tnum++),": power"), n,
			 rand(2,10), ep, verbose);
	err += testgcd(strcat(str(tnum++),": gcd"), n, ep, verbose);
	for (i=0; i < 32; ++i) {
		config("sqrt", i);
		err += testsqrt(strcat(str(tnum++),": sqrt",str(i)), n*10,
			        ep, verbose);
	}
	if (verbose > 1) {
		if (err) {
			print "***", err, "error(s) found in test2600";
		} else {
			print "no errors in test2600";
		}
	}
	return tnum;
}

global lib_debug;
if (lib_debug >= 0) {
	print "global defaultverbose defined";
	print "global err defined";
	print "testismult(str,n,verbose) defined";
	print "testsqrt(str,n,eps,verbose) defined";
	print "testexp(str,n,eps,verbose) defined";
	print "testln(str,n,eps,verbose) defined";
	print "testpower(str,n,b,eps,verbose) defined";
	print "testgcd(str,n,verbose) defined";
	print "cpow(x,n,eps) defined";
	print "cexp(x,eps) defined";
	print "cln(x,eps) defined";
	print "mkreal() defined";
	print "mkcomplex() defined";
	print "mkbigreal() defined";
	print "mksmallreal() defined";
	print "testappr(str,n,verbose) defined";
	print "checkappr(x,y,z,verbose) defined";
	print "checkresult(x,y,z,a) defined";
	print "test2600(verbose,tnum) defined";
}