void
eigen_symm2x2 (float A11, float A12, float A22, float *l1, float *l2,
float *e11, float *e12, float *e21, float *e22)
{
struct mat2x2 A;
struct mat2x2 E = {1, 0, 0, 1};
struct mat2x2 Q, Qt;
float c, s;
A.a = A11; A.b = A.c = A12; A.d = A22;
chop_small_elements (&A);
if (!((A.b == 0.0f) || isnan (A.b))) {
float x = A.a - trailing_eigenvalue (A);
float z = A.b;
/* Calculate Givens rotation coefficients. */
if (z == 0) {
s = 0; c = 1;
} else if (fabsf (z) > fabsf (x)) {
float t = -x / z;
float u = copysign (sqrtf (1 + t*t), 1);
s = 1.0 / u;
c = s * t;
} else {
float t = -z / x;
float u = copysign (sqrtf (1 + t*t), 1);
c = 1.0 / u;
s = c * t;
}
/* Create rotation matrices */
Qt.a = Q.d = c;
Qt.b = -s;
Qt.c = s;
Q.a = Qt.d = c;
Q.b = s;
Q.c = -s;
/* Rotate source matrix and eigenvector matrix together */
A = mat2x2mul (mat2x2mul (Q, A), Qt);
E = Qt;
}
/* Return values */
*l1 = A.a;
*l2 = A.d;
*e11 = E.a;
*e12 = E.b;
*e21 = E.c;
*e22 = E.d;
}
int
gsl_linalg_SV_decomp (gsl_matrix * A, gsl_matrix * V, gsl_vector * S,
gsl_vector * work)
{
size_t a, b, i, j, iter;
const size_t M=A->size1;
const size_t N=A->size2;
size_t K;
if (M<N) K=M;
else K=N;
if (M < N)
{
GSL_ERROR ("svd of MxN matrix, M<N, is not implemented", GSL_EUNIMPL);
}
else if (V->size1 != N)
{
GSL_ERROR ("square matrix V must match second dimension of matrix A",
GSL_EBADLEN);
}
else if (V->size1 != V->size2)
{
GSL_ERROR ("matrix V must be square", GSL_ENOTSQR);
}
else if (S->size != N)
{
GSL_ERROR ("length of vector S must match second dimension of matrix A",
GSL_EBADLEN);
}
else if (work->size != N)
{
GSL_ERROR ("length of workspace must match second dimension of matrix A",
GSL_EBADLEN);
}
/* Handle the case of N=1 (SVD of a column vector) */
if (N == 1)
{
gsl_vector_view column=gsl_matrix_column (A, 0);
double norm=gsl_blas_dnrm2 (&column.vector);
gsl_vector_set (S, 0, norm);
gsl_matrix_set (V, 0, 0, 1.0);
if (norm != 0.0)
{
gsl_blas_dscal (1.0/norm, &column.vector);
}
return GSL_SUCCESS;
}
{
gsl_vector_view f=gsl_vector_subvector (work, 0, K - 1);
/* bidiagonalize matrix A, unpack A into U S V */
gsl_linalg_bidiag_decomp (A, S, &f.vector);
//std::cout << "A: " << gsl_matrix_get(A,0,0) << " "
//<< gsl_matrix_get(A,M-1,N-1) << std::endl;
//std::cout << "S: " << S->data[0] << " "
//<< S->data[S->size-1]
//<< std::endl;
gsl_linalg_bidiag_unpack2 (A, S, &f.vector, V);
//std::cout << "S2: " << S->data[0] << " "
//<< S->data[S->size-1]
//<< std::endl;
/* apply reduction steps to B=(S,Sd) */
chop_small_elements (S, &f.vector);
//std::cout << "S3: " << S->data[0] << " "
//<< S->data[S->size-1]
//<< std::endl;
/* Progressively reduce the matrix until it is diagonal */
b=N - 1;
iter=0;
while (b > 0)
{
double fbm1=gsl_vector_get (&f.vector, b - 1);
if (fbm1 == 0.0 || gsl_isnan (fbm1))
{
b--;
continue;
}
//std::cout << "b,fbm1: " << b << " " << fbm1 << std::endl;
/* Find the largest unreduced block (a,b) starting from b
and working backwards */
a=b - 1;
while (a > 0)
{
double fam1=gsl_vector_get (&f.vector, a - 1);
if (fam1 == 0.0 || gsl_isnan (fam1))
{
break;
}
a--;
//std::cout << "a,fam1: " << a << " " << fam1 << std::endl;
}
iter++;
if (iter > 100 * N)
{
GSL_ERROR("SVD decomposition failed to converge", GSL_EMAXITER);
}
{
const size_t n_block=b - a + 1;
gsl_vector_view S_block=gsl_vector_subvector (S, a, n_block);
gsl_vector_view f_block=gsl_vector_subvector
(&f.vector, a, n_block - 1);
gsl_matrix_view U_block =
gsl_matrix_submatrix (A, 0, a, A->size1, n_block);
gsl_matrix_view V_block =
gsl_matrix_submatrix (V, 0, a, V->size1, n_block);
int rescale=0;
double scale=1;
double norm=0;
/* Find the maximum absolute values of the diagonal and subdiagonal */
for (i=0; i < n_block; i++)
{
double s_i=gsl_vector_get (&S_block.vector, i);
double a=fabs(s_i);
if (a > norm) norm=a;
//std::cout << "aa: " << a << std::endl;
}
for (i=0; i < n_block - 1; i++)
{
double f_i=gsl_vector_get (&f_block.vector, i);
double a=fabs(f_i);
if (a > norm) norm=a;
//std::cout << "aa2: " << a << std::endl;
}
/* Temporarily scale the submatrix if necessary */
if (norm > GSL_SQRT_DBL_MAX)
{
scale=(norm / GSL_SQRT_DBL_MAX);
rescale=1;
}
else if (norm < GSL_SQRT_DBL_MIN && norm > 0)
{
scale=(norm / GSL_SQRT_DBL_MIN);
rescale=1;
}
//std::cout << "rescale: " << rescale << std::endl;
if (rescale)
{
gsl_blas_dscal(1.0 / scale, &S_block.vector);
gsl_blas_dscal(1.0 / scale, &f_block.vector);
}
/* Perform the implicit QR step */
/*
for(size_t ii=0;ii<M;ii++) {
for(size_t jj=0;jj<N;jj++) {
std::cout << ii << "." << jj << "."
<< gsl_matrix_get(A,ii,jj) << std::endl;
}
}
for(size_t ii=0;ii<N;ii++) {
for(size_t jj=0;jj<N;jj++) {
std::cout << "V: " << ii << "." << jj << "."
<< gsl_matrix_get(V,ii,jj) << std::endl;
}
}
*/
qrstep (&S_block.vector, &f_block.vector, &U_block.matrix,
&V_block.matrix);
/*
for(size_t ii=0;ii<M;ii++) {
for(size_t jj=0;jj<N;jj++) {
std::cout << ii << " " << jj << " "
<< gsl_matrix_get(A,ii,jj) << std::endl;
}
}
for(size_t ii=0;ii<N;ii++) {
for(size_t jj=0;jj<N;jj++) {
std::cout << "V: " << ii << " " << jj << " "
<< gsl_matrix_get(V,ii,jj) << std::endl;
}
}
*/
/* remove any small off-diagonal elements */
chop_small_elements (&S_block.vector, &f_block.vector);
/* Undo the scaling if needed */
if (rescale)
{
gsl_blas_dscal(scale, &S_block.vector);
gsl_blas_dscal(scale, &f_block.vector);
}
}
}
}
/* Make singular values positive by reflections if necessary */
for (j=0; j < K; j++)
{
double Sj=gsl_vector_get (S, j);
if (Sj < 0.0)
{
for (i=0; i < N; i++)
{
double Vij=gsl_matrix_get (V, i, j);
gsl_matrix_set (V, i, j, -Vij);
}
gsl_vector_set (S, j, -Sj);
}
}
/* Sort singular values into decreasing order */
for (i=0; i < K; i++)
{
double S_max=gsl_vector_get (S, i);
size_t i_max=i;
for (j=i + 1; j < K; j++)
{
double Sj=gsl_vector_get (S, j);
if (Sj > S_max)
{
S_max=Sj;
i_max=j;
}
}
if (i_max != i)
{
/* swap eigenvalues */
gsl_vector_swap_elements (S, i, i_max);
/* swap eigenvectors */
gsl_matrix_swap_columns (A, i, i_max);
gsl_matrix_swap_columns (V, i, i_max);
}
}
return GSL_SUCCESS;
}
int
gsl_eigen_herm (gsl_matrix_complex * A, gsl_vector * eval,
gsl_eigen_herm_workspace * w)
{
if (A->size1 != A->size2)
{
GSL_ERROR ("matrix must be square to compute eigenvalues", GSL_ENOTSQR);
}
else if (eval->size != A->size1)
{
GSL_ERROR ("eigenvalue vector must match matrix size", GSL_EBADLEN);
}
else
{
const size_t N = A->size1;
double *const d = w->d;
double *const sd = w->sd;
size_t a, b;
/* handle special case */
if (N == 1)
{
gsl_complex A00 = gsl_matrix_complex_get (A, 0, 0);
gsl_vector_set (eval, 0, GSL_REAL(A00));
return GSL_SUCCESS;
}
{
gsl_vector_view d_vec = gsl_vector_view_array (d, N);
gsl_vector_view sd_vec = gsl_vector_view_array (sd, N - 1);
gsl_vector_complex_view tau_vec = gsl_vector_complex_view_array (w->tau, N-1);
gsl_linalg_hermtd_decomp (A, &tau_vec.vector);
gsl_linalg_hermtd_unpack_T (A, &d_vec.vector, &sd_vec.vector);
}
/* Make an initial pass through the tridiagonal decomposition
to remove off-diagonal elements which are effectively zero */
chop_small_elements (N, d, sd);
/* Progressively reduce the matrix until it is diagonal */
b = N - 1;
while (b > 0)
{
if (sd[b - 1] == 0.0 || isnan(sd[b - 1]))
{
b--;
continue;
}
/* Find the largest unreduced block (a,b) starting from b
and working backwards */
a = b - 1;
while (a > 0)
{
if (sd[a - 1] == 0.0)
{
break;
}
a--;
}
{
const size_t n_block = b - a + 1;
double *d_block = d + a;
double *sd_block = sd + a;
/* apply QR reduction with implicit deflation to the
unreduced block */
qrstep (n_block, d_block, sd_block, NULL, NULL);
/* remove any small off-diagonal elements */
chop_small_elements (n_block, d_block, sd_block);
}
}
{
gsl_vector_view d_vec = gsl_vector_view_array (d, N);
gsl_vector_memcpy (eval, &d_vec.vector);
}
return GSL_SUCCESS;
}
}
int
gsl_eigen_hermv (gsl_matrix_complex * A, gsl_vector * eval,
gsl_matrix_complex * evec,
gsl_eigen_hermv_workspace * w)
{
if (A->size1 != A->size2)
{
GSL_ERROR ("matrix must be square to compute eigenvalues", GSL_ENOTSQR);
}
else if (eval->size != A->size1)
{
GSL_ERROR ("eigenvalue vector must match matrix size", GSL_EBADLEN);
}
else if (evec->size1 != A->size1 || evec->size2 != A->size1)
{
GSL_ERROR ("eigenvector matrix must match matrix size", GSL_EBADLEN);
}
else
{
const size_t N = A->size1;
double *const d = w->d;
double *const sd = w->sd;
size_t a, b;
/* handle special case */
if (N == 1)
{
gsl_complex A00 = gsl_matrix_complex_get (A, 0, 0);
gsl_vector_set (eval, 0, GSL_REAL(A00));
gsl_matrix_complex_set (evec, 0, 0, GSL_COMPLEX_ONE);
return GSL_SUCCESS;
}
/* Transform the matrix into a symmetric tridiagonal form */
{
gsl_vector_view d_vec = gsl_vector_view_array (d, N);
gsl_vector_view sd_vec = gsl_vector_view_array (sd, N - 1);
gsl_vector_complex_view tau_vec = gsl_vector_complex_view_array (w->tau, N-1);
gsl_linalg_hermtd_decomp (A, &tau_vec.vector);
gsl_linalg_hermtd_unpack (A, &tau_vec.vector, evec, &d_vec.vector, &sd_vec.vector);
}
/* Make an initial pass through the tridiagonal decomposition
to remove off-diagonal elements which are effectively zero */
chop_small_elements (N, d, sd);
/* Progressively reduce the matrix until it is diagonal */
b = N - 1;
while (b > 0)
{
if (sd[b - 1] == 0.0 || isnan(sd[b - 1]))
{
b--;
continue;
}
/* Find the largest unreduced block (a,b) starting from b
and working backwards */
a = b - 1;
while (a > 0)
{
if (sd[a - 1] == 0.0)
{
break;
}
a--;
}
{
size_t i;
const size_t n_block = b - a + 1;
double *d_block = d + a;
double *sd_block = sd + a;
double * const gc = w->gc;
double * const gs = w->gs;
/* apply QR reduction with implicit deflation to the
unreduced block */
qrstep (n_block, d_block, sd_block, gc, gs);
/* Apply Givens rotation Gij(c,s) to matrix Q, Q <- Q G */
for (i = 0; i < n_block - 1; i++)
{
const double c = gc[i], s = gs[i];
size_t k;
for (k = 0; k < N; k++)
{
gsl_complex qki = gsl_matrix_complex_get (evec, k, a + i);
gsl_complex qkj = gsl_matrix_complex_get (evec, k, a + i + 1);
/* qki <= qki * c - qkj * s */
/* qkj <= qki * s + qkj * c */
gsl_complex x1 = gsl_complex_mul_real(qki, c);
gsl_complex y1 = gsl_complex_mul_real(qkj, -s);
gsl_complex x2 = gsl_complex_mul_real(qki, s);
gsl_complex y2 = gsl_complex_mul_real(qkj, c);
gsl_complex qqki = gsl_complex_add(x1, y1);
gsl_complex qqkj = gsl_complex_add(x2, y2);
gsl_matrix_complex_set (evec, k, a + i, qqki);
gsl_matrix_complex_set (evec, k, a + i + 1, qqkj);
}
}
/* remove any small off-diagonal elements */
chop_small_elements (n_block, d_block, sd_block);
}
}
{
gsl_vector_view d_vec = gsl_vector_view_array (d, N);
gsl_vector_memcpy (eval, &d_vec.vector);
}
return GSL_SUCCESS;
}
}
int
gsl_linalg_SV_decomp (gsl_matrix * A, gsl_matrix * V, gsl_vector * S,
gsl_vector * work)
{
size_t a, b, i, j, iter;
const size_t M = A->size1;
const size_t N = A->size2;
const size_t K = GSL_MIN (M, N);
if (M < N)
{
GSL_ERROR ("svd of MxN matrix, M<N, is not implemented", GSL_EUNIMPL);
}
else if (V->size1 != N)
{
GSL_ERROR ("square matrix V must match second dimension of matrix A",
GSL_EBADLEN);
}
else if (V->size1 != V->size2)
{
GSL_ERROR ("matrix V must be square", GSL_ENOTSQR);
}
else if (S->size != N)
{
GSL_ERROR ("length of vector S must match second dimension of matrix A",
GSL_EBADLEN);
}
else if (work->size != N)
{
GSL_ERROR ("length of workspace must match second dimension of matrix A",
GSL_EBADLEN);
}
/* Handle the case of N = 1 (SVD of a column vector) */
if (N == 1)
{
gsl_vector_view column = gsl_matrix_column (A, 0);
double norm = gsl_blas_dnrm2 (&column.vector);
gsl_vector_set (S, 0, norm);
gsl_matrix_set (V, 0, 0, 1.0);
if (norm != 0.0)
{
gsl_blas_dscal (1.0/norm, &column.vector);
}
return GSL_SUCCESS;
}
{
gsl_vector_view f = gsl_vector_subvector (work, 0, K - 1);
/* bidiagonalize matrix A, unpack A into U S V */
gsl_linalg_bidiag_decomp (A, S, &f.vector);
gsl_linalg_bidiag_unpack2 (A, S, &f.vector, V);
/* apply reduction steps to B=(S,Sd) */
chop_small_elements (S, &f.vector);
/* Progressively reduce the matrix until it is diagonal */
b = N - 1;
iter = 0;
while (b > 0)
{
double fbm1 = gsl_vector_get (&f.vector, b - 1);
if (fbm1 == 0.0 || gsl_isnan (fbm1))
{
b--;
continue;
}
/* Find the largest unreduced block (a,b) starting from b
and working backwards */
a = b - 1;
while (a > 0)
{
double fam1 = gsl_vector_get (&f.vector, a - 1);
if (fam1 == 0.0 || gsl_isnan (fam1))
{
break;
}
a--;
}
iter++;
if (iter > 100 * N)
{
GSL_ERROR("SVD decomposition failed to converge", GSL_EMAXITER);
}
{
const size_t n_block = b - a + 1;
gsl_vector_view S_block = gsl_vector_subvector (S, a, n_block);
gsl_vector_view f_block = gsl_vector_subvector (&f.vector, a, n_block - 1);
gsl_matrix_view U_block =
gsl_matrix_submatrix (A, 0, a, A->size1, n_block);
gsl_matrix_view V_block =
gsl_matrix_submatrix (V, 0, a, V->size1, n_block);
qrstep (&S_block.vector, &f_block.vector, &U_block.matrix, &V_block.matrix);
/* remove any small off-diagonal elements */
chop_small_elements (&S_block.vector, &f_block.vector);
}
}
}
/* Make singular values positive by reflections if necessary */
for (j = 0; j < K; j++)
{
double Sj = gsl_vector_get (S, j);
if (Sj < 0.0)
{
for (i = 0; i < N; i++)
{
double Vij = gsl_matrix_get (V, i, j);
gsl_matrix_set (V, i, j, -Vij);
}
gsl_vector_set (S, j, -Sj);
}
}
/* Sort singular values into decreasing order */
for (i = 0; i < K; i++)
{
double S_max = gsl_vector_get (S, i);
size_t i_max = i;
for (j = i + 1; j < K; j++)
{
double Sj = gsl_vector_get (S, j);
if (Sj > S_max)
{
S_max = Sj;
i_max = j;
}
}
if (i_max != i)
{
/* swap eigenvalues */
gsl_vector_swap_elements (S, i, i_max);
/* swap eigenvectors */
gsl_matrix_swap_columns (A, i, i_max);
gsl_matrix_swap_columns (V, i, i_max);
}
}
return GSL_SUCCESS;
}