mirror of
https://github.com/lcn2/calc.git
synced 2025-08-16 01:03:29 +03:00
db77e29a23
Converted all ASCII tabs to ASCII spaces using a 8 character tab stop, for all files, except for all Makefiles (plus rpm.mk). The `git diff -w` reports no changes.
328 lines
9.5 KiB
Plaintext
328 lines
9.5 KiB
Plaintext
/*
|
|
* test2700.isqrt - test complex sqrt for test 27dd
|
|
*
|
|
* Copyright (C) 1999,2021,2023 Ernest Bowen and Landon Curt Noll
|
|
*
|
|
* Primary author: Ernest Bowen
|
|
*
|
|
* Calc is open software; you can redistribute it and/or modify it under
|
|
* the terms of the version 2.1 of the GNU Lesser General Public License
|
|
* as published by the Free Software Foundation.
|
|
*
|
|
* Calc is distributed in the hope that it will be useful, but WITHOUT
|
|
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
|
|
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
|
|
* Public License for more details.
|
|
*
|
|
* A copy of version 2.1 of the GNU Lesser General Public License is
|
|
* distributed with calc under the filename COPYING-LGPL. You should have
|
|
* received a copy with calc; if not, write to Free Software Foundation, Inc.
|
|
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
*
|
|
* Under source code control: 1995/11/01 22:52:25
|
|
* File existed as early as: 1995
|
|
*
|
|
* Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
|
|
*/
|
|
|
|
/*
|
|
* The following resource file gives a severe test of sqrt(x,y,z) for
|
|
* all 128 values of z, randomly produced real and complex x, and randomly
|
|
* produced nonzero values for y. After loading it, testcsqrt(n) will
|
|
* test n combinations of x and y; testcsqrt(str,n,2) will print 1 2 3 ...
|
|
* indicating work in process; testcsqrt(str,n,3) will give information about
|
|
* errors detected and will print values of x and y used.
|
|
* I've also defined a function iscomsq(x) which does for complex as well
|
|
* as real x what issq(x) currently does for real x.
|
|
*/
|
|
|
|
|
|
defaultverbose = 1;
|
|
|
|
define mknonnegreal() {
|
|
switch(rand(8)) {
|
|
case 0: return rand(20);
|
|
case 1: return rand(20,1000);
|
|
case 2: return rand(1,10000)/rand(1,100);
|
|
case 3: return scale(mkposreal(), rand(1,100));
|
|
case 4: return scale(mkposreal(), -rand(1,100));
|
|
case 5: return rand(1, 1000) + scale(mkfrac(),-rand(1,100));
|
|
case 6: return mkposreal()^2;
|
|
case 7: return mkposreal() * (1+scale(mkfrac(),-rand(1,100)));
|
|
}
|
|
}
|
|
|
|
define mkposreal() {
|
|
local x;
|
|
|
|
x = mknonnegreal();
|
|
while (x == 0)
|
|
x = mknonnegreal();
|
|
return x;
|
|
}
|
|
|
|
define mkreal_2700() = rand(2) ? mknonnegreal() : -mknonnegreal();
|
|
|
|
define mknonzeroreal() = rand(2) ? mkposreal() : -mkposreal();
|
|
|
|
/* Number > 0 and < 1, almost uniformly distributed */
|
|
define mkposfrac() {
|
|
local x,y;
|
|
|
|
x = rand(1,1000);
|
|
do
|
|
y = rand(1,1000);
|
|
while (y == x);
|
|
if (x > y)
|
|
swap(x,y);
|
|
return x/y;
|
|
}
|
|
|
|
/* Nonzero > -1 and < 1 */
|
|
define mkfrac() = rand(2) ? mkposfrac() : -mkposfrac();
|
|
|
|
define mksquarereal() = mknonnegreal()^2;
|
|
|
|
/*
|
|
* We might be able to do better than the following. For non-square
|
|
* positive integer less than 1e6, could use:
|
|
* x = rand(1, 1000);
|
|
* return rand(x^2 + 1, (x + 1)^2);
|
|
* Maybe could do:
|
|
* do
|
|
* x = mkreal_2700();
|
|
* while
|
|
* (issq(x));
|
|
* This would of course not be satisfactory for testing issq().
|
|
*/
|
|
|
|
define mknonsquarereal() = 22 * mkposreal()^2/7;
|
|
|
|
define mkcomplex_2700() = mkreal_2700() + 1i * mkreal_2700();
|
|
|
|
define testcsqrt(str, n, verbose)
|
|
{
|
|
local x, y, z, m, i, p, v;
|
|
|
|
if (isnull(verbose))
|
|
verbose = defaultverbose;
|
|
if (verbose > 0) {
|
|
print str:":",:;
|
|
}
|
|
m = 0;
|
|
for (i = 1; i <= n; i++) {
|
|
if (verbose > 1) print i,:;
|
|
x = rand(3) ? mkreal_2700(): mkcomplex_2700();
|
|
y = scale(mknonzeroreal(), -100);
|
|
if (verbose > 2)
|
|
printf("%d: x = %d, y = %d\n", i, x, y);
|
|
|
|
for (z = 0; z < 128; z++) {
|
|
v = sqrt(x,y,z);
|
|
p = checksqrt(x,y,z,v);
|
|
if (p) {
|
|
if (verbose > 0)
|
|
printf(
|
|
"*** Type %d failure for x = %r, "
|
|
"y = %r, z = %d\n",
|
|
p, x, y, z);
|
|
m++;
|
|
}
|
|
}
|
|
}
|
|
if (verbose > 0) {
|
|
if (m) {
|
|
printf("*** %d error(s)\n", m);
|
|
} else {
|
|
printf("no errors\n");
|
|
}
|
|
}
|
|
return m;
|
|
}
|
|
|
|
|
|
define checksqrt(x,y,z,v) /* Returns >0 if an error is detected */
|
|
{
|
|
local A, B, X, Y, t1, t2, eps, u, n, f, s;
|
|
|
|
A = re(x);
|
|
B = im(x);
|
|
X = re(v);
|
|
Y = im(v);
|
|
|
|
/* checking signs of X and Y */
|
|
|
|
if (B == 0 && A <= 0) /* t1 = sgn(re(tvsqrt)) */
|
|
t1 = 0;
|
|
else
|
|
t1 = (z & 64) ? -1 : 1;
|
|
|
|
t2 = B ? sgn(B) : (A < 0); /* t2 = sgn(im(tvsqrt)) */
|
|
if (z & 64)
|
|
t2 = -t2;
|
|
|
|
if (t1 == 0 && X != 0)
|
|
return 1;
|
|
|
|
if (t2 == 0 && Y != 0) {
|
|
printf("x = %d, Y = %d, t2 = %d\n", x, Y, t2);
|
|
return 2;
|
|
}
|
|
|
|
if (X && sgn(X) != t1)
|
|
return 3;
|
|
|
|
if (Y && sgn(Y) != t2)
|
|
return 4;
|
|
|
|
if (z & 32 && iscomsq(x))
|
|
return 5 * (x != v^2);
|
|
|
|
eps = (z & 16) ? abs(y)/2 : abs(y);
|
|
u = sgn(y);
|
|
|
|
/* Checking X */
|
|
|
|
n = X/y;
|
|
if (!isint(n))
|
|
return 6;
|
|
|
|
if (t1) {
|
|
f = checkavrem(A, B, abs(X), eps);
|
|
|
|
if (z & 16 && f < 0)
|
|
return 7;
|
|
if (!(z & 16) && f <= 0)
|
|
return 8;
|
|
|
|
if (!(z & 16) || f == 0) {
|
|
s = X ? t1 * sgn(A - X^2 + B^2/4/X^2) : t1;
|
|
if (s && !checkrounding(s,n,t1,u,z))
|
|
return 9;
|
|
}
|
|
}
|
|
|
|
/* Checking Y */
|
|
|
|
n = Y/y;
|
|
if (!isint(n))
|
|
return 10;
|
|
|
|
if (t2) {
|
|
f = checkavrem(-A, B, abs(Y), eps);
|
|
|
|
if (z & 16 && f < 0)
|
|
return 11;
|
|
if (!(z & 16) && f <= 0)
|
|
return 12;
|
|
|
|
if (!(z & 16) || f == 0) {
|
|
s = Y ? t2 * sgn(-A - Y^2 + B^2/4/Y^2) : t2;
|
|
if (s && !checkrounding(s,n,t2,u,z))
|
|
return 13;
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
/*
|
|
* Check that the calculated absolute value X of the real part of
|
|
* sqrt(A + Bi) is between (true value - eps) and (true value + eps).
|
|
* Returns -1 if it is outside, 0 if on boundary, 1 if between.
|
|
*/
|
|
|
|
define checkavrem(A, B, X, eps)
|
|
{
|
|
local f;
|
|
|
|
f = sgn(A - (X + eps)^2 + B^2/4/(X + eps)^2);
|
|
if (f > 0)
|
|
return -1; /* X < tv - eps */
|
|
if (f == 0)
|
|
return 0; /* X = tv - eps */
|
|
|
|
if (X > eps) {
|
|
f = sgn(A - (X - eps)^2 + B^2/4/(X - eps)^2);
|
|
|
|
if (f < 0)
|
|
return -1; /* X > tv + eps */
|
|
if (f == 0)
|
|
return 0; /* X = tv + eps */
|
|
}
|
|
return 1; /* tv - eps < X < tv + eps */
|
|
}
|
|
|
|
|
|
define checkrounding(s,n,t,u,z)
|
|
{
|
|
local w;
|
|
|
|
switch (z & 15) {
|
|
case 0: w = (s == u); break;
|
|
case 1: w = (s == -u); break;
|
|
case 2: w = (s == t); break;
|
|
case 3: w = (s == -t); break;
|
|
case 4: w = (s > 0); break;
|
|
case 5: w = (s < 0); break;
|
|
case 6: w = (s == u/t); break;
|
|
case 7: w = (s == -u/t); break;
|
|
case 8: w = iseven(n); break;
|
|
case 9: w = isodd(n); break;
|
|
case 10: w = (u/t > 0) ? iseven(n) : isodd(n); break;
|
|
case 11: w = (u/t > 0) ? isodd(n) : iseven(n); break;
|
|
case 12: w = (u > 0) ? iseven(n) : isodd(n); break;
|
|
case 13: w = (u > 0) ? isodd(n) : iseven(n); break;
|
|
case 14: w = (t > 0) ? iseven(n) : isodd(n); break;
|
|
case 15: w = (t > 0) ? isodd(n) : iseven(n); break;
|
|
}
|
|
return w;
|
|
}
|
|
|
|
define iscomsq(x)
|
|
{
|
|
local c;
|
|
|
|
if (isreal(x))
|
|
return issq(abs(x));
|
|
c = norm(x);
|
|
if (!issq(c))
|
|
return 0;
|
|
return issq((re(x) + sqrt(c,1,32))/2);
|
|
}
|
|
|
|
/*
|
|
* test2700 - perform all of the above tests a bunch of times
|
|
*/
|
|
define test2700(verbose, tnum)
|
|
{
|
|
local n; /* test parameter */
|
|
local ep; /* test parameter */
|
|
local i;
|
|
|
|
/* set test parameters */
|
|
n = 32; /* internal test loop count */
|
|
if (isnull(verbose)) {
|
|
verbose = defaultverbose;
|
|
}
|
|
if (isnull(tnum)) {
|
|
tnum = 1; /* initial test number */
|
|
}
|
|
|
|
/*
|
|
* test a lot of stuff
|
|
*/
|
|
srand(2700e2700);
|
|
for (i=0; i < n; ++i) {
|
|
err += testcsqrt(strcat(str(tnum++),": complex sqrt",str(i)),
|
|
1, verbose);
|
|
}
|
|
if (verbose > 1) {
|
|
if (err) {
|
|
print "***", err, "error(s) found in testall";
|
|
} else {
|
|
print "no errors in testall";
|
|
}
|
|
}
|
|
return tnum;
|
|
}
|