/*
* translate #1 or lx:ly,hx:hy into a result range struct
* returns absolute coords
*/
int
sarg_area(char *str, struct range *rp)
{
long rlm;
struct natstr *np;
struct realmstr realm;
char *end;
if (*str == '#') {
/*
* realm #X where (X > 0 && X < MAXNOR)
* Assumes realms are in abs coordinates
*/
if (*++str) {
rlm = strtol(str, &end, 10);
if (end == str || (*end != 0 && !isspace(*end))
|| rlm < 0 || MAXNOR <= rlm)
return 0;
} else
rlm = 0;
getrealm(rlm, player->cnum, &realm);
rp->lx = realm.r_xl;
rp->hx = realm.r_xh;
rp->ly = realm.r_yl;
rp->hy = realm.r_yh;
} else {
/*
* full map specification
* LX:LY,HX:HY where
* ly, hy are optional.
*/
rp->lx = rp->hx = strtox(str, &str);
if (rp->lx < 0)
return 0;
if (*str == ':') {
rp->hx = strtox(str + 1, &str);
if (rp->hx < 0)
return 0;
}
if (*str++ != ',')
return 0;
rp->ly = rp->hy = strtoy(str, &str);
if (rp->ly < 0)
return 0;
if (*str == ':') {
rp->hy = strtoy(str + 1, &str);
if (rp->hy < 0)
return 0;
}
if (*str != 0 && !isspace(*str))
return 0;
np = getnatp(player->cnum);
rp->lx = xabs(np, rp->lx);
rp->hx = xabs(np, rp->hx);
rp->ly = yabs(np, rp->ly);
rp->hy = yabs(np, rp->hy);
}
xysize_range(rp);
return 1;
}
// COMPUTES L2 FIXED-SHIFT H POLYNOMIALS AND TESTS FOR CONVERGENCE.
// INITIATES A VARIABLE-SHIFT ITERATION AND RETURNS WITH THE
// APPROXIMATE ZERO IF SUCCESSFUL.
// L2 - LIMIT OF FIXED SHIFT STEPS
// ZR,ZI - APPROXIMATE ZERO IF CONV IS .TRUE.
// CONV - LOGICAL INDICATING CONVERGENCE OF STAGE 3 ITERATION
//
static bool fxshft(const int l2, int deg, xcomplex *P, xcomplex *p, xcomplex *H, xcomplex *h, xcomplex *zero, xcomplex *s){
bool bol, conv; // boolean for convergence of stage 2
bool test, pasd;
xcomplex old_T, old_S, Ps, t;
xcomplex Tmp[deg+1];
Ps = polyev(deg, *s, P, p);
test = true;
pasd = false;
// Calculate first T = -P(S)/H(S)
t = calct(&bol, deg, Ps, H, h, *s);
// Main loop for second stage
for(int j = 1; j <= l2; j++){
old_T = t;
// Compute the next H Polynomial and new t
nexth(bol, deg, t, H, h, p);
t = calct(&bol, deg, Ps, H, h, *s);
*zero = *s + t;
// Test for convergence unless stage 3 has failed once or this
// is the last H Polynomial
if(!(bol || !test || j == l2)){
if(xabs(t - old_T) < 0.5 * xabs(*zero)) {
if(pasd) {
// The weak convergence test has been passwed twice, start the third stage
// Iteration, after saving the current H polynomial and shift
for(int i = 0; i < deg; i++)
Tmp[i] = H[i];
old_S = *s;
conv = vrshft(10, deg, P, p, H, h, zero, s);
if(conv) return conv;
//The iteration failed to converge. Turn off testing and restore h,s,pv and T
test = false;
for(int i = 0; i < deg; i++)
H[i] = Tmp[i];
*s = old_S;
Ps = polyev(deg, *s, P, p);
t = calct(&bol, deg, Ps, H, h, *s);
continue;
}
pasd = true;
}
else
pasd = false;
}
}
// Attempt an iteration with final H polynomial from second stage
conv = vrshft(10, deg, P, p, H, h, zero, s);
return conv;
}
// BOUNDS THE ERROR IN EVALUATING THE POLYNOMIAL BY THE HORNER RECURRENCE.
// QR,QI - THE PARTIAL SUMS
// MS -MODULUS OF THE POINT
// MP -MODULUS OF POLYNOMIAL VALUE
// ARE, MRE -ERROR BOUNDS ON COMPLEX ADDITION AND MULTIPLICATION
//
static xreal errev(const int deg, const xcomplex *p, const xreal ms, const xreal mp){
xreal MRE = 2.0 * sqrt(2.0) * xeta(p[0]);
xreal e = xabs(p[0]) * MRE / (xeta(p[0]) + MRE);
for(int i = 0; i <= deg; i++)
e = e * ms + xabs(p[i]);
return e * (xeta(p[0]) + MRE) - MRE * mp;
}
/*
* translate @x,y:int into
* result params
*/
int
sarg_range(char *str, coord *xp, coord *yp, int *dist)
{
coord x, y;
long d;
char *end;
struct natstr *np;
if (*str++ != '@')
return 0;
x = strtox(str, &str);
if (x < 0 || *str++ != ',')
return 0;
y = strtoy(str, &str);
if (y < 0 || *str++ != ':')
return 0;
d = strtol(str, &end, 10);
if (end == str || (*end != 0 && !isspace(*end)) || d < 0)
return 0;
*dist = d;
np = getnatp(player->cnum);
*xp = xabs(np, x);
*yp = yabs(np, y);
return 1;
}
struct cxpr
cxatanh (struct cxpr z)
{
struct cxpr w;
struct xpr t;
int errcond;
t = xadd (xabs (z.re), xOne, 1);
errcond = xsgn (&z.im) == 0 && xsgn (&t) == 0;
if (xsigerr (errcond, XEDOM, "cxatanh()"))
return cxZero;
else
{
w = cxdiv (cxsum (cxOne, z), cxsub (cxOne, z));
w = cxlog_sqrt (w);
return w;
}
}
// CAUCHY COMPUTES A LOWER BOUND ON THE MODULI OF THE ZEROS OF A
// POLYNOMIAL - PT IS THE MODULUS OF THE COEFFICIENTS.
//
static xcomplex cauchy(const int deg, xcomplex *P)
{
xreal x, xm, f, dx, df, tmp[deg+1];
for(int i = 0; i<=deg; i++){ tmp[i] = xabs(P[i]); };
// Compute upper estimate bound
x = xroot(tmp[deg],deg) / xroot(tmp[0],deg);
if(tmp[deg - 1] != 0.0) {
// Newton step at the origin is better, use it
xm = tmp[deg] / tmp[deg-1];
if (xm < x) x = xm;
}
tmp[deg] = -tmp[deg];
// Chop the interval (0,x) until f < 0
while(1) {
xm = x * 0.1;
// Evaluate the polynomial <tmp> at <xm>
f = tmp[0];
for(int i = 1; i <= deg; i++)
f = f * xm + tmp[i];
if(f <= 0.0) break;
x = xm;
}
dx = x;
// Do Newton iteration until x converges to two decimal places
while(fabs(dx / x) > 0.005) {
f = tmp[0];
df = 0.0;
for(int i = 1; i <= deg; i++){
df = df * x + f;
f = f * x + tmp[i];
}
dx = f / df;
x -= dx; // Newton step
}
return (xcomplex)(x);
}
int
sarg_xy(char *str, coord *xp, coord *yp)
{
coord x, y;
struct natstr *np;
x = strtox(str, &str);
if (x < 0 || *str++ != ',')
return 0;
y = strtoy(str, &str);
if (y < 0 || (*str != 0 && !isspace(*str)))
return 0;
if ((x ^ y) & 1)
return 0;
np = getnatp(player->cnum);
*xp = xabs(np, x);
*yp = yabs(np, y);
return 1;
}
/*
* setup the nstr_sect structure for sector selection.
* can select on either NS_ALL, NS_AREA, or NS_DIST
* iterate thru the "condarg" string looking
* for arguments to compile into the nstr.
* Using this function for anything but command arguments is usually
* incorrect, because it respects conditionals. Use the snxtsct_FOO()
* instead.
*/
int
snxtsct(struct nstr_sect *np, char *str)
{
struct range range;
struct natstr *natp;
coord cx, cy;
int dist;
char buf[1024];
if (!str || !*str) {
if (!(str = getstring("(sects)? ", buf)))
return 0;
} else
make_stale_if_command_arg(str);
switch (sarg_type(str)) {
case NS_AREA:
if (!sarg_area(str, &range))
return 0;
snxtsct_area(np, &range);
break;
case NS_DIST:
if (!sarg_range(str, &cx, &cy, &dist))
return 0;
snxtsct_dist(np, cx, cy, dist);
break;
case NS_ALL:
/*
* Can't use snxtsct_all(), as it would disclose the real
* origin. Use a world-sized area instead.
*/
natp = getnatp(player->cnum);
range.lx = xabs(natp, -WORLD_X / 2);
range.ly = yabs(natp, -WORLD_Y / 2);
range.hx = xnorm(range.lx + WORLD_X - 1);
range.hy = ynorm(range.ly + WORLD_Y - 1);
xysize_range(&range);
snxtsct_area(np, &range);
break;
default:
return 0;
}
return snxtsct_use_condarg(np);
}
// CARRIES OUT THE THIRD STAGE ITERATION.
// L3 - LIMIT OF STEPS IN STAGE 3.
// ZR,ZI - ON ENTRY CONTAINS THE INITIAL ITERATE, IF THE
// ITERATION CONVERGES IT CONTAINS THE FINAL ITERATE ON EXIT.
// CONV - .TRUE. IF ITERATION CONVERGES
//
static bool vrshft(const int l3, int deg, xcomplex *P, xcomplex *p, xcomplex *H, xcomplex *h, xcomplex *zero, xcomplex *s){
bool bol, conv, b;
int i, j;
xcomplex Ps, t;
xreal mp, ms, omp = 0.0, relstp = 0.0, tp;
conv = b = false;
*s = *zero;
// Main loop for stage three
for(i = 1; i <= l3; i++) {
// Evaluate P at S and test for convergence
Ps = polyev(deg, *s, P, p);
mp = xabs(Ps);
ms = xabs(*s);
if(mp <= 20 * errev(deg, p, ms, mp)) {
// Polynomial value is smaller in value than a bound on the error
// in evaluating P, terminate the iteration
conv = true;
*zero = *s;
return conv;
}
if(i != 1) {
if(!(b || mp < omp || relstp >= 0.05)){
// if(!(b || xlogb(mp) < omp || real(relstp) >= 0.05)){
// Iteration has stalled. Probably a cluster of zeros. Do 5 fixed
// shift steps into the cluster to force one zero to dominate
tp = relstp;
b = true;
if(relstp < xeta(P[0])) tp = xeta(P[0]);
*s *= 1.0 + (1.0+1.0i)*sqrt(tp);
Ps = polyev(deg, *s, P, p);
for(j = 1; j <= 5; j++){
t = calct(&bol, deg, Ps, H, h, *s);
nexth(bol, deg, t, H, h, p);
}
omp = xdata.INFIN;
goto _20;
}
// Exit if polynomial value increase significantly
if(mp * 0.1 > omp) return conv;
}
omp = mp;
// Calculate next iterate
_20: t = calct(&bol, deg, Ps, H, h, *s);
nexth(bol, deg, t, H, h, p);
t = calct(&bol, deg, Ps, H, h, *s);
if(!bol) {
relstp = xabs(t) / xabs(*s);
*s += t;
}
} // end for
return conv;
}