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