size_t gsl_linalg_QRPT_rank (const gsl_matrix * QR, const double tol) { const size_t M = QR->size1; const size_t N = QR->size2; gsl_vector_const_view diag = gsl_matrix_const_diagonal(QR); double eps; size_t i; size_t r = 0; if (tol < 0.0) { double min, max, absmax; int ee; gsl_vector_minmax(&diag.vector, &min, &max); absmax = GSL_MAX(fabs(min), fabs(max)); ee = (int) (log(absmax) / log(2.0)); eps = 20.0 * (M + N) * pow(2.0, (double) ee) * GSL_DBL_EPSILON; } else eps = tol; /* count number of diagonal elements with |di| > eps */ for (i = 0; i < GSL_MIN(M, N); ++i) { double di = gsl_vector_get(&diag.vector, i); if (fabs(di) > eps) ++r; } return r; }
static double cholesky_LDLT_norm1(const gsl_matrix * LDLT, const gsl_permutation * p, gsl_vector * work) { const size_t N = LDLT->size1; gsl_vector_const_view D = gsl_matrix_const_diagonal(LDLT); gsl_vector_view diagA = gsl_vector_subvector(work, N, N); double max = 0.0; size_t i, j; /* reconstruct diagonal entries of original matrix A */ for (j = 0; j < N; ++j) { double Ajj; /* compute diagonal (j,j) entry of A */ Ajj = gsl_vector_get(&D.vector, j); for (i = 0; i < j; ++i) { double Di = gsl_vector_get(&D.vector, i); double Lji = gsl_matrix_get(LDLT, j, i); Ajj += Di * Lji * Lji; } gsl_vector_set(&diagA.vector, j, Ajj); } gsl_permute_vector_inverse(p, &diagA.vector); for (j = 0; j < N; ++j) { double sum = 0.0; double Ajj = gsl_vector_get(&diagA.vector, j); for (i = 0; i < j; ++i) { double *wi = gsl_vector_ptr(work, i); double Aij = gsl_matrix_get(LDLT, i, j); double absAij = fabs(Aij); sum += absAij; *wi += absAij; } gsl_vector_set(work, j, sum + fabs(Ajj)); } for (i = 0; i < N; ++i) { double wi = gsl_vector_get(work, i); max = GSL_MAX(max, wi); } return max; }
int gsl_linalg_pcholesky_svx(const gsl_matrix * LDLT, const gsl_permutation * p, gsl_vector * x) { if (LDLT->size1 != LDLT->size2) { 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 (LDLT->size2 != x->size) { GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN); } else { gsl_vector_const_view D = gsl_matrix_const_diagonal(LDLT); /* x := P b */ gsl_permute_vector(p, x); /* solve: L w = P b */ gsl_blas_dtrsv(CblasLower, CblasNoTrans, CblasUnit, LDLT, x); /* solve: D y = w */ gsl_vector_div(x, &D.vector); /* solve: L^T z = y */ gsl_blas_dtrsv(CblasLower, CblasTrans, CblasUnit, LDLT, x); /* compute: x = P^T z */ gsl_permute_vector_inverse(p, x); return GSL_SUCCESS; } }
gsl_matrix * mygsl_matrix_diagalloc(const gsl_matrix * mat, const double x) { gsl_vector_const_view diag = gsl_matrix_const_diagonal(mat); return mygsl_matrix_diagalloc(&diag.vector, x); }