int
gsl_linalg_LQ_unpack (const gsl_matrix * LQ, const gsl_vector * tau, gsl_matrix * Q, gsl_matrix * L)
{
const size_t N = LQ->size1;
const size_t M = LQ->size2;
if (Q->size1 != M || Q->size2 != M)
{
GSL_ERROR ("Q matrix must be M x M", GSL_ENOTSQR);
}
else if (L->size1 != N || L->size2 != M)
{
GSL_ERROR ("R matrix must be N x M", GSL_ENOTSQR);
}
else if (tau->size != GSL_MIN (M, N))
{
GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
}
else
{
size_t i, j, l_border;
/* Initialize Q to the identity */
gsl_matrix_set_identity (Q);
for (i = GSL_MIN (M, N); i-- > 0;)
{
gsl_vector_const_view c = gsl_matrix_const_row (LQ, i);
gsl_vector_const_view h = gsl_vector_const_subvector (&c.vector,
i, M - i);
gsl_matrix_view m = gsl_matrix_submatrix (Q, i, i, M - i, M - i);
double ti = gsl_vector_get (tau, i);
gsl_linalg_householder_mh (ti, &h.vector, &m.matrix);
}
/* Form the lower triangular matrix L from a packed LQ matrix */
for (i = 0; i < N; i++)
{
l_border=GSL_MIN(i,M-1);
for (j = 0; j <= l_border ; j++)
gsl_matrix_set (L, i, j, gsl_matrix_get (LQ, i, j));
for (j = l_border+1; j < M; j++)
gsl_matrix_set (L, i, j, 0.0);
}
return GSL_SUCCESS;
}
}
int
gsl_linalg_LQ_decomp (gsl_matrix * A, gsl_vector * tau)
{
const size_t N = A->size1;
const size_t M = A->size2;
if (tau->size != GSL_MIN (M, N))
{
GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
}
else
{
size_t i;
for (i = 0; i < GSL_MIN (M, N); i++)
{
/* Compute the Householder transformation to reduce the j-th
column of the matrix to a multiple of the j-th unit vector */
gsl_vector_view c_full = gsl_matrix_row (A, i);
gsl_vector_view c = gsl_vector_subvector (&(c_full.vector), i, M-i);
double tau_i = gsl_linalg_householder_transform (&(c.vector));
gsl_vector_set (tau, i, tau_i);
/* Apply the transformation to the remaining columns and
update the norms */
if (i + 1 < N)
{
gsl_matrix_view m = gsl_matrix_submatrix (A, i + 1, i, N - (i + 1), M - i );
gsl_linalg_householder_mh (tau_i, &(c.vector), &(m.matrix));
}
}
return GSL_SUCCESS;
}
}
int
gsl_linalg_PTLQ_decomp (gsl_matrix * A, gsl_vector * tau, gsl_permutation * p, int *signum, gsl_vector * norm)
{
const size_t N = A->size1;
const size_t M = A->size2;
if (tau->size != GSL_MIN (M, N))
{
GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN);
}
else if (p->size != N)
{
GSL_ERROR ("permutation size must be N", GSL_EBADLEN);
}
else if (norm->size != N)
{
GSL_ERROR ("norm size must be N", GSL_EBADLEN);
}
else
{
size_t i;
*signum = 1;
gsl_permutation_init (p); /* set to identity */
/* Compute column norms and store in workspace */
for (i = 0; i < N; i++)
{
gsl_vector_view c = gsl_matrix_row (A, i);
double x = gsl_blas_dnrm2 (&c.vector);
gsl_vector_set (norm, i, x);
}
for (i = 0; i < GSL_MIN (M, N); i++)
{
/* Bring the column of largest norm into the pivot position */
double max_norm = gsl_vector_get(norm, i);
size_t j, kmax = i;
for (j = i + 1; j < N; j++)
{
double x = gsl_vector_get (norm, j);
if (x > max_norm)
{
max_norm = x;
kmax = j;
}
}
if (kmax != i)
{
gsl_matrix_swap_rows (A, i, kmax);
gsl_permutation_swap (p, i, kmax);
gsl_vector_swap_elements(norm,i,kmax);
(*signum) = -(*signum);
}
/* Compute the Householder transformation to reduce the j-th
column of the matrix to a multiple of the j-th unit vector */
{
gsl_vector_view c_full = gsl_matrix_row (A, i);
gsl_vector_view c = gsl_vector_subvector (&c_full.vector,
i, M - i);
double tau_i = gsl_linalg_householder_transform (&c.vector);
gsl_vector_set (tau, i, tau_i);
/* Apply the transformation to the remaining columns */
if (i + 1 < N)
{
gsl_matrix_view m = gsl_matrix_submatrix (A, i +1, i, N - (i+1), M - i);
gsl_linalg_householder_mh (tau_i, &c.vector, &m.matrix);
}
}
/* Update the norms of the remaining columns too */
if (i + 1 < M)
{
for (j = i + 1; j < N; j++)
{
double x = gsl_vector_get (norm, j);
if (x > 0.0)
{
double y = 0;
double temp= gsl_matrix_get (A, j, i) / x;
if (fabs (temp) >= 1)
y = 0.0;
else
y = x * sqrt (1 - temp * temp);
/* recompute norm to prevent loss of accuracy */
if (fabs (y / x) < sqrt (20.0) * GSL_SQRT_DBL_EPSILON)
{
gsl_vector_view c_full = gsl_matrix_row (A, j);
gsl_vector_view c =
gsl_vector_subvector(&c_full.vector,
i+1, M - (i+1));
y = gsl_blas_dnrm2 (&c.vector);
}
gsl_vector_set (norm, j, y);
}
}
}
}
return GSL_SUCCESS;
}
}
/**
* C++ version of gsl_linalg_householder_mh().
* @param tau A scalar
* @param v A vector
* @param A A matrix
* @return Error code on failure
*/
inline int householder_mh( double tau, vector const& v, matrix& A ){
return gsl_linalg_householder_mh( tau, v.get(), A.get() ); }
int
gsl_linalg_hessenberg_decomp(gsl_matrix *A, gsl_vector *tau)
{
const size_t N = A->size1;
if (N != A->size2)
{
GSL_ERROR ("Hessenberg reduction requires square matrix",
GSL_ENOTSQR);
}
else if (N != tau->size)
{
GSL_ERROR ("tau vector must match matrix size", GSL_EBADLEN);
}
else if (N < 3)
{
/* nothing to do */
return GSL_SUCCESS;
}
else
{
size_t i; /* looping */
gsl_vector_view c, /* matrix column */
hv; /* householder vector */
gsl_matrix_view m;
double tau_i; /* beta in algorithm 7.4.2 */
for (i = 0; i < N - 2; ++i)
{
/*
* make a copy of A(i + 1:n, i) and store it in the section
* of 'tau' that we haven't stored coefficients in yet
*/
c = gsl_matrix_subcolumn(A, i, i + 1, N - i - 1);
hv = gsl_vector_subvector(tau, i + 1, N - (i + 1));
gsl_vector_memcpy(&hv.vector, &c.vector);
/* compute householder transformation of A(i+1:n,i) */
tau_i = gsl_linalg_householder_transform(&hv.vector);
/* apply left householder matrix (I - tau_i v v') to A */
m = gsl_matrix_submatrix(A, i + 1, i, N - (i + 1), N - i);
gsl_linalg_householder_hm(tau_i, &hv.vector, &m.matrix);
/* apply right householder matrix (I - tau_i v v') to A */
m = gsl_matrix_submatrix(A, 0, i + 1, N, N - (i + 1));
gsl_linalg_householder_mh(tau_i, &hv.vector, &m.matrix);
/* save Householder coefficient */
gsl_vector_set(tau, i, tau_i);
/*
* store Householder vector below the subdiagonal in column
* i of the matrix. hv(1) does not need to be stored since
* it is always 1.
*/
c = gsl_vector_subvector(&c.vector, 1, c.vector.size - 1);
hv = gsl_vector_subvector(&hv.vector, 1, hv.vector.size - 1);
gsl_vector_memcpy(&c.vector, &hv.vector);
}
return GSL_SUCCESS;
}
} /* gsl_linalg_hessenberg_decomp() */
int
gsl_linalg_hessenberg_unpack_accum(gsl_matrix * H, gsl_vector * tau,
gsl_matrix * V)
{
const size_t N = H->size1;
if (N != H->size2)
{
GSL_ERROR ("Hessenberg reduction requires square matrix",
GSL_ENOTSQR);
}
else if (N != tau->size)
{
GSL_ERROR ("tau vector must match matrix size", GSL_EBADLEN);
}
else if (N != V->size2)
{
GSL_ERROR ("V matrix has wrong dimension", GSL_EBADLEN);
}
else
{
size_t j; /* looping */
double tau_j; /* householder coefficient */
gsl_vector_view c, /* matrix column */
hv; /* householder vector */
gsl_matrix_view m;
if (N < 3)
{
/* nothing to do */
return GSL_SUCCESS;
}
for (j = 0; j < (N - 2); ++j)
{
c = gsl_matrix_column(H, j);
tau_j = gsl_vector_get(tau, j);
/*
* get a view to the householder vector in column j, but
* make sure hv(2) starts at the element below the
* subdiagonal, since hv(1) was never stored and is always
* 1
*/
hv = gsl_vector_subvector(&c.vector, j + 1, N - (j + 1));
/*
* Only operate on part of the matrix since the first
* j + 1 entries of the real householder vector are 0
*
* V -> V * U(j)
*
* Note here that V->size1 is not necessarily equal to N
*/
m = gsl_matrix_submatrix(V, 0, j + 1, V->size1, N - (j + 1));
/* apply right Householder matrix to V */
gsl_linalg_householder_mh(tau_j, &hv.vector, &m.matrix);
}
return GSL_SUCCESS;
}
} /* gsl_linalg_hessenberg_unpack_accum() */
