void CPoly<T>::calct( int *bol )
{
int n;
T hvr, hvi;
n = nn;
// evaluate h(s)
polyev( n - 1, sr, si, hr, hi, qhr, qhi, &hvr, &hvi );
*bol = cmod( hvr, hvi ) <= are * 10 * cmod( hr[ n - 1 ], hi[ n - 1 ] ) ? 1 : 0;
if( !*bol )
{
cdivid( -pvr, -pvi, hvr, hvi, &tr, &ti );
return;
}
tr = 0;
ti = 0;
}
void CPoly<T>::noshft( const int l1 )
{
int i, j, jj, n, nm1;
T xni, t1, t2;
n = nn;
nm1 = n - 1;
for( i = 0; i < n; i++ )
{
xni = (T) (nn - i);
hr[ i ] = xni * pr[ i ] / n;
hi[ i ] = xni * pi[ i ] / n;
}
for( jj = 1; jj <= l1; jj++ )
{
if( cmod( hr[ n - 1 ], hi[ n - 1 ] ) > eta * 10 * cmod( pr[ n - 1 ], pi[ n - 1 ] ) )
{
cdivid( -pr[ nn ], -pi[ nn ], hr[ n - 1 ], hi[ n - 1 ], &tr, &ti );
for( i = 0; i < nm1; i++ )
{
j = nn - i - 1;
t1 = hr[ j - 1 ];
t2 = hi[ j - 1 ];
hr[ j ] = tr * t1 - ti * t2 + pr[ j ];
hi[ j ] = tr * t2 + ti * t1 + pi[ j ];
}
hr[ 0 ] = pr[ 0 ];
hi[ 0 ] = pi[ 0 ];
}
else
{
// If the constant term is essentially zero, shift H coefficients
for( i = 0; i < nm1; i++ )
{
j = nn - i - 1;
hr[ j ] = hr[ j - 1 ];
hi[ j ] = hi[ j - 1 ];
}
hr[ 0 ] = 0;
hi[ 0 ] = 0;
}
}
}
static int calct(void)
/* Computes t = -p(s)/h(s)
Returns TRUE if h(s) is essentially zero
*/
{
double hvr,hvi;
int n = nn-1, boolvar;
/* Evaluate h(s) */
polyev(n,sr,si,hr,hi,qhr,qhi,&hvr,&hvi);
boolvar = (cmod(hvr,hvi) <= are*10.0*cmod(hr[n-1],hi[n-1]));
if (!boolvar) {
cdivid(-pvr,-pvi,hvr,hvi,&tr,&ti);
} else {
tr = 0.0;
ti = 0.0;
}
return boolvar;
}
static void noshft(int l1)
{
int i, j, jj, n = nn - 1, nm1 = n - 1;
double t1, t2, xni;
for (i=0; i < n; i++) {
xni = (double)(nn - i - 1);
hr[i] = xni * pr[i] / n;
hi[i] = xni * pi[i] / n;
}
for (jj = 1; jj <= l1; jj++) {
if (hypot(hr[n-1], hi[n-1]) <=
eta * 10.0 * hypot(pr[n-1], pi[n-1])) {
/* If the constant term is essentially zero, */
/* shift h coefficients. */
for (i = 1; i <= nm1; i++) {
j = nn - i;
hr[j-1] = hr[j-2];
hi[j-1] = hi[j-2];
}
hr[0] = 0.;
hi[0] = 0.;
}
else {
cdivid(-pr[nn-1], -pi[nn-1], hr[n-1], hi[n-1], &tr, &ti);
for (i = 1; i <= nm1; i++) {
j = nn - i;
t1 = hr[j-2];
t2 = hi[j-2];
hr[j-1] = tr * t1 - ti * t2 + pr[j-1];
hi[j-1] = tr * t2 + ti * t1 + pi[j-1];
}
hr[0] = pr[0];
hi[0] = pi[0];
}
}
}
static void noshft(int l1)
{
/* Computes the derivative polynomial as the initial h
polynomial and computes l1 no-shift h polynomials. */
double xni,t1,t2;
int i,j,jj,n = nn-1,nm1 = n-1,nm2=nm1-1;
for (i=0;i<n;i++) {
xni = n-i;
hr[i] = xni*pr[i]/((double)(n));
hi[i] = xni*pi[i]/((double)(n));
}
for (jj=0;jj<l1;jj++) {
if (cmod(hr[nm2],hi[nm2]) > eta*10.0*cmod(pr[nm2],pi[nm2])) {
cdivid(-pr[n],-pi[n],hr[nm1],hi[nm1],&tr,&ti);
for (i=0;i<nm1;i++) {
j = nm1-i;
t1 = hr[j-1];
t2 = hi[j-1];
hr[j] = tr*t1-ti*t2+pr[j];
hi[j] = tr*t2+ti*t1+pi[j];
}
hr[0] = pr[0];
hi[0] = pi[0];
} else {
/* If the constant term is essentially zero, shift h coefficients */
for (i=0;i<nm1;i++) {
j = nm1-i;
hr[j] = hr[j-1];
hi[j] = hi[j-1];
}
hr[0] = 0.0;
hi[0] = 0.0;
}
}
}
static void R_cpolyroot(double *opr, double *opi, int *degree,
double *zeror, double *zeroi, Rboolean *fail)
{
static const double smalno = DBL_MIN;
static const double base = (double)FLT_RADIX;
static int d_n, i, i1, i2;
static double zi, zr, xx, yy;
static double bnd, xxx;
Rboolean conv;
int d1;
double *tmp;
static const double cosr =/* cos 94 */ -0.06975647374412529990;
static const double sinr =/* sin 94 */ 0.99756405025982424767;
xx = M_SQRT1_2;/* 1/sqrt(2) = 0.707.... */
yy = -xx;
*fail = FALSE;
nn = *degree;
d1 = nn - 1;
/* algorithm fails if the leading coefficient is zero. */
if (opr[0] == 0. && opi[0] == 0.) {
*fail = TRUE;
return;
}
/* remove the zeros at the origin if any. */
while (opr[nn] == 0. && opi[nn] == 0.) {
d_n = d1-nn+1;
zeror[d_n] = 0.;
zeroi[d_n] = 0.;
nn--;
}
nn++;
/*-- Now, global var. nn := #{coefficients} = (relevant degree)+1 */
if (nn == 1) return;
/* Use a single allocation as these as small */
const void *vmax = vmaxget();
tmp = (double *) R_alloc((size_t) (10*nn), sizeof(double));
pr = tmp; pi = tmp + nn; hr = tmp + 2*nn; hi = tmp + 3*nn;
qpr = tmp + 4*nn; qpi = tmp + 5*nn; qhr = tmp + 6*nn; qhi = tmp + 7*nn;
shr = tmp + 8*nn; shi = tmp + 9*nn;
/* make a copy of the coefficients and shr[] = | p[] | */
for (i = 0; i < nn; i++) {
pr[i] = opr[i];
pi[i] = opi[i];
shr[i] = hypot(pr[i], pi[i]);
}
/* scale the polynomial with factor 'bnd'. */
bnd = cpoly_scale(nn, shr, eta, infin, smalno, base);
if (bnd != 1.) {
for (i=0; i < nn; i++) {
pr[i] *= bnd;
pi[i] *= bnd;
}
}
/* start the algorithm for one zero */
while (nn > 2) {
/* calculate bnd, a lower bound on the modulus of the zeros. */
for (i=0 ; i < nn ; i++)
shr[i] = hypot(pr[i], pi[i]);
bnd = cpoly_cauchy(nn, shr, shi);
/* outer loop to control 2 major passes */
/* with different sequences of shifts */
for (i1 = 1; i1 <= 2; i1++) {
/* first stage calculation, no shift */
noshft(5);
/* inner loop to select a shift */
for (i2 = 1; i2 <= 9; i2++) {
/* shift is chosen with modulus bnd */
/* and amplitude rotated by 94 degrees */
/* from the previous shift */
xxx= cosr * xx - sinr * yy;
yy = sinr * xx + cosr * yy;
xx = xxx;
sr = bnd * xx;
si = bnd * yy;
/* second stage calculation, fixed shift */
conv = fxshft(i2 * 10, &zr, &zi);
if (conv)
goto L10;
}
}
/* the zerofinder has failed on two major passes */
/* return empty handed */
*fail = TRUE;
vmaxset(vmax);
return;
/* the second stage jumps directly to the third stage iteration.
* if successful, the zero is stored and the polynomial deflated.
*/
L10:
d_n = d1+2 - nn;
zeror[d_n] = zr;
zeroi[d_n] = zi;
--nn;
for (i=0; i < nn ; i++) {
pr[i] = qpr[i];
pi[i] = qpi[i];
}
}/*while*/
/* calculate the final zero and return */
cdivid(-pr[1], -pi[1], pr[0], pi[0], &zeror[d1], &zeroi[d1]);
vmaxset(vmax);
return;
}
int CPoly<T>::findRoots( const T *opr, const T *opi, int degree, T *zeror, T *zeroi )
{
int cnt1, cnt2, idnn2, i, conv;
T xx, yy, cosr, sinr, smalno, base, xxx, zr, zi, bnd;
mcon( &eta, &infin, &smalno, &base );
are = eta;
mre = (T) (2.0 * sqrt( 2.0 ) * eta);
xx = (T) 0.70710678;
yy = -xx;
cosr = (T) -0.060756474;
sinr = (T) -0.99756405;
nn = degree;
// Algorithm fails if the leading coefficient is zero, or degree is zero.
if( nn < 1 || (opr[ 0 ] == 0 && opi[ 0 ] == 0) )
return -1;
// Remove the zeros at the origin if any
while( opr[ nn ] == 0 && opi[ nn ] == 0 )
{
idnn2 = degree - nn;
zeror[ idnn2 ] = 0;
zeroi[ idnn2 ] = 0;
nn--;
}
// sherm 20130410: If all coefficients but the leading one were zero, then
// all solutions are zero; should be a successful (if boring) return.
if (nn == 0)
return degree;
// Allocate arrays
pr = new T [ degree+1 ];
pi = new T [ degree+1 ];
hr = new T [ degree+1 ];
hi = new T [ degree+1 ];
qpr= new T [ degree+1 ];
qpi= new T [ degree+1 ];
qhr= new T [ degree+1 ];
qhi= new T [ degree+1 ];
shr= new T [ degree+1 ];
shi= new T [ degree+1 ];
// Make a copy of the coefficients
for( i = 0; i <= nn; i++ )
{
pr[ i ] = opr[ i ];
pi[ i ] = opi[ i ];
shr[ i ] = cmod( pr[ i ], pi[ i ] );
}
// Scale the polynomial
bnd = scale( nn, shr, eta, infin, smalno, base );
if( bnd != 1 )
for( i = 0; i <= nn; i++ )
{
pr[ i ] *= bnd;
pi[ i ] *= bnd;
}
search:
if( nn <= 1 )
{
cdivid( -pr[ 1 ], -pi[ 1 ], pr[ 0 ], pi[ 0 ], &zeror[ degree-1 ], &zeroi[ degree-1 ] );
goto finish;
}
// Calculate bnd, alower bound on the modulus of the zeros
for( i = 0; i<= nn; i++ )
shr[ i ] = cmod( pr[ i ], pi[ i ] );
cauchy( nn, shr, shi, &bnd );
// Outer loop to control 2 Major passes with different sequences of shifts
for( cnt1 = 1; cnt1 <= 2; cnt1++ )
{
// First stage calculation , no shift
noshft( 5 );
// Inner loop to select a shift
for( cnt2 = 1; cnt2 <= 9; cnt2++ )
{
// Shift is chosen with modulus bnd and amplitude rotated by 94 degree from the previous shif
xxx = cosr * xx - sinr * yy;
yy = sinr * xx + cosr * yy;
xx = xxx;
sr = bnd * xx;
si = bnd * yy;
// Second stage calculation, fixed shift
fxshft( 10 * cnt2, &zr, &zi, &conv );
if( conv )
{
// The second stage jumps directly to the third stage ieration
// If successful the zero is stored and the polynomial deflated
idnn2 = degree - nn;
zeror[ idnn2 ] = zr;
zeroi[ idnn2 ] = zi;
nn--;
for( i = 0; i <= nn; i++ )
{
pr[ i ] = qpr[ i ];
pi[ i ] = qpi[ i ];
}
goto search;
}
// If the iteration is unsuccessful another shift is chosen
}
// if 9 shifts fail, the outer loop is repeated with another sequence of shifts
}
// The zerofinder has failed on two major passes
// return empty handed with the number of roots found (less than the original degree)
degree -= nn;
finish:
// Deallocate arrays
delete [] pr;
delete [] pi;
delete [] hr;
delete [] hi;
delete [] qpr;
delete [] qpi;
delete [] qhr;
delete [] qhi;
delete [] shr;
delete [] shi;
return degree;
}
int cpoly(double opr[], double opi[], int degree,
double zeror[], double zeroi[])
{
/* Finds the zeros of a complex polynomial.
opr, opi - double precision vectors of real and imaginary parts
of the coefficients in order of decreasing powers.
degree - integer degree of polynomial
zeror, zeroi
- output double precision vectors of real and imaginary
parts of the zeros.
fail - output logical parameter, TRUE if leading coefficient
is zero, if cpoly has found fewer than degree zeros,
or if there is another internal error.
The program has been written to reduce the chance of overflow
occurring. If it does occur, there is still a possibility that
the zerofinder will work provided the overflowed quantity is
replaced by a large number. */
double xx,yy,xxx,zr,zi,bnd;
int fail,conv;
int cnt1,cnt2,i,idnn2;
/* initialization of constants */
nn = degree+1;
if (!init(nn)) {
fail = TRUE;
return fail;
}
xx = .70710678L;
yy = -xx;
fail = FALSE;
/* algorithm fails if the leading coefficient is zero. */
if (opr[0] == 0.0 && opi[0] == 0.0) {
fail = TRUE;
return fail;
}
/* Remove the zeros at the origin if any */
while (opr[nn-1] == 0.0 && opi[nn-1] == 0.0) {
idnn2 = degree+1-nn;
zeror[idnn2] = 0.0;
zeroi[idnn2] = 0.0;
nn--;
}
/* Make a copy of the coefficients */
for (i=0;i<nn;i++) {
pr[i] = opr[i];
pi[i] = opi[i];
shr[i] = cmod(pr[i],pi[i]);
}
/* Scale the polynomial */
bnd = scale(nn,shr);
if (bnd != 1.0) {
for (i=0;i<nn;i++) {
pr[i] *= bnd;
pi[i] *= bnd;
}
}
while (!fail) {
/* Start the algorithm for one zero */
if (nn < 3) {
/* Calculate the final zero and return */
cdivid(-pr[1],-pi[1],pr[0],pi[0],&(zeror[degree-1]),&(zeroi[degree-1]));
return fail;
}
/* Calculate bnd, a lower bound on the modulus of the zeros */
for (i=0;i<nn;i++) {
shr[i] = cmod(pr[i],pi[i]);
}
bnd = cauchy(nn,shr,shi);
/* Outer loop to control 2 major passes with different sequences
of shifts */
fail = TRUE;
for(cnt1=1;fail && (cnt1<=2);cnt1++) {
/* First stage calculation, no shift */
noshft(5);
/* Inner loop to select a shift. */
for (cnt2=1;fail && (cnt2<10);cnt2++) {
/* Shift is chosen with modulus bnd and amplitude rotated by
94 degrees from the previous shift */
xxx = COSR*xx-SINR*yy;
yy = SINR*xx+COSR*yy;
xx = xxx;
sr = bnd*xx;
si = bnd*yy;
/* Second stage calculation, fixed shift */
conv = fxshft(10*cnt2,&zr,&zi);
if (conv) {
/* The second stage jumps directly to the third stage iteration
If successful the zero is stored and the polynomial deflated */
idnn2 = degree+1-nn;
zeror[idnn2] = zr;
zeroi[idnn2] = zi;
nn--;
for(i=0;i<nn;i++) {
pr[i] = qpr[i];
pi[i] = qpi[i];
}
fail = FALSE;
}
/* If the iteration is unsuccessful another shift is chosen */
}
/* If 9 shifts fail, the outer loop is repeated with another
sequence of shifts */
}
}
/* The zerofinder has failed on two major passes
Return empty handed */
return fail;
}
