int gsl_linalg_QR_QTmat (const gsl_matrix * QR, const gsl_vector * tau, gsl_matrix * A) { const size_t M = QR->size1; const size_t N = QR->size2; if (tau->size != GSL_MIN (M, N)) { GSL_ERROR ("size of tau must be MIN(M,N)", GSL_EBADLEN); } else if (A->size1 != M) { GSL_ERROR ("matrix must have M rows", GSL_EBADLEN); } else { size_t i; /* compute Q^T A */ for (i = 0; i < GSL_MIN (M, N); i++) { gsl_vector_const_view c = gsl_matrix_const_column (QR, i); gsl_vector_const_view h = gsl_vector_const_subvector (&(c.vector), i, M - i); gsl_matrix_view m = gsl_matrix_submatrix(A, i, 0, M - i, A->size2); double ti = gsl_vector_get (tau, i); gsl_linalg_householder_hm (ti, &(h.vector), &(m.matrix)); } return GSL_SUCCESS; } }
int gsl_linalg_QR_unpack (const gsl_matrix * QR, const gsl_vector * tau, gsl_matrix * Q, gsl_matrix * R) { const size_t M = QR->size1; const size_t N = QR->size2; if (Q->size1 != M || Q->size2 != M) { GSL_ERROR ("Q matrix must be M x M", GSL_ENOTSQR); } else if (R->size1 != M || R->size2 != N) { GSL_ERROR ("R matrix must be M x N", 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; /* 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_column (QR, 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_hm (ti, &h.vector, &m.matrix); } /* Form the right triangular matrix R from a packed QR matrix */ for (i = 0; i < M; i++) { for (j = 0; j < i && j < N; j++) gsl_matrix_set (R, i, j, 0.0); for (j = i; j < N; j++) gsl_matrix_set (R, i, j, gsl_matrix_get (QR, i, j)); } return GSL_SUCCESS; } }
int gsl_linalg_QR_decomp (gsl_matrix * A, gsl_vector * tau) { const size_t M = A->size1; const size_t N = 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_column (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, i + 1, M - i, N - (i + 1)); gsl_linalg_householder_hm (tau_i, &(c.vector), &(m.matrix)); } } return GSL_SUCCESS; } }
/** * C++ version of gsl_linalg_householder_hm(). * @param tau A scalar * @param v A vector * @param A A matrix * @return Error code on failure */ inline int householder_hm( double tau, vector const& v, matrix& A ){ return gsl_linalg_householder_hm( tau, v.get(), A.get() ); }
int gsl_linalg_symmtd_unpack (const gsl_matrix * A, const gsl_vector * tau, gsl_matrix * Q, gsl_vector * diag, gsl_vector * sdiag) { if (A->size1 != A->size2) { GSL_ERROR ("matrix A must be square", GSL_ENOTSQR); } else if (tau->size + 1 != A->size1) { GSL_ERROR ("size of tau must be (matrix size - 1)", GSL_EBADLEN); } else if (Q->size1 != A->size1 || Q->size2 != A->size1) { GSL_ERROR ("size of Q must match size of A", GSL_EBADLEN); } else if (diag->size != A->size1) { GSL_ERROR ("size of diagonal must match size of A", GSL_EBADLEN); } else if (sdiag->size + 1 != A->size1) { GSL_ERROR ("size of subdiagonal must be (matrix size - 1)", GSL_EBADLEN); } else { const size_t N = A->size1; size_t i; /* Initialize Q to the identity */ gsl_matrix_set_identity (Q); for (i = N - 2; i-- > 0;) { gsl_vector_const_view c = gsl_matrix_const_column (A, i); gsl_vector_const_view h = gsl_vector_const_subvector (&c.vector, i + 1, N - (i+1)); double ti = gsl_vector_get (tau, i); gsl_matrix_view m = gsl_matrix_submatrix (Q, i + 1, i + 1, N-(i+1), N-(i+1)); gsl_linalg_householder_hm (ti, &h.vector, &m.matrix); } /* Copy diagonal into diag */ for (i = 0; i < N; i++) { double Aii = gsl_matrix_get (A, i, i); gsl_vector_set (diag, i, Aii); } /* Copy subdiagonal into sd */ for (i = 0; i < N - 1; i++) { double Aji = gsl_matrix_get (A, i+1, i); gsl_vector_set (sdiag, i, Aji); } return GSL_SUCCESS; } }
int gsl_linalg_QRPT_decomp (gsl_matrix * A, gsl_vector * tau, gsl_permutation * p, int *signum, gsl_vector * norm) { const size_t M = A->size1; const size_t N = 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_column (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_columns (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_column (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, i + 1, M - i, N - (i+1)); gsl_linalg_householder_hm (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, i, j) / 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_column (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; } }
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_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; }
void Matrix::householderTransform ( const double tau, const Vector& householder ) { gsl_linalg_householder_hm( tau, &householder.vector, &matrix ); }
int gsl_linalg_COD_unpack(const gsl_matrix * QRZ, const gsl_vector * tau_Q, const gsl_vector * tau_Z, const size_t rank, gsl_matrix * Q, gsl_matrix * R, gsl_matrix * Z) { const size_t M = QRZ->size1; const size_t N = QRZ->size2; if (tau_Q->size != GSL_MIN (M, N)) { GSL_ERROR ("size of tau_Q must be MIN(M,N)", GSL_EBADLEN); } else if (tau_Z->size != GSL_MIN (M, N)) { GSL_ERROR ("size of tau_Z must be MIN(M,N)", GSL_EBADLEN); } else if (rank > GSL_MIN (M, N)) { GSL_ERROR ("rank must be <= MIN(M,N)", GSL_EBADLEN); } else if (Q->size1 != M || Q->size2 != M) { GSL_ERROR ("Q must by M-by-M", GSL_EBADLEN); } else if (R->size1 != M || R->size2 != N) { GSL_ERROR ("R must by M-by-N", GSL_EBADLEN); } else if (Z->size1 != N || Z->size2 != N) { GSL_ERROR ("Z must by N-by-N", GSL_EBADLEN); } else { size_t i; gsl_matrix_view R11 = gsl_matrix_submatrix(R, 0, 0, rank, rank); gsl_matrix_const_view QRZ11 = gsl_matrix_const_submatrix(QRZ, 0, 0, rank, rank); /* form Q matrix */ gsl_matrix_set_identity(Q); for (i = GSL_MIN (M, N); i-- > 0;) { gsl_vector_const_view h = gsl_matrix_const_subcolumn (QRZ, i, i, M - i); gsl_matrix_view m = gsl_matrix_submatrix (Q, i, i, M - i, M - i); double ti = gsl_vector_get (tau_Q, i); gsl_linalg_householder_hm (ti, &h.vector, &m.matrix); } /* form Z matrix */ gsl_matrix_set_identity(Z); if (rank < N) { gsl_vector_view work = gsl_matrix_row(R, 0); /* temporary workspace, size N */ /* multiply I by Z from the right */ gsl_linalg_COD_matZ(QRZ, tau_Z, rank, Z, &work.vector); } /* copy rank-by-rank upper triangle of QRZ into R and zero the rest */ gsl_matrix_set_zero(R); gsl_matrix_tricpy('U', 1, &R11.matrix, &QRZ11.matrix); return GSL_SUCCESS; } }