/** * C++ version of gsl_linalg_householder_hm1(). * @param tau A scalar * @param A A matrix * @return Error code on failure */ inline int householder_hm1( double tau, matrix& A ){ return gsl_linalg_householder_hm1( tau, A.get() ); }
int gsl_linalg_SV_decomp_mod (gsl_matrix * A, gsl_matrix * X, gsl_matrix * V, gsl_vector * S, gsl_vector * work) { size_t i, j; const size_t M = A->size1; const size_t N = A->size2; 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 (X->size1 != N) { GSL_ERROR ("square matrix X must match second dimension of matrix A", GSL_EBADLEN); } else if (X->size1 != X->size2) { GSL_ERROR ("matrix X 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); } 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; } /* Convert A into an upper triangular matrix R */ for (i = 0; i < N; i++) { gsl_vector_view c = gsl_matrix_column (A, i); gsl_vector_view v = gsl_vector_subvector (&c.vector, i, M - i); double tau_i = gsl_linalg_householder_transform (&v.vector); /* Apply the transformation to the remaining columns */ if (i + 1 < N) { gsl_matrix_view m = gsl_matrix_submatrix (A, i, i + 1, M - i, N - (i + 1)); gsl_linalg_householder_hm (tau_i, &v.vector, &m.matrix); } gsl_vector_set (S, i, tau_i); } /* Copy the upper triangular part of A into X */ for (i = 0; i < N; i++) { for (j = 0; j < i; j++) { gsl_matrix_set (X, i, j, 0.0); } { double Aii = gsl_matrix_get (A, i, i); gsl_matrix_set (X, i, i, Aii); } for (j = i + 1; j < N; j++) { double Aij = gsl_matrix_get (A, i, j); gsl_matrix_set (X, i, j, Aij); } } /* Convert A into an orthogonal matrix L */ for (j = N; j-- > 0;) { /* Householder column transformation to accumulate L */ double tj = gsl_vector_get (S, j); gsl_matrix_view m = gsl_matrix_submatrix (A, j, j, M - j, N - j); gsl_linalg_householder_hm1 (tj, &m.matrix); } /* unpack R into X V S */ gsl_linalg_SV_decomp (X, V, S, work); /* Multiply L by X, to obtain U = L X, stored in U */ { gsl_vector_view sum = gsl_vector_subvector (work, 0, N); for (i = 0; i < M; i++) { gsl_vector_view L_i = gsl_matrix_row (A, i); gsl_vector_set_zero (&sum.vector); for (j = 0; j < N; j++) { double Lij = gsl_vector_get (&L_i.vector, j); gsl_vector_view X_j = gsl_matrix_row (X, j); gsl_blas_daxpy (Lij, &X_j.vector, &sum.vector); } gsl_vector_memcpy (&L_i.vector, &sum.vector); } } return GSL_SUCCESS; }