static int pcholesky_decomp (const int copy_uplo, gsl_matrix * A, gsl_permutation * p) { const size_t N = A->size1; if (N != A->size2) { GSL_ERROR("LDLT decomposition requires square matrix", GSL_ENOTSQR); } else if (p->size != N) { GSL_ERROR ("permutation length must match matrix size", GSL_EBADLEN); } else { gsl_vector_view diag = gsl_matrix_diagonal(A); size_t k; if (copy_uplo) { /* save a copy of A in upper triangle (for later rcond calculation) */ gsl_matrix_transpose_tricpy('L', 0, A, A); } gsl_permutation_init(p); for (k = 0; k < N; ++k) { gsl_vector_view w; size_t j; /* compute j = max_idx { A_kk, ..., A_nn } */ w = gsl_vector_subvector(&diag.vector, k, N - k); j = gsl_vector_max_index(&w.vector) + k; gsl_permutation_swap(p, k, j); cholesky_swap_rowcol(A, k, j); if (k < N - 1) { double alpha = gsl_matrix_get(A, k, k); double alphainv = 1.0 / alpha; /* v = A(k+1:n, k) */ gsl_vector_view v = gsl_matrix_subcolumn(A, k, k + 1, N - k - 1); /* m = A(k+1:n, k+1:n) */ gsl_matrix_view m = gsl_matrix_submatrix(A, k + 1, k + 1, N - k - 1, N - k - 1); /* m = m - v v^T / alpha */ gsl_blas_dsyr(CblasLower, -alphainv, &v.vector, &m.matrix); /* v = v / alpha */ gsl_vector_scale(&v.vector, alphainv); } } return GSL_SUCCESS; } }
int gsl_linalg_cholesky_invert(gsl_matrix * LLT) { if (LLT->size1 != LLT->size2) { GSL_ERROR ("cholesky matrix must be square", GSL_ENOTSQR); } else { const size_t N = LLT->size1; size_t i; gsl_vector_view v1, v2; /* invert the lower triangle of LLT */ gsl_linalg_tri_lower_invert(LLT); /* * The lower triangle of LLT now contains L^{-1}. Now compute * A^{-1} = L^{-T} L^{-1} */ for (i = 0; i < N; ++i) { double aii = gsl_matrix_get(LLT, i, i); if (i < N - 1) { double tmp; v1 = gsl_matrix_subcolumn(LLT, i, i, N - i); gsl_blas_ddot(&v1.vector, &v1.vector, &tmp); gsl_matrix_set(LLT, i, i, tmp); if (i > 0) { gsl_matrix_view m = gsl_matrix_submatrix(LLT, i + 1, 0, N - i - 1, i); v1 = gsl_matrix_subcolumn(LLT, i, i + 1, N - i - 1); v2 = gsl_matrix_subrow(LLT, i, 0, i); gsl_blas_dgemv(CblasTrans, 1.0, &m.matrix, &v1.vector, aii, &v2.vector); } } else { v1 = gsl_matrix_row(LLT, N - 1); gsl_blas_dscal(aii, &v1.vector); } } /* copy lower triangle to upper */ gsl_matrix_transpose_tricpy('L', 0, LLT, LLT); return GSL_SUCCESS; } } /* gsl_linalg_cholesky_invert() */
int gsl_linalg_cholesky_decomp (gsl_matrix * A) { int status; status = gsl_linalg_cholesky_decomp1(A); if (status == GSL_SUCCESS) { gsl_matrix_transpose_tricpy('L', 0, A, A); } return status; }
int gsl_linalg_cholesky_decomp1 (gsl_matrix * A) { const size_t M = A->size1; const size_t N = A->size2; if (M != N) { GSL_ERROR("cholesky decomposition requires square matrix", GSL_ENOTSQR); } else { size_t j; /* save original matrix in upper triangle for later rcond calculation */ gsl_matrix_transpose_tricpy('L', 0, A, A); for (j = 0; j < N; ++j) { double ajj; gsl_vector_view v = gsl_matrix_subcolumn(A, j, j, N - j); /* A(j:n,j) */ if (j > 0) { gsl_vector_view w = gsl_matrix_subrow(A, j, 0, j); /* A(j,1:j-1)^T */ gsl_matrix_view m = gsl_matrix_submatrix(A, j, 0, N - j, j); /* A(j:n,1:j-1) */ gsl_blas_dgemv(CblasNoTrans, -1.0, &m.matrix, &w.vector, 1.0, &v.vector); } ajj = gsl_matrix_get(A, j, j); if (ajj <= 0.0) { GSL_ERROR("matrix is not positive definite", GSL_EDOM); } ajj = sqrt(ajj); gsl_vector_scale(&v.vector, 1.0 / ajj); } return GSL_SUCCESS; } }
int gsl_linalg_pcholesky_decomp2(gsl_matrix * A, gsl_permutation * p, gsl_vector * S) { const size_t M = A->size1; const size_t N = A->size2; if (M != N) { GSL_ERROR("cholesky decomposition requires square matrix", GSL_ENOTSQR); } else if (N != p->size) { GSL_ERROR ("matrix size must match permutation size", GSL_EBADLEN); } else if (N != S->size) { GSL_ERROR("S must have length N", GSL_EBADLEN); } else { int status; /* save a copy of A in upper triangle (for later rcond calculation) */ gsl_matrix_transpose_tricpy('L', 0, A, A); /* compute scaling factors to reduce cond(A) */ status = gsl_linalg_cholesky_scale(A, S); if (status) return status; /* apply scaling factors */ status = gsl_linalg_cholesky_scale_apply(A, S); if (status) return status; /* compute Cholesky decomposition of diag(S) A diag(S) */ status = pcholesky_decomp(0, A, p); if (status) return status; return GSL_SUCCESS; } }
int gsl_multifit_linear_Lsobolev(const size_t p, const size_t kmax, const gsl_vector *alpha, gsl_matrix *L, gsl_multifit_linear_workspace *work) { if (p > work->pmax) { GSL_ERROR("p is larger than workspace", GSL_EBADLEN); } else if (p <= kmax) { GSL_ERROR("p must be larger than derivative order", GSL_EBADLEN); } else if (kmax + 1 != alpha->size) { GSL_ERROR("alpha must be size kmax + 1", GSL_EBADLEN); } else if (p != L->size1) { GSL_ERROR("L matrix is wrong size", GSL_EBADLEN); } else if (L->size1 != L->size2) { GSL_ERROR("L matrix is not square", GSL_ENOTSQR); } else { int s; size_t j, k; gsl_vector_view d = gsl_matrix_diagonal(L); const double alpha0 = gsl_vector_get(alpha, 0); /* initialize L to alpha0^2 I */ gsl_matrix_set_zero(L); gsl_vector_add_constant(&d.vector, alpha0 * alpha0); for (k = 1; k <= kmax; ++k) { gsl_matrix_view Lk = gsl_matrix_submatrix(work->Q, 0, 0, p - k, p); double ak = gsl_vector_get(alpha, k); /* compute a_k L_k */ s = gsl_multifit_linear_Lk(p, k, &Lk.matrix); if (s) return s; gsl_matrix_scale(&Lk.matrix, ak); /* LTL += L_k^T L_k */ gsl_blas_dsyrk(CblasLower, CblasTrans, 1.0, &Lk.matrix, 1.0, L); } s = gsl_linalg_cholesky_decomp(L); if (s) return s; /* copy Cholesky factor to upper triangle and zero out bottom */ gsl_matrix_transpose_tricpy('L', 1, L, L); for (j = 0; j < p; ++j) { for (k = 0; k < j; ++k) gsl_matrix_set(L, j, k, 0.0); } return GSL_SUCCESS; } }
int gsl_linalg_pcholesky_invert(const gsl_matrix * LDLT, const gsl_permutation * p, gsl_matrix * Ainv) { const size_t M = LDLT->size1; const size_t N = LDLT->size2; if (M != N) { GSL_ERROR ("LDLT matrix must be square", GSL_ENOTSQR); } else if (LDLT->size1 != p->size) { GSL_ERROR ("matrix size must match permutation size", GSL_EBADLEN); } else if (Ainv->size1 != Ainv->size2) { GSL_ERROR ("Ainv matrix must be square", GSL_ENOTSQR); } else if (Ainv->size1 != M) { GSL_ERROR ("Ainv matrix has wrong dimensions", GSL_EBADLEN); } else { size_t i, j; gsl_vector_view v1, v2; /* invert the lower triangle of LDLT */ gsl_matrix_memcpy(Ainv, LDLT); gsl_linalg_tri_lower_unit_invert(Ainv); /* compute sqrt(D^{-1}) L^{-1} in the lower triangle of Ainv */ for (i = 0; i < N; ++i) { double di = gsl_matrix_get(LDLT, i, i); double sqrt_di = sqrt(di); for (j = 0; j < i; ++j) { double *Lij = gsl_matrix_ptr(Ainv, i, j); *Lij /= sqrt_di; } gsl_matrix_set(Ainv, i, i, 1.0 / sqrt_di); } /* * The lower triangle of Ainv now contains D^{-1/2} L^{-1}. Now compute * A^{-1} = L^{-T} D^{-1} L^{-1} */ for (i = 0; i < N; ++i) { double aii = gsl_matrix_get(Ainv, i, i); if (i < N - 1) { double tmp; v1 = gsl_matrix_subcolumn(Ainv, i, i, N - i); gsl_blas_ddot(&v1.vector, &v1.vector, &tmp); gsl_matrix_set(Ainv, i, i, tmp); if (i > 0) { gsl_matrix_view m = gsl_matrix_submatrix(Ainv, i + 1, 0, N - i - 1, i); v1 = gsl_matrix_subcolumn(Ainv, i, i + 1, N - i - 1); v2 = gsl_matrix_subrow(Ainv, i, 0, i); gsl_blas_dgemv(CblasTrans, 1.0, &m.matrix, &v1.vector, aii, &v2.vector); } } else { v1 = gsl_matrix_row(Ainv, N - 1); gsl_blas_dscal(aii, &v1.vector); } } /* copy lower triangle to upper */ gsl_matrix_transpose_tricpy('L', 0, Ainv, Ainv); /* now apply permutation p to the matrix */ /* compute L^{-T} D^{-1} L^{-1} P^T */ for (i = 0; i < N; ++i) { v1 = gsl_matrix_row(Ainv, i); gsl_permute_vector_inverse(p, &v1.vector); } /* compute P L^{-T} D^{-1} L^{-1} P^T */ for (i = 0; i < N; ++i) { v1 = gsl_matrix_column(Ainv, i); gsl_permute_vector_inverse(p, &v1.vector); } return GSL_SUCCESS; } }