Sindbad~EG File Manager
/* M. Beeson, root finder and drawer for Mathpert.
Find all complex roots of a complex polynomial using
Newton's method, but choosing a new starting value at
random if the iteration gets more than ten times larger
than a bound on the roots. Draw the roots as they are
computed.
*/
/*
4.5.91 original date
2.3.98 last modified
2.24.24 changed include cgraph. to svgGraph.h and svgDevice to svgDevice
modified place_root to not mention printer.
removed unused variable in place_root
2.25.24 removed call to get_aspect
2.28.24 used double coordinates in place_root.
*/
#include <assert.h>
#include <math.h>
#include <stdlib.h> /* memset */
#include "globals.h"
#include "graphstr.h"
#include "svgGraph.h"
#include "dcomplex.h"
#include "ceval.h"
#include "newton.h"
#include "polyroot.h"
#include "mpmem.h"
#include "deval.h"
#include "drandom.h"
#define ROUNDOFF(x) (int)((x)+0.5)
static int zroots(graph *, dcomplex *a,int m);
static void place_root(graph *g, double x, double y, int j);
/*______________________________________________________*/
int polyroot(graph *g, term t, int *nroots)
/* t is a polynomial, i.e. a term with functor POLY whose args are terms
representing the coefficients. Nonzero return is an error;
1 is the only possible error value . It calls zroots, which draws the
roots on-screen one by one as they are computed. Arrays of pixel
coordinates are allocated as documented by zroots, and freed here.
Because there are numerical troubles in case of x^n-1, for large n,
and because it's a common example, we trap that case and calculate the
roots directly.
The coefficients of t can contain variables; ceval is used to evaluate
the coefficients, so depending on the current values of those variables,
the degree of t with its coefficients numerically evaluated may be
less than the degree of t. Hence the number of roots may be
less than the degree of t. This number will be placed in *nroots.
If the polynomial turns out to be identically zero, -1 will be placed
in nroots.
*/
{ int i,j,err;
dcomplex *a; /* coefficients of the polynomial */
int m = ARITY(t) -1; /* degree of the poly */
int count = 0; /* count the nonzero coefficients */
double c,x,y,phase=0.0;
term u;
assert(m >=0);
if(m==0)
return 1; /* can't use this on a constant poly */
/* First trap the case when t is divisible by a power of x greater than 1 */
if(ZERO(ARG(0,t)) && ZERO(ARG(1,t)))
{ for(i=1;i<=m;i++)
{ if(!ZERO(ARG(i+1,t)))
break;
}
assert(i+1<=m); /* some coefficient must be nonzero */
u = make_term(POLY,(unsigned short)(m-i+1));
for(j=0;j<m-i+1;j++)
ARGREP(u,j,ARG(j+i,t)); /* this puts ONE zero coefficient in */
t = u;
m = ARITY(t) - 1;
}
if(g->nroots != 0 && g->nroots != m)
{ free2(g->root_xcoords);
free2(g->root_ycoords);
g->nroots = 0;
}
if(g->nroots == 0)
{ g->nroots = m;
g->root_xcoords = callocate(m,sizeof(double));
g->root_ycoords = callocate(m,sizeof(double));
}
a = (dcomplex *) callocate(ARITY(t), sizeof(dcomplex));
if(g->root_xcoords == NULL || g->root_ycoords == NULL || a == NULL)
nospace();
if(!is_complex(t)) /* real coefficients, so use deval */
{ for(i=0;i<=m;i++)
{ deval(ARG(i,t),&a[i].r);
a[i].i = 0.0;
if(a[i].r!=0.0)
++count;
else if(fabs(a[i].r) < VERYSMALL)
a[i].r = 0.0;
}
if(count == 2)
{ /* trap x^m - a, don't send it to zroots as it is numerically
particularly difficult for large m, and a common case too.
This also traps x^m - ax and x^m + ax etc.
*/
if(a[0].r == 0.0)
{ place_root(g,0.0,0.0,1);
c = -a[m].r/a[1].r;
assert(m > 1);
if(c < 0.0)
{ c = -c;
phase = PI_DECIMAL/(m-1);
}
if(c != 1.0 )
c = 1.0 / pow(c,1.0/(m-1));
for(j=1;j<m;j++)
{ x = c * cos( j * 2.0 * PI_DECIMAL/(m-1) + phase);
y = c * sin( j * 2.0 * PI_DECIMAL/(m-1) + phase);
place_root(g,x,y,j+1);
}
}
else
{ c = -a[m].r / a[0].r;
if(c < 0.0)
{ c = -c;
phase = PI_DECIMAL/m;
}
if(c != 1.0)
c = 1.0 / pow(c,1.0/m);
for(j=0;j<m;j++)
{ x = c * cos( j * 2.0 * PI_DECIMAL / m + phase);
y = c * sin( j * 2.0 * PI_DECIMAL / m + phase);
place_root(g,x,y,j+1); /* place_root wants indices starting at 1 */
}
}
free2(a); /* allocated above */
return 0;
}
}
else /* complex coefficients, so use ceval */
{ for(i=0;i<=m;i++)
{ ceval(ARG(i,t),&a[i]);
if(fabs(a[i].r) < VERYSMALL)
a[i].r = 0.0;
if(fabs(a[i].i) < VERYSMALL)
a[i].i = 0.0;
}
}
/* The polynomial t can contain variables in the coefficients. When
ceval is used on them, they can possibly have value zero. So the
degree of the polynomial with numerically evaluated coefficients might
be less than m. The polynomial might even be identically zero! Let's
check for this. */
for(i=m;i>=0;i--)
{ if(fabs(a[i].r) != 0.0 || fabs(a[i].i) != 0.0)
break;
}
if(i < 0)
{ /* polynomial was identically zero */
*nroots = 1;
return 0;
}
if(i==0)
{ /* polynomial is constant but not zero */
*nroots = 0;
return 0;
}
m = i;
*nroots = m;
err = zroots(g,a,m); /* calculate and draw the roots */
free2(a); /* allocated above */
return err;
}
/*zroots_____________________________________________________________*/
/* I removed parameter 'polish' from zroots and made it return an error value */
/* Made it polish the roots for degree 3 or more */
/* even for x^3 they are off in the fourth decimal place without polishing */
/* and made it restart randomly with a square containing the roots when newton
does fail */
/* and put in dynamic allocation of 'ad' to remove artificial limit on degree */
/* Return value is 0 for success, 1 if newton fails after MAXFAILURES
random restarts */
#define EPS 2.0e-14 /* keep much more accuracy than in Num Recipes code */
#define MAXFAILURES 200
static int zroots(graph *g, dcomplex *a,int m)
/* Code much modified but originating from Numerical Recipes zroots
on p. 281 of Numerical Recipes.
a is the array of coefficients of the polynomial (a[i] x^i);
m is the degree;
The function creates arrays pleft and ptop of pixel coordinates used
by putimage to draw the roots, and needed by polyroot to erase them.
These arrays are stashed in space presumed to be pre-allocated,at
g->root_xcoords and g->root_ycoords, which are declared
as (int *); and their dimension is presumed already stored in g->nroots.
The old roots are erased, or the whole screen is erased and the axes redrawn,
before arriving here. This function draws the roots on-screen and does
not store them anyplace as doubles; it keeps integer arrays of pixel
coordinates stashed at the places just stated.
*/
{ int jj,j;
int err;
double bound;
int timesfailed;
int polish = 1; /* (m > 2 ? 1 : 0); */
dcomplex x,b,c,*ad;
g->newaxes = 0; /* may have been set to 1 last
time and should be left 0 until we encounter an
overlapping root. */
ad = (dcomplex *) callocate(m+1,sizeof(dcomplex));
for(j=0;j<=m;j++) ad[j]=a[j];
/* By Exercise 20, p. 438 vol. 2 of Knuth, a bound
for the roots is the sqrt of the sum of squares
of the absolute values of the coefficients,
divided by the leading coef, ad[m] */
bound=0.0;
for(j=0;j<=m;j++)
{ bound += ad[j].r * ad[j].r + ad[j].i * ad[j].i;
}
bound /= (ad[m].r *ad[m].r + ad[m].i* ad[m].i);
bound = sqrt(bound);
for(j=m;j>=1;j--)
{ /* choose starting value; avoid zeros of a' */
timesfailed = 0;
err = 1; /* to get the loop started */
while(err)
{ /* choose starting value at random */
x.r = 2*(drandom() - 0.5) * bound; /* using 'factor' guarantees computation order here */
x.i = 2*(drandom()-0.5) * bound;
err = newton(ad,j,&x,EPS,0,10.0 * bound);
if(err)
++timesfailed;
if(timesfailed > MAXFAILURES)
return 1;
if(!err && polish) /* polish using undeflated coefficients */
err = newton(a,m,&x,EPS,1,10.0 *bound);
}
if (fabs(x.i) <= (2.0*EPS*fabs(x.r)))
x.i=0.0; /* correct for what is probably roundoff error */
place_root(g,x.r,x.i,j);
b=ad[j];
for(jj=j-1;jj>=0;jj--)
/* deflate AFTER polishing */
{ c=ad[jj];
ad[jj]=b;
b=Cplus(Cmul(x,b),c);
}
}
free2(ad);
return 0;
}
/*___________________________________________________________________*/
static void place_root(graph *g, double x, double y, int j)
/* draw the j-th root at (x,y), and record the upper left coordinates
for the spot in g->root_xcoords[j-1] and g->root_ycoords[j-1].
Here j starts from 1, not 0.
*/
{
int hradius,vradius,m;
// int k,hdistance,vdistance;
svgDevice *device = get_device();
double radius;
double *pleft = g->root_xcoords-1; /* -1 so the legal accesses start from pleft[1] */
double *ptop = g->root_ycoords-1;
/* space to record where the roots are written by putimage */
hradius = (int) g->linewidth;
if(hradius < 3)
hradius = 3; /* minimum three pixels */
vradius = ROUNDOFF( hradius * device->numypixels/(device->numxpixels));
/* vertical radius of filled circle in device coordinates */
if(vradius < 3)
vradius = 3; /* minimum three pixels */
radius = device -> xpixel * hradius; /* world coord horiz radius */
m = g->nroots;
filled_circle(x,y,radius);
world_to_pixel(x,y,(pleft+j),(ptop+j));
/* now pleft[j] and ptop[j] are the pixel coords of the
center of the new image */
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists