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; }