void
test_eigen_genherm_results (const gsl_matrix_complex * A,
const gsl_matrix_complex * B,
const gsl_vector * eval,
const gsl_matrix_complex * evec,
size_t count,
const char * desc,
const char * desc2)
{
const size_t N = A->size1;
size_t i, j;
gsl_vector_complex * x = gsl_vector_complex_alloc(N);
gsl_vector_complex * y = gsl_vector_complex_alloc(N);
/* check A v = lambda B v */
for (i = 0; i < N; i++)
{
double ei = gsl_vector_get (eval, i);
gsl_vector_complex_const_view vi =
gsl_matrix_complex_const_column(evec, i);
double norm = gsl_blas_dznrm2(&vi.vector);
/* check that eigenvector is normalized */
gsl_test_rel(norm, 1.0, N * GSL_DBL_EPSILON,
"genherm(N=%u,cnt=%u), %s, normalized(%d), %s", N, count,
desc, i, desc2);
/* compute y = A z */
gsl_blas_zgemv (CblasNoTrans, GSL_COMPLEX_ONE, A, &vi.vector, GSL_COMPLEX_ZERO, y);
/* compute x = B z */
gsl_blas_zgemv (CblasNoTrans, GSL_COMPLEX_ONE, B, &vi.vector, GSL_COMPLEX_ZERO, x);
/* compute x = lambda B z */
gsl_blas_zdscal(ei, x);
/* now test if y = x */
for (j = 0; j < N; j++)
{
gsl_complex xj = gsl_vector_complex_get (x, j);
gsl_complex yj = gsl_vector_complex_get (y, j);
gsl_test_rel(GSL_REAL(yj), GSL_REAL(xj), 1e9 * GSL_DBL_EPSILON,
"genherm(N=%u,cnt=%u), %s, eigenvalue(%d,%d), real, %s", N, count, desc, i, j, desc2);
gsl_test_abs(GSL_IMAG(yj), GSL_IMAG(xj), 1e9 * GSL_DBL_EPSILON,
"genherm(N=%u,cnt=%u), %s, eigenvalue(%d,%d), imag, %s", N, count, desc, i, j, desc2);
}
}
gsl_vector_complex_free(x);
gsl_vector_complex_free(y);
}
static void
genhermv_normalize_eigenvectors(gsl_matrix_complex *evec)
{
const size_t N = evec->size1;
size_t i; /* looping */
for (i = 0; i < N; ++i)
{
gsl_vector_complex_view vi = gsl_matrix_complex_column(evec, i);
double scale = 1.0 / gsl_blas_dznrm2(&vi.vector);
gsl_blas_zdscal(scale, &vi.vector);
}
} /* genhermv_normalize_eigenvectors() */
int
print_Lcurve(const char *filename, poltor_workspace *w)
{
int s = 0;
FILE *fp;
const size_t p = w->p;
double rnorm, Lnorm;
gsl_vector_complex_view v = gsl_vector_complex_subvector(w->rhs, 0, p);
size_t i;
fp = fopen(filename, "a");
if (!fp)
{
fprintf(stderr, "print_Lcurve: unable to open %s: %s\n",
filename, strerror(errno));
return -1;
}
/* construct A and b, and calculate chi^2 = ||b - A c||^2 */
poltor_build_ls(0, w);
rnorm = sqrt(w->chisq);
/* compute v = L c; L is stored in w->L by poltor_solve() */
for (i = 0; i < p; ++i)
{
gsl_complex ci = gsl_vector_complex_get(w->c, i);
double li = gsl_vector_get(w->L, i);
gsl_complex val = gsl_complex_mul_real(ci, li);
gsl_vector_complex_set(&v.vector, i, val);
}
/* compute || L c || */
Lnorm = gsl_blas_dznrm2(&v.vector);
fprintf(fp, "%.12e %.12e %.6e %.6e %.6e\n",
log(rnorm),
log(Lnorm),
w->alpha_int,
w->alpha_sh,
w->alpha_tor);
printcv_octave(w->residuals, "r");
printcv_octave(w->c, "c");
printv_octave(w->L, "L");
fclose(fp);
return s;
} /* print_Lcurve() */
int
lls_complex_solve(const double lambda, gsl_vector_complex *c, lls_complex_workspace *w)
{
if (c->size != w->p)
{
fprintf(stderr, "lls_complex_solve: coefficient vector has wrong size\n");
return GSL_EBADLEN;
}
else
{
int s = 0;
/* solve (AHA + lambda^2 I) c = AHb and estimate condition number */
s = lls_lapack_zposv(lambda, c, w);
/* compute residual || AHA c - AHb || */
gsl_vector_complex_memcpy(w->work_b, w->AHb);
gsl_blas_zhemv(CblasUpper, GSL_COMPLEX_ONE, w->AHA, c, GSL_COMPLEX_NEGONE, w->work_b);
w->residual = gsl_blas_dznrm2(w->work_b);
/* compute chi^2 = b^H b - 2 c^H A^H b + c^H A^H A c */
{
gsl_complex negtwo = gsl_complex_rect(-2.0, 0.0);
gsl_complex val;
/* compute: AHA c - 2 AHb */
gsl_vector_complex_memcpy(w->work_b, w->AHb);
gsl_blas_zhemv(CblasUpper, GSL_COMPLEX_ONE, w->AHA, c, negtwo, w->work_b);
/* compute: c^H ( AHA c - 2 AHb ) */
gsl_blas_zdotc(c, w->work_b, &val);
w->chisq = w->bHb + GSL_REAL(val);
}
/* save coefficient vector for future robust iterations */
gsl_vector_complex_memcpy(w->c, c);
++(w->niter);
return s;
}
} /* lls_complex_solve() */
/**
* C++ version of gsl_blas_dznrm2().
* @param X A vector
* @return The Euclidean norm
*/
double dznrm2( vector_complex const& X ){ return gsl_blas_dznrm2( X.get() ); }
/** Get Euclidean norm */
double vector<complex>::mod() const
{
return gsl_blas_dznrm2(_vector);
}
static VALUE rb_gsl_blas_dznrm2(int argc, VALUE *argv, VALUE obj)
{
gsl_vector_complex *x = NULL;
get_vector_complex1(argc, argv, obj, &x);
return rb_float_new(gsl_blas_dznrm2(x));
}
void
test_eigen_nonsymm_results (const gsl_matrix * m,
const gsl_vector_complex * eval,
const gsl_matrix_complex * evec,
size_t count,
const char * desc,
const char * desc2)
{
size_t i,j;
size_t N = m->size1;
gsl_vector_complex * x = gsl_vector_complex_alloc(N);
gsl_vector_complex * y = gsl_vector_complex_alloc(N);
gsl_matrix_complex * A = gsl_matrix_complex_alloc(N, N);
/* we need a complex matrix for the blas routines, so copy m into A */
for (i = 0; i < N; ++i)
{
for (j = 0; j < N; ++j)
{
gsl_complex z;
GSL_SET_COMPLEX(&z, gsl_matrix_get(m, i, j), 0.0);
gsl_matrix_complex_set(A, i, j, z);
}
}
for (i = 0; i < N; i++)
{
gsl_complex ei = gsl_vector_complex_get (eval, i);
gsl_vector_complex_const_view vi = gsl_matrix_complex_const_column(evec, i);
double norm = gsl_blas_dznrm2(&vi.vector);
/* check that eigenvector is normalized */
gsl_test_rel(norm, 1.0, N * GSL_DBL_EPSILON,
"nonsymm(N=%u,cnt=%u), %s, normalized(%d), %s", N, count, desc, i, desc2);
gsl_vector_complex_memcpy(x, &vi.vector);
/* compute y = m x (should = lambda v) */
gsl_blas_zgemv (CblasNoTrans, GSL_COMPLEX_ONE, A, x,
GSL_COMPLEX_ZERO, y);
/* compute x = lambda v */
gsl_blas_zscal(ei, x);
/* now test if y = x */
for (j = 0; j < N; j++)
{
gsl_complex xj = gsl_vector_complex_get (x, j);
gsl_complex yj = gsl_vector_complex_get (y, j);
/* use abs here in case the values are close to 0 */
gsl_test_abs(GSL_REAL(yj), GSL_REAL(xj), 1e8*GSL_DBL_EPSILON,
"nonsymm(N=%u,cnt=%u), %s, eigenvalue(%d,%d), real, %s", N, count, desc, i, j, desc2);
gsl_test_abs(GSL_IMAG(yj), GSL_IMAG(xj), 1e8*GSL_DBL_EPSILON,
"nonsymm(N=%u,cnt=%u), %s, eigenvalue(%d,%d), imag, %s", N, count, desc, i, j, desc2);
}
}
gsl_matrix_complex_free(A);
gsl_vector_complex_free(x);
gsl_vector_complex_free(y);
}
void
test_eigen_herm_results (const gsl_matrix_complex * A,
const gsl_vector * eval,
const gsl_matrix_complex * evec,
size_t count,
const char * desc,
const char * desc2)
{
const size_t N = A->size1;
size_t i, j;
gsl_vector_complex * x = gsl_vector_complex_alloc(N);
gsl_vector_complex * y = gsl_vector_complex_alloc(N);
/* check eigenvalues */
for (i = 0; i < N; i++)
{
double ei = gsl_vector_get (eval, i);
gsl_vector_complex_const_view vi =
gsl_matrix_complex_const_column(evec, i);
gsl_vector_complex_memcpy(x, &vi.vector);
/* compute y = m x (should = lambda v) */
gsl_blas_zgemv (CblasNoTrans, GSL_COMPLEX_ONE, A, x,
GSL_COMPLEX_ZERO, y);
for (j = 0; j < N; j++)
{
gsl_complex xj = gsl_vector_complex_get (x, j);
gsl_complex yj = gsl_vector_complex_get (y, j);
gsl_test_rel(GSL_REAL(yj), ei * GSL_REAL(xj), 1e8*GSL_DBL_EPSILON,
"%s, eigenvalue(%d,%d), real, %s", desc, i, j, desc2);
gsl_test_rel(GSL_IMAG(yj), ei * GSL_IMAG(xj), 1e8*GSL_DBL_EPSILON,
"%s, eigenvalue(%d,%d), imag, %s", desc, i, j, desc2);
}
}
/* check eigenvectors are orthonormal */
for (i = 0; i < N; i++)
{
gsl_vector_complex_const_view vi = gsl_matrix_complex_const_column(evec, i);
double nrm_v = gsl_blas_dznrm2(&vi.vector);
gsl_test_rel (nrm_v, 1.0, N * GSL_DBL_EPSILON, "%s, normalized(%d), %s",
desc, i, desc2);
}
for (i = 0; i < N; i++)
{
gsl_vector_complex_const_view vi = gsl_matrix_complex_const_column(evec, i);
for (j = i + 1; j < N; j++)
{
gsl_vector_complex_const_view vj
= gsl_matrix_complex_const_column(evec, j);
gsl_complex vivj;
gsl_blas_zdotc (&vi.vector, &vj.vector, &vivj);
gsl_test_abs (gsl_complex_abs(vivj), 0.0, 10.0 * N * GSL_DBL_EPSILON,
"%s, orthogonal(%d,%d), %s", desc, i, j, desc2);
}
}
gsl_vector_complex_free(x);
gsl_vector_complex_free(y);
} /* test_eigen_herm_results() */
static bool _convert(CVECTOR *_object, GB_TYPE type, GB_VALUE *conv)
{
if (THIS)
{
if (!COMPLEX(THIS))
{
switch (type)
{
case GB_T_FLOAT:
conv->_float.value = gsl_blas_dnrm2(VEC(THIS));
return FALSE;
case GB_T_SINGLE:
conv->_single.value = gsl_blas_dnrm2(VEC(THIS));
return FALSE;
case GB_T_INTEGER:
case GB_T_SHORT:
case GB_T_BYTE:
conv->_integer.value = gsl_blas_dnrm2(VEC(THIS));
return FALSE;
case GB_T_LONG:
conv->_long.value = gsl_blas_dnrm2(VEC(THIS));
return FALSE;
case GB_T_STRING:
case GB_T_CSTRING:
conv->_string.value.addr = _to_string(THIS, type == GB_T_CSTRING);
conv->_string.value.start = 0;
conv->_string.value.len = GB.StringLength(conv->_string.value.addr);
return FALSE;
default:
break;
}
}
else
{
switch (type)
{
case GB_T_FLOAT:
conv->_float.value = gsl_blas_dznrm2(CVEC(THIS));
return FALSE;
case GB_T_SINGLE:
conv->_single.value = gsl_blas_dznrm2(CVEC(THIS));
return FALSE;
case GB_T_INTEGER:
case GB_T_SHORT:
case GB_T_BYTE:
conv->_integer.value = gsl_blas_dznrm2(CVEC(THIS));
return FALSE;
case GB_T_LONG:
conv->_long.value = gsl_blas_dznrm2(CVEC(THIS));
return FALSE;
case GB_T_STRING:
case GB_T_CSTRING:
conv->_string.value.addr = _to_string(THIS, type == GB_T_CSTRING);
conv->_string.value.start = 0;
conv->_string.value.len = GB.StringLength(conv->_string.value.addr);
return FALSE;
default:
break;
}
}
// Vector ---> Float[]
if ((type == GB.FindClass("Float[]") || type == CLASS_Polynomial) && !COMPLEX(THIS))
{
GB_ARRAY a;
int i;
double *data;
GB.Array.New(&a, GB_T_FLOAT, SIZE(THIS));
data = (double *)GB.Array.Get(a, 0);
for(i = 0; i < SIZE(THIS); i++)
data[i] = gsl_vector_get(VEC(THIS), i);
conv->_object.value = a;
if (type != CLASS_Polynomial)
return FALSE;
}
// Vector ---> Complex[]
else if (type == GB.FindClass("Complex[]") || type == CLASS_Polynomial)
{
GB_ARRAY a;
int i;
void **data;
CCOMPLEX *c;
GB.Array.New(&a, CLASS_Complex, SIZE(THIS));
data = (void **)GB.Array.Get(a, 0);
for(i = 0; i < SIZE(THIS); i++)
{
c = COMPLEX_create(COMPLEX(THIS) ? gsl_vector_complex_get(CVEC(THIS), i) : gsl_complex_rect(gsl_vector_get(VEC(THIS), i), 0));
data[i] = c;
GB.Ref(c);
}
conv->_object.value = a;
if (type != CLASS_Polynomial)
return FALSE;
}
else
return TRUE;
// Vector ---> Polynomial
if (type == CLASS_Polynomial)
{
void *unref = conv->_object.value;
GB.Ref(unref); // Will be unref by the next GB.Conv()
POLYNOMIAL_convert(FALSE, type, conv);
GB.Unref(&unref); // Will be unref by the next GB.Conv()
//GB.Conv(conv, type);
//GB.UnrefKeep(&conv->_object.value, FALSE); // Will be ref again after the current GB.Conv()
return FALSE;
}
}
else if (type >= GB_T_OBJECT)
{
if (GB.Is(conv->_object.value, CLASS_Array))
{
GB_ARRAY array = (GB_ARRAY)conv->_object.value;
int size = GB.Array.Count(array);
CVECTOR *v;
int i;
GB_VALUE temp;
void *data;
GB_TYPE atype = GB.Array.Type(array);
// Float[] Integer[] ... ---> Vector
if (atype > GB_T_BOOLEAN && atype <= GB_T_FLOAT)
{
v = VECTOR_create(size, FALSE, FALSE);
for (i = 0; i < size; i++)
{
data = GB.Array.Get(array, i);
GB.ReadValue(&temp, data, atype);
GB.Conv(&temp, GB_T_FLOAT);
gsl_vector_set(VEC(v), i, temp._float.value);
}
conv->_object.value = v;
return FALSE;
}
// Variant[] ---> Vector
else if (atype == GB_T_VARIANT)
{
CCOMPLEX *c;
v = VECTOR_create(size, TRUE, FALSE);
for (i = 0; i < size; i++)
{
GB.ReadValue(&temp, GB.Array.Get(array, i), atype);
GB.BorrowValue(&temp);
GB.Conv(&temp, CLASS_Complex);
c = temp._object.value;
if (c)
gsl_vector_complex_set(CVEC(v), i, c->number);
else
gsl_vector_complex_set(CVEC(v), i, COMPLEX_zero);
GB.ReleaseValue(&temp);
}
conv->_object.value = v;
return FALSE;
}
// Complex[] ---> Vector
else if (atype == CLASS_Complex)
{
CCOMPLEX *c;
v = VECTOR_create(size, TRUE, FALSE);
for (i = 0; i < size; i++)
{
c = *((CCOMPLEX **)GB.Array.Get(array, i));
if (c)
gsl_vector_complex_set(CVEC(v), i, c->number);
else
gsl_vector_complex_set(CVEC(v), i, COMPLEX_zero);
}
conv->_object.value = v;
return FALSE;
}
}
// Float Integer... ---> Vector
else if (type > GB_T_BOOLEAN && type <= GB_T_FLOAT)
{
CVECTOR *v = VECTOR_create(1, FALSE, FALSE);
if (type == GB_T_FLOAT)
gsl_vector_set(VEC(v), 0, conv->_float.value);
else if (type == GB_T_SINGLE)
gsl_vector_set(VEC(v), 0, conv->_single.value);
else
gsl_vector_set(VEC(v), 0, conv->_integer.value);
conv->_object.value = v;
return FALSE;
}
// Complex ---> Vector
else if (type == CLASS_Complex)
{
CCOMPLEX *c = (CCOMPLEX *)conv->_object.value;
CVECTOR *v = VECTOR_create(1, TRUE, FALSE);
gsl_vector_complex_set(CVEC(v), 0, c->number);
conv->_object.value = v;
return FALSE;
}
}
return TRUE;
}
int
lls_complex_lcurve(gsl_vector *reg_param, gsl_vector *rho, gsl_vector *eta,
lls_complex_workspace *w)
{
const size_t N = rho->size; /* number of points on L-curve */
if (N != reg_param->size)
{
GSL_ERROR("size of reg_param and rho do not match", GSL_EBADLEN);
}
else if (N != eta->size)
{
GSL_ERROR("size of eta and rho do not match", GSL_EBADLEN);
}
else
{
int s;
const gsl_complex negtwo = gsl_complex_rect(-2.0, 0.0);
/* smallest regularization parameter */
const double smin_ratio = 16.0 * GSL_DBL_EPSILON;
double s1, sp, ratio, tmp;
size_t i;
/* compute eigenvalues of A^H A */
gsl_matrix_complex_transpose_memcpy(w->work_A, w->AHA);
s = gsl_eigen_herm(w->work_A, w->eval, w->eigen_p);
if (s)
return s;
/* find largest and smallest eigenvalues */
gsl_vector_minmax(w->eval, &sp, &s1);
/* singular values are square roots of eigenvalues */
s1 = sqrt(s1);
if (sp > GSL_DBL_EPSILON)
sp = sqrt(fabs(sp));
tmp = GSL_MAX(sp, s1*smin_ratio);
gsl_vector_set(reg_param, N - 1, tmp);
/* ratio so that reg_param(1) = s(1) */
ratio = pow(s1 / tmp, 1.0 / (N - 1.0));
/* calculate the regularization parameters */
for (i = N - 1; i > 0 && i--; )
{
double rp1 = gsl_vector_get(reg_param, i + 1);
gsl_vector_set(reg_param, i, ratio * rp1);
}
for (i = 0; i < N; ++i)
{
double r2;
double lambda = gsl_vector_get(reg_param, i);
gsl_complex val;
lls_complex_solve(lambda, w->c, w);
/* store ||c|| */
gsl_vector_set(eta, i, gsl_blas_dznrm2(w->c));
/* compute: A^H A c - 2 A^H b */
gsl_vector_complex_memcpy(w->work_b, w->AHb);
gsl_blas_zhemv(CblasUpper, GSL_COMPLEX_ONE, w->AHA, w->c, negtwo, w->work_b);
/* compute: c^T A^T A c - 2 c^T A^T b */
gsl_blas_zdotc(w->c, w->work_b, &val);
r2 = GSL_REAL(val) + w->bHb;
gsl_vector_set(rho, i, sqrt(r2));
}
return GSL_SUCCESS;
}
} /* lls_complex_lcurve() */
int
lls_complex_fold(const gsl_matrix_complex *A, const gsl_vector_complex *b,
lls_complex_workspace *w)
{
const size_t n = A->size1;
if (A->size2 != w->p)
{
fprintf(stderr, "lls_complex_fold: A has wrong size2\n");
return GSL_EBADLEN;
}
else if (n != b->size)
{
fprintf(stderr, "lls_complex_fold: b has wrong size\n");
return GSL_EBADLEN;
}
else
{
int s = 0;
double bnorm;
#if 0
size_t i;
gsl_vector_view wv = gsl_vector_subvector(w->w_robust, 0, n);
if (w->niter > 0)
{
gsl_vector_complex_view rc = gsl_vector_complex_subvector(w->r_complex, 0, n);
gsl_vector_view rv = gsl_vector_subvector(w->r, 0, n);
/* calculate residuals with previously computed coefficients: r = b - A c */
gsl_vector_complex_memcpy(&rc.vector, b);
gsl_blas_zgemv(CblasNoTrans, GSL_COMPLEX_NEGONE, A, w->c, GSL_COMPLEX_ONE, &rc.vector);
/* compute Re(r) */
for (i = 0; i < n; ++i)
{
gsl_complex ri = gsl_vector_complex_get(&rc.vector, i);
gsl_vector_set(&rv.vector, i, GSL_REAL(ri));
}
/* calculate weights with robust weighting function */
gsl_multifit_robust_weights(&rv.vector, &wv.vector, w->robust_workspace_p);
}
else
gsl_vector_set_all(&wv.vector, 1.0);
/* compute final weights as product of input and robust weights */
gsl_vector_mul(wts, &wv.vector);
#endif
/* AHA += A^H A, using only the upper half of the matrix */
s = gsl_blas_zherk(CblasUpper, CblasConjTrans, 1.0, A, 1.0, w->AHA);
if (s)
return s;
/* AHb += A^H b */
s = gsl_blas_zgemv(CblasConjTrans, GSL_COMPLEX_ONE, A, b, GSL_COMPLEX_ONE, w->AHb);
if (s)
return s;
/* bHb += b^H b */
bnorm = gsl_blas_dznrm2(b);
w->bHb += bnorm * bnorm;
fprintf(stderr, "norm(AHb) = %.12e, bHb = %.12e\n",
gsl_blas_dznrm2(w->AHb), w->bHb);
if (!gsl_finite(w->bHb))
{
fprintf(stderr, "bHb is NAN\n");
exit(1);
}
return s;
}
} /* lls_complex_fold() */