void parse_complex(const char *str, gsl_complex *dest)
{
const char *comma = strchr(str, ',');
if (comma != NULL)
{
char *end;
GSL_SET_REAL(dest, strtod(str, &end));
GSL_SET_IMAG(dest, strtod(comma + 1, &end));
}
else
{
char *end;
GSL_SET_REAL(dest, strtod(str, &end));
GSL_SET_IMAG(dest, 0.0);
}
}
/* compute B = (A^H A)^{-1} */
int
lls_complex_invert(gsl_matrix_complex *B, const lls_complex_workspace *w)
{
size_t n = w->AHA->size1;
if (B->size1 != n || B->size2 != n)
{
fprintf(stderr, "lls_complex_invert: B has wrong dimensions\n");
return GSL_EBADLEN;
}
else
{
int s;
size_t i, j;
s = lls_lapack_zinvert(B, w);
if (s)
fprintf(stderr, "lls_complex_invert: error inverting A^H A: %d\n", s);
/* fill in lower half of B */
for (j = 1; j < n; ++j)
{
for (i = 0; i < j; ++i)
{
gsl_complex z = gsl_matrix_complex_get(B, i, j);
GSL_SET_IMAG(&z, -GSL_IMAG(z));
gsl_matrix_complex_set(B, j, i, z);
}
}
return s;
}
} /* lls_complex_invert() */
static VALUE rb_gsl_vector_int_to_complex(VALUE obj)
{
gsl_vector_int *v;
gsl_vector_complex *vnew;
gsl_complex z;
size_t i;
Data_Get_Struct(obj, gsl_vector_int, v);
vnew = gsl_vector_complex_alloc(v->size);
for (i = 0; i < v->size; i++) {
GSL_SET_REAL(&z, (double) gsl_vector_int_get(v, i));
GSL_SET_IMAG(&z, 0.0);
gsl_vector_complex_set(vnew, i, z);
}
if (VECTOR_INT_COL_P(obj))
return Data_Wrap_Struct(cgsl_vector_complex_col, 0, gsl_vector_complex_free, vnew);
else
return Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, vnew);
}
gsl_complex ary2complex(VALUE obj)
{
gsl_complex *z, c;
switch (TYPE(obj)) {
case T_ARRAY:
GSL_SET_REAL(&c, NUM2DBL(rb_ary_entry(obj, 0)));
GSL_SET_IMAG(&c, NUM2DBL(rb_ary_entry(obj, 1)));
break;
default:
if (COMPLEX_P(obj)) {
Data_Get_Struct(obj, gsl_complex, z);
c = *z;
} else {
rb_raise(rb_eTypeError, "wrong argument type %s (Array or Complex expected)",
rb_class2name(CLASS_OF(obj)));
}
break;
}
return c;
}
void
create_random_complex_posdef_matrix(gsl_matrix_complex *m, gsl_rng *r,
gsl_vector_complex *work)
{
const size_t N = m->size1;
size_t i, j;
double x, y;
gsl_complex z;
gsl_complex tau;
GSL_SET_IMAG(&z, 0.0);
/* make a positive diagonal matrix */
gsl_matrix_complex_set_zero(m);
for (i = 0; i < N; ++i)
{
x = gsl_rng_uniform(r);
GSL_SET_REAL(&z, x);
gsl_matrix_complex_set(m, i, i, z);
}
/* now generate random householder reflections and form P D P^H */
for (i = 0; i < N; ++i)
{
/* form complex vector */
for (j = 0; j < N; ++j)
{
x = 2.0 * gsl_rng_uniform(r) - 1.0;
y = 2.0 * gsl_rng_uniform(r) - 1.0;
GSL_SET_COMPLEX(&z, x, y);
gsl_vector_complex_set(work, j, z);
}
tau = gsl_linalg_complex_householder_transform(work);
gsl_linalg_complex_householder_hm(tau, work, m);
gsl_linalg_complex_householder_mh(gsl_complex_conjugate(tau), work, m);
}
} /* create_random_complex_posdef_matrix() */
/**
* Constructor from base class.
* @param z A gsl_complex_long_double
*/
complex_long_double( gsl_complex_long_double const& z ) {
GSL_SET_REAL( this, GSL_REAL( z ) );
GSL_SET_IMAG( this, GSL_IMAG( z ) );
}
/**
* C++ version of GSL_SET_IMAG().
* @param y The new imaginary part
*/
void set_imag( long double y ) {
GSL_SET_IMAG( this, y );
}
static void
nonsymmv_get_right_eigenvectors(gsl_matrix *T, gsl_matrix *Z,
gsl_vector_complex *eval,
gsl_matrix_complex *evec,
gsl_eigen_nonsymmv_workspace *w)
{
const size_t N = T->size1;
const double smlnum = GSL_DBL_MIN * N / GSL_DBL_EPSILON;
const double bignum = (1.0 - GSL_DBL_EPSILON) / smlnum;
int i; /* looping */
size_t iu, /* looping */
ju,
ii;
gsl_complex lambda; /* current eigenvalue */
double lambda_re, /* Re(lambda) */
lambda_im; /* Im(lambda) */
gsl_matrix_view Tv, /* temporary views */
Zv;
gsl_vector_view y, /* temporary views */
y2,
ev,
ev2;
double dat[4], /* scratch arrays */
dat_X[4];
double scale; /* scale factor */
double xnorm; /* |X| */
gsl_vector_complex_view ecol, /* column of evec */
ecol2;
int complex_pair; /* complex eigenvalue pair? */
double smin;
/*
* Compute 1-norm of each column of upper triangular part of T
* to control overflow in triangular solver
*/
gsl_vector_set(w->work3, 0, 0.0);
for (ju = 1; ju < N; ++ju)
{
gsl_vector_set(w->work3, ju, 0.0);
for (iu = 0; iu < ju; ++iu)
{
gsl_vector_set(w->work3, ju,
gsl_vector_get(w->work3, ju) +
fabs(gsl_matrix_get(T, iu, ju)));
}
}
for (i = (int) N - 1; i >= 0; --i)
{
iu = (size_t) i;
/* get current eigenvalue and store it in lambda */
lambda_re = gsl_matrix_get(T, iu, iu);
if (iu != 0 && gsl_matrix_get(T, iu, iu - 1) != 0.0)
{
lambda_im = sqrt(fabs(gsl_matrix_get(T, iu, iu - 1))) *
sqrt(fabs(gsl_matrix_get(T, iu - 1, iu)));
}
else
{
lambda_im = 0.0;
}
GSL_SET_COMPLEX(&lambda, lambda_re, lambda_im);
smin = GSL_MAX(GSL_DBL_EPSILON * (fabs(lambda_re) + fabs(lambda_im)),
smlnum);
smin = GSL_MAX(smin, GSL_NONSYMMV_SMLNUM);
if (lambda_im == 0.0)
{
int k, l;
gsl_vector_view bv, xv;
/* real eigenvector */
/*
* The ordering of eigenvalues in 'eval' is arbitrary and
* does not necessarily follow the Schur form T, so store
* lambda in the right slot in eval to ensure it corresponds
* to the eigenvector we are about to compute
*/
gsl_vector_complex_set(eval, iu, lambda);
/*
* We need to solve the system:
*
* (T(1:iu-1, 1:iu-1) - lambda*I)*X = -T(1:iu-1,iu)
*/
/* construct right hand side */
for (k = 0; k < i; ++k)
{
gsl_vector_set(w->work,
(size_t) k,
-gsl_matrix_get(T, (size_t) k, iu));
}
gsl_vector_set(w->work, iu, 1.0);
for (l = i - 1; l >= 0; --l)
{
size_t lu = (size_t) l;
if (lu == 0)
complex_pair = 0;
else
complex_pair = gsl_matrix_get(T, lu, lu - 1) != 0.0;
if (!complex_pair)
{
double x;
/*
* 1-by-1 diagonal block - solve the system:
*
* (T_{ll} - lambda)*x = -T_{l(iu)}
*/
Tv = gsl_matrix_submatrix(T, lu, lu, 1, 1);
bv = gsl_vector_view_array(dat, 1);
gsl_vector_set(&bv.vector, 0,
gsl_vector_get(w->work, lu));
xv = gsl_vector_view_array(dat_X, 1);
gsl_schur_solve_equation(1.0,
&Tv.matrix,
lambda_re,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
/* scale x to avoid overflow */
x = gsl_vector_get(&xv.vector, 0);
if (xnorm > 1.0)
{
if (gsl_vector_get(w->work3, lu) > bignum / xnorm)
{
x /= xnorm;
scale /= xnorm;
}
}
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
gsl_vector_set(w->work, lu, x);
if (lu > 0)
{
gsl_vector_view v1, v2;
/* update right hand side */
v1 = gsl_matrix_subcolumn(T, lu, 0, lu);
v2 = gsl_vector_subvector(w->work, 0, lu);
gsl_blas_daxpy(-x, &v1.vector, &v2.vector);
} /* if (l > 0) */
} /* if (!complex_pair) */
else
{
double x11, x21;
/*
* 2-by-2 diagonal block
*/
Tv = gsl_matrix_submatrix(T, lu - 1, lu - 1, 2, 2);
bv = gsl_vector_view_array(dat, 2);
gsl_vector_set(&bv.vector, 0,
gsl_vector_get(w->work, lu - 1));
gsl_vector_set(&bv.vector, 1,
gsl_vector_get(w->work, lu));
xv = gsl_vector_view_array(dat_X, 2);
gsl_schur_solve_equation(1.0,
&Tv.matrix,
lambda_re,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
/* scale X(1,1) and X(2,1) to avoid overflow */
x11 = gsl_vector_get(&xv.vector, 0);
x21 = gsl_vector_get(&xv.vector, 1);
if (xnorm > 1.0)
{
double beta;
beta = GSL_MAX(gsl_vector_get(w->work3, lu - 1),
gsl_vector_get(w->work3, lu));
if (beta > bignum / xnorm)
{
x11 /= xnorm;
x21 /= xnorm;
scale /= xnorm;
}
}
/* scale if necessary */
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
gsl_vector_set(w->work, lu - 1, x11);
gsl_vector_set(w->work, lu, x21);
/* update right hand side */
if (lu > 1)
{
gsl_vector_view v1, v2;
v1 = gsl_matrix_subcolumn(T, lu - 1, 0, lu - 1);
v2 = gsl_vector_subvector(w->work, 0, lu - 1);
gsl_blas_daxpy(-x11, &v1.vector, &v2.vector);
v1 = gsl_matrix_subcolumn(T, lu, 0, lu - 1);
gsl_blas_daxpy(-x21, &v1.vector, &v2.vector);
}
--l;
} /* if (complex_pair) */
} /* for (l = i - 1; l >= 0; --l) */
/*
* At this point, w->work is an eigenvector of the
* Schur form T. To get an eigenvector of the original
* matrix, we multiply on the left by Z, the matrix of
* Schur vectors
*/
ecol = gsl_matrix_complex_column(evec, iu);
y = gsl_matrix_column(Z, iu);
if (iu > 0)
{
gsl_vector_view x;
Zv = gsl_matrix_submatrix(Z, 0, 0, N, iu);
x = gsl_vector_subvector(w->work, 0, iu);
/* compute Z * w->work and store it in Z(:,iu) */
gsl_blas_dgemv(CblasNoTrans,
1.0,
&Zv.matrix,
&x.vector,
gsl_vector_get(w->work, iu),
&y.vector);
} /* if (iu > 0) */
/* store eigenvector into evec */
ev = gsl_vector_complex_real(&ecol.vector);
ev2 = gsl_vector_complex_imag(&ecol.vector);
scale = 0.0;
for (ii = 0; ii < N; ++ii)
{
double a = gsl_vector_get(&y.vector, ii);
/* store real part of eigenvector */
gsl_vector_set(&ev.vector, ii, a);
/* set imaginary part to 0 */
gsl_vector_set(&ev2.vector, ii, 0.0);
if (fabs(a) > scale)
scale = fabs(a);
}
if (scale != 0.0)
scale = 1.0 / scale;
/* scale by magnitude of largest element */
gsl_blas_dscal(scale, &ev.vector);
} /* if (GSL_IMAG(lambda) == 0.0) */
else
{
gsl_vector_complex_view bv, xv;
size_t k;
int l;
gsl_complex lambda2;
/* complex eigenvector */
/*
* Store the complex conjugate eigenvalues in the right
* slots in eval
*/
GSL_SET_REAL(&lambda2, GSL_REAL(lambda));
GSL_SET_IMAG(&lambda2, -GSL_IMAG(lambda));
gsl_vector_complex_set(eval, iu - 1, lambda);
gsl_vector_complex_set(eval, iu, lambda2);
/*
* First solve:
*
* [ T(i:i+1,i:i+1) - lambda*I ] * X = 0
*/
if (fabs(gsl_matrix_get(T, iu - 1, iu)) >=
fabs(gsl_matrix_get(T, iu, iu - 1)))
{
gsl_vector_set(w->work, iu - 1, 1.0);
gsl_vector_set(w->work2, iu,
lambda_im / gsl_matrix_get(T, iu - 1, iu));
}
else
{
gsl_vector_set(w->work, iu - 1,
-lambda_im / gsl_matrix_get(T, iu, iu - 1));
gsl_vector_set(w->work2, iu, 1.0);
}
gsl_vector_set(w->work, iu, 0.0);
gsl_vector_set(w->work2, iu - 1, 0.0);
/* construct right hand side */
for (k = 0; k < iu - 1; ++k)
{
gsl_vector_set(w->work, k,
-gsl_vector_get(w->work, iu - 1) *
gsl_matrix_get(T, k, iu - 1));
gsl_vector_set(w->work2, k,
-gsl_vector_get(w->work2, iu) *
gsl_matrix_get(T, k, iu));
}
/*
* We must solve the upper quasi-triangular system:
*
* [ T(1:i-2,1:i-2) - lambda*I ] * X = s*(work + i*work2)
*/
for (l = i - 2; l >= 0; --l)
{
size_t lu = (size_t) l;
if (lu == 0)
complex_pair = 0;
else
complex_pair = gsl_matrix_get(T, lu, lu - 1) != 0.0;
if (!complex_pair)
{
gsl_complex bval;
gsl_complex x;
/*
* 1-by-1 diagonal block - solve the system:
*
* (T_{ll} - lambda)*x = work + i*work2
*/
Tv = gsl_matrix_submatrix(T, lu, lu, 1, 1);
bv = gsl_vector_complex_view_array(dat, 1);
xv = gsl_vector_complex_view_array(dat_X, 1);
GSL_SET_COMPLEX(&bval,
gsl_vector_get(w->work, lu),
gsl_vector_get(w->work2, lu));
gsl_vector_complex_set(&bv.vector, 0, bval);
gsl_schur_solve_equation_z(1.0,
&Tv.matrix,
&lambda,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
if (xnorm > 1.0)
{
if (gsl_vector_get(w->work3, lu) > bignum / xnorm)
{
gsl_blas_zdscal(1.0/xnorm, &xv.vector);
scale /= xnorm;
}
}
/* scale if necessary */
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
wv = gsl_vector_subvector(w->work2, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
x = gsl_vector_complex_get(&xv.vector, 0);
gsl_vector_set(w->work, lu, GSL_REAL(x));
gsl_vector_set(w->work2, lu, GSL_IMAG(x));
/* update the right hand side */
if (lu > 0)
{
gsl_vector_view v1, v2;
v1 = gsl_matrix_subcolumn(T, lu, 0, lu);
v2 = gsl_vector_subvector(w->work, 0, lu);
gsl_blas_daxpy(-GSL_REAL(x), &v1.vector, &v2.vector);
v2 = gsl_vector_subvector(w->work2, 0, lu);
gsl_blas_daxpy(-GSL_IMAG(x), &v1.vector, &v2.vector);
} /* if (lu > 0) */
} /* if (!complex_pair) */
else
{
gsl_complex b1, b2, x1, x2;
/*
* 2-by-2 diagonal block - solve the system
*/
Tv = gsl_matrix_submatrix(T, lu - 1, lu - 1, 2, 2);
bv = gsl_vector_complex_view_array(dat, 2);
xv = gsl_vector_complex_view_array(dat_X, 2);
GSL_SET_COMPLEX(&b1,
gsl_vector_get(w->work, lu - 1),
gsl_vector_get(w->work2, lu - 1));
GSL_SET_COMPLEX(&b2,
gsl_vector_get(w->work, lu),
gsl_vector_get(w->work2, lu));
gsl_vector_complex_set(&bv.vector, 0, b1);
gsl_vector_complex_set(&bv.vector, 1, b2);
gsl_schur_solve_equation_z(1.0,
&Tv.matrix,
&lambda,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
x1 = gsl_vector_complex_get(&xv.vector, 0);
x2 = gsl_vector_complex_get(&xv.vector, 1);
if (xnorm > 1.0)
{
double beta;
beta = GSL_MAX(gsl_vector_get(w->work3, lu - 1),
gsl_vector_get(w->work3, lu));
if (beta > bignum / xnorm)
{
gsl_blas_zdscal(1.0/xnorm, &xv.vector);
scale /= xnorm;
}
}
/* scale if necessary */
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
wv = gsl_vector_subvector(w->work2, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
gsl_vector_set(w->work, lu - 1, GSL_REAL(x1));
gsl_vector_set(w->work, lu, GSL_REAL(x2));
gsl_vector_set(w->work2, lu - 1, GSL_IMAG(x1));
gsl_vector_set(w->work2, lu, GSL_IMAG(x2));
/* update right hand side */
if (lu > 1)
{
gsl_vector_view v1, v2, v3, v4;
v1 = gsl_matrix_subcolumn(T, lu - 1, 0, lu - 1);
v4 = gsl_matrix_subcolumn(T, lu, 0, lu - 1);
v2 = gsl_vector_subvector(w->work, 0, lu - 1);
v3 = gsl_vector_subvector(w->work2, 0, lu - 1);
gsl_blas_daxpy(-GSL_REAL(x1), &v1.vector, &v2.vector);
gsl_blas_daxpy(-GSL_REAL(x2), &v4.vector, &v2.vector);
gsl_blas_daxpy(-GSL_IMAG(x1), &v1.vector, &v3.vector);
gsl_blas_daxpy(-GSL_IMAG(x2), &v4.vector, &v3.vector);
} /* if (lu > 1) */
--l;
} /* if (complex_pair) */
} /* for (l = i - 2; l >= 0; --l) */
/*
* At this point, work + i*work2 is an eigenvector
* of T - backtransform to get an eigenvector of the
* original matrix
*/
y = gsl_matrix_column(Z, iu - 1);
y2 = gsl_matrix_column(Z, iu);
if (iu > 1)
{
gsl_vector_view x;
/* compute real part of eigenvectors */
Zv = gsl_matrix_submatrix(Z, 0, 0, N, iu - 1);
x = gsl_vector_subvector(w->work, 0, iu - 1);
gsl_blas_dgemv(CblasNoTrans,
1.0,
&Zv.matrix,
&x.vector,
gsl_vector_get(w->work, iu - 1),
&y.vector);
/* now compute the imaginary part */
x = gsl_vector_subvector(w->work2, 0, iu - 1);
gsl_blas_dgemv(CblasNoTrans,
1.0,
&Zv.matrix,
&x.vector,
gsl_vector_get(w->work2, iu),
&y2.vector);
}
else
{
gsl_blas_dscal(gsl_vector_get(w->work, iu - 1), &y.vector);
gsl_blas_dscal(gsl_vector_get(w->work2, iu), &y2.vector);
}
/*
* Now store the eigenvectors into evec - the real parts
* are Z(:,iu - 1) and the imaginary parts are
* +/- Z(:,iu)
*/
/* get views of the two eigenvector slots */
ecol = gsl_matrix_complex_column(evec, iu - 1);
ecol2 = gsl_matrix_complex_column(evec, iu);
/*
* save imaginary part first as it may get overwritten
* when copying the real part due to our storage scheme
* in Z/evec
*/
ev = gsl_vector_complex_imag(&ecol.vector);
ev2 = gsl_vector_complex_imag(&ecol2.vector);
scale = 0.0;
for (ii = 0; ii < N; ++ii)
{
double a = gsl_vector_get(&y2.vector, ii);
scale = GSL_MAX(scale,
fabs(a) + fabs(gsl_vector_get(&y.vector, ii)));
gsl_vector_set(&ev.vector, ii, a);
gsl_vector_set(&ev2.vector, ii, -a);
}
/* now save the real part */
ev = gsl_vector_complex_real(&ecol.vector);
ev2 = gsl_vector_complex_real(&ecol2.vector);
for (ii = 0; ii < N; ++ii)
{
double a = gsl_vector_get(&y.vector, ii);
gsl_vector_set(&ev.vector, ii, a);
gsl_vector_set(&ev2.vector, ii, a);
}
if (scale != 0.0)
scale = 1.0 / scale;
/* scale by largest element magnitude */
gsl_blas_zdscal(scale, &ecol.vector);
gsl_blas_zdscal(scale, &ecol2.vector);
/*
* decrement i since we took care of two eigenvalues at
* the same time
*/
--i;
} /* if (GSL_IMAG(lambda) != 0.0) */
} /* for (i = (int) N - 1; i >= 0; --i) */
} /* nonsymmv_get_right_eigenvectors() */
int
main (void)
{
const double eps = 100.0 * GSL_DBL_EPSILON;
gsl_ieee_env_setup ();
/* Polynomial evaluation */
{
double x, y;
double c[3] = { 1.0, 0.5, 0.3 };
x = 0.5;
y = gsl_poly_eval (c, 3, x);
gsl_test_rel (y, 1 + 0.5 * x + 0.3 * x * x, eps,
"gsl_poly_eval({1, 0.5, 0.3}, 0.5)");
}
{
double x, y;
double d[11] = { 1, -1, 1, -1, 1, -1, 1, -1, 1, -1, 1 };
x = 1.0;
y = gsl_poly_eval (d, 11, x);
gsl_test_rel (y, 1.0, eps,
"gsl_poly_eval({1,-1, 1, -1, 1, -1, 1, -1, 1, -1, 1}, 1.0)");
}
{
gsl_complex x, y;
double c[1] = {0.3};
GSL_SET_REAL (&x, 0.75);
GSL_SET_IMAG (&x, 1.2);
y = gsl_poly_complex_eval (c, 1, x);
gsl_test_rel (GSL_REAL (y), 0.3, eps, "y.real, gsl_poly_complex_eval ({0.3}, 0.75 + 1.2i)");
gsl_test_rel (GSL_IMAG (y), 0.0, eps, "y.imag, gsl_poly_complex_eval ({0.3}, 0.75 + 1.2i)");
}
{
gsl_complex x, y;
double c[4] = {2.1, -1.34, 0.76, 0.45};
GSL_SET_REAL (&x, 0.49);
GSL_SET_IMAG (&x, 0.95);
y = gsl_poly_complex_eval (c, 4, x);
gsl_test_rel (GSL_REAL (y), 0.3959143, eps, "y.real, gsl_poly_complex_eval ({2.1, -1.34, 0.76, 0.45}, 0.49 + 0.95i)");
gsl_test_rel (GSL_IMAG (y), -0.6433305, eps, "y.imag, gsl_poly_complex_eval ({2.1, -1.34, 0.76, 0.45}, 0.49 + 0.95i)");
}
{
gsl_complex x, y;
gsl_complex c[1];
GSL_SET_REAL (&c[0], 0.674);
GSL_SET_IMAG (&c[0], -1.423);
GSL_SET_REAL (&x, -1.44);
GSL_SET_IMAG (&x, 9.55);
y = gsl_complex_poly_complex_eval (c, 1, x);
gsl_test_rel (GSL_REAL (y), 0.674, eps, "y.real, gsl_complex_poly_complex_eval ({0.674 - 1.423i}, -1.44 + 9.55i)");
gsl_test_rel (GSL_IMAG (y), -1.423, eps, "y.imag, gsl_complex_poly_complex_eval ({0.674 - 1.423i}, -1.44 + 9.55i)");
}
{
gsl_complex x, y;
gsl_complex c[4];
GSL_SET_REAL (&c[0], -2.31);
GSL_SET_IMAG (&c[0], 0.44);
GSL_SET_REAL (&c[1], 4.21);
GSL_SET_IMAG (&c[1], -3.19);
GSL_SET_REAL (&c[2], 0.93);
GSL_SET_IMAG (&c[2], 1.04);
GSL_SET_REAL (&c[3], -0.42);
GSL_SET_IMAG (&c[3], 0.68);
GSL_SET_REAL (&x, 0.49);
GSL_SET_IMAG (&x, 0.95);
y = gsl_complex_poly_complex_eval (c, 4, x);
gsl_test_rel (GSL_REAL (y), 1.82462012, eps, "y.real, gsl_complex_poly_complex_eval ({-2.31 + 0.44i, 4.21 - 3.19i, 0.93 + 1.04i, -0.42 + 0.68i}, 0.49 + 0.95i)");
gsl_test_rel (GSL_IMAG (y), 2.30389412, eps, "y.imag, gsl_complex_poly_complex_eval ({-2.31 + 0.44i, 4.21 - 3.19i, 0.93 + 1.04i, -0.42 + 0.68i}, 0.49 + 0.95i)");
}
/* Quadratic */
{
double x0, x1;
int n = gsl_poly_solve_quadratic (4.0, -20.0, 26.0, &x0, &x1);
gsl_test (n != 0, "gsl_poly_solve_quadratic, no roots, (2x - 5)^2 = -1");
}
{
double x0, x1;
int n = gsl_poly_solve_quadratic (4.0, -20.0, 25.0, &x0, &x1);
gsl_test (n != 2, "gsl_poly_solve_quadratic, one root, (2x - 5)^2 = 0");
gsl_test_rel (x0, 2.5, 1e-9, "x0, (2x - 5)^2 = 0");
gsl_test_rel (x1, 2.5, 1e-9, "x1, (2x - 5)^2 = 0");
gsl_test (x0 != x1, "x0 == x1, (2x - 5)^2 = 0");
}
{
double x0, x1;
int n = gsl_poly_solve_quadratic (4.0, -20.0, 21.0, &x0, &x1);
gsl_test (n != 2, "gsl_poly_solve_quadratic, two roots, (2x - 5)^2 = 4");
gsl_test_rel (x0, 1.5, 1e-9, "x0, (2x - 5)^2 = 4");
gsl_test_rel (x1, 3.5, 1e-9, "x1, (2x - 5)^2 = 4");
}
{
double x0, x1;
int n = gsl_poly_solve_quadratic (4.0, 7.0, 0.0, &x0, &x1);
gsl_test (n != 2, "gsl_poly_solve_quadratic, two roots, x(4x + 7) = 0");
gsl_test_rel (x0, -1.75, 1e-9, "x0, x(4x + 7) = 0");
gsl_test_rel (x1, 0.0, 1e-9, "x1, x(4x + 7) = 0");
}
{
double x0, x1;
int n = gsl_poly_solve_quadratic (5.0, 0.0, -20.0, &x0, &x1);
gsl_test (n != 2,
"gsl_poly_solve_quadratic, two roots b = 0, 5 x^2 = 20");
gsl_test_rel (x0, -2.0, 1e-9, "x0, 5 x^2 = 20");
gsl_test_rel (x1, 2.0, 1e-9, "x1, 5 x^2 = 20");
}
{
double x0, x1;
int n = gsl_poly_solve_quadratic (0.0, 3.0, -21.0, &x0, &x1);
gsl_test (n != 1,
"gsl_poly_solve_quadratic, one root (linear) 3 x - 21 = 0");
gsl_test_rel (x0, 7.0, 1e-9, "x0, 3x - 21 = 0");
}
{
double x0, x1;
int n = gsl_poly_solve_quadratic (0.0, 0.0, 1.0, &x0, &x1);
gsl_test (n != 0,
"gsl_poly_solve_quadratic, no roots 1 = 0");
}
/* Cubic */
{
double x0, x1, x2;
int n = gsl_poly_solve_cubic (0.0, 0.0, -27.0, &x0, &x1, &x2);
gsl_test (n != 1, "gsl_poly_solve_cubic, one root, x^3 = 27");
gsl_test_rel (x0, 3.0, 1e-9, "x0, x^3 = 27");
}
{
double x0, x1, x2;
int n = gsl_poly_solve_cubic (-51.0, 867.0, -4913.0, &x0, &x1, &x2);
gsl_test (n != 3, "gsl_poly_solve_cubic, three roots, (x-17)^3=0");
gsl_test_rel (x0, 17.0, 1e-9, "x0, (x-17)^3=0");
gsl_test_rel (x1, 17.0, 1e-9, "x1, (x-17)^3=0");
gsl_test_rel (x2, 17.0, 1e-9, "x2, (x-17)^3=0");
}
{
double x0, x1, x2;
int n = gsl_poly_solve_cubic (-57.0, 1071.0, -6647.0, &x0, &x1, &x2);
gsl_test (n != 3,
"gsl_poly_solve_cubic, three roots, (x-17)(x-17)(x-23)=0");
gsl_test_rel (x0, 17.0, 1e-9, "x0, (x-17)(x-17)(x-23)=0");
gsl_test_rel (x1, 17.0, 1e-9, "x1, (x-17)(x-17)(x-23)=0");
gsl_test_rel (x2, 23.0, 1e-9, "x2, (x-17)(x-17)(x-23)=0");
}
{
double x0, x1, x2;
int n = gsl_poly_solve_cubic (-11.0, -493.0, +6647.0, &x0, &x1, &x2);
gsl_test (n != 3,
"gsl_poly_solve_cubic, three roots, (x+23)(x-17)(x-17)=0");
gsl_test_rel (x0, -23.0, 1e-9, "x0, (x+23)(x-17)(x-17)=0");
gsl_test_rel (x1, 17.0, 1e-9, "x1, (x+23)(x-17)(x-17)=0");
gsl_test_rel (x2, 17.0, 1e-9, "x2, (x+23)(x-17)(x-17)=0");
}
{
double x0, x1, x2;
int n = gsl_poly_solve_cubic (-143.0, 5087.0, -50065.0, &x0, &x1, &x2);
gsl_test (n != 3,
"gsl_poly_solve_cubic, three roots, (x-17)(x-31)(x-95)=0");
gsl_test_rel (x0, 17.0, 1e-9, "x0, (x-17)(x-31)(x-95)=0");
gsl_test_rel (x1, 31.0, 1e-9, "x1, (x-17)(x-31)(x-95)=0");
gsl_test_rel (x2, 95.0, 1e-9, "x2, (x-17)(x-31)(x-95)=0");
}
{
double x0, x1, x2;
int n = gsl_poly_solve_cubic (-109.0, 803.0, 50065.0, &x0, &x1, &x2);
gsl_test (n != 3,
"gsl_poly_solve_cubic, three roots, (x+17)(x-31)(x-95)=0");
gsl_test_rel (x0, -17.0, 1e-9, "x0, (x+17)(x-31)(x-95)=0");
gsl_test_rel (x1, 31.0, 1e-9, "x1, (x+17)(x-31)(x-95)=0");
gsl_test_rel (x2, 95.0, 1e-9, "x2, (x+17)(x-31)(x-95)=0");
}
/* Quadratic with complex roots */
{
gsl_complex z0, z1;
int n = gsl_poly_complex_solve_quadratic (4.0, -20.0, 26.0, &z0, &z1);
gsl_test (n != 2,
"gsl_poly_complex_solve_quadratic, 2 roots (2x - 5)^2 = -1");
gsl_test_rel (GSL_REAL (z0), 2.5, 1e-9, "z0.real, (2x - 5)^2 = -1");
gsl_test_rel (GSL_IMAG (z0), -0.5, 1e-9, "z0.imag, (2x - 5)^2 = -1");
gsl_test_rel (GSL_REAL (z1), 2.5, 1e-9, "z1.real, (2x - 5)^2 = -1");
gsl_test_rel (GSL_IMAG (z1), 0.5, 1e-9, "z1.imag, (2x - 5)^2 = -1");
}
{
gsl_complex z0, z1;
int n = gsl_poly_complex_solve_quadratic (4.0, -20.0, 25.0, &z0, &z1);
gsl_test (n != 2,
"gsl_poly_complex_solve_quadratic, one root, (2x - 5)^2 = 0");
gsl_test_rel (GSL_REAL (z0), 2.5, 1e-9, "z0.real, (2x - 5)^2 = 0");
gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag (2x - 5)^2 = 0");
gsl_test_rel (GSL_REAL (z1), 2.5, 1e-9, "z1.real, (2x - 5)^2 = 0");
gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag (2x - 5)^2 = 0");
gsl_test (GSL_REAL (z0) != GSL_REAL (z1),
"z0.real == z1.real, (2x - 5)^2 = 0");
gsl_test (GSL_IMAG (z0) != GSL_IMAG (z1),
"z0.imag == z1.imag, (2x - 5)^2 = 0");
}
{
gsl_complex z0, z1;
int n = gsl_poly_complex_solve_quadratic (4.0, -20.0, 21.0, &z0, &z1);
gsl_test (n != 2,
"gsl_poly_complex_solve_quadratic, two roots, (2x - 5)^2 = 4");
gsl_test_rel (GSL_REAL (z0), 1.5, 1e-9, "z0.real, (2x - 5)^2 = 4");
gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (2x - 5)^2 = 4");
gsl_test_rel (GSL_REAL (z1), 3.5, 1e-9, "z1.real, (2x - 5)^2 = 4");
gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, (2x - 5)^2 = 4");
}
{
gsl_complex z0, z1;
int n = gsl_poly_complex_solve_quadratic (4.0, 7.0, 0.0, &z0, &z1);
gsl_test (n != 2,
"gsl_poly_complex_solve_quadratic, two roots, x(4x + 7) = 0");
gsl_test_rel (GSL_REAL (z0), -1.75, 1e-9, "z0.real, x(4x + 7) = 0");
gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, x(4x + 7) = 0");
gsl_test_rel (GSL_REAL (z1), 0.0, 1e-9, "z1.real, x(4x + 7) = 0");
gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, x(4x + 7) = 0");
}
{
gsl_complex z0, z1;
int n = gsl_poly_complex_solve_quadratic (5.0, 0.0, -20.0, &z0, &z1);
gsl_test (n != 2,
"gsl_poly_complex_solve_quadratic, two roots b = 0, 5 x^2 = 20");
gsl_test_rel (GSL_REAL (z0), -2.0, 1e-9, "z0.real, 5 x^2 = 20");
gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, 5 x^2 = 20");
gsl_test_rel (GSL_REAL (z1), 2.0, 1e-9, "z1.real, 5 x^2 = 20");
gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, 5 x^2 = 20");
}
{
gsl_complex z0, z1;
int n = gsl_poly_complex_solve_quadratic (5.0, 0.0, 20.0, &z0, &z1);
gsl_test (n != 2,
"gsl_poly_complex_solve_quadratic, two roots b = 0, 5 x^2 = -20");
gsl_test_rel (GSL_REAL (z0), 0.0, 1e-9, "z0.real, 5 x^2 = -20");
gsl_test_rel (GSL_IMAG (z0), -2.0, 1e-9, "z0.imag, 5 x^2 = -20");
gsl_test_rel (GSL_REAL (z1), 0.0, 1e-9, "z1.real, 5 x^2 = -20");
gsl_test_rel (GSL_IMAG (z1), 2.0, 1e-9, "z1.imag, 5 x^2 = -20");
}
{
gsl_complex z0, z1;
int n = gsl_poly_complex_solve_quadratic (0.0, 3.0, -21.0, &z0, &z1);
gsl_test (n != 1,
"gsl_poly_complex_solve_quadratic, one root (linear) 3 x - 21 = 0");
gsl_test_rel (GSL_REAL (z0), 7.0, 1e-9, "z0.real, 3x - 21 = 0");
gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, 3x - 21 = 0");
}
{
gsl_complex z0, z1;
int n = gsl_poly_complex_solve_quadratic (0.0, 0.0, 1.0, &z0, &z1);
gsl_test (n != 0,
"gsl_poly_complex_solve_quadratic, no roots 1 = 0");
}
/* Cubic with complex roots */
{
gsl_complex z0, z1, z2;
int n = gsl_poly_complex_solve_cubic (0.0, 0.0, -27.0, &z0, &z1, &z2);
gsl_test (n != 3, "gsl_poly_complex_solve_cubic, three root, x^3 = 27");
gsl_test_rel (GSL_REAL (z0), -1.5, 1e-9, "z0.real, x^3 = 27");
gsl_test_rel (GSL_IMAG (z0), -1.5 * sqrt (3.0), 1e-9,
"z0.imag, x^3 = 27");
gsl_test_rel (GSL_REAL (z1), -1.5, 1e-9, "z1.real, x^3 = 27");
gsl_test_rel (GSL_IMAG (z1), 1.5 * sqrt (3.0), 1e-9, "z1.imag, x^3 = 27");
gsl_test_rel (GSL_REAL (z2), 3.0, 1e-9, "z2.real, x^3 = 27");
gsl_test_rel (GSL_IMAG (z2), 0.0, 1e-9, "z2.imag, x^3 = 27");
}
{
gsl_complex z0, z1, z2;
int n = gsl_poly_complex_solve_cubic (-1.0, 1.0, 39.0, &z0, &z1, &z2);
gsl_test (n != 3,
"gsl_poly_complex_solve_cubic, three root, (x+3)(x^2-4x+13) = 0");
gsl_test_rel (GSL_REAL (z0), -3.0, 1e-9, "z0.real, (x+3)(x^2+1) = 0");
gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (x+3)(x^2+1) = 0");
gsl_test_rel (GSL_REAL (z1), 2.0, 1e-9, "z1.real, (x+3)(x^2+1) = 0");
gsl_test_rel (GSL_IMAG (z1), -3.0, 1e-9, "z1.imag, (x+3)(x^2+1) = 0");
gsl_test_rel (GSL_REAL (z2), 2.0, 1e-9, "z2.real, (x+3)(x^2+1) = 0");
gsl_test_rel (GSL_IMAG (z2), 3.0, 1e-9, "z2.imag, (x+3)(x^2+1) = 0");
}
{
gsl_complex z0, z1, z2;
int n =
gsl_poly_complex_solve_cubic (-51.0, 867.0, -4913.0, &z0, &z1, &z2);
gsl_test (n != 3,
"gsl_poly_complex_solve_cubic, three roots, (x-17)^3=0");
gsl_test_rel (GSL_REAL (z0), 17.0, 1e-9, "z0.real, (x-17)^3=0");
gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (x-17)^3=0");
gsl_test_rel (GSL_REAL (z1), 17.0, 1e-9, "z1.real, (x-17)^3=0");
gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, (x-17)^3=0");
gsl_test_rel (GSL_REAL (z2), 17.0, 1e-9, "z2.real, (x-17)^3=0");
gsl_test_rel (GSL_IMAG (z2), 0.0, 1e-9, "z2.imag, (x-17)^3=0");
}
{
gsl_complex z0, z1, z2;
int n =
gsl_poly_complex_solve_cubic (-57.0, 1071.0, -6647.0, &z0, &z1, &z2);
gsl_test (n != 3,
"gsl_poly_complex_solve_cubic, three roots, (x-17)(x-17)(x-23)=0");
gsl_test_rel (GSL_REAL (z0), 17.0, 1e-9, "z0.real, (x-17)(x-17)(x-23)=0");
gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (x-17)(x-17)(x-23)=0");
gsl_test_rel (GSL_REAL (z1), 17.0, 1e-9, "z1.real, (x-17)(x-17)(x-23)=0");
gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, (x-17)(x-17)(x-23)=0");
gsl_test_rel (GSL_REAL (z2), 23.0, 1e-9, "z2.real, (x-17)(x-17)(x-23)=0");
gsl_test_rel (GSL_IMAG (z2), 0.0, 1e-9, "z2.imag, (x-17)(x-17)(x-23)=0");
}
{
gsl_complex z0, z1, z2;
int n =
gsl_poly_complex_solve_cubic (-11.0, -493.0, +6647.0, &z0, &z1, &z2);
gsl_test (n != 3,
"gsl_poly_complex_solve_cubic, three roots, (x+23)(x-17)(x-17)=0");
gsl_test_rel (GSL_REAL (z0), -23.0, 1e-9,
"z0.real, (x+23)(x-17)(x-17)=0");
gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (x+23)(x-17)(x-17)=0");
gsl_test_rel (GSL_REAL (z1), 17.0, 1e-9, "z1.real, (x+23)(x-17)(x-17)=0");
gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, (x+23)(x-17)(x-17)=0");
gsl_test_rel (GSL_REAL (z2), 17.0, 1e-9, "z2.real, (x+23)(x-17)(x-17)=0");
gsl_test_rel (GSL_IMAG (z2), 0.0, 1e-9, "z2.imag, (x+23)(x-17)(x-17)=0");
}
{
gsl_complex z0, z1, z2;
int n =
gsl_poly_complex_solve_cubic (-143.0, 5087.0, -50065.0, &z0, &z1, &z2);
gsl_test (n != 3,
"gsl_poly_complex_solve_cubic, three roots, (x-17)(x-31)(x-95)=0");
gsl_test_rel (GSL_REAL (z0), 17.0, 1e-9, "z0.real, (x-17)(x-31)(x-95)=0");
gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (x-17)(x-31)(x-95)=0");
gsl_test_rel (GSL_REAL (z1), 31.0, 1e-9, "z1.real, (x-17)(x-31)(x-95)=0");
gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, (x-17)(x-31)(x-95)=0");
gsl_test_rel (GSL_REAL (z2), 95.0, 1e-9, "z2.real, (x-17)(x-31)(x-95)=0");
gsl_test_rel (GSL_IMAG (z2), 0.0, 1e-9, "z2.imag, (x-17)(x-31)(x-95)=0");
}
{
/* Wilkinson polynomial: y = (x-1)(x-2)(x-3)(x-4)(x-5) */
double a[6] = { -120, 274, -225, 85, -15, 1 };
double z[6*2];
gsl_poly_complex_workspace *w = gsl_poly_complex_workspace_alloc (6);
int status = gsl_poly_complex_solve (a, 6, w, z);
gsl_poly_complex_workspace_free (w);
gsl_test (status,
"gsl_poly_complex_solve, 5th-order Wilkinson polynomial");
gsl_test_rel (z[0], 1.0, 1e-9, "z0.real, 5th-order polynomial");
gsl_test_rel (z[1], 0.0, 1e-9, "z0.imag, 5th-order polynomial");
gsl_test_rel (z[2], 2.0, 1e-9, "z1.real, 5th-order polynomial");
gsl_test_rel (z[3], 0.0, 1e-9, "z1.imag, 5th-order polynomial");
gsl_test_rel (z[4], 3.0, 1e-9, "z2.real, 5th-order polynomial");
gsl_test_rel (z[5], 0.0, 1e-9, "z2.imag, 5th-order polynomial");
gsl_test_rel (z[6], 4.0, 1e-9, "z3.real, 5th-order polynomial");
gsl_test_rel (z[7], 0.0, 1e-9, "z3.imag, 5th-order polynomial");
gsl_test_rel (z[8], 5.0, 1e-9, "z4.real, 5th-order polynomial");
gsl_test_rel (z[9], 0.0, 1e-9, "z4.imag, 5th-order polynomial");
}
{
/* : 8-th order polynomial y = x^8 + x^4 + 1 */
double a[9] = { 1, 0, 0, 0, 1, 0, 0, 0, 1 };
double z[8*2];
double C = 0.5;
double S = sqrt (3.0) / 2.0;
gsl_poly_complex_workspace *w = gsl_poly_complex_workspace_alloc (9);
int status = gsl_poly_complex_solve (a, 9, w, z);
gsl_poly_complex_workspace_free (w);
gsl_test (status, "gsl_poly_complex_solve, 8th-order polynomial");
gsl_test_rel (z[0], -S, 1e-9, "z0.real, 8th-order polynomial");
gsl_test_rel (z[1], C, 1e-9, "z0.imag, 8th-order polynomial");
gsl_test_rel (z[2], -S, 1e-9, "z1.real, 8th-order polynomial");
gsl_test_rel (z[3], -C, 1e-9, "z1.imag, 8th-order polynomial");
gsl_test_rel (z[4], -C, 1e-9, "z2.real, 8th-order polynomial");
gsl_test_rel (z[5], S, 1e-9, "z2.imag, 8th-order polynomial");
gsl_test_rel (z[6], -C, 1e-9, "z3.real, 8th-order polynomial");
gsl_test_rel (z[7], -S, 1e-9, "z3.imag, 8th-order polynomial");
gsl_test_rel (z[8], C, 1e-9, "z4.real, 8th-order polynomial");
gsl_test_rel (z[9], S, 1e-9, "z4.imag, 8th-order polynomial");
gsl_test_rel (z[10], C, 1e-9, "z5.real, 8th-order polynomial");
gsl_test_rel (z[11], -S, 1e-9, "z5.imag, 8th-order polynomial");
gsl_test_rel (z[12], S, 1e-9, "z6.real, 8th-order polynomial");
gsl_test_rel (z[13], C, 1e-9, "z6.imag, 8th-order polynomial");
gsl_test_rel (z[14], S, 1e-9, "z7.real, 8th-order polynomial");
gsl_test_rel (z[15], -C, 1e-9, "z7.imag, 8th-order polynomial");
}
{
int i;
double xa[7] = {0.16, 0.97, 1.94, 2.74, 3.58, 3.73, 4.70 };
double ya[7] = {0.73, 1.11, 1.49, 1.84, 2.30, 2.41, 3.07 };
double dd_expected[7] = { 7.30000000000000e-01,
4.69135802469136e-01,
-4.34737219941284e-02,
2.68681098870099e-02,
-3.22937056934996e-03,
6.12763259971375e-03,
-6.45402453527083e-03 };
double dd[7], coeff[7], work[7];
gsl_poly_dd_init (dd, xa, ya, 7);
for (i = 0; i < 7; i++)
{
gsl_test_rel (dd[i], dd_expected[i], 1e-10, "divided difference dd[%d]", i);
}
for (i = 0; i < 7; i++)
{
double y = gsl_poly_dd_eval(dd, xa, 7, xa[i]);
gsl_test_rel (y, ya[i], 1e-10, "divided difference y[%d]", i);
}
gsl_poly_dd_taylor (coeff, 1.5, dd, xa, 7, work);
for (i = 0; i < 7; i++)
{
double y = gsl_poly_eval(coeff, 7, xa[i] - 1.5);
gsl_test_rel (y, ya[i], 1e-10, "taylor expansion about 1.5 y[%d]", i);
}
}
{
double c[6] = { +1.0, -2.0, +3.0, -4.0, +5.0, -6.0 };
double dc[6];
double x;
x = -0.5;
gsl_poly_eval_derivs(c, 6, x, dc, 6);
gsl_test_rel (dc[0], c[0] + c[1]*x + c[2]*x*x + c[3]*x*x*x + c[4]*x*x*x*x + c[5]*x*x*x*x*x , eps, "gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6}, 3.75)");
gsl_test_rel (dc[1], c[1] + 2.0*c[2]*x + 3.0*c[3]*x*x + 4.0*c[4]*x*x*x + 5.0*c[5]*x*x*x*x , eps, "gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6} deriv 1, -12.375)");
gsl_test_rel (dc[2], 2.0*c[2] + 3.0*2.0*c[3]*x + 4.0*3.0*c[4]*x*x + 5.0*4.0*c[5]*x*x*x , eps, "gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6} deriv 2, +48.0)");
gsl_test_rel (dc[3], 3.0*2.0*c[3] + 4.0*3.0*2.0*c[4]*x + 5.0*4.0*3.0*c[5]*x*x , eps,"gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6} deriv 3, -174.0)");
gsl_test_rel (dc[4], 4.0*3.0*2.0*c[4] + 5.0*4.0*3.0*2.0*c[5]*x, eps, "gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6} deriv 4, +480.0)");
gsl_test_rel (dc[5], 5.0*4.0*3.0*2.0*c[5] , eps, "gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6} deriv 5, -720.0)");
}
/* now summarize the results */
exit (gsl_test_summary ());
}
void get2Dnoisematrix(struct data *d,int mode)
{
int dim1,dim2,dim3,nr;
double noisefrac;
int h,i,j,k,l;
int n=0;
gsl_complex cx,cx1,cx2;
#ifdef DEBUG
struct timeval tp;
double t1,t2;
char function[20];
strcpy(function,"get2Dnoisematrix"); /* Set function name */
#endif
/* Get noise if it has not been measured */
if (!d->noise.data) getnoise2D(d,mode);
/* Equalize noise if it has not been done */
if (!d->noise.equal) equalizenoise2D(d,mode);
#ifdef DEBUG
fprintf(stdout,"\n%s: %s()\n",SOURCEFILE,function);
gettimeofday(&tp, NULL);
t1=(double)tp.tv_sec+(1.e-6)*tp.tv_usec;
fflush(stdout);
#endif
/* Data dimensions */
dim1=d->np/2; dim2=d->nv; dim3=d->endpos-d->startpos; nr=d->nr;
noisefrac=0.0;
switch(mode) {
case MK: /* Mask parameters */
switch(d->datamode) {
case FID:
noisefrac=*val("masknoisefrac",&d->p);
if (!noisefrac) noisefrac=Knoisefraction;
break;
default:
noisefrac=*val("masklvlnoisefrac",&d->p);
if (!noisefrac) noisefrac=IMnoisefraction;
} /* end datamode switch */
break;
case SM: /* Sensitivity map parameters */
switch(d->datamode) {
case FID:
noisefrac=*val("smapnoisefrac",&d->p);
if (!noisefrac) noisefrac=Knoisefraction;
break;
default:
noisefrac=*val("masklvlnoisefrac",&d->p);
if (!noisefrac) noisefrac=IMnoisefraction;
} /* end datamode switch */
break;
default: /* Default parameters */
switch(d->datamode) {
case FID:
noisefrac=Knoisefraction;
break;
default:
noisefrac=IMnoisefraction;
} /* end datamode switch */
} /* end mode switch */
/* Allocate memory for noise matrix */ /* Get noise if it has not been measured */
if (!d->noise.data) getnoise2D(d,mode);
if ((d->noise.mat = (gsl_matrix_complex **)malloc(dim3*sizeof(gsl_matrix_complex *))) == NULL) nomem();
for (j=0;j<dim3;j++)
d->noise.mat[j]=(gsl_matrix_complex *)gsl_matrix_complex_calloc(nr,nr);
for (h=0;h<nr;h++) {
for (i=0;i<nr;i++) {
if (((d->datamode == FID) && d->shift) || ((d->datamode == IMAGE) && !d->shift)) {
/* For shifted FID and not-shifted IMAGE the noise is at centre */
for (j=0;j<dim3;j++) {
n=0;
GSL_SET_COMPLEX(&cx,0.0,0.0);
for(k=dim2/2-dim2*noisefrac/2;k<dim2/2+dim2*noisefrac/2;k++) {
for (l=dim1/2-dim1*noisefrac/2;l<dim1/2+dim1*noisefrac/2;l++) {
GSL_SET_REAL(&cx1,d->data[h][j][k*dim1+l][0]);
GSL_SET_IMAG(&cx1,d->data[h][j][k*dim1+l][1]);
GSL_SET_REAL(&cx2,d->data[i][j][k*dim1+l][0]);
GSL_SET_IMAG(&cx2,d->data[i][j][k*dim1+l][1]);
cx=gsl_complex_add(cx,gsl_complex_mul(cx1,gsl_complex_conjugate(cx2)));
n++;
}
}
/* Take the mean and normalize */
GSL_SET_COMPLEX(&cx,GSL_REAL(cx)/(n*d->noise.avM2),GSL_IMAG(cx)/(n*d->noise.avM2));
gsl_matrix_complex_set(d->noise.mat[j],h,i,cx);
}
} else {
/* For not shifted FID and shifted IMAGE the noise is at edges */
for (j=0;j<dim3;j++) {
n=0;
GSL_SET_COMPLEX(&cx,0.0,0.0);
for(k=0;k<dim2*noisefrac/2;k++) {
for (l=0;l<dim1*noisefrac/2;l++) {
GSL_SET_REAL(&cx1,d->data[h][j][k*dim1+l][0]);
GSL_SET_IMAG(&cx1,d->data[h][j][k*dim1+l][1]);
GSL_SET_REAL(&cx2,d->data[i][j][k*dim1+l][0]);
GSL_SET_IMAG(&cx2,d->data[i][j][k*dim1+l][1]);
cx=gsl_complex_add(cx,gsl_complex_mul(cx1,gsl_complex_conjugate(cx2)));
n++;
}
for (l=dim1-dim1*noisefrac/2;l<dim1;l++) {
GSL_SET_REAL(&cx1,d->data[h][j][k*dim1+l][0]);
GSL_SET_IMAG(&cx1,d->data[h][j][k*dim1+l][1]);
GSL_SET_REAL(&cx2,d->data[i][j][k*dim1+l][0]);
GSL_SET_IMAG(&cx2,d->data[i][j][k*dim1+l][1]);
cx=gsl_complex_add(cx,gsl_complex_mul(cx1,gsl_complex_conjugate(cx2)));
n++;
}
}
for(k=dim2-dim2*noisefrac/2;k<dim2;k++) {
for (l=0;l<dim1*noisefrac/2;l++) {
GSL_SET_REAL(&cx1,d->data[h][j][k*dim1+l][0]);
GSL_SET_IMAG(&cx1,d->data[h][j][k*dim1+l][1]);
GSL_SET_REAL(&cx2,d->data[i][j][k*dim1+l][0]);
GSL_SET_IMAG(&cx2,d->data[i][j][k*dim1+l][1]);
cx=gsl_complex_add(cx,gsl_complex_mul(cx1,gsl_complex_conjugate(cx2)));
n++;
}
for (l=dim1-dim1*noisefrac/2;l<dim1;l++) {
GSL_SET_REAL(&cx1,d->data[h][j][k*dim1+l][0]);
GSL_SET_IMAG(&cx1,d->data[h][j][k*dim1+l][1]);
GSL_SET_REAL(&cx2,d->data[i][j][k*dim1+l][0]);
GSL_SET_IMAG(&cx2,d->data[i][j][k*dim1+l][1]);
cx=gsl_complex_add(cx,gsl_complex_mul(cx1,gsl_complex_conjugate(cx2)));
n++;
}
}
/* Take the mean and normalize */
GSL_SET_COMPLEX(&cx,GSL_REAL(cx)/(n*d->noise.avM2),GSL_IMAG(cx)/(n*d->noise.avM2));
gsl_matrix_complex_set(d->noise.mat[j],h,i,cx);
}
}
}
}
/* Set noise matrix flag */
d->noise.matrix=TRUE;
#ifdef DEBUG
gettimeofday(&tp, NULL);
t2=(double)tp.tv_sec+(1.e-6)*tp.tv_usec;
fprintf(stdout," Took %f secs\n",t2-t1);
print2Dnoisematrix(d);
fflush(stdout);
#else
/* Print Noise Matrix, if requested */
if (!(strcmp(*sval("printNM",&d->p),"y"))) print2Dnoisematrix(d);
#endif
}
